--- /dev/null
+ -*- indented-text -*-
+to 21.2 beta1 "Aeolus"
+-- Synch with 21.0-pre6
+-- Removal of ancient obsolete symbols courtesy of Altrasoft
+-- Fix version numbers
+
+Fork at 21.0 pre5 "Zhong Wei"
--- /dev/null
+1998-07-19 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.2-beta1 is released.
+
+1998-07-18 SL Baur <steve@altair.xemacs.org>
+
+ * config.guess: Synched with latest FSF version.
+
+1998-07-12 Björn Torkelsson <torkel@hpc2n.umu.se>
+
+ * Makefile.in: added LDFLAGS.
+
+1998-07-12 SL Baur <steve@altair.xemacs.org>
+
+ * etc/GOATS: Removed.
+
+ * README: Bump version numbers.
+ * info/dir: Ditto.
+ * etc/README: Ditto.
+ * etc/NEWS: Ditto and purge pre-21.0 stuff.
+ * version.sh: Ditto.
+
+ * XEmacs 21.0-pre5 is released.
+
+1998-07-10 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in (with_offix): Default --with-offix to off.
+
+1998-07-09 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in: Handle multiple database libraries.
+ From Gregory Neil Shapiro <gshapiro@sendmail.org>
+
+ * XEmacs 21.0-pre4 is released.
+
+ * configure.in: Fix test for InfoDock sources.
+
+ * etc/BETA (writing): Update patch creation instructions.
+
+ * etc/FTP: Update FTP mirror list.
+
+ * etc/DISTRIB: Remove duplicated FTP mirror list.
+ * etc/xemacs.1 (ftp): Ditto.
+
+1998-07-09 Oliver Graf <ograf@fga.de>
+
+ * configure.usage: added warning to --with-offix
+
+1998-06-29 SL Baur <steve@altair.xemacs.org>
+
+ * etc/gnuserv.1 (this): Email address for Ben Wing is ben@xemacs.org.
+ * etc/gnuserv.README (README): Ditto.
+ * etc/xemacs-ja.1: Ditto.
+
+1998-06-28 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in: Berkeley DB autodetection fixes
+ From Martin Buchholz <martin@xemacs.org>
+
+ * etc/BABYL: Moved to rmail package
+
+ * etc/enriched.doc: Moved to xemacs-base package
+
+ * etc/MSDOS:
+ * etc/GNUS-NEWS: deleted
+
+1998-06-21 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * etc/NEWS: Added references to documentation about packages and
+ path setup.
+
+ * etc/README: Synched.
+
+1998-06-19 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.0-pre3 is released.
+
+1998-06-20 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * etc/PACKAGES:
+ * etc/BETA: Moved some package stuff into Texinfo docs. Other nitpicks
+
+1998-06-20 Kazuyuki IENAGA <ienaga@jsys.co.jp>
+
+ * configure.in: Added check if the berkdb has db_open or not.
+ (With fixes from Martin Buchholz)
+
+1998-06-19 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.0-pre2 is released.
+
+1998-06-18 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * configure.in: Added -lC for static linking under AIX 4.2.
+
+1998-06-14 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.0-pre1 is released.
+
+1998-06-14 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
+
+ * etc/NEWS: Updated information about customization of the
+ automatic info dir file generation using
+ `Info-auto-generate-directory' and `Info-save-auto-generated-dir'
+
+1998-06-11 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.0-beta43 is released.
+
+1998-06-04 Oliver Graf <ograf@fga.de>
+
+ * tests/Dnd/README: a step-by-step test run
+ * tests/Dnd/droptest.el: some clarifications
+ * tests/Dnd/droptest.sh: created, creates test files
+
+1998-06-01 Oliver Graf <ograf@fga.de>
+
+ * configure.in (summary): added experimental to dragndrop option
+ * configure.usage: added experimental note to --with-dragndrop
+ * tests/Dnd/droptest.el: extra start-drag-region function
+ changed the experimental- stuff
+
+1998-06-02 Andy Piper <andyp@parallax.co.uk>
+
+ * etc/check_cygwin_setup.sh: set more intelligent defaults for
+ windows 95.
+
+1998-06-07 SL Baur <steve@altair.xemacs.org>
+
+ * lwlib/xlwmenu.c: Add room for the 0 byte sentinel.
+
+1998-06-05 Colin Rafferty <colin@xemacs.org>
+
+ * lwlib/xlwmenu.c: Made newchars be as large as it needs to be.
+
+1998-06-01 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.0-beta42 is released.
+
+ * etc/sounds: Removed, now in the sounds-au package.
+
+1998-05-29 Andy Piper <andyp@parallax.co.uk>
+
+ * configure.in: don't use -O3 for cygwin.
+
+ * etc/check_cygwin_setup.sh: new file to check that cygwin is setup
+ correctly for XEmacs operation.
+
+1998-05-28 P. E. Jareth Hein <jareth@camelot-soft.com>
+
+ * configure.in: Switch from giflib to gifreader for
+ our GIF image support (no other mods needed)
+
+1998-05-28 Oliver Graf <ograf@fga.de>
+
+ * configure.in: only one DnD protocol, CDE has priority over OffiX
+
+ * tests/Dnd/README: some changes reflecting recent modifications
+ * tests/Dnd/dragtest.el: removed
+ * tests/Dnd/droptest.el: cosmetics and comments
+
+1998-05-26 Oliver Graf <ograf@fga.de>
+
+ * tests/Dnd/droptest.el: adapted to CDE extensions
+
+1998-05-25 Hans Guenter Weigand <hgweigand@wiesbaden.netsurf.de>
+
+ * configure.in:
+ * config.sub: add initial OpenBSD support
+
+1998-05-21 Andy Piper <andyp@parallax.co.uk>
+
+ * configure.in: check for msw dialogs.
+
+1998-05-23 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.0-beta41 is released.
+
+1998-05-17 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in (CPP): Change -O2 to -O3.
+ Suggested by Martin Buchholz <martin@xemacs.org>
+
+1998-05-15 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.0-beta40 is released.
+
+1998-05-13 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in (ZSH_VERSION): zsh-3.1.2 (and zsh-3.0.4) drops core
+ on the `unset CDPATH' if running as sh.
+
+1998-05-12 Oliver Graf <ograf@fga.de>
+
+ * tests/Dnd/droptest.el: some CDE adaptions (untested)
+
+1998-05-11 Martin Buchholz <martin@xemacs.org>
+
+ * configure.in:
+ Add some more comments.
+ If using bash, use Posix mode and unset CDPATH.
+ Be more careful checking feature dependencies.
+ Introduce XE_CHECK_FEATURE_DEPENDENCY.
+ Undo the gross hack of multiple `echo >> $tempcname'
+ by using here documents instead. (Might break mswindows, tho...)
+ Be more careful autodetecting tooltalk.
+
+ * PROBLEMS:
+ Document problems with Solaris 2.6 + XSUNTRANSPORT
+
+ * Makefile.in:
+ * lwlib/Makefile.in.in:
+ * modules/Makefile.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 Kazuyuki IENAGA <ienaga@jsys.co.jp>
+
+ * configure.in: some people claimed that they can't stop
+ linking wnn6 library if they set --with-wnn6=no.
+
+1998-05-11 Oliver Graf <ograf@fga.de>
+
+ * tests/Dnd/droptest.el: adapted to new calling conventions
+ also showing the new possibilities
+ * tests/Dnd/README: changed to new protocol
+
+1998-05-11 SAKIYAMA Nobuo <nobuo@db3.so-net.or.jp>
+
+ * Fix for HAVE_MULTICAST check.
+
+1998-05-09 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.0-beta39 is released.
+
+1998-05-06 Oliver Graf <ograf@fga.de>
+
+ * configure.in: added autodetection for the Drag'n'Drop API
+ if some DnD protocol is found, HAVE_DRAGNDROP will be defined
+ and dragdrop.o is added to extra_objs
+ * configure.usage: added with-dragndrop, added (*) to with-offix
+ * tests/Dnd/droptest.el: complete overhaul, no it's a real test
+
+1998-05-04 Oliver Graf <ograf@fga.de>
+
+ * tests/Dnd/droptest.el: changed to test new protocol
+ * tests/Dnd/README.OffiX: removed
+ * tests/Dnd/README: created, info about new protocol
+ * tests/Dnd/dragtest.el: comment change
+
+1998-05-07 SL Baur <steve@altair.xemacs.org>
+
+ * etc/altrasoft-logo.xpm: Removed.
+
+1998-05-02 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.0-beta38 is released.
+
+1998-04-29 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in: Use `PROGNAME' for all generated paths.
+
+ * Makefile.in: Change `progname' to `PROGNAME' for consistency.
+
+1998-04-27 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in (progname): Parameterize program name on `progname'
+ and add --with-infodock.
+
+1998-04-26 SL Baur <steve@altair.xemacs.org>
+
+ * Makefile.in: Religiously use ${progname} instead of hardcoded
+ `xemacs'.
+ CPPFLAGS was being set correctly in ${subdir}/Makefiles and
+ overridden by the empty one set in the toplevel Makefile.
+
+1998-04-26 Jason R Mastaler <jason@4b.org>
+
+ * etc/BETA: Replaced SmartList references in favor of
+ Majordomo.
+
+1998-04-25 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs-21.0-beta37 is released.
+
+1998-04-25 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * configure.in: Sychronized ..._USER_DEFINED variables with
+ datadir setting.
+
+ * Makefile.in (mkdir): No longer create sitelispdir.
+
+Sat Apr 24 1998 Andy Piper <andyp@parallax.co.uk>
+
+ * configure.in: make graphic libraries tests be dependant on a
+ window system not X11 only.
+
+Fri Apr 24 19:38:19 1998 Andy Piper <andyp@parallax.co.uk>
+
+ * configure.in: check for our special select in msw.
+
+1998-04-22 Marcus Thiessel <marcus_thiessel@hp.com>
+
+ * PROBLEMS: add answers to some FAQ concerning hpux.
+
+Wed Apr 22 12:59:35 1998 Andy Piper <andyp@parallax.co.uk>
+
+ * configure.in: enable checking for special mswindows select()
+
+1998-04-21 Martin Buchholz <martin@xemacs.org>
+
+ * configure.in: Isolate incomprehensible cma_open/pthreads checking
+ to decosf*
+
+1998-04-21 Marcus Thiessel <marcus_thiessel@hp.com>
+
+ * configure.in: /usr/{include,lib}/Motif2.1 added to search path for X11
+ libs and includes.
+
+1998-04-22 Itay Ben-Yaacov <pezz@www-mail.huji.ac.il>
+
+ * configure.in: check for xpm does not depend anymore on having X.
+ if libXpm exists, and is of the FOR_MSW flavor, define FOR_MSW.
+
+1998-04-19 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
+
+ * etc/NEWS: Documented info dir rebuilding and LDAP support.
+
+ * info/dir: Fixed the explanatory notes for
+ `Info-default-directory-list' removal and the new automatic dir
+ rebuilding facility. Reindented the menu. Added an entry for
+ term.info
+
+1998-04-20 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in (LISPDIR): Removed configuration option for
+ site-lisp.
+
+1998-04-19 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in (version): snarf InfoDock version number.
+
+1998-04-18 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs-21.0-beta36 is released.
+
+Fri Apr 17 12:59:35 1998 Andy Piper <andyp@parallax.co.uk>
+
+ * configure.in: enable install pre-processing for mswindows
+
+Fri Apr 17 12:59:35 1998 Andy Piper <andyp@parallax.co.uk>
+
+ * Makefile.in.in: add install_pp to install incantation.
+
+ * installexe.sh: new file. Add .exe to install targets if the
+ result is executable.
+
+Fri Apr 17 12:59:35 1998 Andy Piper <andyp@parallax.co.uk>
+
+ * Makefile.in: add install_pp to install incantation.
+
+1998-04-14 Itay Ben-Yaacov <pezz@www-mail.huji.ac.il>
+
+ * configure.in: Large echo split into a few smaller ones,
+ so the cygnus sh.exe does not crash.
+
+Thu Apr 16 12:59:35 1998 Andy Piper <andyp@parallax.co.uk>
+
+ * configure.in: enable toolbar checking for mswindows build
+
+1998-04-06 Martin Buchholz <martin@xemacs.org>
+
+ * config.h.in: Add _SVID_SOURCE to list of xmkmf #defines.
+ Used (at least) by RedHat 4.2.
+
+1998-04-11 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * etc/xemacs.1: -no-packages -> -no-early-packages.
+
+ * etc/NEWS: Clarified site-lisp status.
+
+ * configure.in: Re-instated src/paths.h generation from
+ src/paths.h.in.
+
+ * Makefile.in (top_distclean): Remove site-lisp on `make
+ distclean'.
+
+1998-04-10 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.0-beta35 is released.
+
+1998-04-10 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * etc/NEWS: Documented that Info-default-directory-list and
+ site-directory are gone.
+
+ * configure.usage: Clarified --package-path documentation.
+
+1998-04-07 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * configure.in: Now generates src/paths.h from src/paths.h.in.in.
+ Removed defaults for infopath and package-path.
+
+ * Makefile.in (src/paths.h): ... is now generated from
+ src/paths.h.in.in. Moved generation of paths.h to configure.
+
+ * paths.h.in: Removed.
+
+ * paths.h.in.in: Created.
+
+1998-04-06 Martin Buchholz <martin@xemacs.org>
+
+ * configure.in: png was still being used if png_version < 0.96
+
+ * configure.in: Fixed magic to handle AIX, X11R6, and gcc.
+
+1998-04-05 Amir J. Katz <amir@ndsoft.com>
+
+ * INSTALL (Rationale): Offix support comment is wrong. To disable,
+ one must use --with-offix=no and not --without-offix
+
+1998-04-05 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in (CPP): ppc.ldscript sits in $srcdir/src not $srcdir.
+
+1998-04-04 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.0-beta34 is released.
+
+1998-04-03 Martin Buchholz <martin@xemacs.org>
+
+ * configure.in:
+ checking whether gettimeofday accepts one or two arguments... two
+
+1998-04-03 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * configure.in: Fixed magic to handle AIX and MIT X11R6.
+
+1998-04-02 Martin Buchholz <martin@xemacs.org>
+
+ * configure.in: Add magic -T $srcdir/ppc.ldscript on Linux powerpc
+
+1998-04-01 Martin Buchholz <martin@xemacs.org>
+
+ * tests/database.el (test-database): Temporary files (the databases
+ that were created) should be deleted.
+
+ * Makefile.in (testdir): Remove gnumake-specific syntax.
+ (src/Makefile): src/Makefile depends on src/depend.
+
+1998-03-29 Martin Buchholz <martin@xemacs.org>
+
+ * configure.in: Check for -lz, -lgz unconditionally. Too many
+ system linkers don't properly die when there are cascaded link
+ dependencies, so we can't rely on the linker for that. The only
+ downside is that we might link with an extra unneeded library. If
+ you really really care about this, you can go fix it.
+
+ * configure.in: Enhance PANIC msg to make it clear that
+ --with-FEATURE is going to die if FEATURE is not installed.
+
+1998-03-27 Martin Buchholz <martin@xemacs.org>
+
+ * configure.in: $debug was not properly dependent on $beta
+
+ * configure.in: Move offix configuration out of src/Makefile.in.in
+ into configure.in.
+
+ * configure.in: Reorganize xpm detection code.
+
+ * configure.in: XIM default to ON if Motif which is not Lesstif is
+ found.
+
+ * configure.in: Keep auto-generated makefile dependencies out of
+ src/Makefile.in.in by using AC_OUTPUT file concatenation support.
+
+1998-03-26 Martin Buchholz <martin@xemacs.org>
+
+ * configure.in: Fix up cflags handling. Specifically, configure
+ --cflags='' would fail to be recognized.
+
+ * configure.in: Fix up png detection. Link with png_read_image to
+ make sure -lz is required. Test for png >- 0.96 via header file.
+
+1998-03-21 Martin Buchholz <martin@xemacs.org>
+
+ * configure.in (XE_GCC_WRAP_LDFLAGS)
+ Rename to XE_PROTECT_LINKER_FLAGS. Rewrite.
+
+ * configure.in: Make sure BSD always links in libz.a
+ BSD's stupid linker can't detect cascaded lib dependencies
+
+ * configure.in: Autodetect lesstif. define have_lesstif.
+ Don't use motif-xim with lesstif, at least by default.
+
+1998-03-30 SL Baur <steve@altair.xemacs.org>
+
+ * version.sh: Add InfoDock version number variables.
+
+1998-03-30 Amir J. Katz <amir@ndsoft.com>
+
+ * info/dir: Replaced string '20.5' with '21.0'
+
+1998-03-24 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.0-beta33 is released.
+
+1998-03-26 Didier Verna <verna@inf.enst.fr>
+
+ * configure.in, Makefile.in: Removed infopath_user_defined---we
+ always want to propagate it.
+
+ * configure.usage: Synched with configure.in.
+
+1998-03-25 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * configure.usage, INSTALL: Synched with the new path layout.
+
+ * Makefile.in (src/paths.h): Replaced packagepath with
+ package_path to make configure happy.
+
+ * configure.in: Made default setting for packagepath conform to
+ what packages.el builds at run-time: XEmacs-version-specific paths
+ before site-specific ones.
+ Added default setting for pkgdir.
+ Changed --packagepath back to --package-path.
+
+1998-03-24 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.0-beta32 is released.
+
+1998-03-23 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * configure.in: Extended package path by version-specific
+ hierarchies. Changed allow-site-lisp to inhibit-site-lisp.
+
+1998-03-22 SL Baur <steve@altair.xemacs.org>
+
+ * Makefile.in (distclean): Remove packages and mule-packages if they
+ have been linked into place.
+
+1998-03-22 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * <Today>: The Big Path Searching Overhaul.
+
+ * Makefile.in, configure.in: Now pass all configure-specified paths
+ into the binary in a uniform way.
+
+1998-03-20 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in (have_libmcheck): Add test for glibc's malloc
+ checker.
+ - Fix HP/UX dynamic linking flag.
+
+1998-03-19 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in (quoted_arguments): Fix unquoted variable in
+ error-checking test.
+ - fix bogus substitution.
+
+1998-03-17 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in: In -lpng test, look for png_set_strip_alpha.
+ Suggested by William M. Perry <wmperry@aventail.com>
+
+1998-03-16 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.0 beta31 is released.
+
+1998-03-16 P. E. Jareth Hein <jareth@camelot-soft.com>
+
+ * configure.usage (Usage): Correct information about gif, tiff
+ and WNN entries
+
+1998-03-13 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in: typo fix in sed command.
+ From P. E. Jareth Hein <jareth@camelot-soft.com>
+
+ * configure.in (all_widgets): Check for snprintf().
+
+1998-03-11 P. E. Jareth Hein <jareth@camelot-soft.com>
+
+ * configure.in: New gif support
+
+1998-03-10 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in (have_glibc): Don't define _GNU_SOURCE for glibc.
+
+Mon Mar 09 13:00:55 1998 Andy Piper <andyp@parallax.co.uk>
+
+ * configure.in: don't add libc to link list for dlopen ordinary
+ link takes care of this. check for dlfcn.h
+
+1998-03-10 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in: Examine each directory of X11 include path for
+ inclusion into BITMAPDIR.
+
+1998-03-09 SL Baur <steve@altair.xemacs.org>
+
+ * aclocal.m4: Add legalese.
+
+Mon Mar 09 13:00:55 1998 Andy Piper <andyp@parallax.co.uk>
+
+ * configure.in: make sure we have ndbm.h as well as libgdbm.a for
+ database support.
+
+ * configure.in: move msw checking after x checking so that
+ auto-detection works.
+
+1998-03-09 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in: New DLL support.
+ * aclocal.m4: New file.
+ From William M. Perry <wmperry@aventail.com>
+
+1998-03-08 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in (xemacs_betaname): Align messages for minimal
+ tagbits and indexed lrecords.
+ Suggested by Andreas Jaeger <aj@arthur.rhein-neckar.de>
+
+1998-03-09 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * etc/Emacs.ad: Example using leading dot resources to
+ initalize faces changes to use Emacs.foo since the
+ leading dot syntax doesn't work. Initialization of
+ text-cursor face moved to faces.el.
+
+1998-03-07 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta30 is released.
+
+1998-03-05 SL Baur <steve@altair.xemacs.org>
+
+ * PROBLEMS: Update wording of x86 GCC 2.7 problems.
+
+Wed Mar 04 08:55:12 1998 Andy Piper <andyp@parallax.co.uk>
+
+ * configure.in: add a --with-msw option. Make X and msw work
+ together if the user asks.
+
+1998-03-02 SL Baur <steve@altair.xemacs.org>
+
+ * PROBLEMS: Update documentation of gcc bugs that impact XEmacs.
+
+1998-03-01 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in: Add substitutable variable ld_dynamic_link_flags
+ for special required linker flags for building DLL capable
+ binaries.
+
+ * etc/Emacs.ad: Remove explicit `Emacs' application resource
+ name.
+
+1998-02-28 SL Baur <steve@altair.xemacs.org>
+
+ * Makefile.in (top_distclean): Remove Installation.el.
+ (xemacs): New target. Formerly it was `all:'.
+ (all): New default, dist: is now superfluous.
+
+1998-02-27 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in (GNU_MALLOC): add --with-dlmalloc to allow
+ selective use of Doug Lea malloc in Linux C Library and GNU C Library.
+ (Installation): Add XEmacs version and generate `Installation.el'.
+
+1998-02-26 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in (with_ldap: Fix -lldap autodection.
+ Suggested by Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
+ (Installation): Only keep the last configuration.
+
+1998-02-25 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta28 is released.
+
+ * configure.in (with_session): Fix reporting of the setting.
+ (with_database_gnudbm): Correctly report setting.
+
+1998-02-24 SL Baur <steve@altair.xemacs.org>
+
+ * configure.usage: Restore documentation of graphics library
+ flags.
+ From Karl M. Hegbloom <karlheg@bittersweet.inetarena.com>
+
+1998-02-19 Karl M. Hegbloom <karlheg@bittersweet.inetarena.com>
+
+ * PROBLEMS: Tell of the `gpm' SIGTSTP bug and `C-z' on the Linux
+ console.
+
+1998-02-23 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.4 is released to the beta testers.
+
+1998-02-21 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in (after_morecore_hook_exists): Modify dlmalloc tests
+ to also test for Linux libc5.
+
+1998-02-19 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta27 is released.
+ * XEmacs-20.4-pre4 is released.
+
+ * configure.in (doug_lea_malloc): Requires USE_MINIMAL_TAGBITS.
+ (--with-gung): Implement it.
+
+ * configure.usage (--with-gung): Document. Turns on
+ USE_MINIMAL_TAGBITS and USE_INDEXED_LRECORD_IMPLEMENTATION.
+ (--with-term): Remove.
+
+ * XEmacs-20.5-beta26 is released.
+
+1998-02-18 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs-20.4-pre3 is released.
+
+ * Makefile.in: use better feedback while rebuilding finder database.
+ Suggested by Stephen J. Turnbull <turnbull@sk.tsukuba.ac.jp>
+
+1998-02-15 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in (doug_lea_malloc): Add checking for Doug Lea
+ Malloc.
+
+1998-02-14 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in (OFFIX_O): Don't use OffiX if no real Xmu support.
+ Suggested by Pekka Marjola <pema@iki.fi>
+
+ * XEmacs-20.4-pre2 is released.
+ * XEmacs-20.5-beta25 is released.
+
+1998-02-13 SL Baur <steve@altair.xemacs.org>
+
+ * INSTALL: Update for Cygwin and Microsoft Windows.
+
+ * README: Update for Microsoft Windows.
+
+1998-02-09 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.4-pre1 is released.
+ * XEmacs 20.5-beta24 is released.
+
+Wed Jan 28 13:41:22 1998 Andy Piper <andyp@parallax.co.uk>
+
+ * configure.in: add mule-coding target which defines MULE_CODING,
+ nothing uses it as yet. add gif objects to msw support. define
+ const_is_losing=no for msw. make msw not selected if tty selected.
+ add -lshell32 for dnd support. check for a.out.h rather than
+ coff.h
+
+ * lib-src/make-docfile.c: add cygwin support and generalise the
+ remaining open calls. IMHO this should really include sysfile.h.
+
+1998-02-03 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta23 is released.
+
+1998-02-01 SL Baur <steve@altair.xemacs.org>
+
+ * etc/aliases.ksh: igrep from the shell command line.
+ From Karl M. Hegbloom <karlheg@bittersweet.inetarena.com>
+
+1998-01-31 SL Baur <steve@altair.xemacs.org>
+
+ * etc/aliases.ksh: Add `mak' function to create beta.err for
+ build-report.
+ From Adrian Aichner <aichner@ecf.teradyne.com>
+ Suggested by Karl M. Hegbloom <karlheg@bittersweet.inetarena.com>
+
+1998-01-27 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta22 is released.
+
+1998-01-26 SL Baur <steve@altair.xemacs.org>
+
+ * etc/aliases.ksh: New file. Start tracking useful Maintainer
+ XEmacs commands.
+
+1998-01-25 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta21 is released.
+
+Wed Jan 21 10:49:47 1998 Andy Piper <andyp@parallax.co.uk>
+
+ * configure.in: check for coff.h
+
+1998-01-21 Hrvoje Niksic <hniksic@srce.hr>
+
+ * configure.in: Added support for `--with-shlib'.
+
+1998-01-18 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta20 is released.
+
+1998-01-13 Martin Buchholz <martin@xemacs.org>
+
+ * configure.usage:
+ * etc/NEWS:
+ Remove doc for configure-time INFOPATH, no longer used.
+
+ * etc/BETA: Update ftp addresses.
+ * etc/INSTALL: Update ftp addresses.
+ * etc/MAILINGLISTS: Sync with Emacs 20.2. Update ftp addresses.
+
+ * configure.in:
+ * src/config.h.in:
+ Define HAVE_INVERSE_HYPERBOLIC using 1 configure test, not 3.
+
+ * lwlib/lwlib.h:
+ * lwlib/lwlib.c:
+ * lwlib/lwlib-config.c:
+ * lwlib/lwlib-Xm.c:
+ * lwlib/lwlib-Xaw.c:
+ * lwlib/lwlib-Xlw.c:
+ * lwlib/config.h.in:
+ * src/menubar-x.c:
+ Prepend LWLIB_ to (SCROLLBARS|MENUBARS|DIALOGS)_(MOTIF|LUCID|ATHENA).
+ Maintain only one set of variables.
+
+ * etc/xemacs.1: Update author list.
+
+ * Makefile.in (install-arch-dep): Simplify.
+ Replace construct `test -d $dir && foo' with
+ `if test -d $dir; then foo; fi'
+
+ * lwlib/xlwmenu.c:
+ * lwlib/xlwscrollbar.c:
+ * lwlib/lwlib-Xlw.c:
+ * lwlib/lwlib-Xm.c:
+ Always assume presence of limits.h (ANSI).
+
+1998-01-12 SL Baur <steve@altair.xemacs.org>
+
+ * INSTALL: Updated for recent Mule/package changes.
+
+ * XEmacs 20.5-beta19 is released.
+
+1998-01-12 Damon Lipparelli <lipp@primus.com>
+
+ * Makefile.in: Yow! Fixed paths to install dirs when --prefix !=
+ --exec-prefix.
+
+1998-01-10 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta18 is released.
+
+ * etc/FTP: Update address of what was formerly ftp.ibp.fr.
+
+1998-01-08 Didier Verna <verna@inf.enst.fr>
+
+ * configure.in: Get rid of INFOPATH for configure time.
+ * configure.usage (Usage): Ditto.
+
+1998-01-09 SL Baur <steve@altair.xemacs.org>
+
+ * Makefine.in: Correct reported amount of disk savings from
+ compression.
+ From Markus Linnala <maage@cs.tut.fi>
+
+Thu Jan 08 09:42:36 1998 <andyp@parallax.co.uk>
+
+ * configure.in: detect and set scrollbars and menubars with
+ MS-Windows more appropriately. Check for sys/un.h to use in
+ gnuserv.
+
+1998-01-07 SL Baur <steve@altair.xemacs.org>
+
+ * Makefile.in (progname): Cleanly parameterize XEmacs-specific
+ naming.
+
+1998-01-05 Glynn Clements <glynn@sensei.co.uk>
+
+ * lwlib/xlwmenu.c (push_button_draw): use inactive_gc instead of
+ inactive_button_gc for menu entries.
+ (remap_menubar): ignore the enabled status
+
+1998-01-04 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta17 is released.
+
+ * Makefile.in (finder): Use -vanilla.
+ (lisp/finder-inf.el): Ditto.
+ (check-features): New target. Do a sanity check prior to
+ installation.
+
+1997-01-03 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta16 is released.
+
+1997-12-30 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta15 is released.
+
+1997-12-29 SL Baur <steve@altair.xemacs.org>
+
+ * Makefile.in (${SUBDIR}): Remove bogus .RECURSIVE dependency.
+
+1997-12-27 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta14 is released.
+
+1997-12-23 Andy Piper <andyp@parallax.co.uk>
+
+ * configure.in: support for *-pc-cygwin32 config
+
+1997-12-25 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta13 is released.
+
+1997-12-21 SL Baur <steve@altair.xemacs.org>
+
+ * etc/BETA (Prerequisite): Add cookbook procedures for maintaining
+ package lisp directories.
+
+1997-12-20 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta 12 is released.
+
+1997-12-19 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in (bitmapdir): Reenable --with-session by default for
+ testing.
+
+1997-12-18 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * etc/Emacs.ad: Don't specify a default toolbar specific
+ background color.
+
+1997-12-18 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * etc/toolbar: Added support for foregroundToolBarColor
+ symbol to most icons.
+
+1997-12-17 SL Baur <steve@altair.xemacs.org>
+
+ * info/dir (File): Skk and Gnats are packaged.
+
+ * PROBLEMS (Note): Update version numbers.
+
+ * etc/BETA: Update version numbers.
+
+ * etc/NEWS: Update version number.
+
+ * info/dir (File): Update version number.
+
+1997-12-16 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta11 is released.
+
+1997-12-14 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in: Don't bypass graphics library detection
+ if the `--with-imagick' option is given to configure.
+ : Print autodetected graphics libraries to be linked with Imagick.
+
+ * Makefile.in (lisp/finder-inf.el): Reverse previous change.
+
+1997-12-14 Olivier Galibert <olivier.galibert@mines.u-nancy.fr>
+
+ * Makefile.in (install-arch-indep): Build info files if needed.
+
+1997-12-13 SL Baur <steve@altair.xemacs.org>
+
+ * Makefile.in (lisp/finder-inf.el): Add dependency on src/.
+
+ * XEmacs 20.5-beta10 is released.
+
+1997-12-12 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in (CPP): Don't add special CFLAGS for ix86/Linux.
+
+1997-12-10 Karl M. Hegbloom <karlheg@bittersweet.inetarena.com>
+
+ * configure.in (autodetect ImageMagick): also look for
+ "X11/magick/magick.h", and if present, define
+ MAGICK_HEADERS_ARE_UNDER_X11
+
+1997-12-11 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in (imagick_libs): Add autodetection for freetype
+ -lttf library.
+
+1997-12-09 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta9 is released.
+
+1997-12-06 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta8 is released.
+
+ * info/dir: update for further packaging.
+ * configure.in: remove `tree-x' from XEmacs build.
+
+1997-11-29 Jeff Miller <jmiller@smart.net>
+
+ * configure.in: motif menubars need xlwmenu.o
+
+ * updated files in src/ to allow an XEmacs configured for
+ motif menubars to at least compile. Motif menubars are still
+ very broken.
+
+1997-12-05 Aki Vehtari <Aki.Vehtari@hut.fi>
+
+ * etc/refcard.tex: Updated for 20.3
+
+1997-12-02 P E Jareth Hein <jareth@camelot-soft.com>
+
+ * lwlib/xlwscrollbar.c: fixed colormap/visual handling to work
+ properly with the information in the core.
+
+ * lwlib/xlwmenu.c: fixed colormap/visual handling to work properly with
+ the information in the core, and fixed a potental problem with
+ parentage.
+
+1997-12-02 SL Baur <steve@altair.xemacs.org>
+
+ * etc/skk/SKK.tut.E (Hint): Fix typos.
+
+1997-12-01 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in (with_session): Properly display flag in configure
+ status report.
+
+1997-11-29 SL Baur <steve@altair.xemacs.org>
+
+ * configure.usage: Remove documentation of obsolete option
+ --with-gif.
+
+1997-11-27 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta7 is released.
+
+ * configure.in: When testing for -ltiff, fall back on the extra
+ libraries -ljpeg, and -lz since some -ltiff's need them.
+
+1997-11-26 SL Baur <steve@altair.xemacs.org>
+
+ * lwlib/xlwmenu.c (display_menu): Defer incremental menus properly.
+ From Glynn Clements <glynn@sensei.co.uk>
+
+1997-11-25 Kazuyuki IENAGA <ienaga@jsys.co.jp>
+
+ * configure.in: Improve auto detect of libraries ImageMagick rely
+ on.
+
+1997-11-23 Jeff Miller <jmiller@smart.net>
+
+ * Energize is dead. Removed ENERGIZE ifdef's from code in lwlib
+ and src. Configure.in modified. --with-energize is no longer a
+ valid configure option.
+
+ * lwlib/Makefile.in.in removed energize support
+ * lwlib/lwlib-Xm.c removed energize support
+ * lwlib/lwlib-config.c removed energize support
+
+ * lwlib/energize/* removed
+
+1997-11-23 SL Baur <steve@altair.xemacs.org>
+
+ * Makefile.in: Change references of lisp/utils/finder-inf.el to
+ lisp/finder-inf.el.
+
+1997-11-20 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta6 is released.
+
+1997-11-21 Stephen Turnbull <turnbull@sk.tsukuba.ac.jp>
+
+ * configure.usage: Use `--' convention in "usage:" line.
+
+1997-11-20 Stephen Turnbull <turnbull@sk.tsukuba.ac.jp>
+
+ * configure.in: added `with_xfs' to list of boolean features.
+
+1997-11-20 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3 is released for binary kit building.
+
+1997-11-19 Tor Arntsen <tor@spacetec.no>
+
+ * PROBLEMS: Removed IRIX entry about xemacs core dumps when using
+ xemacs dumped on one machine on another. Problem was fixed by 20.3.
+
+1997-11-19 SL Baur <steve@altair.xemacs.org>
+
+ * etc/xemacs.1: Document -no-packages, -vanilla.
+ Document -h.
+
+1997-11-18 SL Baur <steve@altair.xemacs.org>
+
+ * configure.usage: New file.
+
+ * configure.in: Use it instead of monster 10k shell variable.
+
+1997-11-17 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-pre4 is released.
+
+1997-11-17 Jens-Ulrik Holger Petersen <petersen@kurims.kyoto-u.ac.jp>
+
+ * configure.in (infopath): List "/usr/local/" dirs before "/usr/"
+ dirs.
+
+1997-11-17 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in: Initialize infodir off of datadir.
+
+ * Makefile.in: Force LANG = C for building.
+
+1997-11-15 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-pre3 is released.
+ * XEmacs 20.5-beta5 is released.
+
+1997-11-13 Marc Paquette <marcpa@cam.org>
+
+ * nt/Todo: added a task for support of lisp packages through
+ the registry.
+
+1997-11-13 Jonathan Harris <jhar@tardis.ed.ac.uk>
+
+ * Renamed files *w32* to *msw*
+
+ * Changed 'w32' and 'win32' to 'mswindows', and HAVE_W32GUI to
+ HAVE_MS_WINDOWS. Changed files:
+ cus-edit.el, device.el, faces.el, frame.el, msw-faces.el,
+ msw.init.el, igrep.el, dumped-lisp.el, font.el, hippie-exp.el,
+ sysdep.el, console-msw.c, console-msw.h, console.c,
+ device-msw.c, emacs.c, event-msw.c, event-msw.h, event-stream.c,
+ events.c, events.h, faces.c, frame-msw.c, frame.c, general.c,
+ msw-proc.c, objects-msw.c, objects-msw.h, redisplay-msw.c,
+ redisplay.c, symsinit.h,
+
+ * Didn't change 'win32' in nt.c, nt.h, ntproc.c
+
+ * Deleted w32 build directory since nt build directory now handles
+ X and native mswindows builds.
+
+1997-11-11 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta4 is released.
+
+1997-11-10 SL Baur <steve@altair.xemacs.org>
+
+ * info/dir: remove packaged entries.
+ From Glynn Clements <glynn@sensei.co.uk>
+
+ * configure.in: Puke and die if NAS sound is selected without X.
+
+1997-11-08 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta3 is released.
+ * XEmacs 20.3-pre2 is released.
+
+Wed November 05 23:40:00 1997 <jhar@tardis.ed.ac.uk>
+
+ * w32/xemacs.mak: moved building the DOC file to after the .elcs.
+
+Sun November 01 12:00:00 1997 <jhar@tardis.ed.ac.uk>
+
+ * Files split from nt to new w32 directory:
+ ChangeLog, README, Todo, paths.h, config.h, inc/*, runemacs.c,
+ xemacs.mak.
+
+1997-11-05 Didier Verna <verna@inf.enst.fr>
+
+ * configure.in: Added the --site-prefixes options for the configure
+ script. You give a colon or space separated list of prefixes, and
+ subdirectories include/ and lib/ will be added with -I and -L.
+
+1997-11-05 Martin Buchholz <Martin Buchholz <martin@xemacs.org>>
+
+ * configure.in: AIX + gcc fixes.
+ - Don't wrap -B. aixflags changed to start_flags.
+
+1997-11-04 SL Baur <steve@altair.xemacs.org>
+
+ * lwlib/lwlib-Xm.c(update_one_menu_entry): Add missing variable.
+ From Skip Montanaro <skip@calendar.com>
+
+1997-11-04 Adrian Aichner <aichner@ecf.teradyne.com>
+
+ * etc/TUTORIAL.de:
+ Updated copyright information. Translated most of the COPYING
+ section. Translated the <<.*>> didactic line.
+
+1997-10-22 Adrian Aichner <aichner@ecf.teradyne.com>
+
+ * etc/TUTORIAL.de: Fixed two issues reported by
+ Achim Oppelt <aoppelt@theorie3.physik.uni-erlangen.de>
+
+ * etc/TUTORIAL.de:
+ Manually applied rejected patch hunks from Marc Aurel's patch.
+ Some more fixes.
+
+ * etc/TUTORIAL.de:
+ 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 <aichner@ecf.teradyne.com>
+
+ * etc/TUTORIAL.de: Manually merged a few more corrections by
+ Carsten Leonhardt <leo@arioch.oche.de>
+
+1997-10-20 Adrian Aichner <aichner@ecf.teradyne.com>
+
+ * etc/TUTORIAL.de:
+ Applied patches from Andreas Jaeger <aj@arthur.rhein-neckar.de> to 1.2,
+ then merged them with 1.3 via ediff-buffers.
+ Andreas found some quite nasty typos still and added many missing commas.
+
+ * etc/TUTORIAL.de: Re-fill-ed paragraphs after patching.
+
+ * etc/TUTORIAL.de: Applied the excellent patches courtesy of
+ Carsten Leonhardt <leo@arioch.oche.de>.
+
+1997-11-03 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * Delete etc/TUTORIAL.th because Thai is not supported yet.
+
+1997-11-02 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * etc/TUTORIAL.ko: Renamed from etc/TUTORIAL.kr to fit with ISO
+ 639 (two letter language code).
+
+ * etc/TUTORIAL.ja: Renamed from etc/TUTORIAL.jp to fit with ISO
+ 639 (two letter language code).
+
+1997-11-02 SL Baur <steve@altair.xemacs.org>
+
+ * etc/CHARSETS: New file imported from Emacs 20.1.
+
+1997-11-02 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * lwlib/lwlib-Xaw.c (xaw_pop_instance): Don't use parent
+ window's coordinates and dimensions to center the
+ dialog box unless its mapped_when_managed property is
+ true. This should avoid the top level widget that the
+ HAVE_SESSION code creates, which is unmapped and
+ useless for this purpose.
+
+1997-11-01 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-pre1 is released.
+
+1997-10-31 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 19.16 is released.
+
+1997-10-31 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta2 is released.
+
+1997-10-30 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in (xetest): Eliminate tests for PNG, JPEG,
+ TIFF(broken) and replace with test for ImageMagick.
+
+1997-10-30 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * etc/Emacs.ad: Added *XlwMenu*highlightForeground entry.
+ Added *XlwMenu*titleForeground entry.
+
+ * lwlib/xlwmenu.h: Added string macro declarations for
+ titleForeground and highlightForeground properties.
+
+ * lwlib/xlwmenuP.h: Added struct fields for title and
+ highlight colors.
+
+ * lwlib/xlwmenu.c: Added initialization and usage code
+ for the new titleForeground and highlightForeground
+ properties.
+
+1997-10-29 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * etc/HELLO: Add Czech.
+
+ * etc/HELLO: Delete Amharic, Thai and Tigrigna.
+
+1997-10-28 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta94 is released.
+
+1997-10-28 Andreas Jaeger <aj@arthur.rhein-neckar.de>
+
+ * configure.in: Correct last patch for berkdb.
+
+1997-10-28 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta93 is released.
+
+1997-10-27 Martin Buchholz <mrb@eng.sun.com>
+
+ * lib-src/make-path.c:
+ * lib-src/digest-doc.c:
+ * lib-src/gnuslib.c: Always include config.h before system headers
+ * configure.in: Improve AIX configure support
+ - NON_GNU_CC defaults to `xlc'
+ - CFLAGS defaults to "-O3 -qstrict -qlibansi -qinfo -qro
+ -qmaxmem=20000"
+ - check for sin instead of sqrt in -lm to avoid xlc internal error
+ - Detect -li18n for use with Motif
+ - Move weird AIX static linking flags from s&m files to configure.in
+ - use #pragma instead of -ma flag to avoid compiler warnings
+
+1997-10-25 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * lwlib/xlwmenu.c: Use XtRDimension in place of
+ XmRHorizontalDimension in shadowThickness resource
+ declaration.
+
+ * lwlib/xlwmenu.c (label_button_draw): Use the button_gc
+ color as the foreground for selected entries.
+
+ * lwlib/xlwmenu.c (push_button_draw): Use the button_gc
+ color as the foreground for selected entries.
+
+ * lwlib/xlwmenu.c (toggle_decoration_height): Force
+ height to be minimum of 2x the shadow thickness.
+
+1997-10-24 Andreas Jaeger <aj@arthur.rhein-neckar.de>
+
+ * configure.in: Don't choke on Berkeley DB 2.x.
+
+1997-10-24 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta92 is released.
+
+1997-10-21 SL Baur <steve@altair.xemacs.org>
+
+ * Makefile.in (lisp/utils/finder-inf.el): Don't force rebuild if
+ it already exists (use `make finder' to force rebuild).
+
+1997-10-18 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta91 is released.
+
+1997-10-16 Hrvoje Niksic <hniksic@srce.hr>
+
+ * etc/NEWS: document changed package load semantics.
+
+1997-10-15 Olivier Galibert <olivier.galibert@mines.u-nancy.fr>
+
+ * configure.in: Removed -Olimit=2000 from cc for IRIX.
+
+1997-10-12 Karl M. Hegbloom <karlheg@inetarena.com>
+
+ * configure.in (null_string): Added AC_SUBST(infodir_user_defined)
+ and removed backquoted echo statement from the infopath report line.
+
+1997-10-15 Olivier Galibert <olivier.galibert@mines.u-nancy.fr>
+
+ * configure.in: Added detection of the declaration of the timezone
+ variable in system files. Defines HAVE_TIMEZONE_DECL if yes.
+
+
+1997-10-15 Olivier Galibert <olivier.galibert@mines.u-nancy.fr>
+
+ * config.h.in: Add HAVE_TIMEZONE_DECL for detection of declaration
+ of the timezone variable in system headers.
+
+ * systime.h: Use HAVE_TIMEZONE_DECL.
+
+1997-10-14 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in (all_widgets): Don't allow configuration of
+ --with-mule if Mule lisp hasn't been installed.
+
+1997-10-13 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in: Remove `site-lisp' from list of directories to
+ make symbolic links for.
+
+ * XEmacs 20.3-beta90 is released.
+
+1997-10-12 Glynn Clements <glynn@sensei.co.uk>
+
+ * info/dir: Cosmetic changes to info/dir
+
+1997-10-13 Hrvoje Niksic <hniksic@srce.hr>
+
+ * etc/NEWS: Updates
+
+1997-10-12 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.5-beta1 is released.
+
+ * XEmacs 19.16-pre9 is released.
+
+ * XEmacs 19.16-pre8 is released.
+
+1997-10-11 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta28 is released.
+
+ * Makefile.in (src/paths.h): Update PATH_INFOPATH
+ (infopath): New shell variable.
+ (infopath_user_defined): Ditto.
+
+ * configure.in (infodir_user_defined): Spelling fixes.
+
+1997-10-10 Karl M. Hegbloom <karlheg@inetarena.com>
+
+ * configure.in: added options and option help docs for infopath
+ and lockdir
+ * '' added a line to the report for infopath and lockdir
+
+ * etc/NEWS: Draft entry for the info changes.
+
+1997-10-10 Karl M. Hegbloom <karlheg@inetarena.com>
+
+ * Makefile.in.in (INFOPATH): Added variable and put it into
+ DUMPENV.
+
+1997-10-11 SL Baur <steve@altair.xemacs.org>
+
+ * packages/info/localdir: New directory and file.
+
+ * packages/README: New directory & file.
+
+1997-10-10 Martin Buchholz <mrb@eng.sun.com>
+
+ * Makefile.in: Add `make configure' target
+
+ * etc/BETA:
+ - remove Chuck as contact name
+ - random small improvements
+ - remove I/me references - the message should be that XEmacs
+ maintenance is an inclusive community effort.
+
+1997-10-10 SL Baur <steve@altair.xemacs.org>
+
+ * etc/BETA (Prerequisite): Add further documentation for
+ package installation.
+
+1997-10-07 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 19.16-pre7 is released.
+
+1997-10-05 Damon Lipparelli <lipp@aa.net>
+
+ * Makefile.in (install-arch-dep, install-arch-indep): Move the
+ commands for symlink'ing the system-independent bits into the
+ system-dependent directory structure from "install-arch-indep" to
+ "install-arch-dep".
+
+1997-10-06 Jens-Ulrik Holger Petersen <petersen@kurims.kyoto-u.ac.jp>
+
+ * Makefile.in (blddir): variable from "configure".
+ (finder): use it.
+
+1997-10-05 SL Baur <steve@altair.xemacs.org>
+
+ * Makefile.in (GENERATED_LISP): New variable.
+ (all): Force dependency on finder-inf.el.
+ (lisp/utils/finder-inf.el): new rule.
+
+1997-10-04 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 19.16-pre6 is released.
+
+1997-10-04 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta27 is released.
+
+1997-10-03 Damon Lipparelli <lipp@primus.com>
+
+ * Makefile.in (install-arch-indep): When --prefix !=
+ --exec-prefix, symlink the system-independent bits into the
+ system-dependent directory structure (rather than the other way
+ around).
+
+1997-10-03 Martin Buchholz <mrb@eng.sun.com>
+
+ * lib-src/etags.c: etags 12.28 + prototypization
+ * INSTALL: Better document --site-runtime-libraries
+ * src/scrollbar-x.c (x_update_scrollbar_instance_status):
+ FIX: M-x scroll-left; horizontal scrollbar appears; drag it
+ left; scrollbar disappears; keyboard inoperative.
+ * configure.in: Remove left-over references to *_switch_x_*
+ - NAS libaudio is part of $libs_x, not $LIBS
+
+1997-10-02 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta26 is released.
+
+1997-09-30 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta25 is released.
+
+ * Makefile.in (install-arch-dep): Install the `Installation' for
+ future reference.
+
+ * etc/BETA: Document existence of `Installation' file.
+ - Document requirement of rebuilding finder-inf.el when building
+ from the full tarball.
+
+ * Makefile.in (top_distclean): Remove finder-inf.el*.
+
+ * configure.in (use_union_type): Default to "yes".
+
+1997-09-29 Martin Buchholz <mrb@eng.sun.com>
+
+ * configure.in: Add tiff autodetection
+
+1997-09-29 SL Baur <steve@altair.xemacs.org>
+
+ * lwlib/xlwmenu.c: Add bounds checking.
+ Check error return on XmStringGetLtoR.
+
+1997-09-27 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta24 is released.
+
+1997-09-27 Hrvoje Niksic <hniksic@srce.hr>
+
+ * Makefile.in (custom-loads): New target.
+
+1997-09-24 SL Baur <steve@altair.xemacs.org>
+
+ * etc/BETA (XEmacs 20.3 packages): Added explanation of package
+ hierarchy.
+
+1997-09-23 SL Baur <steve@altair.xemacs.org>
+
+ * lwlib/xlwmenu.c: Fix compilation problem with USE_XFONTSET.
+ From Kazuyuki IENAGA <ienaga@jsys.co.jp>
+
+1997-09-22 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 19.16-pre4 is released.
+
+1997-09-20 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta23 is released.
+
+1997-09-19 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 19.16-pre3 is released.
+
+1997-09-18 Colin Rafferty <craffert@ml.com>
+
+ * etc/NEWS: Various spelling corrections and some grammar
+ corrections (which/that).
+
+1997-09-19 Martin Buchholz <mrb@eng.sun.com>
+
+ * src/redisplay-tty.c: Fix crashes with non-7bit tty escape
+ sequences (needs more testing).
+ * */Makefile*:
+ - Cleanup man/*/Makefile for consistency.
+ - use $(MAKEFINFO), $(TEXI2DVI), etc...
+ - Make combination --with-srcdir + Sun make work properly.
+ - Change construct: test -d $${dir} || mkdir $${dir}
+ --> if test ! -d $${dir}; then mkdir $${dir}; fi
+ * lisp/x11/x-win-sun.el: Fix remaining glitches with
+ re-mappings of Sun function keys.
+ * configure.in: Detect libXaw AFTER libXpm to support libXawXpm.
+ * man/internals/internals.texi: Fix makeinfo compilation error.
+
+1997-09-17 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta22 is released.
+
+1997-09-16 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta21 is released.
+
+ * XEmacs 19.16-pre2 is released.
+
+1997-09-13 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta20 is released.
+
+1997-09-11 Martin Buchholz <mrb@eng.sun.com>
+
+ * configure.in: Use `PATH' for options that take multiple dirs.
+ - Fix test for $PWD == `pwd`
+ - Prefer autodetected X11R6 to X11 so that broken HP and Linux
+ systems can work. (untested)
+
+ * lisp/cl/cl.el: Fix `loop' indentation to be same as `defun'.
+ * lisp/prim/dumped-lisp.el: cl-extra and cl-seq always end up
+ being autoloaded - let's make them part of the core.
+
+ * lisp/x11/x-compose.el:
+ * lisp/x11/x-init.el:
+ * lisp/x11/x-win-sun.el:
+ * lisp/x11/x-winxfree86.el:
+ * src/device-x.c:
+ * src/event-Xt.c:
+ - Yet another rewrite of key handling (not the last, though)
+ - x-keysym-on-keyboard-p is much faster.
+ - x-keysym-on-keyboard-sans-modifiers-p introduced.
+ - x-keysym-hashtable introduced.
+ - allow X11R4 libs to guess keysyms on X11R5 servers.
+ - A better workaround for the bug that some Xlibs generate
+ Multi_key a adiaeresis when pressing Multi_key a "
+
+ * src/dgif_lib.c: Make sure size_t is defined before using it.
+
+1997-09-12 SL Baur <steve@altair.xemacs.org>
+
+ XEmacs 19.16-pre1 "Queens" is released.
+
+1997-09-08 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in: Reverse package-path.
+ From Colin Rafferty <craffert@ml.com>
+
+1997-09-02 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta19 is released.
+
+ * Makefile.in (finder): New target.
+
+1997-08-29 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 19.16-beta91 is released.
+
+1997-08-25 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * lisp/apel/emu-x20.el (mime-charset-coding-system-alist):
+ iso-2022-jp-2 is defined as coding-system.
+
+ * lisp/mule/mule-coding.el: Rename `iso-2022-ss2-{7|8}' ->
+ `iso-2022-{7|8}bit-ss2' to sync with Emacs 20.0.96.
+
+ (iso-2022-jp-2): New coding system.
+
+1997-08-23 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * lisp/prim/about.el (about-maintainer-glyph): Fix problem with
+ jka-compr.el.
+
+1997-08-20 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 19.16-beta90 is released.
+
+1997-08-16 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta18 is released.
+
+1997-08-11 Karl M. Hegbloom <karlheg@inetarena.com>
+
+ * etc/NEWS: add a section telling about the Info changes.
+
+1997-08-09 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta17 is released.
+
+1997-08-07 Jan Vroonhof <vroonhof@math.ethz.ch>
+
+ * etc/gnuserv.1: Described Hrvoje's mods in manpage
+
+1997-08-09 Martin Buchholz <mrb@eng.sun.com>
+
+ * configure.in:
+ - use-system-malloc renamed to with-system-malloc.
+ - config.el reimplemented for improved accuracy.
+ - new variable `blddir' introduced for informational purposes.
+ * lib-src/config.values.in: new config.el implementation
+ * lib-src/config.values.sh: new config.el implementation
+ * lisp/modes/pascal.el: Sync with GNU Emacs, fix infloop problem
+ (thanks to Espen Skoglund, pascal.el maintainer)
+ * src/chartab.c: maintainability improvements.
+ * src/mule-coding.c: FIX for: editing DOS files with ISO2022*
+ coding systems results in extra CR's inserted into file on saving.
+
+1997-08-06 SL Baur <steve@altair.xemacs.org>
+
+ * configure.in: Crash & burn if db-2 is detected.
+ From Soren Dayton <csdayton@cs.uchicago.edu>
+
+1997-07-31 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta16 is released.
+
+1997-07-31 Martin Buchholz <mrb@eng.sun.com>
+
+ * configure.in: --with-x11=no --> --with-xface=no
+ * lisp/efs/dired-xemacs.el: Rationalize mouse file functions
+ * src/input-method-xlib.c: Allow xemacs to connect to kinput2
+ * event-Xt.c: Fix crashes when no input context available.
+ * src/mule-coding.c: Use enum eol_type instead of int consistently
+ * regex.c: Use (void *) 0 instead of NULL in varargs function calls
+ * src/s/freebsd.h: Wrap #include X11/Xlocale.h inside #ifndef
+ NOT_C_CODE
+
+1997-07-27 SL Baur <steve@altair.xemacs.org>
+
+ * etc/BETA: Update patching instructions.
+
+1997-07-26 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta15 is released.
+
+1997-07-25 SL Baur <steve@altair.xemacs.org>
+
+ * lwlib/xlwscrollbar.c: Add debug malloc support.
+ * lwlib/xlwmenu.c: Ditto.
+ * lwlib/lwlib-utils.h: Ditto.
+
+ * configure.in (null_string): Add --use-debug-malloc option.
+
+1997-07-21 SL Baur <steve@altair.xemacs.org>
+
+ * info/dir (Packages): Remove AUCTeX, Gnus and Message manuals.
+
+1997-07-20 SL Baur <steve@altair.xemacs.org>
+
+ * Makefile.in (install-arch-indep): Create required links when
+ prefixdir != execdir.
+
+1997-07-19 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta14 is released.
+
+1997-07-19 Martin Buchholz <mrb@eng.sun.com>
+
+ * src/fns.c (require): Print messages when loading a file as a
+ result of require.
+
+ * configure.in:
+ * lisp/utils/config.el:
+ * lib-src/config.values:
+ - new file created and installed by building.
+ - Allow configuration time values to be queried by the lisp code.
+
+ * configure.in:
+ - check for alloca in libPW on hpux.
+ - Redo --with-clash-detection
+ - need to check for termios and friends even if with-tty=no.
+ - Always define SIGNALS_VIA_CHARACTERS if HAVE_TERMIOS
+ - better quoting for AIX_SMT_EXP (untested)
+ - gcc flags now default to "-g -O2 -Wall -Wno-switch"
+
+ * *.[ch]: more warning elimination
+
+ * src/input-method*.c:
+ * src/s/freebsd.h:
+ - remove freebsd ifdefs from C code.
+
+ * src/specifier.c:
+ - fix Fdisplay-table-specifier-p
+
+1997-07-13 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta13 is released.
+
+ * info/dir (Packages): Integrate texinfo manual for PH.
+
+1997-07-10 Hrvoje Niksic <hniksic@srce.hr>
+
+ * extents.c (print_extent): Print correctly.
+
+1997-07-13 Steven L Baur <steve@altair.xemacs.org>
+
+ * configure.in (CPP): Add -Wall to default gcc CFLAGS.
+
+1997-07-11 Martin Buchholz <mrb@eng.sun.com>
+
+ * *Makefile*: More cleanup.
+ - MAKE CFLAGS=-foo now works with recursive invocations on old makes
+ - Nuke ld_call_shared from s&m files
+ - Nuke src/s/*-static.h
+ - Nuke Solaris and DEC OSF static build support.
+ - Nuke SHORTNAMES
+ - Nuke libmld
+ - CLASH_DETECTION configurable, off by default.
+
+ * *.[ch]: Warning elimination, code cleanup, some 64-bit
+ safeguarding.
+
+ * sol2.h: More bullet-proofing for Sun bugs in header files.
+
+ * lib-src/etags.c: etags version 12.19.
+
+ * lisp/x11/x-select.el:
+ * src/xselect.c: Try STRING if selection owner couldn't convert
+ COMPOUND_TEXT.
+
+ * src/*.c: Change defalt to default_, and in general allow
+ doc-snarfing functions to recognize and ignore trailing `_'
+
+ * src/*.[ch]: Introduce XVECTOR_DATA and XVECTOR_LENGTH macros and
+ convert source code to use them consistently.
+
+1997-07-08 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta12 is released.
+
+1997-07-08 Martin Buchholz <mrb@eng.sun.com>
+
+ * configure.in: Set options differently, depending on beta-ness of
+ build tree.
+ * *Makefile*: Clean up *clean: targets, esp. Steven's beloved
+ distclean.
+
+1997-07-08 Steven L Baur <steve@altair.xemacs.org>
+
+ * pkg-src/tree-x/Makefile.in.in (xoobr): Pass CFLAGS to the
+ linker.
+ From Olivier Galibert <Olivier.Galibert@mines.u-nancy.fr>
+
+1997-07-07 Steven L Baur <steve@altair.xemacs.org>
+
+ * pkg-src/tree-x/Makefile.in.in (distclean): Add target.
+
+1997-07-06 Steven L Baur <steve@altair.xemacs.org>
+
+ * lwlib/lwlib-Xm.c (xm_update_one_value): Hand application of mrb
+ fix. Restoration of lossage from beta10->beta11 upgrade.
+
+ * XEmacs 20.3-beta11 is released.
+
+1997-07-08 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * lisp/language/english.el: Add quail-british for British.
+
+ * lisp/language/european.el: Register input-method for various non
+ quail-latin-1 methods.
+
+1997-07-05 Martin Buchholz <mrb@eng.sun.com>
+
+ * lib-src/getopt*.c: Don't redefine const - let configure do that.
+
+ * configure.in: Better behavior for `configure --with-gcc=no'
+ - Autodetect ulimit.h
+ - Remove broken SunOS4 kludge for libXmu
+ - Autodetect usleep
+
+ * src/s/sol2.h: Support gcc on various Solaris releases.
+
+ * lib-src/*.c: Ansify prototypes.
+
+ * lisp/prim/files.el: Optimize auto-mode-alist.
+
+ * pkg-src/tree-x/Makefile.in.in: `make distclean' now works
+ - `make install' now works.
+ - dependencies updated.
+
+ * pkg-src/tree-x/*.[ch]: Fix compile warnings.
+ - Replace uses of XtVa* with non-varargs variants.
+
+1997-07-01 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * lisp/modes/image-mode.el: Add `image-maybe-restore' to
+ `change-major-mode-hook'.
+
+ * lisp/modes/image-mode.el (image-maybe-restore): New function.
+
+ * src/glyphs.c (make_string_from_file): must protect from
+ `format-alist'.
+
+1997-06-30 Steven L Baur <steve@altair.xemacs.org>
+
+ * pkg-src/tree-x/Makefile.in.in (INSTALL): Add configure written
+ variable.
+
+1997-06-29 Steven L Baur <steve@altair.xemacs.org>
+
+ * configure.in (CPP): Correct typo `print-lib-gcc-file-name'
+ should be `print-libgcc-file-name'
+ From Katsumi Yamaoka <yamaoka@ga.sony.co.jp>
+
+ * XEmacs 20.3-beta10 is released.
+
+1997-06-29 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * lisp/language/chinese.el: Add chinese-isoir165 (CCITT Extended
+ GB).
+
+ * lisp/language/chinese.el: Modify charset DOC-strings for CNS
+ 11643 to be more detailed.
+
+ * lisp/language/arabic.el: Rename `arabic-0', `arabic-1' and
+ `arabic-2' to `arabic-digit', `arabic-1-column' and
+ `arabic-2-column' to sync with Emacs/mule-19.34.94-zeta.
+
+ * src/mule-charset.c: Modify charset DOC-strings to be more
+ detailed.
+
+ Use BOX DRAWINGS characters of JIS X0208.
+
+1997-06-28 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * lisp/apel/richtext.el: Add autoload comments for
+ `richtext-encode' and `richtext-decode'.
+
+ * lisp/prim/format.el (format-alist): Add `text/richtext'.
+
+ * lisp/tl/chartblxmas.el: New file.
+
+ * lisp/x11/x-menubar.el (default-menubar): Add "Show character
+ table" for MULE menu.
+
+ * lisp/apel/emu.el: Check richtext.el is bundled.
+
+ * lisp/tl/char-table.el (view-charset): New command.
+
+ * lisp/tl/char-table.el: Rename some functions.
+
+ * lisp/packages/hexl.el (hexl-mode-exit): Run
+ `hexl-mode-exit-hook'.
+
+ * lisp/x11/x-menubar.el (default-menubar): Fix "Describe language
+ support" and "Set language environment" of mule menu.
+
+ * lisp/apel/file-detect.el: Add autoload comments for function
+ `add-path', `add-latest-path', `get-latest-path',
+ `file-installed-p', `exec-installed-p', `module-installed-p' and
+ variable `exec-suffix-list'.
+
+ * lisp/prim/format.el (format-alist): Add image/jpeg, image/gif,
+ image/png and image/x-xpm.
+
+ * lisp/modes/image-mode.el: New file.
+
+1997-06-27 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * lisp/tm/tm-ew-e.el (tm-eword::encode-string-1): avoid infinite
+ loop caused by long non-encoded-word element. (cf. [tm-en:1356])
+
+ (mime/field-encoding-method-alist): Add "Message-ID" as ignored.
+
+1997-06-25 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta9 is released.
+
+ * Makefile.in (dist): Make `make dist' work for me.
+
+1997-06-25 Martin Buchholz <mrb@eng.sun.com>
+
+ * configure.in:
+ - Change "t" to tabs in sed commands
+ - Add /g to sed substitition commands when appropriate
+ - Change XtVa[SG]etValue to Xt[SG]etValue
+ - Make version variables into Lisp_Objects.
+
+1997-06-19 Martin Buchholz <mrb@eng.sun.com>
+
+ * src/config.h.in:
+ * configure.in:
+ - Autodetect X defines using xmkmf.
+ - Compute rpath on *bsd* systems as well.
+ - rewrite PRINT_VAR m4 macro.
+ - detect sizes of void* and long long for future use by unex*.c
+ * regex.c: _GNU_SOURCE may be defined by config.h; don't redefine.
+
+1997-06-24 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * lisp/language/arabic.el: moved from lisp/mule/arabic-hooks.el.
+
+ * lisp/mh-e/mh-e.el (mh-get-new-mail): Decode output as
+ `mh-folder-coding-system'.
+
+1997-06-24 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * lisp/language/ethio-util.el: imported from
+ Emacs/mule-19.34.94-zeta.
+
+ * lisp/language/arabic-util.el: moved from lisp/mule/arabic.el;
+ repair Arabic characters.
+
+1997-06-24 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * lib-src/update-autoloads.sh: Search lisp/mule/.
+
+ * etc/HELLO: final byte for ethiopic was changed to sync with
+ Emacs/mule-19.34.94-zeta.
+
+ * lisp/x11/x-menubar.el: Fix "Describe language support" and "Set
+ language environment" of Mule menu.
+
+ * lisp/language/visual-mode.el: moved from mule/.
+
+ * lisp/language/ethiopic.el: Modify for XEmacs.
+
+ * lisp/language/cyrillic.el: Modify DOC-string of koi8-r; Fixed
+ problem of setting for `language-info-alist' about koi8-r.
+
+ * lisp/mule/auto-autoloads.el: Enable auto-autoloads.el for mule/.
+
+ * lisp/mule/mule-util.el: New file (imported from
+ Emacs/mule-19.34.94-zeta).
+
+ * lisp/mule/mule-misc.el: Function `truncate-string-to-width' was
+ moved to mule-util.el.
+
+ * lisp/prim/dumped-lisp.el, lisp/mule/mule-load.el:
+ lisp/mule/arabic-hooks.el was moved to lisp/language/arabic.el;
+ lisp/mule/arabic.el was moved to lisp/language/arabic-util.el; Use
+ lisp/language/ethiopic.el instead of lisp/mule/ethiopic-hooks.el;
+ Use lisp/language/ethio-util.el instead of lisp/mule/ethiopic.el.
+
+ * lisp/mule/mule-coding.el (coding-system-docstring): New alias to
+ emulate Emacs/mule-19.34.94-zeta function.
+
+ * lisp/mule/mule-cmds.el: modified to sync with
+ Emacs/mule-19.34.94-zeta (mule-prefix was changed to "C-x C-m")
+
+ (set-language-info): Add to "Describe Language Support" and "Set
+ Language Environment" menu.
+
+ * lisp/mule/mule-charset.el: Function `compose-region' and
+ `decompose-region' were moved to mule-util.el.
+
+ * lisp/leim/quail.el: modify to sync with latest quail.el of
+ Emacs/mule in ETL.
+
+ (quail-toggle-mode-temporarily): check `quail-conv-overlay'.
+
+ (quail-map-p): Use `characterp' instead of `integerp'.
+
+1997-06-23 Steven L Baur <steve@altair.xemacs.org>
+
+ * etc/NEWS (Commands): Various updates by Hrvoje Niksic.
+
+1997-06-21 Steven L Baur <steve@altair.xemacs.org>
+
+ * Makefile.in: Missing FRC.info.
+ (install-arch-dep): Add missing backslash.
+ From Glynn Clements <glynn@sensei.co.uk>
+
+ * XEmacs 20.3-beta8 is released.
+
+1997-06-20 Olivier Galibert <Olivier.Galibert@mines.u-nancy.fr>
+
+ * lwlib/lwlib-Xaw.c, lwlib/lwlib-Xlw.c, lwlib/lwlib-Xm.c,
+ lwlib/lwlib.c: Make 64 bit clean.
+
+1997-06-20 Steven L Baur <steve@altair.xemacs.org>
+
+ * etc/gnuserv.1: Updates and cleanup.
+ From Hrvoje Niksic <hniksic@srce.hr>
+
+1997-06-19 Martin Buchholz <mrb@eng.sun.com>
+
+ * configure.in:
+ - Autodetect X defines using xmkmf.
+ - Compute rpath on *bsd* systems as well.
+ - rewrite PRINT_VAR m4 macro.
+ - detect sizes of void* and long long for future use by unex*.c
+
+1997-06-18 Martin Buchholz <mrb@eng.sun.com>
+
+ * */Makefile.in.in: Another rewrite
+ Make makefiles immune from being mangled by various cpp
+ implementations by quoting non-preprocessor directive lines.
+ - random cleanup
+ - Use $(RM) and $(pwd) macros consistently
+ - Add dependencies for balloon-help source files
+ - Use getcwd by default instead of getwd.
+ * lwlib/config.h: Now includes src/config.h
+ * lwlib/*.c: Use config.h, but DON'T use Xos.h
+ * lib-src/*.c: Fix compiler warnings
+ * lisp/version.el:
+ - Put version information in version.sh instead of version.el
+
+Wed Jun 18 16:41:43 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * configure.in (CPP): Remove hardcoding of -L/usr/local/lib
+ -I/usr/local/include.
+
+1997-06-14 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta7 is released.
+
+1997-06-12 Steven L Baur <steve@altair.xemacs.org>
+
+ * etc/TUTORIAL (things): Synched by Hrvoje Niksic with previous
+ XEmacs version.
+
+1997-06-13 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * lisp/gnus/smiley.el (smiley-deformed-regexp-alist): Modify
+ regexp for horizontal smiley faces.
+ (smiley-nosey-regexp-alist): Add horizontal smiley faces.
+
+ * lisp/leim/quail.el (quail-get-translation): Don't use
+ `string-to-vector' for XEmacs.
+
+1997-06-13 Gary D. Foster <Gary.Foster@corp.Sun.COM>
+
+ * lisp/modes/*.el: Removed all "\177" bindings that were
+ previously commented out and normalized everything vis a vis
+ 'backspace and 'delete keysyms.
+ * lisp/packages/*.el: Normalized all the "\177" bindings
+ * lisp/modes/cperl-mode.el: Created cperl-electric-delete function
+ which is a "smart" version of the cperl-electric-backspace
+ function (it honors the desired delete direction). Bound it to
+ 'delete and the electric-backspace to 'backspace.
+ * lisp/packages/pending-del.el: Added cperl-electric-backspace and
+ cperl-electric-delete to the 'supersede list.
+
+1997-06-11 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-b6 is released.
+
+ * configure.in (GNU_MALLOC): Check for (-l)PW instead of (-l)-lPW.
+ Suggested by Martin Buchholz <mrb@eng.sun.com>
+
+1997-06-11 Martin Buchholz <mrb@eng.sun.com>
+
+ * src/Makefile.in:
+ * lwlib/Makefile.in:
+ * lib-src/Makefile.in:
+ * Makefile.in: More Makefile cleanup
+ - add .PHONY targets where necessary
+ - remove most builtin rules using .SUFFIXES
+ - -lXau only gets used for linking gnuserv binaries
+ - No VPATH for root Makefile
+ - remove gcc v1 support
+ * configure.in:
+ - A new test to autodetect need to define NARROWPROTO,
+ needed by XFree86
+ - Consistently use idiom foo=`echo '' $foo | sed -s 's:^ ::' -e ...`
+ - Immediately exit if SIZEOF_* tests fail.
+ - Check for libPW
+ - Use more sophisticated Xpm test that confirms xpm.h and libXpm
+ are in sync.
+ * src/s/linux.h:
+ * src/m/intel386.h: Yet another attempt to clean up linux defines.
+
+1997-06-10 Steven L Baur <steve@altair.xemacs.org>
+
+ * lib-src/pop.c: Correct incantation for pop.h.
+ From Martin Buchholz <mrb@Eng.Sun.COM>
+
+Tue Jun 10 15:11:16 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * configure.in (beta): Correct test looking for Beta number.
+
+1997-06-11 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * src/Makefile.in.in, mule/language/misc-lang.el,
+ mule/mule-load.el, mule/ipa-hooks.el: Use
+ lisp/mule/language/misc-lang.el instead of lisp/mule/ipa-hooks.el;
+ mule/ipa-hooks.el was deleted.
+
+1997-06-10 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * Use lisp/mule/language/thai-util.el instead of
+ lisp/mule/thai.el.
+
+ * lisp/custom/wid-edit.el: Add widget `coding-system' for mule.
+
+ * lisp/mule/thai-hooks.el, lisp/mule/mule-load.el: Use
+ lisp/mule/language/thai.el instead of lisp/mule/thai-hooks.el.
+
+ * lisp/mule/language/thai.el: modified for XEmacs.
+
+1997-06-09 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * lisp/mule/mule-load.el, src/Makefile.in.in: Use
+ lisp/mule/language/chinese.el, lisp/mule/language/cyrillic.el,
+ lisp/mule/language/european.el, lisp/mule/language/greek.el,
+ lisp/mule/language/japanese.el and lisp/mule/language/korean.el
+ instead of lisp/mule/chinese-hooks.el,
+ lisp/mule/cyrillic-hooks.el, lisp/mule/european-hooks.el,
+ lisp/mule/greek-hooks.el, lisp/mule/japanese-hooks.el and
+ lisp/mule/korean-hooks.el.
+
+ * lisp/mule/language/*.el was imported from
+ Emacs/mule-19.34.94-zeta.
+
+ * Use lisp/mule/language/china-util.el instead of
+ lisp/mule/chinese.el.
+
+1997-06-08 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * lisp/apel/emu-x20.el (mime-charset-coding-system-alist):
+ iso-8859-1, hz-gb-2312, cn-gb-2312, gb2312, cn-big5 and koi8-r
+ were defined as coding-system.
+
+1997-06-08 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * etc/smilies/Face_smile.xbm, etc/smilies/Face_weep.xbm,
+ etc/smilies/Face_ase2.xbm, etc/smilies/Face_ase3.xbm,
+ etc/smilies/Face_ase.xbm: Add Japanese smiley faces.
+
+1997-06-07 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * lisp/gnus/smiley.el (smiley-deformed-regexp-alist): Add Japanese
+ smiley faces.
+
+1997-06-10 Gary D. Foster <Gary.Foster@corp.sun.com>
+
+ * lisp/modes/view-less.el: Changed \177 bindings to 'delete
+ * lisp/modes/help.el: Changed \177 bindings to 'delete
+
+1997-06-10 Gary D. Foster <Gary.Foster@corp.sun.com>
+
+ * lisp/prim/keydefs.el: Changed all 'delete key bindings to point to
+ the `backward-or-forward-foo' functions.
+ * lisp/prim/simple.el:
+ - Renamed `delete-erases-forward' to `delete-key-deletes-forward'.
+ - Removed `backspace-or-delete-hook'
+ - Renamed `backspace-or-delete' to `backward-or-forward-delete-char'
+ - Added functions: `backward-or-forward-kill-word'
+ `backward-or-forward-kill-sentence'
+ `backward-or-forward-kill-sexp'
+ - Removed the zmacs hacks from all the `b-or-f-foo' functions and
+ began playing nicely with pending-del.
+ * lisp/modes/cc-mode.el:
+ * lisp/modes/cperl-mode.el: Fixed references to delete functions
+ to use the new names.
+
+1997-06-09 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-b5 is released.
+
+1997-06-08 Steven L Baur <steve@altair.xemacs.org>
+
+ * etc/NEWS: Updates for early beta20.3 stuffs.
+ From Hrvoje Niksic <hniksic@srce.hr>
+
+1997-06-05 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-b4 is released.
+
+1997-06-04 Martin Buchholz <mrb@eng.sun.com>
+
+ * src/*/*.h: Remove definitions of HAVE_UNION_WAIT, in accordance
+ with new Autoconf 2 mechanisms.
+ * src/syswait.h:
+ * src/sysdep.c:
+ * src/process.c: Use only Posix.1 sys/wait.h-defined symbols
+
+ * src/s/netbsd.h: complete rewrite, use ORDINARY_LINK, #ifdef out
+ old cruft that can be obtained from system header files.
+ * lib-src/getopt*: Synch with FSF, remove compiler warnings.
+
+ * lib-src/b2m.c:
+ * src/gifalloc.c:
+ * lib-src/gnuslib.c:
+ * lib-src/profile.c:
+ * lib-src/movemail.c: Fix compiler warnings
+
+ * lib-src/Makefile.in.in: Remove unused -DCONFIG_BROKETS flag
+ - Fix up compile flags for new etags version
+
+ * etc/NEWS:
+ * etc/etags.1:
+ * man/xemacs/programs.texi:
+ * lib-src/etags.c: Upgraded to etags 12.11
+
+ * src/config.h.in: Fix inline keyword support
+
+ * configure.in: Use a different mechanism for removing extra white
+ space. Avoid using foo=`echo $bar`, which loses with various echos.
+ - new M4 macro XE_SPACE(var, words...)
+ - Use autoconf 2's AC_HEADER_SYS_WAIT
+ - Check for Xpm-XpmFree instead of Xpm-XpmReadFileToData to avoid
+ linking with losing Xpm implementations
+ - Check for correct wnn4 lib symbols
+ - Only link with inline.o when using gcc
+ - Support inline keywords inline, __inline, __inline__
+ - Ultrix now implies have_mmap=no
+ - Sun sound in non-standard dirs now works
+ - --native-sound-lib no longer ignored on HP & SGI
+ - gpm configure tests moved after curses configure tests
+
+1997-06-04 Gary D. Foster <Gary.Foster@corp.sun.com>
+
+ * lisp/modes/cc-mode.el: Modified `c-electric-delete' to honor the
+ desired delete direction in both normal and "hungry" modes.
+ * lisp/modes/cperl-mode.el: Modified `cperl-electric-backspace' to
+ honor the desired delete direction.
+
+1997-05-30 Martin Buchholz <mrb@eng.sun.com>
+
+ * configure.in: Automagically compute -R path for gcc
+
+1997-05-30 Gary D. Foster <Gary.Foster@corp.sun.com>
+
+ * lisp/vm/vm-vars.el: Fixed delete key binding to call
+ `vm-scroll-down'
+
+Thu May 29 15:35:07 1997 Martin Buchholz <mrb@eng.sun.com>
+
+ * configure.in: Add support for Solaris2.6 -z ignore linker flags
+
+1997-05-29 Martin Buchholz <mrb@eng.sun.com>
+
+ * configure.in: Replace standard Autoconf MMAP test with Neal
+ Becker's replacement, hacked somewhat.
+
+1997-05-16 Gary D. Foster <Gary.Foster@corp.sun.com>
+
+ * lisp/prim/simple.el: Created `backspace-or-delete' function and
+ `backspace-or-delete-hook'
+ * lisp/prim/keydefs.el: Changed \177 bindings to point to new
+ delete function.
+ * lisp/modes/*.el: Removed conflicting \177 bindings.
+ * lisp/modes/cc-mode.el: Modified `c-electric-delete' to use new
+ delete bindings.
+ * lisp/modes/cperl-mode.el: Modified `cperl-electric-backspace' to
+ use new delete bindings.
+
+1997-06-03 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * lisp/x11/x-menubar.el (default-menubar): Add menu for Mule.
+
+ * lisp/mule/mule-cmds.el: Menu for XEmacs were moved to
+ x11/x-menubar.el.
+
+1997-06-03 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * lisp/leim/quail.el: to avoid compiling warnings about
+ overlay.el.
+
+1997-06-03 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * lisp/leim/quail.el: to sync with quail.el of
+ Emacs-19.34.94-zeta.
+
+ * lisp/leim/quail/ziranma.el, lisp/leim/quail/tonepy.el,
+ lisp/leim/quail/py.el, lisp/leim/quail/qj.el,
+ lisp/leim/quail/sw.el, lisp/leim/quail/ccdospy.el,
+ lisp/leim/quail/punct.el, lisp/leim/quail/4corner.el,
+ lisp/leim/quail/symbol-ksc.el, lisp/leim/quail/ethiopic.el,
+ lisp/leim/quail/hanja.el, lisp/leim/quail/quick-cns.el,
+ lisp/leim/quail/tsangchi-cns.el, lisp/leim/quail/lrt.el,
+ lisp/leim/quail/tsangchi-b5.el, lisp/leim/quail/devanagari.el,
+ lisp/leim/quail/japanese.el, lisp/leim/quail/quick-b5.el,
+ lisp/leim/quail/punct-b5.el, lisp/leim/quail/qj-b5.el,
+ lisp/leim/quail/py-b5.el, lisp/leim/quail/ctlau.el,
+ lisp/leim/quail/ctlaub.el, lisp/leim/quail/ecdict.el,
+ lisp/leim/quail/array30.el, lisp/leim/quail/hangul3.el,
+ lisp/leim/quail/hanja-jis.el, lisp/leim/quail/cyrillic.el,
+ lisp/leim/quail/etzy.el, lisp/leim/quail/greek.el,
+ lisp/leim/quail/ipa.el, lisp/leim/quail/lao.el,
+ lisp/leim/quail/zozy.el, lisp/leim/quail/viqr.el,
+ lisp/leim/quail/latin.el, lisp/leim/quail/thai.el,
+ lisp/leim/quail/hangul.el: quail of LEIM for Emacs-19.34.94-zeta.
+
+1997-06-02 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mule/korean.el was abolished because it seems not to be used.
+
+ * mule/japanese.el was abolished because it seems not to be used.
+
+1997-06-01 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * lisp/tm/gnus-mime-old.el was abolished because XEmacs 20.3 has
+ Gnus 5.4.
+
+ * lisp/tm/tm-edit.el: updated to 7.108.
+
+ * lisp/tm/tm-view.el: updated to 7.83.
+
+ * lisp/leim/quail.el: modified for XEmacs.
+
+ * lisp/mule/mule-load.el, lisp/mule/mule-process.el: delete
+ mule-process.el because it is not used.
+
+ * lisp/mule/european.el was abolished because it seems not to be
+ used.
+
+ * lisp/mule/mule-load.el: must load mule-cmds before setting for
+ language-environment.
+
+ * lisp/mule/european-hooks.el: Modified for LEIM.
+
+ * lisp/mule/mule-cmds.el: Uncomment key definition for
+ `toggle-input-method'.
+
+ * lisp/mule/mule-init.el: Comment out about `mule-keymap' (moved
+ to mule-cmds.el).
+
+ * lisp/mule/mule-cmds.el: Uncomment about `mule-keymap' (moved
+ from mule-init.el).
+
+ * lisp/tl/tl-atype.el: Don't require tl-str.
+
+ * lisp/tl/tl-atype.el: Use atype.el of APEL.
+
+ * lisp/tl/tl-list.el: Use alist.el of APEL.
+
+1997-05-31 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * lisp/tl/richtext.el, lisp/tl/emu-x20.el, lisp/tl/emu-xemacs.el,
+ lisp/tl/emu.el, lisp/tl/emu-e19.el: moved to apel/.
+
+ * lisp/tl/file-detect.el, lisp/tl/filename.el: replaced by APEL's.
+
+ * lisp/mu/std11-parse.el, lisp/mu/std11.el: moved to apel/.
+
+ * lisp/leim/quail.el: Add new quail.el (imported from Emacs
+ 19.34.94-epsilon).
+
+ * lisp/leim/skk/skkdic.el: delete skkdic.el temporary because
+ XEmacs can not compile it.
+
+ * lisp/leim/skk/skkdic.el, lisp/leim/quail/zozy.el,
+ lisp/leim/quail/ziranma.el, lisp/leim/quail/viqr.el,
+ lisp/leim/quail/tsangchi-cns.el, lisp/leim/quail/tsangchi-b5.el,
+ lisp/leim/quail/symbol-ksc.el, lisp/leim/quail/thai.el,
+ lisp/leim/quail/tonepy.el, lisp/leim/quail/quick-cns.el,
+ lisp/leim/quail/sw.el, lisp/leim/quail/qj-b5.el,
+ lisp/leim/quail/qj.el, lisp/leim/quail/quick-b5.el,
+ lisp/leim/quail/py-b5.el, lisp/leim/quail/py.el,
+ lisp/leim/quail/lao.el, lisp/leim/quail/latin.el,
+ lisp/leim/quail/lrt.el, lisp/leim/quail/punct-b5.el,
+ lisp/leim/quail/punct.el, lisp/leim/quail/hanja-jis.el,
+ lisp/leim/quail/hanja.el, lisp/leim/quail/ipa.el,
+ lisp/leim/quail/japanese.el, lisp/leim/quail/hangul3.el,
+ lisp/leim/quail/etzy.el, lisp/leim/quail/greek.el,
+ lisp/leim/quail/hangul.el, lisp/leim/quail/ethiopic.el,
+ lisp/leim/quail/devanagari.el, lisp/leim/quail/ecdict.el,
+ lisp/leim/quail/ctlau.el, lisp/leim/quail/ctlaub.el,
+ lisp/leim/quail/cyrillic.el, lisp/leim/quail/array30.el,
+ lisp/leim/quail/ccdospy.el, lisp/leim/quail/4corner.el: Add LEIM
+ elisp files; old lisp/quail was abolished.
+
+ * src/Makefile.in.in: Add mule-cmds.elc.
+
+ * lisp/mule/mule-load.el, lisp/mule/mule-cmds.el: Add mule-cmds.el
+ (imported from Emacs-19.34.94-epsilon and comment out a lot to
+ avoid conflict with mule-init.el or other XEmacs/mule files).
+
+ * lisp/prim/simple.el (assoc-ignore-case): New function; imported
+ from Emacs-19.34.94-epsilon.
+
+1997-05-29 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta3 is released.
+
+ * INSTALL: Delete documentation of mocklisp support.
+
+ * configure.in: Delete mocklisp support.
+
+ * etc/FTP: Update mirror info.
+
+ * etc/DISTRIB: Update mirror info.
+
+1997-05-29 Martin Buchholz <mrb@eng.sun.com>
+
+ * configure.in: Replace standard Autoconf MMAP test with Neal
+ Becker's replacement, hacked somewhat.
+
+1997-05-28 Martin Buchholz <mrb@eng.sun.com>
+
+ * lisp/prim/files.el (auto-mode-alist): Reorg auto-mode-alist again.
+
+ * lib-src/etags.c: Version 12.7 from Francesco.
+
+ * configure.in: Juggle link order of X libraries.
+ Add support for using zsh to run configure.
+ Document --with-tty=no.
+ Fix -no-recursion option.
+ Recognize and ignore --cache-file option.
+ Recognize null values for preprocessor symbols converted to shell
+ variables. This maybe fixes the "-ltermcap" problem.
+ Remove spurious blanks from various SUBST-ituted variables.
+ Fix conditional creation of gdbinit.
+ Conditionally create .sbinit for Sunpro C.
+
+1997-05-26 Steven L Baur <steve@altair.xemacs.org>
+
+ * etc/FTP: Correct typo in ftp.cenatls.cena.dgac.fr.
+
+ * etc/DISTRIB: Ditto.
+
+1997-05-22 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-beta2 is released.
+
+Thu May 22 04:19:09 1997 Martin Buchholz <mrb@eng.sun.com>
+
+ * configure.in: Try to fix all reported bugs with 20.3-b1.
+ Change HAVE_WNN6 to WNN6. WNN6 correctly autodetected.
+ extra-verbose now default on beta builds.
+ extra-verbose now much more verbose.
+ Don't set libs_termcap to " ".
+ Detect -lXm AFTER detecting -lXpm.
+ Use runtime paths before running tests, since AC_TRY_RUN may
+ depend on it.
+ with-xim=motif only default on Solaris.
+ realpath moved from s&m to configure.in.
+ xemacs-version.h removed. main_1 now contains $canonical as well,
+ for even more useful backtraces.
+ termcap handling rewritten.
+ Create .sbinit for Sun's source browser.
+ Warn user if no XPM support present.
+ Warn user if compiling in error checking.
+
+ * Makefile.in: use MAKE_SUBDIR consistently. Remove references to
+ dynodump. Remove core when cleaning. Remove config.log.
+ make distclean now functional.
+
+Tue Jun 4 10:15:54 1996 Per Bothner <bothner@deneb.cygnus.com>
+
+ * etc/e/eterm.ti: Add kcub1, kcuf1, kcuu1, kcud1 capabilities.
+
+Sun May 18 13:03:20 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * lwlib/Makefile.in.in (distclean): Clean up config.h.
+
+ * Makefile.in (distclean): Remve config.log.
+ remove broken dynodump stuffs.
+
+Sat May 17 20:30:54 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.3-b1 is released.
+
+Fri May 16 20:38:19 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * info/dir (Packages): Update minor version number.
+
+ * etc/README: Update minor version number.
+
+ * README: Update minor version number.
+
+Tue May 13 20:35:52 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs-20.2 is released.
+
+Sat May 10 16:14:30 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.2-b6 is released.
+
+Thu May 8 20:22:34 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.2-b5 is released.
+
+Fri May 2 16:50:02 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.2-b4 is released.
+
+Thu May 1 18:13:38 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * configure.in (--with-xim): Don't default it to Motif since it
+ causes crashes at startup on some systems.
+
+Sun Apr 27 12:25:55 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.2-b3 is released.
+
+Wed Apr 23 10:33:58 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.2-b2 is released.
+
+ * configure.in (beta): OPENWINHOME misspelled.
+
+Mon Apr 21 14:48:29 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * etc/BETA (writing): Update with information about how to create
+ patches.
+
+Sat Apr 19 16:13:16 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.2-b1 is released.
+
+Thu Apr 17 21:33:59 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * configure.in (beta): SONY NEWS-OS has /etc/osversion and not
+ uname.
+
+Wed Apr 16 17:44:05 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.1 is re-released.
+
+Tue Apr 15 21:03:22 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.1 is released.
+
+Sat Apr 12 20:11:08 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.1-b15 is released.
+
+Sat Apr 12 09:01:32 1997 Hrvoje Niksic <hniksic@srce.hr>
+ * PROBLEMS: I have cleaned up a bit the PROBLEMS file, by:
+ 1) changing it into sections -- there is now a section for building,
+ running and compatibility problems
+
+ 2) removing some obviously obsolete entries -- e.g. those pertaining
+ to Emacs 18, etc. --> size is off by 20K
+
+ 3) Rearranging the entries by relevance. I have tried to put the most
+ relevant entries in front.
+
+Thu Apr 10 19:07:26 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.1-b14 is released. (Beta 13 was skipped).
+
+Wed Apr 9 22:52:06 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.1-b12 is released.
+
+Sun Apr 6 22:31:00 1997 Tatsuya Ichikawa <ichikawa@hv.epson.co.jp>
+
+ * configure.in: Cosmetic change to summary print of POP/Kerberos/
+ Hesiod options.
+
+Sat Apr 5 09:11:36 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.1-b11 is released.
+
+Wed Apr 2 15:27:35 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * Makefile.in (install-only): New target. Functionality suggested
+ by Larry Schwimmer, correct way of doing it suggested by Chuck
+ Thompson.
+
+ * configure.in: Default to "-Olimit 2000" as suggested by Jamie
+ Zawinski for SGI cc and Irix 6.
+
+Tue Apr 1 12:23:13 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * configure.in: Add configuration parameters for Emacs 19.34
+ movemail.c (--with-pop, --with-kerberos, --with-hesiod).
+
+Fri Mar 28 19:58:41 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * configure.in: Remove garbage if [ ... ] constructs and a
+ mispatch.
+
+Thu Mar 27 18:24:19 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.1-b10 is released.
+
+Wed Mar 26 22:31:10 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * Remove vms top-level directory.
+
+ * XEmacs 19.15 final released to beta testers.
+
+Tue Mar 25 19:13:27 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 19.15 prefinal released to beta testers.
+
+Mon Mar 24 12:28:17 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * configure.in (--debug): Correct documentation.
+
+Sun Mar 23 17:24:38 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 19.15-b104 is released.
+
+Sat Mar 22 19:56:36 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * etc/sgml/CATALOG: Default to html-3.2final.
+
+Sat Mar 22 17:55:15 1997 Darrell Kindred <dkindred@cmu.edu>
+
+ * configure.in (beta): Add configure support for the -rpath flag
+ for IRIX analogous to the Solaris "-R".
+
+Sat Mar 22 16:47:08 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * info/dir (Packages): Add HM-HTML-Mode to menu.
+
+Sat Mar 22 21:27:41 1997 Tomasz J. Cholewo <t.cholewo@ieee.org>
+
+ * configure.in: Echo only current configuration using 'tee -a'.
+
+Fri Mar 21 21:26:01 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs-19.15-b103 is released.
+ * XEmacs-20.0-b9 is released.
+
+ * Makefile.in (top_distclean): Add `Installation' to distclean
+ rule.
+
+Fri Mar 21 20:05:29 1997 Darrell Kindred <dkindred@cmu.edu>
+
+ * Makefile.in (autoloads): Pass $(MAKE) to update-elc.sh and
+ update-autoloads.sh.
+
+Thu Mar 20 20:14:16 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs-19.15-b102 is released.
+
+Tue Mar 18 21:52:36 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs-19.15-b101 is released.
+
+Mon Mar 17 19:09:29 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs-20.1-b8 is released.
+ * XEmacs-19.15-b100 is released.
+
+Sat Mar 15 17:15:18 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs-20.1-b7 is released.
+ * XEmacs-19.15-b99 is released.
+
+ * etc/sgml/CATALOG: Added IE3 DTDs and htmlpro DTD.
+
+Thu Mar 13 10:40:11 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * configure.in: Add sunos4-1-4 header files.
+
+Wed Mar 12 18:53:08 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * configure.in: Use new file bsdos3.h with BSDI 3.0.
+
+Sat Mar 8 15:19:33 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs-20.1-b6 is released.
+ * XEmacs-19.15-b98 is released.
+
+Wed Mar 5 18:55:36 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * Makefile.in (install-arch-indep): Offer to compress lisp sources.
+ (gzip-el): New targe for compressed installed lisp sources.
+
+Tue Mar 4 23:28:37 1997 Martin Buchholz <mrb@eng.sun.com>
+
+ * lib-src/update-elc.sh: VM is compiled after the byte-compiler,
+ but before anything else. More flexible about finding an xemacs
+ to use for byte-compilation (default src/xemacs). Other minor fixes.
+
+Mon Mar 3 23:57:56 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.1-b5 is released.
+
+Mon Mar 3 18:09:17 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.1-b4 is released.
+
+Sat Mar 1 15:38:30 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * Makefile.in (distclean): Correct typos.
+
+ * XEmacs 19.15-b96 is released.
+
+ * configure.in: Symlink site-lisp when using --srcdir.
+ Add special handling of lisp directory to allow for multiple
+ site-packages files.
+
+Fri Feb 28 20:38:46 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * Makefile.in (distclean): Create lock and site-lisp directories
+ when they don't exist (after being pruned by CVS).
+
+Tue Mar 4 00:41:38 1997 Hrvoje Niksic <hniksic@srce.hr>
+
+ * etc/sample.Xdefaults: Added customization of foreground and
+ background colors for the `default' face.
+
+Wed Feb 26 22:12:12 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * Makefile.in (top_distclean): Reset src/PURESIZE.h for
+ distribution.
+
+ * XEmacs 20.1-b3 is released.
+
+Sun Feb 23 17:10:09 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.1-b2 is released.
+
+Sat Feb 22 14:29:44 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 19-15-b'95 is released.
+
+Fri Feb 21 22:29:51 1997 Martin Buchholz <mrb@eng.sun.com>
+
+ * etc/toolbar/workshop-cap-up.xpm: Moved caption up one pixel.
+
+ * lwlib/xlwscrollbar.c : Fix many scrollbar bugs:
+ - "knob" renamed to "slider"
+ - leftmost pixel wasn't sensitive to button clicks, while righmost
+ pixel was.
+ - many glitches fixed if Emacs*XlwScrollBar.ArrowPosition:same:
+ - goobers on top of up-arrow removed.
+ - up-arrow would not always be redrawn when necessary
+ - slider drag would be `off' by size of up-arrow
+ - horizontal and vertical scrollbars didn't use exactly the same
+ dimensions.
+ - slider was never drawn if XlwScrollBar.shadowThickness was 0.
+ - Now up- and down-arrows actually work near beginning/end of buffer!
+
+Thu Feb 20 12:40:57 1997 Jan Vroonhof <vroonhof@math.ethz.ch>
+
+ * configure.in (with_xauth): Attempted correction of test for
+ libXmu on SunOS.
+
+Sat Feb 15 14:11:03 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.1-b1 is released.
+ * XEmacs 19.15-b94 is released.
+
+Fri Feb 14 23:23:03 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * README: ``This directory tree holds version 19.13 ...'' ???
+
+Sun Feb 9 16:15:55 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 19.15-b93 is released.
+ XEmacs 20.0 is released to the 'net.
+
+Fri Feb 7 19:21:34 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.0try3 is released.
+
+Wed Feb 5 18:03:06 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.0try2 is released.
+
+Mon Feb 3 19:39:08 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 19.15-b92 is released.
+
+Sat Feb 1 18:17:38 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.0try1 is released.
+ * XEmacs 19.15-b91 AKA XEmacs '97 NOT! is released.
+
+Sat Feb 1 00:00:48 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * PROBLEMS: Updated from beta test bug reports.
+ Put in outline-mode/outl-mouse-minor-mode by default.
+
+Wed Jan 29 19:59:41 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * CHANGES-beta: XEmacs 20.0-b93 is released.
+
+Sat Jan 25 15:43:59 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * CHANGES-beta: XEmacs 20.0-b92 is released.
+
+Fri Jan 24 09:54:01 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * lwlib/xlwmenu.c (massage_resource_name): Changed comparison of
+ char and pointer.
+
+Thu Jan 23 10:39:34 1997 Martin Buchholz <mrb@eng.sun.com>
+
+ * lib-src/update-elc.sh (ignore_dirs): Quoting portability.
+
+Wed Jan 22 21:07:17 1997 Steven L Baur <steve@altair.xemacs.org>
+ * XEmacs 20.0-b91 (prerelease 2) is released.
+
+ * configure.in (--with-scrollbars): Add Athena3d as a toolkit
+ type.
+
+ * lwlib/lwlib-Xaw.c (xaw_update_one_widget): Let Athena 3d have 0
+ borderwidth.
+ (xaw_scrollbar_scroll): Use SCROLLBAR_LINE_UP and
+ SCROLLBAR_LINE_DOWN since that's current the only to get to the
+ bottom of the buffer. :-(
+
+Tue Jan 21 20:01:19 1997 Steven L. Baur <steve@altair.xemacs.org>
+
+ * configure.in (beta): Add LWLIB_USES_ATHENA for odd
+ configurations that use both Motif and Athena.
+
+ * etc/sgml/HTML32.dtd: html-3.2 final dtd added.
+
+Wed Jan 15 12:55:19 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * info/dir (Gnus): Updated spelling and info.
+
+Mon Jan 13 13:37:27 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * configure.in: Remove assignment of NON_GNU_CPP for irix-6.0.
+
+Mon Jan 13 00:36:01 1997 Martin Buchholz <mrb@eng.sun.com>
+
+ * lib-src/make-docfile.c (scan_lisp_file): eliminate doc-string
+ warnings for ccl-read-*
+
+Sat Jan 11 12:05:31 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * etc/sample.emacs: Remove code snippet that wipes out the cycle
+ buffer modeline feature.
+
+ * XEmacs 20.0 beta90 (prerelease 1) is released.
+ * XEmacs 19.15 beta90 (prerelease 1) is released.
+
+Tue Jan 7 08:45:16 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * configure.in (LIBS): Revise test for XFree86 (look for XF86Config).
+
+Sat Jan 4 14:52:57 1997 Steven L Baur <steve@altair.xemacs.org>
+ * XEmacs 20.0 beta 34 is released.
+ * XEmacs 19.15 beta 7 is released.
+
+Fri Jan 3 15:18:59 1997 Jeff Miller <jmiller@smart.net>
+
+ * lwlib/Makefile.in.in: lwlib is required if X11 is used.
+
+Wed Jan 1 08:30:48 1997 Martin Buchholz <mrb@eng.sun.com>
+
+ * src/emacs.c: Make sure
+ `./temacs -batch -l loadup.el run-temacs <emacs-args>'
+ works properly
+
+ * src/Makefile.in.in (rtcmacs): Add support for RTC, Sun's
+ competitor to Purify.
+
+ * man/lispref/symbols.texi: Fix up bit vector documentation
+ * man/lispref/sequences.texi: Fix up bit vector documentation
+
+ * lisp/sunpro/sunpro-load.el: Only preload mime-setup for Sun.
+
+ * lisp/prim/update-elc.el: Don't rely on autoloads.
+
+Tue Dec 31 09:46:13 1996 Martin Buchholz <mrb@eng.sun.com>
+
+ * lisp/prim/auto-autoloads.el: New, completely program-generated, file
+ * lib-src/update-autoloads.sh: Rewritten to use auto-autoloads.el.
+ * lisp/utils/autoload.el: Reorganization of autoload mechanism:
+ Errors during autoload generation are just that - errors.
+
+ Generated autoloads are now in a separate file of their own.
+
+ Reliability of autoload generation greatly increased.
+
+ Distribution smaller by about 100k.
+
+ `make autoloads' is still the preferred mechanism for update.
+
+ Autoloads are always regenerated completely from scratch. This
+ avoids errors with obsolete or corrupted autoload entries.
+
+ Caching of autoload entries using timestamps has been eliminated.
+
+ Files that have no autoloads no longer have a comment placed into
+ the generated autoloads file.
+
+ There was a bug where autoload entries would sometimes end up
+ being inserted into the *middle* of other autoload entries,
+ thereby corrupting them.
+
+ * src/event-Xt.c: Remove SUNOS_GCC_L0_BUG kludge.
+
+Sun Dec 29 05:37:43 1996 Martin Buchholz <mrb@eng.sun.com>
+
+ * lib-src/update-autoloads.sh: Make sure that `make autoloads'
+ doesn't use the autoload facility to load `autoload';
+ load it explicity instead.
+
+ * lib-src/update-elc.sh (ignore_dirs): ignore SCCS, CVS, RCS dirs
+
+ * man/Makefile: Reinstate hyperbole & oo-browser manuals
+
+ * lisp/modes/mail-abbrevs.el: Apply patch originated from Noah Friedman
+
+ * src/mule-charset.c: Use lower case for charset registry, to
+ match XLFD.
+
+ * Makefile.in: replace list of info files with *.info* - one less
+ maintenance headache
+
+ * etc/sample.emacs: Add sample code to highlight continuation glyph
+
+ * man/oo-browser.texi: Fix TeXability
+
+ * man/hyperbole.texi: Fix TeXability
+
+ * man/vhdl-mode.texi: Fix TeXability
+
+ * lisp/prim/loaddefs.el: Wholesale housecleaning
+ `make autoloads' should finally work.
+
+ * lib-src/emacsclient.c (main): ANSIfication, compiler warning removal
+
+ * lisp/mule/mule-files.el: Add support for multi-lingual info files.
+
+ * lib-src/update-elc.sh: `make all-elc' was updating files in
+ `special' directories without using the Makefiles
+ designed for that purpose.
+ - make sure ilisp isn't remade every time through `make all-elc'.
+
+ * info/dir (Packages): Add Japanese TM info files
+
+ * src/inline.c: Allow compilation with `gcc -g'
+
+ * src/syntax.c (word_constituent_p): Allow compilation with `gcc -g'
+
+ * src/lread.c: Don't put `...' immediately after a filename, so
+ that various tools can recognize the filename as such.
+
+ * src/event-Xt.c (x_to_emacs_keysym): Fix crash when
+ --with-xim=xlib and key event on window frame.
+ Change return foo to return (foo) when return is a macro.
+
+ * src/editfns.c (Ffollowing_char): docstring fixes.
+
+ * man/tm/Makefile: Add support for Japanese TM info (but not dvi) files.
+ This Makefile is no longer officially broken.
+
+ * info/dir: Add Japanese tm documents.
+
+ * man/tm/tm-vm-en.texi: Make document TeX-friendly.
+
+ * lib-src/update-autoloads.sh (EMACS): Don't rely on non-portable
+ xargs -i flag.
+
+ * lisp/mule/mule-files.el (file-coding-system-alist): Make sure
+ the `binary' coding system is used for .gz and .Z extensions.
+
+ * man/viper.texi: Viper version 2.90
+
+ * man/ediff.texi: Ediff Version 2.62
+
+ * lisp/packages/ispell.el (ispell-word): Avoid using strings with
+ define-key, for compatibility with loaddefs.el
+
+ * lisp/modes/eiffel3.el: Make compatible with update-autoloads.
+
+ * lisp/ilisp/Makefile (elc): Add target to avoid re-compilation.
+
+ * lib-src/update-elc.sh: XEmacs sometimes re-byte-compiled elisp
+ files in dirs that have their own Makefiles.
+
+
+
+Sun Dec 29 17:02:49 1996 Steven L Baur <steve@altair.xemacs.org>
+
+ * Makefile.in (install-arch-indep): Force compression with `gzip -f'.
+
+ * lib-src/update-elc.sh (NUMTOCOMPILE): Ignore CVS directories.
+
+ * Makefile.in (install-arch-indep): Catch .info-[0-9]* files for
+ installation.
+
+Sat Dec 28 15:33:27 1996 Steven L Baur <steve@altair.xemacs.org>
+
+ * XEmacs 20.0 beta 33 is released.
+ * XEmacs 19.15 beta 6 is released.
+
+Fri Dec 27 20:34:58 1996 Richard Mlynarik <mly@adoc.xerox.com>
+
+ * etc/yow.lines: 20k of new zippy quotes.
+
+Fri Dec 27 01:02:41 1996 Martin Buchholz <mrb@eng.sun.com>
+
+ * Makefile.in (install-arch-indep): Simplify installation of info
+ pages.
+
+Sat Dec 21 15:20:20 1996 Steven L Baur <steve@altair.xemacs.org>
+ * XEmacs 20.0-b32 released.
+
+ * XEmacs 19.15-b5 released.
+
+Wed Dec 18 20:22:08 1996 Martin Buchholz <mrb@eng.sun.com>
+
+ * configure.in: Reformat. Fix shared include file rename
+ problem.
+
+ * configure: Reformat. Fix shared include file rename problem.
+
+ * dynodump/dynodump.c (__EXTENSIONS__): Define it.
+
+Thu Dec 12 13:19:00 1996 Joseph J Nuspl <nuspl@nvwls.cc.purdue.edu>
+
+ * Makefile.in (install-arch-indep): Install infofiles gzipped by
+ default.
+
+Tue Dec 10 19:25:25 1996 Steven L Baur <steve@altair.xemacs.org>
+
+ * CHANGES-beta: XEmacs 20.0-b31 is released.
+
+Tue Dec 10 18:33:19 1996 Rod Whitby <rwhitby@asc.sps.mot.com>
+
+ * info/vhdl-mode.info: New file.
+
+ * info/dir (Packages): Add vhdl-mode documentation.
+
+Tue Dec 10 18:27:02 1996 Martin Buchholz <mrb@Eng.Sun.COM>
+
+ * configure: Make shared/dynamic flags work much more logically.
+
+Tue Dec 10 09:17:22 1996 David Worenklein <dcw@gcm.com>
+
+ * configure.in (machine): Patch to make newly renamed shared
+ link include files work.
+
+Sat Dec 7 16:28:10 1996 Martin Buchholz <mrb@Eng.Sun.COM>
+
+ * configure.in: Configure for POSIX getcwd if available.
+
+Thu Dec 5 20:42:35 1996 Steven L Baur <steve@altair.xemacs.org>
+
+ * etc/edt-user.doc (File): New file from Emacs 19.34.
+
+Thu Dec 5 11:56:05 1996 Joseph J Nuspl <nuspl@nvwls.cc.purdue.edu>
+
+ * configure.in (LIBS): Fix typo in dialog box test.
+
+
--- /dev/null
+## DIST: This is the distribution Makefile for XEmacs. configure can
+## DIST: make most of the changes to this file you might want, so try
+## DIST: that first.
+
+## 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.
+
+## make all to compile and build XEmacs.
+## make install to build and install it.
+## make install-only to install after a previous complete build
+## make TAGS to update tags tables.
+
+## make clean or make mostlyclean
+## Delete all files from the current directory that are normally
+## created by building the program. Don't delete the files that
+## record the configuration. Also preserve files that could be made
+## by building, but normally aren't because the distribution comes
+## with them.
+
+## Delete `.dvi' files here if they are not part of the distribution.
+
+## make distclean
+## Delete all files from the current directory that are created by
+## configuring or building the program. If you have unpacked the
+## source and built the program without creating any other files,
+## `make distclean' should leave only the files that were in the
+## distribution.
+
+## make realclean
+## Delete everything from the current directory that can be
+## reconstructed with this Makefile. This typically includes
+## everything deleted by distclean, plus more: C source files
+## produced by Bison, tags tables, info files, and so on.
+
+## make extraclean
+## Still more severe - delete backup and autosave files, too.
+
+#ifdef USE_GNU_MAKE
+RECURSIVE_MAKE=$(MAKE)
+#else
+@SET_MAKE@
+RECURSIVE_MAKE=@RECURSIVE_MAKE@
+#endif
+
+SHELL = /bin/sh
+LANG = C
+RM = rm -f
+pwd = /bin/pwd
+
+## ==================== Things `configure' Might Edit ====================
+
+CC=@CC@
+CPP=@CPP@
+LN_S=@LN_S@
+CFLAGS=@CFLAGS@
+CPPFLAGS=@CPPFLAGS@
+
+## These help us choose version- and architecture-specific directories
+## to install files in.
+
+## This should be the number of the XEmacs version we're building,
+## like `19.12' or `19.13'.
+version=@version@
+
+## This should be the name of the configuration we're building XEmacs
+## for, like `mips-dec-ultrix' or `sparc-sun-sunos'.
+configuration=@configuration@
+
+## This will be the name of the generated binary and is set automatically
+## by configure.
+PROGNAME=@PROGNAME@
+
+## ==================== Where To Install Things ====================
+
+## The default location for installation. Everything is placed in
+## subdirectories of this directory. The default values for many of
+## the variables below are expressed in terms of this one, so you may
+## not need to change them. This defaults to /usr/local.
+prefix=@prefix@
+
+## Like `prefix', but used for architecture-specific files.
+exec_prefix=@exec_prefix@
+
+## Where to install XEmacs and other binaries that people will want to
+## run directly (like etags).
+bindir=@bindir@
+
+## Where to install architecture-independent data files.
+## ${lispdir} and ${etcdir} are subdirectories of this.
+datadir=@datadir@
+
+## Where to find XEmacs packages.
+pkgdir=@pkgdir@
+
+## Where to install and expect the files that XEmacs modifies as it runs.
+## These files are all architecture-independent. Right now, the
+## only such data is the locking directory;
+## ${lockdir} is a subdirectory of this.
+statedir=@statedir@
+
+## Where to install and expect executable files to be run by XEmacs
+## rather than directly by users, and other architecture-dependent data
+## ${archlibdir} is a subdirectory of this.
+libdir=@libdir@
+
+## Where to install XEmacs's man pages, and what extension they should have.
+mandir=@mandir@
+manext=.1
+
+## Where to install and expect the info files describing XEmacs. In the
+## past, this defaulted to a subdirectory of ${prefix}/lib/xemacs, but
+## since there are now many packages documented with the texinfo
+## system, it is inappropriate to imply that it is part of XEmacs.
+infodir=@infodir@
+
+## Document me.
+## See callproc.c for code which references this.
+infopath=@infopath@
+
+## Where to find the source code. The source code for XEmacs's C kernel is
+## expected to be in ${srcdir}/src, and the source code for XEmacs's
+## utility programs is expected to be in ${srcdir}/lib-src. This is
+## set by the configure script's `--srcdir' option.
+srcdir=@srcdir@
+
+## Where the build is done.
+blddir=@blddir@
+
+## ==================== XEmacs-specific directories ====================
+
+## These variables hold the values XEmacs will actually use. They are
+## based on the values of the standard Make variables above.
+
+## Where to install the lisp files distributed with
+## XEmacs. This includes the XEmacs version, so that the
+## lisp files for different versions of XEmacs will install
+## themselves in separate directories.
+lispdir=@lispdir@
+
+## Directory XEmacs should search for lisp files specific
+## to this site (i.e. customizations), before consulting
+## ${lispdir}.
+sitelispdir=@sitelispdir@
+
+## Where XEmacs will search for its lisp files while
+## building. This is only used during the process of
+## compiling XEmacs, to help XEmacs find its lisp files
+## before they've been installed in their final location.
+## It's usually identical to lispdir, except that the
+## entry for the directory containing the installed lisp
+## files has been replaced with ../lisp. This should be a
+## colon-separated list of directories.
+buildlispdir=${srcdir}/lisp
+
+## Where to install the other architecture-independent
+## data files distributed with XEmacs (like the tutorial,
+## the cookie recipes and the Zippy database). This path
+## usually contains the XEmacs version number, so the data
+## files for multiple versions of XEmacs may be installed
+## at once.
+etcdir=@etcdir@
+
+## Where to create and expect the locking directory, where
+## the XEmacs locking code keeps track of which files are
+## currently being edited.
+lockdir=@lockdir@
+
+## 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
+## for multiple versions of XEmacs may be installed at
+## once.
+archlibdir=@archlibdir@
+
+## ==================== Utility Programs for the Build ====================
+
+## Allow the user to specify the install program.
+INSTALL = @install_pp@ @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+
+## ============================= Targets ==============================
+
+## Subdirectories to make recursively. `lisp' is not included
+## because the compiled lisp files are part of the distribution
+## and you cannot remake them without installing XEmacs first.
+MAKE_SUBDIR = @MAKE_SUBDIR@
+
+## Subdirectories that can be made recursively.
+SUBDIR = ${MAKE_SUBDIR} man
+
+## The makefiles of the directories in ${MAKE_SUBDIR}.
+SUBDIR_MAKEFILES = @SUBDIR_MAKEFILES@
+
+## Subdirectories to `make install-arch-dep' recursively
+INSTALL_ARCH_DEP_SUBDIR = @INSTALL_ARCH_DEP_SUBDIR@
+
+## Subdirectories to install, and where they'll go.
+## lib-src's makefile knows how to install it, so we don't do that here.
+## When installing the info files, we need to do special things to
+## avoid nuking an existing dir file, so we don't do that here;
+## 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_LISP = lisp/finder-inf.el
+
+all: ${PROGNAME} all-elc info
+
+${PROGNAME}: ${GENERATED_HEADERS} ${MAKE_SUBDIR} ${GENERATED_LISP}
+
+## For performance and consistency, no built-in rules
+.SUFFIXES:
+
+.NO_PARALLEL: ${GENERATED_HEADERS} ${MAKE_SUBDIR} dump-elcs
+.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
+
+## Convenience target for XEmacs maintainers
+## This would run `make-xemacsdist' if I were really confident that everything
+## was turnkey.
+dist: all-elc info
+
+## Convenience target for XEmacs maintainers
+## Updates some rarely generated files:
+## - configure from configure.in
+## - config.values.in from configure
+## - src/depend from src/*.[ch]
+.PHONY: config configure depend
+config: configure depend
+configure: ${srcdir}/configure
+${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
+
+## 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
+
+## 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
+
+custom-loads:
+ MAKE='$(MAKE)' EMACS='./src/$(PROGNAME)' sh ${srcdir}/lib-src/update-custom.sh
+
+finder: src
+ @echo "Building finder database ..."
+ @(cd ./lisp; \
+ ${blddir}/src/${PROGNAME} -batch -vanilla \
+ -eval '(setq finder-compile-keywords-quiet t)' \
+ -l finder -f finder-compile-keywords )
+ @echo "Building finder database ...(done)"
+
+lisp/finder-inf.el:
+ @echo "Building finder database ..."
+ @(cd ./lisp; \
+ ${blddir}/src/${PROGNAME} -batch -vanilla \
+ -eval '(setq finder-compile-keywords-quiet t)' \
+ -l finder -f finder-compile-keywords )
+ @echo "Building finder database ...(done)"
+
+## We have to force the building of Emacs.ad.h as well in order to get it
+## updated correctly when VPATH is being used. Since we use move-if-change,
+## it will only actually change if the user modified ${etcdir}/Emacs.ad.
+src/Emacs.ad.h: ${srcdir}/etc/Emacs.ad
+ @echo "Producing \`src/Emacs.ad.h' from \`etc/Emacs.ad'."
+ @$(RM) src/Emacs.ad.h
+ @(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 ) > \
+ 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!" ; \
+ echo " Automatically generated by XEmacs */" ; \
+ echo "#define SHEAP_ADJUSTMENT 0") > $@
+
+src: @SRC_SUBDIR_DEPS@ FRC.src
+pkg-src/tree-x: pkg-src/FRC.tree-x
+lib-src: FRC.lib-src
+lwlib: FRC.lwlib
+dynodump: FRC.dynodump
+FRC.src FRC.lib-src FRC.lwlib FRC.dynodump pkg-src/FRC.tree-x:
+FRC.lisp.finder-inf.el:
+
+${SUBDIR}: ${SUBDIR_MAKEFILES} ${GENERATED_HEADERS} FRC
+ cd ./$@ && $(RECURSIVE_MAKE) all
+
+Makefile: ${srcdir}/Makefile.in config.status
+ ./config.status
+
+src/Makefile: ${srcdir}/src/Makefile.in.in ${srcdir}/src/depend config.status
+ ./config.status
+
+lib-src/Makefile: ${srcdir}/lib-src/Makefile.in.in config.status
+ ./config.status
+
+lwlib/Makefile: ${srcdir}/lwlib/Makefile.in.in config.status
+ ./config.status
+
+pkg-src/tree-x/Makefile: ${srcdir}/pkg-src/tree-x/Makefile.in.in config.status
+ ./config.status
+
+src/config.h: ${srcdir}/src/config.h.in
+ ./config.status && touch $@
+
+src/paths.h: ${srcdir}/src/paths.h.in
+ ./config.status && touch $@
+
+lwlib/config.h: ${srcdir}/lwlib/config.h.in
+ ./config.status && touch $@
+
+## ==================== Installation ====================
+
+## If we let lib-src do its own installation, that means we
+## don't have to duplicate the list of utilities to install in
+## this Makefile as well.
+
+## On AIX, use tar xBf.
+## On Xenix, use tar xpf.
+
+.PHONY: install-only install install-arch-dep install-arch-indep gzip.el mkdir
+.PHONY: check-features
+
+## We delete each directory in ${COPYDESTS} before we copy into it;
+## that way, we can reinstall over directories that have been put in
+## place with their files read-only (perhaps because they are checked
+## into RCS). In order to make this safe, we make sure that the
+## source exists and is distinct from the destination.
+
+## FSF doesn't depend on `all', but rather on ${MAKE_SUBDIR}, so that
+## they "won't ever modify src/paths.h". But that means you can't do
+## 'make install' right off the bat because src/paths.h won't exist.
+## And, in XEmacs case, src/Emacs.ad.h won't exist either. I also
+## don't see the point in avoiding modifying paths.h. It creates an
+## inconsistency in the build process. So we go ahead and depend on
+## all. --cet
+
+check-features: all
+ ${blddir}/src/${PROGNAME} -batch -l check-features.el
+
+install-only: ${MAKE_SUBDIR} check-features install-arch-dep install-arch-indep
+
+install: all check-features install-arch-dep install-arch-indep
+
+install-arch-dep: mkdir
+ for subdir in ${INSTALL_ARCH_DEP_SUBDIR}; do \
+ (cd ./$${subdir} && $(RECURSIVE_MAKE) install prefix=${prefix} \
+ exec_prefix=${exec_prefix} bindir=${bindir} libdir=${libdir} \
+ archlibdir=${archlibdir}) ; done
+ if test "`(cd ${archlibdir} && $(pwd))`" != \
+ "`(cd ./lib-src && $(pwd))`"; then \
+ 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 ; \
+ 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
+ ${INSTALL_PROGRAM} src/${PROGNAME} ${bindir}/${PROGNAME}-${version}
+ -chmod 0755 ${bindir}/${PROGNAME}-${version}
+ cd ${bindir} && $(RM) ./${PROGNAME} && ${LN_S} ${PROGNAME}-${version} ./${PROGNAME}
+ if test "${prefix}" != "${exec_prefix}"; then \
+ for dir in \
+ lib/${PROGNAME} \
+ lib/${PROGNAME}-${version}/etc \
+ lib/${PROGNAME}-${version}/info \
+ lib/${PROGNAME}-${version}/lisp; do \
+ if test ! -d ${exec_prefix}/$${dir}; then \
+ $(LN_S) ${prefix}/$${dir} ${exec_prefix}/$${dir}; fi; \
+ done; \
+ fi
+
+install-arch-indep: mkdir info
+ -@set ${COPYDESTS} ; \
+ for dir in ${COPYDIR} ; do \
+ if test "`(cd $$1 && $(pwd))`" != \
+ "`(cd $${dir} && $(pwd))`"; then \
+ : do nothing - echo "rm -rf $$1" ; \
+ fi ; \
+ shift ; \
+ done
+ -set ${COPYDESTS} ; \
+ for dir in ${COPYDESTS} ; do \
+ if test ! -d $${dir} ; then mkdir $${dir} ; fi ; \
+ done ; \
+ for dir in ${COPYDIR} ; do \
+ dest=$$1 ; shift ; \
+ test -d $${dir} \
+ -a "`(cd $${dir} && $(pwd))`" != \
+ "`(cd $${dest} && $(pwd))`" \
+ && (echo "Copying $${dir}..." ; \
+ (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 \#* *~) ; \
+ done) ; \
+ done
+ if test "`(cd ${srcdir}/info && $(pwd))`" != \
+ "`(cd ${infodir} && $(pwd))`" && cd ${srcdir}/info; then \
+ if test ! -f ${infodir}/dir -a -f dir ; then \
+ ${INSTALL_DATA} ${srcdir}/info/dir ${infodir}/dir ; \
+ fi ; \
+ for file in *.info* ; do \
+ ${INSTALL_DATA} $${file} ${infodir}/$${file} ; \
+ 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} ; \
+ chmod 0644 ${mandir}/$${page}${manext} ; \
+ done
+ @echo "If you would like to save approximately 2M of disk space, do"
+ @echo "make gzip-el"
+ @echo "or you may run "
+ @echo ${srcdir}/lib-src/gzip-el.sh lispdir " from the command line."
+ @echo "Where lispdir is where the lisp files were installed, i.e.,"
+ @echo "${lispdir}"
+
+gzip-el:
+ ${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} \
+ ${mandir} ${bindir} ${datadir} ${libdir} ${pkgdir}
+ -chmod 0777 ${lockdir}
+
+## Delete all the installed files that the `install' target would
+## create (but not the noninstalled files such as `make all' would
+## create).
+
+#### Don't delete the lisp and etc directories if they're in the source tree.
+#### This target has not been updated in sometime and until it is it
+#### would be extremely dangerous for anyone to use it.
+##uninstall:
+## (cd ./lib-src; \
+## $(RECURSIVE_MAKE) uninstall \
+## prefix=${prefix} exec_prefix=${exec_prefix} \
+## bindir=${bindir} libdir=${libdir} archlibdir=${archlibdir})
+## for dir in ${lispdir} ${etcdir} ; do \
+## case `(cd $${dir} ; $(pwd))` in \
+## `(cd ${srcdir} ; $(pwd))`* ) ;; \
+## * ) $(RM) $${dir} ;; \
+## esac ; \
+## case $${dir} in \
+## ${datadir}/${PROGNAME}/${version}/* ) \
+## $(RM) -r ${datadir}/${PROGNAME}/${version} \
+## ;; \
+## esac ; \
+## done
+## cd ${infodir} && $(RM) cl* ${PROGNAME}* forms* info* vip*
+## cd ${mandir} && $(RM) xemacs.1 etags.1 ctags.1 gnuserv.1
+## cd ${bindir} && $(RM) ${PROGNAME}-${version} ${PROGNAME}
+
+
+## Some makes seem to remember that they've built something called FRC,
+## so you can only use a given FRC once per makefile.
+FRC FRC.src.paths.h FRC.mkdir FRC.dump-elcs FRC.info:
+FRC.mostlyclean FRC.clean FRC.distclean FRC.realclean FRC.tags:
+
+## ==================== Cleaning up and miscellanea ====================
+
+.PHONY: mostlyclean clean distclean realclean extraclean
+
+## `mostlyclean'
+## Like `clean', but may refrain from deleting a few files that people
+## normally don't want to recompile. For example, the `mostlyclean'
+## target for GCC does not delete `libgcc.a', because recompiling it
+## is rarely necessary and takes a lot of time.
+mostlyclean: FRC.mostlyclean
+ for d in $(SUBDIR); do (cd ./$$d && $(RECURSIVE_MAKE) $@); done
+
+## `clean'
+## Delete all files from the current directory that are normally
+## created by building the program. Don't delete the files that
+## record the configuration. Also preserve files that could be made
+## by building, but normally aren't because the distribution comes
+## with them.
+
+## Delete `.dvi' files here if they are not part of the distribution.
+clean: FRC.clean
+ for d in $(SUBDIR); do (cd ./$$d && $(RECURSIVE_MAKE) $@); done
+ $(RM) core
+
+## `distclean'
+## Delete all files from the current directory that are created by
+## configuring or building the program. If you have unpacked the
+## source and built the program without creating any other files,
+## `make distclean' should leave only the files that were in the
+## distribution.
+top_distclean=\
+ $(RM) config.status config.log config-tmp-* build-install Installation ; \
+ for d in src lib-src lwlib dynodump ; do \
+ $(RM) $$d/Makefile $$d/Makefile.in ; \
+ done ; \
+ $(RM) core .sbinit Makefile Makefile.in lock/*; \
+ $(RM) lisp/finder-inf.el* Installation.el Installation.elc; \
+ $(RM) packages mule-packages site-lisp
+
+distclean: FRC.distclean
+ for d in $(SUBDIR); do (cd ./$$d && $(RECURSIVE_MAKE) $@); done
+ -${top_distclean}
+
+## `realclean'
+## Delete everything from the current directory that can be
+## reconstructed with this Makefile. This typically includes
+## everything deleted by distclean, plus more: C source files
+## produced by Bison, tags tables, info files, and so on.
+
+## One exception, however: `make realclean' should not delete
+## `configure' even if `configure' can be remade using a rule in the
+## Makefile. More generally, `make realclean' should not delete
+## anything that needs to exist in order to run `configure' and then
+## begin to build the program.
+realclean: FRC.realclean
+ for d in $(SUBDIR); do (cd ./$$d && $(RECURSIVE_MAKE) $@); done
+ -${top_distclean}
+ $(RM) TAGS
+
+## This doesn't actually appear in the coding standards, but Karl
+## says GCC supports it, and that's where the configuration part of
+## the coding standards seem to come from. It's like distclean, but
+## it deletes backup and autosave files too.
+extraclean:
+ for d in $(SUBDIR); do (cd ./$$d && $(RECURSIVE_MAKE) $@); done
+ $(RM) *~ \#*
+ -${top_distclean}
+
+## Unlocking and relocking. The idea of these productions is to reduce
+## hassles when installing an incremental tar of XEmacs. Do `make unlock'
+## before unlocking the file to take the write locks off all sources so
+## that tar xvof will overwrite them without fuss. Then do `make relock'
+## afterward so that VC mode will know which files should be checked in
+## if you want to mung them.
+
+## Note: it's no disaster if these productions miss a file or two; tar
+## and VC will swiftly let you know if this happens, and it is easily
+## corrected.
+SOURCES = ChangeLog GETTING.GNU.SOFTWARE INSTALL Makefile.in PROBLEMS \
+ README build-install.in configure make-dist move-if-change
+
+.PHONY: unlock relock TAGS tags check dist info dvi mcs
+
+unlock:
+ chmod u+w $(SOURCES) cpp/*
+ -cd ./elisp && chmod u+w Makefile README *.texi
+ for d in src etc lib-src lisp; do (cd ./$$d && $(RECURSIVE_MAKE) $@); done
+ cd ./lisp/term && chmod u+w README *.el
+ cd ./man && chmod u+w *texi* ChangeLog split-man
+ cd ./lwlib && chmod u+w *.[ch] Makefile.in.in
+
+relock:
+ chmod u-w $(SOURCES) cpp/*
+ -cd ./elisp && chmod u-w Makefile README *.texi
+ for d in src etc lib-src lisp; do (cd ./$$d && $(RECURSIVE_MAKE) $@); done
+ cd ./lisp/term && chmod u+w README *.el
+ cd ./man && chmod u+w *texi* ChangeLog split-man
+ cd ./lwlib && chmod u+w *.[ch] Makefile.in.in
+
+PRUNE_VC = -name SCCS -prune -o -name RCS -prune -o -name CVS -prune -o
+tagslisp = lisp
+TAGS tags: FRC.tags
+ @echo "If you don't have a copy of etags around, then do 'make lib-src' first."
+ $(RM) ${srcdir}/TAGS
+ @PATH=`$(pwd)`/lib-src:$$PATH HOME=/-=-; export PATH HOME; \
+ echo "Using etags from `which etags`."
+ PATH=`$(pwd)`/lib-src:$$PATH ; export PATH; cd ${srcdir} && \
+ find src lwlib lib-src ${PRUNE_VC} -name '*.[ch]' -print | \
+ xargs etags -a -r '/[ ]*DEF\(VAR\|INE\)_[A-Z_]+[ ]*([ ]*"\([^"]+\)"/\2/'; \
+ find ${tagslisp} ${PRUNE_VC} -name '*.el' ! -name 'auto-autoloads.el' -print | \
+ xargs etags -a -l none -r "/^(def\\(var\\|un\\|alias\\|const\\|macro\\|subst\\|struct\\|face\\|group\\|custom\\|ine-\\(function\\|compiler-macro\\|[a-z-]+alias\\)\\)[ ]+'?\\([^ ]+\\)/\\3/"
+
+check:
+ cd ./src && $(RECURSIVE_MAKE) $@
+
+info: FRC.info
+ cd ${srcdir}/man && $(RECURSIVE_MAKE) $@
+
+dvi:
+ cd ${srcdir}/man && $(RECURSIVE_MAKE) $@
+
+## Fix up version information in executables (Solaris-only)
+mcs:
+ date=`LANG=C LC_ALL=C date -u '+%e %b %Y'`; \
+ ident="@(#)RELEASE VERSION XEmacs ${version} $${date}"; \
+ for f in `file lib-src/* src/${PROGNAME} | grep ELF | sed -e 's/:.*//'`; do \
+ mcs -da "$${ident} `echo $${f} | sed 's/.*\///'`" $${f}; \
+ done
--- /dev/null
+#! /bin/sh
+
+#### Configuration script for XEmacs. Largely divergent from FSF.
+#### Guess values for system-dependent variables and create Makefiles.
+#### Generated automatically using autoconf version 2.12
+#### Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#### Copyright (C) 1993-1995 Board of Trustees, University of Illinois.
+#### Copyright (C) 1996, 1997 Sun Microsystems, Inc.
+#### Copyright (C) 1995, 1996 Ben Wing.
+
+### Don't edit this script!
+### This script was automatically generated by the `autoconf' program
+### from the file `./configure.in'.
+### To rebuild it, execute the command
+### autoconf
+### in the this directory. You must have autoconf version 2.12 or later.
+
+### 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.
+
+### For usage, run `./configure --help'
+### For more detailed information on building and installing XEmacs,
+### read the file `INSTALL'.
+###
+### If configure succeeds, it leaves its status in config.status.
+### A log of configuration tests can be found in config.log.
+### If configure fails after disturbing the status quo,
+### config.status is removed.
+
+ac_help="$ac_help
+ --with-x use the X Window System"
+
+
+
+if test -n "$ZSH_VERSION"; then
+ setopt NO_BAD_PATTERN NO_BANG_HIST NO_BG_NICE NO_EQUALS NO_FUNCTION_ARGZERO
+ setopt GLOB_SUBST NO_HUP INTERACTIVE_COMMENTS KSH_ARRAYS NO_MULTIOS NO_NOMATCH
+ setopt RM_STAR_SILENT POSIX_BUILTINS SH_FILE_EXPANSION SH_GLOB SH_OPTION_LETTERS
+ setopt SH_WORD_SPLIT BSD_ECHO IGNORE_BRACES
+ if test -n "$CDPATH"; then CDPATH="."; export CDPATH; fi
+elif test -n "$BASH_VERSION"; then
+ set -o posix
+ unset CDPATH
+else
+ if test -n "$CDPATH"; then CDPATH="."; export CDPATH; fi
+fi
+
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${{exec_prefix}}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+subdirs=
+MFLAGS= MAKEFLAGS=
+ac_max_here_lines=12
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+ exec 6>/dev/null
+else
+ exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+ case "$ac_arg" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+ ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+ esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set. These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=src/lisp.h
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_prog=$0
+ ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+ test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+ else
+ { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+ fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ echo "loading site script $ac_site_file"
+ . "$ac_site_file"
+ fi
+done
+
+
+ac_ext=c
+xe_cppflags='$CPPFLAGS $c_switch_site $c_switch_machine $c_switch_system $c_switch_x_site $X_CFLAGS'
+xe_ldflags='$LDFLAGS $ld_switch_site $ld_switch_machine $ld_switch_system $ld_switch_x_site $ld_switch_run'
+xe_libs='$ld_call_shared $xe_check_libs $X_EXTRA_LIBS $libs_x $X_PRE_LIBS $LIBS $libs_machine $libs_system $libs_standard'
+ac_cpp='$CPP '"$xe_cppflags"
+ac_compile='${CC-cc} -c $CFLAGS '"$xe_cppflags"' conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest $CFLAGS '"$xe_cppflags $xe_ldflags"' conftest.$ac_ext '"$xe_libs"' 1>&5'
+cross_compiling=no
+
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+ # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+ if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+ ac_n= ac_c='
+' ac_t=' '
+ else
+ ac_n=-n ac_c= ac_t=
+ fi
+else
+ ac_n= ac_c='\c' ac_t=
+fi
+
+
+progname="`echo $0 | sed 's:^\./\./:\./:'`"
+
+
+MAKE_SUBDIR="$MAKE_SUBDIR lib-src" && if test "$extra_verbose" = "yes"; then echo " Appending \"lib-src\" to \$MAKE_SUBDIR"; fi
+INSTALL_ARCH_DEP_SUBDIR="$INSTALL_ARCH_DEP_SUBDIR lib-src" && if test "$extra_verbose" = "yes"; then echo " Appending \"lib-src\" to \$INSTALL_ARCH_DEP_SUBDIR"; fi
+
+prefix='/usr/local'
+exec_prefix='${prefix}'
+bindir='${exec_prefix}/bin'
+datadir='${prefix}/lib'
+statedir='${prefix}/lib'
+libdir='${exec_prefix}/lib'
+mandir='${prefix}/man/man1'
+infodir='${datadir}/${PROGNAME}-${version}/info'
+infopath=''
+install_pp=''
+lispdir='${datadir}/${PROGNAME}-${version}/lisp'
+pkgdir='${datadir}/${PROGNAME}-${version}/lisp'
+package_path=''
+etcdir='${datadir}/${PROGNAME}-${version}/etc'
+lockdir='${statedir}/${PROGNAME}/lock'
+archlibdir='${libdir}/${PROGNAME}-${version}/${configuration}'
+with_site_lisp='no'
+with_menubars=''
+with_scrollbars=''
+with_dialogs=''
+with_file_coding=''
+puresize=''
+cpp='' cppflags='' libs='' ldflags=''
+dynamic=''
+with_x11=''
+with_msw=''
+rel_alloc='default'
+with_system_malloc='default'
+with_dlmalloc='default'
+native_sound_lib=''
+use_assertions="yes"
+with_toolbars=""
+with_tty=""
+use_union_type="no"
+with_dnet=""
+
+
+
+
+arguments="$@"
+
+quoted_sed_magic=s/"'"/"'"'"'"'"'"'"'"/g
+quoted_arguments=
+for i in "$@"; do
+ case "$i" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *)
+ quoted_i="`echo '' $i | sed -e 's:^ ::' -e $quoted_sed_magic`"
+ quoted_arguments="$quoted_arguments '$quoted_i'" ;;
+ esac
+done
+
+while test $# != 0; do
+ arg="$1"; shift
+ case "$arg" in
+ --no-create|--no-recursion) ;;
+ -* )
+ case "$arg" in
+ -*=*)
+ opt=`echo '' $arg | sed -e 's:^ ::' -e 's:^-*\([^=]*\)=.*$:\1:'`
+ val=`echo '' $arg | sed -e 's:^ ::' -e 's:^-*[^=]*=\(.*\)$:\1:'`
+ valomitted=no
+ ;;
+ -*)
+ opt=`echo '' $arg | sed -e 's:^ ::' -e 's:^-*\(.*\)$:\1:'`
+ val="yes" valomitted=yes
+ ;;
+ esac
+
+ optname="$opt"
+ opt="`echo '' $opt | sed -e 's:^ ::' | tr - _`"
+
+ case "${valomitted}-${opt}" in yes-without_* )
+ opt=`echo $opt | sed 's/without/with/'`
+ valomitted="no" val="no" ;;
+ esac
+
+ case "$opt" in
+
+ run_in_place | \
+ with_site_lisp | \
+ with_x | \
+ with_x11 | \
+ with_msw | \
+ with_gcc | \
+ with_gnu_make | \
+ dynamic | \
+ with_ncurses | \
+ with_dnet | \
+ with_socks | \
+ with_dragndrop | \
+ with_cde | \
+ with_offix | \
+ with_gpm | \
+ with_xpm | \
+ with_xface | \
+ with_gif | \
+ with_jpeg | \
+ with_png | \
+ with_tiff | \
+ with_session | \
+ with_xmu | \
+ with_quantify | \
+ with_toolbars | \
+ with_tty | \
+ with_xfs | \
+ with_i18n3 | \
+ with_mule | \
+ with_file_coding | \
+ with_canna | \
+ with_wnn | \
+ with_wnn6 | \
+ with_workshop | \
+ with_sparcworks | \
+ with_tooltalk | \
+ with_ldap | \
+ with_pop | \
+ with_kerberos | \
+ with_hesiod | \
+ with_dnet | \
+ with_infodock | \
+ external_widget | \
+ verbose | \
+ extra_verbose | \
+ const_is_losing | \
+ usage_tracking | \
+ use_union_type | \
+ debug | \
+ use_assertions | \
+ use_minimal_tagbits | \
+ use_indexed_lrecord_implementation | \
+ gung_ho | \
+ use_assertions | \
+ memory_usage_stats | \
+ with_clash_detection | \
+ with_shlib | \
+ no_doc_file )
+ case "$val" in
+ y | ye | yes ) val=yes ;;
+ n | no ) val=no ;;
+ * ) (echo "$progname: Usage error:"
+echo " " "The \`--$optname' option requires a boolean value: \`yes' or \`no'."
+echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;;
+ esac
+ eval "$opt=\"$val\"" ;;
+
+
+ srcdir | \
+ compiler | \
+ cflags | \
+ cpp | \
+ cppflags | \
+ libs | \
+ ldflags | \
+ puresize | \
+ cache_file | \
+ native_sound_lib | \
+ site_lisp | \
+ x_includes | \
+ x_libraries | \
+ site_includes | \
+ site_libraries | \
+ site_prefixes | \
+ site_runtime_libraries )
+ if test "$valomitted" = "yes" ; then
+ if test "$#" = 0 ; then
+ (echo "$progname: Usage error:"
+echo " " "The \`--$optname' option requires a value."
+echo " Use \`$progname --help' to show usage.") >&2 && exit 1;
+ fi
+ val="$1"; shift
+ fi
+ eval "$opt=\"$val\""
+ ;;
+
+ rel_alloc | \
+ with_dlmalloc | \
+ with_debug_malloc | use_debug_malloc | \
+ with_system_malloc | use_system_malloc )
+ case "$val" in
+ y | ye | yes ) val=yes ;;
+ n | no ) val=no ;;
+ d | de | def | defa | defau | defaul | default ) val=default ;;
+ * ) (echo "$progname: Usage error:"
+echo " " "The \`--$optname' option requires one of these values:
+ \`yes', \`no', or \`default'."
+echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;;
+ esac
+ case "$opt" in use_* ) opt="`echo $opt | sed s/use/with/`" ;; esac
+ eval "$opt=\"$val\""
+ ;;
+
+ "with_database" )
+ with_database_berkdb=no
+ with_database_dbm=no
+ with_database_gnudbm=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:"
+echo " " "The \`--$optname' option value
+ must be either \`no' or a comma-separated list
+ of one or more of \`berkdb', \`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
+ (echo "$progname: Usage error:"
+echo " " "Only one of \`dbm' and \`gnudbm' may be specified
+ with the \`--$optname' option."
+echo " Use \`$progname --help' to show usage.") >&2 && exit 1
+ fi
+ ;;
+
+ "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;;
+ * ) (echo "$progname: Usage error:"
+echo " " "The \`--$optname' option must have one of these values:
+ \`native', \`nas', \`both', or \`none'."
+echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;;
+ esac
+ eval "$opt=\"$val\""
+ ;;
+
+ "with_xim" )
+ case "$val" in
+ y | ye | yes ) val=yes ;;
+ n | no | non | none ) val=no ;;
+ x | xl | xli | xlib ) val=xlib ;;
+ m | mo | mot | moti | motif ) val=motif ;;
+ * ) (echo "$progname: Usage error:"
+echo " " "The \`--$optname' option must have one of these values:
+ \`motif', \`xlib', \`yes', or \`no'."
+echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;;
+ esac
+ eval "$opt=\"$val\""
+ ;;
+
+ "with_xfs" )
+ case "$val" in
+ y | ye | yes ) val=yes ;;
+ n | no | non | none ) val=no ;;
+ * ) (echo "$progname: Usage error:"
+echo " " "The \`--$optname' option must have one of these values:
+ \`yes', or \`no'."
+echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;;
+ esac
+ eval "$opt=\"$val\""
+ ;;
+
+ "mail_locking" )
+ case "$val" in
+ lockf ) val=lockf ;;
+ flock ) val=flock ;;
+ file ) val=file ;;
+ * ) (echo "$progname: Usage error:"
+echo " " "The \`--$optname' option must have one of these values:
+ \`lockf', \`flock', or \`file'."
+echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;;
+ esac
+ eval "$opt=\"$val\""
+ ;;
+
+ "error_checking" )
+
+ for x in `echo "$val" | sed -e 's/,/ /g'` ; do
+ case "$x" in
+ n | no | non | none ) new_default=no ;;
+ a | al | all ) new_default=yes ;;
+
+ extents ) error_check_extents=yes ;;
+ noextents ) error_check_extents=no ;;
+
+ typecheck ) error_check_typecheck=yes ;;
+ notypecheck ) error_check_typecheck=no ;;
+
+ bufpos ) error_check_bufpos=yes ;;
+ nobufpos ) error_check_bufpos=no ;;
+
+ gc ) error_check_gc=yes ;;
+ nogc ) error_check_gc=no ;;
+
+ malloc ) error_check_malloc=yes ;;
+ nomalloc ) error_check_malloc=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'."
+ else
+ types="\`all', \`none' (default), \`extents', \`typecheck', \`bufpos', \`gc', and \`malloc'."
+ fi
+ (echo "$progname: Usage error:"
+echo " " "Valid types for the \`--$optname' option are:
+ $types."
+echo " Use \`$progname --help' to show usage.") >&2 && exit 1
+ elif test -n "$new_default" ; then
+ error_check_extents=$new_default
+ error_check_typecheck=$new_default
+ error_check_bufpos=$new_default
+ error_check_gc=$new_default
+ error_check_malloc=$new_default
+ new_default= # reset this
+ fi
+ echeck_notfirst=true
+ done
+ ;;
+
+
+ prefix | exec_prefix | bindir | datadir | statedir | libdir | \
+ mandir | infodir | infopath | lispdir | etcdir | lockdir | pkgdir | \
+ archlibdir | docdir | package_path )
+ if test "$valomitted" = "yes"; then
+ if test "$#" = 0; then
+ (echo "$progname: Usage error:"
+echo " " "The \`--$optname' option requires a value."
+echo " Use \`$progname --help' to show usage.") >&2 && exit 1;
+ fi
+ val="$1"; shift
+ fi
+ eval "$opt=\"$val\""
+
+ case "$opt" in
+ lispdir ) { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining LISPDIR_USER_DEFINED
+EOF
+cat >> confdefs.h <<\EOF
+#define LISPDIR_USER_DEFINED 1
+EOF
+}
+ ;;
+ etcdir ) { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining ETCDIR_USER_DEFINED
+EOF
+cat >> confdefs.h <<\EOF
+#define ETCDIR_USER_DEFINED 1
+EOF
+}
+ ;;
+ infodir ) { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining INFODIR_USER_DEFINED
+EOF
+cat >> confdefs.h <<\EOF
+#define INFODIR_USER_DEFINED 1
+EOF
+}
+ ;;
+ infopath ) { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining INFOPATH_USER_DEFINED
+EOF
+cat >> confdefs.h <<\EOF
+#define INFOPATH_USER_DEFINED 1
+EOF
+}
+ ;;
+ package_path ) { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining PACKAGE_PATH_USER_DEFINED
+EOF
+cat >> confdefs.h <<\EOF
+#define PACKAGE_PATH_USER_DEFINED 1
+EOF
+}
+ ;;
+ datadir )
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining INFODIR_USER_DEFINED
+EOF
+cat >> confdefs.h <<\EOF
+#define INFODIR_USER_DEFINED 1
+EOF
+}
+
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining LISPDIR_USER_DEFINED
+EOF
+cat >> confdefs.h <<\EOF
+#define LISPDIR_USER_DEFINED 1
+EOF
+}
+
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining ETCDIR_USER_DEFINED
+EOF
+cat >> confdefs.h <<\EOF
+#define ETCDIR_USER_DEFINED 1
+EOF
+}
+ ;;
+ statedir | lockdir ) { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining LOCKDIR_USER_DEFINED
+EOF
+cat >> confdefs.h <<\EOF
+#define LOCKDIR_USER_DEFINED 1
+EOF
+}
+ ;;
+ exec_prefix | libdir | archlibdir ) { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining ARCHLIBDIR_USER_DEFINED
+EOF
+cat >> confdefs.h <<\EOF
+#define ARCHLIBDIR_USER_DEFINED 1
+EOF
+}
+ ;;
+ esac
+ ;;
+
+ "no_create" ) ;;
+
+ "usage" | "help" ) ${PAGER-more} ${srcdir}/configure.usage; exit 0 ;;
+
+ "with_menubars" | "with_scrollbars" | "with_dialogs" )
+ 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'."
+echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;;
+ esac
+ eval "$opt=\"$val\""
+ ;;
+
+ * ) (echo "$progname: Usage error:"
+echo " " "Unrecognized option: $arg"
+echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;;
+
+ esac
+ ;;
+
+ *-*-*) configuration="$arg" ;;
+
+ *) (echo "$progname: Usage error:"
+echo " " "Unrecognized argument: $arg"
+echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;;
+
+ esac
+done
+
+
+test -n "$cpp" && CPP="$cpp"
+test -n "$cppflags" && CPPFLAGS="$cppflags"
+test -n "$libs" && LIBS="$libs"
+test -n "$ldflags" && LDFLAGS="$ldflags"
+
+eval set x "$quoted_arguments"; shift
+
+test "$extra_verbose" = "yes" && verbose=yes
+
+case "$site_includes" in *:* ) site_includes="`echo '' $site_includes | sed -e 's/^ //' -e 's/:/ /g'`";; esac
+case "$site_libraries" in *:* ) site_libraries="`echo '' $site_libraries | sed -e 's/^ //' -e 's/:/ /g'`";; esac
+case "$site_prefixes" in *:* ) site_prefixes="`echo '' $site_prefixes | sed -e 's/^ //' -e 's/:/ /g'`";; esac
+case "$site_runtime_libraries" in *:* ) site_runtime_libraries="`echo '' $site_runtime_libraries | sed -e 's/^ //' -e 's/:/ /g'`";; esac
+
+test -n "$with_x" && with_x11="$with_x"
+
+
+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
+ (echo "$progname: Usage error:"
+echo " " "--with-cde requires --with-tooltalk"
+echo " Use \`$progname --help' to show usage.") >&2 && exit 1
+elif test "$with_tooltalk" = "no" ; then with_cde=no
+elif test "$with_cde" = "yes"; then with_tooltalk=yes
+fi
+
+
+if test "$run_in_place" = "yes"; then
+ echo "configure: warning: "The --run-in-place option is ignored because it is unnecessary."" 1>&2
+fi
+
+case "$srcdir" in
+
+ "" )
+ for dir in "`echo $0 | sed 's|//|/|' | sed 's|/[^/]*$||'`" "." ".." ; do
+ if test -f "$dir/src/lisp.h" -a \
+ -f "$dir/lisp/version.el" ; then
+ srcdir="$dir"
+ break
+ fi
+ done
+ if test -z "$srcdir" ; then
+ (echo "$progname: Usage error:"
+echo " " "Neither the current directory nor its parent seem to
+ contain the XEmacs sources. If you do not want to build XEmacs in its
+ source tree, you should run \`$progname' in the directory in which
+ you wish to build XEmacs, using the \`--srcdir' option to say where the
+ sources may be found."
+echo " Use \`$progname --help' to show usage.") >&2 && exit 1
+ fi
+ ;;
+
+ * )
+ if test ! -f "$srcdir/src/lisp.h" -o \
+ ! -f "$srcdir/lisp/version.el" ; then
+ (echo "$progname: Usage error:"
+echo " " "The directory specified with the \`--srcdir' option,
+ \`$srcdir', doesn't seem to contain the XEmacs sources. You should
+ either run the \`$progname' script at the top of the XEmacs source
+ tree, or use the \`--srcdir' option to specify the XEmacs source directory."
+echo " Use \`$progname --help' to show usage.") >&2 && exit 1
+ fi
+ ;;
+esac
+
+if test -z "$configuration"; then
+ echo $ac_n "checking "host system type"""... $ac_c" 1>&6
+echo "configure:759: checking "host system type"" >&5
+ if configuration=`${CONFIG_SHELL-/bin/sh} $srcdir/config.guess | \
+ sed 's/^\([^-][^-]*-[^-][^-]*-[^-][^-]*\)-.*$/\1/'` ; then
+ echo "$ac_t""$configuration" 1>&6
+ else
+ echo "$ac_t""unknown" 1>&6
+ (echo "$progname: Usage error:"
+echo " " "XEmacs has not been ported to this host type.
+Try explicitly specifying the CONFIGURATION when rerunning configure."
+echo " Use \`$progname --help' to show usage.") >&2 && exit 1
+ fi
+fi
+
+echo $ac_n "checking whether ln -s works""... $ac_c" 1>&6
+echo "configure:773: checking whether ln -s works" >&5
+
+rm -f conftestdata
+if ln -s X conftestdata 2>/dev/null
+then
+ rm -f conftestdata
+ ac_cv_prog_LN_S="ln -s"
+else
+ ac_cv_prog_LN_S=ln
+fi
+LN_S="$ac_cv_prog_LN_S"
+if test "$ac_cv_prog_LN_S" = "ln -s"; then
+ echo "$ac_t""yes" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+for dir in lisp etc man info; do
+ if test ! -d "$dir" ; then
+ echo Making symbolic link to "$srcdir/$dir"
+ ${LN_S} "$srcdir/$dir" "$dir"
+ fi
+done
+
+absolute_pwd="`pwd`";
+if test -n "$PWD" -a "`cd $PWD && pwd`" = "$absolute_pwd"
+then blddir="$PWD"
+else blddir="$absolute_pwd"
+fi
+
+
+case "$srcdir" in
+ /* ) ;;
+ . ) srcdir="$blddir" ;;
+ * ) srcdir="`cd $srcdir && pwd`" ;;
+esac
+
+if test `pwd` != `sh -c cd $srcdir && pwd` \
+ && test -f "$srcdir/src/config.h"; then
+ (echo "$progname: WARNING: The directory tree \`$srcdir' is being used"
+ echo " as a build directory right now; it has been configured in its own"
+ echo " right. To configure in another directory as well, you MUST"
+ echo " use GNU make. If you do not have GNU make, then you must"
+ echo " now do \`make distclean' in $srcdir,"
+ echo " and then run $progname again.") >&2
+ extrasub='/^VPATH[ ]*=/c\
+vpath %.c $(srcdir)\
+vpath %.h $(srcdir)\
+vpath %.y $(srcdir)\
+vpath %.l $(srcdir)\
+vpath %.s $(srcdir)\
+vpath %.in $(srcdir)'
+fi
+
+. "$srcdir/version.sh" || exit 1;
+if test -n "$emacs_beta_version"; then beta=yes; else beta=no; fi
+: "${extra_verbose=$beta}"
+version="${emacs_major_version}.${emacs_minor_version}"
+{ test "$extra_verbose" = "yes" && cat << EOF
+ Defining EMACS_MAJOR_VERSION = $emacs_major_version
+EOF
+cat >> confdefs.h <<EOF
+#define EMACS_MAJOR_VERSION $emacs_major_version
+EOF
+}
+
+{ test "$extra_verbose" = "yes" && cat << EOF
+ Defining EMACS_MINOR_VERSION = $emacs_minor_version
+EOF
+cat >> confdefs.h <<EOF
+#define EMACS_MINOR_VERSION $emacs_minor_version
+EOF
+}
+
+if test -n "$emacs_beta_version"; then
+ version="${version}-b${emacs_beta_version}"
+ { test "$extra_verbose" = "yes" && cat << EOF
+ Defining EMACS_BETA_VERSION = $emacs_beta_version
+EOF
+cat >> confdefs.h <<EOF
+#define EMACS_BETA_VERSION $emacs_beta_version
+EOF
+}
+
+fi
+{ test "$extra_verbose" = "yes" && cat << EOF
+ Defining XEMACS_CODENAME = "$xemacs_codename"
+EOF
+cat >> confdefs.h <<EOF
+#define XEMACS_CODENAME "$xemacs_codename"
+EOF
+}
+
+{ test "$extra_verbose" = "yes" && cat << EOF
+ Defining EMACS_VERSION = "$version"
+EOF
+cat >> confdefs.h <<EOF
+#define EMACS_VERSION "$version"
+EOF
+}
+
+
+if test "$with_infodock" = "yes"; then
+ if test ! -f ../ID-INSTALL; then
+ echo "Cannot build InfoDock without InfoDock sources"
+ with_infodock=no
+ fi
+fi
+
+if test "$with_infodock" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << EOF
+ Defining INFODOCK_MAJOR_VERSION = $infodock_major_version
+EOF
+cat >> confdefs.h <<EOF
+#define INFODOCK_MAJOR_VERSION $infodock_major_version
+EOF
+}
+
+ { test "$extra_verbose" = "yes" && cat << EOF
+ Defining INFODOCK_MINOR_VERSION = $infodock_minor_version
+EOF
+cat >> confdefs.h <<EOF
+#define INFODOCK_MINOR_VERSION $infodock_minor_version
+EOF
+}
+
+ { test "$extra_verbose" = "yes" && cat << EOF
+ Defining INFODOCK_BUILD_VERSION = $infodock_build_version
+EOF
+cat >> confdefs.h <<EOF
+#define INFODOCK_BUILD_VERSION $infodock_build_version
+EOF
+}
+
+ version=${infodock_major_version}.${infodock_minor_version}.${infodock_build_version}
+ PROGNAME=infodock
+ CPPFLAGS="$CPPFLAGS -DINFODOCK"
+else
+ PROGNAME=xemacs
+fi
+
+if test -n "$emacs_beta_version"; then beta=yes; else beta=no; fi
+test "${error_check_extents=$beta}" = yes && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining ERROR_CHECK_EXTENTS
+EOF
+cat >> confdefs.h <<\EOF
+#define ERROR_CHECK_EXTENTS 1
+EOF
+}
+
+test "${error_check_typecheck=$beta}" = yes && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining ERROR_CHECK_TYPECHECK
+EOF
+cat >> confdefs.h <<\EOF
+#define ERROR_CHECK_TYPECHECK 1
+EOF
+}
+
+test "${error_check_bufpos=$beta}" = yes && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining ERROR_CHECK_BUFPOS
+EOF
+cat >> confdefs.h <<\EOF
+#define ERROR_CHECK_BUFPOS 1
+EOF
+}
+
+test "${error_check_gc=$beta}" = yes && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining ERROR_CHECK_GC
+EOF
+cat >> confdefs.h <<\EOF
+#define ERROR_CHECK_GC 1
+EOF
+}
+
+test "${error_check_malloc=$beta}" = yes && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining ERROR_CHECK_MALLOC
+EOF
+cat >> confdefs.h <<\EOF
+#define ERROR_CHECK_MALLOC 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
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining DEBUG_XEMACS
+EOF
+cat >> confdefs.h <<\EOF
+#define DEBUG_XEMACS 1
+EOF
+}
+
+fi
+test "$use_assertions" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining USE_ASSERTIONS
+EOF
+cat >> confdefs.h <<\EOF
+#define USE_ASSERTIONS 1
+EOF
+}
+
+test "$memory_usage_stats" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining MEMORY_USAGE_STATS
+EOF
+cat >> confdefs.h <<\EOF
+#define MEMORY_USAGE_STATS 1
+EOF
+}
+
+
+
+echo "checking "the configuration name"" 1>&6
+echo "configure:989: checking "the configuration name"" >&5
+internal_configuration=`echo $configuration | sed 's/-\(workshop\)//'`
+if canonical=`$srcdir/config.sub "$internal_configuration"` ; then : ; else
+ exit $?
+fi
+
+
+
+
+
+machine='' opsys=''
+
+case "$canonical" in
+ sparc-*-* ) machine=sparc ;;
+ alpha-*-* ) machine=alpha ;;
+ vax-*-* ) machine=vax ;;
+ mips-dec-* ) machine=pmax ;;
+ mips-sgi-* ) machine=iris4d ;;
+ romp-ibm-* ) machine=ibmrt ;;
+ rs6000-ibm-aix* ) machine=ibmrs6000 ;;
+ powerpc-ibm-aix* ) machine=ibmrs6000 ;;
+ powerpc*-* ) machine=powerpc ;;
+ hppa-*-* ) machine=hp800 ;;
+ m88k-dg-* ) machine=aviion ;;
+ m68*-sony-* ) machine=news ;;
+ mips-sony-* ) machine=news-risc ;;
+ clipper-* ) machine=clipper ;;
+esac
+
+case "$canonical" in
+ *-*-linux* ) opsys=linux ;;
+ *-*-netbsd* ) opsys=netbsd ;;
+ *-*-openbsd* ) opsys=openbsd ;;
+ *-*-nextstep* ) opsys=nextstep ;;
+ *-*-vms ) opsys=vms ;;
+
+ *-dec-osf1.3 | *-dec-osf2* ) opsys=decosf1-3 ;;
+ *-dec-osf1.2 | *-dec-osf1* ) opsys=decosf1-2 ;;
+ *-dec-osf3.[2-9] ) opsys=decosf3-2 ;;
+ *-dec-osf3* ) opsys=decosf3-1 ;;
+ *-dec-osf4* ) opsys=decosf4-0 ;;
+
+ *-*-ultrix[0-3].* | *-*-ultrix4.0* ) opsys=bsd4-2 ;;
+ *-*-ultrix4.[12]* ) opsys=bsd4-3 ;;
+ *-*-ultrix* ) opsys=ultrix4-3 ;;
+
+ *-*-aix3.1* ) opsys=aix3-1 ;;
+ *-*-aix3.2.5 ) opsys=aix3-2-5 ;;
+ *-*-aix3* ) opsys=aix3-2 ;;
+ *-*-aix4.2* ) opsys=aix4-2 ;;
+ *-*-aix4.1* ) opsys=aix4-1 ;;
+ *-*-aix4* ) opsys=aix4 ;;
+
+ *-gnu* ) opsys=gnu ;;
+ *-*-bsd4.[01] ) opsys=bsd4-1 ;;
+ *-*-bsd4.2 ) opsys=bsd4-2 ;;
+ *-*-bsd4.3 ) opsys=bsd4-3 ;;
+ *-*-aos4.2 ) opsys=bsd4-2 ;;
+ *-*-aos* ) opsys=bsd4-3 ;;
+ *-*-sysv0 | *-*-sysvr0 ) opsys=usg5-0 ;;
+ *-*-sysv2 | *-*-sysvr2 ) opsys=usg5-2 ;;
+ *-*-sysv2.2 | *-*-sysvr2.2 ) opsys=usg5-2-2 ;;
+ *-*-sysv3* | *-*-sysvr3* ) opsys=usg5-3 ;;
+ *-*-sysv4.1* | *-*-sysvr4.1* )opsys=usg5-4 NON_GNU_CPP=/usr/lib/cpp ;;
+ *-*-sysv4.[2-9]* | *-sysvr4.[2-9]* )
+ if test -z "$NON_GNU_CPP" ; then
+ for prog in "/usr/ccs/lib/cpp" "/lib/cpp"; do
+ if test -f "$prog"; then NON_GNU_CPP="$prog"; break; fi
+ done
+ fi
+ opsys=usg5-4-2 ;;
+ *-sysv4* | *-sysvr4* ) opsys=usg5-4 ;;
+ *-*-mach_bsd4.3* ) opsys=mach-bsd4-3 ;;
+esac
+
+case "$canonical" in
+
+ *-*-netbsd* )
+ case "$canonical" in
+ i[3-9]86-*-netbsd*) machine=intel386 ;;
+ hp300-*-netbsd* | amiga-*-netbsd* | sun3-*-netbsd* | mac68k-*-netbsd* | da30-*-netbsd* | m68k-*-netbsd* )
+ machine=hp9000s300 ;;
+ pc532-*-netbsd* | ns32k-*-netbsd* ) machine=ns32000 ;;
+ pmax-*-netbsd* | mips-*-netbsd* ) machine=pmax ;;
+ esac
+ ;;
+
+ *-*-openbsd* )
+ case "${canonical}" in
+ alpha*-*-openbsd*) machine=alpha ;;
+ i386-*-openbsd*) machine=intel386 ;;
+ m68k-*-openbsd*) machine=hp9000s300 ;;
+ mipsel-*-openbsd*) machine=pmax ;;
+ ns32k-*-openbsd*) machine=ns32000 ;;
+ sparc-*-openbsd*) machine=sparc ;;
+ vax-*-openbsd*) machine=vax ;;
+ esac
+ ;;
+
+ arm-acorn-riscix1.1* ) machine=acorn opsys=riscix1-1 ;;
+ arm-acorn-riscix1.2* | arm-acorn-riscix ) machine=acorn opsys=riscix1-2 ;;
+
+ fx80-alliant-* ) machine=alliant4 opsys=bsd4-2 ;;
+ i860-alliant-* ) machine=alliant-2800 opsys=bsd4-3 ;;
+
+ m68*-altos-sysv* ) machine=altos opsys=usg5-2 ;;
+
+ 580-amdahl-sysv* ) machine=amdahl opsys=usg5-2-2 ;;
+
+ m68*-apollo-* ) machine=apollo opsys=bsd4-3 ;;
+
+ we32k-att-sysv* ) machine=att3b opsys=usg5-2-2 ;;
+
+ m68*-att-sysv* ) machine=7300 opsys=usg5-2-2 ;;
+
+ rs6000-bull-bosx* ) machine=ibmrs6000 opsys=aix3-2 ;; # dpx20
+ m68*-bull-sysv3* ) machine=dpx2 opsys=usg5-3 ;; # dpx2
+ m68*-bull-sysv2* ) machine=sps7 opsys=usg5-2 ;; # sps7
+
+
+ celerity-celerity-bsd* ) machine=celerity opsys=bsd4-2 ;;
+
+ *-convex-bsd* | *-convex-convexos* )
+ machine=convex opsys=bsd4-3
+ NON_GNU_CPP="cc -E -P"
+ ;;
+
+ i[3-9]86-cubix-sysv* ) machine=intel386 opsys=usg5-3 ;;
+
+ i586-dg-dgux*R4* | i586-dg-dgux5.4.4* ) machine=aviion opsys=dgux5-4r4 ;;
+ m88k-dg-dgux5.4R3* | m88k-dg-dgux5.4.3* ) opsys=dgux5-4r3 ;;
+ m88k-dg-dgux5.4R2* | m88k-dg-dgux5.4.2* ) opsys=dgux5-4r2 ;;
+ m88k-dg-dgux* ) opsys=dgux ;;
+
+ m68k-motorola-sysv* | m68000-motorola-sysv* ) machine=delta opsys=usg5-3 ;;
+ m88k-motorola-sysv4* )
+ machine=delta88k opsys=usg5-4-2
+ ;;
+ m88k-motorola-sysv* | m88k-motorola-m88kbcs* ) machine=delta88k opsys=usg5-3 ;;
+
+ m68*-dual-sysv* ) machine=dual opsys=usg5-2 ;;
+ m68*-dual-uniplus* ) machine=dual opsys=unipl5-2 ;;
+
+ ns16k-encore-bsd* ) machine=ns16000 opsys=umax ;;
+
+ pn-gould-bsd4.2* ) machine=gould opsys=bsd4-2 ;;
+ pn-gould-bsd4.3* ) machine=gould opsys=bsd4-3 ;;
+ np1-gould-bsd* ) machine=gould-np1 opsys=bsd4-3 ;;
+
+ m88k-harris-cxux* )
+ case "`uname -r`" in
+ [56].[0-9] ) machine=nh4000 opsys=cxux ;;
+ [7].[0-9] ) machine=nh4000 opsys=cxux7 ;;
+ esac
+ NON_GNU_CPP="/lib/cpp"
+ ;;
+ m68k-harris-cxux* ) machine=nh3000 opsys=cxux ;;
+ powerpc-harris-powerunix ) machine=nh6000 opsys=powerunix NON_GNU_CPP="cc -Xo -E -P" ;;
+
+ xps*-honeywell-sysv* ) machine=xps100 opsys=usg5-2 ;;
+
+ m68*-hp-bsd* ) machine=hp9000s300 opsys=bsd4-3 ;;
+
+ *-hp-hpux* )
+ case "$canonical" in
+ m68* ) machine=hp9000s300 ;;
+ hppa* ) machine=hp800 ;;
+ esac
+
+ case "$canonical" in
+ *-hp-hpux7* ) opsys=hpux ;;
+ *-hp-hpux8* ) opsys=hpux8 ;;
+ *-hp-hpux9* ) opsys=hpux9 ;;
+ *-hp-hpux10* ) opsys=hpux10 ;;
+ *-hp-hpux11* ) opsys=hpux11 ;;
+ * ) opsys=hpux ;;
+ esac
+
+ case "$opsys" in hpux9 | hpux10 ) extra_objs="$extra_objs strcat.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"strcat.o\""
+ fi ;; esac
+
+ if test "$opsys" = "hpux10" -o "$opsys" = "hpux11"; then \
+ ansi_flag="-Ae"; else ansi_flag="-Aa"; fi
+ NON_GNU_CC="cc $ansi_flag" NON_GNU_CPP="cc $ansi_flag -E"
+
+ case "$canonical" in *-hp-hpux*shr* ) opsys="${opsys}-shr" ;; esac
+ ;;
+
+ orion-orion-bsd* ) machine=orion opsys=bsd4-2 ;;
+ clipper-orion-bsd* ) machine=orion105 opsys=bsd4-2 ;;
+
+ i[3-9]86-ibm-aix1.1* ) machine=ibmps2-aix opsys=usg5-2-2 ;;
+ i[3-9]86-ibm-aix1.[23]* | i[3-9]86-ibm-aix* ) machine=ibmps2-aix opsys=usg5-3 ;;
+ i370-ibm-aix*) machine=ibm370aix opsys=usg5-3 ;;
+ romp-ibm-aos* ) opsys=bsd4-3 ;;
+ romp-ibm-bsd* ) opsys=bsd4-3 ;;
+ romp-ibm-mach* ) opsys=mach-bsd4-3 ;;
+
+ m68*-isi-bsd4.2* ) machine=isi-ov opsys=bsd4-2 ;;
+ m68*-isi-bsd4.3* ) machine=isi-ov opsys=bsd4-3 ;;
+
+ i[3-9]86-intsys-sysv* ) machine=is386 opsys=usg5-2-2 ;;
+
+ i[3-9]86-prime-sysv* ) machine=i386 opsys=usg5-3 ;;
+
+ i[3-9]86-sequent-bsd* ) machine=symmetry opsys=bsd4-3 ;;
+
+ i[3-9]86-sequent-ptx* ) machine=sequent-ptx opsys=ptx NON_GNU_CPP="/lib/cpp" ;;
+
+ i[3-9]86-ncr-sysv* ) machine=ncr386 opsys=usg5-4-2 ;;
+
+ i860-intel-osf1* ) machine=paragon opsys=osf1 NON_GNU_CPP=/usr/mach/lib/cpp ;;
+
+ i860-*-sysv4* ) machine=i860 opsys=usg5-4 NON_GNU_CC="/bin/cc" NON_GNU_CPP="/usr/ccs/lib/cpp" ;;
+
+ m68*-masscomp-rtu* ) machine=masscomp opsys=rtu ;;
+
+ m68*-megatest-bsd* ) machine=mega68 opsys=bsd4-2 ;;
+
+ mips-mips-usg* ) machine=mips4 ;;
+ mips-mips-riscos4 )
+ machine=mips4
+ NON_GNU_CC="cc -systype bsd43"
+ NON_GNU_CPP="cc -systype bsd43 -E"
+ case "$canonical" in
+ mips-mips-riscos4* ) opsys=bsd4-3 ;;
+ mips-mips-riscos5* ) opsys=riscos5 ;;
+ esac
+ ;;
+ mips-mips-bsd* ) machine=mips opsys=bsd4-3 ;;
+ mips-mips-* ) machine=mips opsys=usg5-2-2 ;;
+
+ m68*-next-* | m68k-*-nextstep* ) machine=m68k opsys=nextstep ;;
+
+ ns32k-ns-genix* ) machine=ns32000 opsys=usg5-2 ;;
+
+ m68*-ncr-sysv2* | m68*-ncr-sysvr2* ) machine=tower32 opsys=usg5-2-2 ;;
+ m68*-ncr-sysv3* | m68*-ncr-sysvr3* ) machine=tower32v3 opsys=usg5-3 ;;
+
+ m68*-nixdorf-sysv* ) machine=targon31 opsys=usg5-2-2 ;;
+
+ m68*-nu-sysv* ) machine=nu opsys=usg5-2 ;;
+
+ m68*-plexus-sysv* ) machine=plexus opsys=usg5-2 ;;
+
+ pyramid-pyramid-bsd* ) machine=pyramid opsys=bsd4-2 ;;
+
+ ns32k-sequent-bsd4.2* ) machine=sequent opsys=bsd4-2 ;;
+ ns32k-sequent-bsd4.3* ) machine=sequent opsys=bsd4-3 ;;
+
+ mips-siemens-sysv* | mips-sni-sysv*)
+ machine=mips-siemens opsys=usg5-4
+ NON_GNU_CC=/usr/ccs/bin/cc
+ NON_GNU_CPP=/usr/ccs/lib/cpp
+ ;;
+
+ m68*-sgi-iris3.5* ) machine=irist opsys=iris3-5 ;;
+ m68*-sgi-iris3.6* | m68*-sgi-iris*) machine=irist opsys=iris3-6 ;;
+ mips-sgi-irix3.* ) opsys=irix3-3 ;;
+ mips-sgi-irix4.* ) opsys=irix4-0 ;;
+ mips-sgi-irix6* ) opsys=irix6-0 ;;
+ mips-sgi-irix5.1* ) opsys=irix5-1 ;;
+ mips-sgi-irix5.2* ) opsys=irix5-2 ;;
+ mips-sgi-irix5.* ) opsys=irix5-3 ;;
+ mips-sgi-irix* ) opsys=irix5-0 ;;
+
+ *-sony-newsos[34]* | *-sony-news[34]* ) opsys=bsd4-3 ;;
+ *-sony-news* ) opsys=newsos5 ;;
+
+ m68*-stride-sysv* ) machine=stride opsys=usg5-2 ;;
+
+ *-*-solaris* | *-*-sunos* | *-sun-mach* | *-sun-bsd* )
+ case "$canonical" in
+ m68*-sunos1* ) machine=sun1 ;;
+ m68*-sunos2* ) machine=sun2 ;;
+ m68* ) machine=sun3 ;;
+ i*86*-sun-sunos[34]* ) machine=sun386 ;;
+ i*86-*-* ) machine=intel386 ;;
+ rs6000* ) machine=rs6000 ;;
+ esac
+
+ case "$canonical" in *-sunos5*)
+ canonical=`echo $canonical | sed -e s/sunos5/solaris2/`;;
+ esac
+
+ case "$canonical" in
+ *-sunos4* )
+ #test -f /usr/lib/cpp && NON_GNU_CPP=/usr/lib/cpp ;;
+ : ;;
+ *-solaris2* )
+ #test -f /usr/ccs/lib/cpp && NON_GNU_CPP=/usr/ccs/lib/cpp
+ RANLIB=':' ;;
+ esac
+
+ case "$canonical" in
+ *-solaris* )
+ opsys=sol2
+ os_release=`uname -r | sed -e 's/^\([0-9]\)\.\([0-9]\).*/\1\2/'`
+ { test "$extra_verbose" = "yes" && cat << EOF
+ Defining OS_RELEASE = $os_release
+EOF
+cat >> confdefs.h <<EOF
+#define OS_RELEASE $os_release
+EOF
+}
+ ;;
+
+ i*86-*-sunos4* ) opsys=sunos4-0 ;;
+ *-sunos4.0* ) opsys=sunos4-0 ;;
+ *-sunos4.1.2* ) opsys=sunos4-1-2 ;;
+ *-sunos4.1.3* ) opsys=sunos4-1-3 ;;
+ *-sunos4.1.[4-9]* ) opsys=sunos4-1-4 ;;
+ *-sunos4* | *-sunos ) opsys=sunos4-1 ;;
+ *-mach* ) opsys=mach-bsd4-3 ;;
+ * ) opsys=bsd4-2 ;;
+ esac
+
+ case "$canonical" in *-sunos4*shr* ) opsys="${opsys}-shr" ;; esac
+
+ test "$opsys $CC" = "sol2 /usr/ucb/cc" && CC=""
+ ;;
+
+ m68*-tadpole-sysv* ) machine=tad68k opsys=usg5-3 ;;
+
+ tahoe-tahoe-bsd4.2* ) machine=tahoe opsys=bsd4-2 ;;
+ tahoe-tahoe-bsd4.3* ) machine=tahoe opsys=bsd4-3 ;;
+
+ mips-tandem-sysv* ) machine=tandem-s2 opsys=usg5-3 ;;
+
+ m88k-tektronix-sysv3* ) machine=tekxd88 opsys=usg5-3 ;;
+
+ ns16k-tektronix-bsd* ) machine=ns16000 opsys=bsd4-2 ;;
+ m68*-tektronix-bsd* ) machine=tek4300 opsys=bsd4-3 ;;
+
+ titan-titan-sysv* ) machine=titan opsys=usg5-3 ;;
+
+ m68*-unisys-uniplus* ) machine=ustation opsystem=unipl5-2 ;;
+
+ vax-dec-* )
+ case "$canonical" in
+ *-sysv[01]* | *-sysvr[01]* ) opsys=usg5-0 ;;
+ *-sysv2* | *-sysvr2* ) opsys=usg5-2 ;;
+ *-mach* ) opsys=mach-bsd4-3 ;;
+ esac
+ ;;
+
+ ns16k-whitechapel-* ) machine=mg1 ;;
+
+ m68*-wicat-sysv* ) machine=wicat opsys=usg5-2 ;;
+
+ i[3-9]86-*-* )
+ machine=intel386
+ case "$canonical" in
+ *-isc1.* | *-isc2.[01]* ) opsys=386-ix ;;
+ *-isc2.2* ) opsys=isc2-2 ;;
+ *-isc4.0* ) opsys=isc4-0 ;;
+ *-isc4.* ) opsys=isc4-1
+ GCC_TEST_OPTIONS=-posix
+ NON_GCC_TEST_OPTIONS=-Xp
+ ;;
+ *-isc* ) opsys=isc3-0 ;;
+ *-esix5* ) opsys=esix5r4 NON_GNU_CPP=/usr/lib/cpp ;;
+ *-esix* ) opsys=esix ;;
+ *-mach* ) opsys=mach-bsd4-3 ;;
+ *-xenix* ) opsys=xenix ;;
+ *-sco3.2v4* ) opsys=sco4 NON_GNU_CPP=/lib/cpp ;;
+ *-bsd386* | *-bsdi1* ) opsys=bsd386 ;;
+ *-bsdi3* ) opsys=bsdos3 ;;
+ *-bsdi2.1* ) opsys=bsdos2-1 ;;
+ *-bsdi2* ) opsys=bsdos2 ;;
+ *-sco3.2v5* ) opsys=sco5 ;
+ if test "$dynamic" = "yes" ; then
+ NON_GNU_CPP="/lib/cpp -D_XOPEN_SOURCE -D_SCO_ELF" ;
+ else
+ NON_GNU_CPP="/lib/cpp -D_XOPEN_SOURCE" ;
+ fi ;;
+ *-386bsd* ) opsys=386bsd ;;
+ *-freebsd* ) opsys=freebsd ;;
+ *-nextstep* ) opsys=nextstep ;;
+ *-pc-cygwin32 ) opsys=cygwin32 ;;
+ esac
+ ;;
+
+ m68k-*-linux* ) machine=m68k opsys=linux ;;
+
+esac
+
+if test -z "$machine" -o -z "$opsys"; then
+ (echo "$progname: XEmacs hasn't been ported to \`$canonical' systems."
+ echo "$progname: Check \`etc/MACHINES' for recognized configuration names."
+ ) >&2
+ exit 1
+fi
+
+if test -z "$dynamic"; then
+ case "$opsys" in
+ hpux* | sunos4* | sco5 ) dynamic=no ;;
+ *) dynamic=yes ;;
+ esac
+fi
+if test "$dynamic" = "yes"; then
+ case "$opsys" in
+ hpux* | sunos4* | sco5 ) opsys="${opsys}-shr" ;;
+ decosf* ) ld_call_shared="-call_shared" ;;
+ esac
+else case "$opsys" in
+ sol2 )
+ echo "Static linking is not supported on Solaris 2."
+ echo "Rerun configure without specifying --dynamic=no."
+ exit 1 ;;
+ linux ) ld_call_shared="-Bstatic" ;;
+ decosf* ) ld_call_shared="-non_shared" ;;
+ esac
+fi
+
+case "$opsys" in aix*) NON_GNU_CC=xlc ;; esac
+
+stack_trace_eye_catcher=`echo ${PROGNAME}_${version}_${canonical} | sed 'y/.-/__/'`
+{ test "$extra_verbose" = "yes" && cat << EOF
+ Defining STACK_TRACE_EYE_CATCHER = $stack_trace_eye_catcher
+EOF
+cat >> confdefs.h <<EOF
+#define STACK_TRACE_EYE_CATCHER $stack_trace_eye_catcher
+EOF
+}
+
+
+machfile="m/${machine}.h"
+opsysfile="s/${opsys}.h"
+
+
+test "$with_sparcworks" = "yes" && with_workshop=yes # compatibility alias
+if test "$with_workshop $with_tooltalk" = "yes no"; then
+ (echo "$progname: Usage error:"
+echo " " "--with-workshop requires --with-tooltalk"
+echo " Use \`$progname --help' to show usage.") >&2 && exit 1
+elif test "$with_tooltalk" = "no" ; then with_workshop=no
+elif test "$with_workshop" = "yes"; then with_tooltalk=yes
+fi
+
+if test "$with_workshop" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining SUNPRO
+EOF
+cat >> confdefs.h <<\EOF
+#define SUNPRO 1
+EOF
+}
+
+ extra_objs="$extra_objs sunpro.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"sunpro.o\""
+ fi
+fi
+
+if test "$with_clash_detection" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining CLASH_DETECTION
+EOF
+cat >> confdefs.h <<\EOF
+#define CLASH_DETECTION 1
+EOF
+}
+
+ extra_objs="$extra_objs filelock.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"filelock.o\""
+ fi
+fi
+
+test -n "$compiler" && CC="$compiler"
+if test "$with_gcc" = "no"; then case "$CC" in "" | *gcc* ) CC="${NON_GNU_CC-cc}" ;; esac
+fi
+
+test "${cflags-unset}" != unset && CFLAGS="$cflags"
+if test "${CFLAGS-unset}" != unset
+ then cflags_specified=yes;
+ else cflags_specified=no;
+fi
+
+xe_save_CFLAGS="$CFLAGS"
+
+# 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:1473: checking for $ac_word" >&5
+
+if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:"
+ for ac_dir in $PATH; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="gcc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+ # 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:1499: checking for $ac_word" >&5
+
+if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:"
+ ac_prog_rejected=no
+ for ac_dir in $PATH; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# -gt 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ set dummy "$ac_dir/$ac_word" "$@"
+ shift
+ ac_cv_prog_CC="$@"
+ fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:1544: 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'
+xe_ldflags='$LDFLAGS $ld_switch_site $ld_switch_machine $ld_switch_system $ld_switch_x_site $ld_switch_run'
+xe_libs='$ld_call_shared $xe_check_libs $X_EXTRA_LIBS $libs_x $X_PRE_LIBS $LIBS $libs_machine $libs_system $libs_standard'
+ac_cpp='$CPP '"$xe_cppflags"
+ac_compile='${CC-cc} -c $CFLAGS '"$xe_cppflags"' conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest $CFLAGS '"$xe_cppflags $xe_ldflags"' conftest.$ac_ext '"$xe_libs"' 1>&5'
+cross_compiling=no
+
+cat > conftest.$ac_ext <<EOF
+#line 1556 "configure"
+#include "confdefs.h"
+main(){return(0);}
+EOF
+if { (eval echo configure:1560: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ ac_cv_prog_cc_cross=no
+ else
+ ac_cv_prog_cc_cross=yes
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+ { 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:1580: 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:1585: checking whether we are using GNU C" >&5
+
+cat > conftest.c <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1592: \"$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
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+ GCC=yes
+ ac_test_CFLAGS="${CFLAGS+set}"
+ ac_save_CFLAGS="$CFLAGS"
+ CFLAGS=
+ echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:1606: checking whether ${CC-cc} accepts -g" >&5
+
+echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+ ac_cv_prog_cc_g=yes
+else
+ ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+ if test "$ac_test_CFLAGS" = set; then
+ CFLAGS="$ac_save_CFLAGS"
+ elif test $ac_cv_prog_cc_g = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-O2"
+ fi
+else
+ GCC=
+ test "${CFLAGS+set}" = set || CFLAGS="-g"
+fi
+
+if test "$with_gcc" = "no" -a "$GCC" = "yes"; then
+ CC=${NON_GNU_CC-cc}
+ # 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:1635: checking for $ac_word" >&5
+
+if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:"
+ for ac_dir in $PATH; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="gcc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+ # 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:1661: checking for $ac_word" >&5
+
+if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:"
+ ac_prog_rejected=no
+ for ac_dir in $PATH; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# -gt 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ set dummy "$ac_dir/$ac_word" "$@"
+ shift
+ ac_cv_prog_CC="$@"
+ fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:1706: 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'
+xe_ldflags='$LDFLAGS $ld_switch_site $ld_switch_machine $ld_switch_system $ld_switch_x_site $ld_switch_run'
+xe_libs='$ld_call_shared $xe_check_libs $X_EXTRA_LIBS $libs_x $X_PRE_LIBS $LIBS $libs_machine $libs_system $libs_standard'
+ac_cpp='$CPP '"$xe_cppflags"
+ac_compile='${CC-cc} -c $CFLAGS '"$xe_cppflags"' conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest $CFLAGS '"$xe_cppflags $xe_ldflags"' conftest.$ac_ext '"$xe_libs"' 1>&5'
+cross_compiling=no
+
+cat > conftest.$ac_ext <<EOF
+#line 1718 "configure"
+#include "confdefs.h"
+main(){return(0);}
+EOF
+if { (eval echo configure:1722: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ ac_cv_prog_cc_cross=no
+ else
+ ac_cv_prog_cc_cross=yes
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+ { 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:1742: 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:1747: checking whether we are using GNU C" >&5
+
+cat > conftest.c <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1754: \"$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
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+ GCC=yes
+ ac_test_CFLAGS="${CFLAGS+set}"
+ ac_save_CFLAGS="$CFLAGS"
+ CFLAGS=
+ echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:1768: checking whether ${CC-cc} accepts -g" >&5
+
+echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+ ac_cv_prog_cc_g=yes
+else
+ ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+ if test "$ac_test_CFLAGS" = set; then
+ CFLAGS="$ac_save_CFLAGS"
+ elif test $ac_cv_prog_cc_g = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-O2"
+ fi
+else
+ GCC=
+ test "${CFLAGS+set}" = set || CFLAGS="-g"
+fi
+
+elif test "$with_gcc" = "yes" -a "$GCC" != "yes" ; then
+ CC=gcc
+ # 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:1797: checking for $ac_word" >&5
+
+if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:"
+ for ac_dir in $PATH; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="gcc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+ # 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:1823: checking for $ac_word" >&5
+
+if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:"
+ ac_prog_rejected=no
+ for ac_dir in $PATH; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# -gt 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ set dummy "$ac_dir/$ac_word" "$@"
+ shift
+ ac_cv_prog_CC="$@"
+ fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:1868: 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'
+xe_ldflags='$LDFLAGS $ld_switch_site $ld_switch_machine $ld_switch_system $ld_switch_x_site $ld_switch_run'
+xe_libs='$ld_call_shared $xe_check_libs $X_EXTRA_LIBS $libs_x $X_PRE_LIBS $LIBS $libs_machine $libs_system $libs_standard'
+ac_cpp='$CPP '"$xe_cppflags"
+ac_compile='${CC-cc} -c $CFLAGS '"$xe_cppflags"' conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest $CFLAGS '"$xe_cppflags $xe_ldflags"' conftest.$ac_ext '"$xe_libs"' 1>&5'
+cross_compiling=no
+
+cat > conftest.$ac_ext <<EOF
+#line 1880 "configure"
+#include "confdefs.h"
+main(){return(0);}
+EOF
+if { (eval echo configure:1884: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ ac_cv_prog_cc_cross=no
+ else
+ ac_cv_prog_cc_cross=yes
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+ { 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:1904: 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:1909: checking whether we are using GNU C" >&5
+
+cat > conftest.c <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1916: \"$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
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+ GCC=yes
+ ac_test_CFLAGS="${CFLAGS+set}"
+ ac_save_CFLAGS="$CFLAGS"
+ CFLAGS=
+ echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:1930: checking whether ${CC-cc} accepts -g" >&5
+
+echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+ ac_cv_prog_cc_g=yes
+else
+ ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+ if test "$ac_test_CFLAGS" = set; then
+ CFLAGS="$ac_save_CFLAGS"
+ elif test $ac_cv_prog_cc_g = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-O2"
+ fi
+else
+ GCC=
+ test "${CFLAGS+set}" = set || CFLAGS="-g"
+fi
+
+fi
+CFLAGS="$xe_save_CFLAGS"
+
+
+test -n "$CPP" -a -d "$CPP" && CPP=
+
+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:1963: checking how to run the C preprocessor" >&5
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
+fi
+if test -z "$CPP"; then
+
+ # This must be in double quotes, not single quotes, because CPP may get
+ # substituted into the Makefile and "${CC-cc}" will confuse make.
+ CPP="${CC-cc} -E"
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp.
+ cat > conftest.$ac_ext <<EOF
+#line 1976 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1982: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -E -traditional-cpp"
+ cat > conftest.$ac_ext <<EOF
+#line 1993 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1999: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP=/lib/cpp
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+ ac_cv_prog_CPP="$CPP"
+ CPP="$ac_cv_prog_CPP"
+else
+ ac_cv_prog_CPP="$CPP"
+fi
+echo "$ac_t""$CPP" 1>&6
+
+
+echo $ac_n "checking for AIX""... $ac_c" 1>&6
+echo "configure:2022: checking for AIX" >&5
+cat > conftest.$ac_ext <<EOF
+#line 2024 "configure"
+#include "confdefs.h"
+#ifdef _AIX
+ yes
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "yes" >/dev/null 2>&1; then
+ rm -rf conftest*
+ echo "$ac_t""yes" 1>&6; { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining _ALL_SOURCE
+EOF
+cat >> confdefs.h <<\EOF
+#define _ALL_SOURCE 1
+EOF
+}
+
+else
+ rm -rf conftest*
+ echo "$ac_t""no" 1>&6
+fi
+rm -f conftest*
+
+
+
+echo $ac_n "checking for GNU libc""... $ac_c" 1>&6
+echo "configure:2051: checking for GNU libc" >&5
+cat > conftest.$ac_ext <<EOF
+#line 2053 "configure"
+#include "confdefs.h"
+#include <features.h>
+int main() {
+
+#if ! (defined __GLIBC__ || defined __GNU_LIBRARY__)
+#error Not a GNU libc system :-(
+******* ======= ******** &&&&&&&&
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:2065: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ have_glibc=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ have_glibc=no
+fi
+rm -f conftest*
+echo "$ac_t""$have_glibc" 1>&6
+test "$have_glibc" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining _GNU_SOURCE
+EOF
+cat >> confdefs.h <<\EOF
+#define _GNU_SOURCE 1
+EOF
+}
+
+
+echo $ac_n "checking whether we are using SunPro C""... $ac_c" 1>&6
+echo "configure:2086: checking whether we are using SunPro C" >&5
+cat > conftest.$ac_ext <<EOF
+#line 2088 "configure"
+#include "confdefs.h"
+
+int main() {
+#ifndef __SUNPRO_C
+#error Not a SunPro compiler :-(
+******* ======= ******** &&&&&&&&
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:2099: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ __sunpro_c=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ __sunpro_c=no
+fi
+rm -f conftest*
+echo "$ac_t""$__sunpro_c" 1>&6
+
+
+
+echo "Extracting information from the machine- and system-dependent headers..."
+
+tempcname="conftest.c"
+
+
+
+cat > $tempcname <<EOF
+#define NOT_C_CODE
+#define C_SWITCH_SITE
+#define C_SWITCH_X_SITE
+#define LD_SWITCH_SITE
+#define LD_SWITCH_X_SITE
+#define LD_SWITCH_X_SITE_AUX
+#define OS_RELEASE $os_release
+#include "$srcdir/src/$opsysfile"
+#include "$srcdir/src/$machfile"
+
+#ifndef LIBS_MACHINE
+#define LIBS_MACHINE
+#endif
+configure___ libs_machine=LIBS_MACHINE
+
+#ifndef LIBS_SYSTEM
+#define LIBS_SYSTEM
+#endif
+configure___ libs_system=LIBS_SYSTEM
+
+#ifndef LIBS_TERMCAP
+#define LIBS_TERMCAP
+#endif
+configure___ libs_termcap=LIBS_TERMCAP
+
+#ifndef LIB_STANDARD
+#define LIB_STANDARD
+#endif
+configure___ libs_standard=LIB_STANDARD
+
+
+#ifndef OBJECTS_MACHINE
+#define OBJECTS_MACHINE
+#endif
+configure___ objects_machine=OBJECTS_MACHINE
+
+#ifndef OBJECTS_SYSTEM
+#define OBJECTS_SYSTEM
+#endif
+configure___ objects_system=OBJECTS_SYSTEM
+
+
+#ifndef C_SWITCH_MACHINE
+#define C_SWITCH_MACHINE
+#endif
+configure___ c_switch_machine=C_SWITCH_MACHINE
+
+#ifndef C_SWITCH_SYSTEM
+#define C_SWITCH_SYSTEM
+#endif
+configure___ c_switch_system=C_SWITCH_SYSTEM
+
+
+#ifndef LD_SWITCH_MACHINE
+#define LD_SWITCH_MACHINE
+#endif
+configure___ ld_switch_machine=LD_SWITCH_MACHINE
+
+#ifndef LD_SWITCH_SYSTEM
+#define LD_SWITCH_SYSTEM
+#endif
+configure___ ld_switch_system=LD_SWITCH_SYSTEM
+
+
+#ifndef UNEXEC
+#define UNEXEC "unexec.o"
+#endif
+configure___ unexec=UNEXEC
+
+
+#ifndef LD_SWITCH_SHARED
+#define LD_SWITCH_SHARED "-c"
+#endif
+configure___ ld_switch_shared=LD_SWITCH_SHARED
+
+
+#ifdef ORDINARY_LINK
+#define LD "\$(CC) \$(CFLAGS)"
+#else /* no ORDINARY LINK */
+#ifdef COFF_ENCAPSULATE
+#define LD "\$(CC) -nostdlib"
+#else /* not COFF_ENCAPSULATE */
+#ifdef LINKER
+#define LD LINKER
+#else /* ! defined (LINKER) */
+#define LD "ld"
+#endif /* ! defined (LINKER) */
+#endif /* ! defined (COFF_ENCAPSULATE) */
+#endif /* not ORDINARY_LINK */
+configure___ ld=LD
+
+#ifndef LIB_GCC
+#define LIB_GCC
+#endif
+configure___ lib_gcc=LIB_GCC
+
+#ifndef LD_TEXT_START_ADDR
+#define LD_TEXT_START_ADDR
+#endif
+configure___ ld_text_start_addr=LD_TEXT_START_ADDR
+
+
+#if ! defined (ORDINARY_LINK) && !defined (START_FILES)
+#ifdef NO_REMAP
+#ifdef COFF_ENCAPSULATE
+#define START_FILES "pre-crt0.o /usr/local/lib/gcc-crt0.o"
+#else /* ! defined (COFF_ENCAPSULATE) */
+#define START_FILES "pre-crt0.o /lib/crt0.o"
+#endif /* ! defined (COFF_ENCAPSULATE) */
+#else /* ! defined (NO_REMAP) */
+#define START_FILES "ecrt0.o"
+#endif /* ! defined (NO_REMAP) */
+#endif /* no ORDINARY_LINK */
+#ifndef START_FILES
+#define START_FILES
+#endif
+configure___ start_files=START_FILES
+
+#ifdef ORDINARY_LINK
+configure___ ordinary_link=yes
+#else
+configure___ ordinary_link=no
+#endif
+
+#ifdef SYSTEM_MALLOC
+configure___ system_malloc=yes
+#else
+configure___ system_malloc=no
+#endif
+
+#ifdef TERMINFO
+configure___ have_terminfo=yes
+#else
+configure___ have_terminfo=no
+#endif
+
+#ifdef MAIL_USE_FLOCK
+configure___ mail_use_flock=yes
+#else
+configure___ mail_use_flock=no
+#endif
+
+#ifdef MAIL_USE_LOCKF
+configure___ mail_use_lockf=yes
+#else
+configure___ mail_use_lockf=no
+#endif
+
+EOF
+
+CPP=`eval "echo $CPP"`
+eval `$CPP -Isrc $tempcname \
+ | sed -n -e "s/[ ]*=[ \"]*/='/" -e "s/[ \"]*\$/'/" -e "s/^configure___//p"`
+
+rm $tempcname
+
+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 ""
+
+test "$ordinary_link" = "no" -a -z "$libs_standard" && libs_standard="-lc"
+
+if test "$cflags_specified" = "no"; then
+ if test "$GCC" = "yes"; then
+ CFLAGS="-g -O3 -Wall -Wno-switch"
+ test "$opsys $machine" = "cygwin32 intel386" && \
+ CFLAGS="-g -O2 -Wall -Wno-switch"
+ elif test "$__sunpro_c" = "yes"; then
+ case "$opsys" in
+ sol2 ) CFLAGS="-v -xO4" ;;
+ sunos4* ) CFLAGS="-xO2";;
+ esac
+ elif test "$CC" = "xlc"; then
+ CFLAGS="-O3 -qstrict -qnoansialias -qlibansi -qinfo -qro -qmaxmem=20000"
+ else
+ CFLAGS="-O" ; fi
+fi
+
+
+if test "$GCC" = "yes"; then
+ set x $ld_switch_system; shift; ld_switch_system=""
+ while test -n "$1"; do
+ case $1 in
+ -L | -l | -u ) ld_switch_system="$ld_switch_system $1 $2"; shift ;;
+ -L* | -l* | -u* | -Wl* ) ld_switch_system="$ld_switch_system $1" ;;
+ -Xlinker* ) ;;
+ * ) ld_switch_system="$ld_switch_system -Xlinker $1" ;;
+ esac
+ shift
+ done
+fi
+
+if test "$GCC" = "yes"; then
+ set x $ld_switch_machine; shift; ld_switch_machine=""
+ while test -n "$1"; do
+ case $1 in
+ -L | -l | -u ) ld_switch_machine="$ld_switch_machine $1 $2"; shift ;;
+ -L* | -l* | -u* | -Wl* ) ld_switch_machine="$ld_switch_machine $1" ;;
+ -Xlinker* ) ;;
+ * ) ld_switch_machine="$ld_switch_machine -Xlinker $1" ;;
+ esac
+ shift
+ done
+fi
+
+if test "$GCC" = "yes"; then
+ set x $LDFLAGS; shift; LDFLAGS=""
+ while test -n "$1"; do
+ case $1 in
+ -L | -l | -u ) LDFLAGS="$LDFLAGS $1 $2"; shift ;;
+ -L* | -l* | -u* | -Wl* ) LDFLAGS="$LDFLAGS $1" ;;
+ -Xlinker* ) ;;
+ * ) LDFLAGS="$LDFLAGS -Xlinker $1" ;;
+ esac
+ shift
+ done
+fi
+
+if test "$GCC" = "yes"; then
+ set x $ld_call_shared; shift; ld_call_shared=""
+ while test -n "$1"; do
+ case $1 in
+ -L | -l | -u ) ld_call_shared="$ld_call_shared $1 $2"; shift ;;
+ -L* | -l* | -u* | -Wl* ) ld_call_shared="$ld_call_shared $1" ;;
+ -Xlinker* ) ;;
+ * ) ld_call_shared="$ld_call_shared -Xlinker $1" ;;
+ esac
+ shift
+ done
+fi
+
+test -n "$objects_machine" && extra_objs="$extra_objs $objects_machine" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"$objects_machine\""
+ fi
+test -n "$objects_system" && extra_objs="$extra_objs $objects_system" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"$objects_system\""
+ fi
+test -n "$unexec" && extra_objs="$extra_objs $unexec" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"$unexec\""
+ fi
+
+echo $ac_n "checking for dynodump""... $ac_c" 1>&6
+echo "configure:2361: checking for dynodump" >&5
+if test "$unexec" != "unexsol2.o"; then
+ echo "$ac_t""no" 1>&6
+else
+ echo "$ac_t""yes" 1>&6
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining DYNODUMP
+EOF
+cat >> confdefs.h <<\EOF
+#define DYNODUMP 1
+EOF
+}
+
+ MAKE_SUBDIR="$MAKE_SUBDIR dynodump" && if test "$extra_verbose" = "yes"; then echo " Appending \"dynodump\" to \$MAKE_SUBDIR"; fi
+ SRC_SUBDIR_DEPS="$SRC_SUBDIR_DEPS dynodump" && if test "$extra_verbose" = "yes"; then echo " Appending \"dynodump\" to \$SRC_SUBDIR_DEPS"; fi
+ case "$machine" in
+ sparc ) dynodump_arch=sparc ;;
+ *86* ) dynodump_arch=i386 ;;
+ powerpc ) dynodump_arch=ppc ;;
+ esac
+ test "$GCC" = "yes" && ld_switch_site="$ld_switch_site -fno-gnu-linker" && if test "$extra_verbose" = "yes"; then echo " Appending \"-fno-gnu-linker\" to \$ld_switch_site"; fi
+fi
+
+
+test "$machine$opsys" = "powerpclinux" && start_flags="-T $srcdir/src/ppc.ldscript"
+
+if test "$unexec" = "unexaix.o"; then
+ if test "$dynamic" = "no"; then
+ start_flags="-Wl,-bnso,-bnodelcsect"
+ test "$GCC" = "yes" && start_flags="-B/bin/ ${start_flags}"
+ for f in "/lib/syscalls.exp" "/lib/threads.exp"; do
+ if test -r "$f"; then start_flags="${start_flags},-bI:${f}"; fi
+ done
+ for f in "/usr/lpp/X11/bin/smt.exp" "/usr/bin/X11/smt.exp"; do
+ if test -r "$f"; then start_flags="${start_flags},-bI:${f}"; break; fi
+ done
+
+echo $ac_n "checking for terminateAndUnload in -lC""... $ac_c" 1>&6
+echo "configure:2399: checking for terminateAndUnload in -lC" >&5
+ac_lib_var=`echo C'_'terminateAndUnload | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lC "
+cat > conftest.$ac_ext <<EOF
+#line 2404 "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 terminateAndUnload();
+
+int main() {
+terminateAndUnload()
+; return 0; }
+EOF
+if { (eval echo configure:2415: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ libs_system="$libs_system -lC" && if test "$extra_verbose" = "yes"; then echo " Appending \"-lC\" to \$libs_system"; fi
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+ fi
+elif test -n "$ld_text_start_addr"; then
+ start_flags="-T $ld_text_start_addr -e __start"
+fi
+
+
+
+
+if test "$ordinary_link" = "no" -a "$GCC" = "yes"; then
+ test -z "$linker" && linker='$(CC) -nostdlib'
+ test -z "$lib_gcc" && lib_gcc='`$(CC) -print-libgcc-file-name`'
+fi
+test "$GCC" != "yes" && lib_gcc=
+
+
+
+
+
+if test -n "$site_prefixes"; then
+ for arg in $site_prefixes; do
+ case "$arg" in
+ -* ) ;;
+ * ) argi="-I${arg}/include" ; argl="-L${arg}/lib" ;;
+ esac
+ c_switch_site="$c_switch_site $argi" && if test "$extra_verbose" = "yes"; then echo " Appending \"$argi\" to \$c_switch_site"; fi
+ ld_switch_site="$ld_switch_site $argl" && if test "$extra_verbose" = "yes"; then echo " Appending \"$argl\" to \$ld_switch_site"; fi
+ done
+fi
+
+if test -n "$site_libraries"; then
+ for arg in $site_libraries; do
+ case "$arg" in -* ) ;; * ) arg="-L${arg}" ;; esac
+ ld_switch_site="$ld_switch_site $arg" && if test "$extra_verbose" = "yes"; then echo " Appending \"$arg\" to \$ld_switch_site"; fi
+ done
+fi
+
+if test -n "$site_includes"; then
+ for arg in $site_includes; do
+ case "$arg" in -* ) ;; * ) arg="-I${arg}" ;; esac
+ c_switch_site="$c_switch_site $arg" && if test "$extra_verbose" = "yes"; then echo " Appending \"$arg\" to \$c_switch_site"; fi
+ done
+fi
+
+
+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
+done
+
+if test -n "$site_runtime_libraries"; then
+ LD_RUN_PATH="`echo $site_runtime_libraries | sed -e 's/ */:/g'`"
+ export LD_RUN_PATH
+fi
+
+
+if 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* ) add_runtime_path=yes ;;
+ * ) add_runtime_path=no ;;
+ esac
+fi
+
+if test "$add_runtime_path" = "yes"; then
+ echo $ac_n "checking "for runtime libraries flag"""... $ac_c" 1>&6
+echo "configure:2499: checking "for runtime libraries flag"" >&5
+ dash_r=""
+ for try_dash_r in "-R" "-R " "-rpath "; do
+ xe_check_libs="${try_dash_r}/no/such/file-or-directory"
+
+if test "$GCC" = "yes"; then
+ set x $xe_check_libs; shift; xe_check_libs=""
+ while test -n "$1"; do
+ case $1 in
+ -L | -l | -u ) xe_check_libs="$xe_check_libs $1 $2"; shift ;;
+ -L* | -l* | -u* | -Wl* ) xe_check_libs="$xe_check_libs $1" ;;
+ -Xlinker* ) ;;
+ * ) xe_check_libs="$xe_check_libs -Xlinker $1" ;;
+ esac
+ shift
+ done
+fi
+ cat > conftest.$ac_ext <<EOF
+#line 2517 "configure"
+#include "confdefs.h"
+
+int main() {
+
+; return 0; }
+EOF
+if { (eval echo configure:2524: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ dash_r="$try_dash_r"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+fi
+rm -f conftest*
+ xe_check_libs=""
+ test -n "$dash_r" && break
+ done
+ if test -n "$dash_r";
+ then echo "$ac_t"""\"${dash_r}\""" 1>&6
+ else echo "$ac_t""NONE" 1>&6
+ fi
+fi
+
+xe_add_unique_runpath_dir='
+ xe_add_p=yes
+ for xe_dir in $runpath_dirs; do test "$xe_dir" = "$xe_runpath_dir" && xe_add_p=no
+ done
+ if test "$xe_add_p" = "yes"; then
+ test -n "$runpath" && runpath="${runpath}:"
+ runpath="${runpath}${xe_runpath_dir}"
+ runpath_dirs="$runpath_dirs $xe_runpath_dir"
+ fi'
+
+
+
+
+if test "$add_runtime_path" = "yes" -a -n "$dash_r"; then
+ ld_switch_site=`echo '' $ld_switch_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//g"`
+ ld_switch_x_site=`echo '' $ld_switch_x_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//g"`
+
+ runpath="" runpath_dirs=""
+ if test -n "$LD_RUN_PATH"; then
+ runpath="$LD_RUN_PATH"
+ elif test "$GCC" = "yes"; then
+ ld_switch_run_save="$ld_switch_run"; ld_switch_run=""
+ echo "int main(int argc, char *argv[]) {return 0;}" > conftest.c
+ xe_runpath_link='${CC-cc} -o conftest -v $CFLAGS '"$xe_ldflags"' conftest.$ac_ext 2>&1 1>/dev/null'
+ for arg in `eval "$xe_runpath_link" | grep ' -L'`; do
+ case "$arg" in P,* | -L* | -R* )
+ for dir in `echo '' "$arg" | sed -e 's:^ ::' -e 's/^..//' -e 'y/:/ /'`; do
+ {
+xe_runpath_dir="$dir"
+ test "$xe_runpath_dir" != "/lib" -a \
+ "$xe_runpath_dir" != "/usr/lib" -a \
+ -n "`ls ${xe_runpath_dir}/*.s[ol] 2>/dev/null`" && \
+ eval "$xe_add_unique_runpath_dir"
+}
+ done ;;
+ esac
+ done
+ ld_switch_run="$ld_switch_run_save"
+ rm -f conftest*
+ else
+ for arg in $ld_switch_site $ld_switch_x_site; do
+ case "$arg" in -L*) {
+xe_runpath_dir=`echo '' "$arg" | sed -e 's:^ ::' -e 's/^-L//'`
+ test "$xe_runpath_dir" != "/lib" -a \
+ "$xe_runpath_dir" != "/usr/lib" -a \
+ -n "`ls ${xe_runpath_dir}/*.s[ol] 2>/dev/null`" && \
+ eval "$xe_add_unique_runpath_dir"
+};; esac
+ done
+ if test "$opsys $need_motif" = "sol2 yes"; then
+ xe_runpath_dir="/opt/SUNWdt/lib";
+ eval "$xe_add_unique_runpath_dir";
+ fi
+ fi
+ if test -n "$runpath"; then
+ ld_switch_run="${dash_r}${runpath}"
+
+if test "$GCC" = "yes"; then
+ set x $ld_switch_run; shift; ld_switch_run=""
+ while test -n "$1"; do
+ case $1 in
+ -L | -l | -u ) ld_switch_run="$ld_switch_run $1 $2"; shift ;;
+ -L* | -l* | -u* | -Wl* ) ld_switch_run="$ld_switch_run $1" ;;
+ -Xlinker* ) ;;
+ * ) ld_switch_run="$ld_switch_run -Xlinker $1" ;;
+ esac
+ shift
+ done
+fi
+ test "$extra_verbose" = "yes" && echo "Setting runpath to $runpath"
+ fi
+fi
+
+
+
+GNU_MALLOC=yes
+if test "$with_dlmalloc" != "no"; then
+ doug_lea_malloc=yes
+else
+ doug_lea_malloc=no
+fi
+after_morecore_hook_exists=yes
+echo $ac_n "checking for malloc_get_state""... $ac_c" 1>&6
+echo "configure:2624: checking for malloc_get_state" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 2627 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char malloc_get_state(); below. */
+#include <assert.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 malloc_get_state();
+
+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_malloc_get_state) || defined (__stub___malloc_get_state)
+choke me
+#else
+malloc_get_state();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:2650: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ eval "ac_cv_func_malloc_get_state=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_malloc_get_state=no"
+fi
+rm -f conftest*
+
+if eval "test \"`echo '$ac_cv_func_'malloc_get_state`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+doug_lea_malloc=no
+fi
+
+echo $ac_n "checking for malloc_set_state""... $ac_c" 1>&6
+echo "configure:2670: checking for malloc_set_state" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 2673 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char malloc_set_state(); below. */
+#include <assert.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 malloc_set_state();
+
+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_malloc_set_state) || defined (__stub___malloc_set_state)
+choke me
+#else
+malloc_set_state();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:2696: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ eval "ac_cv_func_malloc_set_state=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_malloc_set_state=no"
+fi
+rm -f conftest*
+
+if eval "test \"`echo '$ac_cv_func_'malloc_set_state`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+doug_lea_malloc=no
+fi
+
+echo $ac_n "checking whether __after_morecore_hook exists""... $ac_c" 1>&6
+echo "configure:2716: checking whether __after_morecore_hook exists" >&5
+cat > conftest.$ac_ext <<EOF
+#line 2718 "configure"
+#include "confdefs.h"
+extern void (* __after_morecore_hook)();
+int main() {
+__after_morecore_hook = 0
+; return 0; }
+EOF
+if { (eval echo configure:2725: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ echo "$ac_t""yes" 1>&6
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ echo "$ac_t""no" 1>&6
+ after_morecore_hook_exists=no
+fi
+rm -f conftest*
+if test "$system_malloc" = "yes" ; then
+ GNU_MALLOC=no
+ GNU_MALLOC_reason="
+ (The GNU allocators don't work with this system configuration)."
+elif test "$with_system_malloc" = "yes" ; then
+ GNU_MALLOC=no
+ GNU_MALLOC_reason="
+ (User chose not to use GNU allocators)."
+elif test "$with_debug_malloc" = "yes" ; then
+ GNU_MALLOC=no
+ GNU_MALLOC_reason="
+ (User chose to use Debugging Malloc)."
+fi
+
+if test "$doug_lea_malloc" = "yes" ; then
+ if test "$GNU_MALLOC" = yes ; then
+ GNU_MALLOC_reason="
+ (Using Doug Lea's new malloc from the GNU C Library.)"
+ fi
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining DOUG_LEA_MALLOC
+EOF
+cat >> confdefs.h <<\EOF
+#define DOUG_LEA_MALLOC 1
+EOF
+}
+
+ if test "$after_morecore_hook_exists" = "no" ; then
+ GNU_MALLOC_reason="
+ (Using Doug Lea's new malloc from the Linux C Library.)"
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining _NO_MALLOC_WARNING_
+EOF
+cat >> confdefs.h <<\EOF
+#define _NO_MALLOC_WARNING_ 1
+EOF
+}
+
+ fi
+ use_minimal_tagbits=yes
+fi
+
+
+
+
+# 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:2784: checking for $ac_word" >&5
+
+if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:"
+ for ac_dir in $PATH; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_RANLIB="ranlib"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+ echo "$ac_t""$RANLIB" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ac_aux_dir=
+for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# 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:2837: checking for a BSD compatible install" >&5
+if test -z "$INSTALL"; then
+
+ IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS="${IFS}:"
+ for ac_dir in $PATH; do
+ # Account for people who put trailing slashes in PATH elements.
+ case "$ac_dir/" in
+ /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ for ac_prog in ginstall installbsd scoinst install; do
+ if test -f $ac_dir/$ac_prog; then
+ if test $ac_prog = install &&
+ grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ # OSF/1 installbsd also uses dspmsg, but is usable.
+ :
+ else
+ ac_cv_path_install="$ac_dir/$ac_prog -c"
+ break 2
+ fi
+ fi
+ done
+ ;;
+ esac
+ done
+ IFS="$ac_save_IFS"
+
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL="$ac_cv_path_install"
+ else
+ # As a last resort, use the slow shell script. We don't cache a
+ # path for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the path is relative.
+ INSTALL="$ac_install_sh"
+ fi
+fi
+echo "$ac_t""$INSTALL" 1>&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+for ac_prog in 'bison -y' byacc
+do
+# 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:2888: checking for $ac_word" >&5
+
+if test -n "$YACC"; then
+ ac_cv_prog_YACC="$YACC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:"
+ for ac_dir in $PATH; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_YACC="$ac_prog"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+YACC="$ac_cv_prog_YACC"
+if test -n "$YACC"; then
+ echo "$ac_t""$YACC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+test -n "$YACC" && break
+done
+test -n "$YACC" || YACC="yacc"
+
+
+for ac_hdr in mach/mach.h sys/stropts.h sys/timeb.h sys/time.h unistd.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:2919: checking for $ac_hdr" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 2922 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2927: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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 <<EOF
+#define $ac_tr_hdr 1
+EOF
+}
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+for ac_hdr in utime.h locale.h libgen.h fcntl.h ulimit.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:2960: checking for $ac_hdr" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 2963 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2968: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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 <<EOF
+#define $ac_tr_hdr 1
+EOF
+}
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+for ac_hdr in linux/version.h kstat.h sys/pstat.h inttypes.h sys/un.h a.out.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:3001: checking for $ac_hdr" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 3004 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:3009: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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 <<EOF
+#define $ac_tr_hdr 1
+EOF
+}
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+echo $ac_n "checking for sys/wait.h that is POSIX.1 compatible""... $ac_c" 1>&6
+echo "configure:3039: checking for sys/wait.h that is POSIX.1 compatible" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 3042 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/wait.h>
+#ifndef WEXITSTATUS
+#define WEXITSTATUS(stat_val) ((unsigned)(stat_val) >> 8)
+#endif
+#ifndef WIFEXITED
+#define WIFEXITED(stat_val) (((stat_val) & 255) == 0)
+#endif
+int main() {
+int s;
+wait (&s);
+s = WIFEXITED (s) ? WEXITSTATUS (s) : 1;
+; return 0; }
+EOF
+if { (eval echo configure:3058: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_header_sys_wait_h=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_header_sys_wait_h=no
+fi
+rm -f conftest*
+
+echo "$ac_t""$ac_cv_header_sys_wait_h" 1>&6
+if test $ac_cv_header_sys_wait_h = yes; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_SYS_WAIT_H
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_SYS_WAIT_H 1
+EOF
+}
+
+fi
+
+echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6
+echo "configure:3082: checking for ANSI C header files" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 3085 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:3093: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ ac_cv_header_stdc=yes
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+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
+#line 3110 "configure"
+#include "confdefs.h"
+#include <string.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "memchr" >/dev/null 2>&1; then
+ :
+else
+ rm -rf conftest*
+ ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+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
+#line 3128 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "free" >/dev/null 2>&1; then
+ :
+else
+ rm -rf conftest*
+ ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+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 <<EOF
+#line 3146 "configure"
+#include "confdefs.h"
+#include <ctype.h>
+#define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+#define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
+int main () { int i; for (i = 0; i < 256; i++)
+if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2);
+exit (0); }
+
+EOF
+if { (eval echo configure:3157: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5
+then
+ :
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_header_stdc=no
+fi
+rm -fr conftest*
+fi
+
+echo "$ac_t""$ac_cv_header_stdc" 1>&6
+if test $ac_cv_header_stdc = yes; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining STDC_HEADERS
+EOF
+cat >> confdefs.h <<\EOF
+#define STDC_HEADERS 1
+EOF
+}
+
+fi
+
+echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6
+echo "configure:3182: checking whether time.h and sys/time.h may both be included" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 3185 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/time.h>
+#include <time.h>
+int main() {
+struct tm *tp;
+; return 0; }
+EOF
+if { (eval echo configure:3194: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_header_time=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_header_time=no
+fi
+rm -f conftest*
+
+echo "$ac_t""$ac_cv_header_time" 1>&6
+if test $ac_cv_header_time = yes; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining TIME_WITH_SYS_TIME
+EOF
+cat >> confdefs.h <<\EOF
+#define TIME_WITH_SYS_TIME 1
+EOF
+}
+
+fi
+
+echo $ac_n "checking for sys_siglist declaration in signal.h or unistd.h""... $ac_c" 1>&6
+echo "configure:3218: checking for sys_siglist declaration in signal.h or unistd.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 3221 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <signal.h>
+/* NetBSD declares sys_siglist in unistd.h. */
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+int main() {
+char *msg = *(sys_siglist + 1);
+; return 0; }
+EOF
+if { (eval echo configure:3233: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_decl_sys_siglist=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_decl_sys_siglist=no
+fi
+rm -f conftest*
+
+echo "$ac_t""$ac_cv_decl_sys_siglist" 1>&6
+if test $ac_cv_decl_sys_siglist = yes; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining SYS_SIGLIST_DECLARED
+EOF
+cat >> confdefs.h <<\EOF
+#define SYS_SIGLIST_DECLARED 1
+EOF
+}
+
+fi
+
+
+echo $ac_n "checking for struct utimbuf""... $ac_c" 1>&6
+echo "configure:3258: checking for struct utimbuf" >&5
+cat > conftest.$ac_ext <<EOF
+#line 3260 "configure"
+#include "confdefs.h"
+#ifdef TIME_WITH_SYS_TIME
+#include <sys/time.h>
+#include <time.h>
+#else
+#ifdef HAVE_SYS_TIME_H
+#include <sys/time.h>
+#else
+#include <time.h>
+#endif
+#endif
+#ifdef HAVE_UTIME_H
+#include <utime.h>
+#endif
+int main() {
+static struct utimbuf x; x.actime = x.modtime;
+; return 0; }
+EOF
+if { (eval echo configure:3279: \"$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
+ Defining HAVE_STRUCT_UTIMBUF
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_STRUCT_UTIMBUF 1
+EOF
+}
+
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ echo "$ac_t""no" 1>&6
+fi
+rm -f conftest*
+
+echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6
+echo "configure:3299: checking return type of signal handlers" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 3302 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <signal.h>
+#ifdef signal
+#undef signal
+#endif
+#ifdef __cplusplus
+extern "C" void (*signal (int, void (*)(int)))(int);
+#else
+void (*signal ()) ();
+#endif
+
+int main() {
+int i;
+; return 0; }
+EOF
+if { (eval echo configure:3319: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_type_signal=void
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_type_signal=int
+fi
+rm -f conftest*
+
+echo "$ac_t""$ac_cv_type_signal" 1>&6
+{ test "$extra_verbose" = "yes" && cat << EOF
+ Defining RETSIGTYPE = $ac_cv_type_signal
+EOF
+cat >> confdefs.h <<EOF
+#define RETSIGTYPE $ac_cv_type_signal
+EOF
+}
+
+
+echo $ac_n "checking for size_t""... $ac_c" 1>&6
+echo "configure:3341: checking for size_t" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 3344 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "size_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_size_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_size_t=no
+fi
+rm -f conftest*
+
+echo "$ac_t""$ac_cv_type_size_t" 1>&6
+if test $ac_cv_type_size_t = no; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining size_t = unsigned
+EOF
+cat >> confdefs.h <<\EOF
+#define size_t unsigned
+EOF
+}
+
+fi
+
+echo $ac_n "checking for pid_t""... $ac_c" 1>&6
+echo "configure:3375: checking for pid_t" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 3378 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "pid_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_pid_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_pid_t=no
+fi
+rm -f conftest*
+
+echo "$ac_t""$ac_cv_type_pid_t" 1>&6
+if test $ac_cv_type_pid_t = no; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining pid_t = int
+EOF
+cat >> confdefs.h <<\EOF
+#define pid_t int
+EOF
+}
+
+fi
+
+echo $ac_n "checking for uid_t in sys/types.h""... $ac_c" 1>&6
+echo "configure:3409: checking for uid_t in sys/types.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 3412 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "uid_t" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_uid_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_uid_t=no
+fi
+rm -f conftest*
+
+
+echo "$ac_t""$ac_cv_type_uid_t" 1>&6
+if test $ac_cv_type_uid_t = no; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining uid_t = int
+EOF
+cat >> confdefs.h <<\EOF
+#define uid_t int
+EOF
+}
+
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining gid_t = int
+EOF
+cat >> confdefs.h <<\EOF
+#define gid_t int
+EOF
+}
+
+fi
+
+echo $ac_n "checking for mode_t""... $ac_c" 1>&6
+echo "configure:3448: checking for mode_t" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 3451 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "mode_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_mode_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_mode_t=no
+fi
+rm -f conftest*
+
+echo "$ac_t""$ac_cv_type_mode_t" 1>&6
+if test $ac_cv_type_mode_t = no; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining mode_t = int
+EOF
+cat >> confdefs.h <<\EOF
+#define mode_t int
+EOF
+}
+
+fi
+
+echo $ac_n "checking for off_t""... $ac_c" 1>&6
+echo "configure:3482: checking for off_t" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 3485 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "off_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_off_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_off_t=no
+fi
+rm -f conftest*
+
+echo "$ac_t""$ac_cv_type_off_t" 1>&6
+if test $ac_cv_type_off_t = no; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining off_t = long
+EOF
+cat >> confdefs.h <<\EOF
+#define off_t long
+EOF
+}
+
+fi
+
+
+echo $ac_n "checking for struct timeval""... $ac_c" 1>&6
+echo "configure:3517: checking for struct timeval" >&5
+cat > conftest.$ac_ext <<EOF
+#line 3519 "configure"
+#include "confdefs.h"
+#ifdef TIME_WITH_SYS_TIME
+#include <sys/time.h>
+#include <time.h>
+#else
+#ifdef HAVE_SYS_TIME_H
+#include <sys/time.h>
+#else
+#include <time.h>
+#endif
+#endif
+int main() {
+static struct timeval x; x.tv_sec = x.tv_usec;
+; return 0; }
+EOF
+if { (eval echo configure:3535: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ echo "$ac_t""yes" 1>&6
+ HAVE_TIMEVAL=yes
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_TIMEVAL
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_TIMEVAL 1
+EOF
+}
+
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ echo "$ac_t""no" 1>&6
+ HAVE_TIMEVAL=no
+fi
+rm -f conftest*
+
+echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6
+echo "configure:3557: checking whether struct tm is in sys/time.h or time.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 3560 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <time.h>
+int main() {
+struct tm *tp; tp->tm_sec;
+; return 0; }
+EOF
+if { (eval echo configure:3568: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_struct_tm=time.h
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_struct_tm=sys/time.h
+fi
+rm -f conftest*
+
+echo "$ac_t""$ac_cv_struct_tm" 1>&6
+if test $ac_cv_struct_tm = sys/time.h; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining TM_IN_SYS_TIME
+EOF
+cat >> confdefs.h <<\EOF
+#define TM_IN_SYS_TIME 1
+EOF
+}
+
+fi
+
+echo $ac_n "checking for tm_zone in struct tm""... $ac_c" 1>&6
+echo "configure:3592: checking for tm_zone in struct tm" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 3595 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <$ac_cv_struct_tm>
+int main() {
+struct tm tm; tm.tm_zone;
+; return 0; }
+EOF
+if { (eval echo configure:3603: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_struct_tm_zone=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_struct_tm_zone=no
+fi
+rm -f conftest*
+
+echo "$ac_t""$ac_cv_struct_tm_zone" 1>&6
+if test "$ac_cv_struct_tm_zone" = yes; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_TM_ZONE
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_TM_ZONE 1
+EOF
+}
+
+else
+ echo $ac_n "checking for tzname""... $ac_c" 1>&6
+echo "configure:3626: checking for tzname" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 3629 "configure"
+#include "confdefs.h"
+#include <time.h>
+#ifndef tzname /* For SGI. */
+extern char *tzname[]; /* RS6000 and others reject char **tzname. */
+#endif
+int main() {
+atoi(*tzname);
+; return 0; }
+EOF
+if { (eval echo configure:3639: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ ac_cv_var_tzname=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_var_tzname=no
+fi
+rm -f conftest*
+
+echo "$ac_t""$ac_cv_var_tzname" 1>&6
+ if test $ac_cv_var_tzname = yes; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_TZNAME
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_TZNAME 1
+EOF
+}
+
+ fi
+fi
+
+
+echo $ac_n "checking for working const""... $ac_c" 1>&6
+echo "configure:3665: checking for working const" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 3668 "configure"
+#include "confdefs.h"
+
+int main() {
+
+/* Ultrix mips cc rejects this. */
+typedef int charset[2]; const charset x;
+/* SunOS 4.1.1 cc rejects this. */
+char const *const *ccp;
+char **p;
+/* NEC SVR4.0.2 mips cc rejects this. */
+struct point {int x, y;};
+static struct point const zero = {0,0};
+/* AIX XL C 1.02.0.0 rejects this.
+ It does not let you subtract one const X* pointer from another in an arm
+ of an if-expression whose if-part is not a constant expression */
+const char *g = "string";
+ccp = &g + (g ? g-g : 0);
+/* HPUX 7.0 cc rejects these. */
+++ccp;
+p = (char**) ccp;
+ccp = (char const *const *) p;
+{ /* SCO 3.2v4 cc rejects this. */
+ char *t;
+ char const *s = 0 ? (char *) 0 : (char const *) 0;
+
+ *t++ = 0;
+}
+{ /* Someone thinks the Sun supposedly-ANSI compiler will reject this. */
+ int x[] = {25, 17};
+ const int *foo = &x[0];
+ ++foo;
+}
+{ /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */
+ typedef const int *iptr;
+ iptr p = 0;
+ ++p;
+}
+{ /* AIX XL C 1.02.0.0 rejects this saying
+ "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */
+ struct s { int j; const int *ap[3]; };
+ struct s *b; b->j = 5;
+}
+{ /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */
+ const int foo = 10;
+}
+
+; return 0; }
+EOF
+if { (eval echo configure:3717: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_c_const=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_c_const=no
+fi
+rm -f conftest*
+
+echo "$ac_t""$ac_cv_c_const" 1>&6
+if test $ac_cv_c_const = no; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining const =
+EOF
+cat >> confdefs.h <<\EOF
+#define const
+EOF
+}
+
+fi
+
+
+echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6
+echo "configure:3742: checking whether ${MAKE-make} sets \${MAKE}" >&5
+set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'`
+
+cat > conftestmake <<\EOF
+all:
+ @echo 'ac_maketemp="${MAKE}"'
+EOF
+# GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+eval `${MAKE-make} -f conftestmake 2>/dev/null | grep temp=`
+if test -n "$ac_maketemp"; then
+ eval ac_cv_prog_make_${ac_make}_set=yes
+else
+ eval ac_cv_prog_make_${ac_make}_set=no
+fi
+rm -f conftestmake
+if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ SET_MAKE=
+else
+ echo "$ac_t""no" 1>&6
+ SET_MAKE="MAKE=${MAKE-make}"
+fi
+
+
+echo $ac_n "checking whether byte ordering is bigendian""... $ac_c" 1>&6
+echo "configure:3767: 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 <<EOF
+#line 3772 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/param.h>
+int main() {
+
+#if !BYTE_ORDER || !BIG_ENDIAN || !LITTLE_ENDIAN
+ bogus endian macros
+#endif
+; return 0; }
+EOF
+if { (eval echo configure:3783: \"$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 <<EOF
+#line 3787 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/param.h>
+int main() {
+
+#if BYTE_ORDER != BIG_ENDIAN
+ not big endian
+#endif
+; return 0; }
+EOF
+if { (eval echo configure:3798: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_c_bigendian=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_c_bigendian=no
+fi
+rm -f conftest*
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+fi
+rm -f conftest*
+if test $ac_cv_c_bigendian = unknown; then
+cat > conftest.$ac_ext <<EOF
+#line 3815 "configure"
+#include "confdefs.h"
+main () {
+ /* Are we little or big endian? From Harbison&Steele. */
+ union
+ {
+ long l;
+ char c[sizeof (long)];
+ } u;
+ u.l = 1;
+ exit (u.c[sizeof (long) - 1] == 1);
+}
+EOF
+if { (eval echo configure:3828: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5
+then
+ ac_cv_c_bigendian=no
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_c_bigendian=yes
+fi
+rm -fr conftest*
+fi
+
+echo "$ac_t""$ac_cv_c_bigendian" 1>&6
+if test $ac_cv_c_bigendian = yes; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining WORDS_BIGENDIAN
+EOF
+cat >> confdefs.h <<\EOF
+#define WORDS_BIGENDIAN 1
+EOF
+}
+
+fi
+
+
+echo $ac_n "checking size of short""... $ac_c" 1>&6
+echo "configure:3854: checking size of short" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 3857 "configure"
+#include "confdefs.h"
+#include <stdio.h>
+main()
+{
+ FILE *f=fopen("conftestval", "w");
+ if (!f) exit(1);
+ fprintf(f, "%d\n", sizeof(short));
+ exit(0);
+}
+EOF
+if { (eval echo configure:3868: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5
+then
+ ac_cv_sizeof_short=`cat conftestval`
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_sizeof_short=0
+fi
+rm -fr conftest*
+echo "$ac_t""$ac_cv_sizeof_short" 1>&6
+{ test "$extra_verbose" = "yes" && cat << EOF
+ Defining SIZEOF_SHORT = $ac_cv_sizeof_short
+EOF
+cat >> confdefs.h <<EOF
+#define SIZEOF_SHORT $ac_cv_sizeof_short
+EOF
+}
+
+
+if test "$ac_cv_sizeof_short" = 0; then
+ echo ""
+ echo "*** PANIC *** Configure tests are not working - compiler is broken."
+ echo "*** PANIC *** Please examine config.log for compilation errors."
+ exit 1
+fi
+echo $ac_n "checking size of int""... $ac_c" 1>&6
+echo "configure:3895: checking size of int" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 3898 "configure"
+#include "confdefs.h"
+#include <stdio.h>
+main()
+{
+ FILE *f=fopen("conftestval", "w");
+ if (!f) exit(1);
+ fprintf(f, "%d\n", sizeof(int));
+ exit(0);
+}
+EOF
+if { (eval echo configure:3909: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5
+then
+ ac_cv_sizeof_int=`cat conftestval`
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_sizeof_int=0
+fi
+rm -fr conftest*
+echo "$ac_t""$ac_cv_sizeof_int" 1>&6
+{ test "$extra_verbose" = "yes" && cat << EOF
+ Defining SIZEOF_INT = $ac_cv_sizeof_int
+EOF
+cat >> confdefs.h <<EOF
+#define SIZEOF_INT $ac_cv_sizeof_int
+EOF
+}
+
+
+echo $ac_n "checking size of long""... $ac_c" 1>&6
+echo "configure:3930: checking size of long" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 3933 "configure"
+#include "confdefs.h"
+#include <stdio.h>
+main()
+{
+ FILE *f=fopen("conftestval", "w");
+ if (!f) exit(1);
+ fprintf(f, "%d\n", sizeof(long));
+ exit(0);
+}
+EOF
+if { (eval echo configure:3944: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5
+then
+ ac_cv_sizeof_long=`cat conftestval`
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_sizeof_long=0
+fi
+rm -fr conftest*
+echo "$ac_t""$ac_cv_sizeof_long" 1>&6
+{ test "$extra_verbose" = "yes" && cat << EOF
+ Defining SIZEOF_LONG = $ac_cv_sizeof_long
+EOF
+cat >> confdefs.h <<EOF
+#define SIZEOF_LONG $ac_cv_sizeof_long
+EOF
+}
+
+
+echo $ac_n "checking size of long long""... $ac_c" 1>&6
+echo "configure:3965: checking size of long long" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 3968 "configure"
+#include "confdefs.h"
+#include <stdio.h>
+main()
+{
+ FILE *f=fopen("conftestval", "w");
+ if (!f) exit(1);
+ fprintf(f, "%d\n", sizeof(long long));
+ exit(0);
+}
+EOF
+if { (eval echo configure:3979: \"$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
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_sizeof_long_long=0
+fi
+rm -fr conftest*
+echo "$ac_t""$ac_cv_sizeof_long_long" 1>&6
+{ test "$extra_verbose" = "yes" && cat << EOF
+ Defining SIZEOF_LONG_LONG = $ac_cv_sizeof_long_long
+EOF
+cat >> confdefs.h <<EOF
+#define SIZEOF_LONG_LONG $ac_cv_sizeof_long_long
+EOF
+}
+
+
+echo $ac_n "checking size of void *""... $ac_c" 1>&6
+echo "configure:4000: checking size of void *" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 4003 "configure"
+#include "confdefs.h"
+#include <stdio.h>
+main()
+{
+ FILE *f=fopen("conftestval", "w");
+ if (!f) exit(1);
+ fprintf(f, "%d\n", sizeof(void *));
+ exit(0);
+}
+EOF
+if { (eval echo configure:4014: \"$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
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_sizeof_void_p=0
+fi
+rm -fr conftest*
+echo "$ac_t""$ac_cv_sizeof_void_p" 1>&6
+{ test "$extra_verbose" = "yes" && cat << EOF
+ Defining SIZEOF_VOID_P = $ac_cv_sizeof_void_p
+EOF
+cat >> confdefs.h <<EOF
+#define SIZEOF_VOID_P $ac_cv_sizeof_void_p
+EOF
+}
+
+
+
+echo $ac_n "checking for long file names""... $ac_c" 1>&6
+echo "configure:4036: 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:
+# . the current directory, where building will happen
+# $prefix/lib where we will be installing things
+# $exec_prefix/lib likewise
+# eval it to expand exec_prefix.
+# $TMPDIR if set, where it might want to write temporary files
+# if $TMPDIR is not set:
+# /tmp where it might want to write temporary files
+# /var/tmp likewise
+# /usr/tmp likewise
+if test -n "$TMPDIR" && test -d "$TMPDIR" && test -w "$TMPDIR"; then
+ ac_tmpdirs="$TMPDIR"
+else
+ ac_tmpdirs='/tmp /var/tmp /usr/tmp'
+fi
+for ac_dir in . $ac_tmpdirs `eval echo $prefix/lib $exec_prefix/lib` ; do
+ test -d $ac_dir || continue
+ test -w $ac_dir || continue # It is less confusing to not echo anything here.
+ (echo 1 > $ac_dir/conftest9012345) 2>/dev/null
+ (echo 2 > $ac_dir/conftest9012346) 2>/dev/null
+ val=`cat $ac_dir/conftest9012345 2>/dev/null`
+ if test ! -f $ac_dir/conftest9012345 || test "$val" != 1; then
+ ac_cv_sys_long_file_names=no
+ rm -f $ac_dir/conftest9012345 $ac_dir/conftest9012346 2>/dev/null
+ break
+ fi
+ rm -f $ac_dir/conftest9012345 $ac_dir/conftest9012346 2>/dev/null
+done
+
+echo "$ac_t""$ac_cv_sys_long_file_names" 1>&6
+if test $ac_cv_sys_long_file_names = yes; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_LONG_FILE_NAMES
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_LONG_FILE_NAMES 1
+EOF
+}
+
+fi
+
+
+
+echo $ac_n "checking for sin in -lm""... $ac_c" 1>&6
+echo "configure:4083: checking for sin in -lm" >&5
+ac_lib_var=`echo m'_'sin | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lm "
+cat > conftest.$ac_ext <<EOF
+#line 4088 "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 sin();
+
+int main() {
+sin()
+; return 0; }
+EOF
+if { (eval echo configure:4099: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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 m | 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 <<EOF
+#define $ac_tr_lib 1
+EOF
+}
+
+ LIBS="-lm $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lm\" to \$LIBS"; fi
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+
+{ test "$extra_verbose" = "yes" && cat << \EOF
+ Defining LISP_FLOAT_TYPE
+EOF
+cat >> confdefs.h <<\EOF
+#define LISP_FLOAT_TYPE 1
+EOF
+}
+
+
+cat > conftest.$ac_ext <<EOF
+#line 4141 "configure"
+#include "confdefs.h"
+#include <math.h>
+int main() {
+return atanh(1.0) + asinh(1.0) + acosh(1.0);
+; return 0; }
+EOF
+if { (eval echo configure:4148: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_INVERSE_HYPERBOLIC
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_INVERSE_HYPERBOLIC 1
+EOF
+}
+
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+fi
+rm -f conftest*
+
+echo "checking type of mail spool file locking" 1>&6
+echo "configure:4165: checking type of mail spool file locking" >&5
+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 { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining REAL_MAIL_USE_LOCKF
+EOF
+cat >> confdefs.h <<\EOF
+#define REAL_MAIL_USE_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:4189: 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 <<EOF
+#line 4194 "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 kstat_open();
+
+int main() {
+kstat_open()
+; return 0; }
+EOF
+if { (eval echo configure:4205: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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 <<EOF
+#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:4239: 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 <<EOF
+#line 4244 "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 kvm_read();
+
+int main() {
+kvm_read()
+; return 0; }
+EOF
+if { (eval echo configure:4255: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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 <<EOF
+#define $ac_tr_lib 1
+EOF
+}
+
+ LIBS="-lkvm $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lkvm\" to \$LIBS"; fi
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+
+case "$opsys" in decosf*)
+
+echo $ac_n "checking for cma_open in -lpthreads""... $ac_c" 1>&6
+echo "configure:4290: 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 <<EOF
+#line 4295 "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 cma_open();
+
+int main() {
+cma_open()
+; return 0; }
+EOF
+if { (eval echo configure:4306: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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 pthreads | 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 <<EOF
+#define $ac_tr_lib 1
+EOF
+}
+
+ LIBS="-lpthreads $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lpthreads\" to \$LIBS"; fi
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+ test "$ac_cv_lib_pthreads_cma_open" = "yes" && \
+ c_switch_site="$c_switch_site -threads" ;;
+esac
+
+echo $ac_n "checking whether the -xildoff compiler flag is required""... $ac_c" 1>&6
+echo "configure:4342: 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;
+ else echo "$ac_t""yes" 1>&6; ld_switch_site="$ld_switch_site -xildoff" && if test "$extra_verbose" = "yes"; then echo " Appending \"-xildoff\" to \$ld_switch_site"; fi
+ fi
+ else echo "$ac_t""no" 1>&6
+fi
+
+if test "$opsys" = "sol2" && test "$OS_RELEASE" -ge 56; then
+ echo $ac_n "checking for \"-z ignore\" linker flag""... $ac_c" 1>&6
+echo "configure:4353: 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 ;;
+ *) echo "$ac_t""no" 1>&6 ;;
+ esac
+fi
+
+
+echo "checking "for specified window system"" 1>&6
+echo "configure:4363: checking "for specified window system"" >&5
+
+if test "$with_x11" != "no"; then
+ test "$x_includes $x_libraries" != "NONE NONE" && \
+ window_system=x11 with_x11=yes
+
+
+ if test "$x_includes $x_libraries" = "NONE NONE" \
+ -a -n "$OPENWINHOME" \
+ -a "$OPENWINHOME" != "/usr/openwin" \
+ -a -d "$OPENWINHOME"; then
+ test -d "$OPENWINHOME/lib" && x_libraries="$OPENWINHOME/lib"
+ test -d "$OPENWINHOME/include" && x_includes="$OPENWINHOME/include"
+ test -d "$OPENWINHOME/share/include" && x_includes="$OPENWINHOME/share/include"
+ fi
+
+ if test "$x_includes" = "NONE"; then
+ for dir in "/usr/X11" "/usr/X11R6"; do
+ if test -d "$dir/include/X11"; then x_includes="$dir/include"; break; fi
+ done
+ fi
+
+ if test "$x_libraries" = "NONE"; then
+ for dir in "/usr/X11/lib" "/usr/X11R6/lib" "/usr/lib/X11R6"; do
+ if test -r "$dir/libX11.a"; then x_libraries="$dir"; break; fi
+ done
+ fi
+
+ # If we find X, set shell vars x_includes and x_libraries to the
+# paths, otherwise set no_x=yes.
+# 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:4396: checking for X" >&5
+
+# Check whether --with-x or --without-x was given.
+if test "${with_x+set}" = set; then
+ withval="$with_x"
+ :
+fi
+
+# $have_x is `yes', `no', `disabled', or empty when we do not yet know.
+if test "x$with_x" = xno; then
+ # The user explicitly disabled X.
+ have_x=disabled
+else
+ if test "x$x_includes" != xNONE && test "x$x_libraries" != xNONE; then
+ # Both variables are already set.
+ have_x=yes
+ else
+
+# One or both of the vars are not set, and there is no cached value.
+ac_x_includes=NO ac_x_libraries=NO
+rm -fr conftestdir
+if mkdir conftestdir; then
+ cd conftestdir
+ # Make sure to not put "make" in the Imakefile rules, since we grep it out.
+ cat > Imakefile <<'EOF'
+acfindx:
+ @echo 'ac_im_incroot="${INCROOT}"; ac_im_usrlibdir="${USRLIBDIR}"; ac_im_libdir="${LIBDIR}"'
+EOF
+ if (xmkmf) >/dev/null 2>/dev/null && test -f Makefile; then
+ # GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+ eval `${MAKE-make} acfindx 2>/dev/null | grep -v make`
+ # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR.
+ for ac_extension in a so sl; do
+ if test ! -f $ac_im_usrlibdir/libX11.$ac_extension &&
+ test -f $ac_im_libdir/libX11.$ac_extension; then
+ ac_im_usrlibdir=$ac_im_libdir; break
+ fi
+ done
+ # Screen out bogus values from the imake configuration. They are
+ # bogus both because they are the default anyway, and because
+ # using them would break gcc on systems where it needs fixed includes.
+ case "$ac_im_incroot" in
+ /usr/include) ;;
+ *) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes="$ac_im_incroot" ;;
+ esac
+ case "$ac_im_usrlibdir" in
+ /usr/lib | /lib) ;;
+ *) test -d "$ac_im_usrlibdir" && ac_x_libraries="$ac_im_usrlibdir" ;;
+ esac
+ fi
+ cd ..
+ rm -fr conftestdir
+fi
+
+if test "$ac_x_includes" = NO; then
+ # Guess where to find include files, by looking for this one X11 .h file.
+ test -z "$x_direct_test_include" && x_direct_test_include=X11/Intrinsic.h
+
+ # First, try using that file with no special directory specified.
+cat > conftest.$ac_ext <<EOF
+#line 4456 "configure"
+#include "confdefs.h"
+#include <$x_direct_test_include>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:4461: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ # We can compile using X headers with no special include directory.
+ac_x_includes=
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ # Look for the header file in a standard set of common directories.
+# Check X11 before X11Rn because it is often a symlink to the current release.
+ for ac_dir in \
+ /usr/X11/include \
+ /usr/X11R6/include \
+ /usr/X11R5/include \
+ /usr/X11R4/include \
+ \
+ /usr/include/X11 \
+ /usr/include/X11R6 \
+ /usr/include/X11R5 \
+ /usr/include/X11R4 \
+ \
+ /usr/local/X11/include \
+ /usr/local/X11R6/include \
+ /usr/local/X11R5/include \
+ /usr/local/X11R4/include \
+ \
+ /usr/local/include/X11 \
+ /usr/local/include/X11R6 \
+ /usr/local/include/X11R5 \
+ /usr/local/include/X11R4 \
+ \
+ /usr/X386/include \
+ /usr/x386/include \
+ /usr/XFree86/include/X11 \
+ \
+ /usr/include \
+ /usr/local/include \
+ /usr/unsupported/include \
+ /usr/athena/include \
+ /usr/local/x11r5/include \
+ /usr/lpp/Xamples/include \
+ \
+ /usr/openwin/include \
+ /usr/openwin/share/include \
+ ; \
+ do
+ if test -r "$ac_dir/$x_direct_test_include"; then
+ ac_x_includes=$ac_dir
+ break
+ fi
+ done
+fi
+rm -f conftest*
+fi # $ac_x_includes = NO
+
+if test "$ac_x_libraries" = NO; then
+ # Check for the libraries.
+
+ test -z "$x_direct_test_library" && x_direct_test_library=Xt
+ test -z "$x_direct_test_function" && x_direct_test_function=XtMalloc
+
+ # See if we find them without any special options.
+ # Don't add to $LIBS permanently.
+ ac_save_LIBS="$LIBS"
+ LIBS="-l$x_direct_test_library $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 4530 "configure"
+#include "confdefs.h"
+
+int main() {
+${x_direct_test_function}()
+; return 0; }
+EOF
+if { (eval echo configure:4537: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ LIBS="$ac_save_LIBS"
+# We can link X programs with no special library path.
+ac_x_libraries=
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ LIBS="$ac_save_LIBS"
+# First see if replacing the include by lib works.
+# Check X11 before X11Rn because it is often a symlink to the current release.
+for ac_dir in `echo "$ac_x_includes" | sed s/include/lib/` \
+ /usr/X11/lib \
+ /usr/X11R6/lib \
+ /usr/X11R5/lib \
+ /usr/X11R4/lib \
+ \
+ /usr/lib/X11 \
+ /usr/lib/X11R6 \
+ /usr/lib/X11R5 \
+ /usr/lib/X11R4 \
+ \
+ /usr/local/X11/lib \
+ /usr/local/X11R6/lib \
+ /usr/local/X11R5/lib \
+ /usr/local/X11R4/lib \
+ \
+ /usr/local/lib/X11 \
+ /usr/local/lib/X11R6 \
+ /usr/local/lib/X11R5 \
+ /usr/local/lib/X11R4 \
+ \
+ /usr/X386/lib \
+ /usr/x386/lib \
+ /usr/XFree86/lib/X11 \
+ \
+ /usr/lib \
+ /usr/local/lib \
+ /usr/unsupported/lib \
+ /usr/athena/lib \
+ /usr/local/x11r5/lib \
+ /usr/lpp/Xamples/lib \
+ /lib/usr/lib/X11 \
+ \
+ /usr/openwin/lib \
+ /usr/openwin/share/lib \
+ ; \
+do
+ for ac_extension in a so sl; do
+ if test -r $ac_dir/lib${x_direct_test_library}.$ac_extension; then
+ ac_x_libraries=$ac_dir
+ break 2
+ fi
+ done
+done
+fi
+rm -f conftest*
+fi # $ac_x_libraries = NO
+
+if test "$ac_x_includes" = NO || test "$ac_x_libraries" = NO; then
+ # Didn't find X anywhere. Cache the known absence of X.
+ ac_cv_have_x="have_x=no"
+else
+ # Record where we found X for the cache.
+ ac_cv_have_x="have_x=yes \
+ ac_x_includes=$ac_x_includes ac_x_libraries=$ac_x_libraries"
+fi
+ fi
+ eval "$ac_cv_have_x"
+fi # $with_x != no
+
+if test "$have_x" != yes; then
+ echo "$ac_t""$have_x" 1>&6
+ no_x=yes
+else
+ # If each of the values was on the command line, it overrides each guess.
+ test "x$x_includes" = xNONE && x_includes=$ac_x_includes
+ test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries
+ # Update the cache value to reflect the command line values.
+ ac_cv_have_x="have_x=yes \
+ ac_x_includes=$x_includes ac_x_libraries=$x_libraries"
+ echo "$ac_t""libraries $x_libraries, headers $x_includes" 1>&6
+fi
+
+if test "$no_x" = yes; then
+ # Not all programs may use this symbol, but it does not hurt to define it.
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining X_DISPLAY_MISSING
+EOF
+cat >> confdefs.h <<\EOF
+#define X_DISPLAY_MISSING 1
+EOF
+}
+
+ X_CFLAGS= X_PRE_LIBS= X_LIBS= X_EXTRA_LIBS=
+else
+ if test -n "$x_includes"; then
+ X_CFLAGS="$X_CFLAGS -I$x_includes"
+ fi
+
+ # It would also be nice to do this for all -L options, not just this one.
+ if test -n "$x_libraries"; then
+ X_LIBS="$X_LIBS -L$x_libraries"
+ # For Solaris; some versions of Sun CC require a space after -R and
+ # others require no space. Words are not sufficient . . . .
+ 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:4646: checking whether -R must be followed by a space" >&5
+ ac_xsave_LIBS="$LIBS"; LIBS="$LIBS -R$x_libraries"
+ cat > conftest.$ac_ext <<EOF
+#line 4649 "configure"
+#include "confdefs.h"
+
+int main() {
+
+; return 0; }
+EOF
+if { (eval echo configure:4656: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ ac_R_nospace=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_R_nospace=no
+fi
+rm -f conftest*
+ if test $ac_R_nospace = yes; then
+ echo "$ac_t""no" 1>&6
+ X_LIBS="$X_LIBS -R$x_libraries"
+ else
+ LIBS="$ac_xsave_LIBS -R $x_libraries"
+ cat > conftest.$ac_ext <<EOF
+#line 4672 "configure"
+#include "confdefs.h"
+
+int main() {
+
+; return 0; }
+EOF
+if { (eval echo configure:4679: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ ac_R_space=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_R_space=no
+fi
+rm -f conftest*
+ if test $ac_R_space = yes; then
+ echo "$ac_t""yes" 1>&6
+ X_LIBS="$X_LIBS -R $x_libraries"
+ else
+ echo "$ac_t""neither works" 1>&6
+ fi
+ fi
+ LIBS="$ac_xsave_LIBS"
+ esac
+ fi
+
+ # Check for system-dependent libraries X programs must link with.
+ # Do this before checking for the system-independent R6 libraries
+ # (-lICE), since we may need -lsocket or whatever for X linking.
+
+ if test "$ISC" = yes; then
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl_s -linet"
+ else
+ # Martyn.Johnson@cl.cam.ac.uk says this is needed for Ultrix, if the X
+ # libraries were built with DECnet support. And karl@cs.umb.edu says
+ # the Alpha needs dnet_stub (dnet does not exist).
+ if test "$with_dnet" = "no" ; then
+ac_cv_lib_dnet_dnet_ntoa=no
+else
+
+echo $ac_n "checking for dnet_ntoa in -ldnet""... $ac_c" 1>&6
+echo "configure:4715: 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 <<EOF
+#line 4720 "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 dnet_ntoa();
+
+int main() {
+dnet_ntoa()
+; return 0; }
+EOF
+if { (eval echo configure:4731: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+fi
+
+ 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:4755: 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 <<EOF
+#line 4760 "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 dnet_ntoa();
+
+int main() {
+dnet_ntoa()
+; return 0; }
+EOF
+if { (eval echo configure:4771: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet_stub"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+ fi
+
+ # msh@cis.ufl.edu says -lnsl (and -lsocket) are needed for his 386/AT,
+ # to get the SysV transport functions.
+ # chad@anasazi.com says the Pyramis MIS-ES running DC/OSx (SVR4)
+ # needs -lnsl.
+ # 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:4800: checking for gethostbyname" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 4803 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char gethostbyname(); below. */
+#include <assert.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 gethostbyname();
+
+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_gethostbyname) || defined (__stub___gethostbyname)
+choke me
+#else
+gethostbyname();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:4826: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ eval "ac_cv_func_gethostbyname=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_gethostbyname=no"
+fi
+rm -f conftest*
+
+if eval "test \"`echo '$ac_cv_func_'gethostbyname`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test $ac_cv_func_gethostbyname = no; then
+
+echo $ac_n "checking for gethostbyname in -lnsl""... $ac_c" 1>&6
+echo "configure:4847: checking for gethostbyname in -lnsl" >&5
+ac_lib_var=`echo nsl'_'gethostbyname | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lnsl "
+cat > conftest.$ac_ext <<EOF
+#line 4852 "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 gethostbyname();
+
+int main() {
+gethostbyname()
+; return 0; }
+EOF
+if { (eval echo configure:4863: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+ fi
+
+ # lieder@skyler.mavd.honeywell.com says without -lsocket,
+ # socket/setsockopt and other routines are undefined under SCO ODT
+ # 2.0. But -lsocket is broken on IRIX 5.2 (and is not necessary
+ # on later versions), says simon@lia.di.epfl.ch: it contains
+ # gethostby* variants that don't use the nameserver (or something).
+ # -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:4893: checking for connect" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 4896 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char connect(); below. */
+#include <assert.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 connect();
+
+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_connect) || defined (__stub___connect)
+choke me
+#else
+connect();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:4919: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ eval "ac_cv_func_connect=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_connect=no"
+fi
+rm -f conftest*
+
+if eval "test \"`echo '$ac_cv_func_'connect`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test $ac_cv_func_connect = no; then
+
+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:4942: 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 <<EOF
+#line 4947 "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 connect();
+
+int main() {
+connect()
+; return 0; }
+EOF
+if { (eval echo configure:4958: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ X_EXTRA_LIBS="-lsocket $X_EXTRA_LIBS"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+ fi
+
+ # gomez@mi.uni-erlangen.de says -lposix is necessary on A/UX.
+ echo $ac_n "checking for remove""... $ac_c" 1>&6
+echo "configure:4982: checking for remove" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 4985 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char remove(); below. */
+#include <assert.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 remove();
+
+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_remove) || defined (__stub___remove)
+choke me
+#else
+remove();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:5008: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ eval "ac_cv_func_remove=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_remove=no"
+fi
+rm -f conftest*
+
+if eval "test \"`echo '$ac_cv_func_'remove`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test $ac_cv_func_remove = no; then
+
+echo $ac_n "checking for remove in -lposix""... $ac_c" 1>&6
+echo "configure:5029: checking for remove in -lposix" >&5
+ac_lib_var=`echo posix'_'remove | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lposix "
+cat > conftest.$ac_ext <<EOF
+#line 5034 "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 remove();
+
+int main() {
+remove()
+; return 0; }
+EOF
+if { (eval echo configure:5045: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -lposix"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+ fi
+
+ # BSDI BSD/OS 2.1 needs -lipc for XOpenDisplay.
+ echo $ac_n "checking for shmat""... $ac_c" 1>&6
+echo "configure:5069: checking for shmat" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 5072 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char shmat(); below. */
+#include <assert.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 shmat();
+
+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_shmat) || defined (__stub___shmat)
+choke me
+#else
+shmat();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:5095: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ eval "ac_cv_func_shmat=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_shmat=no"
+fi
+rm -f conftest*
+
+if eval "test \"`echo '$ac_cv_func_'shmat`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test $ac_cv_func_shmat = no; then
+
+echo $ac_n "checking for shmat in -lipc""... $ac_c" 1>&6
+echo "configure:5116: checking for shmat in -lipc" >&5
+ac_lib_var=`echo ipc'_'shmat | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lipc "
+cat > conftest.$ac_ext <<EOF
+#line 5121 "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 shmat();
+
+int main() {
+shmat()
+; return 0; }
+EOF
+if { (eval echo configure:5132: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -lipc"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+ fi
+ fi
+
+ # Check for libraries that X11R6 Xt/Xaw programs need.
+ ac_save_LDFLAGS="$LDFLAGS"
+ test -n "$x_libraries" && LDFLAGS="$LDFLAGS -L$x_libraries"
+ # SM needs ICE to (dynamically) link under SunOS 4.x (so we have to
+ # check for ICE first), but we must link in the order -lSM -lICE or
+ # we get undefined symbols. So assume we have SM if we have ICE.
+ # These have to be linked with before -lX11, unlike the other
+ # libraries we check for below, so use a different variable.
+ # --interran@uluru.Stanford.EDU, kb@cs.umb.edu.
+
+echo $ac_n "checking for IceConnectionNumber in -lICE""... $ac_c" 1>&6
+echo "configure:5166: checking for IceConnectionNumber in -lICE" >&5
+ac_lib_var=`echo ICE'_'IceConnectionNumber | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lICE "
+cat > conftest.$ac_ext <<EOF
+#line 5171 "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 IceConnectionNumber();
+
+int main() {
+IceConnectionNumber()
+; return 0; }
+EOF
+if { (eval echo configure:5182: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ X_PRE_LIBS="$X_PRE_LIBS -lSM -lICE"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+ LDFLAGS="$ac_save_LDFLAGS"
+
+fi
+ # Autoconf claims to find X library and include dirs for us.
+ if test "$no_x" = "yes"
+ then with_x11=no window_system=none HAVE_X_WINDOWS=no
+ else with_x11=yes window_system=x11 HAVE_X_WINDOWS=yes
+ fi
+fi
+
+case "$with_x11" in
+ yes ) window_system=x11 HAVE_X_WINDOWS=yes ;;
+ no ) window_system=none HAVE_X_WINDOWS=no ;;
+esac
+
+if test "$with_x11" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_X_WINDOWS
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_X_WINDOWS 1
+EOF
+}
+
+ MAKE_SUBDIR="$MAKE_SUBDIR lwlib" && if test "$extra_verbose" = "yes"; then echo " Appending \"lwlib\" to \$MAKE_SUBDIR"; fi
+ SRC_SUBDIR_DEPS="$SRC_SUBDIR_DEPS lwlib" && if test "$extra_verbose" = "yes"; then echo " Appending \"lwlib\" to \$SRC_SUBDIR_DEPS"; fi
+
+ for lib_dir in "/usr/dt/lib" "/usr/lib/Motif2.1" "/usr/lib/Motif1.2" "/usr/lib/Motif1.1"; do
+ inc_dir=`echo $lib_dir | sed -e 's/lib/include/'`
+ if test -d "$lib_dir" -a -d "$inc_dir"; then
+ case "$x_libraries" in *"$lib_dir"* ) ;; *)
+ x_libraries="$lib_dir $x_libraries"
+ X_LIBS="-L${lib_dir} $X_LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-L${lib_dir}\" to \$X_LIBS"; fi ;;
+ esac
+ case "$x_includes" in "$inc_dir"* ) ;; *)
+ x_includes="$inc_dir $x_includes"
+ X_CFLAGS="-I${inc_dir} $X_CFLAGS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-I${inc_dir}\" to \$X_CFLAGS"; fi ;;
+ esac
+ break; fi
+ done
+
+ for rel in "X11R6" "X11R5" "X11R4"; do
+ lib_dir="/usr/contrib/$rel/lib" inc_dir="/usr/contrib/$rel/include"
+ if test -d "$lib_dir" -a -d "$inc_dir"; then
+ case "$x_libraries" in *"$lib_dir"* ) ;; *)
+ x_libraries="$x_libraries $lib_dir"
+ X_LIBS="$X_LIBS -L${lib_dir}" && if test "$extra_verbose" = "yes"; then echo " Appending \"-L${lib_dir}\" to \$X_LIBS"; fi
+ esac
+ case "$x_includes" in "$inc_dir"* ) ;; *)
+ x_includes="$x_includes $inc_dir"
+ X_CFLAGS="$X_CFLAGS -I${inc_dir}" && if test "$extra_verbose" = "yes"; then echo " Appending \"-I${inc_dir}\" to \$X_CFLAGS"; fi
+ esac
+ break; fi
+ done
+
+ ld_switch_x_site="$X_LIBS"
+
+
+if test "$add_runtime_path" = "yes" -a -n "$dash_r"; then
+ ld_switch_site=`echo '' $ld_switch_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//g"`
+ ld_switch_x_site=`echo '' $ld_switch_x_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//g"`
+
+ runpath="" runpath_dirs=""
+ if test -n "$LD_RUN_PATH"; then
+ runpath="$LD_RUN_PATH"
+ elif test "$GCC" = "yes"; then
+ ld_switch_run_save="$ld_switch_run"; ld_switch_run=""
+ echo "int main(int argc, char *argv[]) {return 0;}" > conftest.c
+ xe_runpath_link='${CC-cc} -o conftest -v $CFLAGS '"$xe_ldflags"' conftest.$ac_ext 2>&1 1>/dev/null'
+ for arg in `eval "$xe_runpath_link" | grep ' -L'`; do
+ case "$arg" in P,* | -L* | -R* )
+ for dir in `echo '' "$arg" | sed -e 's:^ ::' -e 's/^..//' -e 'y/:/ /'`; do
+ {
+xe_runpath_dir="$dir"
+ test "$xe_runpath_dir" != "/lib" -a \
+ "$xe_runpath_dir" != "/usr/lib" -a \
+ -n "`ls ${xe_runpath_dir}/*.s[ol] 2>/dev/null`" && \
+ eval "$xe_add_unique_runpath_dir"
+}
+ done ;;
+ esac
+ done
+ ld_switch_run="$ld_switch_run_save"
+ rm -f conftest*
+ else
+ for arg in $ld_switch_site $ld_switch_x_site; do
+ case "$arg" in -L*) {
+xe_runpath_dir=`echo '' "$arg" | sed -e 's:^ ::' -e 's/^-L//'`
+ test "$xe_runpath_dir" != "/lib" -a \
+ "$xe_runpath_dir" != "/usr/lib" -a \
+ -n "`ls ${xe_runpath_dir}/*.s[ol] 2>/dev/null`" && \
+ eval "$xe_add_unique_runpath_dir"
+};; esac
+ done
+ if test "$opsys $need_motif" = "sol2 yes"; then
+ xe_runpath_dir="/opt/SUNWdt/lib";
+ eval "$xe_add_unique_runpath_dir";
+ fi
+ fi
+ if test -n "$runpath"; then
+ ld_switch_run="${dash_r}${runpath}"
+
+if test "$GCC" = "yes"; then
+ set x $ld_switch_run; shift; ld_switch_run=""
+ while test -n "$1"; do
+ case $1 in
+ -L | -l | -u ) ld_switch_run="$ld_switch_run $1 $2"; shift ;;
+ -L* | -l* | -u* | -Wl* ) ld_switch_run="$ld_switch_run $1" ;;
+ -Xlinker* ) ;;
+ * ) ld_switch_run="$ld_switch_run -Xlinker $1" ;;
+ esac
+ shift
+ done
+fi
+ test "$extra_verbose" = "yes" && echo "Setting runpath to $runpath"
+ fi
+fi
+
+
+ if test "$extra_verbose" = "yes"; then
+ echo; echo "X11 compilation variables:"
+ for var in x_libraries x_includes X_CFLAGS X_LIBS X_PRE_LIBS X_EXTRA_LIBS; do eval "echo \"$var = '\$$var'\""; done
+ echo
+ fi
+
+ bitmapdirs=
+ if test "$x_includes" != NONE; then
+ for i in $x_includes; do
+ if test -d "$i/bitmaps"; then
+ bitmapdirs="$i/bitmaps:$bitmapdirs"
+ fi
+ if test -d "$i/X11/bitmaps"; then
+ bitmapdirs="$i/X11/bitmaps:$bitmapdirs"
+ fi
+ done
+ bitmapdirs=`echo "$bitmapdirs" | sed s/.$//`
+ fi
+ test ! -z "$bitmapdirs" && { test "$extra_verbose" = "yes" && cat << EOF
+ Defining BITMAPDIR = "$bitmapdirs"
+EOF
+cat >> confdefs.h <<EOF
+#define BITMAPDIR "$bitmapdirs"
+EOF
+}
+
+
+ echo "checking for X defines extracted by xmkmf" 1>&6
+echo "configure:5349: checking for X defines extracted by xmkmf" >&5
+ rm -fr conftestdir
+ if mkdir conftestdir; then
+ cd conftestdir
+ cat > Imakefile <<'EOF'
+xetest:
+ @echo ${PROTO_DEFINES} ${STD_DEFINES}
+EOF
+ if (xmkmf) >/dev/null 2>/dev/null && test -f Makefile; then
+ # GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+ xmkmf_defines=`${MAKE-make} xetest 2>/dev/null | grep -v make`
+ fi
+ cd ..
+ rm -fr conftestdir
+ for word in $xmkmf_defines; do
+ case "$word" in
+ -D*=* ) ;;
+ -D* ) word=`echo '' $word | sed -e 's:^ *-D::'`
+ { test "$extra_verbose" = "yes" && cat << EOF
+ Defining $word
+EOF
+cat >> confdefs.h <<EOF
+#define $word 1
+EOF
+}
+ ;;
+ esac
+ done
+ fi
+
+ ac_safe=`echo "X11/Intrinsic.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for X11/Intrinsic.h""... $ac_c" 1>&6
+echo "configure:5381: checking for X11/Intrinsic.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 5384 "configure"
+#include "confdefs.h"
+#include <X11/Intrinsic.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:5389: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ :
+else
+ echo "$ac_t""no" 1>&6
+{ echo "configure: error: "Unable to find X11 header files."" 1>&2; exit 1; }
+fi
+
+
+
+echo $ac_n "checking for XOpenDisplay in -lX11""... $ac_c" 1>&6
+echo "configure:5413: checking for XOpenDisplay in -lX11" >&5
+ac_lib_var=`echo X11'_'XOpenDisplay | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lX11 "
+cat > conftest.$ac_ext <<EOF
+#line 5418 "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 XOpenDisplay();
+
+int main() {
+XOpenDisplay()
+; return 0; }
+EOF
+if { (eval echo configure:5429: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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_lib_x11=yes
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+ if test "$have_lib_x11" != "yes"; then
+
+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:5454: 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 <<EOF
+#line 5459 "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 XGetFontProperty();
+
+int main() {
+XGetFontProperty()
+; return 0; }
+EOF
+if { (eval echo configure:5470: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ ld_switch_x_site="-b i486-linuxaout $ld_switch_x_site"
+else
+ echo "$ac_t""no" 1>&6
+{ echo "configure: error: "Unable to find X11 libraries."" 1>&2; exit 1; }
+fi
+
+
+ fi
+ libs_x="-lX11"
+ test "$extra_verbose" = "yes" && echo " Setting libs_x to \"-lX11\""
+
+
+echo $ac_n "checking for XShapeSelectInput in -lXext""... $ac_c" 1>&6
+echo "configure:5497: checking for XShapeSelectInput in -lXext" >&5
+ac_lib_var=`echo Xext'_'XShapeSelectInput | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lXext "
+cat > conftest.$ac_ext <<EOF
+#line 5502 "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 XShapeSelectInput();
+
+int main() {
+XShapeSelectInput()
+; return 0; }
+EOF
+if { (eval echo configure:5513: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ libs_x="-lXext $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lXext\" to \$libs_x"; fi
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+
+
+echo $ac_n "checking for XtOpenDisplay in -lXt""... $ac_c" 1>&6
+echo "configure:5536: checking for XtOpenDisplay in -lXt" >&5
+ac_lib_var=`echo Xt'_'XtOpenDisplay | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lXt "
+cat > conftest.$ac_ext <<EOF
+#line 5541 "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 XtOpenDisplay();
+
+int main() {
+XtOpenDisplay()
+; return 0; }
+EOF
+if { (eval echo configure:5552: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ libs_x="-lXt $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lXt\" to \$libs_x"; fi
+else
+ echo "$ac_t""no" 1>&6
+{ echo "configure: error: "Unable to find X11 libraries."" 1>&2; exit 1; }
+fi
+
+
+
+ echo $ac_n "checking the version of X11 being used""... $ac_c" 1>&6
+echo "configure:5575: checking the version of X11 being used" >&5
+ cat > conftest.$ac_ext <<EOF
+#line 5577 "configure"
+#include "confdefs.h"
+#include <X11/Intrinsic.h>
+ int main(int c, char *v[]) { return c>1 ? XlibSpecificationRelease : 0; }
+EOF
+if { (eval echo configure:5582: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5
+then
+ ./conftest foobar; x11_release=$?
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ x11_release=4
+fi
+rm -fr conftest*
+ echo "$ac_t""R${x11_release}" 1>&6
+ { test "$extra_verbose" = "yes" && cat << EOF
+ Defining THIS_IS_X11R${x11_release}
+EOF
+cat >> confdefs.h <<EOF
+#define THIS_IS_X11R${x11_release} 1
+EOF
+}
+
+
+ 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:5606: checking for $ac_hdr" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 5609 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:5614: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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 <<EOF
+#define $ac_tr_hdr 1
+EOF
+}
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+
+ echo $ac_n "checking for XFree86""... $ac_c" 1>&6
+echo "configure:5645: checking for XFree86" >&5
+ if test -d "/usr/X386/include" -o \
+ -f "/etc/XF86Config" -o \
+ -f "/etc/X11/XF86Config" -o \
+ -f "/usr/X11R6/lib/X11/XF86Config"; then
+ echo "$ac_t""yes" 1>&6
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_XFREE386
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_XFREE386 1
+EOF
+}
+
+ else
+ echo "$ac_t""no" 1>&6
+ fi
+
+ test -z "$with_xmu" && {
+echo $ac_n "checking for XmuReadBitmapDataFromFile in -lXmu""... $ac_c" 1>&6
+echo "configure:5665: checking for XmuReadBitmapDataFromFile in -lXmu" >&5
+ac_lib_var=`echo Xmu'_'XmuReadBitmapDataFromFile | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lXmu "
+cat > conftest.$ac_ext <<EOF
+#line 5670 "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 XmuReadBitmapDataFromFile();
+
+int main() {
+XmuReadBitmapDataFromFile()
+; return 0; }
+EOF
+if { (eval echo configure:5681: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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_xmu=yes
+else
+ echo "$ac_t""no" 1>&6
+with_xmu=no
+fi
+
+ }
+ if test "$with_xmu" = "no"; then
+ extra_objs="$extra_objs xmu.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"xmu.o\""
+ fi
+ else
+ libs_x="-lXmu $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lXmu\" to \$libs_x"; fi
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_XMU
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_XMU 1
+EOF
+}
+
+ fi
+
+
+echo $ac_n "checking for main in -lXbsd""... $ac_c" 1>&6
+echo "configure:5720: checking for main in -lXbsd" >&5
+ac_lib_var=`echo Xbsd'_'main | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lXbsd "
+cat > conftest.$ac_ext <<EOF
+#line 5725 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:5732: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ libs_x="-lXbsd $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lXbsd\" to \$libs_x"; fi
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+
+ if test "$unexec" = "unexaix.o" -a "$x11_release" = "6"; then
+ if test "$GCC" = "yes"; then
+ X_CFLAGS="-mthreads $X_CFLAGS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-mthreads\" to \$X_CFLAGS"; fi
+ libs_x="-mthreads $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-mthreads\" to \$libs_x"; fi
+ else
+ case "$CC" in
+ "xlc" ) CC="xlc_r" ;;
+ "xlC" ) CC="xlC_r" ;;
+ "cc" ) CC="cc_r" ;;
+ esac
+ fi
+ fi
+
+fi
+if test "$with_msw" != "no"; then
+ echo "checking for MS-Windows" 1>&6
+echo "configure:5769: checking for MS-Windows" >&5
+
+echo $ac_n "checking for main in -lgdi32""... $ac_c" 1>&6
+echo "configure:5772: checking for main in -lgdi32" >&5
+ac_lib_var=`echo gdi32'_'main | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lgdi32 "
+cat > conftest.$ac_ext <<EOF
+#line 5777 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:5784: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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_msw=yes
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+ if test "$with_msw" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_MS_WINDOWS
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_MS_WINDOWS 1
+EOF
+}
+
+ 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
+ if test "$window_system" != x11; then
+ window_system=msw
+ test "$with_scrollbars" != "no" && with_scrollbars=msw \
+ && extra_objs="$extra_objs scrollbar-msw.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"scrollbar-msw.o\""
+ fi
+ test "$with_menubars" != "no" && with_menubars=msw \
+ && extra_objs="$extra_objs menubar-msw.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"menubar-msw.o\""
+ fi
+ test "$with_toolbars" != "no" && with_toolbars=msw \
+ && extra_objs="$extra_objs toolbar-msw.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"toolbar-msw.o\""
+ fi
+ test "$with_dialogs" != "no" && with_dialogs=msw \
+ && extra_objs="$extra_objs dialog-msw.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"dialog-msw.o\""
+ fi
+ 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\""
+ fi
+ test "$with_menubars" != "no" && extra_objs="$extra_objs menubar-msw.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"menubar-msw.o\""
+ fi
+ test "$with_toolbars" != "no" && extra_objs="$extra_objs toolbar-msw.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"toolbar-msw.o\""
+ fi
+ test "$with_dialogs" != "no" && extra_objs="$extra_objs dialog-msw.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"dialog-msw.o\""
+ fi
+ fi
+ cat > conftest.$ac_ext <<EOF
+#line 5848 "configure"
+#include "confdefs.h"
+#include <fcntl.h>
+ int main() { return (open("/dev/windows", O_RDONLY, 0) > 0)? 0 : 1; }
+EOF
+if { (eval echo configure:5853: \"$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
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_MSG_SELECT 1
+EOF
+}
+
+else
+ echo "configure: failed program was:" >&5
+ 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" && 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\""
+ fi
+ fi
+fi
+
+
+
+test -z "$window_system" && window_system="none"
+
+if test "$window_system" = "none"; then
+ for feature in menubars scrollbars toolbars dialogs dragndrop
+ do
+ if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then
+ echo "configure: warning: --with-$feature ignored: Not valid without window system support" 1>&2
+ fi
+ eval "with_${feature}=no"
+ done
+else
+ test -z "$with_toolbars" && with_toolbars=yes
+fi
+
+if test "$with_msw" != "yes"; then
+ for feature in MARTIN_IS_CLUELESS_ABOUT_MSW_FEATURES
+ do
+ if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then
+ echo "configure: warning: --with-$feature ignored: Not valid without MS-Windows support" 1>&2
+ fi
+ eval "with_${feature}=no"
+ done
+else
+ :
+fi
+
+if test "$with_x11" != "yes"; then
+ for feature in tooltalk cde offix session xim xmu \
+ xface
+ 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
+ fi
+ eval "with_${feature}=no"
+ done
+fi
+
+bitmapdir=
+
+case "$window_system" in
+ x11 ) HAVE_X_WINDOWS=yes; echo " Using X11." ;;
+ msw ) HAVE_X_WINDOWS=no ; echo " Using MS-Windows." ;;
+ none ) HAVE_X_WINDOWS=no ; echo " Using no window system." ;;
+esac
+
+case "$x_libraries" in *X11R4* )
+ test "$opsys" = "hpux9" && opsysfile="s/hpux9-x11r4.h"
+ test "$opsys" = "hpux9-shr" && opsysfile="s/hpux9shxr4.h"
+esac
+
+echo "checking for session-management option" 1>&6
+echo "configure:5931: checking for session-management option" >&5;
+if test "$with_session" != "no"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_SESSION
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_SESSION 1
+EOF
+}
+
+fi
+
+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:5946: checking for X11/Xauth.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 5949 "configure"
+#include "confdefs.h"
+#include <X11/Xauth.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:5954: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_xauth=no
+fi
+ }
+test -z "$with_xauth" && {
+echo $ac_n "checking for XauGetAuthByAddr in -lXau""... $ac_c" 1>&6
+echo "configure:5977: checking for XauGetAuthByAddr in -lXau" >&5
+ac_lib_var=`echo Xau'_'XauGetAuthByAddr | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lXau "
+cat > conftest.$ac_ext <<EOF
+#line 5982 "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 XauGetAuthByAddr();
+
+int main() {
+XauGetAuthByAddr()
+; return 0; }
+EOF
+if { (eval echo configure:5993: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_xauth=no
+fi
+
+ }
+test -z "$with_xauth" && with_xauth=yes
+if test "$with_xauth" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_XAUTH
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_XAUTH 1
+EOF
+}
+
+
+T=""
+for W in $X_EXTRA_LIBS -lXau $libs_x $X_PRE_LIBS; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done
+libs_xauth="$T"
+
+fi
+
+
+
+
+if test "$with_tooltalk" != "no" ; then
+ 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:6038: checking for ${dir}tt_c.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 6041 "configure"
+#include "confdefs.h"
+#include <${dir}tt_c.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:6046: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ tt_c_h_path="${dir}tt_c.h"; break
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ done
+ if test -z "$tt_c_h_path"; then
+ if test "$with_tooltalk" = "yes"; then
+ (echo "$progname: Usage error:"
+echo " " "Unable to find required tooltalk header files."
+echo " Use \`$progname --help' to show usage.") >&2 && exit 1
+ fi
+ with_tooltalk=no
+ fi
+fi
+if test "$with_tooltalk" != "no" ; then
+ for extra_libs in "" "-lI18N -lce" "-lcxx"; do
+
+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:6082: 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 <<EOF
+#line 6087 "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 tt_message_create();
+
+int main() {
+tt_message_create()
+; return 0; }
+EOF
+if { (eval echo configure:6098: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ tt_libs="-ltt $extra_libs"; break
+else
+ echo "$ac_t""no" 1>&6
+:
+fi
+
+
+ done
+ if test -z "$tt_libs"; then
+ if test "$with_tooltalk" = "yes"; then
+ (echo "$progname: Usage error:"
+echo " " "Unable to find required tooltalk libraries."
+echo " Use \`$progname --help' to show usage.") >&2 && exit 1
+ fi
+ with_tooltalk=no
+ fi
+fi
+test -z "$with_tooltalk" && with_tooltalk=yes
+if test "$with_tooltalk" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining TOOLTALK
+EOF
+cat >> confdefs.h <<\EOF
+#define TOOLTALK 1
+EOF
+}
+
+ { test "$extra_verbose" = "yes" && cat << EOF
+ Defining TT_C_H_PATH = "$tt_c_h_path"
+EOF
+cat >> confdefs.h <<EOF
+#define TT_C_H_PATH "$tt_c_h_path"
+EOF
+}
+
+ libs_x="$tt_libs $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"$tt_libs\" to \$libs_x"; fi
+ extra_objs="$extra_objs tooltalk.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"tooltalk.o\""
+ fi
+fi
+
+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:6155: checking for Dt/Dt.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 6158 "configure"
+#include "confdefs.h"
+#include <Dt/Dt.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:6163: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_cde=no
+fi
+ }
+test -z "$with_cde" && {
+echo $ac_n "checking for DtDndDragStart in -lDtSvc""... $ac_c" 1>&6
+echo "configure:6186: checking for DtDndDragStart in -lDtSvc" >&5
+ac_lib_var=`echo DtSvc'_'DtDndDragStart | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lDtSvc "
+cat > conftest.$ac_ext <<EOF
+#line 6191 "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 DtDndDragStart();
+
+int main() {
+DtDndDragStart()
+; return 0; }
+EOF
+if { (eval echo configure:6202: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_cde=no
+fi
+
+ }
+test -z "$with_cde" && with_cde=yes
+if test "$with_dragndrop" = no; then
+ echo "configure: warning: No CDE without generic Drag'n'Drop support" 1>&2
+ with_cde=no
+fi
+if test "$with_cde" = "yes" ; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_CDE
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_CDE 1
+EOF
+}
+
+ libs_x="-lDtSvc $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lDtSvc\" to \$libs_x"; fi
+ dragndrop_proto="$dragndrop_proto CDE" && if test "$extra_verbose" = "yes"; then echo " Appending \"CDE\" to \$dragndrop_proto"; fi
+ with_tooltalk=yes # CDE requires Tooltalk
+ need_motif=yes # CDE requires Motif
+fi
+
+test "$window_system" != "x11" && with_offix=no
+if test "$with_xmu" != yes -a "$with_x11" = yes; then
+ echo "configure: warning: No OffiX without real Xmu support" 1>&2
+ with_offix=no
+fi
+if test "$with_dragndrop" = no; then
+ echo "configure: warning: No OffiX without generic Drag'n'Drop support" 1>&2
+ with_offix=no
+fi
+if test "$with_cde" = yes; then
+ echo "configure: warning: CDE already found, disabling OffiX support" 1>&2
+ with_offix=no
+fi
+test -z "$with_offix" && with_offix=no
+if test "$with_offix" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_OFFIX_DND
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_OFFIX_DND 1
+EOF
+}
+
+ dnd_objs="$dnd_objs offix.o" && if test "$extra_verbose" = "yes"; then echo " Appending \"offix.o\" to \$dnd_objs"; fi
+ dragndrop_proto="$dragndrop_proto OffiX" && if test "$extra_verbose" = "yes"; then echo " Appending \"OffiX\" to \$dragndrop_proto"; fi
+fi
+
+echo $ac_n "checking if drag and drop API is needed""... $ac_c" 1>&6
+echo "configure:6271: checking if drag and drop API is needed" >&5
+if test "$with_dragndrop" != "no" ; then
+ if test -n "$dragndrop_proto" ; then
+ with_dragndrop=yes
+ echo "$ac_t""yes (${dragndrop_proto} )" 1>&6
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_DRAGNDROP
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_DRAGNDROP 1
+EOF
+}
+
+ extra_objs="$extra_objs dragdrop.o" && if test "$extra_verbose" = "yes"; then echo " Appending \"dragdrop.o\" to \$extra_objs"; fi
+ else
+ with_dragndrop=no
+ echo "$ac_t""no" 1>&6
+ fi
+fi
+
+echo "checking for LDAP" 1>&6
+echo "configure:6292: 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:6295: checking for ldap.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 6298 "configure"
+#include "confdefs.h"
+#include <ldap.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:6303: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_ldap=no
+fi
+ }
+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:6326: checking for lber.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 6329 "configure"
+#include "confdefs.h"
+#include <lber.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:6334: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_ldap=no
+fi
+ }
+if test "$with_ldap" != "no"; then
+ test -z "$with_umich_ldap" && {
+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:6360: checking "$xe_msg_checking"" >&5
+ac_lib_var=`echo ldap'_'ldap_open | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lldap -llber"
+cat > conftest.$ac_ext <<EOF
+#line 6365 "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 ldap_open();
+
+int main() {
+ldap_open()
+; return 0; }
+EOF
+if { (eval echo configure:6376: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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_umich_ldap=yes
+else
+ echo "$ac_t""no" 1>&6
+with_umich_ldap=no
+fi
+
+ }
+ test "$with_umich_ldap" = "no" && {
+echo $ac_n "checking for ldap_set_option in -lldap10""... $ac_c" 1>&6
+echo "configure:6399: 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 <<EOF
+#line 6404 "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 ldap_set_option();
+
+int main() {
+ldap_set_option()
+; return 0; }
+EOF
+if { (eval echo configure:6415: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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_ns_ldap=yes
+else
+ echo "$ac_t""no" 1>&6
+with_ns_ldap=no
+fi
+
+ }
+ test -z "$with_ldap" -a \( "$with_umich_ldap" = "yes" -o "$with_ns_ldap" = "yes" \) && with_ldap=yes
+fi
+if test "$with_ldap" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_LDAP
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_LDAP 1
+EOF
+}
+
+ 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
+}
+
+ 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
+
+
+if test "$window_system" != "none"; then
+ echo "checking for graphics libraries" 1>&6
+echo "configure:6479: checking for graphics libraries" >&5
+
+ if test -z "$with_xpm"; then
+ echo $ac_n "checking for Xpm - no older than 3.4f""... $ac_c" 1>&6
+echo "configure:6483: checking for Xpm - no older than 3.4f" >&5
+ xe_check_libs=-lXpm
+ cat > conftest.$ac_ext <<EOF
+#line 6486 "configure"
+#include "confdefs.h"
+#include <X11/xpm.h>
+ int main(int c, char **v) {
+ return c == 1 ? 0 :
+ XpmIncludeVersion != XpmLibraryVersion() ? 1 :
+ XpmIncludeVersion < 30406 ? 2 : 0 ;}
+EOF
+if { (eval echo configure:6494: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5
+then
+ ./conftest dummy_arg; xpm_status=$?;
+ if test "$?" = "0"; then
+ with_xpm=yes;
+ else
+ with_xpm=no;
+ if test "$?" = "1"; then
+ xpm_problem="Xpm library version and header file version don't match!"
+ elif test "$?" = "2"; then
+ xpm_problem="Xpm library version is too old!"
+ else
+ xpm_problem="Internal xpm detection logic error!"
+ fi
+ echo "
+*** WARNING *** $problem
+ I'm not touching that with a 10-foot pole!
+ If you really want to use the installed version of Xpm, rerun
+ configure --with-xpm=yes, but don't blame me if XEmacs crashes!"
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ with_xpm=no
+fi
+rm -fr conftest*
+ xe_check_libs=
+ echo "$ac_t""$with_xpm" 1>&6
+ fi
+ if test "$with_xpm" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_XPM
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_XPM 1
+EOF
+}
+
+ 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:6535: checking for \"FOR_MSW\" xpm" >&5
+ xe_check_libs=-lXpm
+ cat > conftest.$ac_ext <<EOF
+#line 6538 "configure"
+#include "confdefs.h"
+
+int main() {
+XpmCreatePixmapFromData()
+; return 0; }
+EOF
+if { (eval echo configure:6545: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ xpm_for_msw=no
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ xpm_for_msw=yes
+fi
+rm -f conftest*
+ xe_check_libs=
+ echo "$ac_t""$xpm_for_msw" 1>&6
+ if test "$xpm_for_msw" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining FOR_MSW
+EOF
+cat >> confdefs.h <<\EOF
+#define FOR_MSW 1
+EOF
+}
+
+ fi
+ fi
+
+ if test "$with_png $with_tiff" != "no no"; then
+
+echo $ac_n "checking for inflate in -lc""... $ac_c" 1>&6
+echo "configure:6572: checking for inflate in -lc" >&5
+ac_lib_var=`echo c'_'inflate | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lc "
+cat > conftest.$ac_ext <<EOF
+#line 6577 "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 inflate();
+
+int main() {
+inflate()
+; return 0; }
+EOF
+if { (eval echo configure:6588: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ :
+else
+ echo "$ac_t""no" 1>&6
+
+echo $ac_n "checking for inflate in -lz""... $ac_c" 1>&6
+echo "configure:6607: checking for inflate in -lz" >&5
+ac_lib_var=`echo z'_'inflate | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lz "
+cat > conftest.$ac_ext <<EOF
+#line 6612 "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 inflate();
+
+int main() {
+inflate()
+; return 0; }
+EOF
+if { (eval echo configure:6623: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ libs_x="-lz $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lz\" to \$libs_x"; fi
+else
+ echo "$ac_t""no" 1>&6
+
+echo $ac_n "checking for inflate in -lgz""... $ac_c" 1>&6
+echo "configure:6642: checking for inflate in -lgz" >&5
+ac_lib_var=`echo gz'_'inflate | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lgz "
+cat > conftest.$ac_ext <<EOF
+#line 6647 "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 inflate();
+
+int main() {
+inflate()
+; return 0; }
+EOF
+if { (eval echo configure:6658: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ libs_x="-lgz $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lgz\" to \$libs_x"; fi
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+fi
+
+
+fi
+
+
+ fi
+
+ echo $ac_n "checking for gifreader""... $ac_c" 1>&6
+echo "configure:6687: checking for gifreader" >&5
+ test -z "$with_gif" && { ac_safe=`echo "gifrlib.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for gifrlib.h""... $ac_c" 1>&6
+echo "configure:6690: checking for gifrlib.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 6693 "configure"
+#include "confdefs.h"
+#include <gifrlib.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:6698: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_gif=no
+fi
+ }
+ test -z "$with_gif" && {
+echo $ac_n "checking for GetGifError in -lgifreader""... $ac_c" 1>&6
+echo "configure:6721: checking for GetGifError in -lgifreader" >&5
+ac_lib_var=`echo gifreader'_'GetGifError | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lgifreader "
+cat > conftest.$ac_ext <<EOF
+#line 6726 "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 GetGifError();
+
+int main() {
+GetGifError()
+; return 0; }
+EOF
+if { (eval echo configure:6737: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_gif=no
+fi
+
+ }
+ test -z "$with_gif" && with_gif=yes
+ if test "$with_gif" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_GIF
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_GIF 1
+EOF
+}
+
+ libs_x="-lgifreader $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lgifreader\" to \$libs_x"; fi
+ fi
+
+ 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:6773: checking for jpeglib.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 6776 "configure"
+#include "confdefs.h"
+#include <jpeglib.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:6781: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_jpeg=no
+fi
+ }
+ test -z "$with_jpeg" && {
+echo $ac_n "checking for jpeg_destroy_decompress in -ljpeg""... $ac_c" 1>&6
+echo "configure:6804: 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 <<EOF
+#line 6809 "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 jpeg_destroy_decompress();
+
+int main() {
+jpeg_destroy_decompress()
+; return 0; }
+EOF
+if { (eval echo configure:6820: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_jpeg=no
+fi
+
+ }
+ test -z "$with_jpeg" && with_jpeg=yes
+ if test "$with_jpeg" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_JPEG
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_JPEG 1
+EOF
+}
+
+ libs_x="-ljpeg $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-ljpeg\" to \$libs_x"; fi
+ fi
+
+ if test -z "$with_png"; then
+ echo $ac_n "checking for png.h - no older than 0.96""... $ac_c" 1>&6
+echo "configure:6856: checking for png.h - no older than 0.96" >&5
+ cat > conftest.$ac_ext <<EOF
+#line 6858 "configure"
+#include "confdefs.h"
+#include <png.h>
+#if PNG_LIBPNG_VER >= 96
+yes
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "yes" >/dev/null 2>&1; then
+ rm -rf conftest*
+ echo "$ac_t""yes" 1>&6
+else
+ rm -rf conftest*
+ echo "$ac_t""no" 1>&6; with_png=no
+fi
+rm -f conftest*
+
+ fi
+ test -z "$with_png" && { echo $ac_n "checking for pow""... $ac_c" 1>&6
+echo "configure:6878: checking for pow" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 6881 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char pow(); below. */
+#include <assert.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 pow();
+
+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_pow) || defined (__stub___pow)
+choke me
+#else
+pow();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:6904: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ eval "ac_cv_func_pow=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_pow=no"
+fi
+rm -f conftest*
+
+if eval "test \"`echo '$ac_cv_func_'pow`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_png=no
+fi
+ }
+ test -z "$with_png" && {
+echo $ac_n "checking for png_read_image in -lpng""... $ac_c" 1>&6
+echo "configure:6925: 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 <<EOF
+#line 6930 "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 png_read_image();
+
+int main() {
+png_read_image()
+; return 0; }
+EOF
+if { (eval echo configure:6941: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_png=no
+fi
+
+ }
+ test -z "$with_png" && with_png=yes
+ if test "$with_png" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_PNG
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_PNG 1
+EOF
+}
+
+ libs_x="-lpng $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lpng\" to \$libs_x"; fi
+ fi
+
+ 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:6977: checking for tiffio.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 6980 "configure"
+#include "confdefs.h"
+#include <tiffio.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:6985: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_tiff=no
+fi
+ }
+ test -z "$with_tiff" && {
+echo $ac_n "checking for TIFFClientOpen in -ltiff""... $ac_c" 1>&6
+echo "configure:7008: checking for TIFFClientOpen in -ltiff" >&5
+ac_lib_var=`echo tiff'_'TIFFClientOpen | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -ltiff "
+cat > conftest.$ac_ext <<EOF
+#line 7013 "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 TIFFClientOpen();
+
+int main() {
+TIFFClientOpen()
+; return 0; }
+EOF
+if { (eval echo configure:7024: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_tiff=no
+fi
+
+ }
+ test -z "$with_tiff" && with_tiff=yes
+ if test "$with_tiff" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_TIFF
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_TIFF 1
+EOF
+}
+
+ libs_x="-ltiff $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-ltiff\" to \$libs_x"; fi
+ fi
+fi
+
+
+if test "$with_x11" = "yes"; then
+
+ echo "checking for X11 graphics libraries" 1>&6
+echo "configure:7063: checking for X11 graphics libraries" >&5
+
+ 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:7067: checking for compface.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 7070 "configure"
+#include "confdefs.h"
+#include <compface.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:7075: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_xface=no
+fi
+ }
+ test -z "$with_xface" && {
+echo $ac_n "checking for UnGenFace in -lcompface""... $ac_c" 1>&6
+echo "configure:7098: checking for UnGenFace in -lcompface" >&5
+ac_lib_var=`echo compface'_'UnGenFace | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lcompface "
+cat > conftest.$ac_ext <<EOF
+#line 7103 "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 UnGenFace();
+
+int main() {
+UnGenFace()
+; return 0; }
+EOF
+if { (eval echo configure:7114: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_xface=no
+fi
+
+ }
+ test -z "$with_xface" && with_xface=yes
+ if test "$with_xface" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_XFACE
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_XFACE 1
+EOF
+}
+
+ libs_x="-lcompface $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lcompface\" to \$libs_x"; fi
+ fi
+
+
+echo $ac_n "checking for XawScrollbarSetThumb in -lXaw""... $ac_c" 1>&6
+echo "configure:7150: checking for XawScrollbarSetThumb in -lXaw" >&5
+ac_lib_var=`echo Xaw'_'XawScrollbarSetThumb | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lXaw "
+cat > conftest.$ac_ext <<EOF
+#line 7155 "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 XawScrollbarSetThumb();
+
+int main() {
+XawScrollbarSetThumb()
+; return 0; }
+EOF
+if { (eval echo configure:7166: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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_xaw=yes
+else
+ echo "$ac_t""no" 1>&6
+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:7190: checking for Xm/Xm.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 7193 "configure"
+#include "confdefs.h"
+#include <Xm/Xm.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:7198: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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 XmStringFree in -lXm""... $ac_c" 1>&6
+echo "configure:7215: checking for XmStringFree in -lXm" >&5
+ac_lib_var=`echo Xm'_'XmStringFree | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lXm "
+cat > conftest.$ac_ext <<EOF
+#line 7220 "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 XmStringFree();
+
+int main() {
+XmStringFree()
+; return 0; }
+EOF
+if { (eval echo configure:7231: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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_motif=yes
+else
+ echo "$ac_t""no" 1>&6
+have_motif=no
+fi
+
+
+else
+ echo "$ac_t""no" 1>&6
+have_motif=no
+fi
+
+
+ if test "$have_motif" = "yes"; then
+ echo $ac_n "checking for Lesstif""... $ac_c" 1>&6
+echo "configure:7260: checking for Lesstif" >&5
+ cat > conftest.$ac_ext <<EOF
+#line 7262 "configure"
+#include "confdefs.h"
+#include <Xm/Xm.h>
+#ifdef LESSTIF_VERSION
+yes
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "yes" >/dev/null 2>&1; then
+ rm -rf conftest*
+ have_lesstif=yes
+else
+ rm -rf conftest*
+ have_lesstif=no
+fi
+rm -f conftest*
+
+ echo "$ac_t""$have_lesstif" 1>&6
+ fi
+
+fi
+
+case "$with_menubars" in "" | "yes" | "athena" | "athena3d" )
+ 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"
+ 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
+ Defining LWLIB_USES_ATHENA
+EOF
+cat >> confdefs.h <<\EOF
+#define LWLIB_USES_ATHENA 1
+EOF
+}
+
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining NEED_ATHENA
+EOF
+cat >> confdefs.h <<\EOF
+#define NEED_ATHENA 1
+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 ;;
+esac
+
+case "$all_widgets" in *motif* )
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining LWLIB_USES_MOTIF
+EOF
+cat >> confdefs.h <<\EOF
+#define LWLIB_USES_MOTIF 1
+EOF
+}
+
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining NEED_MOTIF
+EOF
+cat >> confdefs.h <<\EOF
+#define NEED_MOTIF 1
+EOF
+}
+
+ lwlib_objs="$lwlib_objs lwlib-Xm.o" && if test "$extra_verbose" = "yes"; then echo " Appending \"lwlib-Xm.o\" to \$lwlib_objs"; fi
+ need_motif=yes ;;
+esac
+
+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
+case "$all_widgets" in *lucid* )
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining NEED_LUCID
+EOF
+cat >> confdefs.h <<\EOF
+#define NEED_LUCID 1
+EOF
+}
+
+ lwlib_objs="$lwlib_objs lwlib-Xlw.o" && if test "$extra_verbose" = "yes"; then echo " Appending \"lwlib-Xlw.o\" to \$lwlib_objs"; fi ;;
+esac
+
+
+
+case "$with_scrollbars" in 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
+ 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
+ Defining LWLIB_SCROLLBARS_ATHENA3D
+EOF
+cat >> confdefs.h <<\EOF
+#define LWLIB_SCROLLBARS_ATHENA3D 1
+EOF
+}
+
+test "$with_dialogs" = "athena3d" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining LWLIB_DIALOGS_ATHENA3D
+EOF
+cat >> confdefs.h <<\EOF
+#define LWLIB_DIALOGS_ATHENA3D 1
+EOF
+}
+
+
+test "$with_menubars" != "no" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_MENUBARS
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_MENUBARS 1
+EOF
+}
+
+test "$with_scrollbars" != "no" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_SCROLLBARS
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_SCROLLBARS 1
+EOF
+}
+
+test "$with_dialogs" != "no" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_DIALOGS
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_DIALOGS 1
+EOF
+}
+
+test "$with_toolbars" != "no" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_TOOLBARS
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_TOOLBARS 1
+EOF
+}
+
+
+test "$with_menubars" = "lucid" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining LWLIB_MENUBARS_LUCID
+EOF
+cat >> confdefs.h <<\EOF
+#define LWLIB_MENUBARS_LUCID 1
+EOF
+}
+
+test "$with_scrollbars" = "lucid" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining LWLIB_SCROLLBARS_LUCID
+EOF
+cat >> confdefs.h <<\EOF
+#define LWLIB_SCROLLBARS_LUCID 1
+EOF
+}
+
+
+test "$with_menubars" = "motif" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining LWLIB_MENUBARS_MOTIF
+EOF
+cat >> confdefs.h <<\EOF
+#define LWLIB_MENUBARS_MOTIF 1
+EOF
+}
+
+test "$with_scrollbars" = "motif" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining LWLIB_SCROLLBARS_MOTIF
+EOF
+cat >> confdefs.h <<\EOF
+#define LWLIB_SCROLLBARS_MOTIF 1
+EOF
+}
+
+test "$with_dialogs" = "motif" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining LWLIB_DIALOGS_MOTIF
+EOF
+cat >> confdefs.h <<\EOF
+#define LWLIB_DIALOGS_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
+ 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
+ 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
+ echo " xemacs will be linked with \"toolbar.o\""
+ fi
+test "$all_widgets" != "no no no no" && extra_objs="$extra_objs gui.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"gui.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
+ 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
+ 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
+ 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
+ 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
+ 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
+}
+
+
+
+test -z "$with_mule" && with_mule=no
+test -z "$with_file_coding" && with_file_coding=no
+
+
+if test "$with_file_coding" = "yes" && test "$with_mule" = "no"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining FILE_CODING
+EOF
+cat >> confdefs.h <<\EOF
+#define FILE_CODING 1
+EOF
+}
+
+ extra_objs="$extra_objs file-coding.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"file-coding.o\""
+ fi
+fi
+
+if test "$with_mule" = "yes" ; then
+ echo "checking for Mule-related features" 1>&6
+echo "configure:7546: checking for Mule-related features" >&5
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining MULE
+EOF
+cat >> confdefs.h <<\EOF
+#define MULE 1
+EOF
+}
+
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining FILE_CODING
+EOF
+cat >> confdefs.h <<\EOF
+#define FILE_CODING 1
+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\""
+ 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:7571: checking for $ac_hdr" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 7574 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:7579: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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 <<EOF
+#define $ac_tr_hdr 1
+EOF
+}
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+
+echo $ac_n "checking for strerror in -lintl""... $ac_c" 1>&6
+echo "configure:7610: checking for strerror in -lintl" >&5
+ac_lib_var=`echo intl'_'strerror | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lintl "
+cat > conftest.$ac_ext <<EOF
+#line 7615 "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 strerror();
+
+int main() {
+strerror()
+; return 0; }
+EOF
+if { (eval echo configure:7626: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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 intl | 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 <<EOF
+#define $ac_tr_lib 1
+EOF
+}
+
+ LIBS="-lintl $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lintl\" to \$LIBS"; fi
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+
+ echo "checking for Mule input methods" 1>&6
+echo "configure:7659: checking for Mule input methods" >&5
+ case "$with_xim" in "" | "yes" )
+ echo "checking for XIM" 1>&6
+echo "configure:7662: checking for XIM" >&5
+ if test "$have_lesstif" = "yes"; then with_xim=xlib
+ else
+echo $ac_n "checking for XmImMbLookupString in -lXm""... $ac_c" 1>&6
+echo "configure:7666: checking for XmImMbLookupString in -lXm" >&5
+ac_lib_var=`echo Xm'_'XmImMbLookupString | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lXm "
+cat > conftest.$ac_ext <<EOF
+#line 7671 "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 XmImMbLookupString();
+
+int main() {
+XmImMbLookupString()
+; return 0; }
+EOF
+if { (eval echo configure:7682: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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_xim=motif
+else
+ echo "$ac_t""no" 1>&6
+with_xim=xlib
+fi
+
+
+ fi
+ esac
+ if test "$with_xim" != "no"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_XIM
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_XIM 1
+EOF
+}
+
+ if test "$with_xim" = "xlib"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining XIM_XLIB
+EOF
+cat >> confdefs.h <<\EOF
+#define XIM_XLIB 1
+EOF
+}
+
+ extra_objs="$extra_objs input-method-xlib.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"input-method-xlib.o\""
+ fi
+ fi
+ if test "$with_xim" = "motif"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining XIM_MOTIF
+EOF
+cat >> confdefs.h <<\EOF
+#define XIM_MOTIF 1
+EOF
+}
+
+ need_motif=yes
+ extra_objs="$extra_objs input-method-motif.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"input-method-motif.o\""
+ fi
+ fi
+ if test "$with_xim" = "motif"; then
+ with_xfs=no
+ fi
+ fi
+
+ if test "$with_xfs" = "yes" ; then
+ echo "checking for XFontSet" 1>&6
+echo "configure:7748: checking for XFontSet" >&5
+
+echo $ac_n "checking for XmbDrawString in -lX11""... $ac_c" 1>&6
+echo "configure:7751: checking for XmbDrawString in -lX11" >&5
+ac_lib_var=`echo X11'_'XmbDrawString | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lX11 "
+cat > conftest.$ac_ext <<EOF
+#line 7756 "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 XmbDrawString();
+
+int main() {
+XmbDrawString()
+; return 0; }
+EOF
+if { (eval echo configure:7767: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_xfs=no
+fi
+
+
+ if test "$with_xfs" = "yes" && test "$with_menubars" = "lucid"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining USE_XFONTSET
+EOF
+cat >> confdefs.h <<\EOF
+#define USE_XFONTSET 1
+EOF
+}
+
+ if test "$with_xim" = "no" ; then
+ extra_objs="$extra_objs input-method-xfs.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"input-method-xfs.o\""
+ fi
+ fi
+ fi
+ fi
+ 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:7807: checking for wnn/jllib.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 7810 "configure"
+#include "confdefs.h"
+#include <wnn/jllib.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:7815: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_wnn=no
+fi
+ }
+ if test "$with_wnn" != "no"; then
+ for ac_func in crypt
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:7840: checking for $ac_func" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 7843 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func(); below. */
+#include <assert.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 $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:7866: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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 <<EOF
+#define $ac_tr_func 1
+EOF
+}
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+ test "$ac_cv_func_crypt" != "yes" && {
+echo $ac_n "checking for crypt in -lcrypt""... $ac_c" 1>&6
+echo "configure:7895: checking for crypt in -lcrypt" >&5
+ac_lib_var=`echo crypt'_'crypt | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lcrypt "
+cat > conftest.$ac_ext <<EOF
+#line 7900 "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 crypt();
+
+int main() {
+crypt()
+; return 0; }
+EOF
+if { (eval echo configure:7911: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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 crypt | 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 <<EOF
+#define $ac_tr_lib 1
+EOF
+}
+
+ LIBS="-lcrypt $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lcrypt\" to \$LIBS"; fi
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ }
+ fi
+ test -z "$with_wnn" && {
+echo $ac_n "checking for jl_dic_list_e in -lwnn""... $ac_c" 1>&6
+echo "configure:7945: 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 <<EOF
+#line 7950 "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 jl_dic_list_e();
+
+int main() {
+jl_dic_list_e()
+; return 0; }
+EOF
+if { (eval echo configure:7961: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_wnn=no
+fi
+
+ }
+ test -z "$with_wnn" && with_wnn=yes
+ if test "$with_wnn" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_WNN
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_WNN 1
+EOF
+}
+
+ libs_x="-lwnn $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lwnn\" to \$libs_x"; fi
+ extra_objs="$extra_objs mule-wnnfns.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"mule-wnnfns.o\""
+ fi
+ if test "$with_wnn6" != "no"; then
+
+echo $ac_n "checking for jl_fi_dic_list in -lwnn""... $ac_c" 1>&6
+echo "configure:7999: checking for jl_fi_dic_list in -lwnn" >&5
+ac_lib_var=`echo wnn'_'jl_fi_dic_list | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lwnn "
+cat > conftest.$ac_ext <<EOF
+#line 8004 "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 jl_fi_dic_list();
+
+int main() {
+jl_fi_dic_list()
+; return 0; }
+EOF
+if { (eval echo configure:8015: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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_wnn6=yes
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+ test "$with_wnn6" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining WNN6
+EOF
+cat >> confdefs.h <<\EOF
+#define WNN6 1
+EOF
+}
+
+ fi
+ fi
+
+ canna_includes_found=no
+ 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:8050: checking for canna/jrkanji.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 8053 "configure"
+#include "confdefs.h"
+#include <canna/jrkanji.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:8058: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ canna_includes_found=yes
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ fi
+ if test "$canna_includes_found" = "no" -a "$with_canna" != "no" -a \
+ -d "/usr/local/canna/include"; then
+ save_c_switch_site="$c_switch_site"
+ 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:8085: checking for canna/jrkanji.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 8088 "configure"
+#include "confdefs.h"
+#include <canna/jrkanji.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:8093: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ canna_includes_found=yes
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test "$canna_includes_found" != "yes"; then
+ c_switch_site="$save_c_switch_site"
+ with_canna="no"
+ fi
+ fi
+
+ 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:8121: checking for canna/RK.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 8124 "configure"
+#include "confdefs.h"
+#include <canna/RK.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:8129: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_canna=no
+fi
+ }
+ test -z "$with_canna" && {
+echo $ac_n "checking for RkBgnBun in -lRKC""... $ac_c" 1>&6
+echo "configure:8152: checking for RkBgnBun in -lRKC" >&5
+ac_lib_var=`echo RKC'_'RkBgnBun | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lRKC "
+cat > conftest.$ac_ext <<EOF
+#line 8157 "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 RkBgnBun();
+
+int main() {
+RkBgnBun()
+; return 0; }
+EOF
+if { (eval echo configure:8168: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_canna=no
+fi
+
+ }
+ test -z "$with_canna" && {
+echo $ac_n "checking for jrKanjiControl in -lcanna""... $ac_c" 1>&6
+echo "configure:8191: checking for jrKanjiControl in -lcanna" >&5
+ac_lib_var=`echo canna'_'jrKanjiControl | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lcanna "
+cat > conftest.$ac_ext <<EOF
+#line 8196 "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 jrKanjiControl();
+
+int main() {
+jrKanjiControl()
+; return 0; }
+EOF
+if { (eval echo configure:8207: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_canna=no
+fi
+
+ }
+ test -z "$with_canna" && with_canna=yes
+ if test "$with_canna" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_CANNA
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_CANNA 1
+EOF
+}
+
+ libs_x="-lcanna -lRKC $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lcanna -lRKC\" to \$libs_x"; fi
+ extra_objs="$extra_objs mule-canna.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"mule-canna.o\""
+ fi
+ fi
+
+else for feature in xim canna wnn; do
+ if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then
+ echo "configure: warning: "--with-${feature} ignored: Not valid without Mule support"" 1>&2
+ fi
+ eval "with_${feature}=no"
+ done
+fi
+
+if test "$need_motif" = "yes" ; then
+ 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:8256: 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 <<EOF
+#line 8261 "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 layout_object_getvalue();
+
+int main() {
+layout_object_getvalue()
+; return 0; }
+EOF
+if { (eval echo configure:8272: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ libs_x="-li18n $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-li18n\" to \$libs_x"; fi
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+
+if test "$add_runtime_path" = "yes" -a -n "$dash_r"; then
+ ld_switch_site=`echo '' $ld_switch_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//g"`
+ ld_switch_x_site=`echo '' $ld_switch_x_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//g"`
+
+ runpath="" runpath_dirs=""
+ if test -n "$LD_RUN_PATH"; then
+ runpath="$LD_RUN_PATH"
+ elif test "$GCC" = "yes"; then
+ ld_switch_run_save="$ld_switch_run"; ld_switch_run=""
+ echo "int main(int argc, char *argv[]) {return 0;}" > conftest.c
+ xe_runpath_link='${CC-cc} -o conftest -v $CFLAGS '"$xe_ldflags"' conftest.$ac_ext 2>&1 1>/dev/null'
+ for arg in `eval "$xe_runpath_link" | grep ' -L'`; do
+ case "$arg" in P,* | -L* | -R* )
+ for dir in `echo '' "$arg" | sed -e 's:^ ::' -e 's/^..//' -e 'y/:/ /'`; do
+ {
+xe_runpath_dir="$dir"
+ test "$xe_runpath_dir" != "/lib" -a \
+ "$xe_runpath_dir" != "/usr/lib" -a \
+ -n "`ls ${xe_runpath_dir}/*.s[ol] 2>/dev/null`" && \
+ eval "$xe_add_unique_runpath_dir"
+}
+ done ;;
+ esac
+ done
+ ld_switch_run="$ld_switch_run_save"
+ rm -f conftest*
+ else
+ for arg in $ld_switch_site $ld_switch_x_site; do
+ case "$arg" in -L*) {
+xe_runpath_dir=`echo '' "$arg" | sed -e 's:^ ::' -e 's/^-L//'`
+ test "$xe_runpath_dir" != "/lib" -a \
+ "$xe_runpath_dir" != "/usr/lib" -a \
+ -n "`ls ${xe_runpath_dir}/*.s[ol] 2>/dev/null`" && \
+ eval "$xe_add_unique_runpath_dir"
+};; esac
+ done
+ if test "$opsys $need_motif" = "sol2 yes"; then
+ xe_runpath_dir="/opt/SUNWdt/lib";
+ eval "$xe_add_unique_runpath_dir";
+ fi
+ fi
+ if test -n "$runpath"; then
+ ld_switch_run="${dash_r}${runpath}"
+
+if test "$GCC" = "yes"; then
+ set x $ld_switch_run; shift; ld_switch_run=""
+ while test -n "$1"; do
+ case $1 in
+ -L | -l | -u ) ld_switch_run="$ld_switch_run $1 $2"; shift ;;
+ -L* | -l* | -u* | -Wl* ) ld_switch_run="$ld_switch_run $1" ;;
+ -Xlinker* ) ;;
+ * ) ld_switch_run="$ld_switch_run -Xlinker $1" ;;
+ esac
+ shift
+ done
+fi
+ test "$extra_verbose" = "yes" && echo "Setting runpath to $runpath"
+ fi
+fi
+
+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
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:8358: checking for $ac_func" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 8361 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func(); below. */
+#include <assert.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 $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:8384: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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 <<EOF
+#define $ac_tr_func 1
+EOF
+}
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+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 ;;
+ * )
+ for ac_func in realpath
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:8421: checking for $ac_func" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 8424 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func(); below. */
+#include <assert.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 $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:8447: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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 <<EOF
+#define $ac_tr_func 1
+EOF
+}
+
+else
+ echo "$ac_t""no" 1>&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
+
+echo $ac_n "checking whether netdb declares h_errno""... $ac_c" 1>&6
+echo "configure:8480: checking whether netdb declares h_errno" >&5
+cat > conftest.$ac_ext <<EOF
+#line 8482 "configure"
+#include "confdefs.h"
+#include <netdb.h>
+int main() {
+return h_errno;
+; return 0; }
+EOF
+if { (eval echo configure:8489: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ echo "$ac_t""yes" 1>&6
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_H_ERRNO
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_H_ERRNO 1
+EOF
+}
+
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ echo "$ac_t""no" 1>&6
+fi
+rm -f conftest*
+
+echo $ac_n "checking for sigsetjmp""... $ac_c" 1>&6
+echo "configure:8509: checking for sigsetjmp" >&5
+cat > conftest.$ac_ext <<EOF
+#line 8511 "configure"
+#include "confdefs.h"
+#include <setjmp.h>
+int main() {
+sigjmp_buf bar; sigsetjmp (bar, 0);
+; return 0; }
+EOF
+if { (eval echo configure:8518: \"$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
+ Defining HAVE_SIGSETJMP
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_SIGSETJMP 1
+EOF
+}
+
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ echo "$ac_t""no" 1>&6
+fi
+rm -f conftest*
+
+echo $ac_n "checking whether localtime caches TZ""... $ac_c" 1>&6
+echo "configure:8538: checking whether localtime caches TZ" >&5
+
+if test "$ac_cv_func_tzset" = "yes"; then
+cat > conftest.$ac_ext <<EOF
+#line 8542 "configure"
+#include "confdefs.h"
+#include <time.h>
+#if STDC_HEADERS
+# include <stdlib.h>
+#endif
+extern char **environ;
+unset_TZ ()
+{
+ char **from, **to;
+ for (to = from = environ; (*to = *from); from++)
+ if (! (to[0][0] == 'T' && to[0][1] == 'Z' && to[0][2] == '='))
+ to++;
+}
+char TZ_GMT0[] = "TZ=GMT0";
+char TZ_PST8[] = "TZ=PST8";
+main()
+{
+ time_t now = time ((time_t *) 0);
+ int hour_GMT0, hour_unset;
+ if (putenv (TZ_GMT0) != 0)
+ exit (1);
+ hour_GMT0 = localtime (&now)->tm_hour;
+ unset_TZ ();
+ hour_unset = localtime (&now)->tm_hour;
+ if (putenv (TZ_PST8) != 0)
+ exit (1);
+ if (localtime (&now)->tm_hour == hour_GMT0)
+ exit (1);
+ unset_TZ ();
+ if (localtime (&now)->tm_hour != hour_unset)
+ exit (1);
+ exit (0);
+}
+EOF
+if { (eval echo configure:8577: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5
+then
+ emacs_cv_localtime_cache=no
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ emacs_cv_localtime_cache=yes
+fi
+rm -fr conftest*
+else
+ # If we lack tzset, report that localtime does not cache TZ,
+ # since we can't invalidate the cache if we don't have tzset.
+ emacs_cv_localtime_cache=no
+fi
+echo "$ac_t""$emacs_cv_localtime_cache" 1>&6
+if test $emacs_cv_localtime_cache = yes; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining LOCALTIME_CACHE
+EOF
+cat >> confdefs.h <<\EOF
+#define LOCALTIME_CACHE 1
+EOF
+}
+
+fi
+
+if test "$HAVE_TIMEVAL" = "yes"; then
+echo $ac_n "checking whether gettimeofday accepts one or two arguments""... $ac_c" 1>&6
+echo "configure:8606: checking whether gettimeofday accepts one or two arguments" >&5
+cat > conftest.$ac_ext <<EOF
+#line 8608 "configure"
+#include "confdefs.h"
+
+#ifdef TIME_WITH_SYS_TIME
+#include <sys/time.h>
+#include <time.h>
+#else
+#ifdef HAVE_SYS_TIME_H
+#include <sys/time.h>
+#else
+#include <time.h>
+#endif
+#endif
+
+int main() {
+
+ struct timeval time;
+ struct timezone dummy;
+ gettimeofday (&time, &dummy);
+
+; return 0; }
+EOF
+if { (eval echo configure:8630: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ echo "$ac_t""two" 1>&6
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ echo "$ac_t""one" 1>&6
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining GETTIMEOFDAY_ONE_ARGUMENT
+EOF
+cat >> confdefs.h <<\EOF
+#define GETTIMEOFDAY_ONE_ARGUMENT 1
+EOF
+}
+
+fi
+rm -f conftest*
+fi
+
+
+echo $ac_n "checking for inline""... $ac_c" 1>&6
+echo "configure:8652: checking for inline" >&5
+
+ac_cv_c_inline=no
+for ac_kw in inline __inline__ __inline; do
+ cat > conftest.$ac_ext <<EOF
+#line 8657 "configure"
+#include "confdefs.h"
+
+int main() {
+} $ac_kw foo() {
+; return 0; }
+EOF
+if { (eval echo configure:8664: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_c_inline=$ac_kw; break
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+fi
+rm -f conftest*
+done
+
+
+echo "$ac_t""$ac_cv_c_inline" 1>&6
+case "$ac_cv_c_inline" in
+ inline | yes) ;;
+ no) { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining inline =
+EOF
+cat >> confdefs.h <<\EOF
+#define inline
+EOF
+}
+ ;;
+ *) { test "$extra_verbose" = "yes" && cat << EOF
+ Defining inline = $ac_cv_c_inline
+EOF
+cat >> confdefs.h <<EOF
+#define inline $ac_cv_c_inline
+EOF
+}
+ ;;
+esac
+
+if test "$ac_cv_c_inline" != "no"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_INLINE
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_INLINE 1
+EOF
+}
+
+ test "$GCC" = "yes" && extra_objs="$extra_objs inline.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"inline.o\""
+ fi
+fi
+
+
+# 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:8714: checking for working alloca.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 8717 "configure"
+#include "confdefs.h"
+#include <alloca.h>
+int main() {
+char *p = alloca(2 * sizeof(int));
+; return 0; }
+EOF
+if { (eval echo configure:8724: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ ac_cv_header_alloca_h=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_header_alloca_h=no
+fi
+rm -f conftest*
+
+echo "$ac_t""$ac_cv_header_alloca_h" 1>&6
+if test $ac_cv_header_alloca_h = yes; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_ALLOCA_H
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_ALLOCA_H 1
+EOF
+}
+
+fi
+
+echo $ac_n "checking for alloca""... $ac_c" 1>&6
+echo "configure:8748: checking for alloca" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 8751 "configure"
+#include "confdefs.h"
+
+#ifdef __GNUC__
+# define alloca __builtin_alloca
+#else
+# if HAVE_ALLOCA_H
+# include <alloca.h>
+# else
+# ifdef _AIX
+ #pragma alloca
+# else
+# ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+# endif
+# endif
+# endif
+#endif
+
+int main() {
+char *p = (char *) alloca(1);
+; return 0; }
+EOF
+if { (eval echo configure:8774: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ ac_cv_func_alloca_works=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_func_alloca_works=no
+fi
+rm -f conftest*
+
+echo "$ac_t""$ac_cv_func_alloca_works" 1>&6
+if test $ac_cv_func_alloca_works = yes; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_ALLOCA
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_ALLOCA 1
+EOF
+}
+
+fi
+
+if test $ac_cv_func_alloca_works = no; then
+ # The SVR3 libPW and SVR4 libucb both contain incompatible functions
+ # that cause trouble. Some versions do not even contain alloca or
+ # contain a buggy version. If you still want to use their alloca,
+ # use ar to extract alloca.o from them instead of compiling alloca.c.
+ ALLOCA=alloca.o
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining C_ALLOCA
+EOF
+cat >> confdefs.h <<\EOF
+#define C_ALLOCA 1
+EOF
+}
+
+
+echo $ac_n "checking whether alloca needs Cray hooks""... $ac_c" 1>&6
+echo "configure:8813: checking whether alloca needs Cray hooks" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 8816 "configure"
+#include "confdefs.h"
+#if defined(CRAY) && ! defined(CRAY2)
+webecray
+#else
+wenotbecray
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "webecray" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_os_cray=yes
+else
+ rm -rf conftest*
+ ac_cv_os_cray=no
+fi
+rm -f conftest*
+
+
+echo "$ac_t""$ac_cv_os_cray" 1>&6
+if test $ac_cv_os_cray = yes; then
+for ac_func in _getb67 GETB67 getb67; do
+ echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:8840: checking for $ac_func" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 8843 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func(); below. */
+#include <assert.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 $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:8866: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ { test "$extra_verbose" = "yes" && cat << EOF
+ Defining CRAY_STACKSEG_END = $ac_func
+EOF
+cat >> confdefs.h <<EOF
+#define CRAY_STACKSEG_END $ac_func
+EOF
+}
+
+ break
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+done
+fi
+
+echo $ac_n "checking stack direction for C alloca""... $ac_c" 1>&6
+echo "configure:8896: checking stack direction for C alloca" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 8899 "configure"
+#include "confdefs.h"
+find_stack_direction ()
+{
+ static char *addr = 0;
+ auto char dummy;
+ if (addr == 0)
+ {
+ addr = &dummy;
+ return find_stack_direction ();
+ }
+ else
+ return (&dummy > addr) ? 1 : -1;
+}
+main ()
+{
+ exit (find_stack_direction() < 0);
+}
+EOF
+if { (eval echo configure:8918: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5
+then
+ ac_cv_c_stack_direction=1
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_c_stack_direction=-1
+fi
+rm -fr conftest*
+
+echo "$ac_t""$ac_cv_c_stack_direction" 1>&6
+{ test "$extra_verbose" = "yes" && cat << EOF
+ Defining STACK_DIRECTION = $ac_cv_c_stack_direction
+EOF
+cat >> confdefs.h <<EOF
+#define STACK_DIRECTION $ac_cv_c_stack_direction
+EOF
+}
+
+fi
+
+test -n "$ALLOCA" && extra_objs="$extra_objs $ALLOCA" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"$ALLOCA\""
+ fi
+
+ac_safe=`echo "vfork.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for vfork.h""... $ac_c" 1>&6
+echo "configure:8946: checking for vfork.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 8949 "configure"
+#include "confdefs.h"
+#include <vfork.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:8954: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_VFORK_H
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_VFORK_H 1
+EOF
+}
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+echo $ac_n "checking for working vfork""... $ac_c" 1>&6
+echo "configure:8982: checking for working vfork" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 8985 "configure"
+#include "confdefs.h"
+/* Thanks to Paul Eggert for this test. */
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+#ifdef HAVE_VFORK_H
+#include <vfork.h>
+#endif
+/* On some sparc systems, changes by the child to local and incoming
+ argument registers are propagated back to the parent.
+ The compiler is told about this with #include <vfork.h>,
+ but some compilers (e.g. gcc -O) don't grok <vfork.h>.
+ Test for this by using a static variable whose address
+ is put into a register that is clobbered by the vfork. */
+static
+#ifdef __cplusplus
+sparc_address_test (int arg)
+#else
+sparc_address_test (arg) int arg;
+#endif
+{
+ static pid_t child;
+ if (!child) {
+ child = vfork ();
+ if (child < 0) {
+ perror ("vfork");
+ _exit(2);
+ }
+ if (!child) {
+ arg = getpid();
+ write(-1, "", 0);
+ _exit (arg);
+ }
+ }
+}
+main() {
+ pid_t parent = getpid ();
+ pid_t child;
+
+ sparc_address_test ();
+
+ child = vfork ();
+
+ if (child == 0) {
+ /* Here is another test for sparc vfork register problems.
+ This test uses lots of local variables, at least
+ as many local variables as main has allocated so far
+ including compiler temporaries. 4 locals are enough for
+ gcc 1.40.3 on a Solaris 4.1.3 sparc, but we use 8 to be safe.
+ A buggy compiler should reuse the register of parent
+ for one of the local variables, since it will think that
+ parent can't possibly be used any more in this routine.
+ Assigning to the local variable will thus munge parent
+ in the parent process. */
+ pid_t
+ p = getpid(), p1 = getpid(), p2 = getpid(), p3 = getpid(),
+ p4 = getpid(), p5 = getpid(), p6 = getpid(), p7 = getpid();
+ /* Convince the compiler that p..p7 are live; otherwise, it might
+ use the same hardware register for all 8 local variables. */
+ if (p != p1 || p != p2 || p != p3 || p != p4
+ || p != p5 || p != p6 || p != p7)
+ _exit(1);
+
+ /* On some systems (e.g. IRIX 3.3),
+ vfork doesn't separate parent from child file descriptors.
+ If the child closes a descriptor before it execs or exits,
+ this munges the parent's descriptor as well.
+ Test for this by closing stdout in the child. */
+ _exit(close(fileno(stdout)) != 0);
+ } else {
+ int status;
+ struct stat st;
+
+ while (wait(&status) != child)
+ ;
+ exit(
+ /* Was there some problem with vforking? */
+ child < 0
+
+ /* Did the child fail? (This shouldn't happen.) */
+ || status
+
+ /* Did the vfork/compiler bug occur? */
+ || parent != getpid()
+
+ /* Did the file descriptor bug occur? */
+ || fstat(fileno(stdout), &st) != 0
+ );
+ }
+}
+EOF
+if { (eval echo configure:9080: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5
+then
+ ac_cv_func_vfork_works=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_func_vfork_works=no
+fi
+rm -fr conftest*
+
+echo "$ac_t""$ac_cv_func_vfork_works" 1>&6
+if test $ac_cv_func_vfork_works = no; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining vfork = fork
+EOF
+cat >> confdefs.h <<\EOF
+#define vfork fork
+EOF
+}
+
+fi
+
+
+echo $ac_n "checking for working strcoll""... $ac_c" 1>&6
+echo "configure:9105: checking for working strcoll" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 9108 "configure"
+#include "confdefs.h"
+#include <string.h>
+main ()
+{
+ exit (strcoll ("abc", "def") >= 0 ||
+ strcoll ("ABC", "DEF") >= 0 ||
+ strcoll ("123", "456") >= 0);
+}
+EOF
+if { (eval echo configure:9118: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5
+then
+ ac_cv_func_strcoll_works=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_func_strcoll_works=no
+fi
+rm -fr conftest*
+
+echo "$ac_t""$ac_cv_func_strcoll_works" 1>&6
+if test $ac_cv_func_strcoll_works = yes; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_STRCOLL
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_STRCOLL 1
+EOF
+}
+
+fi
+
+
+for ac_func in getpgrp
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:9145: checking for $ac_func" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 9148 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func(); below. */
+#include <assert.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 $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:9171: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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 <<EOF
+#define $ac_tr_func 1
+EOF
+}
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+echo $ac_n "checking whether getpgrp takes no argument""... $ac_c" 1>&6
+echo "configure:9199: checking whether getpgrp takes no argument" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 9202 "configure"
+#include "confdefs.h"
+
+/*
+ * If this system has a BSD-style getpgrp(),
+ * which takes a pid argument, exit unsuccessfully.
+ *
+ * Snarfed from Chet Ramey's bash pgrp.c test program
+ */
+#include <stdio.h>
+#include <sys/types.h>
+
+int pid;
+int pg1, pg2, pg3, pg4;
+int ng, np, s, child;
+
+main()
+{
+ pid = getpid();
+ pg1 = getpgrp(0);
+ pg2 = getpgrp();
+ pg3 = getpgrp(pid);
+ pg4 = getpgrp(1);
+
+ /*
+ * If all of these values are the same, it's pretty sure that
+ * we're on a system that ignores getpgrp's first argument.
+ */
+ if (pg2 == pg4 && pg1 == pg3 && pg2 == pg3)
+ exit(0);
+
+ child = fork();
+ if (child < 0)
+ exit(1);
+ else if (child == 0) {
+ np = getpid();
+ /*
+ * If this is Sys V, this will not work; pgrp will be
+ * set to np because setpgrp just changes a pgrp to be
+ * the same as the pid.
+ */
+ setpgrp(np, pg1);
+ ng = getpgrp(0); /* Same result for Sys V and BSD */
+ if (ng == pg1) {
+ exit(1);
+ } else {
+ exit(0);
+ }
+ } else {
+ wait(&s);
+ exit(s>>8);
+ }
+}
+
+EOF
+if { (eval echo configure:9257: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5
+then
+ ac_cv_func_getpgrp_void=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_func_getpgrp_void=no
+fi
+rm -fr conftest*
+
+
+echo "$ac_t""$ac_cv_func_getpgrp_void" 1>&6
+if test $ac_cv_func_getpgrp_void = yes; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining GETPGRP_VOID
+EOF
+cat >> confdefs.h <<\EOF
+#define GETPGRP_VOID 1
+EOF
+}
+
+fi
+
+
+echo $ac_n "checking for working mmap""... $ac_c" 1>&6
+echo "configure:9283: checking for working mmap" >&5
+case "$opsys" in ultrix* ) have_mmap=no ;; *)
+cat > conftest.$ac_ext <<EOF
+#line 9286 "configure"
+#include "confdefs.h"
+#include <stdio.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include <sys/mman.h>
+
+#ifndef MAP_VARIABLE
+#define MAP_VARIABLE 0
+#endif
+
+#ifndef MAP_FAILED
+#define MAP_FAILED -1
+#endif
+
+int main (int argc, char *argv[])
+{
+ int fd = -1;
+ caddr_t p;
+#ifndef MAP_ANONYMOUS
+ fd = open ("/dev/zero", O_RDWR);
+ if (fd < 0)
+ return 1;
+#define MAP_ANONYMOUS 0
+#endif
+ if (mmap(0, 1024, PROT_READ | PROT_WRITE,
+ MAP_PRIVATE | MAP_VARIABLE | MAP_ANONYMOUS,
+ fd, 0) != (void *) MAP_FAILED)
+ return 0;
+ perror ("conftest: mmap failed");
+ return 1;
+}
+EOF
+if { (eval echo configure:9319: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5
+then
+ have_mmap=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ have_mmap=no
+fi
+rm -fr conftest* ;;
+esac
+echo "$ac_t""$have_mmap" 1>&6
+test "$have_mmap" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_MMAP
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_MMAP 1
+EOF
+}
+
+
+test "$GNU_MALLOC" != "yes" -a "$have_mmap" != "yes" && rel_alloc=no
+test "$rel_alloc" = "default" -a "$have_mmap" = "yes" && rel_alloc=yes
+test "$rel_alloc" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining REL_ALLOC
+EOF
+cat >> confdefs.h <<\EOF
+#define REL_ALLOC 1
+EOF
+}
+
+
+ac_safe=`echo "termios.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for termios.h""... $ac_c" 1>&6
+echo "configure:9353: checking for termios.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 9356 "configure"
+#include "confdefs.h"
+#include <termios.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:9361: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_TERMIOS
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_TERMIOS 1
+EOF
+}
+
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining SIGNALS_VIA_CHARACTERS
+EOF
+cat >> confdefs.h <<\EOF
+#define SIGNALS_VIA_CHARACTERS 1
+EOF
+}
+
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining NO_TERMIO
+EOF
+cat >> confdefs.h <<\EOF
+#define NO_TERMIO 1
+EOF
+}
+
+else
+ 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:9404: checking for termio.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 9407 "configure"
+#include "confdefs.h"
+#include <termio.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:9412: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_TERMIO
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_TERMIO 1
+EOF
+}
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+fi
+
+
+
+echo $ac_n "checking for socket""... $ac_c" 1>&6
+echo "configure:9444: checking for socket" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 9447 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char socket(); below. */
+#include <assert.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 socket();
+
+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_socket) || defined (__stub___socket)
+choke me
+#else
+socket();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:9470: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ eval "ac_cv_func_socket=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_socket=no"
+fi
+rm -f conftest*
+
+if eval "test \"`echo '$ac_cv_func_'socket`\" = yes"; then
+ 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:9485: checking for netinet/in.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 9488 "configure"
+#include "confdefs.h"
+#include <netinet/in.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:9493: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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 "arpa/inet.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for arpa/inet.h""... $ac_c" 1>&6
+echo "configure:9510: checking for arpa/inet.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 9513 "configure"
+#include "confdefs.h"
+#include <arpa/inet.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:9518: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_SOCKETS
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_SOCKETS 1
+EOF
+}
+
+ echo $ac_n "checking "for sun_len member in struct sockaddr_un"""... $ac_c" 1>&6
+echo "configure:9543: checking "for sun_len member in struct sockaddr_un"" >&5
+ cat > conftest.$ac_ext <<EOF
+#line 9545 "configure"
+#include "confdefs.h"
+
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <sys/un.h>
+
+int main() {
+static struct sockaddr_un x; x.sun_len = 1;
+; return 0; }
+EOF
+if { (eval echo configure:9556: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ echo "$ac_t""yes" 1>&6; { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_SOCKADDR_SUN_LEN
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_SOCKADDR_SUN_LEN 1
+EOF
+}
+
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ echo "$ac_t""no" 1>&6
+fi
+rm -f conftest*
+ echo $ac_n "checking "for ip_mreq struct in netinet/in.h"""... $ac_c" 1>&6
+echo "configure:9574: checking "for ip_mreq struct in netinet/in.h"" >&5
+ cat > conftest.$ac_ext <<EOF
+#line 9576 "configure"
+#include "confdefs.h"
+
+#include <sys/types.h>
+#include <netinet/in.h>
+
+int main() {
+static struct ip_mreq x;
+; return 0; }
+EOF
+if { (eval echo configure:9586: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ echo "$ac_t""yes" 1>&6; { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_MULTICAST
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_MULTICAST 1
+EOF
+}
+
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ echo "$ac_t""no" 1>&6
+fi
+rm -f conftest*
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+echo $ac_n "checking for msgget""... $ac_c" 1>&6
+echo "configure:9617: checking for msgget" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 9620 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char msgget(); below. */
+#include <assert.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 msgget();
+
+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_msgget) || defined (__stub___msgget)
+choke me
+#else
+msgget();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:9643: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ eval "ac_cv_func_msgget=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_msgget=no"
+fi
+rm -f conftest*
+
+if eval "test \"`echo '$ac_cv_func_'msgget`\" = yes"; then
+ 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:9658: checking for sys/ipc.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 9661 "configure"
+#include "confdefs.h"
+#include <sys/ipc.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:9666: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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 "sys/msg.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for sys/msg.h""... $ac_c" 1>&6
+echo "configure:9683: checking for sys/msg.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 9686 "configure"
+#include "confdefs.h"
+#include <sys/msg.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:9691: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_SYSVIPC
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_SYSVIPC 1
+EOF
+}
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+ac_safe=`echo "dirent.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for dirent.h""... $ac_c" 1>&6
+echo "configure:9729: checking for dirent.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 9732 "configure"
+#include "confdefs.h"
+#include <dirent.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:9737: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining SYSV_SYSTEM_DIR
+EOF
+cat >> confdefs.h <<\EOF
+#define SYSV_SYSTEM_DIR 1
+EOF
+}
+
+else
+ 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:9764: checking for sys/dir.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 9767 "configure"
+#include "confdefs.h"
+#include <sys/dir.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:9772: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ :
+else
+ echo "$ac_t""no" 1>&6
+{ test "$extra_verbose" = "yes" && cat << \EOF
+ Defining NONSYSTEM_DIR_LIBRARY
+EOF
+cat >> confdefs.h <<\EOF
+#define NONSYSTEM_DIR_LIBRARY 1
+EOF
+}
+
+fi
+
+fi
+
+
+ac_safe=`echo "nlist.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for nlist.h""... $ac_c" 1>&6
+echo "configure:9805: checking for nlist.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 9808 "configure"
+#include "confdefs.h"
+#include <nlist.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:9813: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining NLIST_STRUCT
+EOF
+cat >> confdefs.h <<\EOF
+#define NLIST_STRUCT 1
+EOF
+}
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+
+echo "checking "for sound support"" 1>&6
+echo "configure:9843: checking "for sound support"" >&5
+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
+ 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:9854: checking for multimedia/audio_device.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 9857 "configure"
+#include "confdefs.h"
+#include <multimedia/audio_device.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:9862: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ sound_found=yes sound_cflags=""
+ extra_objs="$extra_objs sunplay.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"sunplay.o\""
+ fi
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ fi
+
+ if test -z "$sound_found" -a -d "/usr/demo/SOUND"; then
+ sound_found=yes
+ extra_objs="$extra_objs sunplay.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"sunplay.o\""
+ fi
+ if test -d "/usr/demo/SOUND/include"
+ then sound_cflags="-I/usr/demo/SOUND/include"
+ else sound_cflags="-I/usr/demo/SOUND"
+ fi
+ if test -z "$native_sound_lib" ; then
+ if test -r "/usr/demo/SOUND/lib/libaudio.a"
+ then native_sound_lib="/usr/demo/SOUND/lib/libaudio.a"
+ else native_sound_lib="/usr/demo/SOUND/libaudio.a"
+ fi
+ fi
+ fi
+
+ if test -z "$sound_found"; then
+ case "$canonical" in
+ *-sgi-* )
+ if test -z "$native_sound_lib"; then
+
+echo $ac_n "checking for ALopenport in -laudio""... $ac_c" 1>&6
+echo "configure:9910: checking for ALopenport in -laudio" >&5
+ac_lib_var=`echo audio'_'ALopenport | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -laudio "
+cat > conftest.$ac_ext <<EOF
+#line 9915 "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 ALopenport();
+
+int main() {
+ALopenport()
+; return 0; }
+EOF
+if { (eval echo configure:9926: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ native_sound_lib="-laudio"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+ fi
+ if test -n "$native_sound_lib"; then
+ sound_found=yes sound_cflags=""
+ extra_objs="$extra_objs sgiplay.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"sgiplay.o\""
+ fi
+ fi ;;
+ hppa*-hp-hpux* )
+ if test -z "$native_sound_lib"; then
+
+echo $ac_n "checking for AOpenAudio in -lAlib""... $ac_c" 1>&6
+echo "configure:9957: checking for AOpenAudio in -lAlib" >&5
+ac_lib_var=`echo Alib'_'AOpenAudio | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lAlib "
+cat > conftest.$ac_ext <<EOF
+#line 9962 "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 AOpenAudio();
+
+int main() {
+AOpenAudio()
+; return 0; }
+EOF
+if { (eval echo configure:9973: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ native_sound_lib="-lAlib"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+ fi
+ if test -n "$native_sound_lib"; then
+ sound_found=yes
+ extra_objs="$extra_objs hpplay.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"hpplay.o\""
+ fi
+ if test "$GCC" = "yes" # Kludge city
+ then sound_cflags="-Dconst= -Dvolatile= -I/usr/audio/examples"
+ else sound_cflags="+e -I/usr/audio/examples"
+ fi
+ fi ;;
+ esac
+ fi
+
+ if test -z "$sound_found"; then
+ 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:10011: checking for ${dir}/soundcard.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 10014 "configure"
+#include "confdefs.h"
+#include <${dir}/soundcard.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:10019: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ sound_found=yes
+ extra_objs="$extra_objs linuxplay.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"linuxplay.o\""
+ fi
+ { test "$extra_verbose" = "yes" && cat << EOF
+ Defining SOUNDCARD_H_PATH = "${dir}/soundcard.h"
+EOF
+cat >> confdefs.h <<EOF
+#define SOUNDCARD_H_PATH "${dir}/soundcard.h"
+EOF
+}
+
+ break
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ done
+ fi
+
+ 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
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_NATIVE_SOUND 1
+EOF
+}
+
+ 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
+ Defining HAVE_NAS_SOUND
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_NAS_SOUND 1
+EOF
+}
+
+ 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 <<EOF
+#line 10089 "configure"
+#include "confdefs.h"
+#include <audio/Xtutil.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "AuXtErrorJump" >/dev/null 2>&1; then
+ :
+else
+ rm -rf conftest*
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining NAS_NO_ERROR_JUMP
+EOF
+cat >> confdefs.h <<\EOF
+#define NAS_NO_ERROR_JUMP 1
+EOF
+}
+
+fi
+rm -f conftest*
+
+esac
+
+
+test -z "$with_tty" && with_tty=yes
+
+if test "$with_tty" = "yes" ; then
+ echo "checking for TTY-related features" 1>&6
+echo "configure:10116: checking for TTY-related features" >&5
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_TTY
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_TTY 1
+EOF
+}
+
+ extra_objs="$extra_objs console-tty.o device-tty.o event-tty.o frame-tty.o objects-tty.o redisplay-tty.o cm.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"console-tty.o device-tty.o event-tty.o frame-tty.o objects-tty.o redisplay-tty.o cm.o\""
+ fi
+
+ if test -z "$with_ncurses"; then
+
+echo $ac_n "checking for tgetent in -lncurses""... $ac_c" 1>&6
+echo "configure:10132: checking for tgetent in -lncurses" >&5
+ac_lib_var=`echo ncurses'_'tgetent | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lncurses "
+cat > conftest.$ac_ext <<EOF
+#line 10137 "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 tgetent();
+
+int main() {
+tgetent()
+; return 0; }
+EOF
+if { (eval echo configure:10148: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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_ncurses=yes
+else
+ echo "$ac_t""no" 1>&6
+with_ncurses=no
+fi
+
+
+ fi
+ if test "$with_ncurses" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_NCURSES
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_NCURSES 1
+EOF
+}
+
+ ac_safe=`echo "ncurses/curses.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for ncurses/curses.h""... $ac_c" 1>&6
+echo "configure:10181: checking for ncurses/curses.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 10184 "configure"
+#include "confdefs.h"
+#include <ncurses/curses.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:10189: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ curses_h_path=ncurses/curses.h
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ ac_safe=`echo "ncurses/term.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for ncurses/term.h""... $ac_c" 1>&6
+echo "configure:10211: checking for ncurses/term.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 10214 "configure"
+#include "confdefs.h"
+#include <ncurses/term.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:10219: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ term_h_path=ncurses/term.h
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ extra_objs="$extra_objs terminfo.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"terminfo.o\""
+ fi
+ LIBS="-lncurses $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lncurses\" to \$LIBS"; fi
+
+ if test "$ac_cv_header_ncurses_curses_h" != "yes" ; then
+ save_c_switch_site="$c_switch_site"
+ 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:10249: checking for ncurses/curses.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 10252 "configure"
+#include "confdefs.h"
+#include <ncurses/curses.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:10257: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ curses_h_path=ncurses/curses.h
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test "$ac_cv_header_ncurses_curses_h" = "yes"
+ then echo "configure: warning: "Your system has the bogus ncurses include bug."" 1>&2
+ else c_switch_site="$save_c_switch_site"
+ fi
+ fi
+ else if test "$have_terminfo" = "yes"; then
+ extra_objs="$extra_objs terminfo.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"terminfo.o\""
+ fi
+ if test -n "$libs_termcap"; then
+ LIBS="$libs_termcap $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"$libs_termcap\" to \$LIBS"; fi
+ else
+ for lib in curses termlib termcap; do
+
+echo $ac_n "checking for tgetent in -l$lib""... $ac_c" 1>&6
+echo "configure:10292: 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 <<EOF
+#line 10297 "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 tgetent();
+
+int main() {
+tgetent()
+; return 0; }
+EOF
+if { (eval echo configure:10308: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ LIBS="-l${lib} $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-l${lib}\" to \$LIBS"; fi; break
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+ done
+ fi
+ else extra_objs="$extra_objs tparam.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"tparam.o\""
+ fi
+ case "$opsys" in *-hp-hpux* ) libs_termcap="-ltermcap" ;; esac
+ if test -n "$libs_termcap"; then
+ LIBS="$libs_termcap $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"$libs_termcap\" to \$LIBS"; fi
+ else
+
+echo $ac_n "checking for tgetent in -lcurses""... $ac_c" 1>&6
+echo "configure:10339: checking for tgetent in -lcurses" >&5
+ac_lib_var=`echo curses'_'tgetent | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lcurses "
+cat > conftest.$ac_ext <<EOF
+#line 10344 "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 tgetent();
+
+int main() {
+tgetent()
+; return 0; }
+EOF
+if { (eval echo configure:10355: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ LIBS="-lcurses $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lcurses\" to \$LIBS"; fi
+else
+ echo "$ac_t""no" 1>&6
+echo $ac_n "checking for tgetent in -ltermcap""... $ac_c" 1>&6
+echo "configure:10373: checking for tgetent in -ltermcap" >&5
+ac_lib_var=`echo termcap'_'tgetent | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -ltermcap "
+cat > conftest.$ac_ext <<EOF
+#line 10378 "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 tgetent();
+
+int main() {
+tgetent()
+; return 0; }
+EOF
+if { (eval echo configure:10389: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ LIBS="-ltermcap $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-ltermcap\" to \$LIBS"; fi
+else
+ echo "$ac_t""no" 1>&6
+extra_objs="$extra_objs termcap.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"termcap.o\""
+ fi
+fi
+
+
+fi
+
+
+ fi
+ fi
+ fi
+ { test "$extra_verbose" = "yes" && cat << EOF
+ Defining CURSES_H_PATH = "${curses_h_path-curses.h}"
+EOF
+cat >> confdefs.h <<EOF
+#define CURSES_H_PATH "${curses_h_path-curses.h}"
+EOF
+}
+
+ { test "$extra_verbose" = "yes" && cat << EOF
+ Defining TERM_H_PATH = "${term_h_path-term.h}"
+EOF
+cat >> confdefs.h <<EOF
+#define TERM_H_PATH "${term_h_path-term.h}"
+EOF
+}
+
+
+ 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:10437: checking for gpm.h" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 10440 "configure"
+#include "confdefs.h"
+#include <gpm.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:10445: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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
+ :
+else
+ echo "$ac_t""no" 1>&6
+with_gpm=no
+fi
+ }
+ test -z "$with_gpm" && {
+echo $ac_n "checking for Gpm_Open in -lgpm""... $ac_c" 1>&6
+echo "configure:10468: 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 <<EOF
+#line 10473 "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 Gpm_Open();
+
+int main() {
+Gpm_Open()
+; return 0; }
+EOF
+if { (eval echo configure:10484: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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_gpm=yes
+else
+ echo "$ac_t""no" 1>&6
+with_gpm=no
+fi
+
+ }
+ if test "$with_gpm" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_GPM
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_GPM 1
+EOF
+}
+
+ extra_objs="$extra_objs gpmevent.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"gpmevent.o\""
+ fi
+ LIBS="-lgpm $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lgpm\" to \$LIBS"; fi
+ fi
+
+else for feature in ncurses gpm; do
+ if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then
+ echo "configure: warning: "--with-${feature} ignored: Not valid without TTY support"" 1>&2
+ fi
+ eval "with_${feature}=no"
+ done
+fi
+test "$with_x11" = "yes" -o "$with_tty" = "yes" && extra_objs="$extra_objs event-unixoid.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"event-unixoid.o\""
+ fi
+
+
+echo "checking for database support" 1>&6
+echo "configure:10533: checking for database support" >&5
+
+if test "$with_database_gnudbm" != "no"; then
+ for ac_hdr in ndbm.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:10540: checking for $ac_hdr" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 10543 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:10548: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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 <<EOF
+#define $ac_tr_hdr 1
+EOF
+}
+ have_ndbm_h=yes
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+ if test "$have_ndbm_h" = "yes"; then
+
+echo $ac_n "checking for dbm_open in -lgdbm""... $ac_c" 1>&6
+echo "configure:10580: 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 <<EOF
+#line 10585 "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 dbm_open();
+
+int main() {
+dbm_open()
+; return 0; }
+EOF
+if { (eval echo configure:10596: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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_database_gnudbm=yes have_libgdbm=yes
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+ fi
+ if test "$with_database_gnudbm" != "yes"; then
+ echo $ac_n "checking for dbm_open""... $ac_c" 1>&6
+echo "configure:10619: checking for dbm_open" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 10622 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char dbm_open(); below. */
+#include <assert.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 dbm_open();
+
+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_dbm_open) || defined (__stub___dbm_open)
+choke me
+#else
+dbm_open();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:10645: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ eval "ac_cv_func_dbm_open=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_dbm_open=no"
+fi
+rm -f conftest*
+
+if eval "test \"`echo '$ac_cv_func_'dbm_open`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ with_database_gnudbm=yes
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ fi
+ if test "$with_database_gnudbm" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_DBM
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_DBM 1
+EOF
+}
+
+ test "$have_libgdbm" = "yes" && LIBS="-lgdbm $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lgdbm\" to \$LIBS"; fi
+ with_database_dbm=no
+ else with_database_gnudbm=no
+ fi
+fi
+
+if test "$with_database_dbm" != "no"; then
+ echo $ac_n "checking for dbm_open""... $ac_c" 1>&6
+echo "configure:10681: checking for dbm_open" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 10684 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char dbm_open(); below. */
+#include <assert.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 dbm_open();
+
+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_dbm_open) || defined (__stub___dbm_open)
+choke me
+#else
+dbm_open();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:10707: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ eval "ac_cv_func_dbm_open=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_dbm_open=no"
+fi
+rm -f conftest*
+
+if eval "test \"`echo '$ac_cv_func_'dbm_open`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ with_database_dbm=yes need_libdbm=no
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test "$need_libdbm" != "no"; then
+
+echo $ac_n "checking for dbm_open in -ldbm""... $ac_c" 1>&6
+echo "configure:10728: 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 <<EOF
+#line 10733 "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 dbm_open();
+
+int main() {
+dbm_open()
+; return 0; }
+EOF
+if { (eval echo configure:10744: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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_database_dbm=yes need_libdbm=yes
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+ fi
+ if test "$with_database_dbm" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_DBM
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_DBM 1
+EOF
+}
+
+ test "$need_libdbm" = "yes" && LIBS="-ldbm $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-ldbm\" to \$LIBS"; fi
+ else with_database_dbm=no
+ fi
+fi
+
+if test "$with_database_berkdb" != "no"; then
+ echo $ac_n "checking for Berkeley db.h""... $ac_c" 1>&6
+echo "configure:10781: checking for Berkeley db.h" >&5
+ for path in "db/db.h" "db.h"; do
+ cat > conftest.$ac_ext <<EOF
+#line 10784 "configure"
+#include "confdefs.h"
+#ifdef HAVE_INTTYPES_H
+#define __BIT_TYPES_DEFINED__
+#include <inttypes.h>
+typedef uint8_t u_int8_t;
+typedef uint16_t u_int16_t;
+typedef uint32_t u_int32_t;
+#ifdef WE_DONT_NEED_QUADS
+typedef uint64_t u_int64_t;
+#endif
+#endif
+#include <$path>
+
+int main() {
+
+; return 0; }
+EOF
+if { (eval echo configure:10802: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ db_h_path="$path"; break
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+fi
+rm -f conftest*
+ done
+ if test -z "$db_h_path"
+ then echo "$ac_t""no" 1>&6; with_database_berkdb=no
+ else echo "$ac_t""$db_h_path" 1>&6
+ fi
+
+ if test "$with_database_berkdb" != "no"; then
+ echo $ac_n "checking for Berkeley DB version""... $ac_c" 1>&6
+echo "configure:10818: checking for Berkeley DB version" >&5
+ cat > conftest.$ac_ext <<EOF
+#line 10820 "configure"
+#include "confdefs.h"
+#include <$db_h_path>
+#if DB_VERSION_MAJOR > 1
+yes
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "yes" >/dev/null 2>&1; then
+ rm -rf conftest*
+ echo "$ac_t""2" 1>&6; dbfunc=db_open
+else
+ rm -rf conftest*
+ echo "$ac_t""1" 1>&6; dbfunc=dbopen
+fi
+rm -f conftest*
+
+ echo $ac_n "checking for $dbfunc""... $ac_c" 1>&6
+echo "configure:10839: checking for $dbfunc" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 10842 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $dbfunc(); below. */
+#include <assert.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 $dbfunc();
+
+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_$dbfunc) || defined (__stub___$dbfunc)
+choke me
+#else
+$dbfunc();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:10865: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ eval "ac_cv_func_$dbfunc=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_$dbfunc=no"
+fi
+rm -f conftest*
+
+if eval "test \"`echo '$ac_cv_func_'$dbfunc`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ with_database_berkdb=yes need_libdb=no
+else
+ echo "$ac_t""no" 1>&6
+
+
+echo $ac_n "checking for $dbfunc in -ldb""... $ac_c" 1>&6
+echo "configure:10884: checking for $dbfunc in -ldb" >&5
+ac_lib_var=`echo db'_'$dbfunc | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -ldb "
+cat > conftest.$ac_ext <<EOF
+#line 10889 "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 $dbfunc();
+
+int main() {
+$dbfunc()
+; return 0; }
+EOF
+if { (eval echo configure:10900: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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_database_berkdb=yes need_libdb=yes
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+fi
+
+ fi
+
+ if test "$with_database_berkdb" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << EOF
+ Defining DB_H_PATH = "$db_h_path"
+EOF
+cat >> confdefs.h <<EOF
+#define DB_H_PATH "$db_h_path"
+EOF
+}
+
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_BERKELEY_DB
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_BERKELEY_DB 1
+EOF
+}
+
+ test "$need_libdb" = "yes" && LIBS="-ldb $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-ldb\" to \$LIBS"; fi
+ else with_database_berkdb=no
+ fi
+fi
+
+if test "$with_database_gnudbm $with_database_dbm $with_database_berkdb" \
+ != "no no no"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_DATABASE
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_DATABASE 1
+EOF
+}
+
+ extra_objs="$extra_objs database.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"database.o\""
+ fi
+fi
+
+if test "$with_socks" = "yes"; then
+
+echo $ac_n "checking for SOCKSinit in -lsocks""... $ac_c" 1>&6
+echo "configure:10964: checking for SOCKSinit in -lsocks" >&5
+ac_lib_var=`echo socks'_'SOCKSinit | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lsocks "
+cat > conftest.$ac_ext <<EOF
+#line 10969 "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 SOCKSinit();
+
+int main() {
+SOCKSinit()
+; return 0; }
+EOF
+if { (eval echo configure:10980: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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 socks | 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 <<EOF
+#define $ac_tr_lib 1
+EOF
+}
+
+ LIBS="-lsocks $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lsocks\" to \$LIBS"; fi
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+ test -n "$ac_cv_lib_socks_SOCKSinit" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_SOCKS
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_SOCKS 1
+EOF
+}
+
+fi
+
+if test "$usage_tracking" = "yes"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining USAGE_TRACKING
+EOF
+cat >> confdefs.h <<\EOF
+#define USAGE_TRACKING 1
+EOF
+}
+
+ 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:11037: checking for $ac_hdr" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 11040 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:11045: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+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 <<EOF
+#define $ac_tr_hdr 1
+EOF
+}
+ have_dlfcn=yes
+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:11076: checking for dlopen in -ldl" >&5
+ac_lib_var=`echo dl'_'dlopen | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -ldl "
+cat > conftest.$ac_ext <<EOF
+#line 11081 "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:11092: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ 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:11121: checking for _dlopen in -lc" >&5
+ac_lib_var=`echo c'_'_dlopen | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lc "
+cat > conftest.$ac_ext <<EOF
+#line 11126 "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:11137: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ 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:11166: checking for dlopen in -lc" >&5
+ac_lib_var=`echo c'_'dlopen | sed 'y%./+-%__p_%'`
+
+xe_check_libs=" -lc "
+cat > conftest.$ac_ext <<EOF
+#line 11171 "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:11182: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ 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:11211: 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 <<EOF
+#line 11216 "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 shl_load();
+
+int main() {
+shl_load()
+; return 0; }
+EOF
+if { (eval echo configure:11227: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ 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:11256: 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 <<EOF
+#line 11261 "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:11272: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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
+ 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
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_SHLIB
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_SHLIB 1
+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 dll.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"dll.o\""
+ fi
+ test ! -z "$DLL_LIB" && LIBS="-l${DLL_LIB} $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-l${DLL_LIB}\" to \$LIBS"; fi
+
+dll_ld="ld"
+dll_lflags="-shared"
+dll_cflags="-r"
+dll_oflags="-o "
+
+echo $ac_n "checking how to build a shared library""... $ac_c" 1>&6
+echo "configure:11322: checking how to build a shared library" >&5
+case `uname -rs` in
+ UNIX_SV*|UNIX_System_V*)
+ dll_lflags="-G"
+ dll_cflags=-Kpic
+ dll_ld="ld"
+ ;;
+ BSD/OS*)
+ dll_cflags=
+ dll_lflags="-r"
+ dll_ld="shlicc2"
+ ;;
+ FreeBSD*2*)
+ dll_lflags="-Bshareable"
+ dll_cflags="-fPIC -DPIC"
+ dll_ld=ld
+ ;;
+ SunOS*4.*)
+ dll_cflags="-P"
+ dll_lflags="-dp -assert pure-text -assert nodefinitions"
+ ;;
+ SunOS*5.*)
+ dll_ld="cc"
+ dll_cflags="-KPIC"
+ dll_lflags="-G"
+ dll_oflags="-W0,-y-o -W0,-y"
+ ;;
+ IRIX*5.*|IRIX*6.*)
+ dll_cflags="-KPIC"
+ ;;
+ OSF1*)
+ ;;
+ HP-UX*)
+ dll_ld="ld"
+ dll_lflags="-b"
+ dll_cflags="+z"
+ ;;
+ SCO_SV*)
+ dll_ld="ld"
+ dll_lflags="-G"
+ dll_cflags="-Kpic"
+ ;;
+ AIX*)
+ dll_lflags="-H512 -T512 -bhalt:4 -bM:SRE -bE:\${@:.ell=.exp} -b noentry -lc"
+ dll_ld="ld"
+ ;;
+ *)
+ ;;
+ esac
+
+ if test "$GCC" = "yes" ; then
+ dll_cflags="-fPIC"
+ case `uname -rs` in
+ SunOS*5.*)
+ dll_ld="ld"
+ dll_oflags="-o "
+ dll_lflags="-G"
+ ;;
+ SCO_SV*)
+ dll_ld="ld"
+ dll_lflags="-G"
+ dll_cflags="-b elf"
+ ;;
+ FreeBSD*)
+ dll_cflags="-DDLSYM_NEEDS_UNDERSCORE -DPIC -fPIC"
+ dll_lflags="-Bshareable"
+ dll_ld=ld
+ ;;
+ BSD/OS*)
+ dll_cflags=
+ dll_lflags="-r"
+ dll_ld="shlicc2"
+ ;;
+ UNIX_SV*)
+ dll_cflags="-fPIC"
+ ;;
+ *)
+ dll_ld="$CC"
+ dll_lflags="-shared"
+ esac
+ fi
+
+ echo "$ac_t"""lflags: $dll_lflags cflags: $dll_cflags"" 1>&6
+
+
+
+
+
+ for ac_func in dlerror
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:11413: checking for $ac_func" >&5
+
+cat > conftest.$ac_ext <<EOF
+#line 11416 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func(); below. */
+#include <assert.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 $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:11439: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; 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 <<EOF
+#define $ac_tr_func 1
+EOF
+}
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+ ld_dynamic_link_flags=
+ case "$opsys" in
+ hpux*) ld_dynamic_link_flags="-Wl,-E" ;;
+ linux*) ld_dynamic_link_flags="-rdynamic" ;;
+ *) ;;
+ esac
+fi
+
+cat > conftest.$ac_ext <<EOF
+#line 11475 "configure"
+#include "confdefs.h"
+int main(int c,char *v[]){return 0;}
+EOF
+if { (eval echo configure:11479: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5
+then
+ :
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+
+ echo ""
+ echo "*** PANIC *** The C compiler can no longer build working executables."
+ echo "*** PANIC *** Please examine the tail of config.log for runtime errors."
+ echo "*** PANIC *** The most likely reason for this problem is that configure"
+ echo "*** PANIC *** links with shared libraries, but those libraries cannot be"
+ echo "*** PANIC *** found at run time."
+ echo "*** PANIC ***"
+ echo "*** PANIC *** On a Linux system, edit /etc/ld.so.conf and re-run ldconfig."
+ echo "*** PANIC *** On other systems, try telling configure where to find the"
+ echo "*** PANIC *** shared libraries using the --site-runtime-libraries option"
+ echo "*** PANIC ***"
+ echo "*** PANIC *** Another way to shoot yourself in the foot is to specify"
+ echo "*** PANIC *** --with-FEATURE when FEATURE is not actually installed"
+ echo "*** PANIC *** on your system. Don't do that."
+ exit 1
+fi
+rm -fr conftest*
+
+
+{ test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HAVE_UNIX_PROCESSES
+EOF
+cat >> confdefs.h <<\EOF
+#define HAVE_UNIX_PROCESSES 1
+EOF
+}
+
+extra_objs="$extra_objs process-unix.o" && if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"process-unix.o\""
+ fi
+
+
+
+T=""
+for W in $CFLAGS; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done
+CFLAGS="$T"
+
+
+T=""
+for W in $extra_objs; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done
+extra_objs="$T"
+
+
+T=""
+for W in -DHAVE_CONFIG_H $c_switch_site $c_switch_machine $c_switch_system; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done
+c_switch_general="$T"
+
+
+T=""
+for W in $c_switch_x_site $X_CFLAGS; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done
+c_switch_window_system="$T"
+
+
+T=""
+for W in $c_switch_general $c_switch_window_system; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done
+c_switch_all="$T"
+
+
+T=""
+for W in $ld_switch_site $ld_switch_machine $ld_switch_system $ld_switch_run; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done
+ld_switch_general="$T"
+
+
+T=""
+for W in $ld_switch_x_site; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done
+ld_switch_window_system="$T"
+
+
+T=""
+for W in $ld_switch_general $ld_switch_window_system; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done
+ld_switch_all="$T"
+
+
+T=""
+for W in $LIBS $libs_machine $libs_system $libs_standard; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done
+ld_libs_general="$T"
+
+
+T=""
+for W in $X_EXTRA_LIBS $libs_x $X_PRE_LIBS; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done
+ld_libs_window_system="$T"
+
+
+T=""
+for W in $ld_libs_window_system $ld_libs_general; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done
+ld_libs_all="$T"
+
+
+
+MAKE_SUBDIR="$MAKE_SUBDIR src" && if test "$extra_verbose" = "yes"; then echo " Appending \"src\" to \$MAKE_SUBDIR"; fi
+internal_makefile_list="Makefile"
+SUBDIR_MAKEFILES=''
+test -d lock || mkdir lock
+for dir in $MAKE_SUBDIR; do
+ case "$dir" in */* ) ( for d in `echo $dir | sed 's:/: :g'` ; do
+ test -d "$d" || mkdir "$d"; cd "$d"
+ done ) ;;
+ * ) test -d "$dir" || mkdir "$dir" ;;
+ esac
+
+T=""
+for W in $SUBDIR_MAKEFILES $dir/Makefile; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done
+SUBDIR_MAKEFILES="$T"
+
+
+T=""
+for W in $internal_makefile_list $dir/Makefile.in; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done
+internal_makefile_list="$T"
+
+done
+
+
+
+
+for dir in src/s src/m; do
+ if test ! -d "$dir" ; then
+ echo Making symbolic link to "$srcdir/$dir"
+ ${LN_S} "$srcdir/$dir" "$dir"
+ fi
+done
+
+if test "$extra_verbose" = "yes"; then
+ echo ""
+ for var in extra_objs c_switch_general c_switch_window_system c_switch_all ld_switch_general ld_switch_window_system ld_switch_all ld_libs_general ld_libs_window_system ld_libs_all; do eval "echo \"$var = '\$$var'\""; done
+ 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
+fi
+
+if test "$__sunpro_c" = "yes"; then
+ echo "creating .sbinit"; echo ""
+ ( 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
+ ) > .sbinit
+fi
+
+rm -f core
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+PREFIX=$prefix
+while true; do
+ case "$PREFIX" in
+ *\$* ) eval "PREFIX=$PREFIX" ;;
+ *) break ;;
+ esac
+done
+
+
+
+EXEC_PREFIX=$exec_prefix
+while true; do
+ case "$EXEC_PREFIX" in
+ *\$* ) eval "EXEC_PREFIX=$EXEC_PREFIX" ;;
+ *) break ;;
+ esac
+done
+
+
+
+
+INFODIR=$infodir
+while true; do
+ case "$INFODIR" in
+ *\$* ) eval "INFODIR=$INFODIR" ;;
+ *) break ;;
+ esac
+done
+
+
+
+
+INFOPATH=$infopath
+while true; do
+ case "$INFOPATH" in
+ *\$* ) eval "INFOPATH=$INFOPATH" ;;
+ *) break ;;
+ esac
+done
+
+
+
+
+PACKAGE_PATH=$package_path
+while true; do
+ case "$PACKAGE_PATH" in
+ *\$* ) eval "PACKAGE_PATH=$PACKAGE_PATH" ;;
+ *) break ;;
+ esac
+done
+
+
+
+
+LISPDIR=$lispdir
+while true; do
+ case "$LISPDIR" in
+ *\$* ) eval "LISPDIR=$LISPDIR" ;;
+ *) break ;;
+ esac
+done
+
+
+
+
+
+ETCDIR=$etcdir
+while true; do
+ case "$ETCDIR" in
+ *\$* ) eval "ETCDIR=$ETCDIR" ;;
+ *) break ;;
+ esac
+done
+
+
+
+
+LOCKDIR=$lockdir
+while true; do
+ case "$LOCKDIR" in
+ *\$* ) eval "LOCKDIR=$LOCKDIR" ;;
+ *) break ;;
+ esac
+done
+
+
+
+
+ARCHLIBDIR=$archlibdir
+while true; do
+ case "$ARCHLIBDIR" in
+ *\$* ) eval "ARCHLIBDIR=$ARCHLIBDIR" ;;
+ *) break ;;
+ esac
+done
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+RECURSIVE_MAKE="\$(MAKE) \$(MFLAGS) CC='\$(CC)' CFLAGS='\$(CFLAGS)' LDFLAGS='\$(LDFLAGS)' CPPFLAGS='\$(CPPFLAGS)'"
+
+
+
+
+
+
+
+# The default is yes
+if test "$with_site_lisp" = "no"; then
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining INHIBIT_SITE_LISP
+EOF
+cat >> confdefs.h <<\EOF
+#define INHIBIT_SITE_LISP 1
+EOF
+}
+
+fi
+
+
+T=""
+for W in $ac_configure_args; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done
+ac_configure_args="$T"
+
+{ test "$extra_verbose" = "yes" && cat << EOF
+ Defining EMACS_CONFIGURATION = "$canonical"
+EOF
+cat >> confdefs.h <<EOF
+#define EMACS_CONFIGURATION "$canonical"
+EOF
+}
+
+{ test "$extra_verbose" = "yes" && cat << EOF
+ Defining EMACS_CONFIG_OPTIONS = "$ac_configure_args"
+EOF
+cat >> confdefs.h <<EOF
+#define EMACS_CONFIG_OPTIONS "$ac_configure_args"
+EOF
+}
+
+{ test "$extra_verbose" = "yes" && cat << EOF
+ Defining config_machfile = "$machfile"
+EOF
+cat >> confdefs.h <<EOF
+#define config_machfile "$machfile"
+EOF
+}
+
+{ test "$extra_verbose" = "yes" && cat << EOF
+ Defining config_opsysfile = "$opsysfile"
+EOF
+cat >> confdefs.h <<EOF
+#define config_opsysfile "$opsysfile"
+EOF
+}
+
+
+
+null_string=""
+{ test "$extra_verbose" = "yes" && cat << EOF
+ Defining LD_SWITCH_X_SITE = $null_string
+EOF
+cat >> confdefs.h <<EOF
+#define LD_SWITCH_X_SITE $null_string
+EOF
+}
+
+{ test "$extra_verbose" = "yes" && cat << EOF
+ Defining LD_SWITCH_X_SITE_AUX = $null_string
+EOF
+cat >> confdefs.h <<EOF
+#define LD_SWITCH_X_SITE_AUX $null_string
+EOF
+}
+
+{ test "$extra_verbose" = "yes" && cat << EOF
+ Defining C_SWITCH_X_SITE = $null_string
+EOF
+cat >> confdefs.h <<EOF
+#define C_SWITCH_X_SITE $null_string
+EOF
+}
+
+{ test "$extra_verbose" = "yes" && cat << EOF
+ Defining LD_SWITCH_SITE = $null_string
+EOF
+cat >> confdefs.h <<EOF
+#define LD_SWITCH_SITE $null_string
+EOF
+}
+
+{ test "$extra_verbose" = "yes" && cat << EOF
+ Defining C_SWITCH_SITE = $null_string
+EOF
+cat >> confdefs.h <<EOF
+#define C_SWITCH_SITE $null_string
+EOF
+}
+
+
+
+test -n "$puresize" && { test "$extra_verbose" = "yes" && cat << EOF
+ Defining RAW_PURESIZE = $puresize
+EOF
+cat >> confdefs.h <<EOF
+#define RAW_PURESIZE $puresize
+EOF
+}
+
+
+if test "$GNU_MALLOC" = "yes"; then { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining GNU_MALLOC
+EOF
+cat >> confdefs.h <<\EOF
+#define GNU_MALLOC 1
+EOF
+}
+
+elif test "$with_system_malloc" = "yes"; then { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining USE_SYSTEM_MALLOC
+EOF
+cat >> confdefs.h <<\EOF
+#define USE_SYSTEM_MALLOC 1
+EOF
+}
+
+elif test "$with_debug_malloc" = "yes"; then { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining USE_DEBUG_MALLOC
+EOF
+cat >> confdefs.h <<\EOF
+#define USE_DEBUG_MALLOC 1
+EOF
+}
+
+ { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining USE_SYSTEM_MALLOC
+EOF
+cat >> confdefs.h <<\EOF
+#define USE_SYSTEM_MALLOC 1
+EOF
+}
+
+fi
+test "$with_i18n3" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining I18N3
+EOF
+cat >> confdefs.h <<\EOF
+#define I18N3 1
+EOF
+}
+
+test "$GCC" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining USE_GCC
+EOF
+cat >> confdefs.h <<\EOF
+#define USE_GCC 1
+EOF
+}
+
+test "$external_widget" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining EXTERNAL_WIDGET
+EOF
+cat >> confdefs.h <<\EOF
+#define EXTERNAL_WIDGET 1
+EOF
+}
+
+test "$with_gnu_make" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining USE_GNU_MAKE
+EOF
+cat >> confdefs.h <<\EOF
+#define USE_GNU_MAKE 1
+EOF
+}
+
+test "$no_doc_file" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining NO_DOC_FILE
+EOF
+cat >> confdefs.h <<\EOF
+#define NO_DOC_FILE 1
+EOF
+}
+
+test "$with_quantify" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining QUANTIFY
+EOF
+cat >> confdefs.h <<\EOF
+#define QUANTIFY 1
+EOF
+}
+
+test "$with_pop" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining MAIL_USE_POP
+EOF
+cat >> confdefs.h <<\EOF
+#define MAIL_USE_POP 1
+EOF
+}
+
+test "$with_kerberos" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining KERBEROS
+EOF
+cat >> confdefs.h <<\EOF
+#define KERBEROS 1
+EOF
+}
+
+test "$with_hesiod" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining HESIOD
+EOF
+cat >> confdefs.h <<\EOF
+#define HESIOD 1
+EOF
+}
+
+test "$use_union_type" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF
+ Defining USE_UNION_TYPE
+EOF
+cat >> confdefs.h <<\EOF
+#define USE_UNION_TYPE 1
+EOF
+}
+
+
+
+(
+if test -f /etc/osversion; then echo "osversion: `cat /etc/osversion`"
+else
+ echo "uname -a: `uname -a`"
+fi
+echo ""
+echo "$0 $quoted_arguments"
+) > Installation
+
+xemacs_betaname=""
+test ! -z "${emacs_beta_version}" && xemacs_betaname="-b${emacs_beta_version}"
+
+(
+echo "
+
+XEmacs ${emacs_major_version}.${emacs_minor_version}${xemacs_betaname} \"$xemacs_codename\" configured for \`$canonical'.
+
+ Where should the build process find the source code? $srcdir
+ What installation prefix should install use? $prefix
+ What operating system and machine description files should XEmacs use?
+ \`$opsysfile' and \`$machfile'
+ What compiler should XEmacs be built with? $CC $CFLAGS
+ Should XEmacs use the GNU version of malloc? ${GNU_MALLOC}${GNU_MALLOC_reason}
+ Should XEmacs use the relocating allocator for buffers? $rel_alloc
+ What window system should XEmacs use? ${window_system}"
+if test "$with_x11" = "yes"; then
+ echo " Where do we find X Windows header files? $x_includes"
+ echo " Where do we find X Windows libraries? $x_libraries"
+fi
+if test -n "$site_includes"; then
+ echo " Additional header files: $site_includes"
+fi
+if test -n "$site_libraries"; then
+ echo " Additional libraries: $site_libraries"
+fi
+if test -n "$site_prefixes"; then
+ echo " Additional prefixes: $site_prefixes"
+fi
+if test -n "$runpath"; then
+ echo " Runtime library search path: $runpath"
+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."
+if test "$with_xmu" != yes -a "$with_x11" = yes; then
+ echo " No Xmu; substituting equivalent routines."
+fi
+
+if test "$with_xpm" = yes; then
+ echo " Compiling in support for XPM images."
+elif test "$with_x11" = yes; then
+ echo " --------------------------------------------------------------------"
+ echo " WARNING: Compiling without XPM support."
+ echo " WARNING: You should strongly considering installing XPM."
+ echo " WARNING: Otherwise toolbars and other graphics will look suboptimal."
+ echo " --------------------------------------------------------------------"
+fi
+test "$with_xface" = yes && echo " Compiling in support for X-Face message headers."
+test "$with_gif" = yes && echo " Compiling in support for GIF image conversion."
+test "$with_jpeg" = yes && echo " Compiling in support for JPEG image conversion."
+test "$with_png" = yes && echo " Compiling in support for PNG image conversion."
+test "$with_tiff" = yes && echo " Compiling in support for TIFF image conversion."
+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_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_ncurses" = yes && echo " Compiling in support for ncurses."
+test "$with_gpm" = yes && echo " Compiling in support for GPM (General Purpose Mouse)."
+
+test "$with_mule" = yes && echo " Compiling in Mule (multi-lingual) support."
+test "$with_file_coding" = yes && echo " Compiling in File coding support."
+test "$with_xim" != no && echo " Compiling in XIM (X11R5+ I18N input method) support."
+test "$with_xim" = motif && echo " Using Motif to provide XIM support."
+test "$with_xim" = xlib && echo " Using raw Xlib to provide XIM support."
+test "$with_xfs" = yes && echo " Using XFontSet to provide bilingual menubar."
+test "$with_canna" = yes && echo " Compiling in support for Canna on Mule."
+if test "$with_wnn" = yes; then
+ echo " Compiling in support for the WNN input method on Mule."
+ test "$with_wnn6" = yes && echo " Using WNN version 6."
+fi
+test "$with_i18n3" = yes && echo " Compiling in I18N support, level 3 (doesn't currently work)."
+
+test "$with_cde" = yes && echo " Compiling in support for CDE."
+test "$with_tooltalk" = yes && echo " Compiling in support for ToolTalk."
+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."
+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'." ;;
+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." ;;
+esac
+case "$with_dialogs" in
+ motif ) echo " Using Motif dialog boxes." ;;
+ athena ) echo " Using Athena dialog boxes." ;;
+ athena3d ) echo " Using Athena-3d dialog boxes." ;;
+esac
+test "$with_shlib" = "yes" && echo " Compiling in DLL 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."
+test "$with_pop" = yes && echo " Using POP for mail access"
+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)."
+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: ---------------------------------------------------------"
+ echo " WARNING: Compiling in support for runtime error checking."
+ echo " WARNING: XEmacs will run noticeably more slowly as a result."
+ echo " WARNING: Error checking is on by default for XEmacs beta releases."
+ echo " WARNING: ---------------------------------------------------------"
+fi
+echo ""
+) | 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" &&
+ prefix=`echo '' "$prefix" | sed -e 's:^ ::' -e 's,\([^/]\)/*$,\1,'`
+test -n "$exec_prefix" &&
+ exec_prefix=`echo '' "$exec_prefix" | sed -e 's:^ ::' -e 's,\([^/]\)/*$,\1,'`
+
+
+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"
+done
+ac_output_files="$ac_output_files src/paths.h lib-src/config.values"
+
+trap '' 1 2 15
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+DEFS=-DHAVE_CONFIG_H
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+ case "\$ac_option" in
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+ exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+ -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+ echo "$CONFIG_STATUS generated by autoconf version 2.12"
+ exit 0 ;;
+ -help | --help | --hel | --he | --h)
+ echo "\$ac_cs_usage"; exit 0 ;;
+ *) echo "\$ac_cs_usage"; exit 1 ;;
+ esac
+done
+
+ac_given_srcdir=$srcdir
+ac_given_INSTALL="$INSTALL"
+
+trap 'rm -fr `echo "$ac_output_files src/config.h lwlib/config.h" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@LN_S@%$LN_S%g
+s%@blddir@%$blddir%g
+s%@CC@%$CC%g
+s%@CPP@%$CPP%g
+s%@start_flags@%$start_flags%g
+s%@ld_switch_shared@%$ld_switch_shared%g
+s%@start_files@%$start_files%g
+s%@ld@%$ld%g
+s%@lib_gcc@%$lib_gcc%g
+s%@RANLIB@%$RANLIB%g
+s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
+s%@INSTALL_DATA@%$INSTALL_DATA%g
+s%@YACC@%$YACC%g
+s%@SET_MAKE@%$SET_MAKE%g
+s%@X_CFLAGS@%$X_CFLAGS%g
+s%@X_PRE_LIBS@%$X_PRE_LIBS%g
+s%@X_LIBS@%$X_LIBS%g
+s%@X_EXTRA_LIBS@%$X_EXTRA_LIBS%g
+s%@install_pp@%$install_pp%g
+s%@libs_xauth@%$libs_xauth%g
+s%@dnd_objs@%$dnd_objs%g
+s%@lwlib_objs@%$lwlib_objs%g
+s%@ALLOCA@%$ALLOCA%g
+s%@dll_ld@%$dll_ld%g
+s%@dll_cflags@%$dll_cflags%g
+s%@dll_oflags@%$dll_oflags%g
+s%@dll_lflags@%$dll_lflags%g
+s%@SRC_SUBDIR_DEPS@%$SRC_SUBDIR_DEPS%g
+s%@INSTALL_ARCH_DEP_SUBDIR@%$INSTALL_ARCH_DEP_SUBDIR%g
+s%@MAKE_SUBDIR@%$MAKE_SUBDIR%g
+s%@SUBDIR_MAKEFILES@%$SUBDIR_MAKEFILES%g
+s%@PROGNAME@%$PROGNAME%g
+s%@version@%$version%g
+s%@configuration@%$configuration%g
+s%@canonical@%$canonical%g
+s%@srcdir@%$srcdir%g
+s%@pkgdir@%$pkgdir%g
+s%@statedir@%$statedir%g
+s%@PREFIX@%$PREFIX%g
+s%@EXEC_PREFIX@%$EXEC_PREFIX%g
+s%@INFODIR_USER_DEFINED@%$INFODIR_USER_DEFINED%g
+s%@INFODIR@%$INFODIR%g
+s%@infopath@%$infopath%g
+s%@INFOPATH_USER_DEFINED@%$INFOPATH_USER_DEFINED%g
+s%@INFOPATH@%$INFOPATH%g
+s%@package_path@%$package_path%g
+s%@PACKAGE_PATH_USER_DEFINED@%$PACKAGE_PATH_USER_DEFINED%g
+s%@PACKAGE_PATH@%$PACKAGE_PATH%g
+s%@lispdir@%$lispdir%g
+s%@LISPDIR_USER_DEFINED@%$LISPDIR_USER_DEFINED%g
+s%@LISPDIR@%$LISPDIR%g
+s%@etcdir@%$etcdir%g
+s%@ETCDIR_USER_DEFINED@%$ETCDIR_USER_DEFINED%g
+s%@ETCDIR@%$ETCDIR%g
+s%@lockdir@%$lockdir%g
+s%@LOCKDIR_USER_DEFINED@%$LOCKDIR_USER_DEFINED%g
+s%@LOCKDIR@%$LOCKDIR%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%@ld_dynamic_link_flags@%$ld_dynamic_link_flags%g
+s%@machfile@%$machfile%g
+s%@opsysfile@%$opsysfile%g
+s%@c_switch_general@%$c_switch_general%g
+s%@c_switch_window_system@%$c_switch_window_system%g
+s%@c_switch_all@%$c_switch_all%g
+s%@ld_switch_general@%$ld_switch_general%g
+s%@ld_switch_window_system@%$ld_switch_window_system%g
+s%@ld_switch_all@%$ld_switch_all%g
+s%@ld_libs_general@%$ld_libs_general%g
+s%@ld_libs_window_system@%$ld_libs_window_system%g
+s%@ld_libs_all@%$ld_libs_all%g
+s%@RECURSIVE_MAKE@%$RECURSIVE_MAKE%g
+s%@native_sound_lib@%$native_sound_lib%g
+s%@sound_cflags@%$sound_cflags%g
+s%@dynodump_arch@%$dynodump_arch%g
+s%@internal_makefile_list@%$internal_makefile_list%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+ else
+ sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+ fi
+ if test ! -s conftest.s$ac_file; then
+ ac_more_lines=false
+ rm -f conftest.s$ac_file
+ else
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f conftest.s$ac_file"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+ fi
+ ac_file=`expr $ac_file + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_cmds`
+ fi
+done
+if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"$ac_output_files"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+ else
+ ac_dir_suffix= ac_dots=
+ fi
+
+ case "$ac_given_srcdir" in
+ .) srcdir=.
+ if test -z "$ac_dots"; then top_srcdir=.
+ else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+ /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+ *) # Relative path.
+ srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+ top_srcdir="$ac_dots$ac_given_srcdir" ;;
+ esac
+
+ case "$ac_given_INSTALL" in
+ [/$]*) INSTALL="$ac_given_INSTALL" ;;
+ *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+ esac
+
+ echo creating "$ac_file"
+ rm -f "$ac_file"
+ configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+ case "$ac_file" in
+ *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+ *) ac_comsub= ;;
+ esac
+
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+ sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+s%@INSTALL@%$INSTALL%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+# These sed commands are passed to sed as "A NAME B NAME C VALUE D", where
+# NAME is the cpp macro being defined and VALUE is the value it is being given.
+#
+# ac_d sets the value in "#define NAME VALUE" lines.
+ac_dA='s%^\([ ]*\)#\([ ]*define[ ][ ]*\)'
+ac_dB='\([ ][ ]*\)[^ ]*%\1#\2'
+ac_dC='\3'
+ac_dD='%g'
+# ac_u turns "#undef NAME" with trailing blanks into "#define NAME VALUE".
+ac_uA='s%^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)'
+ac_uB='\([ ]\)%\1#\2define\3'
+ac_uC=' '
+ac_uD='\4%g'
+# ac_e turns "#undef NAME" without trailing blanks into "#define NAME VALUE".
+ac_eA='s%^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)'
+ac_eB='$%\1#\2define\3'
+ac_eC=' '
+ac_eD='%g'
+
+if test "${CONFIG_HEADERS+set}" != set; then
+EOF
+cat >> $CONFIG_STATUS <<EOF
+ CONFIG_HEADERS="src/config.h lwlib/config.h"
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+fi
+for ac_file in .. $CONFIG_HEADERS; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ echo creating $ac_file
+
+ rm -f conftest.frag conftest.in conftest.out
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+ cat $ac_file_inputs > conftest.in
+
+EOF
+
+# Transform confdefs.h into a sed script conftest.vals that substitutes
+# the proper values into config.h.in to produce config.h. And first:
+# Protect against being on the right side of a sed subst in config.status.
+# Protect against being in an unquoted here document in config.status.
+rm -f conftest.vals
+cat > conftest.hdr <<\EOF
+s/[\\&%]/\\&/g
+s%[\\$`]%\\&%g
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%${ac_dA}\1${ac_dB}\1${ac_dC}\2${ac_dD}%gp
+s%ac_d%ac_u%gp
+s%ac_u%ac_e%gp
+EOF
+sed -n -f conftest.hdr confdefs.h > conftest.vals
+rm -f conftest.hdr
+
+# This sed command replaces #undef with comments. This is necessary, for
+# example, in the case of _POSIX_SOURCE, which is predefined and required
+# on some systems where configure will not decide to define it.
+cat >> conftest.vals <<\EOF
+s%^[ ]*#[ ]*undef[ ][ ]*[a-zA-Z_][a-zA-Z_0-9]*%/* & */%
+EOF
+
+# Break up conftest.vals because some shells have a limit on
+# the size of here documents, and old seds have small limits too.
+
+rm -f conftest.tail
+while :
+do
+ ac_lines=`grep -c . conftest.vals`
+ # grep -c gives empty output for an empty file on some AIX systems.
+ if test -z "$ac_lines" || test "$ac_lines" -eq 0; then break; fi
+ # Write a limited-size here document to conftest.frag.
+ echo ' cat > conftest.frag <<CEOF' >> $CONFIG_STATUS
+ sed ${ac_max_here_lines}q conftest.vals >> $CONFIG_STATUS
+ echo 'CEOF
+ sed -f conftest.frag conftest.in > conftest.out
+ rm -f conftest.in
+ mv conftest.out conftest.in
+' >> $CONFIG_STATUS
+ sed 1,${ac_max_here_lines}d conftest.vals > conftest.tail
+ rm -f conftest.vals
+ mv conftest.tail conftest.vals
+done
+rm -f conftest.vals
+
+cat >> $CONFIG_STATUS <<\EOF
+ rm -f conftest.frag conftest.h
+ echo "/* $ac_file. Generated automatically by configure. */" > conftest.h
+ cat conftest.in >> conftest.h
+ rm -f conftest.in
+ if cmp -s $ac_file conftest.h 2>/dev/null; then
+ echo "$ac_file is unchanged"
+ rm -f conftest.h
+ else
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ fi
+ rm -f $ac_file
+ mv conftest.h $ac_file
+ fi
+fi; done
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+CPP="$CPP"
+ CPPFLAGS="$CPPFLAGS"
+ top_srcdir="$srcdir"
+ MAKE_SUBDIR="$MAKE_SUBDIR"
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for dir in $MAKE_SUBDIR; do
+ echo creating $dir/Makefile
+ (
+ cd $dir
+ rm -f junk.c
+ < Makefile.in \
+ sed -e '/^# Generated/d' \
+ -e 's%/\*\*/#.*%%' \
+ -e 's/^ *# */#/' \
+ -e '/^##/d' \
+ -e '/^#/ {
+p
+d
+}' -e '/./ {
+s/\([\"]\)/\\\1/g
+s/^/"/
+s/$/"/
+}' > junk.c;
+ $CPP -I. -I${top_srcdir}/src $CPPFLAGS junk.c > junk.cpp;
+ < junk.cpp \
+ sed -e 's/^#.*//' \
+ -e 's/^[ ][ ]*$//' \
+ -e 's/^ / /' \
+ | sed -n -e '/^..*$/p' \
+ | sed '/^"/ {
+s/\\\([\"]\)/\1/g
+s/^[ ]*"//
+s/"[ ]*$//
+}' > Makefile.new
+ chmod 444 Makefile.new
+ mv -f Makefile.new Makefile
+ rm -f junk.c junk.cpp
+)
+done
+
+sed < config.status >> lib-src/config.values \
+ -e '/{ac_dA}.*{ac_dB}.*{ac_dC}.*{ac_dD}$/!d' \
+ -e 's/\${ac_dA}\(.*\)\${ac_dB}.*\${ac_dC}\(.*\)\${ac_dD}/\1 \2/' \
+ -e 's/^\([^ ]*\) $/\1 ""/' \
+ -e 's/ 1$/ t/'
+
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
--- /dev/null
+dnl Define our own header notice with own copyright
+define([AC_INIT_NOTICE],
+[#### Configuration script for XEmacs. Largely divergent from FSF.
+#### Guess values for system-dependent variables and create Makefiles.
+#### Generated automatically using autoconf version] AC_ACVERSION [
+#### Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#### Copyright (C) 1993-1995 Board of Trustees, University of Illinois.
+#### Copyright (C) 1996, 1997 Sun Microsystems, Inc.
+#### Copyright (C) 1995, 1996 Ben Wing.
+
+### Don't edit this script!
+### This script was automatically generated by the `autoconf' program
+### from the file `./configure.in'.
+### To rebuild it, execute the command
+### autoconf
+### in the this directory. You must have autoconf version 2.12 or later.
+
+### 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.
+
+### For usage, run `./configure --help'
+### For more detailed information on building and installing XEmacs,
+### read the file `INSTALL'.
+###
+### If configure succeeds, it leaves its status in config.status.
+### A log of configuration tests can be found in config.log.
+### If configure fails after disturbing the status quo,
+### config.status is removed.
+])
+
+dnl Since XEmacs has configuration requirements that autoconf cannot
+dnl meet, this file is an unholy marriage of custom-baked
+dnl configuration code and autoconf macros.
+
+dnl We use the m4 quoting characters [ ] (as established by the
+dnl autoconf system), so quote them like this: [[foo]]
+
+AC_PREREQ(2.12)dnl
+dnl Redefine some standard autoconf macros
+dnl here is how XEmacs is different:
+dnl - no cache file
+dnl - non-standard options
+dnl - suport for extra-verbosity
+dnl - ordinary libs are handled separately from X libs (might be a mistake)
+dnl - various random kludges (e.g. -with-dnet=no
+
+dnl PRINT_VAR(var var ...) prints values of shell variables
+define([PRINT_VAR],[for var in patsubst([$1],[[
+]+],[ ]); do eval "echo \"$var = '\$$var'\""; done])
+
+dnl Disable cache files:
+dnl This is controversial, but I am convinced this is the right way to go,
+dnl at least by default. Otherwise there are too many surprises.
+define([AC_CACHE_LOAD], )dnl
+define([AC_CACHE_SAVE], )dnl
+define([AC_CACHE_VAL], [
+$2
+])dnl
+
+dnl Redefine AC_TRY_RUN_NATIVE to not throw away stderr while running
+dnl AC_TRY_RUN_NATIVE(PROGRAM, [ACTION-IF-TRUE [, ACTION-IF-FALSE]])
+define([AC_TRY_RUN_NATIVE],
+[cat > conftest.$ac_ext <<EOF
+[#]line __oline__ "configure"
+#include "confdefs.h"
+[$1]
+EOF
+if AC_TRY_EVAL(ac_link) && test -s conftest && (./conftest; exit) 2>&AC_FD_CC
+then
+dnl Do not remove the temporary files here, so they can be examined.
+ ifelse([$2], , :, [$2])
+else
+ echo "configure: failed program was:" >&AC_FD_CC
+ cat conftest.$ac_ext >&AC_FD_CC
+ifelse([$3], , , [ rm -fr conftest*
+ $3
+])dnl
+fi
+rm -fr conftest*])dnl AC_TRY_RUN_NATIVE
+
+
+dnl Avoid spurious cross-compiling warnings from AC_TRY_RUN
+dnl XEmacs is unlikely to ever cross-compile
+define([AC_TRY_RUN],[AC_TRY_RUN_NATIVE([$1], [$2], [$3])])dnl
+
+dnl Redefine AC_DEFINE* to provide more output if extra_verbose
+dnl Set VARIABLE to VALUE, verbatim, or 1.
+dnl AC_DEFINE(VARIABLE [, VALUE])
+define([AC_DEFINE],
+[{ test "$extra_verbose" = "yes" && cat << \EOF
+ Defining $1[]ifelse($#, 2, [ = $2],)
+EOF
+cat >> confdefs.h <<\EOF
+[#define] $1 ifelse($#, 2, [$2], 1)
+EOF
+}
+])dnl AC_DEFINE
+
+define([AC_DEFINE_UNQUOTED],
+[{ test "$extra_verbose" = "yes" && cat << EOF
+ Defining $1[]ifelse($#, 2, [ = $2],)
+EOF
+cat >> confdefs.h <<EOF
+[#define] $1 ifelse($#, 2, [$2], 1)
+EOF
+}
+])dnl AC_DEFINE_UNQUOTED
+
+dnl redefine AC_CHECK_LIB in accordance with our own value of ac_link
+dnl Add in extra kludgy check to support with_dnet=no
+dnl Add in extra LDFLAGS arg, which PRECEDE libs
+dnl Support --with-dnet=no
+
+dnl AC_CHECK_LIB(LIBRARY, FUNCTION [, ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND
+dnl [, OTHER-LIBRARIES] [, LDFLAGS]]]])
+define([AC_CHECK_LIB],
+[ifelse([$1],dnet, [if test "$with_dnet" = "no" ; then
+ac_cv_lib_dnet_dnet_ntoa=no
+ifelse([$4], , , [$4]
+)dnl
+else
+])]
+AC_CHECK_LIB_ORIG_HACKED([$1],[$2],[$3],[$4],[$5], [$6])
+[ifelse([$1],dnet,[fi
+])]dnl
+)dnl AC_CHECK_LIB
+
+define([AC_CHECK_LIB_ORIG_HACKED],
+[ifelse([$5],,AC_MSG_CHECKING([for $2 in -l$1]),
+xe_msg_checking="for [$2] in -l[$1]"
+test -n "[$5]" && xe_msg_checking="$xe_msg_checking using extra libs [$5]"
+AC_MSG_CHECKING("$xe_msg_checking"))
+dnl Use a cache variable name containing both the library and function name,
+dnl because the test really is for library $1 defining function $2, not
+dnl just for library $1. Separate tests with the same $1 and different $2s
+dnl may have different results.
+ac_lib_var=`echo $1['_']$2 | sed 'y%./+-%__p_%'`
+AC_CACHE_VAL(ac_cv_lib_$ac_lib_var,
+[xe_check_libs="$6 -l$1 $5"
+AC_TRY_LINK(dnl
+ifelse([$2], [main], , dnl Avoid conflicting decl of main.
+[/* Override any gcc2 internal prototype to avoid an error. */
+]ifelse(AC_LANG, CPLUSPLUS, [#ifdef __cplusplus
+extern "C"
+#endif
+])dnl
+[/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char $2();
+]),
+ [$2()],
+ eval "ac_cv_lib_$ac_lib_var=yes",
+ eval "ac_cv_lib_$ac_lib_var=no")
+xe_check_libs=""
+])dnl
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then
+ AC_MSG_RESULT(yes)
+ ifelse([$3], ,
+[changequote(, )dnl
+ ac_tr_lib=HAVE_LIB`echo $1 | sed -e 's/[^a-zA-Z0-9_]/_/g' \
+ -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'`
+changequote([, ])dnl
+ AC_DEFINE_UNQUOTED($ac_tr_lib)
+ XE_PREPEND([-l$1], LIBS)
+], [$3])
+else
+ AC_MSG_RESULT(no)
+ifelse([$4], , , [$4
+])dnl
+fi
+])dnl AC_CHECK_LIB_ORIG_HACKED
+
+
+dnl AC_LANG_C()
+define([AC_LANG_C],
+[define([AC_LANG], [C])dnl
+ac_ext=c
+dnl CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+dnl ac_cpp='$CPP $CPPFLAGS'
+dnl ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&AC_FD_CC'
+dnl ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&AC_FD_CC'
+xe_cppflags='$CPPFLAGS $c_switch_site $c_switch_machine $c_switch_system $c_switch_x_site $X_CFLAGS'
+xe_ldflags='$LDFLAGS $ld_switch_site $ld_switch_machine $ld_switch_system $ld_switch_x_site $ld_switch_run'
+xe_libs='$ld_call_shared $xe_check_libs $X_EXTRA_LIBS $libs_x $X_PRE_LIBS $LIBS $libs_machine $libs_system $libs_standard'
+ac_cpp='$CPP '"$xe_cppflags"
+ac_compile='${CC-cc} -c $CFLAGS '"$xe_cppflags"' conftest.$ac_ext 1>&AC_FD_CC'
+ac_link='${CC-cc} -o conftest $CFLAGS '"$xe_cppflags $xe_ldflags"' conftest.$ac_ext '"$xe_libs"' 1>&AC_FD_CC'
+cross_compiling=no
+]) dnl AC_LANG_C
+
+dnl The construct foo=`echo $w1 $w2 $w3` fails on some systems if $w1 = -e or -n
+dnl So we use the following instead.
+dnl XE_SPACE(var, words)
+define([XE_SPACE],[
+T=""
+for W in $2; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done
+$1="$T"
+])dnl XE_SPACE
+
+dnl XE_ADD_OBJS(foo.o ...)
+define([XE_ADD_OBJS],
+[extra_objs="$extra_objs [$1]" && dnl
+ if test "$extra_verbose" = "yes"; then
+ echo " xemacs will be linked with \"[$1]\""
+ fi])dnl XE_ADD_OBJS
+
+dnl XE_APPEND(value, varname)
+define([XE_APPEND],
+[[$2]="$[$2] [$1]" && dnl
+ if test "$extra_verbose" = "yes"; then echo " Appending \"[$1]\" to \$[$2]"; fi])
+
+dnl XE_PREPEND(value, varname)
+define([XE_PREPEND],
+[[$2]="[$1] $[$2]" && dnl
+ if test "$extra_verbose" = "yes"; then echo " Prepending \"[$1]\" to \$[$2]"; fi])
+
+
+dnl Initialize some variables set by options.
+dnl The variables have the same names as the options, with
+dnl dashes changed to underlines.
+
+define([AC_INIT_PARSE_ARGS],[
+
+dnl Get sane consistent behavior from various shells
+dnl Avoid losing with weird user CDPATHs
+
+if test -n "$ZSH_VERSION"; then
+ dnl zsh's Bourne shell emulation options
+ setopt NO_BAD_PATTERN NO_BANG_HIST NO_BG_NICE NO_EQUALS NO_FUNCTION_ARGZERO
+ setopt GLOB_SUBST NO_HUP INTERACTIVE_COMMENTS KSH_ARRAYS NO_MULTIOS NO_NOMATCH
+ setopt RM_STAR_SILENT POSIX_BUILTINS SH_FILE_EXPANSION SH_GLOB SH_OPTION_LETTERS
+ setopt SH_WORD_SPLIT BSD_ECHO IGNORE_BRACES
+ dnl zsh-3.1-beta drops core on the following
+ dnl unset CDPATH
+ if test -n "$CDPATH"; then CDPATH="."; export CDPATH; fi
+elif test -n "$BASH_VERSION"; then
+ dnl Use Posix mode with bash
+ set -o posix
+ unset CDPATH
+else
+ if test -n "$CDPATH"; then CDPATH="."; export CDPATH; fi
+fi
+
+dnl Initialize some variables set by options.
+dnl The variables have the same names as the options, with
+dnl dashes changed to underlines.
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+
+dnl Installation directory options.
+dnl These are left unexpanded so users can "make install exec_prefix=/foo"
+dnl and all the variables that are supposed to be based on exec_prefix
+dnl by default will actually change.
+dnl Use braces instead of parens because sh, perl, etc. also accept them.
+dnl If you change these, you need to synchronize with the settings of the
+dnl various ..._USER_DEFINED variables further down.
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${{exec_prefix}}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+dnl Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+dnl Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+])dnl AC_INIT_PARSE_ARGS
+
+AC_INIT(src/lisp.h)dnl
+AC_CONFIG_HEADER(src/config.h lwlib/config.h)
+dnl Remove any more than one leading "." element from the path name.
+dnl If we do not remove them, then another "./" will be prepended to
+dnl the file name each time we use config.status, and the program name
+dnl will get larger and larger. This would not be a problem, except
+dnl that since progname gets recorded in all the Makefiles this script
+dnl produces, move-if-change thinks they're different when they're
+dnl not.
+dnl
+dnl It would be nice if we could put the ./ in a \( \) group and then
+dnl apply the * operator to that, so we remove as many leading './././'s
+dnl as are present, but some seds (like Ultrix's sed) don't allow you to
+dnl apply * to a \( \) group. Bleah.
+progname="`echo $0 | sed 's:^\./\./:\./:'`"
+
+dnl -----------------------------
+dnl Establish some default values
+dnl -----------------------------
+
+XE_APPEND(lib-src, MAKE_SUBDIR)
+XE_APPEND(lib-src, INSTALL_ARCH_DEP_SUBDIR)
+
+dnl run_in_place='no'
+prefix='/usr/local'
+exec_prefix='${prefix}'
+bindir='${exec_prefix}/bin'
+dnl FSF 19.29 changes to:
+dnl datadir='${prefix}/share'
+dnl sharedstatedir='${prefix}/com'
+dnl libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/lib'
+statedir='${prefix}/lib'
+libdir='${exec_prefix}/lib'
+mandir='${prefix}/man/man1'
+infodir='${datadir}/${PROGNAME}-${version}/info'
+infopath=''
+install_pp=''
+lispdir='${datadir}/${PROGNAME}-${version}/lisp'
+dnl sitelispdir='${datadir}/xemacs/site-lisp'
+pkgdir='${datadir}/${PROGNAME}-${version}/lisp'
+package_path=''
+etcdir='${datadir}/${PROGNAME}-${version}/etc'
+lockdir='${statedir}/${PROGNAME}/lock'
+archlibdir='${libdir}/${PROGNAME}-${version}/${configuration}'
+with_site_lisp='no'
+with_menubars=''
+with_scrollbars=''
+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=''
+with_msw=''
+rel_alloc='default'
+with_system_malloc='default'
+with_dlmalloc='default'
+native_sound_lib=''
+dnl use_assertions should be 'yes' by default. Too many people in this
+dnl world have core dumps turned off by default or \"cannot find where the
+dnl core file went\". At least we should get some useful output ...
+use_assertions="yes"
+dnl the following is set to yes or no later.
+with_toolbars=""
+with_tty=""
+use_union_type="no"
+with_dnet=""
+
+dnl ------------------
+dnl Options Processing
+dnl ------------------
+
+define([USAGE_ERROR],
+[(echo "$progname: Usage error:"
+echo " " $1
+echo " Use \`$progname --help' to show usage.") >&2 && exit 1])
+
+dnl Record all the arguments, so we can save them in config.status.
+arguments="$@"
+
+dnl Shell Magic: Quote the quoted arguments in ARGUMENTS. At a later date,
+dnl in order to get the arguments back in $@, we have to do an
+dnl 'eval set x "$quoted_arguments"; shift'
+dnl # We use sed to turn embedded ' into '"'"'. I truly hate sh quoting.
+quoted_sed_magic=s/"'"/"'"'"'"'"'"'"'"/g
+quoted_arguments=
+for i in "$@"; do
+ case "$i" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *)
+ quoted_i="`echo '' $i | sed -e 's:^ ::' -e $quoted_sed_magic`"
+ quoted_arguments="$quoted_arguments '$quoted_i'" ;;
+ esac
+done
+
+dnl Do not use shift -- that destroys the argument list, which autoconf needs
+dnl to produce config.status. It turns out that "set - $arguments" does not
+dnl work portably.
+dnl However, it also turns out that many shells cannot expand ${10} at all.
+dnl So using an index variable does not work either. It is possible to use
+dnl some shell magic to make 'set x "$arguments"; shift' work portably.
+while test $# != 0; do
+ arg="$1"; shift
+ case "$arg" in
+ --no-create|--no-recursion) ;;
+ dnl Anything starting with a hyphen we assume is an option.
+ -* )
+ dnl Separate the switch name from the value it is being given.
+ case "$arg" in
+ -*=*)
+ opt=`echo '' $arg | sed -e 's:^ ::' -e 's:^-*\([[^=]]*\)=.*$:\1:'`
+ val=`echo '' $arg | sed -e 's:^ ::' -e 's:^-*[[^=]]*=\(.*\)$:\1:'`
+ valomitted=no
+ ;;
+ dnl special case these strings since echo may silently eat them:
+ dnl --help ) opt=help val=yes valomitted=yes ;;
+ dnl --version ) opt=version val=yes valomitted=yes ;;
+ dnl -e ) opt=e val=yes valomitted=yes ;;
+ dnl -E ) opt=E val=yes valomitted=yes ;;
+ dnl -n ) opt=n val=yes valomitted=yes ;;
+ -*)
+ dnl If FOO is a boolean argument, --FOO is equivalent to
+ dnl --FOO=yes. Otherwise, the value comes from the next
+ dnl argument - see below.
+ opt=`echo '' $arg | sed -e 's:^ ::' -e 's:^-*\(.*\)$:\1:'`
+ val="yes" valomitted=yes
+ ;;
+ esac
+
+ dnl translate "-" in option string to "_"
+ optname="$opt"
+ opt="`echo '' $opt | sed -e 's:^ ::' | tr - _`"
+
+ dnl Support --without-FOO as a synonym for --with-FOO=no
+ case "${valomitted}-${opt}" in yes-without_* )
+ opt=`echo $opt | sed 's/without/with/'`
+ valomitted="no" val="no" ;;
+ esac
+
+ dnl Process the option.
+ case "$opt" in
+
+ dnl Process (many) boolean options
+ run_in_place | \
+ with_site_lisp | \
+ with_x | \
+ with_x11 | \
+ with_msw | \
+ with_gcc | \
+ with_gnu_make | \
+ dynamic | \
+ with_ncurses | \
+ with_dnet | \
+ with_socks | \
+ with_dragndrop | \
+ with_cde | \
+ with_offix | \
+ with_gpm | \
+ with_xpm | \
+ with_xface | \
+ with_gif | \
+ with_jpeg | \
+ with_png | \
+ with_tiff | \
+ with_session | \
+ with_xmu | \
+ with_quantify | \
+ with_toolbars | \
+ with_tty | \
+ with_xfs | \
+ with_i18n3 | \
+ with_mule | \
+ with_file_coding | \
+ with_canna | \
+ with_wnn | \
+ with_wnn6 | \
+ with_workshop | \
+ with_sparcworks | \
+ with_tooltalk | \
+ with_ldap | \
+ with_pop | \
+ with_kerberos | \
+ with_hesiod | \
+ with_dnet | \
+ with_infodock | \
+ external_widget | \
+ verbose | \
+ extra_verbose | \
+ const_is_losing | \
+ usage_tracking | \
+ use_union_type | \
+ debug | \
+ use_assertions | \
+ use_minimal_tagbits | \
+ use_indexed_lrecord_implementation | \
+ gung_ho | \
+ use_assertions | \
+ memory_usage_stats | \
+ with_clash_detection | \
+ with_shlib | \
+ no_doc_file )
+ dnl Make sure the value given was either "yes" or "no".
+ case "$val" in
+ y | ye | yes ) val=yes ;;
+ n | no ) val=no ;;
+ * ) USAGE_ERROR("The \`--$optname' option requires a boolean value: \`yes' or \`no'.") ;;
+ esac
+ eval "$opt=\"$val\"" ;;
+
+
+ dnl Options that take a user-supplied value, as in --puresize=8000000
+ dnl The cache-file option is ignored (for compatibility with other configures)
+ srcdir | \
+ compiler | \
+ cflags | \
+ cpp | \
+ cppflags | \
+ libs | \
+ ldflags | \
+ puresize | \
+ cache_file | \
+ native_sound_lib | \
+ site_lisp | \
+ x_includes | \
+ x_libraries | \
+ site_includes | \
+ site_libraries | \
+ site_prefixes | \
+ site_runtime_libraries )
+ dnl If the value was omitted, get it from the next argument.
+ if test "$valomitted" = "yes" ; then
+ dnl Get the next argument from the argument list, if there is one.
+ if test "$#" = 0 ; then
+ USAGE_ERROR("The \`--$optname' option requires a value.");
+ fi
+ val="$1"; shift
+ fi
+ eval "$opt=\"$val\""
+ ;;
+
+ dnl Options that take "yes", "no", or "default" values
+ rel_alloc | \
+ with_dlmalloc | \
+ with_debug_malloc | use_debug_malloc | \
+ with_system_malloc | use_system_malloc )
+ case "$val" in
+ y | ye | yes ) val=yes ;;
+ n | no ) val=no ;;
+ d | de | def | defa | defau | defaul | default ) val=default ;;
+ * ) USAGE_ERROR(["The \`--$optname' option requires one of these values:
+ \`yes', \`no', or \`default'."]) ;;
+ esac
+ case "$opt" in use_* ) opt="`echo $opt | sed s/use/with/`" ;; esac
+ eval "$opt=\"$val\""
+ ;;
+
+ dnl Has the user requested database support?
+ "with_database" )
+ with_database_berkdb=no
+ with_database_dbm=no
+ with_database_gnudbm=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
+ must be either \`no' or a comma-separated list
+ of one or more of \`berkdb', \`dbm', or \`gnudbm'."]) ;;
+ esac
+ done
+ if test "$with_database_dbm" = "yes" -a \
+ "$with_database_gnudbm" = "yes"; then
+ USAGE_ERROR("Only one of \`dbm' and \`gnudbm' may be specified
+ with the \`--$optname' option.")
+ fi
+ ;;
+
+ 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
+ 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;;
+ * ) USAGE_ERROR(["The \`--$optname' option must have one of these values:
+ \`native', \`nas', \`both', or \`none'."]) ;;
+ esac
+ eval "$opt=\"$val\""
+ ;;
+
+ dnl Has the user requested XIM support?
+ "with_xim" )
+ case "$val" in
+ y | ye | yes ) val=yes ;;
+ n | no | non | none ) val=no ;;
+ x | xl | xli | xlib ) val=xlib ;;
+ m | mo | mot | moti | motif ) val=motif ;;
+ * ) USAGE_ERROR(["The \`--$optname' option must have one of these values:
+ \`motif', \`xlib', \`yes', or \`no'."]) ;;
+ esac
+ eval "$opt=\"$val\""
+ ;;
+
+ dnl XFontSet support?
+ "with_xfs" )
+ case "$val" in
+ y | ye | yes ) val=yes ;;
+ n | no | non | none ) val=no ;;
+ * ) USAGE_ERROR(["The \`--$optname' option must have one of these values:
+ \`yes', or \`no'."]) ;;
+ esac
+ eval "$opt=\"$val\""
+ ;;
+
+ dnl Mail locking specification
+ "mail_locking" )
+ case "$val" in
+ lockf ) val=lockf ;;
+ flock ) val=flock ;;
+ file ) val=file ;;
+ * ) USAGE_ERROR(["The \`--$optname' option must have one of these values:
+ \`lockf', \`flock', or \`file'."]) ;;
+ esac
+ eval "$opt=\"$val\""
+ ;;
+
+ dnl Has the user requested error-checking?
+ "error_checking" )
+ dnl value can be all, none, and/or a list of categories to check.
+ dnl Example: --error-checking=all,noextents,nobufpos
+ dnl Example: --error-checking=none,malloc,gc
+
+ 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_default=no ;;
+ a | al | all ) new_default=yes ;;
+
+ extents ) error_check_extents=yes ;;
+ noextents ) error_check_extents=no ;;
+
+ typecheck ) error_check_typecheck=yes ;;
+ notypecheck ) error_check_typecheck=no ;;
+
+ bufpos ) error_check_bufpos=yes ;;
+ nobufpos ) error_check_bufpos=no ;;
+
+ gc ) error_check_gc=yes ;;
+ nogc ) error_check_gc=no ;;
+
+ malloc ) error_check_malloc=yes ;;
+ nomalloc ) error_check_malloc=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'."
+ else
+ types="\`all', \`none' (default), \`extents', \`typecheck', \`bufpos', \`gc', and \`malloc'."
+ fi
+ USAGE_ERROR(["Valid types for the \`--$optname' option are:
+ $types."])
+ elif test -n "$new_default" ; then
+ error_check_extents=$new_default
+ error_check_typecheck=$new_default
+ error_check_bufpos=$new_default
+ error_check_gc=$new_default
+ error_check_malloc=$new_default
+ new_default= # reset this
+ fi
+ echeck_notfirst=true
+ done
+ ;;
+
+ dnl Has the user tried to tell us where the X files are?
+ dnl I think these are dopey, but no less than three alpha
+ dnl testers, at large sites, have said they have their X files
+ dnl installed in odd places.
+
+ dnl Has the user specified one of the path options?
+ prefix | exec_prefix | bindir | datadir | statedir | libdir | \
+ mandir | infodir | infopath | lispdir | etcdir | lockdir | pkgdir | \
+ archlibdir | docdir | package_path )
+ dnl If the value was omitted, get it from the next argument.
+ if test "$valomitted" = "yes"; then
+ if test "$#" = 0; then
+ USAGE_ERROR("The \`--$optname' option requires a value.");
+ fi
+ val="$1"; shift
+ fi
+ eval "$opt=\"$val\""
+
+ dnl You need to synchronize this with the way the
+ dnl default values are built.
+ case "$opt" in
+ lispdir ) AC_DEFINE(LISPDIR_USER_DEFINED) ;;
+dnl sitelispdir ) AC_DEFINE(SITELISPDIR_USER_DEFINED) ;;
+ etcdir ) AC_DEFINE(ETCDIR_USER_DEFINED) ;;
+ infodir ) AC_DEFINE(INFODIR_USER_DEFINED) ;;
+ infopath ) AC_DEFINE(INFOPATH_USER_DEFINED) ;;
+ package_path ) AC_DEFINE(PACKAGE_PATH_USER_DEFINED) ;;
+ datadir )
+ AC_DEFINE(INFODIR_USER_DEFINED)
+ AC_DEFINE(LISPDIR_USER_DEFINED)
+ AC_DEFINE(ETCDIR_USER_DEFINED) ;;
+ statedir | lockdir ) AC_DEFINE(LOCKDIR_USER_DEFINED) ;;
+ exec_prefix | libdir | archlibdir ) AC_DEFINE(ARCHLIBDIR_USER_DEFINED) ;;
+ esac
+ ;;
+
+ dnl --no-create added by autoconf for use by config.status
+ "no_create" ) ;;
+
+ dnl Has the user asked for some help?
+ "usage" | "help" ) ${PAGER-more} ${srcdir}/configure.usage; exit 0 ;;
+
+ dnl Has the user specified what toolkit to use for the menubars,
+ dnl scrollbar or dialogs?
+ "with_menubars" | "with_scrollbars" | "with_dialogs" )
+ 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'."]) ;;
+ esac
+ eval "$opt=\"$val\""
+ ;;
+
+ dnl Fail on unrecognized arguments.
+ * ) USAGE_ERROR("Unrecognized option: $arg") ;;
+
+ esac
+ ;;
+
+ dnl Assume anything with multiple hyphens is a configuration name.
+ *-*-*) configuration="$arg" ;;
+
+ dnl Anything else is an error
+ *) USAGE_ERROR("Unrecognized argument: $arg") ;;
+
+ esac
+done
+
+dnl -------------------------
+dnl Finish options processing
+dnl -------------------------
+
+dnl Several options are equivalent to, and override, environment variables.
+test -n "$cpp" && CPP="$cpp"
+test -n "$cppflags" && CPPFLAGS="$cppflags"
+test -n "$libs" && LIBS="$libs"
+test -n "$ldflags" && LDFLAGS="$ldflags"
+
+dnl Get the arguments back. See the diatribe on Shell Magic above.
+eval set x "$quoted_arguments"; shift
+
+dnl --extra-verbose implies --verbose
+test "$extra_verbose" = "yes" && verbose=yes
+
+dnl Allow use of either ":" or spaces for lists of directories
+define(COLON_TO_SPACE,
+ [case "$[$1]" in *:* [)] [$1]="`echo '' $[$1] | sed -e 's/^ //' -e 's/:/ /g'`";; esac])dnl
+COLON_TO_SPACE(site_includes)
+COLON_TO_SPACE(site_libraries)
+COLON_TO_SPACE(site_prefixes)
+COLON_TO_SPACE(site_runtime_libraries)
+
+dnl with_x is an obsolete synonym for with_x11
+test -n "$with_x" && with_x11="$with_x"
+
+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
+ USAGE_ERROR("--with-$1 requires --with-$2")
+elif test "$with_$2" = "no" ; then with_$1=no
+elif test "$with_$1" = "yes"; then with_$2=yes
+fi
+])
+
+dnl CDE requires tooltalk
+XE_CHECK_FEATURE_DEPENDENCY(cde, tooltalk)
+
+dnl Ignore useless run-in-place flag
+if test "$run_in_place" = "yes"; then
+ AC_MSG_WARN("The --run-in-place option is ignored because it is unnecessary.")
+fi
+
+dnl Find the source directory.
+case "$srcdir" in
+
+ dnl If srcdir is not specified, see if "." or ".." might work.
+ "" )
+ for dir in "`echo $0 | sed 's|//|/|' | sed 's|/[[^/]]*$||'`" "." ".." ; do
+ if test -f "$dir/src/lisp.h" -a \
+ -f "$dir/lisp/version.el" ; then
+ srcdir="$dir"
+ break
+ fi
+ done
+ if test -z "$srcdir" ; then
+ USAGE_ERROR(["Neither the current directory nor its parent seem to
+ contain the XEmacs sources. If you do not want to build XEmacs in its
+ source tree, you should run \`$progname' in the directory in which
+ you wish to build XEmacs, using the \`--srcdir' option to say where the
+ sources may be found."])
+ fi
+ ;;
+
+ dnl Otherwise, check if the directory they specified is okay.
+ * )
+ if test ! -f "$srcdir/src/lisp.h" -o \
+ ! -f "$srcdir/lisp/version.el" ; then
+ USAGE_ERROR(["The directory specified with the \`--srcdir' option,
+ \`$srcdir', doesn't seem to contain the XEmacs sources. You should
+ either run the \`$progname' script at the top of the XEmacs source
+ tree, or use the \`--srcdir' option to specify the XEmacs source directory."])
+ fi
+ ;;
+esac
+
+dnl ###########################################################################
+if test -z "$configuration"; then
+ AC_MSG_CHECKING("host system type")
+ dnl Guess the configuration and remove 4th name component, if present.
+ if configuration=`${CONFIG_SHELL-/bin/sh} $srcdir/config.guess | \
+ sed '[s/^\([^-][^-]*-[^-][^-]*-[^-][^-]*\)-.*$/\1/]'` ; then
+ AC_MSG_RESULT($configuration)
+ else
+ AC_MSG_RESULT(unknown)
+ USAGE_ERROR(["XEmacs has not been ported to this host type.
+Try explicitly specifying the CONFIGURATION when rerunning configure."])
+ fi
+fi
+
+AC_PROG_LN_S
+
+dnl Make symlinks for etc, lisp, and info directories while the path
+dnl is still relative. We do not symlink lock because someone may
+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
+ if test ! -d "$dir" ; then
+ echo Making symbolic link to "$srcdir/$dir"
+ ${LN_S} "$srcdir/$dir" "$dir"
+ fi
+done
+
+dnl Calculate canonical name for blddir (i.e. current directory).
+dnl PWD may already be the preferable absolute name for ".",
+dnl but we can't trust it - it is sometimes inaccurate.
+absolute_pwd="`pwd`";
+if test -n "$PWD" -a "`cd $PWD && pwd`" = "$absolute_pwd"
+then blddir="$PWD"
+else blddir="$absolute_pwd"
+fi
+AC_SUBST(blddir)
+
+dnl Make srcdir absolute, if not already. It is important to
+dnl avoid running the path through pwd unnecessary, since pwd can
+dnl give you automounter prefixes, which can go away.
+case "$srcdir" in
+ /* ) ;;
+ . ) srcdir="$blddir" ;;
+ * ) srcdir="`cd $srcdir && pwd`" ;;
+esac
+
+dnl Check if the source directory already has a configured system in it.
+if test `pwd` != `sh -c cd $srcdir && pwd` \
+ && test -f "$srcdir/src/config.h"; then
+ (echo "$progname: WARNING: The directory tree \`$srcdir' is being used"
+ echo " as a build directory right now; it has been configured in its own"
+ echo " right. To configure in another directory as well, you MUST"
+ echo " use GNU make. If you do not have GNU make, then you must"
+ echo " now do \`make distclean' in $srcdir,"
+ echo " and then run $progname again.") >&2
+ extrasub='/^VPATH[[ ]]*=/c\
+vpath %.c $(srcdir)\
+vpath %.h $(srcdir)\
+vpath %.y $(srcdir)\
+vpath %.l $(srcdir)\
+vpath %.s $(srcdir)\
+vpath %.in $(srcdir)'
+fi
+
+dnl ----------------------------------------
+dnl Find out which version of XEmacs this is
+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
+: "${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)
+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
+ echo "Cannot build InfoDock without InfoDock sources"
+ with_infodock=no
+ fi
+fi
+
+if test "$with_infodock" = "yes"; then
+ dnl InfoDock version numbers. XEmacs will use the same style of numbering
+ dnl after the release of XEmacs 21.0.
+ AC_DEFINE_UNQUOTED(INFODOCK_MAJOR_VERSION, $infodock_major_version)
+ AC_DEFINE_UNQUOTED(INFODOCK_MINOR_VERSION, $infodock_minor_version)
+ AC_DEFINE_UNQUOTED(INFODOCK_BUILD_VERSION, $infodock_build_version)
+ version=${infodock_major_version}.${infodock_minor_version}.${infodock_build_version}
+ PROGNAME=infodock
+ CPPFLAGS="$CPPFLAGS -DINFODOCK"
+else
+ PROGNAME=xemacs
+fi
+
+dnl ----------------------------------
+dnl Error checking and debugging flags
+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
+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)
+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)
+ AC_DEFINE(DEBUG_XEMACS)
+fi
+test "$use_assertions" = "yes" && AC_DEFINE(USE_ASSERTIONS)
+test "$memory_usage_stats" = "yes" && AC_DEFINE(MEMORY_USAGE_STATS)
+
+dnl ------------------------------
+dnl Determine the s&m files to use
+dnl ------------------------------
+dnl Given the configuration name, set machfile and opsysfile to the
+dnl names of the m/*.h and s/*.h files we should use.
+
+dnl Canonicalize the configuration name.
+AC_CHECKING("the configuration name")
+dnl allow -workshop suffix on configuration name
+internal_configuration=`echo $configuration | sed 's/-\(workshop\)//'`
+if canonical=`$srcdir/config.sub "$internal_configuration"` ; then : ; else
+ exit $?
+fi
+
+dnl If you add support for a new configuration, add code to this
+dnl switch statement to recognize your configuration name and select
+dnl the appropriate operating system and machine description files.
+
+dnl You would hope that you could choose an m/*.h file pretty much
+dnl based on the machine portion of the configuration name, and an s-
+dnl file based on the operating system portion. However, it turns out
+dnl that each m/*.h file is pretty manufacturer-specific - for
+dnl example, apollo.h, hp9000s300.h, mega68k, news.h, and tad68k are
+dnl all 68000 machines; mips.h, pmax.h, and news-risc are all MIPS
+dnl machines. So we basically have to have a special case for each
+dnl configuration name.
+
+dnl As far as handling version numbers on operating systems is
+dnl concerned, make sure things will fail in a fixable way. If
+dnl /etc/MACHINES says nothing about version numbers, be
+dnl prepared to handle anything reasonably. If version numbers
+dnl matter, be sure /etc/MACHINES says something about it.
+
+dnl Eric Raymond says we should accept strings like "sysvr4" to mean
+dnl "System V Release 4"; he writes, "The old convention encouraged"
+dnl "confusion between `system' and `release' levels'."
+
+machine='' opsys=''
+
+dnl Straightforward machine determination
+case "$canonical" in
+ sparc-*-* ) machine=sparc ;;
+ alpha-*-* ) machine=alpha ;;
+ vax-*-* ) machine=vax ;;
+ mips-dec-* ) machine=pmax ;;
+ mips-sgi-* ) machine=iris4d ;;
+ romp-ibm-* ) machine=ibmrt ;;
+ rs6000-ibm-aix* ) machine=ibmrs6000 ;;
+ powerpc-ibm-aix* ) machine=ibmrs6000 ;;
+ powerpc*-* ) machine=powerpc ;;
+ hppa-*-* ) machine=hp800 ;;
+ m88k-dg-* ) machine=aviion ;;
+ m68*-sony-* ) machine=news ;;
+ mips-sony-* ) machine=news-risc ;;
+ clipper-* ) machine=clipper ;;
+esac
+
+dnl Straightforward OS determination
+case "$canonical" in
+ *-*-linux* ) opsys=linux ;;
+ *-*-netbsd* ) opsys=netbsd ;;
+ *-*-openbsd* ) opsys=openbsd ;;
+ *-*-nextstep* ) opsys=nextstep ;;
+ *-*-vms ) opsys=vms ;;
+
+ dnl DEC OSF
+ *-dec-osf1.3 | *-dec-osf2* ) opsys=decosf1-3 ;;
+ *-dec-osf1.2 | *-dec-osf1* ) opsys=decosf1-2 ;;
+ *-dec-osf3.[[2-9]] ) opsys=decosf3-2 ;;
+ *-dec-osf3* ) opsys=decosf3-1 ;;
+ *-dec-osf4* ) opsys=decosf4-0 ;;
+
+ dnl DEC Ultrix
+ *-*-ultrix[[0-3]].* | *-*-ultrix4.0* ) opsys=bsd4-2 ;;
+ *-*-ultrix4.[[12]]* ) opsys=bsd4-3 ;;
+ *-*-ultrix* ) opsys=ultrix4-3 ;;
+
+ dnl AIX
+ *-*-aix3.1* ) opsys=aix3-1 ;;
+ *-*-aix3.2.5 ) opsys=aix3-2-5 ;;
+ *-*-aix3* ) opsys=aix3-2 ;;
+ *-*-aix4.2* ) opsys=aix4-2 ;;
+ *-*-aix4.1* ) opsys=aix4-1 ;;
+ *-*-aix4* ) opsys=aix4 ;;
+
+ dnl Other generic OSes
+ *-gnu* ) opsys=gnu ;;
+ *-*-bsd4.[[01]] ) opsys=bsd4-1 ;;
+ *-*-bsd4.2 ) opsys=bsd4-2 ;;
+ *-*-bsd4.3 ) opsys=bsd4-3 ;;
+ *-*-aos4.2 ) opsys=bsd4-2 ;;
+ *-*-aos* ) opsys=bsd4-3 ;;
+ *-*-sysv0 | *-*-sysvr0 ) opsys=usg5-0 ;;
+ *-*-sysv2 | *-*-sysvr2 ) opsys=usg5-2 ;;
+ *-*-sysv2.2 | *-*-sysvr2.2 ) opsys=usg5-2-2 ;;
+ *-*-sysv3* | *-*-sysvr3* ) opsys=usg5-3 ;;
+ *-*-sysv4.1* | *-*-sysvr4.1* )opsys=usg5-4 NON_GNU_CPP=/usr/lib/cpp ;;
+ *-*-sysv4.[[2-9]]* | *-sysvr4.[[2-9]]* )
+ if test -z "$NON_GNU_CPP" ; then
+ for prog in "/usr/ccs/lib/cpp" "/lib/cpp"; do
+ if test -f "$prog"; then NON_GNU_CPP="$prog"; break; fi
+ done
+ fi
+ opsys=usg5-4-2 ;;
+ *-sysv4* | *-sysvr4* ) opsys=usg5-4 ;;
+ *-*-mach_bsd4.3* ) opsys=mach-bsd4-3 ;;
+esac
+
+case "$canonical" in
+
+ dnl NetBSD ports
+ *-*-netbsd* )
+ case "$canonical" in
+ i[[3-9]]86-*-netbsd*) machine=intel386 ;;
+ hp300-*-netbsd* | amiga-*-netbsd* | sun3-*-netbsd* | mac68k-*-netbsd* | da30-*-netbsd* | m68k-*-netbsd* )
+ dnl Yes, this is somewhat bogus.
+ machine=hp9000s300 ;;
+ pc532-*-netbsd* | ns32k-*-netbsd* ) machine=ns32000 ;;
+ pmax-*-netbsd* | mips-*-netbsd* ) machine=pmax ;;
+ esac
+ ;;
+
+ dnl OpenBSD ports
+ *-*-openbsd* )
+ case "${canonical}" in
+ alpha*-*-openbsd*) machine=alpha ;;
+ i386-*-openbsd*) machine=intel386 ;;
+ m68k-*-openbsd*) machine=hp9000s300 ;;
+ mipsel-*-openbsd*) machine=pmax ;;
+ ns32k-*-openbsd*) machine=ns32000 ;;
+ sparc-*-openbsd*) machine=sparc ;;
+ vax-*-openbsd*) machine=vax ;;
+ esac
+ ;;
+
+ dnl Acorn RISCiX:
+ arm-acorn-riscix1.1* ) machine=acorn opsys=riscix1-1 ;;
+ arm-acorn-riscix1.2* | arm-acorn-riscix ) machine=acorn opsys=riscix1-2 ;;
+
+ dnl Alliant machines
+ fx80-alliant-* ) machine=alliant4 opsys=bsd4-2 ;;
+ i860-alliant-* ) machine=alliant-2800 opsys=bsd4-3 ;;
+
+ dnl Altos 3068
+ m68*-altos-sysv* ) machine=altos opsys=usg5-2 ;;
+
+ dnl Amdahl UTS
+ 580-amdahl-sysv* ) machine=amdahl opsys=usg5-2-2 ;;
+
+ dnl Apollo, Domain/OS
+ m68*-apollo-* ) machine=apollo opsys=bsd4-3 ;;
+
+ dnl AT&T 3b2, 3b5, 3b15, 3b20
+ we32k-att-sysv* ) machine=att3b opsys=usg5-2-2 ;;
+
+ dnl AT&T 3b1 - The Mighty Unix PC!
+ m68*-att-sysv* ) machine=7300 opsys=usg5-2-2 ;;
+
+ dnl Bull machines
+ rs6000-bull-bosx* ) machine=ibmrs6000 opsys=aix3-2 ;; # dpx20
+ m68*-bull-sysv3* ) machine=dpx2 opsys=usg5-3 ;; # dpx2
+ m68*-bull-sysv2* ) machine=sps7 opsys=usg5-2 ;; # sps7
+
+ dnl CCI 5/32, 6/32 -- see "Tahoe".
+
+ dnl Celerity
+ celerity-celerity-bsd* ) machine=celerity opsys=bsd4-2 ;;
+
+ dnl Convex
+ *-convex-bsd* | *-convex-convexos* )
+ machine=convex opsys=bsd4-3
+ NON_GNU_CPP="cc -E -P"
+ ;;
+
+ dnl Cubix QBx/386
+ i[[3-9]]86-cubix-sysv* ) machine=intel386 opsys=usg5-3 ;;
+
+ dnl Data General AViiON Machines
+ i586-dg-dgux*R4* | i586-dg-dgux5.4.4* ) machine=aviion opsys=dgux5-4r4 ;;
+ m88k-dg-dgux5.4R3* | m88k-dg-dgux5.4.3* ) opsys=dgux5-4r3 ;;
+ m88k-dg-dgux5.4R2* | m88k-dg-dgux5.4.2* ) opsys=dgux5-4r2 ;;
+ m88k-dg-dgux* ) opsys=dgux ;;
+
+ dnl Motorola Delta machines
+ m68k-motorola-sysv* | m68000-motorola-sysv* ) machine=delta opsys=usg5-3 ;;
+ m88k-motorola-sysv4* )
+ dnl jbotte@bnr.ca says that UNIX_System_V <hostName> 4.0 R40V4.3 m88k mc88110
+ dnl needs POSIX_SIGNALS and therefore needs usg5-4-2.
+ dnl I hope there are not other 4.0 versions for this machine
+ dnl which really need usg5-4 instead.
+ machine=delta88k opsys=usg5-4-2
+ ;;
+ m88k-motorola-sysv* | m88k-motorola-m88kbcs* ) machine=delta88k opsys=usg5-3 ;;
+
+ dnl Dual machines
+ m68*-dual-sysv* ) machine=dual opsys=usg5-2 ;;
+ m68*-dual-uniplus* ) machine=dual opsys=unipl5-2 ;;
+
+ dnl Encore machines
+ ns16k-encore-bsd* ) machine=ns16000 opsys=umax ;;
+
+ dnl Gould Power Node and NP1
+ pn-gould-bsd4.2* ) machine=gould opsys=bsd4-2 ;;
+ pn-gould-bsd4.3* ) machine=gould opsys=bsd4-3 ;;
+ np1-gould-bsd* ) machine=gould-np1 opsys=bsd4-3 ;;
+
+ dnl Harris Night Hawk machines running CX/UX (a 5000 looks just like a 4000
+ dnl as far as XEmacs is concerned).
+ m88k-harris-cxux* )
+ dnl Build needs to be different on 7.0 and later releases
+ case "`uname -r`" in
+ [[56]].[[0-9]] ) machine=nh4000 opsys=cxux ;;
+ [[7]].[[0-9]] ) machine=nh4000 opsys=cxux7 ;;
+ esac
+ NON_GNU_CPP="/lib/cpp"
+ ;;
+ dnl Harris ecx or gcx running CX/UX (Series 1200, Series 3000)
+ m68k-harris-cxux* ) machine=nh3000 opsys=cxux ;;
+ dnl Harris power pc NightHawk running Power UNIX (Series 6000)
+ powerpc-harris-powerunix ) machine=nh6000 opsys=powerunix NON_GNU_CPP="cc -Xo -E -P" ;;
+
+ dnl Honeywell XPS100
+ xps*-honeywell-sysv* ) machine=xps100 opsys=usg5-2 ;;
+
+ dnl HP 9000 series 200 or 300
+ m68*-hp-bsd* ) machine=hp9000s300 opsys=bsd4-3 ;;
+
+ dnl HP-UX
+ *-hp-hpux* )
+ dnl Figure out machine and opsys orthogonally
+ case "$canonical" in
+ m68* ) machine=hp9000s300 ;;
+ hppa* ) machine=hp800 ;;
+ esac
+
+ case "$canonical" in
+ *-hp-hpux7* ) opsys=hpux ;;
+ *-hp-hpux8* ) opsys=hpux8 ;;
+ *-hp-hpux9* ) opsys=hpux9 ;;
+ *-hp-hpux10* ) opsys=hpux10 ;;
+ *-hp-hpux11* ) opsys=hpux11 ;;
+ * ) opsys=hpux ;;
+ esac
+
+ dnl HP has a broken "strcat"
+ case "$opsys" in hpux9 | hpux10 ) XE_ADD_OBJS(strcat.o) ;; esac
+
+ if test "$opsys" = "hpux10" -o "$opsys" = "hpux11"; then \
+ ansi_flag="-Ae"; else ansi_flag="-Aa"; fi
+ NON_GNU_CC="cc $ansi_flag" NON_GNU_CPP="cc $ansi_flag -E"
+
+ case "$canonical" in *-hp-hpux*shr* ) opsys="${opsys}-shr" ;; esac
+ ;;
+
+ dnl Orion machines
+ orion-orion-bsd* ) machine=orion opsys=bsd4-2 ;;
+ clipper-orion-bsd* ) machine=orion105 opsys=bsd4-2 ;;
+
+ dnl IBM machines
+ i[[3-9]]86-ibm-aix1.1* ) machine=ibmps2-aix opsys=usg5-2-2 ;;
+ i[[3-9]]86-ibm-aix1.[[23]]* | i[[3-9]]86-ibm-aix* ) machine=ibmps2-aix opsys=usg5-3 ;;
+ i370-ibm-aix*) machine=ibm370aix opsys=usg5-3 ;;
+ romp-ibm-aos* ) opsys=bsd4-3 ;;
+ romp-ibm-bsd* ) opsys=bsd4-3 ;;
+ romp-ibm-mach* ) opsys=mach-bsd4-3 ;;
+
+ dnl Integrated Solutions "Optimum V"
+ m68*-isi-bsd4.2* ) machine=isi-ov opsys=bsd4-2 ;;
+ m68*-isi-bsd4.3* ) machine=isi-ov opsys=bsd4-3 ;;
+
+ dnl Intel 386 machines where we do care about the manufacturer
+ i[[3-9]]86-intsys-sysv* ) machine=is386 opsys=usg5-2-2 ;;
+
+ dnl Prime EXL
+ i[[3-9]]86-prime-sysv* ) machine=i386 opsys=usg5-3 ;;
+
+ dnl Sequent Symmetry running Dynix
+ i[[3-9]]86-sequent-bsd* ) machine=symmetry opsys=bsd4-3 ;;
+
+ dnl Sequent Symmetry running DYNIX/ptx
+ i[[3-9]]86-sequent-ptx* ) machine=sequent-ptx opsys=ptx NON_GNU_CPP="/lib/cpp" ;;
+
+ dnl Unspecified sysv on an ncr machine defaults to svr4.2.
+ dnl (Plain usg5-4 does not turn on POSIX signals, which we need.)
+ i[[3-9]]86-ncr-sysv* ) machine=ncr386 opsys=usg5-4-2 ;;
+
+ dnl Intel Paragon OSF/1
+ i860-intel-osf1* ) machine=paragon opsys=osf1 NON_GNU_CPP=/usr/mach/lib/cpp ;;
+
+ dnl Intel 860
+ i860-*-sysv4* ) machine=i860 opsys=usg5-4 NON_GNU_CC="/bin/cc" NON_GNU_CPP="/usr/ccs/lib/cpp" ;;
+
+ dnl Masscomp machines
+ m68*-masscomp-rtu* ) machine=masscomp opsys=rtu ;;
+
+ dnl Megatest machines
+ m68*-megatest-bsd* ) machine=mega68 opsys=bsd4-2 ;;
+
+ dnl Workstations sold by MIPS
+ dnl This is not necessarily all workstations using the MIPS processor -
+ dnl Irises are produced by SGI, and DECstations by DEC.
+ mips-mips-usg* ) machine=mips4 ;;
+ mips-mips-riscos4 )
+ machine=mips4
+ NON_GNU_CC="cc -systype bsd43"
+ NON_GNU_CPP="cc -systype bsd43 -E"
+ case "$canonical" in
+ mips-mips-riscos4* ) opsys=bsd4-3 ;;
+ mips-mips-riscos5* ) opsys=riscos5 ;;
+ esac
+ ;;
+ mips-mips-bsd* ) machine=mips opsys=bsd4-3 ;;
+ mips-mips-* ) machine=mips opsys=usg5-2-2 ;;
+
+ dnl NeXT
+ m68*-next-* | m68k-*-nextstep* ) machine=m68k opsys=nextstep ;;
+
+ dnl The complete machine from National Semiconductor
+ ns32k-ns-genix* ) machine=ns32000 opsys=usg5-2 ;;
+
+ dnl NCR machines
+ m68*-ncr-sysv2* | m68*-ncr-sysvr2* ) machine=tower32 opsys=usg5-2-2 ;;
+ m68*-ncr-sysv3* | m68*-ncr-sysvr3* ) machine=tower32v3 opsys=usg5-3 ;;
+
+ dnl Nixdorf Targon 31
+ m68*-nixdorf-sysv* ) machine=targon31 opsys=usg5-2-2 ;;
+
+ dnl Nu (TI or LMI)
+ m68*-nu-sysv* ) machine=nu opsys=usg5-2 ;;
+
+ dnl Plexus
+ m68*-plexus-sysv* ) machine=plexus opsys=usg5-2 ;;
+
+ dnl Pyramid machines
+ pyramid-pyramid-bsd* ) machine=pyramid opsys=bsd4-2 ;;
+
+ dnl Sequent Balance
+ ns32k-sequent-bsd4.2* ) machine=sequent opsys=bsd4-2 ;;
+ ns32k-sequent-bsd4.3* ) machine=sequent opsys=bsd4-3 ;;
+
+ dnl Siemens Nixdorf
+ mips-siemens-sysv* | mips-sni-sysv*)
+ machine=mips-siemens opsys=usg5-4
+ NON_GNU_CC=/usr/ccs/bin/cc
+ NON_GNU_CPP=/usr/ccs/lib/cpp
+ ;;
+
+ dnl Silicon Graphics machines
+ dnl Iris 2500 and Iris 2500 Turbo (aka the Iris 3030)
+ m68*-sgi-iris3.5* ) machine=irist opsys=iris3-5 ;;
+ m68*-sgi-iris3.6* | m68*-sgi-iris*) machine=irist opsys=iris3-6 ;;
+ dnl Iris 4D
+ mips-sgi-irix3.* ) opsys=irix3-3 ;;
+ mips-sgi-irix4.* ) opsys=irix4-0 ;;
+ mips-sgi-irix6* ) opsys=irix6-0 ;;
+ mips-sgi-irix5.1* ) opsys=irix5-1 ;;
+ mips-sgi-irix5.2* ) opsys=irix5-2 ;;
+ mips-sgi-irix5.* ) opsys=irix5-3 ;;
+ mips-sgi-irix* ) opsys=irix5-0 ;;
+
+ dnl SONY machines
+ *-sony-newsos[[34]]* | *-sony-news[[34]]* ) opsys=bsd4-3 ;;
+ *-sony-news* ) opsys=newsos5 ;;
+
+ dnl Stride
+ m68*-stride-sysv* ) machine=stride opsys=usg5-2 ;;
+
+ dnl Suns
+ *-*-solaris* | *-*-sunos* | *-sun-mach* | *-sun-bsd* )
+ dnl Hardware type
+ case "$canonical" in
+ m68*-sunos1* ) machine=sun1 ;;
+ m68*-sunos2* ) machine=sun2 ;;
+ m68* ) machine=sun3 ;;
+ i*86*-sun-sunos[[34]]* ) machine=sun386 ;;
+ i*86-*-* ) machine=intel386 ;;
+ rs6000* ) machine=rs6000 ;;
+ esac
+
+ dnl Make $canonical even more so.
+ case "$canonical" in *-sunos5*)
+ canonical=`echo $canonical | sed -e s/sunos5/solaris2/`;;
+ esac
+
+ dnl On SunOS 4, use /usr/lib/cpp, sans dynodump, /bin/ranlib
+ dnl On SunOS 5, use cc -E, need dynodump, RANLIB not needed
+ dnl But, SunOS 5.6 no longer needs dynodump because it has a similar
+ dnl function integrated.
+ case "$canonical" in
+ *-sunos4* )
+ #test -f /usr/lib/cpp && NON_GNU_CPP=/usr/lib/cpp ;;
+ : ;;
+ *-solaris2* )
+ #test -f /usr/ccs/lib/cpp && NON_GNU_CPP=/usr/ccs/lib/cpp
+ RANLIB=':' ;;
+ esac
+
+ case "$canonical" in
+ *-solaris* )
+ opsys=sol2
+ os_release=`uname -r | sed -e 's/^\([[0-9]]\)\.\([[0-9]]\).*/\1\2/'`
+ AC_DEFINE_UNQUOTED(OS_RELEASE, $os_release) ;;
+
+ dnl The last Sun386 ran 4.0.
+ i*86-*-sunos4* ) opsys=sunos4-0 ;;
+ *-sunos4.0* ) opsys=sunos4-0 ;;
+ *-sunos4.1.2* ) opsys=sunos4-1-2 ;;
+ *-sunos4.1.3* ) opsys=sunos4-1-3 ;;
+ *-sunos4.1.[[4-9]]* ) opsys=sunos4-1-4 ;;
+ *-sunos4* | *-sunos ) opsys=sunos4-1 ;;
+ *-mach* ) opsys=mach-bsd4-3 ;;
+ * ) opsys=bsd4-2 ;;
+ esac
+
+ case "$canonical" in *-sunos4*shr* ) opsys="${opsys}-shr" ;; esac
+
+ dnl Watch out for a compiler guaranteed not to work.
+ test "$opsys $CC" = "sol2 /usr/ucb/cc" && CC=""
+ ;;
+
+ dnl Tadpole 68k
+ m68*-tadpole-sysv* ) machine=tad68k opsys=usg5-3 ;;
+
+ dnl Tahoe machines
+ tahoe-tahoe-bsd4.2* ) machine=tahoe opsys=bsd4-2 ;;
+ tahoe-tahoe-bsd4.3* ) machine=tahoe opsys=bsd4-3 ;;
+
+ dnl Tandem Integrity S2
+ mips-tandem-sysv* ) machine=tandem-s2 opsys=usg5-3 ;;
+
+ dnl Tektronix XD88
+ m88k-tektronix-sysv3* ) machine=tekxd88 opsys=usg5-3 ;;
+
+ dnl Tektronix 16000 box (6130?)
+ ns16k-tektronix-bsd* ) machine=ns16000 opsys=bsd4-2 ;;
+ dnl Tektronix 4300
+ dnl src/m/tek4300.h hints that this is a m68k machine.
+ m68*-tektronix-bsd* ) machine=tek4300 opsys=bsd4-3 ;;
+
+ dnl Titan P2 or P3
+ titan-titan-sysv* ) machine=titan opsys=usg5-3 ;;
+
+ dnl Ustation E30 (SS5E)
+ m68*-unisys-uniplus* ) machine=ustation opsystem=unipl5-2 ;;
+
+ dnl Vaxen.
+ vax-dec-* )
+ case "$canonical" in
+ *-sysv[[01]]* | *-sysvr[[01]]* ) opsys=usg5-0 ;;
+ *-sysv2* | *-sysvr2* ) opsys=usg5-2 ;;
+ *-mach* ) opsys=mach-bsd4-3 ;;
+ esac
+ ;;
+
+ dnl Whitechapel MG1
+ ns16k-whitechapel-* ) machine=mg1 ;;
+
+ dnl Wicat
+ m68*-wicat-sysv* ) machine=wicat opsys=usg5-2 ;;
+
+ dnl Intel 386 machines where we do not care about the manufacturer
+ i[[3-9]]86-*-* )
+ machine=intel386
+ case "$canonical" in
+ *-isc1.* | *-isc2.[[01]]* ) opsys=386-ix ;;
+ *-isc2.2* ) opsys=isc2-2 ;;
+ *-isc4.0* ) opsys=isc4-0 ;;
+ *-isc4.* ) opsys=isc4-1
+ GCC_TEST_OPTIONS=-posix
+ NON_GCC_TEST_OPTIONS=-Xp
+ ;;
+ *-isc* ) opsys=isc3-0 ;;
+ *-esix5* ) opsys=esix5r4 NON_GNU_CPP=/usr/lib/cpp ;;
+ *-esix* ) opsys=esix ;;
+ *-mach* ) opsys=mach-bsd4-3 ;;
+ *-xenix* ) opsys=xenix ;;
+ *-sco3.2v4* ) opsys=sco4 NON_GNU_CPP=/lib/cpp ;;
+ *-bsd386* | *-bsdi1* ) opsys=bsd386 ;;
+ *-bsdi3* ) opsys=bsdos3 ;;
+ *-bsdi2.1* ) opsys=bsdos2-1 ;;
+ *-bsdi2* ) opsys=bsdos2 ;;
+ *-sco3.2v5* ) opsys=sco5 ;
+ dnl This is a pain. Like the current USL cc, SCO cc -E
+ dnl tokenizes as it preprocesses, making configure very
+ dnl unhappy. Unfortunately, /lib/cpp does not understand
+ dnl flags like "-b elf", so we have to cheat in order to
+ dnl pick up the right defines for UNEXEC from the s-file.
+ dnl 01/05/95 robertl@dgii.com
+ if test "$dynamic" = "yes" ; then
+ NON_GNU_CPP="/lib/cpp -D_XOPEN_SOURCE -D_SCO_ELF" ;
+ else
+ NON_GNU_CPP="/lib/cpp -D_XOPEN_SOURCE" ;
+ fi ;;
+ *-386bsd* ) opsys=386bsd ;;
+ *-freebsd* ) opsys=freebsd ;;
+ *-nextstep* ) opsys=nextstep ;;
+ *-pc-cygwin32 ) opsys=cygwin32 ;;
+ dnl Otherwise, we fall through to the generic opsys code at the bottom.
+ esac
+ ;;
+
+ dnl Linux/68k
+ m68k-*-linux* ) machine=m68k opsys=linux ;;
+
+esac
+
+if test -z "$machine" -o -z "$opsys"; then
+ (echo "$progname: XEmacs hasn't been ported to \`$canonical' systems."
+ echo "$progname: Check \`etc/MACHINES' for recognized configuration names."
+ ) >&2
+ exit 1
+fi
+
+if test -z "$dynamic"; then
+ case "$opsys" in
+ hpux* | sunos4* | sco5 ) dynamic=no ;;
+ *) dynamic=yes ;;
+ esac
+fi
+if test "$dynamic" = "yes"; then
+ case "$opsys" in
+ hpux* | sunos4* | sco5 ) opsys="${opsys}-shr" ;;
+ decosf* ) ld_call_shared="-call_shared" ;;
+ esac
+else dnl "$dynamic" = "no"
+ case "$opsys" in
+ sol2 )
+ echo "Static linking is not supported on Solaris 2."
+ echo "Rerun configure without specifying --dynamic=no."
+ exit 1 ;;
+ linux ) ld_call_shared="-Bstatic" ;;
+ decosf* ) ld_call_shared="-non_shared" ;;
+ esac
+fi
+
+dnl Use xlc by default on AIX
+case "$opsys" in aix*) NON_GNU_CC=xlc ;; esac
+
+stack_trace_eye_catcher=`echo ${PROGNAME}_${version}_${canonical} | sed 'y/.-/__/'`
+AC_DEFINE_UNQUOTED(STACK_TRACE_EYE_CATCHER, $stack_trace_eye_catcher)
+
+machfile="m/${machine}.h"
+opsysfile="s/${opsys}.h"
+
+dnl --------------------------------------------------
+dnl Determine the compiler, set up for feature testing
+dnl --------------------------------------------------
+
+dnl Sun Development environment support
+test "$with_sparcworks" = "yes" && with_workshop=yes # compatibility alias
+XE_CHECK_FEATURE_DEPENDENCY(workshop, tooltalk)
+if test "$with_workshop" = "yes"; then
+ AC_DEFINE(SUNPRO)
+ XE_ADD_OBJS(sunpro.o)
+fi
+
+if test "$with_clash_detection" = "yes"; then
+ AC_DEFINE(CLASH_DETECTION)
+ XE_ADD_OBJS(filelock.o)
+fi
+
+dnl Choose a compiler from (in order)
+dnl --compiler, env var CC, with_gcc=no && ${NON_GNU_CC:-cc}, AC_PROG_CC
+test -n "$compiler" && CC="$compiler"
+if test "$with_gcc" = "no"; then dnl Try to find a non-gcc compiler
+ case "$CC" in "" | *gcc* ) CC="${NON_GNU_CC-cc}" ;; esac
+fi
+
+dnl If we don't set CFLAGS here, AC_PROG_CC will set it.
+dnl But we know better what's good for us, so we do our own
+dnl computation of real CFLAGS later.
+dnl --cflags overrides environment variable CFLAGS
+test "${cflags-unset}" != unset && CFLAGS="$cflags"
+if test "${CFLAGS-unset}" != unset
+ then cflags_specified=yes;
+ else cflags_specified=no;
+fi
+
+xe_save_CFLAGS="$CFLAGS"
+
+AC_PROG_CC dnl Autoconf has its own magic for compiler autodetection
+
+dnl Retry using random guesswork if AC_PROG_CC got it wrong...
+if test "$with_gcc" = "no" -a "$GCC" = "yes"; then
+ CC=${NON_GNU_CC-cc}
+ AC_PROG_CC
+elif test "$with_gcc" = "yes" -a "$GCC" != "yes" ; then
+ CC=gcc
+ AC_PROG_CC
+fi
+CFLAGS="$xe_save_CFLAGS"
+
+dnl Figure out what C preprocessor to use.
+
+dnl On Sun systems, people sometimes set up the variable CPP
+dnl with a value that is a directory, not an executable at all.
+dnl Detect that case, and ignore that value.
+test -n "$CPP" -a -d "$CPP" && CPP=
+
+test -n "$NON_GNU_CPP" -a "$GCC" != "yes" -a -z "$CPP" && CPP="$NON_GNU_CPP"
+
+AC_PROG_CPP
+
+AC_AIX
+
+AC_MSG_CHECKING(for GNU libc)
+AC_TRY_COMPILE([#include <features.h>],[
+#if ! (defined __GLIBC__ || defined __GNU_LIBRARY__)
+#error Not a GNU libc system :-(
+******* ======= ******** &&&&&&&&
+#endif
+], have_glibc=yes, have_glibc=no)
+AC_MSG_RESULT($have_glibc)
+dnl I'm tired of pop being broken with GLIBC -slb
+dnl Well. then why not fix fucking pop?
+test "$have_glibc" = "yes" && AC_DEFINE(_GNU_SOURCE)
+
+AC_MSG_CHECKING(whether we are using SunPro C)
+AC_TRY_COMPILE([],[#ifndef __SUNPRO_C
+#error Not a SunPro compiler :-(
+******* ======= ******** &&&&&&&&
+#endif
+], __sunpro_c=yes, __sunpro_c=no)
+AC_MSG_RESULT($__sunpro_c)
+
+dnl case "$canonical" in
+dnl *-sun-sunos* ) test "$CPP" = "acc -E" && CPP="acc -E -Xs" ;;
+dnl esac
+
+dnl --------------------------------------------------------------------
+dnl Extract some information from the operating system and machine files
+dnl --------------------------------------------------------------------
+
+echo "Extracting information from the machine- and system-dependent headers..."
+
+dnl It is not important that this name contain the PID; you cannot run
+dnl two configures in the same directory and have anything work
+dnl anyway.
+tempcname="conftest.c"
+
+dnl CPP_to_sh(CPP_SYMBOL, SH_VAR, DEFAULT_VALUE)
+define([CPP_to_sh],
+[[#]ifndef [$1]
+[#]define [$1]ifelse([$3],,, [ "$3"])
+[#]endif
+configure___ [$2]=[$1]
+])dnl CPP_to_sh
+
+dnl CPP_boolean_to_sh(CPP_SYMBOL, SH_VAR)
+define([CPP_boolean_to_sh],
+[[#]ifdef [$1]
+configure___ [$2]=yes
+[#]else
+configure___ [$2]=no
+[#]endif
+])dnl CPP_boolean_to_sh
+
+cat > $tempcname <<EOF
+#define NOT_C_CODE
+#define C_SWITCH_SITE
+#define C_SWITCH_X_SITE
+#define LD_SWITCH_SITE
+#define LD_SWITCH_X_SITE
+#define LD_SWITCH_X_SITE_AUX
+#define OS_RELEASE $os_release
+#include "$srcdir/src/$opsysfile"
+#include "$srcdir/src/$machfile"
+
+CPP_to_sh(LIBS_MACHINE, libs_machine)
+CPP_to_sh(LIBS_SYSTEM, libs_system)
+CPP_to_sh(LIBS_TERMCAP, libs_termcap)
+CPP_to_sh(LIB_STANDARD, libs_standard)
+
+CPP_to_sh(OBJECTS_MACHINE, objects_machine)
+CPP_to_sh(OBJECTS_SYSTEM, objects_system)
+
+CPP_to_sh(C_SWITCH_MACHINE, c_switch_machine)
+CPP_to_sh(C_SWITCH_SYSTEM, c_switch_system)
+
+CPP_to_sh(LD_SWITCH_MACHINE, ld_switch_machine)
+CPP_to_sh(LD_SWITCH_SYSTEM, ld_switch_system)
+
+CPP_to_sh(UNEXEC, unexec, unexec.o)
+
+CPP_to_sh(LD_SWITCH_SHARED, ld_switch_shared, -c)
+
+#ifdef ORDINARY_LINK
+#define LD "\$(CC) \$(CFLAGS)"
+#else /* no ORDINARY LINK */
+#ifdef COFF_ENCAPSULATE
+#define LD "\$(CC) -nostdlib"
+#else /* not COFF_ENCAPSULATE */
+#ifdef LINKER
+#define LD LINKER
+#else /* ! defined (LINKER) */
+#define LD "ld"
+#endif /* ! defined (LINKER) */
+#endif /* ! defined (COFF_ENCAPSULATE) */
+#endif /* not ORDINARY_LINK */
+configure___ ld=LD
+
+CPP_to_sh(LIB_GCC, lib_gcc)
+CPP_to_sh(LD_TEXT_START_ADDR, ld_text_start_addr)
+
+#if ! defined (ORDINARY_LINK) && !defined (START_FILES)
+#ifdef NO_REMAP
+#ifdef COFF_ENCAPSULATE
+#define START_FILES "pre-crt0.o /usr/local/lib/gcc-crt0.o"
+#else /* ! defined (COFF_ENCAPSULATE) */
+#define START_FILES "pre-crt0.o /lib/crt0.o"
+#endif /* ! defined (COFF_ENCAPSULATE) */
+#else /* ! defined (NO_REMAP) */
+#define START_FILES "ecrt0.o"
+#endif /* ! defined (NO_REMAP) */
+#endif /* no ORDINARY_LINK */
+#ifndef START_FILES
+#define START_FILES
+#endif
+configure___ start_files=START_FILES
+
+CPP_boolean_to_sh(ORDINARY_LINK, ordinary_link)
+CPP_boolean_to_sh(SYSTEM_MALLOC, system_malloc)
+CPP_boolean_to_sh(TERMINFO, have_terminfo)
+CPP_boolean_to_sh(MAIL_USE_FLOCK, mail_use_flock)
+CPP_boolean_to_sh(MAIL_USE_LOCKF, mail_use_lockf)
+EOF
+
+dnl The value of CPP is a quoted variable reference, so we need to do this
+dnl to get its actual value...
+CPP=`eval "echo $CPP"`
+define(TAB, [ ])dnl
+changequote(, )dnl
+eval `$CPP -Isrc $tempcname \
+ | sed -n -e "s/[ TAB]*=[ TAB\"]*/='/" -e "s/[ TAB\"]*\$/'/" -e "s/^configure___//p"`
+changequote([, ])dnl
+
+rm $tempcname
+
+dnl For debugging...
+test "$extra_verbose" = "yes" && \
+ PRINT_VAR(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) && echo ""
+
+dnl Non-ordinary link usually requires -lc
+test "$ordinary_link" = "no" -a -z "$libs_standard" && libs_standard="-lc"
+
+dnl Calculalate value of CFLAGS:
+dnl Use either command line flag, environment var, or autodetection
+if test "$cflags_specified" = "no"; then
+ 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"
+ 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 can't cope with -O3
+ test "$opsys $machine" = "cygwin32 intel386" && \
+ CFLAGS="-g -O2 -Wall -Wno-switch"
+ elif test "$__sunpro_c" = "yes"; then
+ case "$opsys" in
+ sol2 ) CFLAGS="-v -xO4" ;;
+ sunos4* ) CFLAGS="-xO2";;
+ esac
+ elif test "$CC" = "xlc"; then
+ CFLAGS="-O3 -qstrict -qnoansialias -qlibansi -qinfo -qro -qmaxmem=20000"
+ else
+ dnl ### Add tests for other compilers here...
+ CFLAGS="-O" ;dnl The only POSIX-approved flag
+ fi
+fi
+
+dnl Inform compiler that certain flags are meant for the linker
+dnl XE_PROTECT_LINKER_FLAGS(shell_var)
+define([XE_PROTECT_LINKER_FLAGS], [
+if test "$GCC" = "yes"; then
+ set x $[$1]; shift; [$1]=""
+ while test -n "[$]1"; do
+ case [$]1 in
+ -L | -l | -u ) [$1]="$[$1] [$]1 [$]2"; shift ;;
+ -L* | -l* | -u* | -Wl* ) [$1]="$[$1] [$]1" ;;
+ -Xlinker* ) ;;
+ * ) [$1]="$[$1] -Xlinker [$]1" ;;
+ esac
+ shift
+ done
+fi])dnl
+XE_PROTECT_LINKER_FLAGS(ld_switch_system)
+XE_PROTECT_LINKER_FLAGS(ld_switch_machine)
+XE_PROTECT_LINKER_FLAGS(LDFLAGS)
+XE_PROTECT_LINKER_FLAGS(ld_call_shared)
+
+dnl Add s&m-determined objects (including unexec) to link line
+test -n "$objects_machine" && XE_ADD_OBJS($objects_machine)
+test -n "$objects_system" && XE_ADD_OBJS($objects_system)
+test -n "$unexec" && XE_ADD_OBJS($unexec)
+
+dnl Dynodump (Solaris 2.x, x<6)
+AC_MSG_CHECKING(for dynodump)
+if test "$unexec" != "unexsol2.o"; then
+ AC_MSG_RESULT(no)
+else
+ AC_MSG_RESULT(yes)
+ AC_DEFINE(DYNODUMP)
+ XE_APPEND(dynodump, MAKE_SUBDIR)
+ XE_APPEND(dynodump, SRC_SUBDIR_DEPS)
+ case "$machine" in
+ sparc ) dynodump_arch=sparc ;;
+ *86* ) dynodump_arch=i386 ;;
+ powerpc ) dynodump_arch=ppc ;;
+ esac
+ dnl Dynodump requires the system linker
+ test "$GCC" = "yes" && XE_APPEND(-fno-gnu-linker, ld_switch_site)
+fi
+
+dnl Feed s&m crud to src/Makefile
+
+dnl Linux/powerpc needs the following magic for some reason
+test "$machine$opsys" = "powerpclinux" && start_flags="-T $srcdir/src/ppc.ldscript"
+
+if test "$unexec" = "unexaix.o"; then
+dnl AIX needs various hacks to make static linking work.
+ if test "$dynamic" = "no"; then
+ start_flags="-Wl,-bnso,-bnodelcsect"
+ test "$GCC" = "yes" && start_flags="-B/bin/ ${start_flags}"
+ for f in "/lib/syscalls.exp" "/lib/threads.exp"; do
+ if test -r "$f"; then start_flags="${start_flags},-bI:${f}"; fi
+ done
+ for f in "/usr/lpp/X11/bin/smt.exp" "/usr/bin/X11/smt.exp"; do
+ if test -r "$f"; then start_flags="${start_flags},-bI:${f}"; break; fi
+ done
+ AC_CHECK_LIB(C, terminateAndUnload, XE_APPEND(-lC, libs_system))
+ fi
+elif test -n "$ld_text_start_addr"; then
+ start_flags="-T $ld_text_start_addr -e __start"
+fi
+AC_SUBST(start_flags)
+
+AC_SUBST(ld_switch_shared)
+AC_SUBST(start_files)
+if test "$ordinary_link" = "no" -a "$GCC" = "yes"; then
+ test -z "$linker" && linker='$(CC) -nostdlib'
+ test -z "$lib_gcc" && lib_gcc='`$(CC) -print-libgcc-file-name`'
+fi
+test "$GCC" != "yes" && lib_gcc=
+AC_SUBST(ld)
+AC_SUBST(lib_gcc)
+
+dnl ---------------------------------------------------------------
+dnl Add site and system specific flags to compile and link commands
+dnl ---------------------------------------------------------------
+
+dnl All dirs present in site-prefixes will be searched for include/ and lib/
+dnl subdirs. This can avoid specifying both site-includes and site-libraries.
+dnl Those dirs will take precedence over the standard places, but not over
+dnl site-includes and site-libraries.
+
+dnl --site-prefixes (multiple dirs)
+if test -n "$site_prefixes"; then
+ for arg in $site_prefixes; do
+ case "$arg" in
+ -* ) ;;
+ * ) argi="-I${arg}/include" ; argl="-L${arg}/lib" ;;
+ esac
+ XE_APPEND($argi, c_switch_site)
+ XE_APPEND($argl, ld_switch_site)
+ done
+fi
+
+dnl --site-libraries (multiple dirs)
+if test -n "$site_libraries"; then
+ for arg in $site_libraries; do
+ case "$arg" in -* ) ;; * ) arg="-L${arg}" ;; esac
+ XE_APPEND($arg, ld_switch_site)
+ done
+fi
+
+dnl --site-includes (multiple dirs)
+if test -n "$site_includes"; then
+ for arg in $site_includes; do
+ case "$arg" in -* ) ;; * ) arg="-I${arg}" ;; esac
+ XE_APPEND($arg, c_switch_site)
+ done
+fi
+
+dnl GNU software installs by default into /usr/local/{include,lib}
+dnl if test -d "/usr/local/include" -a -d "/usr/local/lib"; then
+dnl XE_APPEND("-L/usr/local/lib", ld_switch_site)
+dnl XE_APPEND("-I/usr/local/include", c_switch_site)
+dnl fi
+
+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)
+done
+
+dnl --site-runtime-libraries (multiple dirs)
+if test -n "$site_runtime_libraries"; then
+ LD_RUN_PATH="`echo $site_runtime_libraries | sed -e 's/ */:/g'`"
+ export LD_RUN_PATH
+fi
+
+dnl -------------------------------------
+dnl Compute runtime library path
+dnl -------------------------------------
+
+if 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* ) add_runtime_path=yes ;;
+ * ) add_runtime_path=no ;;
+ esac
+fi
+
+if test "$add_runtime_path" = "yes"; then
+ dnl Try to autodetect runtime library flag (usually -R),
+ dnl and whether it works (or at least does no harm)
+ AC_MSG_CHECKING("for runtime libraries flag")
+ dash_r=""
+ for try_dash_r in "-R" "-R " "-rpath "; do
+ xe_check_libs="${try_dash_r}/no/such/file-or-directory"
+ XE_PROTECT_LINKER_FLAGS(xe_check_libs)
+ AC_TRY_LINK(, , dash_r="$try_dash_r")
+ xe_check_libs=""
+ test -n "$dash_r" && break
+ done
+ if test -n "$dash_r";
+ then AC_MSG_RESULT("\"${dash_r}\"")
+ else AC_MSG_RESULT(NONE)
+ fi
+fi
+
+xe_add_unique_runpath_dir='
+ xe_add_p=yes
+ for xe_dir in $runpath_dirs; do dnl Uniquify
+ test "$xe_dir" = "$xe_runpath_dir" && xe_add_p=no
+ done
+ if test "$xe_add_p" = "yes"; then
+ test -n "$runpath" && runpath="${runpath}:"
+ runpath="${runpath}${xe_runpath_dir}"
+ runpath_dirs="$runpath_dirs $xe_runpath_dir"
+ fi'
+
+
+dnl XE_ADD_RUNPATH_DIR(directory)
+define([XE_ADD_RUNPATH_DIR],[{
+xe_runpath_dir=$1
+dnl PRINT_VAR(ld_switch_site ld_switch_x_site runpath xe_runpath_dir LD_RUN_PATH xe_ldflags)
+ test "$xe_runpath_dir" != "/lib" -a \
+ "$xe_runpath_dir" != "/usr/lib" -a \
+ -n "`ls ${xe_runpath_dir}/*.s[[ol]] 2>/dev/null`" && \
+ eval "$xe_add_unique_runpath_dir"
+}])dnl
+
+dnl XE_COMPUTE_RUNPATH()
+define([XE_COMPUTE_RUNPATH],[
+if test "$add_runtime_path" = "yes" -a -n "$dash_r"; then
+ dnl Remove runtime paths from current ld switches
+ ld_switch_site=`echo '' $ld_switch_site | sed -e 's:^ ::' -e "s/$dash_r[[^ ]]*//g"`
+ ld_switch_x_site=`echo '' $ld_switch_x_site | sed -e 's:^ ::' -e "s/$dash_r[[^ ]]*//g"`
+ dnl PRINT_VAR(ld_switch_site ld_switch_x_site)
+
+ dnl Fix up Runtime path
+ dnl If LD_RUN_PATH is set in environment, use that.
+ dnl In this case, assume user has set the right value.
+ runpath="" runpath_dirs=""
+ if test -n "$LD_RUN_PATH"; then
+ runpath="$LD_RUN_PATH"
+ elif test "$GCC" = "yes"; then
+ dnl Compute runpath from gcc's -v output
+ ld_switch_run_save="$ld_switch_run"; ld_switch_run=""
+ echo "int main(int argc, char *argv[[]]) {return 0;}" > conftest.c
+ xe_runpath_link='${CC-cc} -o conftest -v $CFLAGS '"$xe_ldflags"' conftest.$ac_ext 2>&1 1>/dev/null'
+ for arg in `eval "$xe_runpath_link" | grep ' -L'`; do
+ case "$arg" in P,* | -L* | -R* )
+ for dir in `echo '' "$arg" | sed -e 's:^ ::' -e 's/^..//' -e 'y/:/ /'`; do
+ XE_ADD_RUNPATH_DIR("$dir")
+ done ;;
+ esac
+ done
+ ld_switch_run="$ld_switch_run_save"
+ rm -f conftest*
+ else
+ dnl Add all directories with .so files to runpath
+ for arg in $ld_switch_site $ld_switch_x_site; do
+ case "$arg" in -L*) XE_ADD_RUNPATH_DIR(`echo '' "$arg" | sed -e 's:^ ::' -e 's/^-L//'`);; esac
+ done
+ dnl Sometimes /opt/SUNWdt/lib is the only installed Motif available
+ if test "$opsys $need_motif" = "sol2 yes"; then
+ xe_runpath_dir="/opt/SUNWdt/lib";
+ eval "$xe_add_unique_runpath_dir";
+ fi
+ fi dnl Compute $runpath
+
+ if test -n "$runpath"; then
+ ld_switch_run="${dash_r}${runpath}"
+ XE_PROTECT_LINKER_FLAGS(ld_switch_run)
+ test "$extra_verbose" = "yes" && echo "Setting runpath to $runpath"
+ fi
+fi
+])dnl
+XE_COMPUTE_RUNPATH()
+
+dnl -----------------------------------
+dnl Do some misc autoconf-special tests
+dnl -----------------------------------
+
+dnl Do the opsystem or machine files prohibit the use of the GNU malloc?
+dnl Assume not, until told otherwise.
+GNU_MALLOC=yes
+if test "$with_dlmalloc" != "no"; then
+ doug_lea_malloc=yes
+else
+ doug_lea_malloc=no
+fi
+after_morecore_hook_exists=yes
+AC_CHECK_FUNC(malloc_get_state, ,doug_lea_malloc=no)
+AC_CHECK_FUNC(malloc_set_state, ,doug_lea_malloc=no)
+AC_MSG_CHECKING(whether __after_morecore_hook exists)
+AC_TRY_LINK([extern void (* __after_morecore_hook)();],[__after_morecore_hook = 0],
+ [AC_MSG_RESULT(yes)],
+ [AC_MSG_RESULT(no)
+ after_morecore_hook_exists=no])
+if test "$system_malloc" = "yes" ; then
+ GNU_MALLOC=no
+ GNU_MALLOC_reason="
+ (The GNU allocators don't work with this system configuration)."
+elif test "$with_system_malloc" = "yes" ; then
+ GNU_MALLOC=no
+ GNU_MALLOC_reason="
+ (User chose not to use GNU allocators)."
+elif test "$with_debug_malloc" = "yes" ; then
+ GNU_MALLOC=no
+ GNU_MALLOC_reason="
+ (User chose to use Debugging Malloc)."
+fi
+
+if test "$doug_lea_malloc" = "yes" ; then
+ if test "$GNU_MALLOC" = yes ; then
+ GNU_MALLOC_reason="
+ (Using Doug Lea's new malloc from the GNU C Library.)"
+ fi
+ AC_DEFINE(DOUG_LEA_MALLOC)
+ if test "$after_morecore_hook_exists" = "no" ; then
+ GNU_MALLOC_reason="
+ (Using Doug Lea's new malloc from the Linux C Library.)"
+ AC_DEFINE(_NO_MALLOC_WARNING_)
+ fi
+ use_minimal_tagbits=yes
+fi
+
+dnl #### mcheck is broken in all versions of Linux libc and glibc.
+dnl Try this again when 2.1 hits the streets.
+dnl Avoid using free-hook.c if support exists for malloc debugging in libc
+dnl have_libmcheck=no
+dnl if test "$error_check_malloc" = "yes" -a \
+dnl "$have_glibc" = "yes" -a \
+dnl "$doug_lea_malloc" = "yes"; then
+dnl AC_CHECK_HEADERS(mcheck.h)
+dnl AC_CHECK_LIB(mcheck, mcheck, have_libmcheck=yes, have_libmcheck=no)
+dnl fi
+
+dnl if test "$have_libmcheck" = "yes"; then
+dnl AC_DEFINE(HAVE_LIBMCHECK)
+dnl libmcheck=-lmcheck
+dnl AC_SUBST(libmcheck)
+dnl fi
+
+dnl Some other nice autoconf tests. If you add a test here which
+dnl should make an entry in src/config.h, do not forget to add an
+dnl #undef clause to src/config.h.in for autoconf to modify.
+
+AC_PROG_RANLIB
+AC_PROG_INSTALL
+AC_PROG_YACC
+
+dnl checks for header files
+AC_CHECK_HEADERS(mach/mach.h sys/stropts.h sys/timeb.h sys/time.h unistd.h)
+AC_CHECK_HEADERS(utime.h locale.h libgen.h fcntl.h ulimit.h)
+AC_CHECK_HEADERS(linux/version.h kstat.h sys/pstat.h inttypes.h sys/un.h a.out.h)
+AC_HEADER_SYS_WAIT
+AC_HEADER_STDC
+AC_HEADER_TIME
+AC_DECL_SYS_SIGLIST
+
+dnl Some systems have utime.h but do not declare the struct anyplace.
+AC_MSG_CHECKING(for struct utimbuf)
+AC_TRY_COMPILE([#ifdef TIME_WITH_SYS_TIME
+#include <sys/time.h>
+#include <time.h>
+#else
+#ifdef HAVE_SYS_TIME_H
+#include <sys/time.h>
+#else
+#include <time.h>
+#endif
+#endif
+#ifdef HAVE_UTIME_H
+#include <utime.h>
+#endif], [static struct utimbuf x; x.actime = x.modtime;],
+ [AC_MSG_RESULT(yes)
+ AC_DEFINE(HAVE_STRUCT_UTIMBUF)],
+ AC_MSG_RESULT(no))
+
+dnl checks for typedefs
+AC_TYPE_SIGNAL
+AC_TYPE_SIZE_T
+AC_TYPE_PID_T
+AC_TYPE_UID_T
+AC_TYPE_MODE_T
+AC_TYPE_OFF_T
+
+AC_MSG_CHECKING(for struct timeval)
+AC_TRY_COMPILE([#ifdef TIME_WITH_SYS_TIME
+#include <sys/time.h>
+#include <time.h>
+#else
+#ifdef HAVE_SYS_TIME_H
+#include <sys/time.h>
+#else
+#include <time.h>
+#endif
+#endif], [static struct timeval x; x.tv_sec = x.tv_usec;],
+ [AC_MSG_RESULT(yes)
+ HAVE_TIMEVAL=yes
+ AC_DEFINE(HAVE_TIMEVAL)],
+ [AC_MSG_RESULT(no)
+ HAVE_TIMEVAL=no])
+
+dnl checks for structure members
+AC_STRUCT_TM
+AC_STRUCT_TIMEZONE
+
+dnl checks for compiler characteristics
+AC_C_CONST
+
+dnl check for Make feature
+AC_PROG_MAKE_SET
+
+dnl check byte order
+AC_C_BIGENDIAN
+
+dnl define SIZEOF_TYPE
+AC_CHECK_SIZEOF(short)
+if test "$ac_cv_sizeof_short" = 0; then
+ echo ""
+ echo "*** PANIC *** Configure tests are not working - compiler is broken."
+ echo "*** PANIC *** Please examine config.log for compilation errors."
+ exit 1
+fi
+AC_CHECK_SIZEOF(int)
+AC_CHECK_SIZEOF(long)
+AC_CHECK_SIZEOF(long long)
+AC_CHECK_SIZEOF(void *)
+
+dnl check for long file names
+AC_SYS_LONG_FILE_NAMES
+
+dnl -lm is required by LISP_FLOAT_TYPE, among other things
+AC_CHECK_LIB(m, sin)
+
+dnl Floating operation support is now unconditional
+AC_DEFINE(LISP_FLOAT_TYPE)
+
+AC_TRY_LINK([#include <math.h>],
+ [return atanh(1.0) + asinh(1.0) + acosh(1.0); ],
+ AC_DEFINE(HAVE_INVERSE_HYPERBOLIC))
+
+dnl Determine type of mail locking from configure args and s&m headers
+AC_CHECKING(type of mail spool file locking)
+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"
+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)
+
+case "$opsys" in decosf*)
+ AC_CHECK_LIB(pthreads, cma_open)
+ test "$ac_cv_lib_pthreads_cma_open" = "yes" && \
+ c_switch_site="$c_switch_site -threads" ;;
+esac
+
+AC_MSG_CHECKING(whether the -xildoff compiler flag is required)
+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 AC_MSG_RESULT(no);
+ else AC_MSG_RESULT(yes); XE_APPEND(-xildoff, ld_switch_site)
+ fi
+ else AC_MSG_RESULT(no)
+fi
+
+dnl Link with "-z ignore" on Solaris if supported
+if test "$opsys" = "sol2" && test "$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)
+ XE_PREPEND(-z ignore, ld_switch_site) ;;
+ *) AC_MSG_RESULT(no) ;;
+ esac
+fi
+
+dnl ----------------------
+dnl Choose a window system
+dnl ----------------------
+
+AC_CHECKING("for specified window system")
+
+if test "$with_x11" != "no"; then
+ dnl User-specified --x-includes or --x-libraries implies --with-x11.
+ test "$x_includes $x_libraries" != "NONE NONE" && \
+ window_system=x11 with_x11=yes
+
+ dnl Autodetection of X11 libraries and includes
+ dnl -------------------------------------------
+ dnl AC_PATH_XTRA thinks it can find our X headers and includes, but
+ dnl it often gets it wrong, so we only use it as a last resort.
+
+ dnl $OPENWINHOME implies --x-includes and --x-libraries
+ dnl Not (yet) handled by autoconf2
+ if test "$x_includes $x_libraries" = "NONE NONE" \
+ -a -n "$OPENWINHOME" \
+ -a "$OPENWINHOME" != "/usr/openwin" \
+ -a -d "$OPENWINHOME"; then
+ test -d "$OPENWINHOME/lib" && x_libraries="$OPENWINHOME/lib"
+ test -d "$OPENWINHOME/include" && x_includes="$OPENWINHOME/include"
+ test -d "$OPENWINHOME/share/include" && x_includes="$OPENWINHOME/share/include"
+ fi
+
+ if test "$x_includes" = "NONE"; then
+ dnl AC_PATH_XTRA often guesses /usr/include, when some other
+ dnl include directory is a MUCH better guess (Linux, HP-UX 10.20).
+ dnl This is a workaround for idiot (esp. HP) system vendors, who
+ dnl provide a /usr/include/X11, but DON'T FULLY POPULATE IT.
+ for dir in "/usr/X11" "/usr/X11R6"; do
+ if test -d "$dir/include/X11"; then x_includes="$dir/include"; break; fi
+ done
+ fi
+
+ if test "$x_libraries" = "NONE"; then
+ for dir in "/usr/X11/lib" "/usr/X11R6/lib" "/usr/lib/X11R6"; do
+ if test -r "$dir/libX11.a"; then x_libraries="$dir"; break; fi
+ done
+ fi
+
+ AC_PATH_XTRA # Autoconf claims to find X library and include dirs for us.
+ if test "$no_x" = "yes"
+ then with_x11=no window_system=none HAVE_X_WINDOWS=no
+ else with_x11=yes window_system=x11 HAVE_X_WINDOWS=yes
+ fi
+fi
+
+case "$with_x11" in
+ yes ) window_system=x11 HAVE_X_WINDOWS=yes ;;
+ no ) window_system=none HAVE_X_WINDOWS=no ;;
+esac
+
+if test "$with_x11" = "yes"; then
+ AC_DEFINE(HAVE_X_WINDOWS)
+ XE_APPEND(lwlib, MAKE_SUBDIR)
+ XE_APPEND(lwlib, SRC_SUBDIR_DEPS)
+
+ dnl Try to find Motif/CDE/Tooltalk dirs
+ dnl These take precedence over other X libs/includes, so PRE-pend
+ for lib_dir in "/usr/dt/lib" "/usr/lib/Motif2.1" "/usr/lib/Motif1.2" "/usr/lib/Motif1.1"; do
+ inc_dir=`echo $lib_dir | sed -e 's/lib/include/'`
+ if test -d "$lib_dir" -a -d "$inc_dir"; then
+ case "$x_libraries" in *"$lib_dir"* ) ;; *)
+ x_libraries="$lib_dir $x_libraries"
+ XE_PREPEND(-L${lib_dir}, X_LIBS) ;;
+ esac
+ case "$x_includes" in "$inc_dir"* ) ;; *)
+ x_includes="$inc_dir $x_includes"
+ XE_PREPEND(-I${inc_dir}, X_CFLAGS) ;;
+ esac
+ break; dnl only need ONE Motif implementation!
+ fi
+ done
+
+ dnl Contrib X libs/includes do NOT take precedence, so AP-pend
+ for rel in "X11R6" "X11R5" "X11R4"; do
+ lib_dir="/usr/contrib/$rel/lib" inc_dir="/usr/contrib/$rel/include"
+ if test -d "$lib_dir" -a -d "$inc_dir"; then
+ case "$x_libraries" in *"$lib_dir"* ) ;; *)
+ x_libraries="$x_libraries $lib_dir"
+ XE_APPEND(-L${lib_dir}, X_LIBS)
+ esac
+ case "$x_includes" in "$inc_dir"* ) ;; *)
+ x_includes="$x_includes $inc_dir"
+ XE_APPEND(-I${inc_dir}, X_CFLAGS)
+ esac
+ break; dnl Only need ONE X11 implementation !
+ fi
+ done
+
+ ld_switch_x_site="$X_LIBS"
+
+ XE_COMPUTE_RUNPATH()
+
+ if test "$extra_verbose" = "yes"; then
+ echo; echo "X11 compilation variables:"
+ PRINT_VAR(x_libraries x_includes X_CFLAGS X_LIBS X_PRE_LIBS X_EXTRA_LIBS)
+ echo
+ fi
+
+ dnl Set up bitmaps search path.
+ dnl The original suggestion was to unconditionally to append X11/bitmaps
+ dnl to each element of $x_includes, I'm pretty sure this is the wrong
+ dnl thing to do. We test for bitmaps and X11/bitmaps directories on each
+ dnl element and add them to BITMAPDIR if they exist.
+ bitmapdirs=
+ if test "$x_includes" != NONE; then
+ for i in $x_includes; do
+ if test -d "$i/bitmaps"; then
+ bitmapdirs="$i/bitmaps:$bitmapdirs"
+ fi
+ if test -d "$i/X11/bitmaps"; then
+ bitmapdirs="$i/X11/bitmaps:$bitmapdirs"
+ fi
+ done
+ bitmapdirs=`echo "$bitmapdirs" | sed s/.$//`
+ fi
+ test ! -z "$bitmapdirs" && AC_DEFINE_UNQUOTED(BITMAPDIR, "$bitmapdirs")
+
+ dnl Autodetect defines extracted from X config by xmkmf, e.g. NARROWPROTO
+ AC_CHECKING(for X defines extracted by xmkmf)
+ rm -fr conftestdir
+ if mkdir conftestdir; then
+ cd conftestdir
+ cat > Imakefile <<'EOF'
+xetest:
+ @echo ${PROTO_DEFINES} ${STD_DEFINES}
+EOF
+ if (xmkmf) >/dev/null 2>/dev/null && test -f Makefile; then
+ # GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+ xmkmf_defines=`${MAKE-make} xetest 2>/dev/null | grep -v make`
+ fi
+ cd ..
+ rm -fr conftestdir
+ for word in $xmkmf_defines; do
+ case "$word" in
+ -D*=* ) ;;
+ -D* ) word=`echo '' $word | sed -e 's:^ *-D::'`
+ AC_DEFINE_UNQUOTED($word) ;;
+ esac
+ done
+ fi
+
+ dnl make sure we can find Intrinsic.h
+ AC_CHECK_HEADER(X11/Intrinsic.h, ,
+ [AC_MSG_ERROR("Unable to find X11 header files.")])
+
+ dnl -lXt and -lX11 are required
+ dnl Some broken systems require the magic "-b i486-linuxaout" flag
+ AC_CHECK_LIB(X11, XOpenDisplay, have_lib_x11=yes)
+ if test "$have_lib_x11" != "yes"; then
+ AC_CHECK_LIB(X11, XGetFontProperty,
+ ld_switch_x_site="-b i486-linuxaout $ld_switch_x_site",
+ [AC_MSG_ERROR("Unable to find X11 libraries.")],
+ -b i486-linuxaout)
+ fi
+ libs_x="-lX11"
+ test "$extra_verbose" = "yes" && echo " Setting libs_x to \"-lX11\""
+
+ dnl Autodetect -lXext
+ AC_CHECK_LIB(Xext, XShapeSelectInput, XE_PREPEND(-lXext, libs_x))
+
+ dnl Require -lXt
+ AC_CHECK_LIB(Xt, XtOpenDisplay, XE_PREPEND(-lXt, libs_x),
+ AC_MSG_ERROR("Unable to find X11 libraries."))
+
+ AC_MSG_CHECKING(the version of X11 being used)
+ AC_TRY_RUN([#include <X11/Intrinsic.h>
+ int main(int c, char *v[]) { return c>1 ? XlibSpecificationRelease : 0; }],
+ [./conftest foobar; x11_release=$?],[x11_release=4],[x11_release=4])
+ AC_MSG_RESULT(R${x11_release})
+ AC_DEFINE_UNQUOTED(THIS_IS_X11R${x11_release})
+
+ AC_CHECK_HEADERS(X11/Xlocale.h)
+
+ dnl remove this - we should avoid checking for specific OS
+ AC_MSG_CHECKING(for XFree86)
+ if test -d "/usr/X386/include" -o \
+ -f "/etc/XF86Config" -o \
+ -f "/etc/X11/XF86Config" -o \
+ -f "/usr/X11R6/lib/X11/XF86Config"; then
+ AC_MSG_RESULT(yes)
+ AC_DEFINE(HAVE_XFREE386)
+ else
+ AC_MSG_RESULT(no)
+ fi
+
+ dnl autodetect -lXmu
+ test -z "$with_xmu" && { AC_CHECK_LIB(Xmu, XmuReadBitmapDataFromFile,
+ with_xmu=yes, with_xmu=no) }
+ if test "$with_xmu" = "no"; then
+ XE_ADD_OBJS(xmu.o)
+ else
+ XE_PREPEND(-lXmu, libs_x)
+ AC_DEFINE(HAVE_XMU)
+ fi
+
+ dnl Autodetect -lXbsd
+ dnl #### Someone, please add a better function than main
+ AC_CHECK_LIB(Xbsd, main, XE_PREPEND(-lXbsd, libs_x))
+
+ dnl Problem with the MIT distribution of X on AIX
+ if test "$unexec" = "unexaix.o" -a "$x11_release" = "6"; then
+ dnl X11R6 requires thread-safe code on AIX for some reason
+ if test "$GCC" = "yes"; then
+ XE_PREPEND(-mthreads, X_CFLAGS)
+ XE_PREPEND(-mthreads, libs_x)
+ else
+ case "$CC" in
+ "xlc" ) CC="xlc_r" ;;
+ "xlC" ) CC="xlC_r" ;;
+ "cc" ) CC="cc_r" ;;
+ esac
+ fi
+ fi
+
+fi dnl $with_x11 = yes
+
+if test "$with_msw" != "no"; then
+ AC_CHECKING(for MS-Windows)
+ AC_CHECK_LIB(gdi32,main,with_msw=yes)
+ 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)
+ if test "$window_system" != x11; then
+ window_system=msw
+ test "$with_scrollbars" != "no" && with_scrollbars=msw \
+ && XE_ADD_OBJS(scrollbar-msw.o)
+ test "$with_menubars" != "no" && with_menubars=msw \
+ && XE_ADD_OBJS(menubar-msw.o)
+ test "$with_toolbars" != "no" && with_toolbars=msw \
+ && XE_ADD_OBJS(toolbar-msw.o)
+ test "$with_dialogs" != "no" && with_dialogs=msw \
+ && XE_ADD_OBJS(dialog-msw.o)
+ else
+ test "$with_scrollbars" != "no" && XE_ADD_OBJS(scrollbar-msw.o)
+ test "$with_menubars" != "no" && XE_ADD_OBJS(menubar-msw.o)
+ test "$with_toolbars" != "no" && XE_ADD_OBJS(toolbar-msw.o)
+ test "$with_dialogs" != "no" && XE_ADD_OBJS(dialog-msw.o)
+ fi
+ dnl check for our special version of select
+ AC_TRY_RUN([#include <fcntl.h>
+ 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)
+ fi
+fi
+
+AC_SUBST(install_pp)
+
+test -z "$window_system" && window_system="none"
+
+dnl Test for features that require a window system - ANY window system
+if test "$window_system" = "none"; then
+ for feature in menubars scrollbars toolbars dialogs dragndrop
+ do
+ if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then
+ AC_MSG_WARN([--with-$feature ignored: Not valid without window system support])
+ fi
+ eval "with_${feature}=no"
+ done
+else
+ test -z "$with_toolbars" && with_toolbars=yes
+fi
+
+dnl ### Test for features that require mswindows support - currently none
+dnl ### MS-Windows folks: add code here..... (martin)
+if test "$with_msw" != "yes"; then
+ for feature in MARTIN_IS_CLUELESS_ABOUT_MSW_FEATURES
+ do
+ if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then
+ AC_MSG_WARN([--with-$feature ignored: Not valid without MS-Windows support])
+ fi
+ eval "with_${feature}=no"
+ done
+else
+ :
+fi
+
+dnl Test for features that require X11 support
+if test "$with_x11" != "yes"; then
+ dnl It ought to be reasonable to have no output device at all, and only use
+ dnl XEmacs in --batch mode.
+ 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 \
+ xface
+ do
+ if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then
+ AC_MSG_WARN([--with-$feature ignored: Not valid without X support])
+ fi
+ eval "with_${feature}=no"
+ done
+fi
+
+dnl FSF 19.29 has some bitmapdir stuff here.
+bitmapdir=
+
+case "$window_system" in
+ x11 ) HAVE_X_WINDOWS=yes; echo " Using X11." ;;
+ msw ) HAVE_X_WINDOWS=no ; echo " Using MS-Windows." ;;
+ none ) HAVE_X_WINDOWS=no ; echo " Using no window system." ;;
+esac
+
+case "$x_libraries" in *X11R4* )
+ test "$opsys" = "hpux9" && opsysfile="s/hpux9-x11r4.h"
+ 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)
+fi
+
+dnl Autodetect Xauth
+dnl -lXau is only used by gnuclient, so use a special variable for Xauth X libs
+test -z "$with_xauth" && test "$window_system" = "none" && with_xauth=no
+test -z "$with_xauth" && { AC_CHECK_HEADER(X11/Xauth.h, ,with_xauth=no) }
+test -z "$with_xauth" && { AC_CHECK_LIB(Xau, XauGetAuthByAddr,[:],with_xauth=no) }
+test -z "$with_xauth" && with_xauth=yes
+if test "$with_xauth" = "yes"; then
+ AC_DEFINE(HAVE_XAUTH)
+ XE_SPACE(libs_xauth, $X_EXTRA_LIBS -lXau $libs_x $X_PRE_LIBS)
+fi
+AC_SUBST(libs_xauth)
+
+dnl This one is for the static initializeds variables in
+dnl offix.c, so that the thing is dumped after lastfile.o
+AC_SUBST(dnd_objs)
+
+dnl Autodetect tooltalk
+if test "$with_tooltalk" != "no" ; then
+ dnl autodetect the location of tt_c.h
+ dnl tt_c.h might be in Tt or desktop include directories
+ for dir in "" "Tt/" "desktop/" ; do
+ AC_CHECK_HEADER(${dir}tt_c.h, tt_c_h_path="${dir}tt_c.h"; break)
+ done
+ if test -z "$tt_c_h_path"; then
+ if test "$with_tooltalk" = "yes"; then
+ USAGE_ERROR("Unable to find required tooltalk header files.")
+ fi
+ with_tooltalk=no
+ fi
+fi
+if test "$with_tooltalk" != "no" ; then
+ for extra_libs in "" "-lI18N -lce" "-lcxx"; do
+ AC_CHECK_LIB(tt, tt_message_create,
+ tt_libs="-ltt $extra_libs"; break, [:],$extra_libs)
+ done
+ if test -z "$tt_libs"; then
+ if test "$with_tooltalk" = "yes"; then
+ USAGE_ERROR("Unable to find required tooltalk libraries.")
+ fi
+ with_tooltalk=no
+ fi
+fi
+test -z "$with_tooltalk" && with_tooltalk=yes
+if test "$with_tooltalk" = "yes"; then
+ AC_DEFINE(TOOLTALK)
+ AC_DEFINE_UNQUOTED(TT_C_H_PATH, "$tt_c_h_path")
+ XE_PREPEND($tt_libs, libs_x)
+ XE_ADD_OBJS(tooltalk.o)
+fi
+
+dnl Autodetect CDE
+test -z "$with_cde" && { AC_CHECK_HEADER(Dt/Dt.h, , with_cde=no) }
+test -z "$with_cde" && { AC_CHECK_LIB(DtSvc, DtDndDragStart, [:], with_cde=no) }
+test -z "$with_cde" && with_cde=yes
+if test "$with_dragndrop" = no; then
+ AC_MSG_WARN([No CDE without generic Drag'n'Drop support])
+ with_cde=no
+fi
+if test "$with_cde" = "yes" ; then
+ AC_DEFINE(HAVE_CDE)
+ XE_PREPEND(-lDtSvc, libs_x)
+ XE_APPEND(CDE, dragndrop_proto)
+ with_tooltalk=yes # CDE requires Tooltalk
+ need_motif=yes # CDE requires Motif
+fi
+
+dnl Always compile OffiX unless --without-offix is given, no
+dnl X11 support is compiled in, no standard Xmu is avaiable,
+dnl or dragndrop support is disabled
+dnl Because OffiX support currently loses when more than one display
+dnl is in use, we now disable it by default -slb 07/10/1998.
+test "$window_system" != "x11" && with_offix=no
+if test "$with_xmu" != yes -a "$with_x11" = yes; then
+ AC_MSG_WARN([No OffiX without real Xmu support])
+ with_offix=no
+fi
+if test "$with_dragndrop" = no; then
+ AC_MSG_WARN([No OffiX without generic Drag'n'Drop support])
+ with_offix=no
+fi
+if test "$with_cde" = yes; then
+ AC_MSG_WARN([CDE already found, disabling OffiX support])
+ with_offix=no
+fi
+test -z "$with_offix" && with_offix=no
+if test "$with_offix" = "yes"; then
+ AC_DEFINE(HAVE_OFFIX_DND)
+ XE_APPEND(offix.o, dnd_objs)
+ XE_APPEND(OffiX, dragndrop_proto)
+fi
+
+dnl Autodetect Drag'n'Drop support
+dnl always included if CDE, Offix, or MSWindows are defined
+AC_MSG_CHECKING(if drag and drop API is needed)
+if test "$with_dragndrop" != "no" ; then
+ if test -n "$dragndrop_proto" ; then
+ with_dragndrop=yes
+ AC_MSG_RESULT([yes (${dragndrop_proto} )])
+ AC_DEFINE(HAVE_DRAGNDROP)
+ XE_APPEND(dragdrop.o, extra_objs)
+ else
+ with_dragndrop=no
+ AC_MSG_RESULT(no)
+ fi
+fi
+
+dnl Autodetect LDAP
+AC_CHECKING(for LDAP)
+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
+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)
+ 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
+fi
+
+dnl ----------------------
+dnl Graphics libraries
+dnl ----------------------
+
+if test "$window_system" != "none"; then
+ AC_CHECKING(for graphics libraries)
+
+ dnl Autodetect Xpm
+ if test -z "$with_xpm"; then
+ AC_MSG_CHECKING(for Xpm - no older than 3.4f)
+ xe_check_libs=-lXpm
+ AC_TRY_RUN([#include <X11/xpm.h>
+ int main(int c, char **v) {
+ return c == 1 ? 0 :
+ XpmIncludeVersion != XpmLibraryVersion() ? 1 :
+ XpmIncludeVersion < 30406 ? 2 : 0 ;}],
+ [./conftest dummy_arg; xpm_status=$?;
+ if test "$?" = "0"; then
+ with_xpm=yes;
+ else
+ with_xpm=no;
+ if test "$?" = "1"; then
+ xpm_problem="Xpm library version and header file version don't match!"
+ elif test "$?" = "2"; then
+ xpm_problem="Xpm library version is too old!"
+ else
+ xpm_problem="Internal xpm detection logic error!"
+ fi
+ echo "
+*** WARNING *** $problem
+ I'm not touching that with a 10-foot pole!
+ If you really want to use the installed version of Xpm, rerun
+ configure --with-xpm=yes, but don't blame me if XEmacs crashes!"
+ fi],
+ [with_xpm=no])
+ xe_check_libs=
+ AC_MSG_RESULT($with_xpm)
+ fi
+ if test "$with_xpm" = "yes"; then
+ AC_DEFINE(HAVE_XPM)
+ XE_PREPEND(-lXpm, libs_x)
+ AC_MSG_CHECKING(for \"FOR_MSW\" xpm)
+ xe_check_libs=-lXpm
+ AC_TRY_LINK(, [XpmCreatePixmapFromData()],
+ [xpm_for_msw=no],
+ [xpm_for_msw=yes])
+ xe_check_libs=
+ AC_MSG_RESULT($xpm_for_msw)
+ if test "$xpm_for_msw" = "yes"; then
+ AC_DEFINE(FOR_MSW)
+ fi
+ fi
+
+ dnl Too many stupid linkers can't detect cascaded lib dependencies until runtime
+ dnl So we always search for libz compression support.
+ if test "$with_png $with_tiff" != "no no"; then
+ AC_CHECK_LIB(c, inflate, [:], [
+ AC_CHECK_LIB(z, inflate, [XE_PREPEND(-lz, libs_x)],[
+ AC_CHECK_LIB(gz, inflate, [XE_PREPEND(-lgz, libs_x)])])])
+ fi
+
+ dnl Autodetect GIFlib
+ AC_MSG_CHECKING(for gifreader)
+ test -z "$with_gif" && { AC_CHECK_HEADER(gifrlib.h, ,with_gif=no) }
+ test -z "$with_gif" && { AC_CHECK_LIB(gifreader, GetGifError,[:] ,with_gif=no) }
+ test -z "$with_gif" && with_gif=yes
+ if test "$with_gif" = "yes"; then
+ AC_DEFINE(HAVE_GIF)
+ XE_PREPEND(-lgifreader, libs_x)
+ fi
+
+ dnl autodetect JPEG
+ test -z "$with_jpeg" && { AC_CHECK_HEADER(jpeglib.h, ,with_jpeg=no) }
+ test -z "$with_jpeg" && { AC_CHECK_LIB(jpeg, jpeg_destroy_decompress,[:],with_jpeg=no) }
+ test -z "$with_jpeg" && with_jpeg=yes
+ if test "$with_jpeg" = "yes"; then
+ AC_DEFINE(HAVE_JPEG)
+ XE_PREPEND(-ljpeg, libs_x)
+ fi
+
+ dnl autodetect PNG
+ if test -z "$with_png"; then
+ AC_MSG_CHECKING(for png.h - no older than 0.96)
+ AC_EGREP_CPP(yes,
+[#include <png.h>
+#if PNG_LIBPNG_VER >= 96
+yes
+#endif
+], [AC_MSG_RESULT(yes)], [AC_MSG_RESULT(no); with_png=no])
+ fi
+ test -z "$with_png" && { AC_CHECK_FUNC(pow, ,with_png=no) }
+ test -z "$with_png" && { AC_CHECK_LIB(png, png_read_image,[:],with_png=no) }
+ test -z "$with_png" && with_png=yes
+ if test "$with_png" = "yes"; then
+ AC_DEFINE(HAVE_PNG)
+ XE_PREPEND(-lpng, libs_x)
+ fi
+
+ dnl autodetect TIFF
+ test -z "$with_tiff" && { AC_CHECK_HEADER(tiffio.h, ,with_tiff=no) }
+ test -z "$with_tiff" && { AC_CHECK_LIB(tiff, TIFFClientOpen,[:],with_tiff=no) }
+ test -z "$with_tiff" && with_tiff=yes
+ if test "$with_tiff" = "yes"; then
+ AC_DEFINE(HAVE_TIFF)
+ XE_PREPEND(-ltiff, libs_x)
+ fi
+fi
+
+dnl ----------------------
+dnl Graphics libraries
+dnl ----------------------
+
+if test "$with_x11" = "yes"; then
+
+ AC_CHECKING(for X11 graphics libraries)
+
+ dnl Autodetect XFACE
+ test -z "$with_xface" && { AC_CHECK_HEADER(compface.h, ,with_xface=no) }
+ test -z "$with_xface" && { AC_CHECK_LIB(compface, UnGenFace,[:] ,with_xface=no) }
+ test -z "$with_xface" && with_xface=yes
+ if test "$with_xface" = "yes"; then
+ AC_DEFINE(HAVE_XFACE)
+ XE_PREPEND(-lcompface, libs_x)
+ fi
+
+ 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
+
+ dnl autodetect Motif - but only add to libs_x later (if necessary)
+ AC_CHECK_HEADER(Xm/Xm.h,
+ [AC_CHECK_LIB(Xm, XmStringFree, have_motif=yes, have_motif=no)],
+ have_motif=no)
+
+ if test "$have_motif" = "yes"; then
+ dnl autodetect lesstif
+ AC_MSG_CHECKING(for Lesstif)
+ AC_EGREP_CPP(yes,
+[#include <Xm/Xm.h>
+#ifdef LESSTIF_VERSION
+yes
+#endif
+], have_lesstif=yes, have_lesstif=no)
+ AC_MSG_RESULT($have_lesstif)
+ fi
+
+fi dnl "$with_x11" = "yes"
+
+dnl Finish ensuring that we have values for the various toolkit items.
+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" )
+ 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"
+ 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) ;;
+esac
+
+case "$all_widgets" in *motif* )
+ AC_DEFINE(LWLIB_USES_MOTIF)
+ AC_DEFINE(NEED_MOTIF)
+ XE_APPEND(lwlib-Xm.o, lwlib_objs)
+ need_motif=yes ;;
+esac
+
+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)
+case "$all_widgets" in *lucid* )
+ AC_DEFINE(NEED_LUCID)
+ XE_APPEND(lwlib-Xlw.o, lwlib_objs) ;;
+esac
+
+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_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_menubars" = "lucid" && AC_DEFINE(LWLIB_MENUBARS_LUCID)
+test "$with_scrollbars" = "lucid" && AC_DEFINE(LWLIB_SCROLLBARS_LUCID)
+
+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 "$all_widgets" != "no no no no" && XE_ADD_OBJS(gui.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
+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 ----------------------
+
+test -z "$with_mule" && with_mule=no
+test -z "$with_file_coding" && with_file_coding=no
+
+dnl if test "$with_mule" = "yes" && test ! -d "$srcdir/lisp/mule"; then
+dnl echo "Attempt to Build with Mule without Mule/Lisp"
+dnl echo "Please install the XEmacs/Mule tarball or"
+dnl echo "rerun configure with --with-mule=no"
+dnl exit 1
+dnl fi
+
+if test "$with_file_coding" = "yes" && test "$with_mule" = "no"; then
+ AC_DEFINE(FILE_CODING)
+ XE_ADD_OBJS(file-coding.o)
+fi
+
+if test "$with_mule" = "yes" ; then
+ 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)
+
+ dnl Use -lintl to get internationalized strerror for Mule
+ AC_CHECK_HEADERS(libintl.h)
+ AC_CHECK_LIB(intl, strerror)
+
+ AC_CHECKING(for Mule input methods)
+ dnl Do we have the XmIm* routines? And if so, do we want to use them?
+ dnl XIM seems to be flaky except on Solaris...
+ dnl test -z "$with_xim" -a "$opsys" != "sol2" && with_xim=no
+ case "$with_xim" in "" | "yes" )
+ AC_CHECKING(for XIM)
+ dnl XIM + Lesstif is not (yet?) usable
+ if test "$have_lesstif" = "yes"; then with_xim=xlib
+ else AC_CHECK_LIB(Xm, XmImMbLookupString, with_xim=motif, with_xim=xlib)
+ fi
+ esac
+ if test "$with_xim" != "no"; then
+ AC_DEFINE(HAVE_XIM)
+ if test "$with_xim" = "xlib"; then
+ AC_DEFINE(XIM_XLIB)
+ XE_ADD_OBJS(input-method-xlib.o)
+ fi
+ if test "$with_xim" = "motif"; then
+ AC_DEFINE(XIM_MOTIF)
+ need_motif=yes
+ XE_ADD_OBJS(input-method-motif.o)
+ fi
+ if test "$with_xim" = "motif"; then
+ with_xfs=no
+ fi
+ fi
+
+ dnl "with_xim" = "yes"
+ if test "$with_xfs" = "yes" ; then
+ AC_CHECKING(for XFontSet)
+ AC_CHECK_LIB(X11, XmbDrawString, [:], with_xfs=no)
+ if test "$with_xfs" = "yes" && test "$with_menubars" = "lucid"; then
+ AC_DEFINE(USE_XFONTSET)
+ if test "$with_xim" = "no" ; then
+ XE_ADD_OBJS(input-method-xfs.o)
+ fi
+ fi
+ fi dnl with_xim
+
+ dnl Autodetect WNN
+ test "$with_wnn6" = "yes" && with_wnn=yes # wnn6 implies wnn support
+ test -z "$with_wnn" && { AC_CHECK_HEADER(wnn/jllib.h, ,with_wnn=no) }
+ dnl Detour to find crypt
+ if test "$with_wnn" != "no"; then
+ AC_CHECK_FUNCS(crypt)
+ test "$ac_cv_func_crypt" != "yes" && { AC_CHECK_LIB(crypt, crypt) }
+ fi
+ dnl Back to our regularly scheduled wnn hunting
+ test -z "$with_wnn" && { AC_CHECK_LIB(wnn,jl_dic_list_e,[:],with_wnn=no) }
+ test -z "$with_wnn" && with_wnn=yes
+ if test "$with_wnn" = "yes"; then
+ AC_DEFINE(HAVE_WNN)
+ XE_PREPEND(-lwnn, libs_x)
+ XE_ADD_OBJS(mule-wnnfns.o)
+ if test "$with_wnn6" != "no"; then
+ AC_CHECK_LIB(wnn, jl_fi_dic_list, with_wnn6=yes)
+ test "$with_wnn6" = "yes" && AC_DEFINE(WNN6)
+ fi
+ fi
+
+ dnl Autodetect canna
+ canna_includes_found=no
+ if test "$with_canna" != "no"; then
+ AC_CHECK_HEADER(canna/jrkanji.h,canna_includes_found=yes)
+ fi
+ if test "$canna_includes_found" = "no" -a "$with_canna" != "no" -a \
+ -d "/usr/local/canna/include"; then
+ save_c_switch_site="$c_switch_site"
+ c_switch_site="$c_switch_site -I/usr/local/canna/include"
+ AC_CHECK_HEADER(canna/jrkanji.h,canna_includes_found=yes)
+ if test "$canna_includes_found" != "yes"; then
+ c_switch_site="$save_c_switch_site"
+ with_canna="no"
+ fi
+ fi
+
+ test -z "$with_canna" && { AC_CHECK_HEADER(canna/RK.h, , with_canna=no) }
+ test -z "$with_canna" && { AC_CHECK_LIB(RKC, RkBgnBun, [:],with_canna=no) }
+ test -z "$with_canna" && { AC_CHECK_LIB(canna,jrKanjiControl,[:],with_canna=no) }
+ test -z "$with_canna" && with_canna=yes
+ if test "$with_canna" = "yes"; then
+ AC_DEFINE(HAVE_CANNA)
+ XE_PREPEND(-lcanna -lRKC, libs_x)
+ XE_ADD_OBJS(mule-canna.o)
+ fi
+
+else dnl "$with_mule" = "no"
+ for feature in xim canna wnn; do
+ if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then
+ AC_MSG_WARN("--with-${feature} ignored: Not valid without Mule support")
+ fi
+ eval "with_${feature}=no"
+ done
+fi dnl with_mule
+
+
+dnl At this point, we know whether we need the motif lib or not.
+if test "$need_motif" = "yes" ; then
+ XE_PREPEND(-lXm, libs_x)
+ dnl AIX needs the following library for use with Motif
+ AC_CHECK_LIB(i18n, layout_object_getvalue, [XE_PREPEND(-li18n, libs_x)])
+ 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.
+case "$opsys" in
+ linuxaout* | bsdos3* | freebsd* | decosf4-0* | aix4* ) XE_ADD_OBJS(realpath.o) ;;
+ * )
+ AC_CHECK_FUNCS(realpath)
+ test "$ac_cv_func_realpath" != "yes" && XE_ADD_OBJS(realpath.o) ;;
+esac
+
+dnl If netdb.h does not declare h_errno, we must declare it by hand.
+AC_MSG_CHECKING(whether netdb declares h_errno)
+AC_TRY_LINK([#include <netdb.h>],
+ [return h_errno;],
+ [AC_MSG_RESULT(yes)
+ AC_DEFINE(HAVE_H_ERRNO)],
+ [AC_MSG_RESULT(no)])
+
+AC_MSG_CHECKING(for sigsetjmp)
+AC_TRY_COMPILE([#include <setjmp.h>],
+ [sigjmp_buf bar; sigsetjmp (bar, 0);],
+ [AC_MSG_RESULT(yes)
+ AC_DEFINE(HAVE_SIGSETJMP)],
+ [AC_MSG_RESULT(no)])
+
+AC_MSG_CHECKING(whether localtime caches TZ)
+AC_CACHE_VAL(emacs_cv_localtime_cache,
+[if test "$ac_cv_func_tzset" = "yes"; then
+AC_TRY_RUN([#include <time.h>
+#if STDC_HEADERS
+# include <stdlib.h>
+#endif
+extern char **environ;
+unset_TZ ()
+{
+ char **from, **to;
+ for (to = from = environ; (*to = *from); from++)
+ if (! (to[0][0] == 'T' && to[0][1] == 'Z' && to[0][2] == '='))
+ to++;
+}
+char TZ_GMT0[] = "TZ=GMT0";
+char TZ_PST8[] = "TZ=PST8";
+main()
+{
+ time_t now = time ((time_t *) 0);
+ int hour_GMT0, hour_unset;
+ if (putenv (TZ_GMT0) != 0)
+ exit (1);
+ hour_GMT0 = localtime (&now)->tm_hour;
+ unset_TZ ();
+ hour_unset = localtime (&now)->tm_hour;
+ if (putenv (TZ_PST8) != 0)
+ exit (1);
+ if (localtime (&now)->tm_hour == hour_GMT0)
+ exit (1);
+ unset_TZ ();
+ if (localtime (&now)->tm_hour != hour_unset)
+ exit (1);
+ exit (0);
+}], emacs_cv_localtime_cache=no, emacs_cv_localtime_cache=yes,
+[# If we have tzset, assume the worst when cross-compiling.
+emacs_cv_localtime_cache=yes])
+else
+ # If we lack tzset, report that localtime does not cache TZ,
+ # since we can't invalidate the cache if we don't have tzset.
+ emacs_cv_localtime_cache=no
+fi],[:])dnl
+AC_MSG_RESULT($emacs_cv_localtime_cache)
+if test $emacs_cv_localtime_cache = yes; then
+ AC_DEFINE(LOCALTIME_CACHE)
+fi
+
+if test "$HAVE_TIMEVAL" = "yes"; then
+AC_MSG_CHECKING(whether gettimeofday accepts one or two arguments)
+AC_TRY_LINK([
+#ifdef TIME_WITH_SYS_TIME
+#include <sys/time.h>
+#include <time.h>
+#else
+#ifdef HAVE_SYS_TIME_H
+#include <sys/time.h>
+#else
+#include <time.h>
+#endif
+#endif
+ ],
+ [
+ struct timeval time;
+ struct timezone dummy;
+ gettimeofday (&time, &dummy);
+],
+ [AC_MSG_RESULT(two)],
+ [AC_MSG_RESULT(one)
+ AC_DEFINE(GETTIMEOFDAY_ONE_ARGUMENT)])
+fi
+
+
+AC_C_INLINE
+if test "$ac_cv_c_inline" != "no"; then
+ AC_DEFINE(HAVE_INLINE)
+ test "$GCC" = "yes" && XE_ADD_OBJS(inline.o)
+fi
+
+dnl HP-UX has a working alloca in libPW.
+dnl case "${GCC}${opsys}" in hpux* )
+dnl AC_CHECK_FUNC(alloca, [:], [AC_CHECK_LIB(PW, alloca)])
+dnl esac
+
+AC_FUNC_ALLOCA
+test -n "$ALLOCA" && XE_ADD_OBJS($ALLOCA)
+
+dnl Check whether vfork exists and works correctly. (This does more
+dnl than just check for its existence.) If so, it defines HAVE_VFORK_H.
+dnl If not, it defines vfork to be fork.
+AC_FUNC_VFORK
+
+dnl Check whether strcoll exists and works correctly. (This does more
+dnl than just check for its existence.) If so, it defines HAVE_STRCOLL.
+AC_FUNC_STRCOLL
+
+dnl If `getpgrp' takes no argument (the POSIX.1 version), define
+dnl `GETPGRP_VOID'. Otherwise, it is the BSD version, which takes a
+dnl process ID as an argument.
+AC_CHECK_FUNCS(getpgrp)
+AC_FUNC_GETPGRP
+
+dnl We used to call AC_FUNC_MMAP here
+dnl Instead we now use following, suggested by Neal Becker
+AC_MSG_CHECKING(for working mmap)
+case "$opsys" in ultrix* ) have_mmap=no ;; *)
+AC_TRY_RUN([#include <stdio.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include <sys/mman.h>
+
+#ifndef MAP_VARIABLE
+#define MAP_VARIABLE 0
+#endif
+
+#ifndef MAP_FAILED
+#define MAP_FAILED -1
+#endif
+
+int main (int argc, char *argv[])
+{
+ int fd = -1;
+ caddr_t p;
+#ifndef MAP_ANONYMOUS
+ fd = open ("/dev/zero", O_RDWR);
+ if (fd < 0)
+ return 1;
+#define MAP_ANONYMOUS 0
+#endif
+ if (mmap(0, 1024, PROT_READ | PROT_WRITE,
+ MAP_PRIVATE | MAP_VARIABLE | MAP_ANONYMOUS,
+ fd, 0) != (void *) MAP_FAILED)
+ return 0;
+ perror ("conftest: mmap failed");
+ return 1;
+}], have_mmap=yes, have_mmap=no) ;;
+esac
+AC_MSG_RESULT($have_mmap)
+test "$have_mmap" = "yes" && AC_DEFINE(HAVE_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 "$rel_alloc" = "yes" && AC_DEFINE(REL_ALLOC)
+
+dnl Check for terminal I/O variants
+dnl TERMIOS systems may have termio.h, but not vice-versa, I think.
+AC_CHECK_HEADER(termios.h,
+ AC_DEFINE(HAVE_TERMIOS)
+ AC_DEFINE(SIGNALS_VIA_CHARACTERS)
+ AC_DEFINE(NO_TERMIO),
+ [AC_CHECK_HEADER(termio.h, [AC_DEFINE(HAVE_TERMIO)])])
+
+
+dnl Check for Internet sockets.
+AC_CHECK_FUNC(socket,
+ [AC_CHECK_HEADER(netinet/in.h,
+ [AC_CHECK_HEADER(arpa/inet.h, [
+ AC_DEFINE(HAVE_SOCKETS)
+ AC_MSG_CHECKING("for sun_len member in struct sockaddr_un")
+ AC_TRY_LINK([
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <sys/un.h>
+ ],
+ [static struct sockaddr_un x; x.sun_len = 1;],
+ [AC_MSG_RESULT(yes); AC_DEFINE(HAVE_SOCKADDR_SUN_LEN)],
+ [AC_MSG_RESULT(no)])
+ AC_MSG_CHECKING("for ip_mreq struct in netinet/in.h")
+ AC_TRY_LINK([
+#include <sys/types.h>
+#include <netinet/in.h>
+ ],
+ [static struct ip_mreq x;],
+ [AC_MSG_RESULT(yes); AC_DEFINE(HAVE_MULTICAST)],
+ [AC_MSG_RESULT(no)])])])])
+
+dnl Check for SYS V IPC. (Inferior to sockets.)
+AC_CHECK_FUNC(msgget,
+ [AC_CHECK_HEADER(sys/ipc.h,
+ [AC_CHECK_HEADER(sys/msg.h,
+ [AC_DEFINE(HAVE_SYSVIPC)])])])
+
+dnl Check for directory variants
+AC_CHECK_HEADER(dirent.h, [AC_DEFINE(SYSV_SYSTEM_DIR)],
+ [AC_CHECK_HEADER(sys/dir.h, , [AC_DEFINE(NONSYSTEM_DIR_LIBRARY)])])
+
+dnl Check for nlist.h
+AC_CHECK_HEADER(nlist.h, AC_DEFINE(NLIST_STRUCT), )
+
+dnl Check for sound of various sorts.
+
+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
+ dnl Maybe sound is already on include path...
+ if test -n "$native_sound_lib"; then
+ AC_CHECK_HEADER(multimedia/audio_device.h,
+ [sound_found=yes sound_cflags=""
+ XE_ADD_OBJS(sunplay.o)])
+ fi
+
+ dnl Autodetect Sun native sound from SUNWaudmo package
+ if test -z "$sound_found" -a -d "/usr/demo/SOUND"; then
+ sound_found=yes
+ XE_ADD_OBJS(sunplay.o)
+ if test -d "/usr/demo/SOUND/include"
+ then sound_cflags="-I/usr/demo/SOUND/include"
+ else sound_cflags="-I/usr/demo/SOUND"
+ fi
+ if test -z "$native_sound_lib" ; then
+ if test -r "/usr/demo/SOUND/lib/libaudio.a"
+ then native_sound_lib="/usr/demo/SOUND/lib/libaudio.a"
+ else native_sound_lib="/usr/demo/SOUND/libaudio.a"
+ fi
+ fi
+ fi
+
+ dnl Check for SGI and HP native sound libs
+ if test -z "$sound_found"; then
+ case "$canonical" in
+ *-sgi-* )
+ if test -z "$native_sound_lib"; then
+ AC_CHECK_LIB(audio, ALopenport, native_sound_lib="-laudio")
+ fi
+ if test -n "$native_sound_lib"; then
+ sound_found=yes sound_cflags=""
+ XE_ADD_OBJS(sgiplay.o)
+ fi ;;
+ hppa*-hp-hpux* )
+ if test -z "$native_sound_lib"; then
+ AC_CHECK_LIB(Alib, AOpenAudio, native_sound_lib="-lAlib")
+ fi
+ if test -n "$native_sound_lib"; then
+ sound_found=yes
+ XE_ADD_OBJS(hpplay.o)
+ if test "$GCC" = "yes" # Kludge city
+ then sound_cflags="-Dconst= -Dvolatile= -I/usr/audio/examples"
+ else sound_cflags="+e -I/usr/audio/examples"
+ fi
+ fi ;;
+ esac
+ fi
+
+ dnl Check for Linux/BSD native sound
+ if test -z "$sound_found"; then
+ for dir in "machine" "sys" "linux"; do
+ AC_CHECK_HEADER(${dir}/soundcard.h,
+ sound_found=yes
+ XE_ADD_OBJS(linuxplay.o)
+ [AC_DEFINE_UNQUOTED(SOUNDCARD_H_PATH, "${dir}/soundcard.h")]
+ break)
+ done
+ fi
+
+ 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 behaviour.
+ AC_EGREP_HEADER(AuXtErrorJump,audio/Xtutil.h,,[AC_DEFINE(NAS_NO_ERROR_JUMP)])
+esac
+
+dnl ---------------------
+dnl TTY-dependent options
+dnl ---------------------
+
+test -z "$with_tty" && with_tty=yes
+
+if test "$with_tty" = "yes" ; then
+ AC_CHECKING(for TTY-related features)
+ AC_DEFINE(HAVE_TTY)
+ XE_ADD_OBJS(console-tty.o device-tty.o event-tty.o frame-tty.o objects-tty.o redisplay-tty.o cm.o)
+
+ dnl Autodetect ncurses.
+ if test -z "$with_ncurses"; then
+ AC_CHECK_LIB(ncurses, tgetent, with_ncurses=yes, with_ncurses=no)
+ fi
+ if test "$with_ncurses" = "yes"; then
+ AC_DEFINE(HAVE_NCURSES)
+ AC_CHECK_HEADER(ncurses/curses.h, curses_h_path=ncurses/curses.h)
+ AC_CHECK_HEADER(ncurses/term.h, term_h_path=ncurses/term.h)
+ XE_ADD_OBJS(terminfo.o)
+ XE_PREPEND(-lncurses, LIBS)
+
+ if test "$ac_cv_header_ncurses_curses_h" != "yes" ; then
+ dnl Try again, and check for the bogus ncurses/ include bug.
+ dnl (i.e. ncurses/curses.h bogusly includes <unctrl.h> instead of
+ dnl <ncurses/unctrl.h>)
+ save_c_switch_site="$c_switch_site"
+ c_switch_site="$c_switch_site -I/usr/include/ncurses"
+ AC_CHECK_HEADER(ncurses/curses.h, curses_h_path=ncurses/curses.h)
+ if test "$ac_cv_header_ncurses_curses_h" = "yes"
+ then AC_MSG_WARN("Your system has the bogus ncurses include bug.")
+ else c_switch_site="$save_c_switch_site"
+ fi
+ fi
+ else dnl "$with_ncurses" = "no"
+ dnl Autodetect terminfo/-lcurses/-ltermlib/-ltermcap
+ if test "$have_terminfo" = "yes"; then
+ XE_ADD_OBJS(terminfo.o)
+ if test -n "$libs_termcap"; then
+ XE_PREPEND($libs_termcap, LIBS)
+ else
+ for lib in curses termlib termcap; do
+ AC_CHECK_LIB($lib, tgetent, XE_PREPEND(-l${lib}, LIBS); break)
+ done
+ fi
+ else dnl "$have_terminfo" = "no" && "with_ncurses" = "no"
+ XE_ADD_OBJS(tparam.o)
+ dnl The HP-UX curses library seems to have a badly broken version of select(2)
+ dnl that makes "poll: interrupted system call" messages to appear and
+ dnl Emacs suprocesses to hang (e.g. TeX compilation w/ AUCTeX) */
+ case "$opsys" in *-hp-hpux* ) libs_termcap="-ltermcap" ;; esac
+ if test -n "$libs_termcap"; then
+ XE_PREPEND($libs_termcap, LIBS)
+ else
+ AC_CHECK_LIB(curses, tgetent, XE_PREPEND(-lcurses, LIBS),
+ AC_CHECK_LIB(termcap, tgetent, XE_PREPEND(-ltermcap, LIBS),
+ XE_ADD_OBJS(termcap.o)))
+ fi
+ fi
+ fi
+ AC_DEFINE_UNQUOTED(CURSES_H_PATH, "${curses_h_path-curses.h}")
+ AC_DEFINE_UNQUOTED(TERM_H_PATH, "${term_h_path-term.h}")
+
+ dnl Autodetect gpm
+ test -z "$with_gpm" && { AC_CHECK_HEADER(gpm.h, , with_gpm=no) }
+ test -z "$with_gpm" && { AC_CHECK_LIB(gpm, Gpm_Open, with_gpm=yes, with_gpm=no) }
+ if test "$with_gpm" = "yes"; then
+ AC_DEFINE(HAVE_GPM)
+ XE_ADD_OBJS(gpmevent.o)
+ XE_PREPEND(-lgpm, LIBS)
+ fi
+
+else dnl "$with_tty" = "no"
+ for feature in ncurses gpm; do
+ if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then
+ AC_MSG_WARN("--with-${feature} ignored: Not valid without TTY support")
+ fi
+ eval "with_${feature}=no"
+ done
+fi dnl with_tty
+
+dnl Do we need event-unixoid.o ?
+test "$with_x11" = "yes" -o "$with_tty" = "yes" && XE_ADD_OBJS(event-unixoid.o)
+
+dnl Database support
+dnl <mdiers@logware.de>
+dnl We do not necessarily have to have libdb/lib(g)dbm for DB/(G)DBM support.
+dnl On FreeBSD, both DB and DBM are part of libc.
+dnl Note that unless support for DB/(G)DBM is explicitly disabled, we always
+dnl want to check for libdb/lib(g)dbm. Also note that libc will not be
+dnl checked if we have the libraries.
+dnl If support for DB/(G)DBM is requested, but we neither have libdb/lib(g)dbm,
+dnl nor does libc implement it, we are a bit lost :)
+
+AC_CHECKING(for database support)
+
+if test "$with_database_gnudbm" != "no"; then
+ AC_CHECK_HEADERS(ndbm.h, have_ndbm_h=yes)
+ if test "$have_ndbm_h" = "yes"; then
+ AC_CHECK_LIB(gdbm, dbm_open, with_database_gnudbm=yes have_libgdbm=yes)
+ fi
+ if test "$with_database_gnudbm" != "yes"; then
+ AC_CHECK_FUNC(dbm_open, with_database_gnudbm=yes)
+ fi
+ if test "$with_database_gnudbm" = "yes"; then
+ AC_DEFINE(HAVE_DBM)
+ test "$have_libgdbm" = "yes" && XE_PREPEND(-lgdbm, LIBS)
+ with_database_dbm=no
+ else with_database_gnudbm=no
+ fi
+fi
+
+if test "$with_database_dbm" != "no"; then
+ AC_CHECK_FUNC(dbm_open, with_database_dbm=yes need_libdbm=no)
+ if test "$need_libdbm" != "no"; then
+ AC_CHECK_LIB(dbm, dbm_open, with_database_dbm=yes need_libdbm=yes)
+ fi
+ if test "$with_database_dbm" = "yes"; then
+ AC_DEFINE(HAVE_DBM)
+ test "$need_libdbm" = "yes" && XE_PREPEND(-ldbm, LIBS)
+ else with_database_dbm=no
+ fi
+fi
+
+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
+#define __BIT_TYPES_DEFINED__
+#include <inttypes.h>
+typedef uint8_t u_int8_t;
+typedef uint16_t u_int16_t;
+typedef uint32_t u_int32_t;
+#ifdef WE_DONT_NEED_QUADS
+typedef uint64_t u_int64_t;
+#endif
+#endif
+#include <$path>
+],[], db_h_path="$path"; break)
+ done
+ if test -z "$db_h_path"
+ then AC_MSG_RESULT(no); with_database_berkdb=no
+ else AC_MSG_RESULT($db_h_path)
+ fi
+
+ if test "$with_database_berkdb" != "no"; then
+ AC_MSG_CHECKING(for Berkeley DB version)
+ AC_EGREP_CPP(yes,
+[#include <$db_h_path>
+#if DB_VERSION_MAJOR > 1
+yes
+#endif
+], [AC_MSG_RESULT(2); dbfunc=db_open], [AC_MSG_RESULT(1); dbfunc=dbopen])
+ AC_CHECK_FUNC($dbfunc, with_database_berkdb=yes need_libdb=no, [
+ AC_CHECK_LIB(db, $dbfunc, with_database_berkdb=yes need_libdb=yes)])
+ fi
+
+ if test "$with_database_berkdb" = "yes"; then
+ AC_DEFINE_UNQUOTED(DB_H_PATH, "$db_h_path")
+ AC_DEFINE(HAVE_BERKELEY_DB)
+ test "$need_libdb" = "yes" && XE_PREPEND(-ldb, LIBS)
+ else with_database_berkdb=no
+ fi
+fi
+
+if test "$with_database_gnudbm $with_database_dbm $with_database_berkdb" \
+ != "no no no"; then
+ AC_DEFINE(HAVE_DATABASE)
+ XE_ADD_OBJS(database.o)
+fi
+
+dnl Socks support
+if test "$with_socks" = "yes"; then
+ AC_CHECK_LIB(socks, SOCKSinit)
+ test -n "$ac_cv_lib_socks_SOCKSinit" && AC_DEFINE(HAVE_SOCKS)
+fi
+
+dnl Usage tracking (undocumented and likely unused option)
+if test "$usage_tracking" = "yes"; then
+ AC_DEFINE(USAGE_TRACKING)
+ XE_PREPEND(-Bstatic -lut -Bdynamic, LIBS)
+fi
+
+dnl autodetect dll support
+AC_CHECK_HEADERS(dlfcn.h, have_dlfcn=yes)
+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
+ AC_DEFINE(HAVE_SHLIB)
+ XE_ADD_OBJS(sysdll.o)
+ XE_ADD_OBJS(dll.o)
+ test ! -z "$DLL_LIB" && XE_PREPEND(-l${DLL_LIB}, LIBS)
+ XE_MAKE_SHAREDLIB
+ AC_CHECK_FUNCS(dlerror)
+ ld_dynamic_link_flags=
+ dnl Fill this in with other values as this gets more testing
+ case "$opsys" in
+ hpux*) ld_dynamic_link_flags="-Wl,-E" ;;
+ linux*) ld_dynamic_link_flags="-rdynamic" ;;
+ *) ;;
+ esac
+fi
+
+dnl Unfortunately, just because we can link doesn't mean we can run.
+dnl One of the above link tests may have succeeded but caused resulting
+dnl executables to fail to run. Also any tests using AC_TRY_RUN will
+dnl have reported incorrect results.
+AC_TRY_RUN([int main(int c,char *v[]){return 0;}],[:],[
+ echo ""
+ echo "*** PANIC *** The C compiler can no longer build working executables."
+ echo "*** PANIC *** Please examine the tail of config.log for runtime errors."
+ echo "*** PANIC *** The most likely reason for this problem is that configure"
+ echo "*** PANIC *** links with shared libraries, but those libraries cannot be"
+ echo "*** PANIC *** found at run time."
+ echo "*** PANIC ***"
+ echo "*** PANIC *** On a Linux system, edit /etc/ld.so.conf and re-run ldconfig."
+ echo "*** PANIC *** On other systems, try telling configure where to find the"
+ echo "*** PANIC *** shared libraries using the --site-runtime-libraries option"
+ echo "*** PANIC ***"
+ echo "*** PANIC *** Another way to shoot yourself in the foot is to specify"
+ echo "*** PANIC *** --with-FEATURE when FEATURE is not actually installed"
+ 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 --------------------------------
+dnl Compute SUBST-itutable variables
+dnl --------------------------------
+
+dnl We ignore (C|LD)_SWITCH_X_(MACHINE|SYSTEM)
+dnl Use XE_SPACE instead of plain assignment statements to remove extraneous blanks
+XE_SPACE(CFLAGS, $CFLAGS)
+XE_SPACE(extra_objs, $extra_objs)
+XE_SPACE(c_switch_general, -DHAVE_CONFIG_H $c_switch_site $c_switch_machine $c_switch_system)
+XE_SPACE(c_switch_window_system, $c_switch_x_site $X_CFLAGS)
+XE_SPACE(c_switch_all, $c_switch_general $c_switch_window_system)
+XE_SPACE(ld_switch_general, $ld_switch_site $ld_switch_machine $ld_switch_system $ld_switch_run)
+XE_SPACE(ld_switch_window_system, $ld_switch_x_site)
+XE_SPACE(ld_switch_all, $ld_switch_general $ld_switch_window_system)
+XE_SPACE(ld_libs_general, $LIBS $libs_machine $libs_system $libs_standard)
+XE_SPACE(ld_libs_window_system, $X_EXTRA_LIBS $libs_x $X_PRE_LIBS)
+XE_SPACE(ld_libs_all, $ld_libs_window_system $ld_libs_general)
+
+dnl Compute lists of Makefiles and subdirs
+AC_SUBST(SRC_SUBDIR_DEPS)
+XE_APPEND(src, MAKE_SUBDIR)
+internal_makefile_list="Makefile"
+SUBDIR_MAKEFILES=''
+test -d lock || mkdir lock
+for dir in $MAKE_SUBDIR; do
+ case "$dir" in */* ) dnl Implement mkdir -p
+ ( for d in `echo $dir | sed 's:/: :g'` ; do
+ test -d "$d" || mkdir "$d"; cd "$d"
+ done ) ;;
+ * ) test -d "$dir" || mkdir "$dir" ;;
+ esac
+ XE_SPACE(SUBDIR_MAKEFILES, $SUBDIR_MAKEFILES $dir/Makefile)
+ XE_SPACE(internal_makefile_list, $internal_makefile_list $dir/Makefile.in)
+done
+AC_SUBST(INSTALL_ARCH_DEP_SUBDIR)
+AC_SUBST(MAKE_SUBDIR)
+AC_SUBST(SUBDIR_MAKEFILES)
+
+dnl Make s&m symlinks in the src directory, for config.h
+for dir in src/s src/m; do
+ if test ! -d "$dir" ; then
+ echo Making symbolic link to "$srcdir/$dir"
+ ${LN_S} "$srcdir/$dir" "$dir"
+ fi
+done
+
+if test "$extra_verbose" = "yes"; then
+ echo ""
+ PRINT_VAR(extra_objs
+ c_switch_general c_switch_window_system c_switch_all
+ ld_switch_general ld_switch_window_system ld_switch_all
+ ld_libs_general ld_libs_window_system ld_libs_all)
+ 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
+fi
+
+dnl Create top level .sbinit for Sun compilers
+if test "$__sunpro_c" = "yes"; then
+ echo "creating .sbinit"; echo ""
+ ( 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
+ ) > .sbinit
+fi
+
+dnl There are no more compile tests; remove the core they created.
+rm -f core
+
+dnl ----------------------------------------------
+dnl Substitute into Makefile, config.h and paths.h
+dnl ----------------------------------------------
+
+dnl what sort of things to edit into Makefile, config.h and paths.h
+dnl configuration here uncanonicalized to avoid exceeding size limits.
+
+AC_SUBST(PROGNAME)
+AC_SUBST(version)
+AC_SUBST(configuration)
+AC_SUBST(canonical)
+AC_SUBST(srcdir)
+AC_SUBST(bindir)
+AC_SUBST(datadir)
+AC_SUBST(pkgdir)
+AC_SUBST(statedir)
+AC_SUBST(libdir)
+AC_SUBST(mandir)
+
+AC_SUBST(prefix)
+dnl Yo, Stephen Bourne! I want to marry you!
+PREFIX=$prefix
+while true; do
+ case "$PREFIX" in
+ *\$* ) eval "PREFIX=$PREFIX" ;;
+ *) break ;;
+ esac
+done
+AC_SUBST(PREFIX)
+
+AC_SUBST(exec_prefix)
+EXEC_PREFIX=$exec_prefix
+while true; do
+ case "$EXEC_PREFIX" in
+ *\$* ) eval "EXEC_PREFIX=$EXEC_PREFIX" ;;
+ *) break ;;
+ esac
+done
+AC_SUBST(EXEC_PREFIX)
+
+AC_SUBST(infodir)
+AC_SUBST(INFODIR_USER_DEFINED)
+INFODIR=$infodir
+while true; do
+ case "$INFODIR" in
+ *\$* ) eval "INFODIR=$INFODIR" ;;
+ *) break ;;
+ esac
+done
+AC_SUBST(INFODIR)
+
+AC_SUBST(infopath)
+AC_SUBST(INFOPATH_USER_DEFINED)
+INFOPATH=$infopath
+while true; do
+ case "$INFOPATH" in
+ *\$* ) eval "INFOPATH=$INFOPATH" ;;
+ *) break ;;
+ esac
+done
+AC_SUBST(INFOPATH)
+
+AC_SUBST(package_path)
+AC_SUBST(PACKAGE_PATH_USER_DEFINED)
+PACKAGE_PATH=$package_path
+while true; do
+ case "$PACKAGE_PATH" in
+ *\$* ) eval "PACKAGE_PATH=$PACKAGE_PATH" ;;
+ *) break ;;
+ esac
+done
+AC_SUBST(PACKAGE_PATH)
+
+AC_SUBST(lispdir)
+AC_SUBST(LISPDIR_USER_DEFINED)
+LISPDIR=$lispdir
+while true; do
+ case "$LISPDIR" in
+ *\$* ) eval "LISPDIR=$LISPDIR" ;;
+ *) break ;;
+ esac
+done
+AC_SUBST(LISPDIR)
+
+dnl AC_SUBST(sitelispdir)
+dnl AC_SUBST(SITELISPDIR_USER_DEFINED)
+dnl SITELISPDIR=$sitelispdir
+dnl while true; do
+dnl case "$SITELISPDIR" in
+dnl *\$* ) eval "SITELISPDIR=$SITELISPDIR" ;;
+dnl *) break ;;
+dnl esac
+dnl done
+dnl AC_SUBST(SITELISPDIR)
+
+AC_SUBST(etcdir)
+AC_SUBST(ETCDIR_USER_DEFINED)
+ETCDIR=$etcdir
+while true; do
+ case "$ETCDIR" in
+ *\$* ) eval "ETCDIR=$ETCDIR" ;;
+ *) break ;;
+ esac
+done
+AC_SUBST(ETCDIR)
+
+AC_SUBST(lockdir)
+AC_SUBST(LOCKDIR_USER_DEFINED)
+LOCKDIR=$lockdir
+while true; do
+ case "$LOCKDIR" in
+ *\$* ) eval "LOCKDIR=$LOCKDIR" ;;
+ *) break ;;
+ esac
+done
+AC_SUBST(LOCKDIR)
+
+AC_SUBST(archlibdir)
+AC_SUBST(ARCHLIBDIR_USER_DEFINED)
+ARCHLIBDIR=$archlibdir
+while true; do
+ case "$ARCHLIBDIR" in
+ *\$* ) eval "ARCHLIBDIR=$ARCHLIBDIR" ;;
+ *) break ;;
+ esac
+done
+AC_SUBST(ARCHLIBDIR)
+
+AC_SUBST(docdir)
+AC_SUBST(bitmapdir)
+AC_SUBST(extra_objs)
+AC_SUBST(ld_dynamic_link_flags)
+
+dnl The following flags combine all the information from:
+dnl - command line options (user always gets priority)
+dnl - user environment variables
+dnl - determined by configure
+dnl - the s&m header files (deprecated)
+AC_SUBST(machfile)
+AC_SUBST(opsysfile)
+AC_SUBST(c_switch_general)
+AC_SUBST(c_switch_window_system)
+AC_SUBST(c_switch_all)
+AC_SUBST(ld_switch_general)
+AC_SUBST(ld_switch_window_system)
+AC_SUBST(ld_switch_all)
+AC_SUBST(ld_libs_general)
+AC_SUBST(ld_libs_window_system)
+AC_SUBST(ld_libs_all)
+AC_SUBST(CFLAGS)
+AC_SUBST(CPPFLAGS)
+AC_SUBST(LDFLAGS)
+RECURSIVE_MAKE="\$(MAKE) \$(MFLAGS) CC='\$(CC)' CFLAGS='\$(CFLAGS)' LDFLAGS='\$(LDFLAGS)' CPPFLAGS='\$(CPPFLAGS)'"
+AC_SUBST(RECURSIVE_MAKE)
+
+AC_SUBST(native_sound_lib)
+AC_SUBST(sound_cflags)
+AC_SUBST(RANLIB)
+AC_SUBST(dynodump_arch)
+
+# The default is yes
+if test "$with_site_lisp" = "no"; then
+ AC_DEFINE(INHIBIT_SITE_LISP)
+fi
+
+XE_SPACE(ac_configure_args, $ac_configure_args)
+AC_DEFINE_UNQUOTED(EMACS_CONFIGURATION, "$canonical")
+AC_DEFINE_UNQUOTED(EMACS_CONFIG_OPTIONS, "$ac_configure_args")
+AC_DEFINE_UNQUOTED(config_machfile, "$machfile")
+AC_DEFINE_UNQUOTED(config_opsysfile, "$opsysfile")
+
+dnl Following are deprecated
+
+null_string=""
+AC_DEFINE_UNQUOTED(LD_SWITCH_X_SITE, $null_string)
+AC_DEFINE_UNQUOTED(LD_SWITCH_X_SITE_AUX, $null_string)
+AC_DEFINE_UNQUOTED(C_SWITCH_X_SITE, $null_string)
+AC_DEFINE_UNQUOTED(LD_SWITCH_SITE, $null_string)
+AC_DEFINE_UNQUOTED(C_SWITCH_SITE, $null_string)
+
+dnl Note: as a general rule, *only* define things here that are not
+dnl autodetected. For things that are autodetected, define them
+dnl at the point where the autodetection occurs or would occur,
+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)
+ AC_DEFINE(USE_SYSTEM_MALLOC)
+fi
+test "$with_i18n3" = "yes" && AC_DEFINE(I18N3)
+test "$GCC" = "yes" && AC_DEFINE(USE_GCC)
+test "$external_widget" = "yes" && AC_DEFINE(EXTERNAL_WIDGET)
+test "$with_gnu_make" = "yes" && AC_DEFINE(USE_GNU_MAKE)
+test "$no_doc_file" = "yes" && AC_DEFINE(NO_DOC_FILE)
+dnl test "$const_is_losing" = "yes" && AC_DEFINE(CONST_IS_LOSING)
+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)
+
+dnl -------------------------------
+dnl Report on what we decided to do
+dnl -------------------------------
+
+(
+dnl /etc/osversion is on SONY NEWS-OS
+if test -f /etc/osversion; then dnl SONY NEWS-OS
+ echo "osversion: `cat /etc/osversion`"
+else
+ echo "uname -a: `uname -a`"
+fi
+echo ""
+echo "$0 $quoted_arguments"
+) > Installation
+
+xemacs_betaname=""
+test ! -z "${emacs_beta_version}" && xemacs_betaname="-b${emacs_beta_version}"
+
+dnl Start stdout redirection to '| tee -a Installation'
+(
+echo "
+
+XEmacs ${emacs_major_version}.${emacs_minor_version}${xemacs_betaname} \"$xemacs_codename\" configured for \`$canonical'.
+
+ Where should the build process find the source code? $srcdir
+ What installation prefix should install use? $prefix
+ What operating system and machine description files should XEmacs use?
+ \`$opsysfile' and \`$machfile'
+ What compiler should XEmacs be built with? $CC $CFLAGS
+ Should XEmacs use the GNU version of malloc? ${GNU_MALLOC}${GNU_MALLOC_reason}
+ Should XEmacs use the relocating allocator for buffers? $rel_alloc
+ What window system should XEmacs use? ${window_system}"
+if test "$with_x11" = "yes"; then
+ echo " Where do we find X Windows header files? $x_includes"
+ echo " Where do we find X Windows libraries? $x_libraries"
+fi
+if test -n "$site_includes"; then
+ echo " Additional header files: $site_includes"
+fi
+if test -n "$site_libraries"; then
+ echo " Additional libraries: $site_libraries"
+fi
+if test -n "$site_prefixes"; then
+ echo " Additional prefixes: $site_prefixes"
+fi
+if test -n "$runpath"; then
+ echo " Runtime library search path: $runpath"
+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."
+if test "$with_xmu" != yes -a "$with_x11" = yes; then
+ echo " No Xmu; substituting equivalent routines."
+fi
+
+if test "$with_xpm" = yes; then
+ echo " Compiling in support for XPM images."
+elif test "$with_x11" = yes; then
+ echo " --------------------------------------------------------------------"
+ echo " WARNING: Compiling without XPM support."
+ echo " WARNING: You should strongly considering installing XPM."
+ echo " WARNING: Otherwise toolbars and other graphics will look suboptimal."
+ echo " --------------------------------------------------------------------"
+fi
+test "$with_xface" = yes && echo " Compiling in support for X-Face message headers."
+test "$with_gif" = yes && echo " Compiling in support for GIF image conversion."
+test "$with_jpeg" = yes && echo " Compiling in support for JPEG image conversion."
+test "$with_png" = yes && echo " Compiling in support for PNG image conversion."
+test "$with_tiff" = yes && echo " Compiling in support for TIFF image conversion."
+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_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_ncurses" = yes && echo " Compiling in support for ncurses."
+test "$with_gpm" = yes && echo " Compiling in support for GPM (General Purpose Mouse)."
+
+test "$with_mule" = yes && echo " Compiling in Mule (multi-lingual) support."
+test "$with_file_coding" = yes && echo " Compiling in File coding support."
+test "$with_xim" != no && echo " Compiling in XIM (X11R5+ I18N input method) support."
+test "$with_xim" = motif && echo " Using Motif to provide XIM support."
+test "$with_xim" = xlib && echo " Using raw Xlib to provide XIM support."
+test "$with_xfs" = yes && echo " Using XFontSet to provide bilingual menubar."
+test "$with_canna" = yes && echo " Compiling in support for Canna on Mule."
+if test "$with_wnn" = yes; then
+ echo " Compiling in support for the WNN input method on Mule."
+ test "$with_wnn6" = yes && echo " Using WNN version 6."
+fi
+test "$with_i18n3" = yes && echo " Compiling in I18N support, level 3 (doesn't currently work)."
+
+test "$with_cde" = yes && echo " Compiling in support for CDE."
+test "$with_tooltalk" = yes && echo " Compiling in support for ToolTalk."
+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."
+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'." ;;
+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." ;;
+esac
+case "$with_dialogs" in
+ motif ) echo " Using Motif dialog boxes." ;;
+ athena ) echo " Using Athena dialog boxes." ;;
+ athena3d ) echo " Using Athena-3d dialog boxes." ;;
+esac
+test "$with_shlib" = "yes" && echo " Compiling in DLL 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."
+test "$with_pop" = yes && echo " Using POP for mail access"
+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)."
+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: ---------------------------------------------------------"
+ echo " WARNING: Compiling in support for runtime error checking."
+ echo " WARNING: XEmacs will run noticeably more slowly as a result."
+ echo " WARNING: Error checking is on by default for XEmacs beta releases."
+ echo " WARNING: ---------------------------------------------------------"
+fi
+echo ""
+) | tee -a Installation
+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 -----------------------------------
+
+dnl This has to be called in order for this variable to get into config.status
+AC_SUBST(internal_makefile_list)
+# Remove any trailing slashes in these variables.
+test -n "$prefix" &&
+ prefix=`echo '' "$prefix" | sed -e 's:^ ::' -e 's,\([[^/]]\)/*$,\1,'`
+test -n "$exec_prefix" &&
+ exec_prefix=`echo '' "$exec_prefix" | sed -e 's:^ ::' -e 's,\([[^/]]\)/*$,\1,'`
+
+dnl Build Makefile.in's from Makefile.in.in's
+dnl except ./Makefile from $srcdir/Makefile.in
+
+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"
+done
+ac_output_files="$ac_output_files src/paths.h lib-src/config.values"
+
+AC_OUTPUT($ac_output_files,
+[for dir in $MAKE_SUBDIR; do
+ echo creating $dir/Makefile
+ (
+changequote(<<, >>)dnl
+ cd $dir
+ rm -f junk.c
+ < Makefile.in \
+ sed -e '/^# Generated/d' \
+ -e 's%/\*\*/#.*%%' \
+ -e 's/^ *# */#/' \
+ -e '/^##/d' \
+ -e '/^#/ {
+p
+d
+}' -e '/./ {
+s/\([\"]\)/\\\1/g
+s/^/"/
+s/$/"/
+}' > junk.c;
+ $CPP -I. -I${top_srcdir}/src $CPPFLAGS junk.c > junk.cpp;
+ < junk.cpp \
+ sed -e 's/^#.*//' \
+ -e 's/^[ TAB][ TAB]*$//' \
+ -e 's/^ /TAB/' \
+ | sed -n -e '/^..*$/p' \
+ | sed '/^"/ {
+s/\\\([\"]\)/\1/g
+s/^[ TAB]*"//
+s/"[ TAB]*$//
+}' > Makefile.new
+ chmod 444 Makefile.new
+ mv -f Makefile.new Makefile
+ rm -f junk.c junk.cpp
+changequote([, ])dnl
+)
+done
+
+dnl Append AC_DEFINE information to lib-src/config.values
+dnl (AC_SUBST information is already there (see config.values.sh).
+sed < config.status >> lib-src/config.values \
+ -e '/{ac_dA}.*{ac_dB}.*{ac_dC}.*{ac_dD}$/!d' \
+ -e 's/\${ac_dA}\(.*\)\${ac_dB}.*\${ac_dC}\(.*\)\${ac_dD}/\1 \2/' \
+ -e 's/^\([[^ ]]*\) $/\1 ""/' \
+ -e 's/ 1$/ t/'
+
+],
+[CPP="$CPP"
+ CPPFLAGS="$CPPFLAGS"
+ top_srcdir="$srcdir"
+ MAKE_SUBDIR="$MAKE_SUBDIR"
+])
--- /dev/null
+-----BEGIN PGP SIGNED MESSAGE-----
+
+;; Package Index file -- Do not edit manually.
+;;;@@@
+(package-get-update-base-entry (quote
+(zenirc
+ (standards-version 1.0
+ version "1.04"
+ author-version "2.112"
+ date "1998-08-15"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority medium
+ category "comm"
+ dump nil
+ description "ZENIRC IRC Client."
+ filename "zenirc-1.04-pkg.tar.gz"
+ md5sum "96d9e09c41de5c19d8aa092ad544ad6d"
+ size 276116
+ provides (zenirc)
+ requires (zenirc)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(w3
+ (standards-version 1.0
+ version "1.10"
+ author-version "4.0pre23"
+ date "1998-07-18"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution experimental
+ priority high
+ category "comm"
+ dump nil
+ description "A Web browser."
+ filename "w3-1.10-pkg.tar.gz"
+ md5sum "6113b455f82c5903b8bd6f4ca48afb00"
+ size 612442
+ provides (w3 url)
+ requires (w3 mail-lib xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(vm
+ (standards-version 1.0
+ version "1.14"
+ author-version "6.62"
+ date "1998-09-22"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority medium
+ category "comm"
+ dump nil
+ description "An Emacs mailer."
+ filename "vm-1.14-pkg.tar.gz"
+ md5sum "e59383b955243ca90581fd6854bb5eff"
+ size 548815
+ provides (vm)
+ requires (mail-lib xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(tm
+ (standards-version 1.0
+ version "1.15"
+ author-version "21.0"
+ date "1998-08-27"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "comm"
+ dump nil
+ description "Emacs MIME support."
+ filename "tm-1.15-pkg.tar.gz"
+ md5sum "7769db3ab1473811a0622742c3e9bf69"
+ size 329539
+ provides (tm tm-edit tm-view mime-setup)
+ requires (gnus mh-e rmail vm mailcrypt mail-lib apel xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(supercite
+ (standards-version 1.0
+ version "1.10"
+ author-version "3.55x2"
+ date "1998-08-9"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "comm"
+ dump nil
+ description "An Emacs citation tool for News & Mail messages."
+ filename "supercite-1.10-pkg.tar.gz"
+ md5sum "09dee2a7f1400bc8680ea067a2399dcb"
+ size 99403
+ provides (supercite)
+ requires (mail-lib xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(rmail
+ (standards-version 1.0
+ version "1.07"
+ author-version "21.0"
+ date "1998-06-28"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution contrib
+ priority low
+ category "comm"
+ dump nil
+ description "An obsolete Emacs mailer."
+ filename "rmail-1.07-pkg.tar.gz"
+ md5sum "0b256dc4b02e832d939850f86951217a"
+ size 96475
+ provides (rmail rmailsum)
+ requires (tm apel mail-lib xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(mew
+ (standards-version 1.0
+ version "1.04"
+ author-version "1.93b38"
+ date "1998-06-21"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution contrib
+ priority low
+ category "comm"
+ dump nil
+ description "Messaging in an Emacs World."
+ filename "mew-1.04-pkg.tar.gz"
+ md5sum "896793a5d91c0ecfe4af5a7351f82fb7"
+ size 517164
+ provides (mew)
+ requires (mew)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(net-utils
+ (standards-version 1.0
+ version "1.10"
+ author-version "21.0"
+ date "1998-07-01"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "comm"
+ dump nil
+ description "Miscellaneous Networking Utilities."
+ filename "net-utils-1.10-pkg.tar.gz"
+ md5sum "89f6d1830b90e701ab57fcadd7337bb8"
+ size 107129
+ provides (ilisp-browse-cltl2 emacsbug feedmail metamail net-utils rcompile shadowfile webjump webster-www)
+ requires (w3 efs mail-lib xemacs-base)
+ type single
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(mh-e
+ (standards-version 1.0
+ version "1.08"
+ author-version "21.0"
+ date "1998-07-12"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution contrib
+ priority low
+ category "comm"
+ dump nil
+ description "Front end support for MH."
+ filename "mh-e-1.08-pkg.tar.gz"
+ md5sum "f1995b0f516668922a5f4331d0c13187"
+ size 176392
+ provides (mh-e)
+ requires (mail-lib xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(mailcryptng
+ (standards-version 1.0
+ version "1.01"
+ author-version "3.5b7"
+ date "1998-10-10"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "comm"
+ dump nil
+ description "Support for messaging encryption with PGP."
+ filename "mailcryptng-1.01-pkg.tar.gz"
+ md5sum "70bbfabaa083dc3a6178aa2be979705e"
+ size 120414
+ provides (mailcrypt)
+ requires (gnus vm mail-lib fsf-compat xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(mailcrypt
+ (standards-version 1.0
+ version "1.06"
+ author-version "3.4"
+ date "1998-01-24"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "comm"
+ dump nil
+ description "Support for messaging encryption with PGP."
+ filename "mailcrypt-1.06-pkg.tar.gz"
+ md5sum "e601fc5c1f43c5b7f577c7262c7877a9"
+ size 106355
+ provides (mailcrypt)
+ requires (gnus vm mail-lib xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(irchat
+ (standards-version 1.0
+ version "1.03"
+ author-version "980625-2"
+ date "1998-09-08"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority medium
+ category "comm"
+ dump nil
+ description "ZENIRC IRC Client."
+ filename "irchat-1.03-pkg.tar.gz"
+ md5sum "9d066b2d79ab2dd5e01e1b8733289aa4"
+ size 219214
+ provides (irchat)
+ requires ()
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(gnats
+ (standards-version 1.0
+ version "1.07"
+ author-version "3.101"
+ date "1998-08-01"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority high
+ category "comm"
+ dump nil
+ description "XEmacs bug reports."
+ filename "gnats-1.07-pkg.tar.gz"
+ md5sum "40d23fbac2ea05d55be0d0822259b023"
+ size 189213
+ provides (gnats gnats-admin send-pr)
+ requires (mail-lib xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(footnote
+ (standards-version 1.0
+ version "1.07"
+ author-version "0.18x"
+ date "1998-08-27"
+ build-date "1998-10-12"
+ maintainer "SL Baur <steve@xemacs.org>"
+ distribution stable
+ priority low
+ category "comm"
+ dump nil
+ description "Footnoting in mail message editing modes."
+ filename "footnote-1.07-pkg.tar.gz"
+ md5sum "1064b49b7e13a467458af2bafd9e62fb"
+ size 13362
+ provides (footnote)
+ requires (mail-lib xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(eudc
+ (standards-version 1.0
+ version "1.24"
+ author-version "1.24"
+ date "1998-10-15"
+ build-date "1998-10-15"
+ maintainer "Oscar Figueiredo <Oscar.Figueiredo@epfl.ch>"
+ distribution stable
+ priority low
+ category "comm"
+ dump nil
+ description "Emacs Unified Directory Client (LDAP, PH)."
+ filename "eudc-1.24-pkg.tar.gz"
+ md5sum "43c173e7e052c81b196c617fb22b6e00"
+ size 50837
+ provides (eudc eudc-ldap eudc-ph)
+ requires (fsf-compat xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(bbdb
+ (standards-version 1.0
+ version "1.06"
+ author-version "2.00.02"
+ date "1998-10-08"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority medium
+ category "comm"
+ dump nil
+ description "The Big Brother Data Base"
+ filename "bbdb-1.06-pkg.tar.gz"
+ md5sum "4889d21fded3ae5cddee558e0d136a20"
+ size 281992
+ provides (bbdb)
+ requires (bbdb edit-utils gnus mh-e rmail supercite vm tm apel mail-lib xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(gnus
+ (standards-version 1.0
+ version "1.33"
+ author-version "5.6.44"
+ date "1998-09-25"
+ build-date "1998-10-15"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority medium
+ category "comm"
+ dump nil
+ description "The Gnus Newsreader and Mailreader."
+ filename "gnus-1.33-pkg.tar.gz"
+ md5sum "46a0466ec203cd7b0d78bfeb215a65f5"
+ size 1874633
+ provides (gnus message)
+ requires (gnus w3 mh-e mailcrypt rmail mail-lib xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(skk
+ (standards-version 1.0
+ version "1.11"
+ author-version "10.38"
+ date "1998-10-01"
+ build-date "1998-10-12"
+ maintainer "SL Baur <steve@altair.xemacs.org>"
+ distribution mule
+ priority medium
+ category "mule"
+ dump t
+ description "Japanese Language Input Method."
+ filename "skk-1.11-pkg.tar.gz"
+ md5sum "c158751b558299be9b5f8f9d10216a79"
+ size 1513975
+ provides (skk skk-tut)
+ requires (viper mule-base elib xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(mule-base
+ (standards-version 1.0
+ version "1.24"
+ author-version "21.0"
+ date "1998-08-12"
+ build-date "1998-10-12"
+ maintainer "SL Baur <steve@altair.xemacs.org>"
+ distribution mule
+ priority high
+ category "mule"
+ dump t
+ description "Basic Mule support, required for building with Mule."
+ filename "mule-base-1.24-pkg.tar.gz"
+ md5sum "9842af89469856fa1c7f3ed60c8c25cf"
+ size 508959
+ 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)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(egg-its
+ (standards-version 1.0
+ version "1.13"
+ author-version "21.0"
+ date "1998-08-11"
+ build-date "1998-10-15"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution mule
+ priority high
+ category "mule"
+ dump t
+ description "Wnn (4.2 and 6) support. SJ3 support."
+ filename "egg-its-1.13-pkg.tar.gz"
+ md5sum "e7a5d51eb734310b9bb151c4fba05868"
+ size 259686
+ 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
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(edict
+ (standards-version 1.0
+ version "1.06"
+ author-version "0.9.8"
+ date "1998-07-23"
+ build-date "1998-10-12"
+ maintainer "Stephen J. Turnbull <turnbull@sk.tsukuba.ac.jp>"
+ distribution mule
+ priority high
+ category "mule"
+ dump nil
+ description "Lisp Interface to EDICT, Kanji Dictionary"
+ filename "edict-1.06-pkg.tar.gz"
+ md5sum "d9ba0f5372b2b83fe1499d1462dad3ca"
+ size 68008
+ provides (dui-registry dui edict-edit edict-english edict-japanese edict-morphology edict-test edict ts-mode)
+ requires (mule-base xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(leim
+ (standards-version 1.0
+ version "1.11"
+ author-version "21.0"
+ date "1998-07-23"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution mule
+ priority medium
+ category "mule"
+ dump nil
+ description "Quail. All non-English and non-Japanese language support."
+ filename "leim-1.11-pkg.tar.gz"
+ md5sum "19f4745d0364b46c7526a34777c653e5"
+ size 1670560
+ provides ()
+ requires (mule-base fsf-compat xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(locale
+ (standards-version 1.0
+ version "1.10"
+ author-version "21.0"
+ date "1998-07-24"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution mule
+ priority high
+ category "mule"
+ dump nil
+ description "Localized menubars and localized splash screens."
+ filename "locale-1.10-pkg.tar.gz"
+ md5sum "8439f2d7e266f3e4c2f18a19aa967202"
+ size 32709
+ provides ()
+ requires (mule-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(time
+ (standards-version 1.0
+ version "1.06"
+ author-version "1.17"
+ date "1998-04-24"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority medium
+ category "oa"
+ dump nil
+ description "Display time & date on the modeline."
+ filename "time-1.06-pkg.tar.gz"
+ md5sum "f55965f3ef08e038bd58ca8f4fb83fe6"
+ size 20018
+ provides (time)
+ requires (xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(text-modes
+ (standards-version 1.0
+ version "1.13"
+ author-version "21.0"
+ date "1998-09-24"
+ build-date "1998-10-15"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority high
+ category "oa"
+ dump nil
+ description "Miscellaneous support for editing text files."
+ filename "text-modes-1.13-pkg.tar.gz"
+ md5sum "3209269c42e32e39f70259cb68855e4f"
+ size 195165
+ 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
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(strokes
+ (standards-version 1.0
+ version "1.03"
+ author-version "21.0"
+ date "1998-01-25"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority medium
+ category "oa"
+ dump nil
+ description "Mouse enhancement utility."
+ filename "strokes-1.03-pkg.tar.gz"
+ md5sum "170257302196f106a54eb6dcf32fcc7a"
+ size 43480
+ provides (strokes)
+ requires (text-modes edit-utils mail-lib xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(speedbar
+ (standards-version 1.0
+ version "1.10"
+ author-version "0.6.2x"
+ date "1998-10-02"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "oa"
+ dump nil
+ description "Provides a seperate frame with convenient references."
+ filename "speedbar-1.10-pkg.tar.gz"
+ md5sum "eab230ae2aa7d6ed5739f46ec4099dcf"
+ size 64861
+ provides (speedbar)
+ requires (xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(slider
+ (standards-version 1.0
+ version "1.08"
+ author-version "0.3x1"
+ date "1998-08-13"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution experimental
+ priority low
+ category "oa"
+ dump nil
+ description "User interface tool."
+ filename "slider-1.08-pkg.tar.gz"
+ md5sum "8d2fe53d7d58fa0af58ac0359caccaca"
+ size 12018
+ provides (slider color-selector)
+ requires ()
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(sgml
+ (standards-version 1.0
+ version "1.03"
+ author-version "21.0"
+ date "1998-01-25"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution contrib
+ priority low
+ category "oa"
+ dump nil
+ description "SGML/Linuxdoc-SGML editing."
+ filename "sgml-1.03-pkg.tar.gz"
+ md5sum "317c7f52a3215f53e964ad90f9c40909"
+ size 26928
+ provides (sgml linuxdoc-sgml)
+ requires (xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(psgml
+ (standards-version 1.0
+ version "1.10"
+ author-version "1.01"
+ date "1998-07-06"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority medium
+ category "oa"
+ dump nil
+ description "Validated HTML/SGML editing."
+ filename "psgml-1.10-pkg.tar.gz"
+ md5sum "15e584b90a2d2310a2be15ea2aa0717a"
+ size 424930
+ provides (psgml sgml)
+ requires (edit-utils)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(pc
+ (standards-version 1.0
+ version "1.13"
+ author-version "21.0"
+ date "1998-07-25"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "oa"
+ dump nil
+ description "PC style interface emulation."
+ filename "pc-1.13-pkg.tar.gz"
+ md5sum "e5355fb82d1dbd77ad522bffb334168d"
+ size 16306
+ provides (delbs fusion pc-select pending-del s-region)
+ requires (xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(ispell
+ (standards-version 1.0
+ version "1.12"
+ author-version "3.0x2"
+ date "1998-09-15"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "oa"
+ dump nil
+ description "Spell-checking with GNU ispell."
+ filename "ispell-1.12-pkg.tar.gz"
+ md5sum "5786e4688024aae78fe75a5cbf92c446"
+ size 67168
+ provides (ispell)
+ requires ()
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(hm--html-menus
+ (standards-version 1.0
+ version "1.08"
+ author-version "5.9"
+ date "1998-01-25"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "oa"
+ dump nil
+ description "HTML editing."
+ filename "hm--html-menus-1.08-pkg.tar.gz"
+ md5sum "1f0fda934b84c5eed96fcfd02a046398"
+ size 168017
+ provides (adapt hm--date hm--html-configuration hm--html-drag-and-drop hm--html-indentation hm--html-keys hm--html-menu hm--html-mode hm--html-not-standard hm--html html-view tmpl-minor-mode)
+ requires (xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(frame-icon
+ (standards-version 1.0
+ version "1.05"
+ author-version "21.0"
+ date "1998-07-14"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution contrib
+ priority low
+ category "oa"
+ dump nil
+ description "Set up mode-specific icons for each frame under XEmacs"
+ filename "frame-icon-1.05-pkg.tar.gz"
+ md5sum "3d1a67ba8a51f74746ecb14385a025ef"
+ size 33490
+ provides (forms forms-mode)
+ requires ()
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(forms
+ (standards-version 1.0
+ version "1.08"
+ author-version "2.10"
+ date "1998-01-25"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution contrib
+ priority low
+ category "oa"
+ dump nil
+ description "Forms editing support (obsolete, use Widget instead)."
+ filename "forms-1.08-pkg.tar.gz"
+ md5sum "8af074cfc164331838bc83eb79eed3b5"
+ size 47670
+ provides (forms forms-mode)
+ requires ()
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(edit-utils
+ (standards-version 1.0
+ version "1.33"
+ author-version "21.0"
+ date "1998-09-29"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority high
+ category "oa"
+ dump nil
+ description "Miscellaneous editor extensions, you probably need this."
+ filename "edit-utils-1.33-pkg.tar.gz"
+ md5sum "0aa0b5d2864dc02a62fb6e87880c4733"
+ size 564543
+ 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
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(calendar
+ (standards-version 1.0
+ version "1.08"
+ author-version "21.0"
+ date "1998-09-01"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "oa"
+ dump nil
+ description "Calendar and diary support."
+ filename "calendar-1.08-pkg.tar.gz"
+ md5sum "afe4b31eb98b130960046bb3c2385ed3"
+ size 248313
+ 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
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(calc
+ (standards-version 1.0
+ version "1.09"
+ author-version "2.02fX3"
+ date "1998-07-25"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "oa"
+ dump nil
+ description "Emacs calculator"
+ filename "calc-1.09-pkg.tar.gz"
+ md5sum "f0eb907a308a96da7ac5c3fc8c7d8bea"
+ size 1616564
+ provides (calc)
+ requires ()
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(vhdl
+ (standards-version 1.0
+ version "1.06"
+ author-version "2.74"
+ date "1998-01-24"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "prog"
+ dump nil
+ description "Support for VHDL."
+ filename "vhdl-1.06-pkg.tar.gz"
+ md5sum "b6f786b7f682f76d57eeb94d3c917e56"
+ size 65943
+ provides (vhdl-mode)
+ requires ()
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(vc-cc
+ (standards-version 1.0
+ version "1.09"
+ author-version "21.0"
+ date "1998-07-24"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution contrib
+ priority low
+ category "prog"
+ dump nil
+ description "Version Control for ClearCase (UnFree) systems."
+ filename "vc-cc-1.09-pkg.tar.gz"
+ md5sum "43f4947aeb368164aada9dc2df827ce7"
+ size 96473
+ provides (vc)
+ requires (dired xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(vc
+ (standards-version 1.0
+ version "1.14"
+ author-version "21.0"
+ date "1998-10-07"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "prog"
+ dump nil
+ description "Version Control for Free systems."
+ filename "vc-1.14-pkg.tar.gz"
+ md5sum "64c350d9c5280e7545e3dc3936992a8a"
+ size 83885
+ provides (vc)
+ requires (dired xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(sh-script
+ (standards-version 1.0
+ version "1.07"
+ author-version "2.0e"
+ date "1998-05-12"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "prog"
+ dump nil
+ description "Support for editing shell scripts."
+ filename "sh-script-1.07-pkg.tar.gz"
+ md5sum "c5dd114d8e925fc7c8ec6d9130489421"
+ size 33895
+ provides (sh-script executable)
+ requires (xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(scheme
+ (standards-version 1.0
+ version "1.06"
+ author-version "21.0"
+ date "1998-09-08"
+ build-date "1998-10-11"
+ maintainer "Karl M. Hegbloom <karlheg@bittersweet.inetarena.com>"
+ distribution contrib
+ priority low
+ category "prog"
+ dump nil
+ description "Front-end support for Inferior Scheme."
+ filename "scheme-1.06-pkg.tar.gz"
+ md5sum "86edb18517b7ed62929041c55ea68927"
+ size 36321
+ provides (scheme xscheme cmuscheme cmuscheme48)
+ requires (xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(prog-modes
+ (standards-version 1.0
+ version "1.13"
+ author-version "21.0"
+ date "1998-10-15"
+ build-date "1998-10-15"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority medium
+ category "prog"
+ dump nil
+ description "Support for various programming languages."
+ filename "prog-modes-1.13-pkg.tar.gz"
+ md5sum "6e78de455277b0fe757931532ca56a88"
+ size 574269
+ 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-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(pcl-cvs
+ (standards-version 1.0
+ version "1.34"
+ author-version "R-2_0-Beta_2"
+ date "1998-10-12"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "prog"
+ dump nil
+ description "CVS frontend."
+ filename "pcl-cvs-1.34-pkg.tar.gz"
+ md5sum "6a3f944402c486679e7cb33f60b8689b"
+ size 161529
+ provides (pcl-cvs generic-sc)
+ requires (xemacs-base elib dired)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(jde
+ (standards-version 1.0
+ version "1.06"
+ author-version "2.05"
+ date "1998-07-09"
+ build-date "1998-10-11"
+ maintainer "Andy Piper <andyp@parallax.co.uk>"
+ distribution stable
+ priority medium
+ category "prog"
+ dump nil
+ description "Java language and development support."
+ filename "jde-1.06-pkg.tar.gz"
+ md5sum "402a03ac6482ee28a586ee41164cf4f5"
+ size 126911
+ provides (jde)
+ requires (cc-mode debug speedbar edit-utils mail-lib xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(emerge
+ (standards-version 1.0
+ version "1.04"
+ author-version "21.0"
+ date "1998-04-07"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "prog"
+ dump nil
+ description "Another interface over GNU patch."
+ filename "emerge-1.04-pkg.tar.gz"
+ md5sum "681e35d3a0c167782db2e93f37ee3147"
+ size 60972
+ provides (emerge)
+ requires ()
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(ediff
+ (standards-version 1.0
+ version "1.13"
+ author-version "2.71"
+ date "up-mess): "
+ build-date "1998-10-15"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority medium
+ category "prog"
+ dump nil
+ description "Interface over GNU patch."
+ filename "ediff-1.13-pkg.tar.gz"
+ md5sum "6435e57ce61d0b0262196866d62b63be"
+ size 281534
+ provides (ediff)
+ requires (pcl-cvs elib dired xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(debug
+ (standards-version 1.0
+ version "1.06"
+ author-version "21.0"
+ date "1998-07-09"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution contrib
+ priority low
+ category "prog"
+ dump nil
+ description "GUD, gdb, dbx debugging support."
+ filename "debug-1.06-pkg.tar.gz"
+ md5sum "807421911694a3c5853568efb71b88b0"
+ size 88964
+ provides (dbx gdb-highlight gdb gdbsrc gud history)
+ requires (xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(cc-mode
+ (standards-version 1.0
+ version "1.13"
+ author-version "5.22"
+ date "1998-03-05"
+ build-date "1998-10-11"
+ maintainer "Barry Warsaw <cc-mode-help@python.org>"
+ distribution stable
+ priority medium
+ category "prog"
+ dump nil
+ description "C, C++ and Java language support."
+ filename "cc-mode-1.13-pkg.tar.gz"
+ md5sum "1ea7ffaa586063356ae65f4777cfb431"
+ size 186436
+ provides (cc-mode)
+ requires (xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(c-support
+ (standards-version 1.0
+ version "1.09"
+ author-version "21.0"
+ date "1998-03-25"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution contrib
+ priority low
+ category "prog"
+ dump nil
+ description "Basic single-file add-ons for editing C code."
+ filename "c-support-1.09-pkg.tar.gz"
+ md5sum "f9dc7f8884203038f750d1e96087dc9c"
+ size 68730
+ provides (c-comment-edit cmacexp ctypes hideif hideshow)
+ requires (cc-mode xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(ada
+ (standards-version 1.0
+ version "1.05"
+ author-version "2.27"
+ date "1998-01-24"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "prog"
+ dump nil
+ description "Ada language support."
+ filename "ada-1.05-pkg.tar.gz"
+ md5sum "374870f02139d0d80b56dab23f93b06d"
+ size 54388
+ provides (ada-mode ada-stmt)
+ requires ()
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(viper
+ (standards-version 1.0
+ version "1.10"
+ author-version "3.03"
+ date "1998-02-25"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "wp"
+ dump nil
+ description "VI emulation support."
+ filename "viper-1.10-pkg.tar.gz"
+ md5sum "f34ad536e27aa564849fcfb2fcf22a29"
+ size 315794
+ provides (viper)
+ requires (xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(tpu
+ (standards-version 1.0
+ version "1.07"
+ author-version "4.2X"
+ date "1998-07-23"
+ build-date "1998-10-11"
+ maintainer "Kevin Oberman <oberman@es.net>"
+ distribution normal
+ priority medium
+ category "wp"
+ dump nil
+ description "DEC EDIT/TPU support."
+ filename "tpu-1.07-pkg.tar.gz"
+ md5sum "be15173be8a57fcb7b7244a143026f8c"
+ size 58801
+ provides (tpu)
+ requires ()
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(textools
+ (standards-version 1.0
+ version "1.07"
+ author-version "21.0"
+ date "1998-04-29"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stabl
+ priority medium
+ category "wp"
+ dump nil
+ description "Miscellaneous TeX support."
+ filename "textools-1.07-pkg.tar.gz"
+ md5sum "a7dff92bcb92c3401f7e6085216f72d7"
+ size 79178
+ provides (bib-mode bibtex refer-to-bibtex)
+ requires (xemacs-base)
+ type single
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(texinfo
+ (standards-version 1.0
+ version "1.13"
+ author-version "21.0"
+ date "1998-07-20"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority high
+ category "wp"
+ dump nil
+ description "XEmacs TeXinfo support."
+ filename "texinfo-1.13-pkg.tar.gz"
+ md5sum "460efede51ea17cd85872959fcf6474f"
+ size 127794
+ provides (makeinfo tex-mode texinfmt texinfo texnfo-tex texnfo-upd)
+ requires (xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(reftex
+ (standards-version 1.0
+ version "1.09"
+ author-version "3.41"
+ date "1998-08-11"
+ build-date "1998-10-11"
+ maintainer "Carsten Dominik <dominik@strw.LeidenUniv.nl>"
+ distribution stable
+ priority medium
+ category "wp"
+ dump nil
+ description "Emacs support for LaTeX cross-references, citations.."
+ filename "reftex-1.09-pkg.tar.gz"
+ md5sum "c7c12198809741e20431cf14a6b965c4"
+ size 204664
+ provides (reftex)
+ requires (fsf-compat xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(edt
+ (standards-version 1.0
+ version "1.06"
+ author-version "21.0"
+ date "1998-04-07"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution contrib
+ priority low
+ category "wp"
+ dump nil
+ description "DEC EDIT/EDT emulation."
+ filename "edt-1.06-pkg.tar.gz"
+ md5sum "bb559e2a5c87b7b3f466b83a2ed7ef3b"
+ size 46138
+ provides (edt)
+ requires (xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(crisp
+ (standards-version 1.0
+ version "1.08"
+ author-version "1.34"
+ date "1998-08-18"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "wp"
+ dump nil
+ description "Crisp/Brief emulation."
+ filename "crisp-1.08-pkg.tar.gz"
+ md5sum "2c18df3dd1eb14e01768832b2b208af4"
+ size 10077
+ provides (crisp scroll-lock)
+ requires ()
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(auctex
+ (standards-version 1.0
+ version "1.15"
+ author-version "9.7p"
+ date "1998-09-30"
+ build-date "1998-10-15"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority medium
+ category "wp"
+ dump nil
+ description "Basic TeX/LaTeX support."
+ filename "auctex-1.15-pkg.tar.gz"
+ md5sum "491d156e8e1f91b6b1604eccdfddace3"
+ size 365003
+ provides (auc-old bib-cite font-latex latex multi-prompt tex-buf tex-info tex-jp tex-site tex)
+ requires (xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(view-process
+ (standards-version 1.0
+ version "1.05"
+ author-version "2.4"
+ date "1998-01-24"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "os"
+ dump nil
+ description "A Unix process browsing tool."
+ filename "view-process-1.05-pkg.tar.gz"
+ md5sum "ec1ba005feb4ea54a832c9d07414de11"
+ size 59881
+ provides (view-process-mode)
+ requires (xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(os-utils
+ (standards-version 1.0
+ version "1.12"
+ author-version "21.0"
+ date "1998-10-01"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority medium
+ category "os"
+ dump nil
+ description "Miscellaneous O/S utilities."
+ filename "os-utils-1.12-pkg.tar.gz"
+ md5sum "603eb56b2af67de1663c9a3fa700b2ae"
+ size 227137
+ provides (archive-mode background crypt crypt++ inf-lisp jka-compr lpr mchat ps-print tar-mode telnet terminal uncompress)
+ requires (xemacs-base)
+ type single
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(ilisp
+ (standards-version 1.0
+ version "1.06"
+ author-version "5.8"
+ date "1998-01-24"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "os"
+ dump nil
+ description "Front-end for Inferior Lisp."
+ filename "ilisp-1.06-pkg.tar.gz"
+ md5sum "89c81fd6dac09a58d09e46ee10db4484"
+ size 262258
+ provides (ilisp completer)
+ requires (xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(igrep
+ (standards-version 1.0
+ version "1.04"
+ author-version "2.83"
+ date "1998-08-11"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "os"
+ dump nil
+ description "Enhanced front-end for Grep."
+ filename "igrep-1.04-pkg.tar.gz"
+ md5sum "8621b52d6316c14821334191477a8ba7"
+ size 14904
+ provides (igrep)
+ requires (dired xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(eterm
+ (standards-version 1.0
+ version "1.07"
+ author-version "21.0"
+ date "1998-06-28"
+ build-date "1998-10-12"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority medium
+ category "os"
+ dump nil
+ description "Terminal emulation."
+ filename "eterm-1.07-pkg.tar.gz"
+ md5sum "f25bfd3c591f9ca5be6f3705ea2681a3"
+ size 108929
+ provides (eterm)
+ requires (xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(misc-games
+ (standards-version 1.0
+ version "1.08"
+ author-version "21.0"
+ date "1998-03-22"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "games"
+ dump nil
+ description "Other amusements and diversions."
+ filename "misc-games-1.08-pkg.tar.gz"
+ md5sum "ca010a30375137a14b3c37989ad61c48"
+ size 165701
+ provides (decipher gomoku hanoi life morse rot13)
+ requires (xemacs-base)
+ type single
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(mine
+ (standards-version 1.0
+ version "1.09"
+ author-version "1.9"
+ date "1998-05-09"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "games"
+ dump nil
+ description "Minehunt Game."
+ filename "mine-1.09-pkg.tar.gz"
+ md5sum "044c1e48ffca88adf46e0df91d456a49"
+ size 66794
+ provides (xmine)
+ requires (xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(games
+ (standards-version 1.0
+ version "1.07"
+ author-version "1.04"
+ date "1998-06-04"
+ build-date "1998-10-11"
+ maintainer "Glynn Clements <glynn@sensei.co.uk>"
+ distribution stable
+ priority low
+ category "games"
+ dump nil
+ description "Tetris, Sokoban, and Snake."
+ filename "games-1.07-pkg.tar.gz"
+ md5sum "ac3fa3b5de00f0daa50c1f372e5b86e0"
+ size 32101
+ provides (gamegrid snake tetris sokoban)
+ requires (xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(cookie
+ (standards-version 1.0
+ version "1.09"
+ author-version "21.0"
+ date "1998-04-07"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "games"
+ dump nil
+ description "Spook and Yow (Zippy quotes)."
+ filename "cookie-1.09-pkg.tar.gz"
+ md5sum "c0618f8a6db3951c081f053233fb75b5"
+ size 34228
+ provides (cookie1 yow)
+ requires (xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(xemacs-devel
+ (standards-version 1.0
+ version "1.19"
+ author-version "21.0"
+ date "1998-09-18"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority medium
+ category "libs"
+ dump nil
+ description "Emacs Lisp developer support."
+ filename "xemacs-devel-1.19-pkg.tar.gz"
+ md5sum "1a9a1d467ae39ce1e93f5fd238112b3e"
+ size 83669
+ provides (docref eldoc elp find-func hide-copyleft ielm regexp-opt trace)
+ requires (xemacs-base)
+ type single
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(xemacs-base
+ (standards-version 1.0
+ version "1.27"
+ author-version "21.0"
+ date "1998-10-08"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution mule
+ priority high
+ category "libs"
+ dump nil
+ description "Fundamental XEmacs support, you almost certainly need this."
+ filename "xemacs-base-1.27-pkg.tar.gz"
+ md5sum "bbede4998cdf5af078c0e41d7b9af7c8"
+ size 429962
+ 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
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(tooltalk
+ (standards-version 1.0
+ version "1.08"
+ author-version "21.0"
+ date "1998-07-25"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution contrib
+ priority low
+ category "libs"
+ dump nil
+ description "Support for building with Tooltalk."
+ filename "tooltalk-1.08-pkg.tar.gz"
+ md5sum "9b4d7a73f9bd50273a011b1ed6522535"
+ size 9293
+ provides ()
+ requires ()
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(mail-lib
+ (standards-version 1.0
+ version "1.18"
+ author-version "21.0"
+ date "1998-06-08"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority medium
+ category "libs"
+ dump nil
+ description "Fundamental lisp files for providing email support."
+ filename "mail-lib-1.18-pkg.tar.gz"
+ md5sum "25896164b50a8c09a45fdf74342c48ea"
+ size 120245
+ provides (browse-url highlight-headers mail-abbrevs mail-extr mail-utils reporter rfc822 rmail-mini rmailout sendmail smtpmail)
+ requires (xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(fsf-compat
+ (standards-version 1.0
+ version "1.04"
+ author-version "21.0"
+ date "1998-09-12"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution mule
+ priority high
+ category "libs"
+ dump nil
+ description "FSF Emacs compatibility files."
+ filename "fsf-compat-1.04-pkg.tar.gz"
+ md5sum "629a4f399a410e88841db23014d00300"
+ size 17419
+ provides (overlay thingatpt timer x-popup-menu)
+ requires ()
+ type single
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(elib
+ (standards-version 1.0
+ version "1.03"
+ author-version "1.0"
+ date "1998-10-01"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution mule
+ priority high
+ category "libs"
+ dump nil
+ description "Portable Emacs Lisp utilities library."
+ filename "elib-1.03-pkg.tar.gz"
+ md5sum "f65ecef3ac286ee59e102f5fc5ad62cc"
+ size 72830
+ provides (avltree bintree cookie dll elib-node queue-f queue-m read stack-f stack-m string)
+ requires ()
+ type single
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(efs
+ (standards-version 1.0
+ version "1.11"
+ author-version "1.17"
+ date "1998-08-23"
+ build-date "1998-10-11"
+ maintainer "Mike Sperber <sperber@informatik.uni-tuebingen.de>"
+ distribution stable
+ priority medium
+ category "libs"
+ dump nil
+ description "Treat files on remote systems the same as local files."
+ filename "efs-1.11-pkg.tar.gz"
+ md5sum "88a538a5016ae53380dba011db80887a"
+ size 368997
+ provides (efs)
+ requires (xemacs-base vm dired)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(edebug
+ (standards-version 1.0
+ version "1.06"
+ author-version "21.0"
+ date "1998-03-12"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority low
+ category "libs"
+ dump nil
+ description "An Emacs Lisp debugger."
+ filename "edebug-1.06-pkg.tar.gz"
+ md5sum "a897be415a8b68c1f79a3632374c9174"
+ size 112385
+ provides (edebug cl-read cust-print eval-reg cl-specs)
+ requires (xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(dired
+ (standards-version 1.0
+ version "1.03"
+ author-version "7.9"
+ date "1998-05-05"
+ build-date "1998-10-11"
+ maintainer "Mike Sperber <sperber@informatik.uni-tuebingen.de>"
+ distribution stable
+ priority medium
+ category "libs"
+ dump nil
+ description "Manage file systems."
+ filename "dired-1.03-pkg.tar.gz"
+ md5sum "30e621efdf8b83e72ad3b68f4e795069"
+ size 187593
+ provides (diff dired)
+ requires (xemacs-base)
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(apel
+ (standards-version 1.0
+ version "1.07"
+ author-version "3.3"
+ date "1998-07-23"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution mule
+ priority high
+ category "libs"
+ dump nil
+ description "A Portable Emacs Library. Used by XEmacs MIME support."
+ filename "apel-1.07-pkg.tar.gz"
+ md5sum "a650a5235403b0a1b46b3269634498e3"
+ size 34784
+ 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
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(Sun
+ (standards-version 1.0
+ version "1.09"
+ author-version "21.0"
+ date "1998-07-25"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution sun
+ priority low
+ category "libs"
+ dump nil
+ description "Support for Sparcworks."
+ filename "Sun-1.09-pkg.tar.gz"
+ md5sum "dc41d791f7c66dc13e8d0d206689188b"
+ size 63916
+ 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
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(sounds-au
+ (standards-version 1.0
+ version "1.05"
+ author-version "21.0"
+ date "1998-06-30"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority high
+ category "libs"
+ dump nil
+ description "XEmacs Sun sound files."
+ filename "sounds-au-1.05-pkg.tar.gz"
+ md5sum "5e44ddd6754771e35303bf4e71c17a17"
+ size 125753
+ provides ()
+ requires ()
+ type regular
+))
+))
+;;;@@@
+(package-get-update-base-entry (quote
+(sounds-wav
+ (standards-version 1.0
+ version "1.05"
+ author-version "21.0"
+ date "1998-06-30"
+ build-date "1998-10-11"
+ maintainer "XEmacs Development Team <xemacs-beta@xemacs.org>"
+ distribution stable
+ priority high
+ category "libs"
+ dump nil
+ description "XEmacs Microsoft sound files."
+ filename "sounds-wav-1.05-pkg.tar.gz"
+ md5sum "e110bc6096bcd24181b45c1b7f83eb59"
+ size 148564
+ provides ()
+ requires ()
+ type regular
+))
+))
+;;;@@@
+;; Package Index file ends here
+
+-----BEGIN PGP SIGNATURE-----
+Version: 2.6.2
+
+iQCVAwUBNibr5aLJZEUiepcNAQHmWQP+PDjjOvmsdhu6RGXIFCUPV4ado8IWD8i8
+/aEwLHJRdoQWEg0ZuiNgmtF2iNPrNIOkSs9hF+sOF4xoszhxaytfFG7DEA5Q8Alb
+jKooHKEUEF7W0wAxihyGojz3VuH5i7GKAtOcVqFtgWS3eAkNaN4QWlmhxavh0Cdv
+p7wnfYTZYSs=
+=65go
+-----END PGP SIGNATURE-----
--- /dev/null
+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>
+
+ * ldap.el (ldap-search): Doc string change
+
+1998-07-16 Colin Rafferty <colin@xemacs.org>
+
+ * menubar-items.el (default-menubar): Removed references to
+ `data-directory', and use `locate-data-file' instead, and made
+ then greyed out if they don't exist.
+
+1998-07-14 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
+
+ * keymap.el (events-to-keys): Use `format' instead of `concat'
+ since the latter does not accept integer args anymore
+
+1998-07-15 SL Baur <steve@altair.xemacs.org>
+
+ * dumped-lisp.el (preloaded-file-list): Usage of Lisp read-time
+ macros replaced.
+
+1998-07-14 SL Baur <steve@altair.xemacs.org>
+
+ * make-docfile.el: Get first initialization from very-early-lisp.el
+ * update-elc.el: Ditto.
+ * loadup.el (really-early-error-handler): Ditto.
+
+ * packages.el (packages-unbytecompiled-lisp): Add new file,
+ very-early-lisp.el.
+
+ * very-early-lisp.el: New file.
+
+1998-07-14 SL Baur <steve@altair.xemacs.org>
+
+ * Symbols that have been obsolete for at least 3 years removed (II).
+
+ * obsolete.el (eval-current-buffer): Make compatible.
+ (byte-code-function-p): Ditto.
+ (send-string): Removed.
+ (send-region): Removed.
+ (screen-scrollbar-width): Removed.
+ (set-screen-scrollbar-width): Removed.
+ (set-screen-left-margin-width): Removed.
+ (set-screen-right-margin-width): Removed.
+ (screen-left-margin-width): Removed.
+ (screen-right-margin-width): Removed.
+ (set-buffer-left-margin-width): Removed.
+ (set-buffer-right-margin-width): Removed.
+ (buffer-left-margin-width): Removed.
+ (buffer-right-margin-width): Removed.
+ (x-set-frame-icon-pixmap): Removed.
+ (x-set-screen-icon-pixmap): Removed.
+ (pixel-name): Removed.
+ (make-pixmap): Removed.
+ (make-cursor): Removed.
+ (pixmap-width): Removed.
+ (pixmap-contributes-to-line-height-p): Removed.
+ (set-pixmap-contributes-to-line-height): Removed.
+
+1998-07-13 SL Baur <steve@altair.xemacs.org>
+
+ * obsolete.el (popup-menu-up-p): removed.
+ (read-no-blanks-input): Removed.
+ (wholenump): Removed.
+ (ring-mod): Removed (what was ring-mod?).
+ (current-time-seconds): Removed.
+ (run-special-hook-with-args): Removed.
+ (dot): Removed.
+ (dot-marker): Removed.
+ (dot-min): Removed.
+ (dot-max): Removed.
+ (window-dot): Removed.
+ (set-window-dot): Removed.
+
+ * bytecomp.el: Remove bytecompiler support for `dot', `dot-max' and
+ `dot-min'.
+
+ * minibuf.el: (read-no-blanks-input): remove commented-out copy.
+
+ * code-files.el (insert-file-contents): Rename
+ run-special-hook-with-args to run-hook-with-args-until-success.
+ (write-region): Ditto.
+
+1998-07-12 SL Baur <steve@altair.xemacs.org>
+
+ * about.el: Fix typos, update release date.
+
+ * Symbols that have been obsolete for at least 3 years removed.
+
+ * 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.
+ * obsolete.el (lisp-indent-hook): Make compatible, it's used too
+ many places to remove.
+ (comment-indent-hook): Ditto.
+ * obsolete.el (get-screen-for-buffer-default-screen-name): Remove.
+ (buffer-dedicated-screen): Ditto.
+ (deiconify-screen): Ditto.
+ (delete-screen): Ditto.
+ (event-screen): Ditto.
+ (find-file-other-screen): Ditto.
+ (find-file-read-only-other-screen): Ditto.
+ (live-screen-p): Ditto.
+ (screen-height): Ditto.
+ (screen-iconified-p): Ditto.
+ (screen-list): Ditto.
+ (screen-live-p): Ditto.
+ (screen-name): Ditto.
+ (screen-parameters): Ditto.
+ (screen-pixel-height): Ditto.
+ (screen-pixel-width): Ditto.
+ (screen-root-window): Ditto.
+ (screen-selected-window): Ditto.
+ (screen-totally-visible-p): Ditto.
+ (screen-visible-p): Ditto.
+ (screen-width): Ditto.
+ (screenp): Ditto.
+ (get-screen-for-buffer): Ditto.
+ (get-screen-for-buffer-noselect): Ditto.
+ (get-other-screen): Ditto.
+ (iconify-screen): Ditto.
+ (lower-screen): Ditto.
+ (mail-other-screen): Ditto.
+ (make-screen): Ditto.
+ (make-screen-invisible): Ditto.
+ (make-screen-visible): Ditto.
+ (modify-screen-parameters): Ditto.
+ (new-screen): Ditto.
+ (next-screen): Ditto.
+ (next-multiscreen-window): Ditto.
+ (other-screen): Ditto.
+ (previous-screen): Ditto.
+ (previous-multiscreen-window): Ditto.
+ (raise-screen): Ditto.
+ (redraw-screen): Ditto.
+ (select-screen): Ditto.
+ (selected-screen): Ditto.
+ (set-buffer-dedicated-screen): Ditto.
+ (set-screen-height): Ditto.
+ (set-screen-position): Ditto.
+ (set-screen-size): Ditto.
+ (set-screen-width): Ditto.
+ (show-temp-buffer-in-current-screen): Ditto.
+ (switch-to-buffer-other-screen): Ditto.
+ (visible-screen-list): Ditto.
+ (window-screen): Ditto.
+ (x-set-screen-pointer): Ditto.
+ (x-set-frame-pointer): Ditto.
+ (screen-title-format): Ditto.
+ (screen-icon-title-format): Ditto.
+ (terminal-screen): Ditto.
+ (delete-screen-hook): Ditto.
+ (create-screen-hook): Ditto.
+ (mouse-enter-screen-hook): Ditto.
+ (mouse-leave-screen-hook): Ditto.
+ (map-screen-hook): Ditto.
+ (unmap-screen-hook): Ditto.
+ (default-screen-alist): Ditto.
+ (default-screen-name): Ditto.
+ (x-screen-defaults): Ditto.
+ (x-create-screen): Ditto.
+ * obsolete.el: meta-flag removed.
+ baud-rate removed.
+ sleep-for-millisecs removed.
+ extent-data removed.
+ set-extent-data removed.
+ set-extent-attribute removed.
+ extent-glyph removed.
+ extent-layout removed.
+ set-extent-layout removed.
+ list-faces-display removed.
+ list-faces removed.
+ trim-versions-without-asking removed.
+ after-write-file-hooks removed.
+ truename removed.
+ auto-fill-hook removed.
+ blink-paren-hook removed.
+ select-screen-hook, deselect-screen-hook removed.
+ auto-raise-screen, auto-lower-screen removed.
+
+ * msw-mouse.el: Global change resource -> mswindows-resource.
+
+ * XEmacs 21.0-pre5 is released.
+
+1998-07-11 SL Baur <steve@altair.xemacs.org>
+
+ * about.el (about-hackers): Credits update.
+
+1998-07-11 Hrvoje Niksic <hniksic@srce.hr>
+
+ * register.el (insert-register): Don't activate the region.
+
+1998-07-10 SL Baur <steve@altair.xemacs.org>
+
+ * select.el: Restore x-* symbols for backwards compatibility:
+ x-copy-primary-selection, x-kill-primary-selection,
+ x-delete-primary-selection, x-select-make-extent-for-selection,
+ x-valid-simple-selection-, x-cut-copy-clear-internal.
+
+1998-07-09 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.0-pre4 is released.
+
+1998-06-28 Hrvoje Niksic <hniksic@srce.hr>
+
+ * menubar-items.el (default-menubar): Use `report-emacs-bug' for
+ reporting bugs.
+ (maybe-add-init-button): Fix semantics under Windows. Use
+ `expand-file-name' rather than `concat'.
+
+ * help.el (print-messages): New function.
+
+1998-07-05 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
+
+ * ldap.el (ldap-host-parameters-alist): Docstring fixes
+
+1998-07-04 Jonathan Harris <jhar@tardis.ed.ac.uk>
+
+ * about.el: Tweaked my entry in about-hackers.
+
+ * find-paths.el (paths-emacs-root-p):
+ Relaxed emacs-root checking of an in-place installation to
+ also accomodate the flat layout used on MS Windows.
+
+1998-06-29 John Jones <jj@asu.edu>
+
+ * package-get.el: calls to package-get-update-all will only
+ update packages which are already installed.
+
+1998-07-05 Andy Piper <andyp@parallax.co.uk>
+
+ * 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.
+
+ * msw-faces.el (mswindows-init-device-faces): remove gui-element
+ and default face settings since these are set as fallbacks now in
+ the appropriate domain.
+
+1998-07-02 SL Baur <steve@altair.xemacs.org>
+
+ * text-mode.el (text-mode): Reorder regexp so the OR part
+ corresponding to `page-delim' goes first and the hack in
+ `forward-paragraph' will work.
+ With bug analysis from Bob Weiner <weiner@altrasoft.com>
+
+1998-06-29 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * subr.el (remove-hook): When checking the hook value
+ with functionp, don't apply car to it.
+
+1998-06-24 Jonathan Harris <jhar@tardis.ed.ac.uk>
+
+ * package-get.el (package-get-remote-filename):
+ Don't use file-name-as-directory because the local directory
+ separator conventions might not be the same as ftp's.
+
+1998-06-27 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
+
+ * ldap.el (ldap-host-parameters-alist): New name of
+ `ldap-host-parameters-plist'
+
+1998-06-26 Adrian Aichner <aichner@ecf.teradyne.com>
+
+ * package-get.el: Using (require 'package-get-base), now that it
+ provides itself. Consequently removed all instances of (load
+ "package-get-base.el").
+
+1998-06-29 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * 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 <steve@altair.xemacs.org>
+
+ * about.el: Email address for Ben Wing is ben@xemacs.org.
+ * auto-show.el: Ditto.
+ * bytecomp.el: Ditto.
+ * faces.el: Ditto.
+ * x-scrollbar.el: Ditto.
+ * x-misc.el: Ditto.
+ * tty-init.el: Ditto.
+ * toolbar-items.el: Ditto.
+ * symbol-syntax.el: Ditto.
+ * specifier.el: Ditto.
+ * objects.el: Ditto.
+ * hyper-apropos.el: Ditto.
+ * glyphs.el: Ditto.
+
+1998-06-27 Hrvoje Niksic <hniksic@srce.hr>
+
+ * mouse.el (drag-window-divider): vertical-divider-draggable-p ->
+ vertical-divider-always-visible-p.
+ (default-mouse-motion-handler): Ditto.
+
+1998-06-21 Hrvoje Niksic <hniksic@srce.hr>
+
+ * scrollbar.el (scrollbars-visible-p): Simplify. Always set the
+ global value.
+
+1998-06-21 Oliver Graf <ograf@fga.de>
+
+ * build-reports.el: changed receiver to xemacs-build-reports list
+
+1998-06-19 Jonathan Harris <jhar@tardis.ed.ac.uk>
+
+ * font.el: Split font-family-mappings into X and
+ mswindows-specific versions.
+ mswindows-font-create-[object|name]: Treat supplied size
+ as a pointsize. Added underline and strikethru handling.
+
+ * msw-faces.el: changed default mswindows charset to western.
+
+ * msw-glyphs.el: removed space in border-glyph font string that
+ was inserted to get round bugs in the mswindows C font code.
+
+1998-06-27 SL Baur <steve@altair.xemacs.org>
+
+ * about.el (about-hackers): Credits update.
+
+ * help-nomule.el (tutorial-supported-languages): Add Romanian
+ TUTORIAL.
+
+ * code-files.el (file-coding-system-alist): Hardwire TUTORIAL.ro
+ to ISO-8859-2.
+
+1998-06-19 Jonathan Harris <jhar@tardis.ed.ac.uk>
+
+ * font.el: Split font-family-mappings into X and
+ mswindows-specific versions.
+ mswindows-font-create-[object|name]: Treat supplied size
+ as a pointsize. Added underline and strikethru handling.
+
+ * msw-faces.el: changed default mswindows charset to western.
+
+ * msw-glyphs.el: removed space in border-glyph font string that
+ was inserted to get round bugs in the mswindows C font code.
+
+1998-06-15 Jonathan Harris <jhar@tardis.ed.ac.uk>
+
+ * minibuf.el: make read-color-completion-table call
+ (mswindows-color-list for mswindows devices.
+
+1998-06-18 Sam Mikes <smikes@alumni.hmc.edu>
+
+ * lisp/font-lock.el
+ (font-lock-match-c++-style-declaration-item-and-skip-to-next):
+ Let declaration items contain non-word symbol characters.
+
+1998-06-15 Adrian Aichner <aichner@ecf.teradyne.com>
+
+ * package-get.el (package-get-package-provider): Added autoload
+ cookie. Loading "package-get-base.el" in ALL functions that use
+ it. Fixed some (interactive ...) with multiple argument specs
+ again. Cosmetic indentation changes.
+
+1998-05-27 Glynn Clements <glynn@sensei.co.uk>
+
+ * info.el (Info-insert-dir): Don't use nreverse on variables
+ that you want to use later.
+
+1998-06-17 Glynn Clements <glynn@sensei.co.uk>
+
+ * x-mouse.el (x-set-point-and-move-selection): Replace call
+ to x-kill-primary-selection with kill-primary-selection
+
+1998-06-12 Martin Buchholz <martin@xemacs.org>
+
+ * simple.el (what-cursor-position): Make cursor position reported
+ use value of column-number-start-at-one
+
+1998-06-17 SL Baur <steve@altair.xemacs.org>
+
+ * about.el (xemacs-hackers): Fix Jareth's email address.
+
+1998-06-16 SL Baur <steve@altair.xemacs.org>
+
+ * startup.el (startup-splash-frame): Remove
+ `xemacs-startup-logo-function'.
+
+1998-06-15 SL Baur <steve@altair.xemacs.org>
+
+ * about.el (about-hackers): Update credits list.
+
+1998-06-06 Jeff Miller <jmiller@smart.net>
+
+ * lisp/sound.el: Update sound-ext to allow filenames with
+ extensions to be found by load-sound-file
+
+1998-06-14 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
+
+ * info.el (Info-rebuild-outdated-dir): Removed variable
+ (Info-auto-generate-directory): New variable
+ (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-rebuild-dir): Ditto
+
+1998-06-02 Christoph Wedler <wedler@fmi.uni-passau.de>
+
+ * list-mode.el (next-list-mode-item): Would not recognize
+ border between directly neighbored items.
+
+1998-06-12 Andy Piper <andyp@parallax.co.uk>
+
+ * package-get.el: add autoloads for some functions.
+
+1998-06-10 Hrvoje Niksic <hniksic@srce.hr>
+
+ * specifier.el (let-specifier): Tiny docfixes.
+
+1998-06-12 Andy Piper <andyp@parallax.co.uk>
+
+ * msw-mouse.el: set selection-pointer-glyph to Normal.
+
+1998-06-09 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * wid-edit.el (widget-specify-secret): New function.
+ (widget-after-change): Use it.
+ (widget-specify-field): Use it.
+
+1998-06-08 Hrvoje Niksic <hniksic@srce.hr>
+
+ * mouse.el (drag-window-divider): Use `(not done)' instead of
+ `doit'; reuse result of `window-pixel-edges'.
+
+ * modeline.el (drag-modeline-event-lag): Rename to
+ drag-divider-event-lag.
+
+1998-06-07 Hrvoje Niksic <hniksic@srce.hr>
+
+ * specifier.el (let-specifier): Rewritten not to generate needless
+ `let's; clarified documentation; support TAG-SET and HOW-TO-ADD
+ arguments.
+
+1998-05-28 Hrvoje Niksic <hniksic@srce.hr>
+
+ * minibuf.el (read-file-name-1): Setup buffer-local value of
+ `completion-ignore-case' in completions buffer under Windows.
+
+1998-06-06 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * about.el (about-maintainer-glyph): Fix support for not
+ compressed images.
+
+1998-06-04 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * cmdloop.el (cancel-mode-internal): Defined this do-nothing function.
+
+ * mouse.el (mouse-track): Cancel selection if misc-user event with
+ `cancel-mode-internal' function is fetched.
+
+1998-06-03 Hrvoje Niksic <hniksic@srce.hr>
+
+ * files.el (save-some-buffers-1): Fixed return value.
+
+1998-06-01 Oliver Graf <ograf@fga.de>
+
+ * dragdrop.el: added experimental
+
+1998-05-26 Stephen J. Turnbull <turnbull@sk.tsukuba.ac.jp>
+
+ * startup.el (after-init-hook, init-file-user,
+ user-init-directory, load-user-init-file): Purge references
+ to "~/.xemacs/init.el" from docstrings.
+
+ (load-user-init-file) Use paths-construct-path to construct
+ paths to user init files. Go directly to ~/.emacs, do not
+ search ~/.xemacs/, do not load `default-custom-file'.
+
+1998-06-03 Hrvoje Niksic <hniksic@srce.hr>
+
+ * files.el (interpreter-mode-alist): Catch wish and tclsh before
+ general *sh.
+ (inhibit-first-line-modes-regexps): Added `.tar.gz'.
+
+1998-06-03 Andy Piper <andyp@parallax.co.uk>
+
+ * menubar-items.el (default-menubar): add Update Packages to customize
+ menu.
+
+1998-06-02 Andy Piper <andyp@parallax.co.uk>
+
+ * faces.el: use toolbar face as a fallback for toolbar properties
+ in xpm-color-symbols instead of default.
+
+ * msw-faces.el: rename 3d-object -> gui-element face.
+
+1998-06-06 SL Baur <steve@altair.xemacs.org>
+
+ * startup.el (xemacs-startup-logo-function): New variable.
+ (startup-splash-frame): Use it.
+
+1998-06-02 Hrvoje Niksic <hniksic@srce.hr>
+
+ * files.el (save-some-buffers): Would wait 1 second.
+ (save-some-buffers-1): Delete other windows here instead of in
+ `save-some-buffers'.
+ (save-some-buffers): Force redisplay only if windows were deleted.
+
+1998-06-02 Didier Verna <verna@inf.enst.fr>
+
+ * cus-face.el (custom-face-attributes): generalized the use of
+ toggle buttons for boolean attributes.
+ Re-ordered the items a bit.
+
+1998-06-01 SL Baur <steve@altair.xemacs.org>
+
+ * sound.el (default-sound-directory): Use `locate-data-directory'
+ to find the sounds directory.
+
+1998-05-29 Andy Piper <andyp@parallax.co.uk>
+
+ * sound.el: default sound-ext to .wav under mswindows, .au
+ otherwise. load-default sounds without extensions.
+
+1998-05-27 Bjrn Torkelsson <torkel@hpc2n.umu.se>
+
+ * menubar-items.el (default-menubar): Dim out "Submit Bug Report"
+ if send-pr is not bound.
+
+1998-06-01 Andy Piper <andyp@parallax.co.uk>
+
+ * files.el: grok idl files in auto-mode-alist.
+1998-06-01 Jeff Miller <jmiller@smart.net>
+
+ * minibuf.el (exact-minibuffer-completion-p): check for nil before
+ calling `upcase'.
+
+1998-05-30 Andy Piper <andyp@parallax.co.uk>
+
+ * msw-glyphs.el: add xbm to the list of image types supported.
+
+1998-05-30 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * msw-init.el (init-post-mswindows-win): Load InfoDock toolbar
+ instead of XEmacs one when dumping InfoDock.
+
+1998-05-30 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * obsolete.el (has-modeline-p): Added obsolete alias `has-modeline-p'
+ for `modeline-visible-p'
+
+ * winnt.el (nt-quote-process-args): Fix for duplicating argv[0].
+
+1998-05-29 Andy Piper <andyp@parallax.co.uk>
+
+ * msw-select.el (mswindows-cut-copy-clear-clipboard): deleted
+ since it's not used anymore. doc string fixes.
+
+ * package-get.el (package-get-file-installed-p): new function. use
+ instead of file-installed-p which is in an external package.
+
+1998-05-28 Oliver Graf <ograf@fga.de>
+
+ * dragdrop.el (dragdrop-drop-url-default): dropped pop-to-buffer in
+ favor of select-window/switch-to-buffer
+
+Wed May 27, 1998 Darryl Okahata <darrylo@sr.hp.com>
+
+ * startup.el: changed (getenv "HOME") to (user-home-directory)
+
+1998-05-25 Oliver Graf <ograf@fga.de>
+
+ * frame.el (cde-start-drag) moved to dragdrop.el
+ (offix-start-drag-region) moved to dragdrop.el
+ (offix-start-drag) moved to dragdrop.el
+ * dragdrop.el (cde-start-drag) moved from frame.el
+ (offix-start-drag-region) moved from frame.el
+ (offix-start-drag) moved from frame.el
+ (cde-start-drag-region) cde drag regions
+ * mouse.el (mouse-drag-or-yank) will now call cde-start-drag-region
+
+1998-05-26 Oliver Graf <ograf@fga.de>
+
+ * dragdrop.el: created dragdrop-drag prototypes
+ (cde-start-drag-region) fixed typo
+
+1998-05-28 SL Baur <steve@altair.xemacs.org>
+
+ * simple.el (after-init-hook): Remove reader macro.
+
+ * packages.el (packages-hardcoded-lisp): Get rid of reader
+ macros. Update DOC string.
+
+1998-05-25 Hrvoje Niksic <hniksic@srce.hr>
+
+ * mouse.el (drag-window-divider): Ditto.
+
+ * modeline.el (mouse-drag-modeline): Use it.
+
+ * lisp-mode.el (let-specifier): Specify indentation.
+
+ * specifier.el (let-specifier): Renamed from
+ `with-specifier-instance'.
+
+1998-05-27 Andy Piper <andyp@parallax.co.uk>
+
+ * x-faces.el:
+ * faces.el: move definition of xpm-color-symbols from x-faces.el
+ to faces. Predicate x-get-resource on the presence of x.
+
+ * msw-faces.el: set 3d-object face rather than modeline. Specifiy
+ faces as specfier defaults.
+
+ * package-get.el: don't use package-admin-add-single-file-package.
+
+1998-05-25 Hrvoje Niksic <hniksic@srce.hr>
+
+ * toolbar-items.el: Fixup tooltips.
+ (toolbar-gnus): Don't use obsolete variable
+ toolbar-news-frame-properties.
+ (toolbar-news-reader): Default to `gnus' instead of
+ `not-configured'.
+
+ * files.el (auto-mode-alist): Correctly recognize `.emacs' under
+ Windows.
+
+1998-05-25 Andy Piper <andyp@parallax.co.uk>
+
+ * package-get.el: rename -installedp -> -installed-p.
+
+1998-05-23 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * glyphs.el (init-glyphs): Created `border-glyph' face, with no
+ attributes, and assinged it to continuation, truncation and
+ hscroll glyphs.
+
+ * msw-glyphs.el: Assigned WinDings font to `border-glyph' face,
+ and made continuation, truncation and hscroll glyphs arrow
+ characters out of that font.
+
+1998-05-22 Hrvoje Niksic <hniksic@srce.hr>
+
+ * minibuf.el (minibuffer-electric-separator): Play nicely with
+ directory-sep-char being \.
+ (minibuffer-electric-tilde): Ditto.
+ (read-file-name-map): Ditto.
+
+1998-05-22 Hrvoje Niksic <hniksic@srce.hr>
+
+ * mouse.el (default-mouse-track-maybe-own-selection): Pause only
+ on X devices.
+ (default-mouse-track-deal-with-down-event): Avoid
+ `x-disown-selection'; use `disown-selection' instead.
+
+1998-05-21 Andy Piper <andyp@parallax.co.uk>
+
+ * select.el:
+ * 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).
+ (own-clipboard): new function.
+
+ * msw-select.el: use the new kill/delete/copy/cut-copy-clear
+ functions in select.el. remove old ones.
+ (mswindows-own-clipboard): new function.
+
+1998-05-21 Andy Piper <andyp@parallax.co.uk>
+
+ * gnuserv.el: allow connections from mswindows type devices.
+
+1998-05-20 Andy Piper <andyp@parallax.co.uk>
+
+ * msw-glyphs.el: change image type used from cursor to resource.
+
+1998-05-20 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * x-scrollbar.el (x-init-scrollbar-from-resources): Added support
+ for {top,bottom}-{left,right} values in addition to
+ {top,bottom}_{left,right}.
+ Use x-get-resource instead of x-get-resource-and-bogosity-check.
+
+1998-05-20 Hrvoje Niksic <hniksic@srce.hr>
+
+ * cl-macs.el (specifier-instance): Undefine its setf method.
+
+ * specifier.el (with-specifier-instance): Added docstring.
+
+ * mouse.el (drag-window-divider): Ditto.
+
+ * modeline.el (mouse-drag-modeline): Use it.
+
+ * lisp-mode.el (with-specifier-instance): Define its indentation
+ level.
+
+ * specifier.el (with-specifier-instance): New macro.
+
+1998-05-19 Andy Piper <andyp@parallax.co.uk>
+
+ * package-get.el (package-get-create-custom): new function to
+ auto-generate package-get-custom.el from package-get-base.el.
+ * (package-get-ever-installedp): new function.
+ * (package-get-custom): new function to get all packages specified
+ by customize.
+
+1998-05-19 Hrvoje Niksic <hniksic@srce.hr>
+
+ * cus-edit.el (custom-file): Revert to `~/.emacs'.
+
+1998-05-23 SL Baur <steve@altair.xemacs.org>
+
+ * cl-extra.el: Reverse previous float change.
+
+1998-05-17 Andy Piper <andyp@parallax.co.uk>
+
+ * x-faces.el:
+ * faces.el (try-font-name): moved from x-faces.el since it is
+ required by w3 under mswindows as well X.
+
+1998-05-18 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * winnt.el: Removed evil (setq completion-ignore-case t)
+ clause, one more overlookef fsfism.
+ (nt-quote-args-functions-alist): End sentences with double space.
+
+1998-05-18 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * window-xemacs.el (push-window-configuration): Remove kludgery of
+ recaching default-toolbar specifier.
+ (pop-window-configuration): Ditto.
+ (unpop-window-configuration): Ditto.
+
+1998-05-16 Hrvoje Niksic <hniksic@srce.hr>
+
+ * modeline.el (modeline-minor-mode-menu): Don't use :menu-tag.
+
+1998-05-17 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * winnt.el (nt-quote-args-verbatim): Added function.
+ (nt-quote-args-prefix-quote): Added function.
+ (nt-quote-args-backslash-quote): Added function.
+ (nt-quote-args-double-quote): Added function.
+ (nt-quote-args-functions-alist): New variable.
+ (nt-quote-process-args): Added function. This is the main quoting
+ work horse called from process-nt.c
+
+1998-05-16 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * winnt.el: Removed duplicate definitions for backspace,
+ delete, M-backspace and C-M-backspace.
+ (file-name-buffer-file-type-alist): Removed this variable.
+ (find-buffer-file-type): Removed function.
+ (find-file-binary): Removed function.
+ (find-file-text): Removed function.
+ (find-file-not-found-set-buffer-file-type): Removed function.
+ (save-to-unix-hook): Removed function.
+ (revert-from-unix-hook): Removed function.
+ (using-unix-filesystems): Removed function.
+ (original-make-auto-save-file-name): DEFSUBR to avoid doc snarf
+ warning.
+ (x-set-selection): Removed function.
+ (x-get-selection): Removed function.
+ Removed commented FSFisms.
+ Replaced copyright notice (this file is not part of GNU Emacs).
+ (nt-shell-mode-hook): Moved here from a lambda expression. Added
+ comint-process-echoes setting to t.
+
+1998-05-17 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * packages.el (packages-no-package-hierarchy-regexp): Introduced
+ and used following the interface change of
+ `paths-find-recursive-path'.
+
+ * find-paths.el (paths-find-recursive-path): Exclusion is now by a
+ regexp instead of a list of base names.
+ (paths-version-control-filename-regexp):
+ (paths-lisp-filename-regexp): (paths-no-lisp-directory-regexp):
+ Introduced and used following the interface change of
+ `paths-find-recursive-path'.
+
+1998-05-16 Hrvoje Niksic <hniksic@srce.hr>
+
+ * 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 <kkm@kis.ru>
+
+ * msw-mouse.el: New file. Sets up cursor shapes for Windows.
+
+ * dumped-lisp.el (preloaded-file-list): Added msw-mouse.el
+
+1998-05-17 Adrian Aichner <aichner@ecf.teradyne.com>
+
+ * itimer.el (activate-itimer): Fixed usage of integers
+ as argument to `concat'.
+
+1998-05-17 Glynn Clements <glynn@sensei.co.uk>
+
+ * itimer.el (start-itimer): replace the use of `concat' with
+ `format'
+
+1998-05-16 SL Baur <steve@altair.xemacs.org>
+
+ * mode-motion.el (mode-motion-hook): Clarify docstring.
+ From Bob Weiner <weiner@altrasoft.com>
+
+ * loadhist.el (symbol-file): Supply prompt string when used
+ interactively.
+ From Bob Weiner <weiner@altrasoft.com>
+
+1998-05-16 Hrvoje Niksic <hniksic@srce.hr>
+
+ * loadup.el (really-early-error-handler): Ditto.
+
+ * update-elc.el: Ditto.
+
+ * setup-paths.el (paths-construct-exec-path): Ditto.
+
+ * make-docfile.el: Ditto.
+
+ * find-paths.el (paths-decode-directory-path): Use split-path
+ instead of decode-path.
+
+ * files.el (parse-colon-path): Update docstring reference.
+
+1998-05-15 Jonathan Harris <jhar@tardis.ed.ac.uk>
+
+ * msw-init.el:
+ * x-init.el:
+ Bind cut'n'paste keys to non window-system specific functions.
+
+ * msw-select.el: New function mswindows-clear-clipboard.
+ mswindows-cut-copy-clipboard extended to handle clearing of the
+ selection and renamed to mswindows-cut-copy-clear-clipboard.
+
+ * select.el: on mswindows devices delete-primary-selection
+ calls mswindows-clear-clipboard.
+
+1998-05-15 Hrvoje Niksic <hniksic@srce.hr>
+
+ * simple.el (quoted-insert): Inhibit quit when using read-char.
+
+ * cmdloop.el (read-char): Don't inhibit quit.
+ (read-char-exclusive): Ditto.
+ (read-char): Signal quit if quit-char was pressed.
+ (read-char-exclusive): Ditto.
+ (read-quoted-char): Return a character, not integer.
+
+ * menubar-items.el (default-popup-menu): Use Andy's generic
+ selection code.
+ (default-popup-menu): Fix code.
+
+1998-05-14 Oliver Graf <ograf@fga.de>
+
+ * dragdrop.el (dragdrop-function-widget): this time it's done
+
+1998-05-13 Oliver Graf <ograf@fga.de>
+
+ * dumped-lisp.el: dragdrop.el now based on dragdrop-api feature
+
+1998-05-15 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * 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.
+
+1998-05-14 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * mouse.el (default-mouse-motion-handler): Use new name of the
+ function event-over-vertical-divider-p.
+ Do not set E-W arrow cursor over the divider if
+ vertical-divider-draggable-p is nil in the window.
+ ([top-level]): Use new name for the variable
+ vertical-divider-map.
+ (drag-window-divider): Respect vertical-divider-draggable-p.
+ Variable name typo fixes.
+
+1998-05-14 Hrvoje Niksic <hniksic@srce.hr>
+
+ * keymap.el (kbd): Define here; handle string constants and
+ others...
+
+1998-05-15 Christian Nyb <chr@mediascience.no>
+
+ * simple.el (zap-up-to-char): New function. Behaves like `zap-to-char'
+ in Emacs 18.
+
+1998-05-13 Didier Verna <verna@inf.enst.fr>
+
+ * mouse.el (drag-window-divider): give the vertical divider a
+ pressed look when dragging it.
+
+1998-05-13 Andy Piper <andyp@parallax.co.uk>
+
+ * faces.el: predicate some more face operations on x or mswindows
+ not just x.
+
+ * modeline.el: enable modeline coloring for mswindows.
+
+1998-05-13 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * minibuf.el (minibuffer-default): Added variable; compatible with
+ FSF Emacs.
+ (next-history-element): Used `minibuffer-default'.
+
+1998-05-12 Oliver Graf <ograf@fga.de>
+
+ * dragdrop.el (dragdrop-function-widget): button and mods ok
+ arguments still look a bit strange
+ (dragdrop-compare-mods) created
+ (dragdrop-drop-do-functions) correctly checks for buttons and
+ modifiers
+
+1998-05-14 Hrvoje Niksic <hniksic@srce.hr>
+
+ * setup-paths.el (paths-default-info-directories): Replace
+ path-separator with directory-sep-char.
+
+ * files.el (path-separator): Don't define it here.
+
+1998-05-14 Hrvoje Niksic <hniksic@srce.hr>
+
+ * update-elc.el: Ditto.
+
+ * setup-paths.el (paths-construct-exec-path): Ditto.
+
+ * make-docfile.el: Ditto.
+
+ * loadup.el (really-early-error-handler): Ditto.
+
+ * find-paths.el (paths-decode-directory-path): Use decode-path
+ instead of decode-path-internal.
+
+ * files.el (parse-colon-path): Update docstring.
+
+1998-05-13 Hrvoje Niksic <hniksic@srce.hr>
+
+ * subr.el (get-buffer-window-list): Make BUFFER optional.
+
+ * window-xemacs.el (windows-of-buffer): Defalias to
+ get-buffer-window-list.
+
+1998-05-12 Hrvoje Niksic <hniksic@srce.hr>
+
+ * disass.el: Fix maintainer keyword.
+
+ * bytecomp.el (byte-compile-and-load-file): Autoload.
+ (byte-compile-buffer): Ditto.
+
+ * lisp-mode.el (eval-last-sexp): Skip ` in `variable' so that the
+ value is returned, not the name.
+ (lisp-imenu-generic-expression): Enable it.
+ (lisp-mode-variables): Ditto.
+ (lisp-indent-offset): Change defconst to defvar.
+ (lisp-indent-function): Ditto.
+ (lisp-body-indent): Ditto.
+
+1998-05-12 Hrvoje Niksic <hniksic@srce.hr>
+
+ * modeline.el: Use zap-last-kbd-macro-event.
+
+ * lisp-mode.el (eval-interactive): If eval-interactive-verbose is
+ nil, don't attempt to do anything with messages.
+ (eval-last-sexp): Use `letf' for clarity.
+
+1998-05-12 Hrvoje Niksic <hniksic@srce.hr>
+
+ * startup.el: It's still `.emacs', not yet `.xemacs/init.el'.
+
+1998-05-11 Martin Buchholz <martin@xemacs.org>
+
+ * buff-menu.el:
+ * lisp-mode.el:
+ * obsolete.el:
+ Change empty docstrings into no doc strings at all.
+ Fix bogus FSF-format docstrings.
+ * etags.el: Fix docstring.
+
+1998-05-11 Jan Vroonhof <vroonhof@math.ethz.ch>
+
+ * package-get.el (package-get): Use internal md5
+
+1998-05-13 SL Baur <steve@altair.xemacs.org>
+
+ * about.el (about-xemacs): Correct abuse of concat.
+
+1998-05-11 SL Baur <steve@altair.xemacs.org>
+
+ * info.el (Info-mode): Use easymenu.
+
+1998-05-12 Hrvoje Niksic <hniksic@srce.hr>
+
+ * apropos.el (apropos): Don't use concat with integers.
+
+ * cmdloop.el (describe-last-error): Handle the case when no error
+ was seen gracefully.
+
+ * apropos.el (apropos-print): Use with-displaying-help-buffer as
+ defun.
+ (apropos-describe-plist): Ditto.
+
+ * help.el (with-displaying-help-buffer): Revert to a defun.
+ (describe-key): Use it as defun.
+ (describe-mode): Ditto.
+ (describe-bindings): Ditto.
+ (describe-prefix-bindings): Ditto.
+ (describe-installation): Ditto.
+ (view-lossage): Ditto.
+ (describe-function): Ditto.
+ (describe-variable): Ditto.
+ (describe-syntax): Ditto.
+
+1998-05-11 Oliver Graf <ograf@fga.de>
+
+ * dragdrop.el: changed order of require/provide
+ (dragdrop-drop-mime-default) changed to new calling conventions
+ (dragdrop-drop-do-functions) changed to new calling conventions
+ (dragdrop-function-widget) this one needs more work...
+
+1998-05-10 Oliver Graf <ograf@fga.de>
+
+ * about.el: another small change in my entry
+ * dragdrop.el (dragdrop-drop-log-function): logging added
+ plus customizations
+ changed interface to handler functions. now called with event
+ and object
+
+1998-05-12 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * glyphs.el (divider-pointer-glyph): Declared new glyph,
+ E-W arrow pointer displayed over draggable dividers.
+
+ * mouse.el (default-mouse-motion-handler): Show it when
+ appropriate.
+ (drag-window-divider): Added.
+ ([top-level]): Initialized window-divider-map with a keymap
+ binding the above function to left button down event.
+
+ * x-mouse.el (x-init-pointer-shape): Initialize
+ divider-pointer-glyph from Cursor.dividerPointer, or use default
+ E-W double arrow.
+
+1998-04-30 Gunnar Evermann <Gunnar.Evermann@nats.informatik.uni-hamburg.de>
+
+ * toolbar-items.el (toolbar-compile): respect should-use-dialog-box-p
+
+1998-05-11 Hrvoje Niksic <hniksic@srce.hr>
+
+ * simple.el (count-words-buffer): Don't query for buffer.
+ (count-lines-buffer): Ditto.
+
+1998-05-11 Jan Vroonhof <vroonhof@math.ethz.ch>
+
+ * help.el (where-is): add optional insert argument.
+
+1998-05-11 Hrvoje Niksic <hniksic@srce.hr>
+
+ * help.el (describe-key-briefly): New argument INSERT.
+
+ * simple.el (eval-expression): New optional argument; synch with
+ FSF 20.3.
+
+ * keydefs.el (global-map): Add new register bindings.
+
+ * register.el: Synched with FSF 20.3.
+
+1998-05-11 Jan Vroonhof <vroonhof@math.ethz.ch>
+
+ * window-xemacs.el (recenter): all arguments are optional.
+
+1998-05-10 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * device.el: (device-pixel-width): Reflected name/parameters
+ change to device-system-metric.
+ (device-pixel-height): Ditto.
+ (device-mm-width): Ditto.
+ (device-mm-height): Ditto.
+ (device-bitplanes): Ditto.
+ (device-color-cells): Ditto.
+
+1998-05-10 Hrvoje Niksic <hniksic@srce.hr>
+
+ * cl-extra.el (cl-float-limits): Removed; move code to top-level.
+
+ * cl.el (most-positive-fixnum): Document.
+ (most-negative-fixnum): Ditto.
+
+ * cus-dep.el: Updated comment.
+
+ * cus-load.el: Use most-positive-fixnum as the gc-inhibiting
+ constant.
+
+ * cus-load.el (custom-put): Removed.
+
+ * files.el (after-find-file): Just resignal quit instead of
+ signaling "canceled".
+
+1998-05-10 Hrvoje Niksic <hniksic@srce.hr>
+
+ * frame.el (other-frame): Use `focus-frame' instead of
+ select-frame kludges.
+
+ * lisp-mode.el: Update lisp-indent-function for
+ save-selected-frame and with-selected-frame.
+
+ * frame.el (save-selected-frame): New macro.
+ (with-selected-frame): Ditto.
+ (other-frame): Use `set-frame-focus'.
+
+1998-05-06 Oliver Graf <ograf@fga.de>
+
+ * dragdrop.el (dragdrop-drop-dispatch): changed to new list concept
+ (dragdrop-drop-url-default) default handler for URL drops created
+ (dragdrop-drop-mime-default) default handler for MIME drops created
+ (dragdrop-drop-functions) default custom for handling drops created
+ (dragdrop-drop-do-functions) helper for drgadrop-drop-dispatch
+
+1998-05-05 Jonathan Harris <jhar@tardis.ed.ac.uk>
+
+ * mouse.el: Removed redundant mouse-mswindows-drop function.
+
+1998-05-05 Oliver Graf <ograf@fga.de>
+
+ * about.el: changed some text in my entry
+ * dragdrop.el: added customs
+
+1998-05-04 Oliver Graf <ograf@fga.de>
+
+ * mouse.el: killed global drop key bindings
+ (mouse-offix-drop) removed
+ * dragdrop.el: created
+ * dumped-lisp.el: inclusion of dragdrop.el for window-systems
+
+1998-05-09 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * x-scrollbar.el (x-init-scrollbar-from-resources): Initialize
+ scrollbar-on-{left,top}-p from *scrollBarPlacement resources.
+
+ * x-misc.el (x-get-resource-and-maybe-bogosity-check): Removed
+ obsolete comment.
+
+ * scrollbar.el (scrollbars-visible-p): Use new
+ {vertical,horizontal}-scrollbar-visible-p specifiers.
+
+1998-04-18 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * 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.
+
+1998-05-09 SL Baur <steve@altair.xemacs.org>
+
+ * dumped-lisp.el (preloaded-file-list): x-menubar.el and x-toolbar.el
+ were renamed.
+
+ * menubar-items.el:
+ * toolbar-items.el: Renamed from x-menubar/x-toolbar.
+ Suggested by Hrvoje Niksic <hniksic@srce.hr>
+
+ * help.el (help-map): Remove Hyperbole keybinding logic.
+ Suggested by: Michael Ernst <mernst@cs.washington.edu>
+
+1998-05-08 SL Baur <steve@altair.xemacs.org>
+
+ * x-menubar.el (default-menubar): Enable 'mail-user-agent' feature.
+ From SAKIYAMA Nobuo <nobuo@db3.so-net.or.jp>
+
+1998-05-07 Andy Piper <andyp@parallax.co.uk>
+
+ * msw-glyphs.el: use nicer icon3 from the frame icon.
+
+1998-05-07 SL Baur <steve@altair.xemacs.org>
+
+ * version.el (emacs-version): Remove InfoDock conditionals.
+
+ * startup.el (startup-splash-frame): Change ID logo name.
+
+1998-05-06 Hrvoje Niksic <hniksic@srce.hr>
+
+ * files.el (after-find-file): If the user presses C-g on
+ directory-creation prompt, kill the buffer.
+
+1998-05-06 SL Baur <steve@altair.xemacs.org>
+
+ * simple.el (count-words-region): Reverse previous change.
+
+1998-05-05 Hrvoje Niksic <hniksic@srce.hr>
+
+ * replace.el (query-replace): Just call perform-replace.
+ (query-replace-regexp): Ditto.
+ (perform-replace): Move region handling here.
+ (perform-replace): Use the new arg to match-data.
+
+1998-03-08 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * x-init.el: Install X specific display table that
+ displays char 0240 as a space to avoid whatever it is
+ that screws up display of that character code.
+
+1998-05-03 Hrvoje Niksic <hniksic@srce.hr>
+
+ * help.el (function-arglist): If no arguments are documented for a
+ subr, print nothing rather than incorrect output.
+
+1998-05-05 SL Baur <steve@altair.xemacs.org>
+
+ * cmdloop.el (command-error): Update bail-out error message to use
+ `emacs-program-name'.
+
+ * lib-complete.el: Remove reader macro cruft.
+
+ * dumped-lisp.el (preloaded-file-list): Phase I: remove InfoDock
+ cruft.
+
+ * simple.el (count-words-region): Drop interactive-p check on the
+ message.
+
+1998-05-04 Jonathan Harris <jhar@tardis.ed.ac.uk>
+
+ * font.el
+ * msw-faces.el
+ Correct spelling of mswindows-font-canonicalize-name.
+
+1998-05-03 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
+
+ * ldap.el (ldap-host-parameters-alist): Replaced with
+ `ldap-host-parameters-plist'
+ (ldap-search): Adapt to previous change
+
+1998-05-02 SL Baur <steve@altair.xemacs.org>
+
+ * about.el (about-hackers): Update Bob Weiner bio.
+ (about-maintainer-info): Ditto.
+
+1998-05-02 Hrvoje Niksic <hniksic@srce.hr>
+
+ * simple.el (display-warning-minimum-level): Docfix.
+
+1998-04-04 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * widget.el (:default-get): New keyword.
+ * wid-edit.el (default, widget-default-default-get): Define it.
+ (group, widget-group-default-get): Define it.
+ (menu-choice, widget-choice-default-get): Define it.
+ (widget-default-get): New function.
+ (widget-choice-action): Call it.
+ (widget-editable-list-entry-create): Call it.
+
+1998-05-01 Hrvoje Niksic <hniksic@srce.hr>
+
+ * byte-optimize.el (byte-boolean-vars): Removed.
+ (byte-optimize-lapcode): Use `built-in-variable-type' instead of
+ lookup through `byte-boolean-vars'.
+
+1998-05-01 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * x-scrollbar.el (x-init-scrollbar-from-resources): Stuff
+ resource-provided values into ghost specs for scrollbar-height and
+ scrollbar-width.
+
+1998-05-01 Hrvoje Niksic <hniksic@srce.hr>
+
+ * byte-optimize.el: Don't attempt to optimize /=.
+
+ * bytecomp.el (byte-compile-one-ore-more-args): New function.
+ (byte-compile-/=): Ditto.
+
+1998-05-02 SL Baur <steve@altair.xemacs.org>
+
+ * apropos.el: Use `with-displaying-help-buffer'.
+ (apropos-print): Remove explicit mentions of "*Apropos*" buffer.
+ Use `with-displaying-help-buffer'.
+ (apropos-follow): Do not give special treatment to buffer cursor
+ was in prior to a mouse click.
+ (apropos-describe-plist): Use `with-displaying-help-buffer'.
+ (apropos-print-doc): Set correct buffer for setting text
+ properties.
+
+1998-05-01 SL Baur <steve@altair.xemacs.org>
+
+ * help.el (help-buffer-prefix-string): New variable.
+ (help-buffer-name): Use it.
+
+ * modeline.el (modeline-minor-mode-menu): Alphabetize the minor
+ mode menu.
+
+1998-04-30 Greg Klanderman <greg@alphatech.com>
+
+ * frame.el (other-frame): Work even when focus-follows-mouse is true.
+
+1998-05-01 Hrvoje Niksic <hniksic@srce.hr>
+
+ * files.el (find-file-noselect): Update docstring.
+ (find-file-noselect): Signal an error if found an unreadable file.
+ (file-chase-links): Save the match data.
+ (normal-mode): Use `lwarn' and `error-message-string'.
+ (interpreter-mode-alist): Change defconst to defvar.
+ (inhibit-first-line-modes-regexps): Ditto.
+ (inhibit-first-line-modes-regexps): Added .tgz.
+ (inhibit-first-line-modes-suffixes): Change defconst to defvar.
+ (change-major-mode-with-file-name): New user-option.
+ (set-visited-file-name): Synched with FSF.
+ (file-name-extension): New function, from FSF 20.3.
+ (file-relative-name): Synched with FSF.
+ (save-some-buffers): Support the C-r feature.
+ (recover-session): Synched with FSF.
+ (kill-some-buffers): Ditto.
+ (set-auto-mode): New argument JUST-FROM-FILE-NAME.
+
+1998-04-30 SL Baur <steve@altair.xemacs.org>
+
+ * files.el (insert-file): Undo previous change and reenable use of
+ format.el.
+
+1998-04-30 Hrvoje Niksic <hniksic@srce.hr>
+
+ * window-xemacs.el (recenter): Define.
+
+1998-04-29 Andy Piper <andyp@parallax.co.uk>
+
+ * font.el (mswindows-font-create-name)
+ (mswindows-font-create-object): new functions for mswindows type
+ fonts.
+
+ * msw-faces.el (mswindows-font-canicolize-name): fix so that
+ strings are parsed as well as font objects.
+
+1998-04-30 Hrvoje Niksic <hniksic@srce.hr>
+
+ * modeline.el (defining-kbd-macro): Restore modeline indication of
+ kbd-macro being recorded.
+ (add-minor-mode): Simplify docstring.
+ (modeline-minor-mode-menu): Remove stuff.
+
+1998-04-29 Andy Piper <andyp@parallax.co.uk>
+
+ * code-process.el (call-process): dynamically decide process
+ coding type.
+
+1998-04-29 Jim Radford <radford@robby.caltech.edu>
+
+ * modeline.el: Add line-number-mode, column-number-mode to
+ the modeline minor-mode menu. Button2 on the line number does
+ goto-line.
+
+1998-04-29 Andy Piper <andyp@parallax.co.uk>
+
+ * mouse.el: move x-selection-owner-p type things to
+ selection-owner-p.
+
+ * msw-init.el: copy zmacs stuff from x-init.el
+
+ * msw-select.el (mswindows-own-selection)
+ (mswindows-disown-selection) (mswindows-selection-owner-p): new
+ functions. Very simple minded implementation of selectio
+ ownership.
+
+ * select.el (own-selection) (disown-selection)
+ (activate-region-as-selection) (select-make-extent-for-selection)
+ (valid-simple-selection-p): functions moved from x-select.el for
+ generalized selection.
+
+ * x-select.el: see select.el changes.
+
+ * x-toolbar.el: use new selection functions.
+
+1998-04-28 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * packages.el (packages-find-package-directories): Fixed bug that
+ would pick up multiple site-package directories.
+ (package-locations): Added "xemacs-packages" as a late package
+ location.
+
+ * find-paths.el: Now uses `emacs-program-name' and
+ `emacs-program-version'.
+ Additions to enforce version-specific directories in
+ `paths-find-version-directory'.
+
+1998-04-29 SL Baur <steve@altair.xemacs.org>
+
+ * default.el: Removed.
+ * site-start.el: Removed.
+
+1998-04-29 Didier Verna <verna@inf.enst.fr>
+
+ * minibuf.el (minibuffer-history-minimum-string-length): Default
+ to nil.
+
+1998-04-28 SL Baur <steve@altair.xemacs.org>
+
+ * find-paths.el (paths-program-name): Rename.
+ (paths-emacs-root-p): Ditto.
+ (paths-find-site-directory): Ditto.
+
+1998-04-26 Karl M. Hegbloom <karlheg@inetarena.com>
+
+ * lisp-mode.el (emacs-lisp-mode-popup-menu-1): Add menu entry for
+ `emacs-lisp-byte-compile-and-load'.
+
+1998-04-26 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
+
+ * ldap.el (ldap-search): Fixed additional parameter passing to
+ `ldap-open'
+
+1998-04-27 Andy Piper <andyp@parallax.co.uk>
+
+ * select.el (kill-primary-selection) (selection-owner-p)
+ (copy-primary-selection) (yank-clipboard-selection)
+ (selection-exists-p) (delete-primary-selection): new file and
+ functions that do the right thing for the selected device.
+
+ * x-menubar.el: use generalised selection functions.
+
+ * dumped-lisp.el: dump select.el.
+
+1998-04-27 SL Baur <steve@altair.xemacs.org>
+
+ * find-paths.el (paths-progname): New variable.
+ (paths-emacs-root-p): Use it.
+ (paths-find-site-directory): Ditto.
+
+1998-04-26 SL Baur <steve@altair.xemacs.org>
+
+ * loadup.el ((member "dump" command-line-args)): Dump as
+ `infodock' if InfoDock.
+
+1998-04-25 SL Baur <steve@altair.xemacs.org>
+
+ * find-paths.el (construct-emacs-version): Simplify, include
+ program name in the return value.
+ * (paths-find-version-directory): Use it.
+
+1998-04-25 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
+
+ * info.el (Info-parse-dir-entries): Fixed regexp
+ (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
+ file existence (could catch directories before)
+
+1998-04-25 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * setup-paths.el, find-paths.el: Removed uses of `not' which
+ temacs doesn't have.
+
+ * find-paths.el (paths-find-emacs-roots): Included exec-prefix
+ into root searching.
+
+1998-04-24 Martin Buchholz <martin@xemacs.org>
+
+ * subr.el: Remove definition of `not'.
+
+Sat Apr 24 1998 Andy Piper <andyp@parallax.co.uk>
+
+ * msw-glyphs.el: enable graphics support.
+
+1998-04-23 Didier Verna <verna@inf.enst.fr>
+
+ * x-menubar.el (default-menubar): restored the line-number-mode
+ option.
+
+ * misc doc string updates related to the options menu.
+
+1998-04-24 SL Baur <steve@altair.xemacs.org>
+
+ * setup-paths.el (paths-construct-load-path): Fix typo.
+
+1998-04-23 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * x-menubar.el (default-menubar): font-menu-this-frame-only-p and
+ font-menu-ignore-scaled-fonts don't have to be bound now; this
+ gets us one step further towards making --no-autoloads work.
+
+ * startup.el (normal-top-level): Load auto-autoloads only if
+ lisp-directory is non-nil.
+
+ * setup-paths.el (paths-construct-load-path): Made it robust
+ against nil lisp-directory.
+
+ * startup.el (startup-setup-paths-warning): Added `lisp-directory'
+ to the list of variables that cause a warning when nil.
+
+ * toolbar.el (init-toolbar-location): Now works even when there's
+ no toolbar icon directory.
+
+1998-04-23 Hrvoje Niksic <hniksic@srce.hr>
+
+ * help.el (view-lossage): Recognize it.
+
+ * simple.el (log-message): Mark multiline messages.
+
+1998-04-22 SL Baur <steve@altair.xemacs.org>
+
+ * info.el (Info-exit): `toolbar-info-frame' doesn't necessarily exist.
+
+1998-4-20 Stephen J. Turnbull <turnbull@sk.tsukuba.ac.jp>
+
+ * package-get.el (package-get-all): add `\n' separator to
+ interactive specification so that both variables are read
+
+1998-04-22 Didier Verna <verna@inf.enst.fr>
+
+ * x-menubar.el: ported the options menu to Custom.
+ Moved the "read only" toggle button to the buffers menu.
+ Corrected some missing ;;;###autoload or defcustom.
+
+ * scrollbar.el (scrollbars-visible-p): defcustom wrapper around
+ the scrollbar-visible specifier for options menu handling.
+
+ * toolbar.el (toolbar-visible-p)
+ (toolbar-captioned-p)
+ (default-toolbar-position): defcustom wrappers around
+ the toolbar specifiers for options menu handling.
+
+ * 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-mode for options menu handling.
+
+ * cus-start.el: added Custom properties to overwrite-mode for
+ options menu handling.
+
+Wed Apr 22 12:59:35 1998 Andy Piper <andyp@parallax.co.uk>
+
+ * about.el: shameless self-promotion.
+
+1998-04-21 Hrvoje Niksic <hniksic@srce.hr>
+
+ * simple.el (raw-append-message): Slightly optimize.
+ (remove-message): Use `push' for clarity.
+ (append-message): Ditto.
+ (display-warning): Dito.
+ (raw-append-message): Send the message to the appropriate device.
+
+1998-04-22 SL Baur <steve@altair.xemacs.org>
+
+ * auto-save.el (auto-save-cyclic-hash-14): De-ebolification.
+ From Sean MacLennan <Sean.MacLennan@pika.ca>
+
+1998-04-18 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * setup-paths.el: Changed `directory-sep-char' to
+ `path-separator', following a change in GNU Emacs.
+
+1998-04-19 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
+
+ * 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
+ is `always'
+ (Info-rebuild-dir): Ditto
+
+ * dumped-lisp.el (preloaded-file-list): Added ldap.el
+
+1998-04-21 SL Baur <steve@altair.xemacs.org>
+
+ * simple.el (count-words-buffer): Retain zmacs region.
+ (count-words-region): Ditto.
+ * simple.el: (what-line): Expanded line counts.
+ (count-lines): New parameter to conditionalize whether collapsed
+ lines get counted.
+ From Bob Weiner <weiner@altrasoft.com>
+
+1998-04-19 SL Baur <steve@altair.xemacs.org>
+
+ * packages.el (package-locations): infodock-packages must override
+ mule-packages and packages.
+
+1998-04-19 Jonathan Harris <jhar@tardis.ed.a.uk>
+
+ * wid-edit.el:
+ remove rude messages from widget-activation-widget-mapper
+ and widget-activation-glyph-mapper
+
+1998-04-17 Jonathan Harris <jhar@tardis.ed.ac.uk>
+
+ * toolbar.el: Remove (featurep 'x) test from
+ toolbar-make-button-list
+
+1998-04-17 Hrvoje Niksic <hniksic@srce.hr>
+
+ * gnuserv.el (gnuserv-edit): Switch to the next gnuserv buffer
+ only if in the same frame.
+
+1998-04-17 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * packages.el (package-locations): Added site-packages hierarchy.
+
+ * setup-paths.el (paths-default-info-directories): Introduced and
+ used.
+
+ * packages.el, setup-paths.el: Set various path searching depths
+ to 1.
+
+ * packages.el (packages-hierarchy-depth):
+ (packages-load-path-depth): Introduced and used.
+
+ * setup-paths.el (paths-load-path-depth): Introduced and used.
+
+ * find-paths.el (paths-find-recursive-path): Added max-depth
+ parameter.
+
+1998-04-15 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * setup-paths.el (paths-construct-info-path): Removed
+ dependency on behavior of (file-name-as-directory "").
+
+1998-04-09 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
+
+ * ldap.el (ldap-search): Adapt to the new low-level API using ldap
+ lisp objects
+
+1998-04-14 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * dump-paths.el, startup.el: Added handling for --debug-paths.
+
+1998-04-15 William M. Perry <wmperry@aventail.com>
+
+ * 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
+
+1998-04-15 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * scrollbar.el (init-scrollbar-from-resources): Call
+ mswindows-init-scrollbar-metrics when appropriate.
+
+Thu Apr 16 12:59:35 1998 Andy Piper <andyp@parallax.co.uk>
+
+ * dumped-lisp.el: dump x-toolbar for window system
+
+ * msw-init.el (init-post-mswindows-win): enable toolbars if we
+ have support and xpm.
+
+1998-04-16 SL Baur <steve@altair.xemacs.org>
+
+ * files.el (toggle-read-only): Fix docstring.
+ From Didier Verna <verna@inf.enst.fr>
+
+1998-04-14 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * startup.el (normal-top-level): Load autoload-file-name without
+ specifying an extension---some people only auto-autoload.el.gz.
+
+1998-04-06 Hrvoje Niksic <hniksic@srce.hr>
+
+ * files.el (backup-enable-predicate): Don't bomb on NAME being
+ nil.
+
+1998-04-13 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * find-paths.el, packages.el: Now prefers configure'd paths.
+ This shouldn't cause any of the originally anticipated problems as
+ the current paths architecture will not define the various
+ configure-xxx variables if they're not specified on the configure
+ command line.
+
+ * find-paths.el, setup-paths.el, packages.el: Removed all
+ mentionings of "/" as a path separator.
+ Used paths-construct-path throughout.
+
+ * find-paths.el (paths-construct-path): Created to assemble paths
+ from directory components.
+
+ * setup-paths.el, packages.el: Used paths-decode-directory-path
+ instead of decode-path-internal.
+
+ * find-paths.el: Removed unused (and bogus) paths-find-emacs-path
+ and associates.
+ (paths-decode-directory-path) Created.
+
+ * setup-paths.el: Changed configure-exec-path to
+ configure-exec-directory.
+
+1998-04-11 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * packages.el (packages-find-packages): Fixed decoding of
+ EMACSPACKAGEPATH.
+
+ * startup.el: -no-packages -> -no-early-packages.
+
+ (packages-load-package-lisps): Fixed loading of auto-autoload
+ files.
+
+ * startup.el (normal-top-level): Fixed loading of core
+ auto-autoload.
+
+ * obsolete.el: Un-obsoleted site-directory. Sigh.
+
+ * startup.el, packages.el, dump-paths.el: Added proper settings
+ for site-directory and lisp-directory variables.
+
+ * startup.el, loadup.el: Renamed inhibit-update-autoloads to
+ inhibit-package-autoloads and fixed handling of it.
+
+ * startup.el, packages.el, dump-paths.el, loadup.el: Fixed
+ handling of former inhibit-package-init, now
+ inhibit-early-packages, to make -vanilla etc. work.
+
+1998-04-10 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * code-process.el (start-process): Fallback to 'undecided instead
+ of 'binary for process input coding stream.
+
+ * process.el (start-process): Docstring fix.
+
+1998-04-09 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
+
+ * info.el (Info-insert-dir): Do not insert temporary dir files
+ in Info-dir-file-attributes
+ (Info-build-dir-anew): Ensure temporary buffer is not read-only
+ (Info-rebuild-dir): Ditto.
+
+1998-04-09 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * obsolete.el: Added obsoleteness declarations for
+ `site-directory' and `Info-default-directory-list'.
+
+1998-04-08 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * find-paths.el (paths-find-emacs-root): Only look at the
+ executable at the end of the symlink chain for determining the
+ Emacs root.
+
+1998-04-07 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * setup-paths.el (paths-construct-info-path): Changed construction
+ to cater to gone default in configure.
+
+ * find-paths.el (paths-uniq-append): Added.
+
+ * packages.el: Rewritten package path construction once again.
+
+ * dump-paths.el, startup.el: Removed package-path as a global
+ variable.
+
+ * package-admin.el (package-admin-add-single-file-package):
+ (package-admin-add-binary-package): Changed package-path to
+ late-packages.
+
+ * packages.el (packages-split-path): Split path at "/" rather than
+ nil according to change in emacs.c.
+
+1998-04-06 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * setup-paths.el (paths-construct-info-path): Changed info path
+ order so that directories come out right.
+ (paths-find-lock-directory): Fixed bug: It used to think
+ configure-lock-directory is a path.
+
+1998-04-06 Jeff Miller <jmiller@smart.net>
+
+ * 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.
+
+1998-04-07 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * code-files.el (file-coding-system-alist): Commented out
+ loaddefs.el magical treatment.
+
+1998-04-06 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
+
+ * info.el (Info-rebuild-outdated-dir): Added new option
+ `conservative' and made it the default
+ (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
+ temporary
+
+1998-04-04 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * list-mode.el (list-mode-map): Bind highlight motion commands to
+ standard keys left, right, C-b and C-f.
+
+1998-03-29 Karl M. Hegbloom <karlheg@bittersweet.inetarena.com>
+
+ * files.el (auto-mode-alist): allow .sc for Scheme->C
+
+1998-04-06 SL Baur <steve@altair.xemacs.org>
+
+ * loadup.el (pureload): Don't quote (garbage-collect).
+
+1998-04-04 SL Baur <steve@altair.xemacs.org>
+
+ * package-get-base.el: Updated.
+
+1998-04-04 Hrvoje Niksic <hniksic@srce.hr>
+
+ * isearch-mode.el (isearch-just-started): New variable.
+ (isearch-mode): Set it.
+ (isearch-repeat): Advance one character forward only if the search
+ was successful, and was not just started.
+ (isearch-repeat): Clear isearch-just-started.
+
+1998-04-02 SL Baur <steve@altair.xemacs.org>
+
+ * finder.el (finder-compile-keywords): Don't eval new finder-inf
+ if running -batch.
+
+1998-03-26 Hrvoje Niksic <hniksic@srce.hr>
+
+ * subr.el (listify-key-sequence): Removed.
+
+1998-03-31 Hrvoje Niksic <hniksic@srce.hr>
+
+ * bytecomp.el (byte-compile-print-gensym): New option.
+ (byte-compile-output-file-form): Use it.
+ (byte-compile-output-docform): Ditto.
+ (byte-compile-compiled-obj-to-list): Ditto.
+
+Sun Mar 29 1998 Andy Piper <andyp@parallax.co.uk>
+
+ * msw-glyphs.el: set frame icon if xpm support.
+
+1998-03-30 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * help.el: Code that pretty prints variable values
+ removed.
+
+1998-04-02 SL Baur <steve@altair.xemacs.org>
+
+ * find-paths.el (paths-emacs-root-p): Correct test for installation
+ directory.
+ From Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+1998-03-30 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * loaddefs.el: Don't set debug-ignored-errors; leave
+ its default value set to nil.
+
+1998-03-29 Damon Lipparelli <lipp@primus.com>
+
+ * info.el (Info-rebuild-dir): fixed mis-spelling.
+
+1998-03-29 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
+
+ * info.el (Info-rebuild-outdated-dir): New custom var
+ (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] <sperber@informatik.uni-tuebingen.de>
+
+ * setup-paths.el, dump-paths.el, startup.el, packages.el: Allowed
+ for last packages, mainly for using a 20.4 package base.
+
+ * packages.el (late-packages): Typo fix. It was called
+ early-packages.
+
+ * find-paths.el (paths-find-emacs-root): Bug fix: it now chases
+ relative symlinks correctly.
+ (paths-find-emacs-roots): More rigorous checking for plausible
+ configuration-time root.
+
+ * startup.el (normal-top-level): Added a warning if XEmacs cannot
+ find its roots.
+
+1998-03-27 Martin Buchholz <martin@xemacs.org>
+
+ * faces.el: Fix docstrings.
+ * glyphs.el: Fix docstrings.
+ * mouse.el: Fix docstrings.
+
+ * frame.el: Change phrase `current frame' to `selected frame'.
+
+ * faces.el (face-spec-set-match-display): Make FRAME arg optional.
+
+ * bytecomp.el (displaying-byte-compile-warnings): Rewrite some
+ macros using backquote to make them infinitely more readable.
+
+1998-03-30 SL Baur <steve@altair.xemacs.org>
+
+ * packages.el (packages-find-package-path): Hardcoded specialized
+ InfoDock support until we can clean this up.
+
+ * help.el (describe-bindings-1): Return the value of the bindings
+ help buffer created.
+ (describe-bindings): Ditto.
+
+ * simple.el (set-variable): Restore previous behavior of not
+ bombing if the variable to set is not boundp.
+
+1998-03-30 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * packages.el (packages-handle-package-dumped-lisps): Allow for
+ non-local files to be loaded off the package-lisp variable.
+
+1998-03-27 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * x-faces.el: Global X resources should override
+ specs for all device classes (color, grayscale, mono);
+ code currently doesn't override any of them. Fixed by
+ calling remove-specifier with '(x default) as the tag
+ set and allowing inexact matches.
+
+1998-03-27 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * faces.el: Separated face intializations based on
+ device classes into device type specific (tag set,
+ instantiator) pairs.
+
+1998-03-09 Hrvoje Niksic <hniksic@srce.hr>
+
+ * wid-edit.el (widget-choice-action): Remember user's explicit
+ choice.
+ (widget-choice-value-create): Respect it.
+ From Richard Stallman <rms@gnu.org>
+
+1998-03-26 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * setup-paths.el (paths-construct-info-path): Always append
+ existing directories from configure-time info path.
+
+ * startup.el (startup-setup-paths): Renamed misnamed info-path to
+ Info-directory-list.
+
+ * info.el: Removed Info-default-directory-list which was broken by
+ design.
+ Removed bogus initialization of Info-directory-list---startup.el
+ can do a much better job.
+ Added autoload of Info-directory-list.
+
+ * setup-paths.el (paths-construct-load-path): Fixed a bug pointed
+ out by Martin Buchholz <martin@xemacs.org>: EMACSLOADPATH used to
+ be exclusive; now it's merely given precedence, just like in the
+ old days.
+
+1998-03-25 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * find-paths.el (paths-find-architecture-directory): Fix bug with
+ finding; it used to default too early.
+
+1998-03-25 Martin Buchholz <martin@xemacs.org>
+
+ * packages.el (packages-split-path): Fix a bug; it used to fail
+ for paths that weren't split.
+
+1998-03-26 SL Baur <steve@altair.xemacs.org>
+
+ * finder.el (finder-compile-keywords): trap on errors.
+
+1998-03-24 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * x-faces.el (remove-specifier-specs-matching-tag-set-cdrs): Pass
+ fourth argument of t so that only the specs exactly
+ matching the tag lists are removed.
+
+1998-03-25 SL Baur <steve@altair.xemacs.org>
+
+ * make-docfile.el: Don't discard the BOOTSTRAPLOADPATH.
+
+1998-03-23 SL Baur <steve@altair.xemacs.org>
+
+ * minibuf.el (mouse-read-file-name-1): If a default directory was
+ specified, use it for generating the completions.
+
+1998-03-23 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * update-elc.el: Now respects inhibit-package-init and
+ inhibit-site-lisp.
+ Now does path construction with loadup-paths.
+
+ * startup.el (normal-top-level, startup-setup-paths): Now respects
+ inhibit-package-init and inhibit-site-lisp.
+
+ * packages.el (packages-find-package-path): Extended package path
+ by version-specific hierarchies.
+ (packages-find-packages): Now respects inhibit flag and
+ inhibit-site-lisp.
+ Moved path setup to loadup-paths.
+
+ * make-docfile.el: Now respects inhibit-package-init and
+ inhibit-site-lisp.
+ Now does path construction with loadup-paths.
+
+ * loadup.el: Now respects inhibit-package-init and
+ inhibit-site-lisp.
+
+ * dumped-lisp.el (preloaded-file-list): Added loadup-paths.
+
+ * loadup-paths.el: New file: setup load-path to encompass
+ packages.
+
+1998-03-22 SL Baur <steve@altair.xemacs.org>
+
+ * auto-show.el: load-gc renamed to pureload.
+ * site-load.el: Ditto.
+ * packages.el (toplevel): Ditto.
+ * loadup.el (really-early-error-handler): Ditto.
+ * dumped-lisp.el (preloaded-file-list): Ditto.
+ * cus-face.el (custom-declare-face): Ditto.
+
+1998-03-22 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de>
+
+ * <Today>: The Big Path Searching Overhaul.
+
+ * find-paths.el: New file: find and assemble paths in the
+ installation hierarchy.
+
+ * setup-paths.el: New file: global layout of paths and directories
+ within the XEmacs hierarchy.
+
+ * packages.el: Replaced everything related to path searching and
+ startup by code in terms of find-paths.
+
+ * loadup.el, make-docfile.el, update-elc.el, startup.el: Now calls
+ the new path searching engine.
+
+ * dumped-lisp.el (preloaded-file-list): Added new files find-paths
+ and setup-paths.
+
+1998-03-22 SL Baur <steve@altair.xemacs.org>
+
+ * dumped-lisp.el (preloaded-file-list): Load setup-paths.elc not
+ setup-paths.el.
+
+1998-03-20 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * msw-glyphs.el: Added check for 'mswindows feature, so the file
+ compiles identically in any configuration.
+ Removed irrelevant commentary.
+
+1998-03-20 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * simple.el (set-variable): Allow setting specifiers.
+
+1998-03-19 SL Baur <steve@altair.xemacs.org>
+
+ * lisp.el (forward-sexp): Revert previous change.
+
+1998-03-18 SL Baur <steve@altair.xemacs.org>
+
+ * frame.el (frame-initialize): Use `delete-console' instead of
+ `delete-device' to delete the stream console to match the usage in
+ Fkill_emacs.
+
+1998-03-16 SL Baur <steve@altair.xemacs.org>
+
+ * files.el (cdpath-previous): New variable.
+ (cd): Use it.
+ From Bob Weiner <weiner@wave.altrasoft.com>
+
+1998-03-15 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * keydefs.el: Changed keybindings of forward-char,
+ backward, scroll-up and scroll-down to point to their
+ -command counterparts.
+
+ * simple.el: New functions: forwarc-char-command,
+ backwrad-char-command, scroll-up-command,
+ scroll-down-command which work liek their counterparts
+ except that they honor the variable
+ signal-error-on-buffer-boundary.
+
+ Definition of signal-error-on-buffer-boundary received
+ from src/cmds.c.
+
+ defvar declaration added for word-across-newline to avoid
+ byte-compiler warning about the free variable reference.
+
+1998-03-14 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * winnt.el: Removed "%t" from the beginning of
+ modeline-format. From now on, there's no nt-specifics in the modeline.
+
+1998-03-14 SL Baur <steve@altair.xemacs.org>
+
+ * setup-paths.el (paths-setup-paths-warning): Replace occurrences
+ of `when' with `if'.
+
+1998-03-03 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * msw-glyphs.el: New file. Defines TTY-style glyphs for
+ 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.
+
+1998-03-13 SL Baur <steve@altair.xemacs.org>
+
+ * faces.el: fix for text cursor initialization.
+ Suggested by Kyle Jones <kyle_jones@wonderworks.com>
+ From Andy Piper <andyp@parallax.co.uk>
+
+1998-03-11 Pete Ware <ware@cis.ohio-state.edu>
+
+ * 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.
+
+1998-03-02 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * x-menubar.el (default-menubar): Greyed out "Help / Basics /
+ Installation" menu item when Installation-string is not bound.
+
+1998-03-11 SL Baur <steve@altair.xemacs.org>
+
+ * lisp.el (forward-sexp): Fix for test for balanced sexp.
+ From Jeremiah W. James <jerry@cs.ucsb.edu>
+
+1998-03-10 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * msw-faces.el:
+ * faces.el: Fix face initialization.
+
+1998-03-10 Glynn Clements <glynn@sensei.co.uk>
+
+ * files.el (backup-enable-predicate): fix breakage introduced
+ by TMPDIR patch.
+
+1998-03-09 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * x-faces.el (x-init-face-from-resources): The
+ TTY face property retrieval functions don't return
+ specifiers, so use face-property instead.
+
+1998-03-09 SL Baur <steve@altair.xemacs.org>
+
+ * mwheel.el (mwheel-install): Use portable keysyms and syntax.
+
+1998-03-09 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * x-menubar.el: Expanded documentation for
+ option-save-faces. Changed Options -> Browse Faces
+ menu entry to invoke customize-face.
+
+1998-03-09 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * faces.el: Most face initialization moved out of
+ init-other-random-faces to the top level so that the
+ initialization happens before Xemacs is dumped. Much
+ of the fascist "face-differs-from-default-p or FROB!"
+ code has been retired in favor of letting the user do
+ what they want to do. Face initialization code changed
+ to use `default' specifier tag so that the settings can
+ be overridden later if the user wishes it.
+
+1998-03-08 SL Baur <steve@altair.xemacs.org>
+
+ * about.el (about-hackers): Update contributors list.
+
+1998-03-07 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * specifier.el: Define new specifier tag `default'.
+
+ * modeline.el: Initialize faces using `default' tag.
+
+ * x-faces.el (x-init-face-from-resources): Remove
+ specifier specs containing the `default' tag before
+ adding new specs.
+
+1998-03-02 John Jones <jj@asu.edu>
+
+ * package-get.el (package-get-all): fixed arguments on call to
+ package-admin-add-single-file-package.
+ * package-get.el (package-get-installedp): fixed to match
+ advertised behavior.
+ * package-get.el: added function package-get-update-all which
+ installs newest versions of all the current packages (if they are
+ not already installed).
+
+1998-03-04 Jens-Ulrik Petersen <petersen@kurims.kyoto-u.ac.jp>
+
+ * files.el (find-file-noselect): Uncommented `truename' binding in
+ `let*' and use it later to set `buffer-file-truename' iff it's
+ still nil, as happens for example when finding a compressed
+ file with "jka-compr".
+
+Wed Mar 04 08:55:12 1998 Andy Piper <andyp@parallax.co.uk>
+
+ * faces.el: in make-face-* type functions do the operation for all
+ window systems, not just the first one found.
+
+ * font.el: call mswindows-list-fonts for mswindows.
+
+1998-03-02 Glynn Clements <glynn@sensei.co.uk>
+
+ * code-process.el (call-process-region):
+ * process.el (call-process-region):
+ * package-get.el (package-get-dir):
+ * files.el (backup-enable-predicate):
+ * gnuserv.el (gnuserv-temp-file-regexp):
+ Use temp-directory in place of `/tmp'.
+
+Fri Feb 20 21:22:34 1998 Darryl Okahata <darrylo@sr.hp.com>
+
+ * "Fast" dired-in-C enhancements for Windows 95/NT:
+
+ * files.el: Added function, `wildcard-to-regexp', from GNU
+ Emacs.
+
+ * files.el (insert-directory): Modified to use special
+ dired-in-C enhancements if present.
+
+Mon Mar 02 11:37:36 1998 Andy Piper <andyp@parallax.co.uk>
+
+ * code-files.el: make default coding no-conversion.
+
+1998-03-02 SL Baur <steve@altair.xemacs.org>
+
+ * dumped-lisp.el (preloaded-file-list): Find Installation.el from
+ the load-path.
+
+ * update-elc.el: Strip directory when testing for files not to
+ bytecompile.
+
+1998-03-02 Aki Vehtari <Aki.Vehtari@hut.fi>
+
+ * lisp-mode.el: Use recommended form for menus.
+
+ * info.el (Info-construct-menu): Use recommended form for menus.
+
+ * gnuserv.el (gnuserv-edit-files): Use recommended form for menu
+ entry.
+
+1998-02-28 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * frame.el: Resurrect get-frame-for-buffer-default-to-current.
+ (get-frame-for-buffer-noselect): Always return frames
+ in the not-this-window-p cond clause.
+
+1998-02-27 SL Baur <steve@altair.xemacs.org>
+
+ * help.el (describe-installation): New function.
+
+ * x-menubar.el (default-menubar): Add describe-installation to
+ Help menu.
+
+ * packages.el (packages-unbytecompiled-lisp): Installation.el
+ should not be bytecompiled.
+
+ * dumped-lisp.el (preloaded-file-list): Dump Installation with
+ XEmacs.
+
+ * x-menubar.el (default-menubar): Use correct guard for VM menu
+ entry.
+
+ * coding.el: Add coding systems for iso-8859-[12] for No-Mule + file
+ coding.
+ From Andy Piper <andyp@parallax.co.uk>
+
+1998-02-26 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
+
+ * ldap.el: Do not require ldap-internal at compile time.
+
+Tue Feb 17 12:50:37 1998 Andy Piper <andyp@parallax.co.uk>
+
+ * code-files.el: new file. a virtual copy of mule-files.el
+ but without charset
+ dependencies. (toggle-buffer-file-ocding-system) new function for
+ changing the eol type for the current buffer.
+
+ * code-process.el: new file. a copy of
+ mule-process.el. mule-process.el will disappear when things have
+ settled.
+
+ * coding.el: new file. a virtual copy of mule-files.el but
+ without charset dependencies. (coding-system-base) new function
+ for getting the parent coding system of a coding system with eol
+ type set.
+
+ * dumped-lisp.el: add above files for the non-mule case.
+
+1998-02-25 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * window-xemacs.el (display-buffer): If no explicit
+ frame is specified, search for a window that displays
+ the buffer on the currently selected frame, before
+ searching other frames.
+
+1998-02-25 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * frame.el (get-frame-for-buffer): If not-this-window-p
+ is non-nil, use window on the selected frame if it is not
+ also the selected window. When defaulting, search for
+ windows on the currently selected fgrame before searching
+ other frames.
+
+1998-02-25 Didier Verna <verna@inf.enst.fr>
+
+ * modeline.el (modeline-swap-buffers): originally named
+ `mouse-release-modeline'. Whether to actually swap the buffers is
+ 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.
+
+1998-02-25 SL Baur <steve@altair.xemacs.org>
+
+ * x-menubar.el: Put redo on the menubar.
+ From Aki Vehtari <Aki.Vehtari@hut.fi>
+
+1998-02-22 Greg Klanderman <greg@alphatech.com>
+
+ * bytecomp.el (displaying-byte-compile-warnings): if
+ temp-buffer-show-function is set, use it to display current set of
+ warnings in the "*Compile-Log-Show*" buffer.
+
+ * simple.el (display-warning-buffer): if temp-buffer-show-function
+ is set, use it to display current set of warnings in the
+ "*Warnings-Show*" buffer.
+
+1998-02-20 Karl M. Hegbloom <karlheg@bittersweet.inetarena.com>
+
+ * cl-extra.el (equalp): Make (equalp ?A ?a) return t as in
+ Common Lisp.
+
+1998-02-23 Aki Vehtari <Aki.Vehtari@hut.fi>
+
+ * menubar.el: Allow button descriptors at least 2 long.
+
+ * x-menubar.el (default-menubar): Use recommended forms.
+ (file-menu-filter): Remove.
+ (edit-menu-filter): Remove.
+
+1998-02-24 SL Baur <steve@altair.xemacs.org>
+
+ * about.el (about-hackers): Updated.
+
+1998-02-22 Greg Klanderman <greg@alphatech.com>
+
+ * help.el (help-max-help-buffers): new variable
+ (help-register-and-maybe-prune-excess): new function
+ (help-buffer-name): use help-max-help-buffers.
+ (with-displaying-help-buffer): use
+ help-register-and-maybe-prune-excess.
+
+ * help.el (help-maybe-pretty-print-value): if the value fits on
+ one line, let it.
+
+1998-02-21 Greg Klanderman <greg@alphatech.com>
+
+ * (with-displaying-help-buffer): there is no need to kill the buffer
+ 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
+ configuration, hosing temp-buffer-show-function.
+
+
+1998-02-23 Didier Verna <verna@inf.enst.fr>
+
+ * 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)
+ as horizontal reference for modeline dragging. This allows us to
+ keep on dragging the modeline even if the motion event occurs in
+ another window.
+
+1998-02-23 Didier Verna <verna@inf.enst.fr>
+
+ * x-mouse.el (x-init-pointer-shape): use a crossed-arrows cursor
+ glyph on the modeline to indicate that dragging the mouse has an
+ effect both horizontally and vertically.
+
+1998-02-24 SL Baur <steve@altair.xemacs.org>
+
+ * about.el (about-xemacs): Get rid of redundant visible version
+ number.
+
+1998-02-19 SL Baur <steve@altair.xemacs.org>
+
+ * about.el (about-hackers): Update credits.
+
+1997-12-22 Christoph Wedler <wedler@fmi.uni-passau.de>
+
+ * prim/register.el (view-register): Show register type file-query.
+
+1998-02-17 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * mode-motion.el (mode-motion-highlight-internal):
+ save-excursion inside save-window-exucrsion form to
+ hide buffer point changes from save-window-excursion.
+ Prevents display flickering when the mouse pointer
+ moves.
+
+1998-02-17 Didier Verna <verna@inf.enst.fr>
+
+ * mouse.el (default-mouse-track-set-point-in-window): rewrote this
+ function to handle correctly the case of a toolbar one side of the
+ window: scrolling will not necessarily happen.
+
+1998-02-17 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * files.el (after-find-file): Restore missing argument
+ to format that provides filename for "... consider M-x
+ recover-file" message. Also call `message' with "%s"
+ as the first arg instead of an arbitrary string.
+
+1998-02-18 SL Baur <steve@altair.xemacs.org>
+
+ * about.el (about-hackers): Various additions.
+
+1998-02-15 SL Baur <steve@altair.xemacs.org>
+
+ * 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
+ is installed.
+
+1998-02-14 Martin Buchholz <martin@xemacs.org>
+
+ * 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):
+ 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.
+ Clean up symbols used with dead keys, checking Linux and solaris
+ keysyms.
+ Simplify x-win-*.el using above methods.
+ Change documentation for x-keysym-*-p functions.
+
+1998-02-14 SL Baur <steve@altair.xemacs.org>
+
+ * about.el (about-hackers): Restore entries for Michael Sperber and
+ Vinnie Shelton.
+ From Vinnie Shelton <acs@acm.org>
+
+1998-02-14 Hrvoje Niksic <hniksic@srce.hr>
+
+ * simple.el (count-words-region): Ditto.
+
+1998-02-12 Hrvoje Niksic <hniksic@srce.hr>
+
+ * simple.el (count-words-buffer): Document. Don't print anything
+ if non-interactive.
+
+1998-02-12 SL Baur <steve@altair.xemacs.org>
+
+ * packages.el (packages-hardcoded-lisp): easymenu.el is in
+ multiple files in InfoDock.
+
+1998-02-11 SL Baur <steve@altair.xemacs.org>
+
+ * packages.el (packages-hardcoded-lisp): id-vers.elc is loaded
+ from version.el in InfoDock.
+
+ * dumped-lisp.el (preloaded-file-list): Don't treat InfoDock
+ specially.
+
+1998-02-09 Karl M. Hegbloom <karlheg@bittersweet.inetarena.com>
+
+ * bytecomp-runtime.el (proclaim-inline): Single quotes around
+ variable name in docstring.
+
+1998-02-10 Andreas Jaeger <aj@arthur.rhein-neckar.de>
+
+ * menubar.h: Include "gui.h".
+
+1998-02-10 SL Baur <steve@altair.xemacs.org>
+
+ * site-load.el: Fix documentation.
+
+1998-02-09 SL Baur <steve@altair.xemacs.org>
+
+ * package-get-base.el (package-get-base): Updated.
+
+ * keymap.el: PC-ize.
+
+1998-02-08 Karl M. Hegbloom <karlheg@bittersweet.inetarena.com>
+
+ * hyper-apropos.el (hyper-apropos-get-doc): Print the `loaded
+ from' on a fresh line.
+
+1998-02-08 Hrvoje Niksic <hniksic@srce.hr>
+
+ * help.el (help-maybe-pretty-print-value): prin1, not princ the
+ object.
+
+1998-02-09 SL Baur <steve@altair.xemacs.org>
+
+ * undo-stack.el: PC-ize.
+
+ * cmdloop.el: PC-ize.
+
+1998-02-08 SL Baur <steve@altair.xemacs.org>
+
+ * bytecomp-runtime.el: PC-ize.
+
+ * byte-optimize.el: Prolog fixup. PC-ize.
+
+ * cus-dep.el: Spelling fix.
+
+ * text-mode.el: Synch with Emacs 20.2. (Original ChangeLog
+ entries follow).
+
+1997-08-29 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
+
+ * text-mode.el (text-mode-hook-identify): New function,
+ put on text-mode-hook. Set text-mode-variant here.
+ (text-mode): Don't set it here.
+
+1997-08-27 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
+
+ * text-mode.el (text-mode-hook): New defvar.
+ (text-mode-variant): New variable.
+ (text-mode): Set that variable locally.
+ (toggle-text-mode-auto-fill): New command.
+
+1997-06-15 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
+
+ * text-mode.el (text-mode): Let all-white lines separate paragraphs.
+
+1997-06-11 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
+
+ * text-mode.el (paragraph-indent-text-mode):
+ Renamed from spaced-text-mode.
+ (text-mode-map): Bind TAB to indent-relative.
+ (indented-text-mode-map): Variable deleted.
+ (indented-text-mode): Now an alias for text-mode.
+
+1998-02-05 SL Baur <steve@altair.xemacs.org>
+
+ * loadup.el: test-atoms debugging stuffs removed.
+
+1998-02-03 Martin Buchholz <Martin Buchholz <martin@xemacs.org>>
+
+ * lisp/loaddefs.el (completion-ignored-extensions): Add ".class"
+
+1997-12-30 Colin Rafferty <colin@xemacs.org>
+
+ * help.el (describe-beta): Made it use `locate-data-file'.
+ (describe-distribution): Ditto.
+ (describe-copying): Ditto.
+ (describe-project): Ditto.
+ (view-emacs-news): Ditto.
+
+ * help-nomule.el (help-with-tutorial): Made it use
+ `locate-data-file' to find tutorial.
+
+1998-01-28 Jonathon Harris <jhar@tardis.ed.ac.uk>
+
+ * about.el: Corrected my email address.
+
+ * mouse.el: Added 'mouse-mswindows-drop' similar to
+ 'mouse-offix-drop'.
+
+1998-01-27 SL Baur <steve@altair.xemacs.org>
+
+ * loadup.el (running-xemacs): Spelling fix.
+
+1998-01-26 Colin Rafferty <colin@xemacs.org>
+
+ * packages.el (packages-find-packages-1): Don't allow a backwards
+ compatible lisp tree to overwrite `preloaded-file-list'.
+
+1998-01-26 SL Baur <steve@altair.xemacs.org>
+
+ * loadup.el: Don't delete "xemacs" prior to dumping.
+
+1998-01-24 SL Baur <steve@altair.xemacs.org>
+
+ * package-info.el (pi-last-mod-date): New function.
+ (pi-author-version): New function.
+ (batch-update-package-info): Use them.
+
+1998-01-23 Colin Rafferty <colin@xemacs.org>
+
+ * frame.el (get-frame-for-buffer-default-to-current): Create.
+ (get-frame-for-buffer-noselect): Allow user to use current frame
+ with `get-frame-for-buffer-default-to-current'.
+
+1998-01-22 Hrvoje Niksic <hniksic@srce.hr>
+
+ * bytecomp.el (byte-compile-output-file-form): Set print-gensym.
+ (byte-compile-output-docform): Ditto.
+ (byte-compile-compiled-obj-to-list): Ditto.
+
+1998-01-22 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * startup.el (command-line-1): Removed code that ran
+ buffer-menu.
+
+1998-01-21 Hrvoje Niksic <hniksic@srce.hr>
+
+ * help-macro.el (make-help-screen): Bind `help-read-key' via flet.
+
+1998-01-17 Hrvoje Niksic <hniksic@srce.hr>
+
+ * frame.el (suspend-emacs-or-iconify-frame): Check using
+ `device-on-window-system-p' instead of explicitly checking for X,
+ so that the same logic works for MS Windows.
+ (suspend-or-iconify-emacs): Ditto.
+
+1998-01-14 Hrvoje Niksic <hniksic@srce.hr>
+
+ * about.el (about-maintainer-info): Andy Piper is back.
+ (xemacs-hackers): Updated Andy Piper's email address.
+ (about-hackers): Added Jonathan Harris.
+ (about-hackers): Updated Tibor Polgar's email address.
+
+1998-01-18 SL Baur <steve@altair.xemacs.org>
+
+ * about.el: Add xemacs.org email manager.
+
+ * package-get-base.el (package-get-base): Updated with most recent
+ package updates.
+
+1998-01-14 Jens-Ulrik Holger Petersen <petersen@kurims.kyoto-u.ac.jp>
+
+ * help.el (function-arglist): Use `indirect-function' instead of
+ `symbol-function' so that aliases are treated correctly.
+
+1998-01-13 Jens-Ulrik Holger Petersen <petersen@kurims.kyoto-u.ac.jp>
+
+ * help.el (help-map): Add f1 binding to `help-for-help'.
+ Suggested by Karl M. Hegbloom <karlheg@inetarena.com>.
+ (describe-key-briefly): Use `princ' "%s" to print object.
+ (with-displaying-help-buffer): Kill buffer if it exists, again.
+ (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
+ of variable values.
+ (help-maybe-pretty-print-value): Steve wins! Renamed back from
+ `help-pretty-print-value' again. Only print-print when OBJECT is
+ list of length less than `help-pretty-print-limit'.
+ (describe-variable): Use `help-maybe-pretty-print-value' again.
+
+1998-01-18 SL Baur <steve@altair.xemacs.org>
+
+ * simple.el (blink-matching-open): Remove C++ kludge.
+ Suggested by Bob Weiner <weiner@wave.altrasoft.com>
+
+1998-01-14 Karl M. Hegbloom <karlheg@bittersweet.inetarena.com>
+
+ * info.el (Info-default-directory-list): Made the documentation
+ more explanitory.
+
+1998-01-13 Martin Buchholz <martin@xemacs.org>
+
+ * lisp/packages.el:
+ * lisp/package-admin.el:
+ * lisp/build-report.el:
+ Fix typos.
+
+1998-01-14 Christoph Wedler <wedler@fmi.uni-passau.de>
+
+ * Patches/font-lock.el (java-font-lock-keywords-*): Would produce
+ warnings in Java buffers without final newline and editing the
+ last line.
+
+1998-01-17 SL Baur <steve@altair.xemacs.org>
+
+ * packages.el (packages-find-packages-1): Don't allow a backwards
+ compatible lisp tree to overwrite `preloaded-file-list'.
+ Suggested by Colin Rafferty <colin@xemacs.org>
+
+ * mouse.el (mouse-offix-drop): Set undo-boundary.
+ From Oliver Graf <ograf@fga.de>
+
+1998-01-13 SL Baur <steve@altair.xemacs.org>
+
+ * loadup.el (load-gc): rewrite as defun.
+ Print something sensical if a required dump-time file isn't found.
+
+1998-01-12 SL Baur <steve@altair.xemacs.org>
+
+ * menubar.el (check-menu-syntax): Emergency dirty fix -- the 0 plist
+ bug strikes a menudescriptor.
+
+ * package-get-base.el (package-get-base): Updated.
+
+ * package-info.el (batch-update-package-info): Derive REQUIRES
+ from the Makefile.
+
+1998-01-13 Hrvoje Niksic <hniksic@srce.hr>
+
+ * files.el (save-some-buffers): Don't play games with deleting
+ other windows if we are in the minibuffer window.
+
+1998-01-08 Karl M. Hegbloom <karlheg@bittersweet.inetarena.com>
+
+ * modeline.el (modeline-minor-mode-menu): Add support for :active
+ (add-minor-mode): Document :active property to TOGGLE.
+
+1998-01-07 Karl M. Hegbloom <karlheg@bittersweet.inetarena.com>
+
+ * modeline.el (modeline-minor-mode-menu): Add support for an
+ `:included' predicate in the `toggle-sym' plist.
+ (add-minor-mode): Document the :included property, format
+ docstring some more.
+ (modeline-minor-mode-menu): Documentation string added.
+
+1998-01-02 Karl M. Hegbloom <karlheg@bittersweet.inetarena.com>
+
+ * modeline.el (modeline-minor-mode-menu): genmenlab the menu
+ labels from the symbol-names by thwacking off the overly redundant
+ and overused "mode", parenthesizing "minor", and capitalizing the
+ resultant strings. Also shortened the menu's title by eliminating
+ the redundant buffer name.
+ (add-minor-mode): Beautified the docstring, added mention of the
+ `:menu-tag' property of TOGGLE.
+ (modeline-minor-mode-menu): Frinked the `:menu-tag' property on
+ `toggle-sym' to beatify the mode-life menus.
+ * (abbrev-mode): (put)'ed a `:menu-tag' on it and
+ `auto-fill-function'.
+
+1998-01-02 Karl M. Hegbloom <<karlheg@bittersweet.inetarena.com>>
+
+ * modeline.el (modeline-minor-mode-menu): Changed the string-only
+ menus to :style 'toggle.
+
+1997-12-10 Markus Linnala <maage@cs.tut.fi>
+
+ * simple.el: Use mh-user-agent-compose as mh-e-user-agent.
+
+1997-12-11 Christoph Wedler <wedler@fmi.uni-passau.de>
+
+ * packages/hyper-apropos.el (hyper-apropos-insert-face): Would
+ only recognize first hyperlink.
+ (hyper-apropos-highlightify): Deletia, this is already done by
+ `hyper-apropos-insert-face'.
+ (hyper-apropos-help-mode): Don't call `hyper-apropos-highlightify.
+
+1998-01-09 SL Baur <steve@altair.xemacs.org>
+
+ * x-toolbar.el (toolbar-ispell-internal): Use ispell-message for
+ mail.
+ (toolbar-mail-reader): Add support for `send'.
+ From Jonathan Marten <jonathan.marten@UK.Sun.COM>
+
+1998-01-05 Karl M. Hegbloom <<karlheg@bittersweet.inetarena.com>>
+
+ * info.el (Info-emacs-info-file-name): Add defvar for
+ `Info-emacs-info-file-name' so that `Info-goto-emacs-command-node'
+ will function properly.
+
+1998-01-05 Gary D. Foster <gfoster@ragesoft.com>
+
+ * simple.el: make the backwards delete function called by
+ `backward-or-forward-delete-char' user configurable.
+
+1998-01-09 Karl M. Hegbloom <karlheg@bittersweet.inetarena.com>
+
+ * hyper-apropos.el (hyper-apropos-get-doc): Print where a byte
+ compiled function got loaded from.
+
+1998-01-09 SL Baur <steve@altair.xemacs.org>
+
+ * term/apollo.el: Synched up with InfoDock 3.6.2.
+
+1998-01-08 SL Baur <steve@altair.xemacs.org>
+
+ * startup.el (load-init-file): Load autoloads earlier.
+ (startup-splash-frame): Handle InfoDock logo.
+
+ * x-init.el (init-post-x-win): Don't call init-x-toolbar in
+ InfoDock.
+ (x-init-toolbar-from-resources): Move from x-toolbar.el.
+
+ * toolbar.el (init-toolbar-from-resources): InfoDock x-toolbar.el
+ doesn't have this function.
+
+ * packages.el (locate-data-file): Fix to call `locate-file'.
+
+1998-01-07 SL Baur <steve@altair.xemacs.org>
+
+ * dumped-lisp.el (preloaded-file-list): InfoDock uses its own
+ version of version.el.
+ (preloaded-file-list): Ditto for x-menubar.el and x-toolbar.el.
+
+ * x-menubar.el (default-menubar): Guard reference to
+ `gnuserv-frame'.
+ (default-menubar): Guard references to `font-lock-mode'.
+ (default-menubar): Guard references to font-menu-this-frame-only-p'.
+ (default-menubar): Guard references to `font-menu-ignore-scaled-fonts'.
+
+ * make-docfile.el: Don't snarf doc strings from autoloads.
+
+ * startup.el (load-init-file): Use algorithm from loaddefs.el for
+ loading auto-autoloads files.
+
+ * loaddefs.el: Disable dumping autoloads.
+
+1998-01-05 SL Baur <steve@altair.xemacs.org>
+
+ * lisp-mnt.el: Synch to Emacs 20.2.
+
+ * help.el: Remove manual autoload of `finder-by-keyword'.
+
+ * finder.el (finder-by-keyword): Autoload.
+
+ * help.el: Conditionalize hyperbole setup.
+
+1998-01-04 SL Baur <steve@altair.xemacs.org>
+
+ * packages.el (package-require): Update to reflect new data format.
+
+1998-01-02 Didier Verna <verna@inf.enst.fr>
+
+ * x-menubar.el (default-menubar): make the tutorials available
+ through the menubar. (Plus some compilation warnings cleanup).
+
+1998-01-04 SL Baur <steve@altair.xemacs.org>
+
+ * check-features.el: New file. Perform sanity check after build.
+
+ * dumped-lisp.el (preloaded-file-list): Move tooltalk dumped lisp
+ files to tooltalk package.
+ (preloaded-file-list): Moved sparcworks dumped lisp files to Sun
+ package.
+
+ * package-admin.el (package-admin-xemacs): Use better default for
+ location of XEmacs binary.
+
+1998-01-03 Aki Vehtari <Aki.Vehtari@hut.fi>
+
+ * x-menubar.el (buffers-menu-submenus-for-groups-p): Replace const
+ tag with sexp and add value tag with value `t'.
+
+1998-01-03 SL Baur <steve@altair.xemacs.org>
+
+ * package-get.el: Changes to work with real data.
+ From Pete Ware <ware@cis.ohio-state.edu>
+
+ * packages.el (packages-reload-autoloads): Guard load for the time
+ being.
+
+ * update-elc.el ("packages.el"): Force loading packages.el instead
+ of possibly out-of-date packges.elc.
+ * make-docfile.el ("packages.el"): Ditto.
+
+1998-01-02 Colin Rafferty <colin@xemacs.org>
+
+ * build-report.el (build-report-delete-regexp): Added a rule for
+ the main tarball shadowing anything past it.
+
+1998-01-02 SL Baur <steve@altair.xemacs.org>
+
+ * packages.el (package-provide): Delete a previous provide.
+
+ * package-info.el: New file.
+
+ * package-get.el: New file.
+ From Pete Ware <ware@cis.ohio-state.edu>
+ (package-get): Fix md5 computation to work with Mule.
+
+1997-12-11 Jens-Ulrik Holger Petersen <petersen@kurims.kyoto-u.ac.jp>
+
+ * simple.el (log-message-*): Quote symbols in docstrings properly.
+
+1998-01-01 SL Baur <steve@altair.xemacs.org>
+
+ * packages.el (packages-new-autoloads): Ignore symbolic links.
+
+ * cus-face.el (face-custom-attributes-get): Fix typo.
+ From Jens-Ulrik Holger Petersen <petersen@kurims.kyoto-u.ac.jp>
+
+1997-12-31 SL Baur <steve@altair.xemacs.org>
+
+ * startup.el (load-init-file): Reload new or changed autoloads
+ unless inhibited. Reload modified dumped lisp (stubbed).
+
+ * packages.el (packages-new-autoloads): New function.
+ (packages-reload-autoloads): New function.
+ (packages-reload-dumped-lisp): New (stub) function.
+
+ * loadup.el: Inhibit reloading dumped files when running temacs.
+
+ * loadhist.el (file-provides): Extend to handle variant
+ extensions.
+
+ * replace.el (query-replace): Fix typo.
+
+1997-12-30 SL Baur <steve@altair.xemacs.org>
+
+ * make-docfile.el: list-autoloads-path has been renamed.
+ * update-elc.el: list-autoloads has been renamed.
+
+ * packages.el (packages-list-autoloads): Renamed.
+ (packages-list-autoloads-path): Ditto.
+
+1997-12-29 Colin Rafferty <colin@xemacs.org>
+
+ * 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 <steve@altair.xemacs.org>
+
+ * x-menubar.el (buffers-menu-submenus-for-groups-p): Replace sexp
+ tag with const.
+ From Aki Vehtari <Aki.Vehtari@hut.fi>
+
+ * dumped-lisp.el (preloaded-file-list): Dump loadhist with XEmacs.
+
+ * loadhist.el (unload-feature): Remove autoload.
+
+1997-12-28 SL Baur <steve@altair.xemacs.org>
+
+ * loadhist.el: Unpackaged.
+
+ * help.el (describe-symbol-find-file): Rename
+ `describe-function-find-file' and make old name obsolete.
+ (describe-function-1): Use it.
+ (describe-function-1): Guard reference to
+ `compiled-function-annotation'.
+
+1997-12-27 Jens-Ulrik Holger Petersen <petersen@kurims.kyoto-u.ac.jp>
+
+ * help.el (help-mode-bury): Now a call to `help-mode-quit' with
+ argument.
+ (help-mode-quit): New optional arg to control whether it kills or
+ buries. Tidied up.
+ (with-displaying-help-buffer): Don't kill buffer initially, even
+ if it exists: it is erased by `with-output-to-temp-buffer' anyway.
+ (help-pretty-print-value): Rename back from
+ `help-maybe-pretty-print-value'! If `pp-internal' is available
+ use it, otherwise use dumped `cl-prettyprint'.
+ (describe-variable): Use `help-pretty-print-value' again.
+ (find-func): Removed reference to "find-func" at end.
+
+1997-12-26 Kirill M. Katsnelson <kkm@kis.ru>
+
+ * dumped-lisp.el: x-menubar.el dumped along with mswindows native
+ GUI XEmacs. Rename? x-menubar is rather window system
+ independant, except for a couple of items.
+
+1997-12-26 SL Baur <steve@altair.xemacs.org>
+
+ * x-menubar.el (default-menubar): Remove hyperbole and oobr
+ entries as they will no longer be distributed with XEmacs.
+
+ * format.el (format-alist): Fix image/tiff regexps.
+ From P. E. Jareth Hein <jareth@camelot-soft.com>
+
+ * help.el (help-maybe-pretty-print-value): Rename.
+ (describe-variable): Use it.
+ (describe-variable): Add trailing linefeed.
+
+1997-12-26 Jens-Ulrik Holger Petersen <petersen@kurims.kyoto-u.ac.jp>
+
+ * help.el (describe-function-1): Don't output anything for
+ arglist of autoload functions.
+
+1997-12-26 Jens-Ulrik Holger Petersen <petersen@kurims.kyoto-u.ac.jp>
+
+ * help.el (describe-function-1): Don't output anything for
+ arglist of autoload functions.
+
+1997-12-26 Jens-Ulrik Holger Petersen <petersen@kurims.kyoto-u.ac.jp>
+
+ * help.el (help-mode-map): New bindings for `help-mode-bury',
+ `describe-function-at-point', `describe-variable-at-point',
+ `Info-elisp-ref', `customize-variable', `help-next-section' and
+ `help-prev-section'.
+ (help-next-section): New function.
+ (help-prev-section): New function.
+ (help-mode-quit): Changed to kill the help buffer.
+ (help-mode-bury): Formerly `help-mode-quit'. Bury buffer
+ correctly.
+ (help-buffer-name): New function to generate the name of help
+ buffers.
+ (with-displaying-help-buffer): Is now a macro. Takes an new first
+ argument giving the name of the help buffer.
+ (describe-key): Use `with-displaying-help-buffer' with name.
+ (describe-mode): Ditto.
+ (describe-bindings): Ditto.
+ (describe-prefix-bindings): Ditto.
+ (view-lossage): Ditto.
+ (with-syntax-table): New macro.
+ (function-called-at-point): Use `ignore-errors' and
+ `with-syntax-table'.
+ (function-at-point): Ditto.
+ (describe-function): Use `with-displaying-help-buffer' with name.
+ (function-arglist): Extracted from `describe-function-1'. Returns
+ function's arglist as string.
+ (function-documentation): Extracted from `describe-function-1'.
+ Returns function's docstring.
+ (describe-function-1): Remove all the "stream" garbage, including
+ the stream argument. Use `function-arglist' and
+ `function-documentation'.
+ (describe-function-arglist): Just use `function-arglist'.
+ (variable-at-point): Use `ignore-errors' and `with-syntax-table'.
+ (help-pretty-print-value): New function to help with
+ pretty-printing variable values. Knows about `#<...>'. Needs
+ `pp-internal'.
+ (describe-variable): Use `with-displaying-help-buffer' with name.
+ Formatting improved. Display file where variable is defined, if
+ known. Use `help-pretty-print-value'.
+ (describe-syntax): Use `with-displaying-help-buffer' with name.
+ (list-processes): Remove "stream" garbage.
+
+1997-12-25 SL Baur <steve@altair.xemacs.org>
+
+ * x-init.el (x-initialize-keyboard): Don't load x-win*.el files,
+ call a dumped routine instead.
+
+ * x-win-xfree86.el: Wrap file in defun.
+ * x-win-sun.el: Ditto.
+
+1997-12-23 SL Baur <steve@altair.xemacs.org>
+
+ * help.el (view-emacs-news): Remove usage of outl-mouse which
+ advises functions and does other evil things.
+
+1997-12-22 SL Baur <steve@altair.xemacs.org>
+
+ * format.el (format-alist): Add `image/tiff'.
+ From P. E. Jareth Hein <jareth@camelot-soft.com>
+
+1997-12-21 SL Baur <steve@altair.xemacs.org>
+
+ * about.el (about-hackers): More names added.
+
+ * make-docfile.el: Remove superfluous package path search.
+
+ * loaddefs.el: Commentary changes. Removal of VM autoloads.
+
+1997-12-20 SL Baur <steve@altair.xemacs.org>
+
+ * shadow.el (find-emacs-lisp-shadows): Add _pkg to the list of
+ ignored shadows.
+
+1997-12-18 SL Baur <steve@altair.xemacs.org>
+
+ * 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
+ are.
+
+1997-12-18 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * x-faces.el: Added support for foregroundToolBarColor
+ to xpm-color-symbols.
+
+1997-12-17 Hrvoje Niksic <hniksic@srce.hr>
+
+ * etags.el (tags-remove-duplicates): Removed.
+ (buffer-tag-table-list): Use `delete-duplicates'.
+
+ * cl-extra.el (coerce): Coerce to bit-vector and weak-list
+ correctly.
+ (get*): Defalias to `get'.
+
+ * cl.el (eql): Compare integers with `eq'.
+ (cl-map-extents): Check for `map-extents' first.
+
+1997-12-17 Didier Verna <verna@inf.enst.fr>
+
+ * leim/quail/latin-pre.el ("french-prefix"): doc string cleanup +
+ added the 'numero', 'copyright' and 'trademark' symbols.
+
+ * leim/quail/latin-post.el ("french-postfix"): see above.
+
+1997-12-15 Hrvoje Niksic <hniksic@srce.hr>
+
+ * widget.el (define-widget): Check the arguments.
+
+ * cus-edit.el (customize-face): Use `check-argument-type'.
+ (custom-variable-value-create): Use `signal' to signal error.
+ (custom-variable-reset-saved): Ditto.
+ (custom-variable-reset-standard): Ditto.
+ (custom-face-reset-saved): Ditto.
+
+ * wid-edit.el (widget-prompt-value): Use `signal' to signal error.
+ (widget-default-format-handler): Ditto.
+ (widget-checklist-add-item): Ditto.
+ (widget-radio-add-item): Ditto.
+ (widget-editable-list-entry-create): Ditto.
+ (widget-sexp-prompt-value): Ditto.
+
+ * custom.el (custom-declare-variable): Signal errors better.
+ (custom-handle-keyword): Ditto.
+ (custom-declare-group): Ditto.
+
+ * window-xemacs.el (windows): Ditto.
+
+ * menubar.el (menu): Ditto.
+
+ * keydefs.el (keyboard): Ditto.
+
+ * minibuf.el (minibuffer): Ditto.
+
+ * process.el (execute): Ditto.
+
+ * fill.el (fill): Ditto.
+
+ * modeline.el (modeline): Ditto.
+
+ * help.el (help): Ditto.
+
+ * faces.el (faces): Ditto.
+
+ * files.el (files): Ditto.
+
+ * x-init.el (x): Ditto.
+
+ * lisp-mode.el (lisp): Ditto.
+
+ * process.el (processes): Ditto.
+
+ * mouse.el (mouse): Ditto.
+
+ * abbrev.el (abbrev): Moved from cus-edit.
+
+ * font-lock.el (lisp-font-lock-keywords-1): Recognize `defcustom'
+ as variable declaration.
+
+1997-12-15 Hrvoje Niksic <hniksic@srce.hr>
+
+ * menubar.el (find-menu-item): Use `check-argument-type'.
+ (find-menu-item): Cosmetic changes.
+
+1997-12-18 SL Baur <steve@altair.xemacs.org>
+
+ * x-menubar.el (default-menubar): Guard usage of lpr-switches.
+
+1997-12-17 SL Baur <steve@altair.xemacs.org>
+
+ * 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
+ files.
+
+ * loadup.el: Correct commentary. Reformatting.
+ (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).
+
+ * shadow.el (find-emacs-lisp-shadows): Ignore multiple
+ dumped-lisp.el files.
+
+ * make-docfile.el (preloaded-file-list): Reorder when the
+ package-path is searched.
+ * update-elc.el: Ditto.
+
+ * lisp-mode.el (call-with-condition-handler): Treat the same as
+ `condition-case' for indentation.
+
+ * about.el (about-xemacs): Update release date.
+
+1997-12-17 Hrvoje Niksic <hniksic@srce.hr>
+
+ * cl-macs.el (case): Signal error if `t' or `otherwise' are seen
+ anywhere but at the last clause.
+ (ecase): Disallow `t' and `otherwise'.
+
+1997-12-16 Jens-Ulrik Holger Petersen <petersen@kurims.kyoto-u.ac.jp>
+
+ * cus-edit.el (custom-buffer-create-buttons): New function
+ from stuff moved out of `custom-buffer-create-internal'.
+ (custom-novice): New variable. Default t.
+ (custom-display-global-buttons): Ditto. Default `top'.
+ (custom-buffer-create-internal): Only display help if
+ `custom-novice' is non-nil. Display global buttons according to
+ `custom-display-global-buttons'.
+
+1997-12-15 Hrvoje Niksic <hniksic@srce.hr>
+
+ * menubar.el (find-menu-item): Use `check-argument-type'.
+ (find-menu-item): Cosmetic changes.
+
+1997-12-15 Hrvoje Niksic <hniksic@srce.hr>
+
+ * modeline.el (mouse-drag-modeline): Give the modeline a "pressed"
+ look.
+
+1997-12-16 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
+
+ * format.el (format-deannotate-region): Bug fix.
+ Deannotating a region containing unknown tags would fail
+ (causing decoding of text/enriched to fail at user level)
+
+1997-12-16 Kyle Jones <kyle_jones@wonderworks.com>
+
+ * minibuf.el (read-directory-name): Support sixth
+ arg, HISTORY, as already documented.
+
+1997-12-17 Hrvoje Niksic <hniksic@srce.hr>
+
+ * etags.el (get-tag-table-buffer): Use explicit lists as arguments
+ to `ecase'.
+
+1997-12-14 SL Baur <steve@altair.xemacs.org>
+
+ * skk/skk-leim.el (skk-auto-fill-activate): Synch with
+ skk-activate.
+
+1997-12-13 SL Baur <steve@altair.xemacs.org>
+
+ * dumped-lisp.el (preloaded-file-list): Remove debugging statement.
--- /dev/null
+;;; DO NOT MODIFY THIS FILE
+(if (featurep 'Standard-autoloads) (error "Already loaded"))
+\f
+;;;### (autoloads nil "abbrev" "lisp/abbrev.el")
+
+;;;***
+\f
+;;;### (autoloads (about-xemacs) "about" "lisp/about.el")
+
+(autoload 'about-xemacs "about" "\
+Describe the True Editor and its minions." t nil)
+
+;;;***
+\f
+;;;### (autoloads (apropos-documentation apropos-value apropos apropos-command) "apropos" "lisp/apropos.el")
+
+(fset 'command-apropos 'apropos-command)
+
+(autoload 'apropos-command "apropos" "\
+Shows commands (interactively callable functions) that match REGEXP.
+With optional prefix ARG or if `apropos-do-all' is non-nil, also show
+variables." t nil)
+
+(autoload 'apropos "apropos" "\
+Show all bound symbols whose names match REGEXP.
+With optional prefix ARG or if `apropos-do-all' is non-nil, also show unbound
+symbols and key bindings, which is a little more time-consuming.
+Returns list of symbols and documentation found." t nil)
+
+(autoload 'apropos-value "apropos" "\
+Show all symbols whose value's printed image matches REGEXP.
+With optional prefix ARG or if `apropos-do-all' is non-nil, also looks
+at the function and at the names and values of properties.
+Returns list of symbols and values found." t nil)
+
+(autoload 'apropos-documentation "apropos" "\
+Show symbols whose documentation contain matches for REGEXP.
+With optional prefix ARG or if `apropos-do-all' is non-nil, also use
+documentation that is not stored in the documentation file and show key
+bindings.
+Returns list of symbols and documentation found." t nil)
+
+;;;***
+\f
+;;;### (autoloads (batch-update-directory batch-update-autoloads update-autoloads-from-directory update-autoloads-here update-file-autoloads generate-file-autoloads) "autoload" "lisp/autoload.el")
+
+(autoload 'generate-file-autoloads "autoload" "\
+Insert at point a loaddefs autoload section for FILE.
+autoloads are generated for defuns and defmacros in FILE
+marked by `generate-autoload-cookie' (which see).
+If FILE is being visited in a buffer, the contents of the buffer
+are used." t nil)
+
+(autoload 'update-file-autoloads "autoload" "\
+Update the autoloads for FILE in `generated-autoload-file'
+\(which FILE might bind in its local variables).
+This functions refuses to update autoloads files." t nil)
+
+(autoload 'update-autoloads-here "autoload" "\
+Update sections of the current buffer generated by `update-file-autoloads'." t nil)
+
+(autoload 'update-autoloads-from-directory "autoload" "\
+Update `generated-autoload-file' with all the current autoloads from DIR.
+This runs `update-file-autoloads' on each .el file in DIR.
+Obsolete autoload entries for files that no longer exist are deleted." t nil)
+
+(autoload 'batch-update-autoloads "autoload" "\
+Update the autoloads for the files or directories on the command line.
+Runs `update-file-autoloads' on files and `update-directory-autoloads'
+on directories. Must be used only with -batch, and kills Emacs on completion.
+Each file will be processed even if an error occurred previously.
+For example, invoke `xemacs -batch -f batch-update-autoloads *.el'.
+The directory to which the auto-autoloads.el file must be the first parameter
+on the command line." nil nil)
+
+(autoload 'batch-update-directory "autoload" "\
+Update the autoloads for the directory on the command line.
+Runs `update-file-autoloads' on each file in the given directory, must
+be used only with -batch and kills XEmacs on completion." nil nil)
+
+;;;***
+\f
+;;;### (autoloads nil "buff-menu" "lisp/buff-menu.el")
+
+(defvar list-buffers-directory nil)
+
+(make-variable-buffer-local 'list-buffers-directory)
+
+;;;***
+\f
+;;;### (autoloads (batch-byte-recompile-directory batch-byte-recompile-directory-norecurse batch-byte-compile display-call-tree byte-compile-sexp byte-compile compile-defun byte-compile-buffer byte-compile-and-load-file byte-compile-file byte-recompile-file byte-recompile-directory byte-force-recompile) "bytecomp" "lisp/bytecomp.el")
+
+(autoload 'byte-force-recompile "bytecomp" "\
+Recompile every `.el' file in DIRECTORY that already has a `.elc' file.
+Files in subdirectories of DIRECTORY are processed also." t nil)
+
+(autoload 'byte-recompile-directory "bytecomp" "\
+Recompile every `.el' file in DIRECTORY that needs recompilation.
+This is if a `.elc' file exists but is older than the `.el' file.
+Files in subdirectories of DIRECTORY are processed also unless argument
+NORECURSION is non-nil.
+
+If the `.elc' file does not exist, normally the `.el' file is *not* compiled.
+But a prefix argument (optional second arg) means ask user,
+for each such `.el' file, whether to compile it. Prefix argument 0 means
+don't ask and compile the file anyway.
+
+A nonzero prefix argument also means ask about each subdirectory.
+
+If the fourth argument FORCE is non-nil,
+recompile every `.el' file that already has a `.elc' file." t nil)
+
+(autoload 'byte-recompile-file "bytecomp" "\
+Recompile a file of Lisp code named FILENAME if it needs recompilation.
+This is if the `.elc' file exists but is older than the `.el' file.
+
+If the `.elc' file does not exist, normally the `.el' file is *not*
+compiled. But a prefix argument (optional second arg) means ask user
+whether to compile it. Prefix argument 0 don't ask and recompile anyway." t nil)
+
+(autoload 'byte-compile-file "bytecomp" "\
+Compile a file of Lisp code named FILENAME into a file of byte code.
+The output file's name is made by appending `c' to the end of FILENAME.
+With prefix arg (noninteractively: 2nd arg), load the file after compiling." t nil)
+
+(autoload 'byte-compile-and-load-file "bytecomp" "\
+Compile a file of Lisp code named FILENAME into a file of byte code,
+and then load it. The output file's name is made by appending \"c\" to
+the end of FILENAME." t nil)
+
+(autoload 'byte-compile-buffer "bytecomp" "\
+Byte-compile and evaluate contents of BUFFER (default: the current buffer)." t nil)
+
+(autoload 'compile-defun "bytecomp" "\
+Compile and evaluate the current top-level form.
+Print the result in the minibuffer.
+With argument, insert value in current buffer after the form." t nil)
+
+(autoload 'byte-compile "bytecomp" "\
+If FORM is a symbol, byte-compile its function definition.
+If FORM is a lambda or a macro, byte-compile it as a function." nil nil)
+
+(autoload 'byte-compile-sexp "bytecomp" "\
+Compile and return SEXP." nil nil)
+
+(autoload 'display-call-tree "bytecomp" "\
+Display a call graph of a specified file.
+This lists which functions have been called, what functions called
+them, and what functions they call. The list includes all functions
+whose definitions have been compiled in this Emacs session, as well as
+all functions called by those functions.
+
+The call graph does not include macros, inline functions, or
+primitives that the byte-code interpreter knows about directly (eq,
+cons, etc.).
+
+The call tree also lists those functions which are not known to be called
+\(that is, to which no calls have been compiled), and which cannot be
+invoked interactively." t nil)
+
+(autoload 'batch-byte-compile "bytecomp" "\
+Run `byte-compile-file' on the files remaining on the command line.
+Use this from the command line, with `-batch';
+it won't work in an interactive Emacs.
+Each file is processed even if an error occurred previously.
+For example, invoke \"xemacs -batch -f batch-byte-compile $emacs/ ~/*.el\"" nil nil)
+
+(autoload 'batch-byte-recompile-directory-norecurse "bytecomp" "\
+Same as `batch-byte-recompile-directory' but without recursion." nil nil)
+
+(autoload 'batch-byte-recompile-directory "bytecomp" "\
+Runs `byte-recompile-directory' on the dirs remaining on the command line.
+Must be used only with `-batch', and kills Emacs on completion.
+For example, invoke `xemacs -batch -f batch-byte-recompile-directory .'." nil nil)
+
+;;;***
+\f
+;;;### (autoloads (compiler-macroexpand define-compiler-macro ignore-errors assert check-type typep deftype cl-struct-setf-expander defstruct define-modify-macro callf2 callf letf* letf rotatef shiftf remf cl-do-pop psetf setf get-setf-method defsetf define-setf-method declare the locally multiple-value-setq multiple-value-bind lexical-let* lexical-let symbol-macrolet macrolet labels flet progv psetq do-all-symbols do-symbols dotimes dolist do* do loop return-from return block etypecase typecase ecase case load-time-value eval-when destructuring-bind function* defmacro* defun* gentemp gensym cl-compile-time-init) "cl-macs" "lisp/cl-macs.el")
+
+(autoload 'cl-compile-time-init "cl-macs" nil nil nil)
+
+(autoload 'gensym "cl-macs" "\
+Generate a new uninterned symbol.
+The name is made by appending a number to PREFIX, default \"G\"." nil nil)
+
+(autoload 'gentemp "cl-macs" "\
+Generate a new interned symbol with a unique name.
+The name is made by appending a number to PREFIX, default \"G\"." nil nil)
+
+(autoload 'defun* "cl-macs" "\
+(defun* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function.
+Like normal `defun', except ARGLIST allows full Common Lisp conventions,
+and BODY is implicitly surrounded by (block NAME ...)." nil 'macro)
+
+(autoload 'defmacro* "cl-macs" "\
+(defmacro* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro.
+Like normal `defmacro', except ARGLIST allows full Common Lisp conventions,
+and BODY is implicitly surrounded by (block NAME ...)." nil 'macro)
+
+(autoload 'function* "cl-macs" "\
+(function* SYMBOL-OR-LAMBDA): introduce a function.
+Like normal `function', except that if argument is a lambda form, its
+ARGLIST allows full Common Lisp conventions." nil 'macro)
+
+(autoload 'destructuring-bind "cl-macs" nil nil 'macro)
+
+(autoload 'eval-when "cl-macs" "\
+(eval-when (WHEN...) BODY...): control when BODY is evaluated.
+If `compile' is in WHEN, BODY is evaluated when compiled at top-level.
+If `load' is in WHEN, BODY is evaluated when loaded after top-level compile.
+If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level." nil 'macro)
+
+(autoload 'load-time-value "cl-macs" "\
+Like `progn', but evaluates the body at load time.
+The result of the body appears to the compiler as a quoted constant." nil 'macro)
+
+(autoload 'case "cl-macs" "\
+(case EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value.
+Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared
+against each key in each KEYLIST; the corresponding BODY is evaluated.
+If no clause succeeds, case returns nil. A single atom may be used in
+place of a KEYLIST of one atom. A KEYLIST of `t' or `otherwise' is
+allowed only in the final clause, and matches if no other keys match.
+Key values are compared by `eql'." nil 'macro)
+
+(autoload 'ecase "cl-macs" "\
+(ecase EXPR CLAUSES...): like `case', but error if no case fits.
+`otherwise'-clauses are not allowed." nil 'macro)
+
+(autoload 'typecase "cl-macs" "\
+(typecase EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value.
+Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it
+satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds,
+typecase returns nil. A TYPE of `t' or `otherwise' is allowed only in the
+final clause, and matches if no other keys match." nil 'macro)
+
+(autoload 'etypecase "cl-macs" "\
+(etypecase EXPR CLAUSES...): like `typecase', but error if no case fits.
+`otherwise'-clauses are not allowed." nil 'macro)
+
+(autoload 'block "cl-macs" "\
+(block NAME BODY...): define a lexically-scoped block named NAME.
+NAME may be any symbol. Code inside the BODY forms can call `return-from'
+to jump prematurely out of the block. This differs from `catch' and `throw'
+in two respects: First, the NAME is an unevaluated symbol rather than a
+quoted symbol or other form; and second, NAME is lexically rather than
+dynamically scoped: Only references to it within BODY will work. These
+references may appear inside macro expansions, but not inside functions
+called from BODY." nil 'macro)
+
+(autoload 'return "cl-macs" "\
+(return [RESULT]): return from the block named nil.
+This is equivalent to `(return-from nil RESULT)'." nil 'macro)
+
+(autoload 'return-from "cl-macs" "\
+(return-from NAME [RESULT]): return from the block named NAME.
+This jump out to the innermost enclosing `(block NAME ...)' form,
+returning RESULT from that form (or nil if RESULT is omitted).
+This is compatible with Common Lisp, but note that `defun' and
+`defmacro' do not create implicit blocks as they do in Common Lisp." nil 'macro)
+
+(autoload 'loop "cl-macs" "\
+(loop CLAUSE...): The Common Lisp `loop' macro.
+Valid clauses are:
+ for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM,
+ for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR,
+ for VAR across ARRAY, repeat NUM, with VAR = INIT, while COND, until COND,
+ always COND, never COND, thereis COND, collect EXPR into VAR,
+ append EXPR into VAR, nconc EXPR into VAR, sum EXPR into VAR,
+ count EXPR into VAR, maximize EXPR into VAR, minimize EXPR into VAR,
+ if COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...],
+ unless COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...],
+ do EXPRS..., initially EXPRS..., finally EXPRS..., return EXPR,
+ finally return EXPR, named NAME." nil 'macro)
+
+(autoload 'do "cl-macs" "\
+The Common Lisp `do' loop.
+Format is: (do ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil 'macro)
+
+(autoload 'do* "cl-macs" "\
+The Common Lisp `do*' loop.
+Format is: (do* ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil 'macro)
+
+(autoload 'dolist "cl-macs" "\
+(dolist (VAR LIST [RESULT]) BODY...): loop over a list.
+Evaluate BODY with VAR bound to each `car' from LIST, in turn.
+Then evaluate RESULT to get return value, default nil." nil 'macro)
+
+(autoload 'dotimes "cl-macs" "\
+(dotimes (VAR COUNT [RESULT]) BODY...): loop a certain number of times.
+Evaluate BODY with VAR bound to successive integers from 0, inclusive,
+to COUNT, exclusive. Then evaluate RESULT to get return value, default
+nil." nil 'macro)
+
+(autoload 'do-symbols "cl-macs" "\
+(dosymbols (VAR [OBARRAY [RESULT]]) BODY...): loop over all symbols.
+Evaluate BODY with VAR bound to each interned symbol, or to each symbol
+from OBARRAY." nil 'macro)
+
+(autoload 'do-all-symbols "cl-macs" nil nil 'macro)
+
+(autoload 'psetq "cl-macs" "\
+(psetq SYM VAL SYM VAL ...): set SYMs to the values VALs in parallel.
+This is like `setq', except that all VAL forms are evaluated (in order)
+before assigning any symbols SYM to the corresponding values." nil 'macro)
+
+(autoload 'progv "cl-macs" "\
+(progv SYMBOLS VALUES BODY...): bind SYMBOLS to VALUES dynamically in BODY.
+The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists.
+Each SYMBOL in the first list is bound to the corresponding VALUE in the
+second list (or made unbound if VALUES is shorter than SYMBOLS); then the
+BODY forms are executed and their result is returned. This is much like
+a `let' form, except that the list of symbols can be computed at run-time." nil 'macro)
+
+(autoload 'flet "cl-macs" "\
+(flet ((FUNC ARGLIST BODY...) ...) FORM...): make temporary function defns.
+This is an analogue of `let' that operates on the function cell of FUNC
+rather than its value cell. The FORMs are evaluated with the specified
+function definitions in place, then the definitions are undone (the FUNCs
+go back to their previous definitions, or lack thereof)." nil 'macro)
+
+(autoload 'labels "cl-macs" "\
+(labels ((FUNC ARGLIST BODY...) ...) FORM...): make temporary func bindings.
+This is like `flet', except the bindings are lexical instead of dynamic.
+Unlike `flet', this macro is fully complaint with the Common Lisp standard." nil 'macro)
+
+(autoload 'macrolet "cl-macs" "\
+(macrolet ((NAME ARGLIST BODY...) ...) FORM...): make temporary macro defns.
+This is like `flet', but for macros instead of functions." nil 'macro)
+
+(autoload 'symbol-macrolet "cl-macs" "\
+(symbol-macrolet ((NAME EXPANSION) ...) FORM...): make symbol macro defns.
+Within the body FORMs, references to the variable NAME will be replaced
+by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...)." nil 'macro)
+
+(autoload 'lexical-let "cl-macs" "\
+(lexical-let BINDINGS BODY...): like `let', but lexically scoped.
+The main visible difference is that lambdas inside BODY will create
+lexical closures as in Common Lisp." nil 'macro)
+
+(autoload 'lexical-let* "cl-macs" "\
+(lexical-let* BINDINGS BODY...): like `let*', but lexically scoped.
+The main visible difference is that lambdas inside BODY will create
+lexical closures as in Common Lisp." nil 'macro)
+
+(autoload 'multiple-value-bind "cl-macs" "\
+(multiple-value-bind (SYM SYM...) FORM BODY): collect multiple return values.
+FORM must return a list; the BODY is then executed with the first N elements
+of this list bound (`let'-style) to each of the symbols SYM in turn. This
+is analogous to the Common Lisp `multiple-value-bind' macro, using lists to
+simulate true multiple return values. For compatibility, (values A B C) is
+a synonym for (list A B C)." nil 'macro)
+
+(autoload 'multiple-value-setq "cl-macs" "\
+(multiple-value-setq (SYM SYM...) FORM): collect multiple return values.
+FORM must return a list; the first N elements of this list are stored in
+each of the symbols SYM in turn. This is analogous to the Common Lisp
+`multiple-value-setq' macro, using lists to simulate true multiple return
+values. For compatibility, (values A B C) is a synonym for (list A B C)." nil 'macro)
+
+(autoload 'locally "cl-macs" nil nil 'macro)
+
+(autoload 'the "cl-macs" nil nil 'macro)
+
+(autoload 'declare "cl-macs" nil nil 'macro)
+
+(autoload 'define-setf-method "cl-macs" "\
+(define-setf-method NAME ARGLIST BODY...): define a `setf' method.
+This method shows how to handle `setf's to places of the form (NAME ARGS...).
+The argument forms ARGS are bound according to ARGLIST, as if NAME were
+going to be expanded as a macro, then the BODY forms are executed and must
+return a list of five elements: a temporary-variables list, a value-forms
+list, a store-variables list (of length one), a store-form, and an access-
+form. See `defsetf' for a simpler way to define most setf-methods." nil 'macro)
+
+(autoload 'defsetf "cl-macs" "\
+(defsetf NAME FUNC): define a `setf' method.
+This macro is an easy-to-use substitute for `define-setf-method' that works
+well for simple place forms. In the simple `defsetf' form, `setf's of
+the form (setf (NAME ARGS...) VAL) are transformed to function or macro
+calls of the form (FUNC ARGS... VAL). Example: (defsetf aref aset).
+Alternate form: (defsetf NAME ARGLIST (STORE) BODY...).
+Here, the above `setf' call is expanded by binding the argument forms ARGS
+according to ARGLIST, binding the value form VAL to STORE, then executing
+BODY, which must return a Lisp form that does the necessary `setf' operation.
+Actually, ARGLIST and STORE may be bound to temporary variables which are
+introduced automatically to preserve proper execution order of the arguments.
+Example: (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))." nil 'macro)
+
+(autoload 'get-setf-method "cl-macs" "\
+Return a list of five values describing the setf-method for PLACE.
+PLACE may be any Lisp form which can appear as the PLACE argument to
+a macro like `setf' or `incf'." nil nil)
+
+(autoload 'setf "cl-macs" "\
+(setf PLACE VAL PLACE VAL ...): set each PLACE to the value of its VAL.
+This is a generalized version of `setq'; the PLACEs may be symbolic
+references such as (car x) or (aref x i), as well as plain symbols.
+For example, (setf (cadar x) y) is equivalent to (setcar (cdar x) y).
+The return value is the last VAL in the list." nil 'macro)
+
+(autoload 'psetf "cl-macs" "\
+(psetf PLACE VAL PLACE VAL ...): set PLACEs to the values VALs in parallel.
+This is like `setf', except that all VAL forms are evaluated (in order)
+before assigning any PLACEs to the corresponding values." nil 'macro)
+
+(autoload 'cl-do-pop "cl-macs" nil nil nil)
+
+(autoload 'remf "cl-macs" "\
+(remf PLACE TAG): remove TAG from property list PLACE.
+PLACE may be a symbol, or any generalized variable allowed by `setf'.
+The form returns true if TAG was found and removed, nil otherwise." nil 'macro)
+
+(autoload 'shiftf "cl-macs" "\
+(shiftf PLACE PLACE... VAL): shift left among PLACEs.
+Example: (shiftf A B C) sets A to B, B to C, and returns the old A.
+Each PLACE may be a symbol, or any generalized variable allowed by `setf'." nil 'macro)
+
+(autoload 'rotatef "cl-macs" "\
+(rotatef PLACE...): rotate left among PLACEs.
+Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil.
+Each PLACE may be a symbol, or any generalized variable allowed by `setf'." nil 'macro)
+
+(autoload 'letf "cl-macs" "\
+(letf ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs.
+This is the analogue of `let', but with generalized variables (in the
+sense of `setf') for the PLACEs. Each PLACE is set to the corresponding
+VALUE, then the BODY forms are executed. On exit, either normally or
+because of a `throw' or error, the PLACEs are set back to their original
+values. Note that this macro is *not* available in Common Lisp.
+As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
+the PLACE is not modified before executing BODY." nil 'macro)
+
+(autoload 'letf* "cl-macs" "\
+(letf* ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs.
+This is the analogue of `let*', but with generalized variables (in the
+sense of `setf') for the PLACEs. Each PLACE is set to the corresponding
+VALUE, then the BODY forms are executed. On exit, either normally or
+because of a `throw' or error, the PLACEs are set back to their original
+values. Note that this macro is *not* available in Common Lisp.
+As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
+the PLACE is not modified before executing BODY." nil 'macro)
+
+(autoload 'callf "cl-macs" "\
+(callf FUNC PLACE ARGS...): set PLACE to (FUNC PLACE ARGS...).
+FUNC should be an unquoted function name. PLACE may be a symbol,
+or any generalized variable allowed by `setf'." nil 'macro)
+
+(autoload 'callf2 "cl-macs" "\
+(callf2 FUNC ARG1 PLACE ARGS...): set PLACE to (FUNC ARG1 PLACE ARGS...).
+Like `callf', but PLACE is the second argument of FUNC, not the first." nil 'macro)
+
+(autoload 'define-modify-macro "cl-macs" "\
+(define-modify-macro NAME ARGLIST FUNC): define a `setf'-like modify macro.
+If NAME is called, it combines its PLACE argument with the other arguments
+from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)" nil 'macro)
+
+(autoload 'defstruct "cl-macs" "\
+(defstruct (NAME OPTIONS...) (SLOT SLOT-OPTS...)...): define a struct type.
+This macro defines a new Lisp data type called NAME, which contains data
+stored in SLOTs. This defines a `make-NAME' constructor, a `copy-NAME'
+copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors." nil 'macro)
+
+(autoload 'cl-struct-setf-expander "cl-macs" nil nil nil)
+
+(autoload 'deftype "cl-macs" "\
+(deftype NAME ARGLIST BODY...): define NAME as a new data type.
+The type name can then be used in `typecase', `check-type', etc." nil 'macro)
+
+(autoload 'typep "cl-macs" "\
+Check that OBJECT is of type TYPE.
+TYPE is a Common Lisp-style type specifier." nil nil)
+
+(autoload 'check-type "cl-macs" "\
+Verify that FORM is of type TYPE; signal an error if not.
+STRING is an optional description of the desired type." nil 'macro)
+
+(autoload 'assert "cl-macs" "\
+Verify that FORM returns non-nil; signal an error if not.
+Second arg SHOW-ARGS means to include arguments of FORM in message.
+Other args STRING and ARGS... are arguments to be passed to `error'.
+They are not evaluated unless the assertion fails. If STRING is
+omitted, a default message listing FORM itself is used." nil 'macro)
+
+(autoload 'ignore-errors "cl-macs" "\
+Execute FORMS; if an error occurs, return nil.
+Otherwise, return result of last FORM." nil 'macro)
+
+(autoload 'define-compiler-macro "cl-macs" "\
+(define-compiler-macro FUNC ARGLIST BODY...): Define a compiler-only macro.
+This is like `defmacro', but macro expansion occurs only if the call to
+FUNC is compiled (i.e., not interpreted). Compiler macros should be used
+for optimizing the way calls to FUNC are compiled; the form returned by
+BODY should do the same thing as a call to the normal function called
+FUNC, though possibly more efficiently. Note that, like regular macros,
+compiler macros are expanded repeatedly until no further expansions are
+possible. Unlike regular macros, BODY can decide to \"punt\" and leave the
+original function call alone by declaring an initial `&whole foo' parameter
+and then returning foo." nil 'macro)
+
+(autoload 'compiler-macroexpand "cl-macs" nil nil nil)
+
+;;;***
+\f
+;;;### (autoloads (batch-remove-old-elc) "cleantree" "lisp/cleantree.el")
+
+(autoload 'batch-remove-old-elc "cleantree" nil nil nil)
+
+;;;***
+\f
+;;;### (autoloads (config-value config-value-hash-table) "config" "lisp/config.el")
+
+(autoload 'config-value-hash-table "config" "\
+Return hashtable of configuration parameters and their values." nil nil)
+
+(autoload 'config-value "config" "\
+Return the value of the configuration parameter CONFIG_SYMBOL." nil nil)
+
+;;;***
+\f
+;;;### (autoloads (Custom-make-dependencies) "cus-dep" "lisp/cus-dep.el")
+
+(autoload 'Custom-make-dependencies "cus-dep" "\
+Extract custom dependencies from .el files in SUBDIRS.
+SUBDIRS is a list of directories. If it is nil, the command-line
+arguments are used. If it is a string, only that directory is
+processed. This function is especially useful in batch mode.
+
+Batch usage: xemacs -batch -l cus-dep.el -f Custom-make-dependencies DIRS" t nil)
+
+;;;***
+\f
+;;;### (autoloads (customize-menu-create custom-menu-create custom-save-all customize-save-customized customize-browse custom-buffer-create-other-window custom-buffer-create customize-apropos-groups customize-apropos-faces customize-apropos-options customize-apropos customize-saved customize-customized customize-face-other-window customize-face customize-option-other-window customize-changed-options customize-variable customize-other-window customize customize-save-variable customize-set-variable customize-set-value) "cus-edit" "lisp/cus-edit.el")
+
+(autoload 'customize-set-value "cus-edit" "\
+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." t nil)
+
+(autoload 'customize-set-variable "cus-edit" "\
+Set the default for VARIABLE to VALUE. VALUE is a Lisp object.
+
+If VARIABLE has a `custom-set' property, that is used for setting
+VARIABLE, otherwise `set-default' is used.
+
+The `customized-value' property of the VARIABLE will be set to a list
+with a quoted VALUE as its sole list member.
+
+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. " t nil)
+
+(autoload 'customize-save-variable "cus-edit" "\
+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.
+
+The `customized-value' property of the VARIABLE will be set to a list
+with a quoted VALUE as its sole list member.
+
+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. " t nil)
+
+(autoload 'customize "cus-edit" "\
+Select a customization buffer which you can use to set user options.
+User options are structured into \"groups\".
+The default group is `Emacs'." t nil)
+
+(defalias 'customize-group 'customize)
+
+(autoload 'customize-other-window "cus-edit" "\
+Customize SYMBOL, which must be a customization group." t nil)
+
+(defalias 'customize-group-other-window 'customize-other-window)
+
+(defalias 'customize-option 'customize-variable)
+
+(autoload 'customize-variable "cus-edit" "\
+Customize SYMBOL, which must be a user option variable." t nil)
+
+(autoload 'customize-changed-options "cus-edit" "\
+Customize all user option variables whose default values changed recently.
+This means, in other words, variables defined with a `:version' keyword." t nil)
+
+(defalias 'customize-variable-other-window 'customize-option-other-window)
+
+(autoload 'customize-option-other-window "cus-edit" "\
+Customize SYMBOL, which must be a user option variable.
+Show the buffer in another window, but don't select it." t nil)
+
+(autoload 'customize-face "cus-edit" "\
+Customize SYMBOL, which should be a face name or nil.
+If SYMBOL is nil, customize all faces." t nil)
+
+(autoload 'customize-face-other-window "cus-edit" "\
+Show customization buffer for FACE in other window." t nil)
+
+(autoload 'customize-customized "cus-edit" "\
+Customize all user options set since the last save in this session." t nil)
+
+(autoload 'customize-saved "cus-edit" "\
+Customize all already saved user options." t nil)
+
+(autoload 'customize-apropos "cus-edit" "\
+Customize all user options matching REGEXP.
+If ALL is `options', include only options.
+If ALL is `faces', include only faces.
+If ALL is `groups', include only groups.
+If ALL is t (interactively, with prefix arg), include options which are not
+user-settable, as well as faces and groups." t nil)
+
+(autoload 'customize-apropos-options "cus-edit" "\
+Customize all user options matching REGEXP.
+With prefix arg, include options which are not user-settable." t nil)
+
+(autoload 'customize-apropos-faces "cus-edit" "\
+Customize all user faces matching REGEXP." t nil)
+
+(autoload 'customize-apropos-groups "cus-edit" "\
+Customize all user groups matching REGEXP." t nil)
+
+(autoload 'custom-buffer-create "cus-edit" "\
+Create a buffer containing OPTIONS.
+Optional NAME is the name of the buffer.
+OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
+SYMBOL is a customization option, and WIDGET is a widget for editing
+that option." nil nil)
+
+(autoload 'custom-buffer-create-other-window "cus-edit" "\
+Create a buffer containing OPTIONS.
+Optional NAME is the name of the buffer.
+OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
+SYMBOL is a customization option, and WIDGET is a widget for editing
+that option." nil nil)
+
+(autoload 'customize-browse "cus-edit" "\
+Create a tree browser for the customize hierarchy." t nil)
+
+(defcustom custom-file "~/.emacs" "File used for storing customization information.\nIf you change this from the default \"~/.emacs\" you need to\nexplicitly load that file for the settings to take effect." :type 'file :group 'customize)
+
+(autoload 'customize-save-customized "cus-edit" "\
+Save all user options which have been set in this session." t nil)
+
+(autoload 'custom-save-all "cus-edit" "\
+Save all customizations in `custom-file'." nil nil)
+
+(autoload 'custom-menu-create "cus-edit" "\
+Create menu for customization group SYMBOL.
+The menu is in a format applicable to `easy-menu-define'." nil nil)
+
+(autoload 'customize-menu-create "cus-edit" "\
+Return a customize menu for customization group SYMBOL.
+If optional NAME is given, use that as the name of the menu.
+Otherwise the menu will be named `Customize'.
+The format is suitable for use with `easy-menu-define'." nil nil)
+
+;;;***
+\f
+;;;### (autoloads (custom-set-faces 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)
+
+(autoload 'custom-set-faces "cus-face" "\
+Initialize faces according to user preferences.
+The arguments should be a list where each entry has the form:
+
+ (FACE SPEC [NOW])
+
+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.
+
+See `defface' for the format of SPEC." nil nil)
+
+;;;***
+\f
+;;;### (autoloads (disassemble) "disass" "lisp/disass.el")
+
+(autoload 'disassemble "disass" "\
+Print disassembled code for OBJECT in (optional) BUFFER.
+OBJECT can be a symbol defined as a function, or a function itself
+\(a lambda expression or a compiled-function object).
+If OBJECT is not already compiled, we compile it, but do not
+redefine OBJECT if it is a symbol." t nil)
+
+;;;***
+\f
+;;;### (autoloads (standard-display-european standard-display-underline standard-display-graphic standard-display-g1 standard-display-ascii standard-display-default standard-display-8bit make-display-table describe-current-display-table) "disp-table" "lisp/disp-table.el")
+
+(autoload 'describe-current-display-table "disp-table" "\
+Describe the display table in use in the selected window and buffer." t nil)
+
+(autoload 'make-display-table "disp-table" "\
+Return a new, empty display table." nil nil)
+
+(autoload 'standard-display-8bit "disp-table" "\
+Display characters in the range L to H literally." nil nil)
+
+(autoload 'standard-display-default "disp-table" "\
+Display characters in the range L to H using the default notation." nil nil)
+
+(autoload 'standard-display-ascii "disp-table" "\
+Display character C using printable string S." nil nil)
+
+(autoload 'standard-display-g1 "disp-table" "\
+Display character C as character SC in the g1 character set.
+This function assumes that your terminal uses the SO/SI characters;
+it is meaningless for an X frame." nil nil)
+
+(autoload 'standard-display-graphic "disp-table" "\
+Display character C as character GC in graphics character set.
+This function assumes VT100-compatible escapes; it is meaningless for an
+X frame." nil nil)
+
+(autoload 'standard-display-underline "disp-table" "\
+Display character C as character UC plus underlining." nil nil)
+
+(autoload 'standard-display-european "disp-table" "\
+Toggle display of European characters encoded with ISO 8859.
+When enabled, characters in the range of 160 to 255 display not
+as octal escapes, but as accented characters.
+With prefix argument, enable European character display iff arg is positive." t nil)
+
+;;;***
+\f
+;;;### (autoloads nil "easymenu" "lisp/easymenu.el")
+
+;;;***
+\f
+;;;### (autoloads (tags-apropos list-tags tags-query-replace tags-search tags-loop-continue next-file tag-complete-symbol find-tag-other-window find-tag visit-tags-table) "etags" "lisp/etags.el")
+
+(autoload 'visit-tags-table "etags" "\
+Tell tags commands to use tags table file FILE when all else fails.
+FILE should be the name of a file created with the `etags' program.
+A directory name is ok too; it means file TAGS in that directory." t nil)
+
+(autoload 'find-tag "etags" "\
+*Find tag whose name contains TAGNAME.
+ Selects the buffer that the tag is contained in
+and puts point at its definition.
+ If TAGNAME is a null string, the expression in the buffer
+around or before point is used as the tag name.
+ If called interactively with a numeric argument, searches for the next tag
+in the tag table that matches the tagname used in the previous find-tag.
+ If second arg OTHER-WINDOW is non-nil, uses another window to display
+the tag.
+
+This version of this function supports multiple active tags tables,
+and completion.
+
+Variables of note:
+
+ tag-table-alist controls which tables apply to which buffers
+ tags-file-name a default tags table
+ tags-build-completion-table controls completion behavior
+ buffer-tag-table another way of specifying a buffer-local table
+ make-tags-files-invisible whether tags tables should be very hidden
+ tag-mark-stack-max how many tags-based hops to remember" t nil)
+
+(autoload 'find-tag-other-window "etags" "\
+*Find tag whose name contains TAGNAME.
+ Selects the buffer that the tag is contained in in another window
+and puts point at its definition.
+ If TAGNAME is a null string, the expression in the buffer
+around or before point is used as the tag name.
+ If second arg NEXT is non-nil (interactively, with prefix arg),
+searches for the next tag in the tag table
+that matches the tagname used in the previous find-tag.
+
+This version of this function supports multiple active tags tables,
+and completion.
+
+Variables of note:
+
+ tag-table-alist controls which tables apply to which buffers
+ tags-file-name a default tags table
+ tags-build-completion-table controls completion behavior
+ buffer-tag-table another way of specifying a buffer-local table
+ make-tags-files-invisible whether tags tables should be very hidden
+ tag-mark-stack-max how many tags-based hops to remember" t nil)
+
+(autoload 'tag-complete-symbol "etags" "\
+The function used to do tags-completion (using 'tag-completion-predicate)." t nil)
+
+(autoload 'next-file "etags" "\
+Select next file among files in current tag table(s).
+
+A first argument of t (prefix arg, if interactive) initializes to the
+beginning of the list of files in the (first) tags table. If the argument
+is neither nil nor t, it is evalled to initialize the list of files.
+
+Non-nil second argument NOVISIT means use a temporary buffer
+to save time and avoid uninteresting warnings.
+
+Value is nil if the file was already visited;
+if the file was newly read in, the value is the filename." t nil)
+
+(autoload 'tags-loop-continue "etags" "\
+Continue last \\[tags-search] or \\[tags-query-replace] command.
+Used noninteractively with non-nil argument to begin such a command (the
+argument is passed to `next-file', which see).
+Two variables control the processing we do on each file:
+the value of `tags-loop-scan' is a form to be executed on each file
+to see if it is interesting (it returns non-nil if so)
+and `tags-loop-operate' is a form to execute to operate on an interesting file
+If the latter returns non-nil, we exit; otherwise we scan the next file." t nil)
+
+(autoload 'tags-search "etags" "\
+Search through all files listed in tags table for match for REGEXP.
+Stops when a match is found.
+To continue searching for next match, use command \\[tags-loop-continue].
+
+See documentation of variable `tag-table-alist'." t nil)
+
+(autoload 'tags-query-replace "etags" "\
+Query-replace-regexp FROM with TO through all files listed in tags table.
+Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
+If you exit (\\[keyboard-quit] or ESC), you can resume the query-replace
+with the command \\[tags-loop-continue].
+
+See documentation of variable `tag-table-alist'." t nil)
+
+(autoload 'list-tags "etags" "\
+Display list of tags in FILE." t nil)
+
+(autoload 'tags-apropos "etags" "\
+Display list of all tags in tag table REGEXP matches." t nil)
+(define-key esc-map "*" 'pop-tag-mark)
+
+;;;***
+\f
+;;;### (autoloads (finder-by-keyword) "finder" "lisp/finder.el")
+
+(autoload 'finder-by-keyword "finder" "\
+Find packages matching a given keyword." t nil)
+
+;;;***
+\f
+;;;### (autoloads (font-lock-set-defaults-1 font-lock-fontify-buffer turn-off-font-lock turn-on-font-lock font-lock-mode) "font-lock" "lisp/font-lock.el")
+
+(defcustom font-lock-auto-fontify t "*Whether font-lock should automatically fontify files as they're loaded.\nThis will only happen if font-lock has fontifying keywords for the major\nmode of the file. You can get finer-grained control over auto-fontification\nby using this variable in combination with `font-lock-mode-enable-list' or\n`font-lock-mode-disable-list'." :type 'boolean :group 'font-lock)
+
+(defcustom font-lock-mode-enable-list nil "*List of modes to auto-fontify, if `font-lock-auto-fontify' is nil." :type '(repeat (symbol :tag "Mode")) :group 'font-lock)
+
+(defcustom font-lock-mode-disable-list nil "*List of modes not to auto-fontify, if `font-lock-auto-fontify' is t." :type '(repeat (symbol :tag "Mode")) :group 'font-lock)
+
+(defcustom font-lock-use-colors '(color) "*Specification for when Font Lock will set up color defaults.\nNormally this should be '(color), meaning that Font Lock will set up\ncolor defaults that are only used on color displays. Set this to nil\nif you don't want Font Lock to set up color defaults at all. This\nshould be one of\n\n-- a list of valid tags, meaning that the color defaults will be used\n when all of the tags apply. (e.g. '(color x))\n-- a list whose first element is 'or and whose remaining elements are\n lists of valid tags, meaning that the defaults will be used when\n any of the tag lists apply.\n-- nil, meaning that the defaults should not be set up at all.\n\n(If you specify face values in your init file, they will override any\nthat Font Lock specifies, regardless of whether you specify the face\nvalues before or after loading Font Lock.)\n\nSee also `font-lock-use-fonts'. If you want more control over the faces\nused for fontification, see the documentation of `font-lock-mode' for\nhow to do it." :type 'sexp :group 'font-lock)
+
+(defcustom font-lock-use-fonts '(or (mono) (grayscale)) "*Specification for when Font Lock will set up non-color defaults.\n\nNormally this should be '(or (mono) (grayscale)), meaning that Font\nLock will set up non-color defaults that are only used on either mono\nor grayscale displays. Set this to nil if you don't want Font Lock to\nset up non-color defaults at all. This should be one of\n\n-- a list of valid tags, meaning that the non-color defaults will be used\n when all of the tags apply. (e.g. '(grayscale x))\n-- a list whose first element is 'or and whose remaining elements are\n lists of valid tags, meaning that the defaults will be used when\n any of the tag lists apply.\n-- nil, meaning that the defaults should not be set up at all.\n\n(If you specify face values in your init file, they will override any\nthat Font Lock specifies, regardless of whether you specify the face\nvalues before or after loading Font Lock.)\n\nSee also `font-lock-use-colors'. If you want more control over the faces\nused for fontification, see the documentation of `font-lock-mode' for\nhow to do it." :type 'sexp :group 'font-lock)
+
+(defcustom font-lock-maximum-decoration t "*If non-nil, the maximum decoration level for fontifying.\nIf nil, use the minimum decoration (equivalent to level 0).\nIf t, use the maximum decoration available.\nIf a number, use that level of decoration (or if not available the maximum).\nIf a list, each element should be a cons pair of the form (MAJOR-MODE . LEVEL),\nwhere MAJOR-MODE is a symbol or t (meaning the default). For example:\n ((c++-mode . 2) (c-mode . t) (t . 1))\nmeans use level 2 decoration for buffers in `c++-mode', the maximum decoration\navailable for buffers in `c-mode', and level 1 decoration otherwise." :type '(choice (const :tag "default" nil) (const :tag "maximum" t) (integer :tag "level" 1) (repeat :menu-tag "mode specific" :tag "mode specific" :value ((t . t)) (cons :tag "Instance" (radio :tag "Mode" (const :tag "all" t) (symbol :tag "name")) (radio :tag "Decoration" (const :tag "default" nil) (const :tag "maximum" t) (integer :tag "level" 1))))) :group 'font-lock)
+
+(define-obsolete-variable-alias 'font-lock-use-maximal-decoration 'font-lock-maximum-decoration)
+
+(defcustom font-lock-maximum-size (* 250 1024) "*If non-nil, the maximum size for buffers for fontifying.\nOnly buffers less than this can be fontified when Font Lock mode is turned on.\nIf nil, means size is irrelevant.\nIf a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE),\nwhere MAJOR-MODE is a symbol or t (meaning the default). For example:\n ((c++-mode . 256000) (c-mode . 256000) (rmail-mode . 1048576))\nmeans that the maximum size is 250K for buffers in `c++-mode' or `c-mode', one\nmegabyte for buffers in `rmail-mode', and size is irrelevant otherwise." :type '(choice (const :tag "none" nil) (integer :tag "size") (repeat :menu-tag "mode specific" :tag "mode specific" :value ((t)) (cons :tag "Instance" (radio :tag "Mode" (const :tag "all" t) (symbol :tag "name")) (radio :tag "Size" (const :tag "none" nil) (integer :tag "size"))))) :group 'font-lock)
+
+(defvar font-lock-keywords nil "\
+A list of the keywords to highlight.
+Each element should be of the form:
+
+ MATCHER
+ (MATCHER . MATCH)
+ (MATCHER . FACENAME)
+ (MATCHER . HIGHLIGHT)
+ (MATCHER HIGHLIGHT ...)
+ (eval . FORM)
+
+where HIGHLIGHT should be either MATCH-HIGHLIGHT or MATCH-ANCHORED.
+
+FORM is an expression, whose value should be a keyword element,
+evaluated when the keyword is (first) used in a buffer. This feature
+can be used to provide a keyword that can only be generated when Font
+Lock mode is actually turned on.
+
+For highlighting single items, typically only MATCH-HIGHLIGHT is required.
+However, if an item or (typically) items is to be highlighted following the
+instance of another item (the anchor) then MATCH-ANCHORED may be required.
+
+MATCH-HIGHLIGHT should be of the form:
+
+ (MATCH FACENAME OVERRIDE LAXMATCH)
+
+Where MATCHER can be either the regexp to search for, a variable
+containing the regexp to search for, or the function to call to make
+the search (called with one argument, the limit of the search). MATCH
+is the subexpression of MATCHER to be highlighted. FACENAME is either
+a symbol naming a face, or an expression whose value is the face name
+to use. If you want FACENAME to be a symbol that evaluates to a face,
+use a form like \"(progn sym)\".
+
+OVERRIDE and LAXMATCH are flags. If OVERRIDE is t, existing fontification may
+be overwritten. If `keep', only parts not already fontified are highlighted.
+If `prepend' or `append', existing fontification is merged with the new, in
+which the new or existing fontification, respectively, takes precedence.
+If LAXMATCH is non-nil, no error is signalled if there is no MATCH in MATCHER.
+
+For example, an element of the form highlights (if not already highlighted):
+
+ \"\\\\\\=<foo\\\\\\=>\" Discrete occurrences of \"foo\" in the value of the
+ variable `font-lock-keyword-face'.
+ (\"fu\\\\(bar\\\\)\" . 1) Substring \"bar\" within all occurrences of \"fubar\" in
+ the value of `font-lock-keyword-face'.
+ (\"fubar\" . fubar-face) Occurrences of \"fubar\" in the value of `fubar-face'.
+ (\"foo\\\\|bar\" 0 foo-bar-face t)
+ Occurrences of either \"foo\" or \"bar\" in the value
+ of `foo-bar-face', even if already highlighted.
+
+MATCH-ANCHORED should be of the form:
+
+ (MATCHER PRE-MATCH-FORM POST-MATCH-FORM MATCH-HIGHLIGHT ...)
+
+Where MATCHER is as for MATCH-HIGHLIGHT with one exception; see below.
+PRE-MATCH-FORM and POST-MATCH-FORM are evaluated before the first, and after
+the last, instance MATCH-ANCHORED's MATCHER is used. Therefore they can be
+used to initialise before, and cleanup after, MATCHER is used. Typically,
+PRE-MATCH-FORM is used to move to some position relative to the original
+MATCHER, before starting with MATCH-ANCHORED's MATCHER. POST-MATCH-FORM might
+be used to move, before resuming with MATCH-ANCHORED's parent's MATCHER.
+
+For example, an element of the form highlights (if not already highlighted):
+
+ (\"\\\\\\=<anchor\\\\\\=>\" (0 anchor-face) (\"\\\\\\=<item\\\\\\=>\" nil nil (0 item-face)))
+
+ Discrete occurrences of \"anchor\" in the value of `anchor-face', and subsequent
+ discrete occurrences of \"item\" (on the same line) in the value of `item-face'.
+ (Here PRE-MATCH-FORM and POST-MATCH-FORM are nil. Therefore \"item\" is
+ initially searched for starting from the end of the match of \"anchor\", and
+ searching for subsequent instance of \"anchor\" resumes from where searching
+ for \"item\" concluded.)
+
+The above-mentioned exception is as follows. The limit of the MATCHER search
+defaults to the end of the line after PRE-MATCH-FORM is evaluated.
+However, if PRE-MATCH-FORM returns a position greater than the position after
+PRE-MATCH-FORM is evaluated, that position is used as the limit of the search.
+It is generally a bad idea to return a position greater than the end of the
+line, i.e., cause the MATCHER search to span lines.
+
+Note that the MATCH-ANCHORED feature is experimental; in the future, we may
+replace it with other ways of providing this functionality.
+
+These regular expressions should not match text which spans lines. While
+\\[font-lock-fontify-buffer] handles multi-line patterns correctly, updating
+when you edit the buffer does not, since it considers text one line at a time.
+
+Be very careful composing regexps for this list;
+the wrong pattern can dramatically slow things down!")
+
+(make-variable-buffer-local 'font-lock-keywords)
+
+(defcustom font-lock-mode nil "Non nil means `font-lock-mode' is on" :group 'font-lock :type 'boolean :initialize 'custom-initialize-default :require 'font-lock :set '(lambda (var val) (font-lock-mode (or val 0))))
+
+(defvar font-lock-mode-hook nil "\
+Function or functions to run on entry to font-lock-mode.")
+
+(autoload 'font-lock-mode "font-lock" "\
+Toggle Font Lock Mode.
+With arg, turn font-lock mode on if and only if arg is positive.
+
+When Font Lock mode is enabled, text is fontified as you type it:
+
+ - Comments are displayed in `font-lock-comment-face';
+ - Strings are displayed in `font-lock-string-face';
+ - Documentation strings (in Lisp-like languages) are displayed in
+ `font-lock-doc-string-face';
+ - Language keywords (\"reserved words\") are displayed in
+ `font-lock-keyword-face';
+ - Function names in their defining form are displayed in
+ `font-lock-function-name-face';
+ - Variable names in their defining form are displayed in
+ `font-lock-variable-name-face';
+ - Type names are displayed in `font-lock-type-face';
+ - References appearing in help files and the like are displayed
+ in `font-lock-reference-face';
+ - Preprocessor declarations are displayed in
+ `font-lock-preprocessor-face';
+
+ and
+
+ - Certain other expressions are displayed in other faces according
+ to the value of the variable `font-lock-keywords'.
+
+Where modes support different levels of fontification, you can use the variable
+`font-lock-maximum-decoration' to specify which level you generally prefer.
+When you turn Font Lock mode on/off the buffer is fontified/defontified, though
+fontification occurs only if the buffer is less than `font-lock-maximum-size'.
+To fontify a buffer without turning on Font Lock mode, and regardless of buffer
+size, you can use \\[font-lock-fontify-buffer].
+
+See the variable `font-lock-keywords' for customization." t nil)
+
+(autoload 'turn-on-font-lock "font-lock" "\
+Unconditionally turn on Font Lock mode." nil nil)
+
+(autoload 'turn-off-font-lock "font-lock" "\
+Unconditionally turn off Font Lock mode." nil nil)
+
+(autoload 'font-lock-fontify-buffer "font-lock" "\
+Fontify the current buffer the way `font-lock-mode' would.
+See `font-lock-mode' for details.
+
+This can take a while for large buffers." t nil)
+
+(autoload 'font-lock-set-defaults-1 "font-lock" nil nil nil)
+
+(add-minor-mode 'font-lock-mode " Font")
+
+;;;***
+\f
+;;;### (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)
+
+(autoload 'font-default-font-for-device "font" nil nil nil)
+
+(autoload 'font-default-object-for-device "font" nil nil nil)
+
+(autoload 'font-default-family-for-device "font" nil nil nil)
+
+(autoload 'font-default-registry-for-device "font" nil nil nil)
+
+(autoload 'font-default-encoding-for-device "font" nil nil nil)
+
+(autoload 'font-default-size-for-device "font" nil nil nil)
+
+(autoload 'x-font-build-cache "font" nil nil nil)
+
+;;;***
+\f
+;;;### (autoloads (gnuserv-start gnuserv-running-p) "gnuserv" "lisp/gnuserv.el")
+
+(defcustom gnuserv-frame nil "*The frame to be used to display all edited files.\nIf nil, then a new frame is created for each file edited.\nIf t, then the currently selected frame will be used.\nIf a function, then this will be called with a symbol `x' or `tty' as the\nonly argument, and its return value will be interpreted as above." :tag "Gnuserv Frame" :type '(radio (const :tag "Create new frame each time" nil) (const :tag "Use selected frame" t) (function-item :tag "Use main Emacs frame" gnuserv-main-frame-function) (function-item :tag "Use visible frame, otherwise create new" gnuserv-visible-frame-function) (function-item :tag "Create special Gnuserv frame and use it" gnuserv-special-frame-function) (function :tag "Other")) :group 'gnuserv :group 'frames)
+
+(autoload 'gnuserv-running-p "gnuserv" "\
+Return non-nil if a gnuserv process is running from this XEmacs session." nil nil)
+
+(autoload 'gnuserv-start "gnuserv" "\
+Allow this Emacs process to be a server for client processes.
+This starts a gnuserv communications subprocess through which
+client \"editors\" (gnuclient and gnudoit) can send editing commands to
+this Emacs job. See the gnuserv(1) manual page for more details.
+
+Prefix arg means just kill any existing server communications subprocess." t nil)
+
+;;;***
+\f
+;;;### (autoloads nil "help-macro" "lisp/help-macro.el")
+
+(defcustom three-step-help t "*Non-nil means give more info about Help command in three steps.\nThe three steps are simple prompt, prompt with all options,\nand window listing and describing the options.\nA value of nil means skip the middle step, so that\n\\[help-command] \\[help-command] gives the window that lists the options." :type 'boolean :group 'help-appearance)
+
+;;;***
+\f
+;;;### (autoloads (hyper-apropos-popup-menu hyper-apropos-set-variable hyper-set-variable hyper-apropos-read-variable-symbol hyper-describe-function hyper-describe-variable hyper-describe-face hyper-describe-key-briefly hyper-describe-key hyper-apropos) "hyper-apropos" "lisp/hyper-apropos.el")
+
+(autoload 'hyper-apropos "hyper-apropos" "\
+Display lists of functions and variables matching REGEXP
+in buffer \"*Hyper Apropos*\". If optional prefix arg is given, then the
+value of `hyper-apropos-programming-apropos' is toggled for this search.
+See also `hyper-apropos-mode'." t nil)
+
+(autoload 'hyper-describe-key "hyper-apropos" nil t nil)
+
+(autoload 'hyper-describe-key-briefly "hyper-apropos" nil t nil)
+
+(autoload 'hyper-describe-face "hyper-apropos" "\
+Describe face..
+See also `hyper-apropos' and `hyper-describe-function'." t nil)
+
+(autoload 'hyper-describe-variable "hyper-apropos" "\
+Hypertext drop-in replacement for `describe-variable'.
+See also `hyper-apropos' and `hyper-describe-function'." t nil)
+
+(autoload 'hyper-describe-function "hyper-apropos" "\
+Hypertext replacement for `describe-function'. Unlike `describe-function'
+in that the symbol under the cursor is the default if it is a function.
+See also `hyper-apropos' and `hyper-describe-variable'." t nil)
+
+(autoload 'hyper-apropos-read-variable-symbol "hyper-apropos" "\
+Hypertext drop-in replacement for `describe-variable'.
+See also `hyper-apropos' and `hyper-describe-function'." nil nil)
+
+(define-obsolete-function-alias 'hypropos-read-variable-symbol 'hyper-apropos-read-variable-symbol)
+
+(define-obsolete-function-alias 'hypropos-get-doc 'hyper-apropos-get-doc)
+
+(autoload 'hyper-set-variable "hyper-apropos" nil t nil)
+
+(autoload 'hyper-apropos-set-variable "hyper-apropos" "\
+Interactively set the variable on the current line." t nil)
+
+(define-obsolete-function-alias 'hypropos-set-variable 'hyper-apropos-set-variable)
+
+(autoload 'hyper-apropos-popup-menu "hyper-apropos" nil t nil)
+
+(define-obsolete-function-alias 'hypropos-popup-menu 'hyper-apropos-popup-menu)
+
+;;;***
+\f
+;;;### (autoloads (Info-elisp-ref Info-emacs-key Info-goto-emacs-key-command-node Info-goto-emacs-command-node Info-emacs-command Info-search Info-visit-file Info-goto-node Info-batch-rebuild-dir Info-query info) "info" "lisp/info.el")
+
+(defvar Info-directory-list nil "\
+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.")
+
+(autoload 'info "info" "\
+Enter Info, the documentation browser.
+Optional argument FILE specifies the file to examine;
+the default is the top-level directory of Info.
+
+In interactive use, a prefix argument directs this command
+to read a file name from the minibuffer." t nil)
+
+(autoload 'Info-query "info" "\
+Enter Info, the documentation browser. Prompt for name of Info file." t nil)
+
+(autoload 'Info-batch-rebuild-dir "info" "\
+(Re)build info `dir' files in the directories remaining on the command line.
+Use this from the command line, with `-batch';
+it won't work in an interactive Emacs.
+Each file is processed even if an error occurred previously.
+For example, invoke \"xemacs -batch -f Info-batch-rebuild-dir /usr/local/info\"" nil nil)
+
+(autoload 'Info-goto-node "info" "\
+Go to info node named NAME. Give just NODENAME or (FILENAME)NODENAME.
+Actually, the following interpretations of NAME are tried in order:
+ (FILENAME)NODENAME
+ (FILENAME) (using Top node)
+ NODENAME (in current file)
+ TAGNAME (see below)
+ FILENAME (using Top node)
+where TAGNAME is a string that appears in quotes: \"TAGNAME\", in an
+annotation for any node of any file. (See `a' and `x' commands.)" t nil)
+
+(autoload 'Info-visit-file "info" "\
+Directly visit an info file." t nil)
+
+(autoload 'Info-search "info" "\
+Search for REGEXP, starting from point, and select node it's found in." t nil)
+
+(autoload 'Info-emacs-command "info" "\
+Look up an Emacs command in the Emacs manual in the Info system.
+This command is designed to be used whether you are already in Info or not." t nil)
+
+(autoload 'Info-goto-emacs-command-node "info" "\
+Look up an Emacs command in the Emacs manual in the Info system.
+This command is designed to be used whether you are already in Info or not." t nil)
+
+(autoload 'Info-goto-emacs-key-command-node "info" "\
+Look up an Emacs key sequence in the Emacs manual in the Info system.
+This command is designed to be used whether you are already in Info or not." t nil)
+
+(autoload 'Info-emacs-key "info" "\
+Look up an Emacs key sequence in the Emacs manual in the Info system.
+This command is designed to be used whether you are already in Info or not." t nil)
+
+(autoload 'Info-elisp-ref "info" "\
+Look up an Emacs Lisp function in the Elisp manual in the Info system.
+This command is designed to be used whether you are already in Info or not." t nil)
+
+;;;***
+\f
+;;;### (autoloads nil "itimer-autosave" "lisp/itimer-autosave.el")
+
+;;;***
+\f
+;;;### (autoloads nil "loaddefs" "lisp/loaddefs.el")
+
+;;;***
+\f
+;;;### (autoloads nil "loadhist" "lisp/loadhist.el")
+
+;;;***
+\f
+;;;### (autoloads (mwheel-install) "mwheel" "lisp/mwheel.el")
+
+(autoload 'mwheel-install "mwheel" "\
+Enable mouse wheel support." nil nil)
+
+;;;***
+\f
+;;;### (autoloads (package-admin-add-binary-package package-admin-add-single-file-package) "package-admin" "lisp/package-admin.el")
+
+(autoload 'package-admin-add-single-file-package "package-admin" "\
+Install a single file Lisp package into XEmacs package hierarchy.
+`file' should be the full path to the lisp file to install.
+`destdir' should be a simple directory name.
+The optional `pkg-dir' can be used to override the default package hierarchy
+\(car (last late-packages))." t nil)
+
+(autoload 'package-admin-add-binary-package "package-admin" "\
+Install a pre-bytecompiled XEmacs package into package hierarchy." t nil)
+
+;;;***
+\f
+;;;### (autoloads (package-get-custom package-get-package-provider package-get package-get-all package-get-update-all) "package-get" "lisp/package-get.el")
+
+(autoload 'package-get-update-all "package-get" "\
+Fetch and install the latest versions of all currently installed packages." t nil)
+
+(autoload 'package-get-all "package-get" "\
+Fetch PACKAGE with VERSION and all other required packages.
+Uses `package-get-base' to determine just what is required and what
+package provides that functionality. If VERSION is nil, retrieves
+latest version. Optional argument FETCHED-PACKAGES is used to keep
+track of packages already fetched." t nil)
+
+(autoload 'package-get "package-get" "\
+Fetch PACKAGE from remote site.
+Optional arguments VERSION indicates which version to retrieve, nil
+means most recent version. CONFLICT indicates what happens if the
+package is already installed. Valid values for CONFLICT are:
+'always always retrieve the package even if it is already installed
+'never do not retrieve the package if it is installed.
+
+The value of `package-get-base' is used to determine what files should
+be retrieved. The value of `package-get-remote' is used to determine
+where a package should be retrieved from. The sites are tried in
+order so one is better off listing easily reached sites first.
+
+Once the package is retrieved, its md5 checksum is computed. If that
+sum does not match that stored in `package-get-base' for this version
+of the package, an error is signalled." t nil)
+
+(autoload 'package-get-package-provider "package-get" "\
+Search for a package that provides SYM and return the name and
+ version. Searches in `package-get-base' for SYM. If SYM is a
+ consp, then it must match a corresponding (provide (SYM VERSION)) from
+ the package." t nil)
+
+(autoload 'package-get-custom "package-get" "\
+Fetch and install the latest versions of all customized packages." t nil)
+
+;;;***
+\f
+;;;### (autoloads (picture-mode) "picture" "lisp/picture.el")
+
+(autoload 'picture-mode "picture" "\
+Switch to Picture mode, in which a quarter-plane screen model is used.
+Printing characters replace instead of inserting themselves with motion
+afterwards settable by these commands:
+ C-c < Move left after insertion.
+ C-c > Move right after insertion.
+ C-c ^ Move up after insertion.
+ C-c . Move down after insertion.
+ C-c ` Move northwest (nw) after insertion.
+ C-c ' Move northeast (ne) after insertion.
+ C-c / Move southwest (sw) after insertion.
+ C-c \\ Move southeast (se) after insertion.
+The current direction is displayed in the modeline. The initial
+direction is right. Whitespace is inserted and tabs are changed to
+spaces when required by movement. You can move around in the buffer
+with these commands:
+ \\[picture-move-down] Move vertically to SAME column in previous line.
+ \\[picture-move-up] Move vertically to SAME column in next line.
+ \\[picture-end-of-line] Move to column following last non-whitespace character.
+ \\[picture-forward-column] Move right inserting spaces if required.
+ \\[picture-backward-column] Move left changing tabs to spaces if required.
+ C-c C-f Move in direction of current picture motion.
+ C-c C-b Move in opposite direction of current picture motion.
+ Return Move to beginning of next line.
+You can edit tabular text with these commands:
+ M-Tab Move to column beneath (or at) next interesting character.
+ `Indents' relative to a previous line.
+ Tab Move to next stop in tab stop list.
+ C-c Tab Set tab stops according to context of this line.
+ With ARG resets tab stops to default (global) value.
+ See also documentation of variable picture-tab-chars
+ which defines \"interesting character\". You can manually
+ change the tab stop list with command \\[edit-tab-stops].
+You can manipulate text with these commands:
+ C-d Clear (replace) ARG columns after point without moving.
+ C-c C-d Delete char at point - the command normally assigned to C-d.
+ \\[picture-backward-clear-column] Clear (replace) ARG columns before point, moving back over them.
+ \\[picture-clear-line] Clear ARG lines, advancing over them. The cleared
+ text is saved in the kill ring.
+ \\[picture-open-line] Open blank line(s) beneath current line.
+You can manipulate rectangles with these commands:
+ C-c C-k Clear (or kill) a rectangle and save it.
+ C-c C-w Like C-c C-k except rectangle is saved in named register.
+ C-c C-y Overlay (or insert) currently saved rectangle at point.
+ C-c C-x Like C-c C-y except rectangle is taken from named register.
+ \\[copy-rectangle-to-register] Copies a rectangle to a register.
+ \\[advertised-undo] Can undo effects of rectangle overlay commands
+ commands if invoked soon enough.
+You can return to the previous mode with:
+ C-c C-c Which also strips trailing whitespace from every line.
+ Stripping is suppressed by supplying an argument.
+
+Entry to this mode calls the value of picture-mode-hook if non-nil.
+
+Note that Picture mode commands will work outside of Picture mode, but
+they are not defaultly assigned to keys." t nil)
+
+(defalias 'edit-picture 'picture-mode)
+
+;;;***
+\f
+;;;### (autoloads (clear-rectangle string-rectangle open-rectangle insert-rectangle yank-rectangle kill-rectangle extract-rectangle delete-extract-rectangle delete-rectangle) "rect" "lisp/rect.el")
+
+(autoload 'delete-rectangle "rect" "\
+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." 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)
+
+(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)
+
+(autoload 'yank-rectangle "rect" "\
+Yank the last killed rectangle with upper left corner at point." t nil)
+
+(autoload 'insert-rectangle "rect" "\
+Insert text of RECTANGLE with upper left corner at point.
+RECTANGLE's first line is inserted at point, its second
+line is inserted at a point vertically under point, etc.
+RECTANGLE should be a list of strings.
+After this command, the mark is at the upper left corner
+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)
+
+(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.
+
+Called from a program, takes three args; START, END and STRING." 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)
+
+;;;***
+\f
+;;;### (autoloads (list-load-path-shadows) "shadow" "lisp/shadow.el")
+
+(autoload 'list-load-path-shadows "shadow" "\
+Display a list of Emacs Lisp files that shadow other files.
+
+This function lists potential load-path problems. Directories in the
+`load-path' variable are searched, in order, for Emacs Lisp
+files. When a previously encountered file name is found again, a
+message is displayed indicating that the later file is \"hidden\" by
+the earlier.
+
+For example, suppose `load-path' is set to
+
+\(\"/usr/gnu/emacs/site-lisp\" \"/usr/gnu/emacs/share/emacs/19.30/lisp\")
+
+and that each of these directories contains a file called XXX.el. Then
+XXX.el in the site-lisp directory is referred to by all of:
+\(require 'XXX), (autoload .... \"XXX\"), (load-library \"XXX\") etc.
+
+The first XXX.el file prevents emacs from seeing the second (unless
+the second is loaded explicitly via load-file).
+
+When not intended, such shadowings can be the source of subtle
+problems. For example, the above situation may have arisen because the
+XXX package was not distributed with versions of emacs prior to
+19.30. An emacs maintainer downloaded XXX from elsewhere and installed
+it. Later, XXX was updated and included in the emacs distribution.
+Unless the emacs maintainer checks for this, the new version of XXX
+will be hidden behind the old (which may no longer work with the new
+emacs version).
+
+This function performs these checks and flags all possible
+shadowings. Because a .el file may exist without a corresponding .elc
+\(or vice-versa), these suffixes are essentially ignored. A file
+XXX.elc in an early directory (that does not contain XXX.el) is
+considered to shadow a later file XXX.el, and vice-versa.
+
+When run interactively, the shadowings (if any) are displayed in a
+buffer called `*Shadows*'. Shadowings are located by calling the
+\(non-interactive) companion function, `find-emacs-lisp-shadows'." t nil)
+
+;;;***
+\f
+;;;### (autoloads (load-default-sounds load-sound-file) "sound" "lisp/sound.el")
+
+(or sound-alist (setq sound-alist '((ready nil) (warp nil))))
+
+(autoload 'load-sound-file "sound" "\
+Read in an audio-file and add it to the sound-alist.
+
+You can only play sound files if you are running on display 0 of the
+console of a machine with native sound support or running a NetAudio
+server and XEmacs has the necessary sound support compiled in.
+
+The sound file must be in the Sun/NeXT U-LAW format, except on Linux,
+where .wav files are also supported by the sound card drivers." t nil)
+
+(autoload 'load-default-sounds "sound" "\
+Load and install some sound files as beep-types, using
+`load-sound-file'. This only works if you're on display 0 of the
+console of a machine with native sound support or running a NetAudio
+server and XEmacs has the necessary sound support compiled in." t nil)
+
+;;;***
+\f
+;;;### (autoloads (ask-user-about-supersession-threat ask-user-about-lock) "userlock" "lisp/userlock.el")
+
+(autoload 'ask-user-about-lock "userlock" "\
+Ask user what to do when he wants to edit FILE but it is locked by USER.
+This function has a choice of three things to do:
+ do (signal 'file-locked (list FILE USER))
+ to refrain from editing the file
+ return t (grab the lock on the file)
+ return nil (edit the file even though it is locked).
+You can rewrite it to use any criterion you like to choose which one to do." nil nil)
+
+(autoload 'ask-user-about-supersession-threat "userlock" "\
+Ask a user who is about to modify an obsolete buffer what to do.
+This function has two choices: it can return, in which case the modification
+of the buffer will proceed, or it can (signal 'file-supersession (file)),
+in which case the proposed buffer modification will not be made.
+
+You can rewrite this to use any criterion you like to choose which one to do.
+The buffer in question is current when this function is called." nil nil)
+
+;;;***
+\f
+;;;### (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")
+
+(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 "\r" '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 "\ 3\ 3" 'view-quit) (define-key map "\18\11" 'view-quit-toggle-ro) (define-key map "q" 'view-quit) map))
+
+(defvar view-mode-map (let ((map (copy-keymap view-minor-mode-map))) (set-keymap-name map 'view-mode-map) map))
+
+(autoload 'view-file "view-less" "\
+Find FILE, enter view mode. With prefix arg OTHER-P, use other window." t nil)
+
+(autoload 'view-buffer "view-less" "\
+Switch to BUF, enter view mode. With prefix arg use other window." t nil)
+
+(autoload 'view-file-other-window "view-less" "\
+Find FILE in other window, and enter view mode." t nil)
+
+(autoload 'view-buffer-other-window "view-less" "\
+Switch to BUFFER in another window, and enter view mode." t nil)
+
+(autoload 'view-minor-mode "view-less" "\
+Minor mode for viewing text, with bindings like `less'.
+Commands are:
+\\<view-minor-mode-map>
+0..9 prefix args
+- prefix minus
+\\[scroll-up] page forward
+\\[scroll-down] page back
+\\[view-scroll-lines-up] scroll prefix-arg lines forward, default 1.
+\\[view-scroll-lines-down] scroll prefix-arg lines backward, default 1.
+\\[view-scroll-some-lines-down] scroll prefix-arg lines backward, default 10.
+\\[view-scroll-some-lines-up] scroll prefix-arg lines forward, default 10.
+\\[what-line] print line number
+\\[view-mode-describe] print this help message
+\\[view-search-forward] regexp search, uses previous string if you just hit RET
+\\[view-search-backward] as above but searches backward
+\\[view-repeat-search] repeat last search
+\\[view-goto-line] goto line prefix-arg, default 1
+\\[view-last-windowful] goto line prefix-arg, default last line
+\\[view-goto-percent] goto a position by percentage
+\\[toggle-truncate-lines] toggle truncate-lines
+\\[view-file] view another file
+\\[view-buffer] view another buffer
+\\[view-cleanup-backspaces] cleanup backspace constructions
+\\[shell-command] execute a shell command
+\\[shell-command-on-region] execute a shell command with the region as input
+\\[view-quit] exit view-mode, and bury the current buffer.
+
+If invoked with the optional (prefix) arg non-nil, view-mode cleans up
+backspace constructions.
+
+More precisely:
+\\{view-minor-mode-map}" t nil)
+
+(autoload 'view-mode "view-less" "\
+View the current buffer using view-minor-mode. This exists to be 99.9%
+compatible with the implementations of `view-mode' in view.el and older
+versions of view-less.el." t nil)
+
+(autoload 'view-major-mode "view-less" "\
+View the current buffer using view-mode, as a major mode.
+This function has a nonstandard name because `view-mode' is wrongly
+named but is like this for compatibility reasons." t nil)
+
+(autoload 'auto-view-mode "view-less" "\
+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)
+
+;;;***
+\f
+;;;### (autoloads (widget-minor-mode widget-browse-other-window widget-browse widget-browse-at) "wid-browse" "lisp/wid-browse.el")
+
+(autoload 'widget-browse-at "wid-browse" "\
+Browse the widget under point." t nil)
+
+(autoload 'widget-browse "wid-browse" "\
+Create a widget browser for WIDGET." t nil)
+
+(autoload 'widget-browse-other-window "wid-browse" "\
+Show widget browser for WIDGET in other window." t nil)
+
+(autoload 'widget-minor-mode "wid-browse" "\
+Togle minor mode for traversing widgets.
+With arg, turn widget mode on if and only if arg is positive." t nil)
+
+;;;***
+\f
+;;;### (autoloads (widget-delete widget-create widget-prompt-value) "wid-edit" "lisp/wid-edit.el")
+
+(autoload 'widget-prompt-value "wid-edit" "\
+Prompt for a value matching WIDGET, using PROMPT.
+The current value is assumed to be VALUE, unless UNBOUND is non-nil." nil nil)
+
+(autoload 'widget-create "wid-edit" "\
+Create widget of TYPE.
+The optional ARGS are additional keyword arguments." nil nil)
+
+(autoload 'widget-delete "wid-edit" "\
+Delete WIDGET." nil nil)
+
+;;;***
+\f
+;;;### (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)
+
+(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" "\
+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 "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)
+
+;;;***
+
+(provide 'Standard-autoloads)
--- /dev/null
+;;; bytecomp.el --- compilation of Lisp code into byte code.
+
+;;; Copyright (C) 1985-1987, 1991-1994 Free Software Foundation, Inc.
+;;; Copyright (C) 1996 Ben Wing.
+
+;; Author: Jamie Zawinski <jwz@netscape.com>
+;; Hallvard Furuseth <hbf@ulrik.uio.no>
+;; Keywords: internal
+
+;; Subsequently modified by RMS and others.
+
+(defconst byte-compile-version (purecopy "2.25 XEmacs; 22-Mar-96."))
+
+;; 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.
+
+;;; Commentary:
+
+;; The Emacs Lisp byte compiler. This crunches lisp source into a
+;; sort of p-code which takes up less space and can be interpreted
+;; faster. The user entry points are byte-compile-file,
+;; byte-recompile-directory and byte-compile-buffer.
+
+;;; Code:
+
+;;; ========================================================================
+;;; Entry points:
+;;; byte-recompile-directory, byte-compile-file,
+;;; batch-byte-compile, batch-byte-recompile-directory,
+;;; byte-compile, compile-defun,
+;;; display-call-tree
+;;; RMS says:
+;;; (byte-compile-buffer and byte-compile-and-load-file were turned off
+;;; because they are not terribly useful and get in the way of completion.)
+;;; But I'm leaving them. --ben
+
+;;; This version of the byte compiler has the following improvements:
+;;; + optimization of compiled code:
+;;; - removal of unreachable code;
+;;; - removal of calls to side-effectless functions whose return-value
+;;; is unused;
+;;; - compile-time evaluation of safe constant forms, such as (consp nil)
+;;; and (ash 1 6);
+;;; - open-coding of literal lambdas;
+;;; - peephole optimization of emitted code;
+;;; - trivial functions are left uncompiled for speed.
+;;; + support for inline functions;
+;;; + compile-time evaluation of arbitrary expressions;
+;;; + compile-time warning messages for:
+;;; - functions being redefined with incompatible arglists;
+;;; - functions being redefined as macros, or vice-versa;
+;;; - functions or macros defined multiple times in the same file;
+;;; - functions being called with the incorrect number of arguments;
+;;; - functions being called which are not defined globally, in the
+;;; file, or as autoloads;
+;;; - assignment and reference of undeclared free variables;
+;;; - various syntax errors;
+;;; + correct compilation of nested defuns, defmacros, defvars and defsubsts;
+;;; + correct compilation of top-level uses of macros;
+;;; + the ability to generate a histogram of functions called.
+
+;;; User customization variables:
+;;;
+;;; byte-compile-verbose Whether to report the function currently being
+;;; compiled in the minibuffer;
+;;; byte-optimize Whether to do optimizations; this may be
+;;; t, nil, 'source, or 'byte;
+;;; byte-optimize-log Whether to report (in excruciating detail)
+;;; exactly which optimizations have been made.
+;;; This may be t, nil, 'source, or 'byte;
+;;; byte-compile-error-on-warn Whether to stop compilation when a warning is
+;;; produced;
+;;; byte-compile-delete-errors Whether the optimizer may delete calls or
+;;; variable references that are side-effect-free
+;;; except that they may return an error.
+;;; byte-compile-generate-call-tree Whether to generate a histogram of
+;;; function calls. This can be useful for
+;;; finding unused functions, as well as simple
+;;; performance metering.
+;;; byte-compile-warnings List of warnings to issue, or t. May contain
+;;; 'free-vars (references to variables not in the
+;;; current lexical scope)
+;;; 'unused-vars (non-global variables bound but
+;;; not referenced)
+;;; 'unresolved (calls to unknown functions)
+;;; 'callargs (lambda calls with args that don't
+;;; match the lambda's definition)
+;;; 'redefine (function cell redefined from
+;;; a macro to a lambda or vice versa,
+;;; or redefined to take other args)
+;;; 'obsolete (obsolete variables and functions)
+;;; 'pedantic (references to Emacs-compatible
+;;; symbols)
+;;; byte-compile-emacs19-compatibility Whether the compiler should
+;;; generate .elc files which can be loaded into
+;;; generic emacs 19.
+;;; emacs-lisp-file-regexp Regexp for the extension of source-files;
+;;; see also the function byte-compile-dest-file.
+;;; byte-compile-overwrite-file If nil, delete old .elc files before saving.
+;;;
+;;; Most of the above parameters can also be set on a file-by-file basis; see
+;;; the documentation of the `byte-compiler-options' macro.
+
+;;; New Features:
+;;;
+;;; o The form `defsubst' is just like `defun', except that the function
+;;; generated will be open-coded in compiled code which uses it. This
+;;; means that no function call will be generated, it will simply be
+;;; spliced in. Lisp functions calls are very slow, so this can be a
+;;; big win.
+;;;
+;;; You can generally accomplish the same thing with `defmacro', but in
+;;; that case, the defined procedure can't be used as an argument to
+;;; mapcar, etc.
+;;;
+;;; o You can make a given function be inline even if it has already been
+;;; defined with `defun' by using the `proclaim-inline' form like so:
+;;; (proclaim-inline my-function)
+;;; This is, in fact, exactly what `defsubst' does. To make a function no
+;;; longer be inline, you must use `proclaim-notinline'. Beware that if
+;;; you define a function with `defsubst' and later redefine it with
+;;; `defun', it will still be open-coded until you use proclaim-notinline.
+;;;
+;;; o You can also open-code one particular call to a function without
+;;; open-coding all calls. Use the 'inline' form to do this, like so:
+;;;
+;;; (inline (foo 1 2 3)) ;; `foo' will be open-coded
+;;; or...
+;;; (inline ;; `foo' and `baz' will be
+;;; (foo 1 2 3 (bar 5)) ;; open-coded, but `bar' will not.
+;;; (baz 0))
+;;;
+;;; o It is possible to open-code a function in the same file it is defined
+;;; in without having to load that file before compiling it. the
+;;; byte-compiler has been modified to remember function definitions in
+;;; the compilation environment in the same way that it remembers macro
+;;; definitions.
+;;;
+;;; o Forms like ((lambda ...) ...) are open-coded.
+;;;
+;;; o The form `eval-when-compile' is like progn, except that the body
+;;; is evaluated at compile-time. When it appears at top-level, this
+;;; is analogous to the Common Lisp idiom (eval-when (compile) ...).
+;;; When it does not appear at top-level, it is similar to the
+;;; Common Lisp #. reader macro (but not in interpreted code).
+;;;
+;;; o The form `eval-and-compile' is similar to eval-when-compile, but
+;;; the whole form is evalled both at compile-time and at run-time.
+;;;
+;;; o The command M-x byte-compile-and-load-file does what you'd think.
+;;;
+;;; o The command compile-defun is analogous to eval-defun.
+;;;
+;;; o If you run byte-compile-file on a filename which is visited in a
+;;; buffer, and that buffer is modified, you are asked whether you want
+;;; to save the buffer before compiling.
+;;;
+;;; o You can add this to /etc/magic to make file(1) recognise the files
+;;; generated by this compiler:
+;;;
+;;; 0 string ;ELC GNU Emacs Lisp compiled file,
+;;; >4 byte x version %d
+;;;
+;;; TO DO:
+;;;
+;;; o Should implement declarations and proclamations, notably special,
+;;; unspecial, and ignore. Do this in such a way as to not break cl.el.
+;;; o The bound-but-not-used warnings are not issued for variables whose
+;;; bindings were established in the arglist, due to the lack of an
+;;; ignore declaration. Once ignore exists, this should be turned on.
+;;; o Warn about functions and variables defined but not used?
+;;; Maybe add some kind of `export' declaration for this?
+;;; (With interactive functions being automatically exported?)
+;;; o Any reference to a variable, even one which is a no-op, will cause
+;;; the warning not to be given. Possibly we could use the for-effect
+;;; flag to determine when this reference is useless; possibly more
+;;; complex flow analysis would be necessary.
+;;; o If the optimizer deletes a variable reference, we might be left with
+;;; a bound-but-not-referenced warning. Generally this is ok, but not if
+;;; it's a synergistic result of macroexpansion. Need some way to note
+;;; that a varref is being optimized away? Of course it would be nice to
+;;; optimize away the binding too, someday, but it's unsafe today.
+;;; o (See byte-optimize.el for the optimization TODO list.)
+
+(require 'backquote)
+
+(or (fboundp 'defsubst)
+ ;; This really ought to be loaded already!
+ (load-library "bytecomp-runtime"))
+
+(eval-when-compile
+ (defvar byte-compile-single-version nil
+ "If this is true, the choice of emacs version (v19 or v20) byte-codes will
+be hard-coded into bytecomp when it compiles itself. If the compiler itself
+is compiled with optimization, this causes a speedup.")
+
+ (cond (byte-compile-single-version
+ (defmacro byte-compile-single-version () t)
+ (defmacro byte-compile-version-cond (cond) (list 'quote (eval cond))))
+ (t
+ (defmacro byte-compile-single-version () nil)
+ (defmacro byte-compile-version-cond (cond) cond)))
+ )
+
+(defvar emacs-lisp-file-regexp (if (eq system-type 'vax-vms)
+ (purecopy "\\.EL\\(;[0-9]+\\)?$")
+ (purecopy "\\.el$"))
+ "*Regexp which matches Emacs Lisp source files.
+You may want to redefine `byte-compile-dest-file' if you change this.")
+
+;; This enables file name handlers such as jka-compr
+;; to remove parts of the file name that should not be copied
+;; through to the output file name.
+(defun byte-compiler-base-file-name (filename)
+ (let ((handler (find-file-name-handler filename
+ 'byte-compiler-base-file-name)))
+ (if handler
+ (funcall handler 'byte-compiler-base-file-name filename)
+ filename)))
+
+(or (fboundp 'byte-compile-dest-file)
+ ;; The user may want to redefine this along with emacs-lisp-file-regexp,
+ ;; so only define it if it is undefined.
+ (defun byte-compile-dest-file (filename)
+ "Convert an Emacs Lisp source file name to a compiled file name."
+ (setq filename (byte-compiler-base-file-name filename))
+ (setq filename (file-name-sans-versions filename))
+ (cond ((eq system-type 'vax-vms)
+ (concat (substring filename 0 (string-match ";" filename)) "c"))
+ ((string-match emacs-lisp-file-regexp filename)
+ (concat (substring filename 0 (match-beginning 0)) ".elc"))
+ (t (concat filename ".elc")))))
+
+;; This can be the 'byte-compile property of any symbol.
+(autoload 'byte-compile-inline-expand "byte-optimize")
+
+;; This is the entrypoint to the lapcode optimizer pass1.
+(autoload 'byte-optimize-form "byte-optimize")
+;; This is the entrypoint to the lapcode optimizer pass2.
+(autoload 'byte-optimize-lapcode "byte-optimize")
+(autoload 'byte-compile-unfold-lambda "byte-optimize")
+
+;; This is the entry point to the decompiler, which is used by the
+;; disassembler. The disassembler just requires 'byte-compile, but
+;; that doesn't define this function, so this seems to be a reasonable
+;; thing to do.
+(autoload 'byte-decompile-bytecode "byte-opt")
+
+(defvar byte-compile-verbose
+ (and (not noninteractive) (> (device-baud-rate) search-slow-speed))
+ "*Non-nil means print messages describing progress of byte-compiler.")
+
+(defvar byte-compile-emacs19-compatibility
+ (not (emacs-version>= 20))
+ "*Non-nil means generate output that can run in Emacs 19.")
+
+(defvar byte-compile-print-gensym t
+ "*Non-nil means generate code that creates unique symbols at run-time.
+This is achieved by printing uninterned symbols using the `#:SYMBOL'
+notation, so that they will be read uninterned when run.
+
+With this feature, code that uses uninterned symbols in macros will
+not be runnable under pre-21.0 XEmacsen.
+
+When `byte-compile-emacs19-compatibility' is non-nil, this variable is
+ignored and considered to be nil.")
+
+(defvar byte-optimize t
+ "*Enables optimization in the byte compiler.
+nil means don't do any optimization.
+t means do all optimizations.
+`source' means do source-level optimizations only.
+`byte' means do code-level optimizations only.")
+
+(defvar byte-compile-delete-errors t
+ "*If non-nil, the optimizer may delete forms that may signal an error.
+This includes variable references and calls to functions such as `car'.")
+
+;; XEmacs addition
+(defvar byte-compile-new-bytecodes nil
+ "This is completely ignored. It is only around for backwards
+compatibility.")
+
+
+;; FSF enables byte-compile-dynamic-docstrings but not byte-compile-dynamic
+;; by default. This would be a reasonable conservative approach except
+;; for the fact that if you enable either of these, you get incompatible
+;; byte code that can't be read by XEmacs 19.13 or before or FSF 19.28 or
+;; before.
+;;
+;; Therefore, neither is enabled for 19.14. Both are enabled for 20.0
+;; because we have no reason to be conservative about changing the
+;; way things work. (Ben)
+
+;; However, I don't think that defaulting byte-compile-dynamic to nil
+;; is a compatibility issue - rather it is a performance issue.
+;; Therefore I am setting byte-compile-dynamic back to nil. (mrb)
+
+(defvar byte-compile-dynamic nil
+ "*If non-nil, compile function bodies so they load lazily.
+They are hidden comments in the compiled file, and brought into core when the
+function is called.
+
+To enable this option, make it a file-local variable
+in the source file you want it to apply to.
+For example, add -*-byte-compile-dynamic: t;-*- on the first line.
+
+When this option is true, if you load the compiled file and then move it,
+the functions you loaded will not be able to run.")
+
+(defvar byte-compile-dynamic-docstrings (emacs-version>= 20)
+ "*If non-nil, compile doc strings for lazy access.
+We bury the doc strings of functions and variables
+inside comments in the file, and bring them into core only when they
+are actually needed.
+
+When this option is true, if you load the compiled file and then move it,
+you won't be able to find the documentation of anything in that file.
+
+To disable this option for a certain file, make it a file-local variable
+in the source file. For example, add this to the first line:
+ -*-byte-compile-dynamic-docstrings:nil;-*-
+You can also set the variable globally.
+
+This option is enabled by default because it reduces Emacs memory usage.")
+
+(defvar byte-optimize-log nil
+ "*If true, the byte-compiler will log its optimizations into *Compile-Log*.
+If this is 'source, then only source-level optimizations will be logged.
+If it is 'byte, then only byte-level optimizations will be logged.")
+
+(defvar byte-compile-error-on-warn nil
+ "*If true, the byte-compiler reports warnings with `error'.")
+
+;; byte-compile-warning-types in FSF.
+(defvar byte-compile-default-warnings
+ '(redefine callargs free-vars unresolved unused-vars obsolete)
+ "*The warnings used when byte-compile-warnings is t.")
+
+(defvar byte-compile-warnings t
+ "*List of warnings that the compiler should issue (t for the default set).
+Elements of the list may be:
+
+ free-vars references to variables not in the current lexical scope.
+ unused-vars references to non-global variables bound but not referenced.
+ unresolved calls to unknown functions.
+ callargs lambda calls with args that don't match the definition.
+ redefine function cell redefined from a macro to a lambda or vice
+ versa, or redefined to take a different number of arguments.
+ obsolete use of an obsolete function or variable.
+ pedantic warn of use of compatible symbols.
+
+The default set is specified by `byte-compile-default-warnings' and
+normally encompasses all possible warnings.
+
+See also the macro `byte-compiler-options'.")
+
+(defvar byte-compile-generate-call-tree nil
+ "*Non-nil means collect call-graph information when compiling.
+This records functions were called and from where.
+If the value is t, compilation displays the call graph when it finishes.
+If the value is neither t nor nil, compilation asks you whether to display
+the graph.
+
+The call tree only lists functions called, not macros used. Those functions
+which the byte-code interpreter knows about directly (eq, cons, etc.) are
+not reported.
+
+The call tree also lists those functions which are not known to be called
+\(that is, to which no calls have been compiled). Functions which can be
+invoked interactively are excluded from this list.")
+
+(defconst byte-compile-call-tree nil "Alist of functions and their call tree.
+Each element looks like
+
+ \(FUNCTION CALLERS CALLS\)
+
+where CALLERS is a list of functions that call FUNCTION, and CALLS
+is a list of functions for which calls were generated while compiling
+FUNCTION.")
+
+(defvar byte-compile-call-tree-sort 'name
+ "*If non-nil, sort the call tree.
+The values `name', `callers', `calls', `calls+callers'
+specify different fields to sort on.")
+
+(defvar byte-compile-overwrite-file t
+ "If nil, old .elc files are deleted before the new is saved, and .elc
+files will have the same modes as the corresponding .el file. Otherwise,
+existing .elc files will simply be overwritten, and the existing modes
+will not be changed. If this variable is nil, then an .elc file which
+is a symbolic link will be turned into a normal file, instead of the file
+which the link points to being overwritten.")
+
+(defvar byte-recompile-directory-ignore-errors-p nil
+ "If true, then `byte-recompile-directory' will continue compiling even
+when an error occurs in a file. This is bound to t by
+`batch-byte-recompile-directory'.")
+
+(defvar byte-recompile-directory-recursively t
+ "*If true, then `byte-recompile-directory' will recurse on subdirectories.")
+
+(defvar byte-compile-constants nil
+ "list of all constants encountered during compilation of this form")
+(defvar byte-compile-variables nil
+ "list of all variables encountered during compilation of this form")
+(defvar byte-compile-bound-variables nil
+ "Alist of variables bound in the context of the current form,
+that is, the current lexical environment. This list lives partly
+on the specbind stack. The cdr of each cell is an integer bitmask.")
+
+(defconst byte-compile-referenced-bit 1)
+(defconst byte-compile-assigned-bit 2)
+(defconst byte-compile-arglist-bit 4)
+(defconst byte-compile-global-bit 8)
+
+(defvar byte-compile-free-references)
+(defvar byte-compile-free-assignments)
+
+(defvar byte-compiler-error-flag)
+
+(defconst byte-compile-initial-macro-environment
+ (purecopy
+ '((byte-compiler-options . (lambda (&rest forms)
+ (apply 'byte-compiler-options-handler forms)))
+ (eval-when-compile . (lambda (&rest body)
+ (list 'quote (eval (byte-compile-top-level
+ (cons 'progn body))))))
+ (eval-and-compile . (lambda (&rest body)
+ (eval (cons 'progn body))
+ (cons 'progn body)))))
+ "The default macro-environment passed to macroexpand by the compiler.
+Placing a macro here will cause a macro to have different semantics when
+expanded by the compiler as when expanded by the interpreter.")
+
+(defvar byte-compile-macro-environment byte-compile-initial-macro-environment
+ "Alist of macros defined in the file being compiled.
+Each element looks like (MACRONAME . DEFINITION). It is
+\(MACRONAME . nil) when a macro is redefined as a function.")
+
+(defvar byte-compile-function-environment nil
+ "Alist of functions defined in the file being compiled.
+This is so we can inline them when necessary.
+Each element looks like (FUNCTIONNAME . DEFINITION). It is
+\(FUNCTIONNAME . nil) when a function is redefined as a macro.")
+
+(defvar byte-compile-autoload-environment nil
+ "Alist of functions and macros defined by autoload in the file being compiled.
+This is so we can suppress warnings about calls to these functions, even though
+they do not have `real' definitions.
+Each element looks like (FUNCTIONNAME . CALL-TO-AUTOLOAD).")
+
+(defvar byte-compile-unresolved-functions nil
+ "Alist of undefined functions to which calls have been compiled (used for
+warnings when the function is later defined with incorrect args).")
+
+(defvar byte-compile-file-domain) ; domain of file being compiled
+
+(defvar byte-compile-tag-number 0)
+(defvar byte-compile-output nil
+ "Alist describing contents to put in byte code string.
+Each element is (INDEX . VALUE)")
+(defvar byte-compile-depth 0 "Current depth of execution stack.")
+(defvar byte-compile-maxdepth 0 "Maximum depth of execution stack.")
+
+\f
+;;; The byte codes; this information is duplicated in bytecode.c
+
+(defconst byte-code-vector nil
+ "An array containing byte-code names indexed by byte-code values.")
+
+(defconst byte-stack+-info nil
+ "An array with the stack adjustment for each byte-code.")
+
+(defmacro byte-defop (opcode stack-adjust opname &optional docstring)
+ ;; This is a speed-hack for building the byte-code-vector at compile-time.
+ ;; We fill in the vector at macroexpand-time, and then after the last call
+ ;; to byte-defop, we write the vector out as a constant instead of writing
+ ;; out a bunch of calls to aset.
+ ;; Actually, we don't fill in the vector itself, because that could make
+ ;; it problematic to compile big changes to this compiler; we store the
+ ;; values on its plist, and remove them later in -extrude.
+ (let ((v1 (or (get 'byte-code-vector 'tmp-compile-time-value)
+ (put 'byte-code-vector 'tmp-compile-time-value
+ (make-vector 256 nil))))
+ (v2 (or (get 'byte-stack+-info 'tmp-compile-time-value)
+ (put 'byte-stack+-info 'tmp-compile-time-value
+ (make-vector 256 nil)))))
+ (aset v1 opcode opname)
+ (aset v2 opcode stack-adjust))
+ (if docstring
+ (list 'defconst opname opcode (concat "Byte code opcode " docstring "."))
+ (list 'defconst opname opcode)))
+
+(defmacro byte-extrude-byte-code-vectors ()
+ (prog1 (list 'setq 'byte-code-vector
+ (get 'byte-code-vector 'tmp-compile-time-value)
+ 'byte-stack+-info
+ (get 'byte-stack+-info 'tmp-compile-time-value))
+ (remprop 'byte-code-vector 'tmp-compile-time-value)
+ (remprop 'byte-stack+-info 'tmp-compile-time-value)))
+
+
+;; unused: 0-7
+
+;; These opcodes are special in that they pack their argument into the
+;; opcode word.
+;;
+(byte-defop 8 1 byte-varref "for variable reference")
+(byte-defop 16 -1 byte-varset "for setting a variable")
+(byte-defop 24 -1 byte-varbind "for binding a variable")
+(byte-defop 32 0 byte-call "for calling a function")
+(byte-defop 40 0 byte-unbind "for unbinding special bindings")
+;; codes 8-47 are consumed by the preceding opcodes
+
+;; unused: 48-55
+
+(byte-defop 56 -1 byte-nth)
+(byte-defop 57 0 byte-symbolp)
+(byte-defop 58 0 byte-consp)
+(byte-defop 59 0 byte-stringp)
+(byte-defop 60 0 byte-listp)
+(byte-defop 61 -1 byte-old-eq)
+(byte-defop 62 -1 byte-old-memq)
+(byte-defop 63 0 byte-not)
+(byte-defop 64 0 byte-car)
+(byte-defop 65 0 byte-cdr)
+(byte-defop 66 -1 byte-cons)
+(byte-defop 67 0 byte-list1)
+(byte-defop 68 -1 byte-list2)
+(byte-defop 69 -2 byte-list3)
+(byte-defop 70 -3 byte-list4)
+(byte-defop 71 0 byte-length)
+(byte-defop 72 -1 byte-aref)
+(byte-defop 73 -2 byte-aset)
+(byte-defop 74 0 byte-symbol-value)
+(byte-defop 75 0 byte-symbol-function) ; this was commented out
+(byte-defop 76 -1 byte-set)
+(byte-defop 77 -1 byte-fset) ; this was commented out
+(byte-defop 78 -1 byte-get)
+(byte-defop 79 -2 byte-substring)
+(byte-defop 80 -1 byte-concat2)
+(byte-defop 81 -2 byte-concat3)
+(byte-defop 82 -3 byte-concat4)
+(byte-defop 83 0 byte-sub1)
+(byte-defop 84 0 byte-add1)
+(byte-defop 85 -1 byte-eqlsign)
+(byte-defop 86 -1 byte-gtr)
+(byte-defop 87 -1 byte-lss)
+(byte-defop 88 -1 byte-leq)
+(byte-defop 89 -1 byte-geq)
+(byte-defop 90 -1 byte-diff)
+(byte-defop 91 0 byte-negate)
+(byte-defop 92 -1 byte-plus)
+(byte-defop 93 -1 byte-max)
+(byte-defop 94 -1 byte-min)
+(byte-defop 95 -1 byte-mult)
+(byte-defop 96 1 byte-point)
+(byte-defop 97 -1 byte-eq) ; new as of v20
+(byte-defop 98 0 byte-goto-char)
+(byte-defop 99 0 byte-insert)
+(byte-defop 100 1 byte-point-max)
+(byte-defop 101 1 byte-point-min)
+(byte-defop 102 0 byte-char-after)
+(byte-defop 103 1 byte-following-char)
+(byte-defop 104 1 byte-preceding-char)
+(byte-defop 105 1 byte-current-column)
+(byte-defop 106 0 byte-indent-to)
+(byte-defop 107 -1 byte-equal) ; new as of v20
+(byte-defop 108 1 byte-eolp)
+(byte-defop 109 1 byte-eobp)
+(byte-defop 110 1 byte-bolp)
+(byte-defop 111 1 byte-bobp)
+(byte-defop 112 1 byte-current-buffer)
+(byte-defop 113 0 byte-set-buffer)
+(byte-defop 114 0 byte-save-current-buffer
+ "To make a binding to record the current buffer.")
+;;(byte-defop 114 1 byte-read-char-OBSOLETE) ;obsolete as of v19
+(byte-defop 115 -1 byte-memq) ; new as of v20
+(byte-defop 116 1 byte-interactive-p)
+
+(byte-defop 117 0 byte-forward-char)
+(byte-defop 118 0 byte-forward-word)
+(byte-defop 119 -1 byte-skip-chars-forward)
+(byte-defop 120 -1 byte-skip-chars-backward)
+(byte-defop 121 0 byte-forward-line)
+(byte-defop 122 0 byte-char-syntax)
+(byte-defop 123 -1 byte-buffer-substring)
+(byte-defop 124 -1 byte-delete-region)
+(byte-defop 125 -1 byte-narrow-to-region)
+(byte-defop 126 1 byte-widen)
+(byte-defop 127 0 byte-end-of-line)
+
+;; unused: 128
+
+;; These store their argument in the next two bytes
+(byte-defop 129 1 byte-constant2
+ "for reference to a constant with vector index >= byte-constant-limit")
+(byte-defop 130 0 byte-goto "for unconditional jump")
+(byte-defop 131 -1 byte-goto-if-nil "to pop value and jump if it's nil")
+(byte-defop 132 -1 byte-goto-if-not-nil
+ "to pop value and jump if it's not nil")
+(byte-defop 133 -1 byte-goto-if-nil-else-pop
+ "to examine top-of-stack, jump and don't pop it if it's nil,
+otherwise pop it")
+(byte-defop 134 -1 byte-goto-if-not-nil-else-pop
+ "to examine top-of-stack, jump and don't pop it if it's non nil,
+otherwise pop it")
+
+(byte-defop 135 -1 byte-return "to pop a value and return it from `byte-code'")
+(byte-defop 136 -1 byte-discard "to discard one value from stack")
+(byte-defop 137 1 byte-dup "to duplicate the top of the stack")
+
+(byte-defop 138 0 byte-save-excursion
+ "to make a binding to record the buffer, point and mark")
+(byte-defop 139 0 byte-save-window-excursion
+ "to make a binding to record entire window configuration")
+(byte-defop 140 0 byte-save-restriction
+ "to make a binding to record the current buffer clipping restrictions")
+(byte-defop 141 -1 byte-catch
+ "for catch. Takes, on stack, the tag and an expression for the body")
+(byte-defop 142 -1 byte-unwind-protect
+ "for unwind-protect. Takes, on stack, an expression for the unwind-action")
+
+;; For condition-case. Takes, on stack, the variable to bind,
+;; an expression for the body, and a list of clauses.
+(byte-defop 143 -2 byte-condition-case)
+
+;; For entry to with-output-to-temp-buffer.
+;; Takes, on stack, the buffer name.
+;; Binds standard-output and does some other things.
+;; Returns with temp buffer on the stack in place of buffer name.
+(byte-defop 144 0 byte-temp-output-buffer-setup)
+
+;; For exit from with-output-to-temp-buffer.
+;; Expects the temp buffer on the stack underneath value to return.
+;; Pops them both, then pushes the value back on.
+;; Unbinds standard-output and makes the temp buffer visible.
+(byte-defop 145 -1 byte-temp-output-buffer-show)
+
+;; To unbind back to the beginning of this frame.
+;; Not used yet, but will be needed for tail-recursion elimination.
+(byte-defop 146 0 byte-unbind-all)
+
+(byte-defop 147 -2 byte-set-marker)
+(byte-defop 148 0 byte-match-beginning)
+(byte-defop 149 0 byte-match-end)
+(byte-defop 150 0 byte-upcase)
+(byte-defop 151 0 byte-downcase)
+(byte-defop 152 -1 byte-string=)
+(byte-defop 153 -1 byte-string<)
+(byte-defop 154 -1 byte-old-equal)
+(byte-defop 155 -1 byte-nthcdr)
+(byte-defop 156 -1 byte-elt)
+(byte-defop 157 -1 byte-old-member)
+(byte-defop 158 -1 byte-old-assq)
+(byte-defop 159 0 byte-nreverse)
+(byte-defop 160 -1 byte-setcar)
+(byte-defop 161 -1 byte-setcdr)
+(byte-defop 162 0 byte-car-safe)
+(byte-defop 163 0 byte-cdr-safe)
+(byte-defop 164 -1 byte-nconc)
+(byte-defop 165 -1 byte-quo)
+(byte-defop 166 -1 byte-rem)
+(byte-defop 167 0 byte-numberp)
+(byte-defop 168 0 byte-integerp)
+
+;; unused: 169
+
+;; These are not present in FSF.
+;;
+(byte-defop 170 0 byte-rel-goto)
+(byte-defop 171 -1 byte-rel-goto-if-nil)
+(byte-defop 172 -1 byte-rel-goto-if-not-nil)
+(byte-defop 173 -1 byte-rel-goto-if-nil-else-pop)
+(byte-defop 174 -1 byte-rel-goto-if-not-nil-else-pop)
+
+(byte-defop 175 nil byte-listN)
+(byte-defop 176 nil byte-concatN)
+(byte-defop 177 nil byte-insertN)
+
+;; unused: 178-181
+
+;; these ops are new to v20
+(byte-defop 182 -1 byte-member)
+(byte-defop 183 -1 byte-assq)
+
+;; unused: 184-191
+
+(byte-defop 192 1 byte-constant "for reference to a constant")
+;; codes 193-255 are consumed by byte-constant.
+(defconst byte-constant-limit 64
+ "Exclusive maximum index usable in the `byte-constant' opcode.")
+
+(defconst byte-goto-ops (purecopy
+ '(byte-goto byte-goto-if-nil byte-goto-if-not-nil
+ byte-goto-if-nil-else-pop
+ byte-goto-if-not-nil-else-pop))
+ "List of byte-codes whose offset is a pc.")
+
+(defconst byte-goto-always-pop-ops
+ (purecopy '(byte-goto-if-nil byte-goto-if-not-nil)))
+
+(defconst byte-rel-goto-ops
+ (purecopy '(byte-rel-goto byte-rel-goto-if-nil byte-rel-goto-if-not-nil
+ byte-rel-goto-if-nil-else-pop byte-rel-goto-if-not-nil-else-pop))
+ "byte-codes for relative jumps.")
+
+(byte-extrude-byte-code-vectors)
+\f
+;;; lapcode generator
+;;;
+;;; the byte-compiler now does source -> lapcode -> bytecode instead of
+;;; source -> bytecode, because it's a lot easier to make optimizations
+;;; on lapcode than on bytecode.
+;;;
+;;; Elements of the lapcode list are of the form (<instruction> . <parameter>)
+;;; where instruction is a symbol naming a byte-code instruction,
+;;; and parameter is an argument to that instruction, if any.
+;;;
+;;; The instruction can be the pseudo-op TAG, which means that this position
+;;; in the instruction stream is a target of a goto. (car PARAMETER) will be
+;;; the PC for this location, and the whole instruction "(TAG pc)" will be the
+;;; parameter for some goto op.
+;;;
+;;; If the operation is varbind, varref, varset or push-constant, then the
+;;; parameter is (variable/constant . index_in_constant_vector).
+;;;
+;;; First, the source code is macroexpanded and optimized in various ways.
+;;; Then the resultant code is compiled into lapcode. Another set of
+;;; optimizations are then run over the lapcode. Then the variables and
+;;; constants referenced by the lapcode are collected and placed in the
+;;; constants-vector. (This happens now so that variables referenced by dead
+;;; code don't consume space.) And finally, the lapcode is transformed into
+;;; compacted byte-code.
+;;;
+;;; A distinction is made between variables and constants because the variable-
+;;; referencing instructions are more sensitive to the variables being near the
+;;; front of the constants-vector than the constant-referencing instructions.
+;;; Also, this lets us notice references to free variables.
+
+(defun byte-compile-lapcode (lap)
+ "Turns lapcode into bytecode. The lapcode is destroyed."
+ ;; Lapcode modifications: changes the ID of a tag to be the tag's PC.
+ (let ((pc 0) ; Program counter
+ op off ; Operation & offset
+ (bytes '()) ; Put the output bytes here
+ (patchlist nil) ; List of tags and goto's to patch
+ rest rel tmp)
+ (while lap
+ (setq op (car (car lap))
+ off (cdr (car lap)))
+ (cond ((not (symbolp op))
+ (error "Non-symbolic opcode `%s'" op))
+ ((eq op 'TAG)
+ (setcar off pc)
+ (setq patchlist (cons off patchlist)))
+ ((memq op byte-goto-ops)
+ (setq pc (+ pc 3))
+ (setq bytes (cons (cons pc (cdr off))
+ (cons nil
+ (cons (symbol-value op) bytes))))
+ (setq patchlist (cons bytes patchlist)))
+ (t
+ (setq bytes
+ (cond ((cond ((consp off)
+ ;; Variable or constant reference
+ (setq off (cdr off))
+ (eq op 'byte-constant)))
+ (cond ((< off byte-constant-limit)
+ (setq pc (1+ pc))
+ (cons (+ byte-constant off) bytes))
+ (t
+ (setq pc (+ 3 pc))
+ (cons (lsh off -8)
+ (cons (logand off 255)
+ (cons byte-constant2 bytes))))))
+ ((and (<= byte-listN (symbol-value op))
+ (<= (symbol-value op) byte-insertN))
+ (setq pc (+ 2 pc))
+ (cons off (cons (symbol-value op) bytes)))
+ ((< off 6)
+ (setq pc (1+ pc))
+ (cons (+ (symbol-value op) off) bytes))
+ ((< off 256)
+ (setq pc (+ 2 pc))
+ (cons off (cons (+ (symbol-value op) 6) bytes)))
+ (t
+ (setq pc (+ 3 pc))
+ (cons (lsh off -8)
+ (cons (logand off 255)
+ (cons (+ (symbol-value op) 7)
+ bytes))))))))
+ (setq lap (cdr lap)))
+ ;;(if (not (= pc (length bytes)))
+ ;; (error "Compiler error: pc mismatch - %s %s" pc (length bytes)))
+ (cond (t ;; starting with Emacs 19.
+ ;; Make relative jumps
+ (setq patchlist (nreverse patchlist))
+ (while (progn
+ (setq off 0) ; PC change because of deleted bytes
+ (setq rest patchlist)
+ (while rest
+ (setq tmp (car rest))
+ (and (consp (car tmp)) ; Jump
+ (prog1 (null (nth 1 tmp)) ; Absolute jump
+ (setq tmp (car tmp)))
+ (progn
+ (setq rel (- (car (cdr tmp)) (car tmp)))
+ (and (<= -129 rel) (< rel 128)))
+ (progn
+ ;; Convert to relative jump.
+ (setcdr (car rest) (cdr (cdr (car rest))))
+ (setcar (cdr (car rest))
+ (+ (car (cdr (car rest)))
+ (- byte-rel-goto byte-goto)))
+ (setq off (1- off))))
+ (setcar tmp (+ (car tmp) off)) ; Adjust PC
+ (setq rest (cdr rest)))
+ ;; If optimizing, repeat until no change.
+ (and byte-optimize
+ (not (zerop off)))))))
+ ;; Patch PC into jumps
+ (let (bytes)
+ (while patchlist
+ (setq bytes (car patchlist))
+ (cond ((atom (car bytes))) ; Tag
+ ((nth 1 bytes) ; Relative jump
+ (setcar bytes (+ (- (car (cdr (car bytes))) (car (car bytes)))
+ 128)))
+ (t ; Absolute jump
+ (setq pc (car (cdr (car bytes)))) ; Pick PC from tag
+ (setcar (cdr bytes) (logand pc 255))
+ (setcar bytes (lsh pc -8))))
+ (setq patchlist (cdr patchlist))))
+ (concat (nreverse bytes))))
+
+\f
+;;; byte compiler messages
+
+(defvar byte-compile-current-form nil)
+(defvar byte-compile-current-file nil)
+(defvar byte-compile-dest-file nil)
+
+(defmacro byte-compile-log (format-string &rest args)
+ (list 'and
+ 'byte-optimize
+ '(memq byte-optimize-log '(t source))
+ (list 'let '((print-escape-newlines t)
+ (print-level 4)
+ (print-length 4))
+ (list 'byte-compile-log-1
+ (cons 'format
+ (cons format-string
+ (mapcar
+ '(lambda (x)
+ (if (symbolp x) (list 'prin1-to-string x) x))
+ args)))))))
+
+(defconst byte-compile-last-warned-form nil)
+
+;; Log a message STRING in *Compile-Log*.
+;; Also log the current function and file if not already done.
+(defun byte-compile-log-1 (string &optional fill)
+ (let ((this-form (or byte-compile-current-form "toplevel forms")))
+ (cond
+ (noninteractive
+ (if (or byte-compile-current-file
+ (and byte-compile-last-warned-form
+ (not (eq this-form byte-compile-last-warned-form))))
+ (message
+ (format "While compiling %s%s:"
+ this-form
+ (if byte-compile-current-file
+ (if (stringp byte-compile-current-file)
+ (concat " in file " byte-compile-current-file)
+ (concat " in buffer "
+ (buffer-name byte-compile-current-file)))
+ ""))))
+ (message " %s" string))
+ (t
+ (save-excursion
+ (set-buffer (get-buffer-create "*Compile-Log*"))
+ (goto-char (point-max))
+ (cond ((or byte-compile-current-file
+ (and byte-compile-last-warned-form
+ (not (eq this-form byte-compile-last-warned-form))))
+ (if byte-compile-current-file
+ (insert "\n\^L\n" (current-time-string) "\n"))
+ (insert "While compiling "
+ (if (stringp this-form) this-form
+ (format "%s" this-form)))
+ (if byte-compile-current-file
+ (if (stringp byte-compile-current-file)
+ (insert " in file " byte-compile-current-file)
+ (insert " in buffer "
+ (buffer-name byte-compile-current-file))))
+ (insert ":\n")))
+ (insert " " string "\n")
+ (if (and fill (not (string-match "\n" string)))
+ (let ((fill-prefix " ")
+ (fill-column 78))
+ (fill-paragraph nil)))
+ )))
+ (setq byte-compile-current-file nil
+ byte-compile-last-warned-form this-form)))
+
+;; Log the start of a file in *Compile-Log*, and mark it as done.
+;; But do nothing in batch mode.
+(defun byte-compile-log-file ()
+ (and byte-compile-current-file (not noninteractive)
+ (save-excursion
+ (set-buffer (get-buffer-create "*Compile-Log*"))
+ (goto-char (point-max))
+ (insert "\n\^L\nCompiling "
+ (if (stringp byte-compile-current-file)
+ (concat "file " byte-compile-current-file)
+ (concat "buffer " (buffer-name byte-compile-current-file)))
+ " at " (current-time-string) "\n")
+ (setq byte-compile-current-file nil))))
+
+(defun byte-compile-warn (format &rest args)
+ (setq format (apply 'format format args))
+ (if byte-compile-error-on-warn
+ (error "%s" format) ; byte-compile-file catches and logs it
+ (byte-compile-log-1 (concat "** " format) t)
+;;; RMS says:
+;;; It is useless to flash warnings too fast to be read.
+;;; Besides, they will all be shown at the end.
+;;; and comments out the next two lines.
+ (or noninteractive ; already written on stdout.
+ (message "Warning: %s" format))))
+
+;;; This function should be used to report errors that have halted
+;;; compilation of the current file.
+(defun byte-compile-report-error (error-info)
+ (setq byte-compiler-error-flag t)
+ (byte-compile-log-1
+ (concat "!! "
+ (format (if (cdr error-info) "%s (%s)" "%s")
+ (get (car error-info) 'error-message)
+ (prin1-to-string (cdr error-info))))))
+
+;;; Used by make-obsolete.
+(defun byte-compile-obsolete (form)
+ (let ((new (get (car form) 'byte-obsolete-info)))
+ (if (memq 'obsolete byte-compile-warnings)
+ (byte-compile-warn "%s is an obsolete function; %s" (car form)
+ (if (stringp (car new))
+ (car new)
+ (format "use %s instead." (car new)))))
+ (funcall (or (cdr new) 'byte-compile-normal-call) form)))
+
+;;; Used by make-obsolete.
+(defun byte-compile-compatible (form)
+ (let ((new (get (car form) 'byte-compatible-info)))
+ (if (memq 'pedantic byte-compile-warnings)
+ (byte-compile-warn "%s is provided for compatibility; %s" (car form)
+ (if (stringp (car new))
+ (car new)
+ (format "use %s instead." (car new)))))
+ (funcall (or (cdr new) 'byte-compile-normal-call) form)))
+\f
+;; Compiler options
+
+(defconst byte-compiler-legal-options
+ '((optimize byte-optimize (t nil source byte) val)
+ (file-format byte-compile-emacs19-compatibility (emacs19 emacs20)
+ (eq val 'emacs19))
+ (delete-errors byte-compile-delete-errors (t nil) val)
+ (verbose byte-compile-verbose (t nil) val)
+ (new-bytecodes byte-compile-new-bytecodes (t nil) val)
+ (warnings byte-compile-warnings
+ ((callargs redefine free-vars unused-vars unresolved))
+ val)))
+
+;; XEmacs addition
+(defconst byte-compiler-obsolete-options
+ '((new-bytecodes t)))
+
+;; Inhibit v19/v20 selectors if the version is hardcoded.
+;; #### This should print a warning if the user tries to change something
+;; than can't be changed because the running compiler doesn't support it.
+(cond
+ ((byte-compile-single-version)
+ (setcar (cdr (cdr (assq 'file-format byte-compiler-legal-options)))
+ (if (byte-compile-version-cond byte-compile-emacs19-compatibility)
+ '(emacs19) '(emacs20)))))
+
+;; now we can copy it.
+(setq byte-compiler-legal-options (purecopy byte-compiler-legal-options))
+
+(defun byte-compiler-options-handler (&rest args)
+ (let (key val desc choices)
+ (while args
+ (if (or (atom (car args)) (nthcdr 2 (car args)) (null (cdr (car args))))
+ (error "malformed byte-compiler-option %s" (car args)))
+ (setq key (car (car args))
+ val (car (cdr (car args)))
+ desc (assq key byte-compiler-legal-options))
+ (or desc
+ (error "unknown byte-compiler option %s" key))
+ (if (assq key byte-compiler-obsolete-options)
+ (byte-compile-warn "%s is an obsolete byte-compiler option." key))
+ (setq choices (nth 2 desc))
+ (if (consp (car choices))
+ (let* (this
+ (handler 'cons)
+ (var (nth 1 desc))
+ (ret (and (memq (car val) '(+ -))
+ (copy-sequence (if (eq t (symbol-value var))
+ (car choices)
+ (symbol-value var))))))
+ (setq choices (car choices))
+ (while val
+ (setq this (car val))
+ (cond ((memq this choices)
+ (setq ret (funcall handler this ret)))
+ ((eq this '+) (setq handler 'cons))
+ ((eq this '-) (setq handler 'delq))
+ ((error "%s only accepts %s." key choices)))
+ (setq val (cdr val)))
+ (set (nth 1 desc) ret))
+ (or (memq val choices)
+ (error "%s must be one of %s." key choices))
+ (set (nth 1 desc) (eval (nth 3 desc))))
+ (setq args (cdr args)))
+ nil))
+\f
+;;; sanity-checking arglists
+
+(defun byte-compile-fdefinition (name macro-p)
+ (let* ((list (if (memq macro-p '(nil subr))
+ byte-compile-function-environment
+ byte-compile-macro-environment))
+ (env (cdr (assq name list))))
+ (or env
+ (let ((fn name))
+ (while (and (symbolp fn)
+ (fboundp fn)
+ (or (symbolp (symbol-function fn))
+ (consp (symbol-function fn))
+ (and (not macro-p)
+ (compiled-function-p (symbol-function fn)))
+ (and (eq macro-p 'subr) (subrp fn))))
+ (setq fn (symbol-function fn)))
+ (if (or (and (not macro-p) (compiled-function-p fn))
+ (and (eq macro-p 'subr) (subrp fn)))
+ fn
+ (and (consp fn)
+ (not (eq macro-p 'subr))
+ (if (eq 'macro (car fn))
+ (cdr fn)
+ (if macro-p
+ nil
+ (if (eq 'autoload (car fn))
+ nil
+ fn)))))))))
+
+(defun byte-compile-arglist-signature (arglist)
+ (let ((args 0)
+ opts
+ restp)
+ (while arglist
+ (cond ((eq (car arglist) '&optional)
+ (or opts (setq opts 0)))
+ ((eq (car arglist) '&rest)
+ (if (cdr arglist)
+ (setq restp t
+ arglist nil)))
+ (t
+ (if opts
+ (setq opts (1+ opts))
+ (setq args (1+ args)))))
+ (setq arglist (cdr arglist)))
+ (cons args (if restp nil (if opts (+ args opts) args)))))
+
+
+(defun byte-compile-arglist-signatures-congruent-p (old new)
+ (not (or
+ (> (car new) (car old)) ; requires more args now
+ (and (null (cdr old)) ; tooks rest-args, doesn't any more
+ (cdr new))
+ (and (cdr new) (cdr old) ; can't take as many args now
+ (< (cdr new) (cdr old)))
+ )))
+
+(defun byte-compile-arglist-signature-string (signature)
+ (cond ((null (cdr signature))
+ (format "%d+" (car signature)))
+ ((= (car signature) (cdr signature))
+ (format "%d" (car signature)))
+ (t (format "%d-%d" (car signature) (cdr signature)))))
+
+
+;; Warn if the form is calling a function with the wrong number of arguments.
+(defun byte-compile-callargs-warn (form)
+ (let* ((def (or (byte-compile-fdefinition (car form) nil)
+ (byte-compile-fdefinition (car form) t)))
+ (sig (and def (byte-compile-arglist-signature
+ (if (eq 'lambda (car-safe def))
+ (nth 1 def)
+ (if (compiled-function-p def)
+ (compiled-function-arglist def)
+ '(&rest def))))))
+ (ncall (length (cdr form))))
+ (if (and (null def)
+ (fboundp 'subr-min-args)
+ (setq def (byte-compile-fdefinition (car form) 'subr)))
+ (setq sig (cons (subr-min-args def) (subr-max-args def))))
+ (if sig
+ (if (or (< ncall (car sig))
+ (and (cdr sig) (> ncall (cdr sig))))
+ (byte-compile-warn
+ "%s called with %d argument%s, but %s %s"
+ (car form) ncall
+ (if (= 1 ncall) "" "s")
+ (if (< ncall (car sig))
+ "requires"
+ "accepts only")
+ (byte-compile-arglist-signature-string sig)))
+ (or (fboundp (car form)) ; might be a subr or autoload.
+ ;; ## this doesn't work with recursion.
+ (eq (car form) byte-compile-current-form)
+ ;; It's a currently-undefined function.
+ ;; Remember number of args in call.
+ (let ((cons (assq (car form) byte-compile-unresolved-functions))
+ (n (length (cdr form))))
+ (if cons
+ (or (memq n (cdr cons))
+ (setcdr cons (cons n (cdr cons))))
+ (setq byte-compile-unresolved-functions
+ (cons (list (car form) n)
+ byte-compile-unresolved-functions))))))))
+
+;; Warn if the function or macro is being redefined with a different
+;; number of arguments.
+(defun byte-compile-arglist-warn (form macrop)
+ (let ((old (byte-compile-fdefinition (nth 1 form) macrop)))
+ (if old
+ (let ((sig1 (byte-compile-arglist-signature
+ (if (eq 'lambda (car-safe old))
+ (nth 1 old)
+ (if (compiled-function-p old)
+ (compiled-function-arglist old)
+ '(&rest def)))))
+ (sig2 (byte-compile-arglist-signature (nth 2 form))))
+ (or (byte-compile-arglist-signatures-congruent-p sig1 sig2)
+ (byte-compile-warn "%s %s used to take %s %s, now takes %s"
+ (if (eq (car form) 'defun) "function" "macro")
+ (nth 1 form)
+ (byte-compile-arglist-signature-string sig1)
+ (if (equal sig1 '(1 . 1)) "argument" "arguments")
+ (byte-compile-arglist-signature-string sig2))))
+ ;; This is the first definition. See if previous calls are compatible.
+ (let ((calls (assq (nth 1 form) byte-compile-unresolved-functions))
+ nums sig min max)
+ (if calls
+ (progn
+ (setq sig (byte-compile-arglist-signature (nth 2 form))
+ nums (sort (copy-sequence (cdr calls)) (function <))
+ min (car nums)
+ max (car (nreverse nums)))
+ (if (or (< min (car sig))
+ (and (cdr sig) (> max (cdr sig))))
+ (byte-compile-warn
+ "%s being defined to take %s%s, but was previously called with %s"
+ (nth 1 form)
+ (byte-compile-arglist-signature-string sig)
+ (if (equal sig '(1 . 1)) " arg" " args")
+ (byte-compile-arglist-signature-string (cons min max))))
+
+ (setq byte-compile-unresolved-functions
+ (delq calls byte-compile-unresolved-functions)))))
+ )))
+
+;; If we have compiled any calls to functions which are not known to be
+;; defined, issue a warning enumerating them.
+;; `unresolved' in the list `byte-compile-warnings' disables this.
+(defun byte-compile-warn-about-unresolved-functions (&optional msg)
+ (if (memq 'unresolved byte-compile-warnings)
+ (let ((byte-compile-current-form (or msg "the end of the data")))
+ ;; First delete the autoloads from the list.
+ (if byte-compile-autoload-environment
+ (let ((rest byte-compile-unresolved-functions))
+ (while rest
+ (if (assq (car (car rest)) byte-compile-autoload-environment)
+ (setq byte-compile-unresolved-functions
+ (delq (car rest) byte-compile-unresolved-functions)))
+ (setq rest (cdr rest)))))
+ ;; Now warn.
+ (if (cdr byte-compile-unresolved-functions)
+ (let* ((str "The following functions are not known to be defined: ")
+ (L (+ (length str) 5))
+ (rest (reverse byte-compile-unresolved-functions))
+ s)
+ (while rest
+ (setq s (symbol-name (car (car rest)))
+ L (+ L (length s) 2)
+ rest (cdr rest))
+ (if (<= L (1- fill-column))
+ (setq str (concat str " " s (and rest ",")))
+ (setq str (concat str "\n " s (and rest ","))
+ L (+ (length s) 4))))
+ (byte-compile-warn "%s" str))
+ (if byte-compile-unresolved-functions
+ (byte-compile-warn "the function %s is not known to be defined."
+ (car (car byte-compile-unresolved-functions)))))))
+ nil)
+
+(defun byte-compile-defvar-p (var)
+ ;; Whether the byte compiler thinks that nonexical references to this
+ ;; variable are ok.
+ (or (globally-boundp var)
+ (let ((rest byte-compile-bound-variables))
+ (while (and rest var)
+ (if (and (eq var (car-safe (car rest)))
+ (not (= 0 (logand (cdr (car rest))
+ byte-compile-global-bit))))
+ (setq var nil))
+ (setq rest (cdr rest)))
+ ;; if var is nil at this point, it's a defvar in this file.
+ (not var))))
+
+
+;;; If we have compiled bindings of variables which have no referents, warn.
+(defun byte-compile-warn-about-unused-variables ()
+ (let ((rest byte-compile-bound-variables)
+ (unreferenced '())
+ cell)
+ (while (and rest
+ ;; only warn about variables whose lifetime is now ending,
+ ;; that is, variables from the lexical scope that is now
+ ;; terminating. (Think nested lets.)
+ (not (eq (car rest) 'new-scope)))
+ (setq cell (car rest))
+ (if (and (= 0 (logand byte-compile-referenced-bit (cdr cell)))
+ ;; Don't warn about declared-but-unused arguments,
+ ;; for two reasons: first, the arglist structure
+ ;; might be imposed by external forces, and we don't
+ ;; have (declare (ignore x)) yet; and second, inline
+ ;; expansion produces forms like
+ ;; ((lambda (arg) (byte-code "..." [arg])) x)
+ ;; which we can't (ok, well, don't) recognise as
+ ;; containing a reference to arg, so every inline
+ ;; expansion would generate a warning. (If we had
+ ;; `ignore' then inline expansion could emit an
+ ;; ignore declaration.)
+ (= 0 (logand byte-compile-arglist-bit (cdr cell)))
+ ;; Don't warn about defvars because this is a
+ ;; legitimate special binding.
+ (not (byte-compile-defvar-p (car cell))))
+ (setq unreferenced (cons (car cell) unreferenced)))
+ (setq rest (cdr rest)))
+ (setq unreferenced (nreverse unreferenced))
+ (while unreferenced
+ (byte-compile-warn
+ (format "variable %s bound but not referenced" (car unreferenced)))
+ (setq unreferenced (cdr unreferenced)))))
+
+\f
+(defmacro byte-compile-constp (form)
+ ;; Returns non-nil if FORM is a constant.
+ (` (cond ((consp (, form)) (eq (car (, form)) 'quote))
+ ((not (symbolp (, form))))
+ ((keywordp (, form)))
+ ((memq (, form) '(nil t))))))
+
+(defmacro byte-compile-close-variables (&rest body)
+ `(let
+ (;;
+ ;; Close over these variables to encapsulate the
+ ;; compilation state
+ ;;
+ (byte-compile-macro-environment
+ ;; Copy it because the compiler may patch into the
+ ;; macroenvironment.
+ (copy-alist byte-compile-initial-macro-environment))
+ (byte-compile-function-environment nil)
+ (byte-compile-autoload-environment nil)
+ (byte-compile-unresolved-functions nil)
+ (byte-compile-bound-variables nil)
+ (byte-compile-free-references nil)
+ (byte-compile-free-assignments nil)
+ ;;
+ ;; Close over these variables so that `byte-compiler-options'
+ ;; can change them on a per-file basis.
+ ;;
+ (byte-compile-verbose byte-compile-verbose)
+ (byte-optimize byte-optimize)
+ (byte-compile-emacs19-compatibility
+ byte-compile-emacs19-compatibility)
+ (byte-compile-dynamic byte-compile-dynamic)
+ (byte-compile-dynamic-docstrings
+ byte-compile-dynamic-docstrings)
+ (byte-compile-warnings (if (eq byte-compile-warnings t)
+ byte-compile-default-warnings
+ byte-compile-warnings))
+ (byte-compile-file-domain nil)
+ )
+ (prog1
+ (progn ,@body)
+ (if (memq 'unused-vars byte-compile-warnings)
+ ;; done compiling in this scope, warn now.
+ (byte-compile-warn-about-unused-variables)))))
+
+
+(defvar byte-compile-warnings-point-max nil)
+(defmacro displaying-byte-compile-warnings (&rest body)
+ `(let ((byte-compile-warnings-point-max byte-compile-warnings-point-max))
+ ;; Log the file name.
+ (byte-compile-log-file)
+ ;; Record how much is logged now.
+ ;; We will display the log buffer if anything more is logged
+ ;; before the end of BODY.
+ (or byte-compile-warnings-point-max
+ (save-excursion
+ (set-buffer (get-buffer-create "*Compile-Log*"))
+ (setq byte-compile-warnings-point-max (point-max))))
+ (unwind-protect
+ (condition-case error-info
+ (progn ,@body)
+ (error
+ (byte-compile-report-error error-info)))
+ (save-excursion
+ ;; If there were compilation warnings, display them.
+ (set-buffer "*Compile-Log*")
+ (if (= byte-compile-warnings-point-max (point-max))
+ nil
+ (if temp-buffer-show-function
+ (let ((show-buffer (get-buffer-create "*Compile-Log-Show*")))
+ (save-excursion
+ (set-buffer show-buffer)
+ (setq buffer-read-only nil)
+ (erase-buffer))
+ (copy-to-buffer show-buffer
+ (save-excursion
+ (goto-char byte-compile-warnings-point-max)
+ (forward-line -1)
+ (point))
+ (point-max))
+ (funcall temp-buffer-show-function show-buffer))
+ (select-window
+ (prog1 (selected-window)
+ (select-window (display-buffer (current-buffer)))
+ (goto-char byte-compile-warnings-point-max)
+ (recenter 1)))))))))
+
+\f
+;;;###autoload
+(defun byte-force-recompile (directory)
+ "Recompile every `.el' file in DIRECTORY that already has a `.elc' file.
+Files in subdirectories of DIRECTORY are processed also."
+ (interactive "DByte force recompile (directory): ")
+ (byte-recompile-directory directory nil t))
+
+;;;###autoload
+(defun byte-recompile-directory (directory &optional arg norecursion force)
+ "Recompile every `.el' file in DIRECTORY that needs recompilation.
+This is if a `.elc' file exists but is older than the `.el' file.
+Files in subdirectories of DIRECTORY are processed also unless argument
+NORECURSION is non-nil.
+
+If the `.elc' file does not exist, normally the `.el' file is *not* compiled.
+But a prefix argument (optional second arg) means ask user,
+for each such `.el' file, whether to compile it. Prefix argument 0 means
+don't ask and compile the file anyway.
+
+A nonzero prefix argument also means ask about each subdirectory.
+
+If the fourth argument FORCE is non-nil,
+recompile every `.el' file that already has a `.elc' file."
+ (interactive "DByte recompile directory: \nP")
+ (if arg
+ (setq arg (prefix-numeric-value arg)))
+ (if noninteractive
+ nil
+ (save-some-buffers)
+ (redraw-modeline))
+ (let ((directories (list (expand-file-name directory)))
+ (file-count 0)
+ (dir-count 0)
+ last-dir)
+ (displaying-byte-compile-warnings
+ (while directories
+ (setq directory (file-name-as-directory (car directories)))
+ (or noninteractive (message "Checking %s..." directory))
+ (let ((files (directory-files directory))
+ source dest)
+ (while files
+ (setq source (expand-file-name (car files) directory))
+ (if (and (not (member (car files) '("." ".." "RCS" "CVS" "SCCS")))
+ ;; Stay away from directory back-links, etc:
+ (not (file-symlink-p source))
+ (file-directory-p source)
+ byte-recompile-directory-recursively)
+ ;; This file is a subdirectory. Handle them differently.
+ (if (or (null arg)
+ (eq arg 0)
+ (y-or-n-p (concat "Check " source "? ")))
+ (setq directories
+ (nconc directories (list source))))
+ ;; It is an ordinary file. Decide whether to compile it.
+ (if (and (string-match emacs-lisp-file-regexp source)
+ (not (auto-save-file-name-p source))
+ (setq dest (byte-compile-dest-file source))
+ (if (file-exists-p dest)
+ ;; File was already compiled.
+ (or force (file-newer-than-file-p source dest))
+ ;; No compiled file exists yet.
+ (and arg
+ (or (eq 0 arg)
+ (y-or-n-p (concat "Compile " source "? "))))))
+ (progn ;(if (and noninteractive (not byte-compile-verbose))
+ ; (message "Compiling %s..." source))
+ ; we do this in byte-compile-file.
+ (if byte-recompile-directory-ignore-errors-p
+ (batch-byte-compile-1 source)
+ (byte-compile-file source))
+ (or noninteractive
+ (message "Checking %s..." directory))
+ (setq file-count (1+ file-count))
+ (if (not (eq last-dir directory))
+ (setq last-dir directory
+ dir-count (1+ dir-count)))
+ )))
+ (setq files (cdr files))))
+ (setq directories (cdr directories))))
+ (message "Done (Total of %d file%s compiled%s)"
+ file-count (if (= file-count 1) "" "s")
+ (if (> dir-count 1) (format " in %d directories" dir-count) ""))))
+
+;;;###autoload
+(defun byte-recompile-file (filename &optional force)
+ "Recompile a file of Lisp code named FILENAME if it needs recompilation.
+This is if the `.elc' file exists but is older than the `.el' file.
+
+If the `.elc' file does not exist, normally the `.el' file is *not*
+compiled. But a prefix argument (optional second arg) means ask user
+whether to compile it. Prefix argument 0 don't ask and recompile anyway."
+ (interactive "fByte recompile file: \nP")
+ (let ((dest))
+ (if (and (string-match emacs-lisp-file-regexp filename)
+ (not (auto-save-file-name-p filename))
+ (setq dest (byte-compile-dest-file filename))
+ (if (file-exists-p dest)
+ (file-newer-than-file-p filename dest)
+ (and force
+ (or (eq 0 force)
+ (y-or-n-p (concat "Compile " filename "? "))))))
+ (byte-compile-file filename))))
+
+(defvar kanji-flag nil)
+
+;;;###autoload
+(defun byte-compile-file (filename &optional load)
+ "Compile a file of Lisp code named FILENAME into a file of byte code.
+The output file's name is made by appending `c' to the end of FILENAME.
+With prefix arg (noninteractively: 2nd arg), load the file after compiling."
+;; (interactive "fByte compile file: \nP")
+ (interactive
+ (let ((file buffer-file-name)
+ (file-name nil)
+ (file-dir nil))
+ (and file
+ (eq (cdr (assq 'major-mode (buffer-local-variables)))
+ 'emacs-lisp-mode)
+ (setq file-name (file-name-nondirectory file)
+ file-dir (file-name-directory file)))
+ (list (read-file-name (if current-prefix-arg
+ "Byte compile and load file: "
+ "Byte compile file: ")
+ file-dir nil nil file-name)
+ current-prefix-arg)))
+ ;; Expand now so we get the current buffer's defaults
+ (setq filename (expand-file-name filename))
+
+ ;; If we're compiling a file that's in a buffer and is modified, offer
+ ;; to save it first.
+ (or noninteractive
+ (let ((b (get-file-buffer (expand-file-name filename))))
+ (if (and b (buffer-modified-p b)
+ (y-or-n-p (format "save buffer %s first? " (buffer-name b))))
+ (save-excursion (set-buffer b) (save-buffer)))))
+
+ (if (or noninteractive byte-compile-verbose) ; XEmacs change
+ (message "Compiling %s..." filename))
+ (let (;;(byte-compile-current-file (file-name-nondirectory filename))
+ (byte-compile-current-file filename)
+ (debug-issue-ebola-notices 0) ; Hack -slb
+ target-file input-buffer output-buffer
+ byte-compile-dest-file)
+ (setq target-file (byte-compile-dest-file filename))
+ (setq byte-compile-dest-file target-file)
+ (save-excursion
+ (setq input-buffer (get-buffer-create " *Compiler Input*"))
+ (set-buffer input-buffer)
+ (erase-buffer)
+ (insert-file-contents filename)
+ ;; Run hooks including the uncompression hook.
+ ;; If they change the file name, then change it for the output also.
+ (let ((buffer-file-name filename)
+ (default-major-mode 'emacs-lisp-mode)
+ (enable-local-eval nil))
+ (normal-mode)
+ (setq filename buffer-file-name)))
+ (setq byte-compiler-error-flag nil)
+ ;; It is important that input-buffer not be current at this call,
+ ;; so that the value of point set in input-buffer
+ ;; within byte-compile-from-buffer lingers in that buffer.
+ (setq output-buffer (byte-compile-from-buffer input-buffer filename))
+ (if byte-compiler-error-flag
+ nil
+ (if byte-compile-verbose
+ (message "Compiling %s...done" filename))
+ (kill-buffer input-buffer)
+ (save-excursion
+ (set-buffer output-buffer)
+ (goto-char (point-max))
+ (insert "\n") ; aaah, unix.
+ (let ((vms-stmlf-recfm t))
+ (setq target-file (byte-compile-dest-file filename))
+ (or byte-compile-overwrite-file
+ (condition-case ()
+ (delete-file target-file)
+ (error nil)))
+ (if (file-writable-p target-file)
+ (let ((kanji-flag nil)) ; for nemacs, from Nakagawa Takayuki
+ (if (or (eq system-type 'ms-dos) (eq system-type 'windows-nt))
+ (setq buffer-file-type t))
+ (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"
+ (if (file-exists-p target-file)
+ "cannot overwrite file"
+ "directory not writable or nonexistent")
+ target-file)))
+ (or byte-compile-overwrite-file
+ (condition-case ()
+ (set-file-modes target-file (file-modes filename))
+ (error nil))))
+ (kill-buffer (current-buffer)))
+ (if (and byte-compile-generate-call-tree
+ (or (eq t byte-compile-generate-call-tree)
+ (y-or-n-p (format "Report call tree for %s? " filename))))
+ (save-excursion
+ (display-call-tree filename)))
+ (if load
+ (load target-file))
+ t)))
+
+;; RMS comments the next two out.
+
+;;;###autoload
+(defun byte-compile-and-load-file (&optional filename)
+ "Compile a file of Lisp code named FILENAME into a file of byte code,
+and then load it. The output file's name is made by appending \"c\" to
+the end of FILENAME."
+ (interactive)
+ (if filename ; I don't get it, (interactive-p) doesn't always work
+ (byte-compile-file filename t)
+ (let ((current-prefix-arg '(4)))
+ (call-interactively 'byte-compile-file))))
+
+;;;###autoload
+(defun byte-compile-buffer (&optional buffer)
+ "Byte-compile and evaluate contents of BUFFER (default: the current buffer)."
+ (interactive "bByte compile buffer: ")
+ (setq buffer (if buffer (get-buffer buffer) (current-buffer)))
+ (message "Compiling %s..." buffer)
+ (let* ((filename (or (buffer-file-name buffer)
+ (prin1-to-string buffer)))
+ (byte-compile-current-file buffer))
+ (byte-compile-from-buffer buffer filename t))
+ (message "Compiling %s...done" buffer)
+ t)
+
+;;; compiling a single function
+;;;###autoload
+(defun compile-defun (&optional arg)
+ "Compile and evaluate the current top-level form.
+Print the result in the minibuffer.
+With argument, insert value in current buffer after the form."
+ (interactive "P")
+ (save-excursion
+ (end-of-defun)
+ (beginning-of-defun)
+ (let* ((byte-compile-current-file (buffer-file-name))
+ (load-file-name (buffer-file-name))
+ (byte-compile-last-warned-form 'nothing)
+ (value (eval (displaying-byte-compile-warnings
+ (byte-compile-sexp (read (current-buffer))
+ "toplevel forms")))))
+ (cond (arg
+ (message "Compiling from buffer... done.")
+ (prin1 value (current-buffer))
+ (insert "\n"))
+ ((message "%s" (prin1-to-string value)))))))
+
+(defvar byte-compile-inbuffer)
+(defvar byte-compile-outbuffer)
+
+(defun byte-compile-from-buffer (byte-compile-inbuffer filename &optional eval)
+ ;; buffer --> output-buffer, or buffer --> eval form, return nil
+ (let (byte-compile-outbuffer
+ ;; Prevent truncation of flonums and lists as we read and print them
+ (float-output-format nil)
+ (case-fold-search nil)
+ (print-length nil)
+ (print-level nil)
+ ;; Simulate entry to byte-compile-top-level
+ (byte-compile-constants nil)
+ (byte-compile-variables nil)
+ (byte-compile-tag-number 0)
+ (byte-compile-depth 0)
+ (byte-compile-maxdepth 0)
+ (byte-compile-output nil)
+ ;; #### This is bound in b-c-close-variables.
+ ;; (byte-compile-warnings (if (eq byte-compile-warnings t)
+ ;; byte-compile-warning-types
+ ;; byte-compile-warnings))
+ )
+ (byte-compile-close-variables
+ (save-excursion
+ (setq byte-compile-outbuffer
+ (set-buffer (get-buffer-create " *Compiler Output*")))
+ (erase-buffer)
+ ;; (emacs-lisp-mode)
+ (setq case-fold-search nil)
+ (and filename
+ (not eval)
+ (byte-compile-insert-header filename
+ byte-compile-inbuffer
+ byte-compile-outbuffer))
+
+ ;; This is a kludge. Some operating systems (OS/2, DOS) need to
+ ;; write files containing binary information specially.
+ ;; Under most circumstances, such files will be in binary
+ ;; overwrite mode, so those OS's use that flag to guess how
+ ;; they should write their data. Advise them that .elc files
+ ;; need to be written carefully.
+ (setq overwrite-mode 'overwrite-mode-binary))
+ (displaying-byte-compile-warnings
+ (save-excursion
+ (set-buffer byte-compile-inbuffer)
+ (goto-char 1)
+
+ ;; Compile the forms from the input buffer.
+ (while (progn
+ (while (progn (skip-chars-forward " \t\n\^l")
+ (looking-at ";"))
+ (forward-line 1))
+ (not (eobp)))
+ (byte-compile-file-form (read byte-compile-inbuffer)))
+
+ ;; Compile pending forms at end of file.
+ (byte-compile-flush-pending)
+ (byte-compile-warn-about-unresolved-functions)
+ ;; Should we always do this? When calling multiple files, it
+ ;; would be useful to delay this warning until all have
+ ;; been compiled.
+ (setq byte-compile-unresolved-functions nil)))
+ (save-excursion
+ (set-buffer byte-compile-outbuffer)
+ (goto-char (point-min))))
+ (if (not eval)
+ byte-compile-outbuffer
+ (let (form)
+ (while (condition-case nil
+ (progn (setq form (read byte-compile-outbuffer))
+ t)
+ (end-of-file nil))
+ (eval form)))
+ (kill-buffer byte-compile-outbuffer)
+ nil)))
+
+(defun byte-compile-insert-header (filename byte-compile-inbuffer
+ byte-compile-outbuffer)
+ (set-buffer byte-compile-inbuffer)
+ (let ((dynamic-docstrings byte-compile-dynamic-docstrings))
+ (set-buffer byte-compile-outbuffer)
+ (goto-char 1)
+ ;;
+ ;; The magic number of .elc files is ";ELC", or 0x3B454C43. After that is
+ ;; the file-format version number (19 or 20) as a byte, followed by some
+ ;; nulls. The primary motivation for doing this is to get some binary
+ ;; characters up in the first line of the file so that `diff' will simply
+ ;; say "Binary files differ" instead of actually doing a diff of two .elc
+ ;; files. An extra benefit is that you can add this to /etc/magic:
+ ;;
+ ;; 0 string ;ELC GNU Emacs Lisp compiled file,
+ ;; >4 byte x version %d
+ ;;
+ (insert
+ ";ELC"
+ (if (byte-compile-version-cond byte-compile-emacs19-compatibility) 19 20)
+ "\000\000\000\n"
+ )
+ (insert ";;; compiled by "
+ (or (and (boundp 'user-mail-address) user-mail-address)
+ (concat (user-login-name) "@" (system-name)))
+ " on "
+ (current-time-string) "\n;;; from file " filename "\n")
+ (insert ";;; emacs version " emacs-version ".\n")
+ (insert ";;; bytecomp version " byte-compile-version "\n;;; "
+ (cond
+ ((eq byte-optimize 'source) "source-level optimization only")
+ ((eq byte-optimize 'byte) "byte-level optimization only")
+ (byte-optimize "optimization is on")
+ (t "optimization is off"))
+ (if (byte-compile-version-cond byte-compile-emacs19-compatibility)
+ "; compiled with Emacs 19 compatibility.\n"
+ ".\n"))
+ (if (not (byte-compile-version-cond byte-compile-emacs19-compatibility))
+ (insert ";;; this file uses opcodes which do not exist in Emacs 19.\n"
+ ;; Have to check if emacs-version is bound so that this works
+ ;; in files loaded early in loadup.el.
+ "\n(if (and (boundp 'emacs-version)\n"
+ "\t (or (and (boundp 'epoch::version) epoch::version)\n"
+ "\t (string-lessp emacs-version \"20\")))\n"
+ " (error \"`"
+ ;; prin1-to-string is used to quote backslashes.
+ (substring (prin1-to-string (file-name-nondirectory filename))
+ 1 -1)
+ "' was compiled for Emacs 20\"))\n\n"))
+ (insert "(or (boundp 'current-load-list) (setq current-load-list nil))\n"
+ "\n")
+ (if (and (byte-compile-version-cond byte-compile-emacs19-compatibility)
+ dynamic-docstrings)
+ (insert ";;; this file uses opcodes which do not exist prior to\n"
+ ";;; XEmacs 19.14/GNU Emacs 19.29 or later."
+ ;; Have to check if emacs-version is bound so that this works
+ ;; in files loaded early in loadup.el.
+ "\n(if (and (boundp 'emacs-version)\n"
+ "\t (or (and (boundp 'epoch::version) epoch::version)\n"
+ "\t (and (not (string-match \"XEmacs\" emacs-version))\n"
+ "\t (string-lessp emacs-version \"19.29\"))\n"
+ "\t (string-lessp emacs-version \"19.14\")))\n"
+ " (error \"`"
+ ;; prin1-to-string is used to quote backslashes.
+ (substring (prin1-to-string (file-name-nondirectory filename))
+ 1 -1)
+ "' was compiled for XEmacs 19.14/Emacs 19.29 or later\"))\n\n"
+ )
+ ))
+
+ ;; back in the inbuffer; determine and set the coding system for the .elc
+ ;; 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
+ ;; Emacsen.
+ (if (featurep 'mule)
+ (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)
+ (insert "(require 'mule)\n;;;###coding system: escape-quoted\n")
+ (setq buffer-file-coding-system 'escape-quoted)
+ ;; Lazy loading not yet implemented for MULE files
+ ;; mrb - Fix this someday.
+ (save-excursion
+ (set-buffer byte-compile-inbuffer)
+ (setq byte-compile-dynamic nil
+ byte-compile-dynamic-docstrings nil))
+ ;;(external-debugging-output (prin1-to-string (buffer-local-variables))))
+ ))
+ )
+
+
+(defun byte-compile-output-file-form (form)
+ ;; writes the given form to the output buffer, being careful of docstrings
+ ;; in defun, defmacro, defvar, defconst and autoload because make-docfile is
+ ;; so amazingly stupid.
+ ;; defalias calls are output directly by byte-compile-file-form-defmumble;
+ ;; it does not pay to first build the defalias in defmumble and then parse
+ ;; it here.
+ (if (and (memq (car-safe form) '(defun defmacro defvar defconst autoload))
+ (stringp (nth 3 form)))
+ (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil
+ (eq (car form) 'autoload))
+ (let ((print-escape-newlines t)
+ (print-length nil)
+ (print-level nil)
+ (print-readably t) ; print #[] for bytecode, 'x for (quote x)
+ (print-gensym (if (and byte-compile-print-gensym
+ (not byte-compile-emacs19-compatibility))
+ t nil)))
+ (princ "\n" byte-compile-outbuffer)
+ (prin1 form byte-compile-outbuffer)
+ nil)))
+
+(defun byte-compile-output-docform (preface name info form specindex quoted)
+ "Print a form with a doc string. INFO is (prefix doc-index postfix).
+If PREFACE and NAME are non-nil, print them too,
+before INFO and the FORM but after the doc string itself.
+If SPECINDEX is non-nil, it is the index in FORM
+of the function bytecode string. In that case,
+we output that argument and the following argument (the constants vector)
+together, for lazy loading.
+QUOTED says that we have to put a quote before the
+list that represents a doc string reference.
+`autoload' needs that."
+ ;; We need to examine byte-compile-dynamic-docstrings
+ ;; in the input buffer (now current), not in the output buffer.
+ (let ((dynamic-docstrings byte-compile-dynamic-docstrings))
+ (set-buffer
+ (prog1 (current-buffer)
+ (set-buffer byte-compile-outbuffer)
+ (let (position)
+
+ ;; Insert the doc string, and make it a comment with #@LENGTH.
+ (and (>= (nth 1 info) 0)
+ dynamic-docstrings
+ (progn
+ ;; Make the doc string start at beginning of line
+ ;; for make-docfile's sake.
+ (insert "\n")
+ (setq position
+ (byte-compile-output-as-comment
+ (nth (nth 1 info) form) nil))
+ ;; If the doc string starts with * (a user variable),
+ ;; negate POSITION.
+ (if (and (stringp (nth (nth 1 info) form))
+ (> (length (nth (nth 1 info) form)) 0)
+ (char= (aref (nth (nth 1 info) form) 0) ?*))
+ (setq position (- position)))))
+
+ (if preface
+ (progn
+ (insert preface)
+ (prin1 name byte-compile-outbuffer)))
+ (insert (car info))
+ (let ((print-escape-newlines t)
+ (print-readably t) ; print #[] for bytecode, 'x for (quote x)
+ ;; Use a cons cell to say that we want
+ ;; print-gensym-alist not to be cleared between calls
+ ;; to print functions.
+ (print-gensym (if (and byte-compile-print-gensym
+ (not byte-compile-emacs19-compatibility))
+ '(t) nil))
+ print-gensym-alist
+ (index 0))
+ (prin1 (car form) byte-compile-outbuffer)
+ (while (setq form (cdr form))
+ (setq index (1+ index))
+ (insert " ")
+ (cond ((and (numberp specindex) (= index specindex))
+ (let ((position
+ (byte-compile-output-as-comment
+ (cons (car form) (nth 1 form))
+ t)))
+ (princ (format "(#$ . %d) nil" position)
+ byte-compile-outbuffer)
+ (setq form (cdr form))
+ (setq index (1+ index))))
+ ((= index (nth 1 info))
+ (if position
+ (princ (format (if quoted "'(#$ . %d)" "(#$ . %d)")
+ position)
+ byte-compile-outbuffer)
+ (let ((print-escape-newlines nil))
+ (goto-char (prog1 (1+ (point))
+ (prin1 (car form)
+ byte-compile-outbuffer)))
+ (insert "\\\n")
+ (goto-char (point-max)))))
+ (t
+ (prin1 (car form) byte-compile-outbuffer)))))
+ (insert (nth 2 info))))))
+ nil)
+
+(defvar for-effect) ; ## Kludge! This should be an arg, not a special.
+
+(defun byte-compile-keep-pending (form &optional handler)
+ (if (memq byte-optimize '(t source))
+ (setq form (byte-optimize-form form t)))
+ (if handler
+ (let ((for-effect t))
+ ;; To avoid consing up monstrously large forms at load time, we split
+ ;; the output regularly.
+ (and (memq (car-safe form) '(fset defalias define-function))
+ (nthcdr 300 byte-compile-output)
+ (byte-compile-flush-pending))
+ (funcall handler form)
+ (if for-effect
+ (byte-compile-discard)))
+ (byte-compile-form form t))
+ nil)
+
+(defun byte-compile-flush-pending ()
+ (if byte-compile-output
+ (let ((form (byte-compile-out-toplevel t 'file)))
+ (cond ((eq (car-safe form) 'progn)
+ (mapcar 'byte-compile-output-file-form (cdr form)))
+ (form
+ (byte-compile-output-file-form form)))
+ (setq byte-compile-constants nil
+ byte-compile-variables nil
+ byte-compile-depth 0
+ byte-compile-maxdepth 0
+ byte-compile-output nil))))
+
+(defun byte-compile-file-form (form)
+ (let ((byte-compile-current-form nil) ; close over this for warnings.
+ handler)
+ (cond
+ ((not (consp form))
+ (byte-compile-keep-pending form))
+ ((and (symbolp (car form))
+ (setq handler (get (car form) 'byte-hunk-handler)))
+ (cond ((setq form (funcall handler form))
+ (byte-compile-flush-pending)
+ (byte-compile-output-file-form form))))
+ ((eq form (setq form (macroexpand form byte-compile-macro-environment)))
+ (byte-compile-keep-pending form))
+ (t
+ (byte-compile-file-form form)))))
+
+;; Functions and variables with doc strings must be output separately,
+;; so make-docfile can recognise them. Most other things can be output
+;; as byte-code.
+
+(put 'defsubst 'byte-hunk-handler 'byte-compile-file-form-defsubst)
+(defun byte-compile-file-form-defsubst (form)
+ (cond ((assq (nth 1 form) byte-compile-unresolved-functions)
+ (setq byte-compile-current-form (nth 1 form))
+ (byte-compile-warn "defsubst %s was used before it was defined"
+ (nth 1 form))))
+ (byte-compile-file-form
+ (macroexpand form byte-compile-macro-environment))
+ ;; Return nil so the form is not output twice.
+ nil)
+
+(put 'autoload 'byte-hunk-handler 'byte-compile-file-form-autoload)
+(defun byte-compile-file-form-autoload (form)
+ ;;
+ ;; If this is an autoload of a macro, and all arguments are constants (that
+ ;; is, there is no hairy computation going on here) then evaluate the form
+ ;; at compile-time. This is so that we can make use of macros which we
+ ;; have autoloaded from the file being compiled. Normal function autoloads
+ ;; are not automatically evaluated at compile time, because there's not
+ ;; much point to it (so why bother cluttering up the compile-time namespace.)
+ ;;
+ ;; If this is an autoload of a function, then record its definition in the
+ ;; byte-compile-autoload-environment to suppress any `not known to be
+ ;; defined' warnings at the end of this file (this only matters for
+ ;; functions which are autoloaded and compiled in the same file, if the
+ ;; autoload already exists in the compilation environment, we wouldn't have
+ ;; warned anyway.)
+ ;;
+ (let* ((name (if (byte-compile-constp (nth 1 form))
+ (eval (nth 1 form))))
+ ;; In v19, the 5th arg to autoload can be t, nil, 'macro, or 'keymap.
+ (macrop (and (byte-compile-constp (nth 5 form))
+ (memq (eval (nth 5 form)) '(t macro))))
+;; (functionp (and (byte-compile-constp (nth 5 form))
+;; (eq 'nil (eval (nth 5 form)))))
+ )
+ (if (and macrop
+ (let ((form form))
+ ;; all forms are constant
+ (while (if (setq form (cdr form))
+ (byte-compile-constp (car form))))
+ (null form)))
+ ;; eval the macro autoload into the compilation enviroment
+ (eval form))
+
+ (if name
+ (let ((old (assq name byte-compile-autoload-environment)))
+ (cond (old
+ (if (memq 'redefine byte-compile-warnings)
+ (byte-compile-warn "multiple autoloads for %s" name))
+ (setcdr old form))
+ (t
+ ;; We only use the names in the autoload environment, but
+ ;; it might be useful to have the bodies some day.
+ (setq byte-compile-autoload-environment
+ (cons (cons name form)
+ byte-compile-autoload-environment)))))))
+ ;;
+ ;; Now output the form.
+ (if (stringp (nth 3 form))
+ form
+ ;; No doc string, so we can compile this as a normal form.
+ (byte-compile-keep-pending form 'byte-compile-normal-call)))
+
+(put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar)
+(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar)
+(defun byte-compile-file-form-defvar (form)
+ (if (> (length form) 4)
+ (byte-compile-warn "%s used with too many args (%s)"
+ (car form) (nth 1 form)))
+ (if (and (> (length form) 3) (not (stringp (nth 3 form))))
+ (byte-compile-warn "Third arg to %s %s is not a string: %s"
+ (car form) (nth 1 form) (nth 3 form)))
+ (if (null (nth 3 form))
+ ;; Since there is no doc string, we can compile this as a normal form,
+ ;; and not do a file-boundary.
+ (byte-compile-keep-pending form)
+ (if (memq 'free-vars byte-compile-warnings)
+ (setq byte-compile-bound-variables
+ (cons (cons (nth 1 form) byte-compile-global-bit)
+ byte-compile-bound-variables)))
+ (cond ((consp (nth 2 form))
+ (setq form (copy-sequence form))
+ (setcar (cdr (cdr form))
+ (byte-compile-top-level (nth 2 form) nil 'file))))
+
+ ;; The following turns out not to be necessary, since we emit a call to
+ ;; defvar, which can hack Vfile_domain by itself!
+ ;;
+ ;; If a file domain has been set, emit (put 'VAR 'variable-domain ...)
+ ;; after this defvar.
+; (if byte-compile-file-domain
+; (progn
+; ;; Actually, this will emit the (put ...) before the (defvar ...)
+; ;; but I don't think that can matter in this case.
+; (byte-compile-keep-pending
+; (list 'put (list 'quote (nth 1 form)) ''variable-domain
+; (list 'quote byte-compile-file-domain)))))
+ form))
+
+(put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary)
+(defun byte-compile-file-form-eval-boundary (form)
+ (eval form)
+ (byte-compile-keep-pending form 'byte-compile-normal-call))
+
+(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)
+(put 'prog1 'byte-hunk-handler 'byte-compile-file-form-progn)
+(put 'prog2 'byte-hunk-handler 'byte-compile-file-form-progn)
+(defun byte-compile-file-form-progn (form)
+ (mapcar 'byte-compile-file-form (cdr form))
+ ;; Return nil so the forms are not output twice.
+ nil)
+
+;; This handler is not necessary, but it makes the output from dont-compile
+;; and similar macros cleaner.
+(put 'eval 'byte-hunk-handler 'byte-compile-file-form-eval)
+(defun byte-compile-file-form-eval (form)
+ (if (eq (car-safe (nth 1 form)) 'quote)
+ (nth 1 (nth 1 form))
+ (byte-compile-keep-pending form)))
+
+(put 'defun 'byte-hunk-handler 'byte-compile-file-form-defun)
+(defun byte-compile-file-form-defun (form)
+ (byte-compile-file-form-defmumble form nil))
+
+(put 'defmacro 'byte-hunk-handler 'byte-compile-file-form-defmacro)
+(defun byte-compile-file-form-defmacro (form)
+ (byte-compile-file-form-defmumble form t))
+
+(defun byte-compile-compiled-obj-to-list (obj)
+ ;; #### this is fairly disgusting. Rewrite the code instead
+ ;; so that it doesn't create compiled objects in the first place!
+ ;; Much better than creating them and then "uncreating" them
+ ;; like this.
+ (read (concat "("
+ (substring (let ((print-readably t)
+ (print-gensym
+ (if (and byte-compile-print-gensym
+ (not byte-compile-emacs19-compatibility))
+ '(t) nil))
+ (print-gensym-alist nil))
+ (prin1-to-string obj))
+ 2 -1)
+ ")")))
+
+(defun byte-compile-file-form-defmumble (form macrop)
+ (let* ((name (car (cdr form)))
+ (this-kind (if macrop 'byte-compile-macro-environment
+ 'byte-compile-function-environment))
+ (that-kind (if macrop 'byte-compile-function-environment
+ 'byte-compile-macro-environment))
+ (this-one (assq name (symbol-value this-kind)))
+ (that-one (assq name (symbol-value that-kind)))
+ (byte-compile-free-references nil)
+ (byte-compile-free-assignments nil))
+
+ ;; When a function or macro is defined, add it to the call tree so that
+ ;; we can tell when functions are not used.
+ (if byte-compile-generate-call-tree
+ (or (assq name byte-compile-call-tree)
+ (setq byte-compile-call-tree
+ (cons (list name nil nil) byte-compile-call-tree))))
+
+ (setq byte-compile-current-form name) ; for warnings
+ (if (memq 'redefine byte-compile-warnings)
+ (byte-compile-arglist-warn form macrop))
+ (if byte-compile-verbose
+ (message "Compiling %s... (%s)"
+ ;; #### filename used free
+ (if filename (file-name-nondirectory filename) "")
+ (nth 1 form)))
+ (cond (that-one
+ (if (and (memq 'redefine byte-compile-warnings)
+ ;; hack hack: don't warn when compiling the stubs in
+ ;; bytecomp-runtime...
+ (not (assq (nth 1 form)
+ byte-compile-initial-macro-environment)))
+ (byte-compile-warn
+ "%s defined multiple times, as both function and macro"
+ (nth 1 form)))
+ (setcdr that-one nil))
+ (this-one
+ (if (and (memq 'redefine byte-compile-warnings)
+ ;; hack: don't warn when compiling the magic internal
+ ;; byte-compiler macros in bytecomp-runtime.el...
+ (not (assq (nth 1 form)
+ byte-compile-initial-macro-environment)))
+ (byte-compile-warn "%s %s defined multiple times in this file"
+ (if macrop "macro" "function")
+ (nth 1 form))))
+ ((and (fboundp name)
+ (or (subrp (symbol-function name))
+ (eq (car-safe (symbol-function name))
+ (if macrop 'lambda 'macro))))
+ (if (memq 'redefine byte-compile-warnings)
+ (byte-compile-warn "%s %s being redefined as a %s"
+ (if (subrp (symbol-function name))
+ "subr"
+ (if macrop "function" "macro"))
+ (nth 1 form)
+ (if macrop "macro" "function")))
+ ;; shadow existing definition
+ (set this-kind
+ (cons (cons name nil) (symbol-value this-kind))))
+ )
+ (let ((body (nthcdr 3 form)))
+ (if (and (stringp (car body))
+ (symbolp (car-safe (cdr-safe body)))
+ (car-safe (cdr-safe body))
+ (stringp (car-safe (cdr-safe (cdr-safe body)))))
+ (byte-compile-warn "Probable `\"' without `\\' in doc string of %s"
+ (nth 1 form))))
+ (let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form))))
+ (code (byte-compile-byte-code-maker new-one)))
+ (if this-one
+ (setcdr this-one new-one)
+ (set this-kind
+ (cons (cons name new-one) (symbol-value this-kind))))
+ (if (and (stringp (nth 3 form))
+ (eq 'quote (car-safe code))
+ (eq 'lambda (car-safe (nth 1 code))))
+ (cons (car form)
+ (cons name (cdr (nth 1 code))))
+ (byte-compile-flush-pending)
+ (if (not (stringp (nth 3 form)))
+ ;; No doc string. Provide -1 as the "doc string index"
+ ;; so that no element will be treated as a doc string.
+ (byte-compile-output-docform
+ "\n(defalias '"
+ name
+ (cond ((atom code)
+ (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]")))
+ ((eq (car code) 'quote)
+ (setq code new-one)
+ (if macrop '(" '(macro " -1 ")") '(" '(" -1 ")")))
+ ((if macrop '(" (cons 'macro (" -1 "))") '(" (" -1 ")"))))
+ ;; FSF just calls `(append code nil)' here but that relies
+ ;; on horrible C kludges in concat() that accept byte-
+ ;; compiled objects and pretend they're vectors.
+ (if (compiled-function-p code)
+ (byte-compile-compiled-obj-to-list code)
+ (append code nil))
+ (and (atom code) byte-compile-dynamic
+ 1)
+ nil)
+ ;; Output the form by hand, that's much simpler than having
+ ;; b-c-output-file-form analyze the defalias.
+ (byte-compile-output-docform
+ "\n(defalias '"
+ name
+ (cond ((atom code) ; compiled-function-p
+ (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]")))
+ ((eq (car code) 'quote)
+ (setq code new-one)
+ (if macrop '(" '(macro " 2 ")") '(" '(" 2 ")")))
+ ((if macrop '(" (cons 'macro (" 5 "))") '(" (" 5 ")"))))
+ ;; The result of byte-compile-byte-code-maker is either a
+ ;; compiled-function object, or a list of some kind. If it's
+ ;; not a cons, we must coerce it into a list of the elements
+ ;; to be printed to the file.
+ (if (consp code)
+ code
+ (nconc (list
+ (compiled-function-arglist code)
+ (compiled-function-instructions code)
+ (compiled-function-constants code)
+ (compiled-function-stack-depth code))
+ (let ((doc (documentation code t)))
+ (if doc (list doc)))
+ (if (commandp code)
+ (list (nth 1 (compiled-function-interactive code))))))
+ (and (atom code) byte-compile-dynamic
+ 1)
+ nil))
+ (princ ")" byte-compile-outbuffer)
+ nil))))
+
+;; Print Lisp object EXP in the output file, inside a comment,
+;; and return the file position it will have.
+;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting.
+(defun byte-compile-output-as-comment (exp quoted)
+ (let ((position (point)))
+ (set-buffer
+ (prog1 (current-buffer)
+ (set-buffer byte-compile-outbuffer)
+
+ ;; Insert EXP, and make it a comment with #@LENGTH.
+ (insert " ")
+ (if quoted
+ (prin1 exp byte-compile-outbuffer)
+ (princ exp byte-compile-outbuffer))
+ (goto-char position)
+ ;; Quote certain special characters as needed.
+ ;; get_doc_string in doc.c does the unquoting.
+ (while (search-forward "\^A" nil t)
+ (replace-match "\^A\^A" t t))
+ (goto-char position)
+ (while (search-forward "\000" nil t)
+ (replace-match "\^A0" t t))
+ (goto-char position)
+ (while (search-forward "\037" nil t)
+ (replace-match "\^A_" t t))
+ (goto-char (point-max))
+ (insert "\037")
+ (goto-char position)
+ (insert "#@" (format "%d" (- (point-max) position)))
+
+ ;; Save the file position of the object.
+ ;; Note we should add 1 to skip the space
+ ;; that we inserted before the actual doc string,
+ ;; and subtract 1 to convert from an 1-origin Emacs position
+ ;; to a file position; they cancel.
+ (setq position (point))
+ (goto-char (point-max))))
+ position))
+
+\f
+
+;; The `domain' declaration. This is legal only at top-level in a file, and
+;; should generally be the first form in the file. It is not legal inside
+;; function bodies.
+
+(put 'domain 'byte-hunk-handler 'byte-compile-file-form-domain)
+(defun byte-compile-file-form-domain (form)
+ (if (not (null (cdr (cdr form))))
+ (byte-compile-warn "domain used with too many arguments: %s" form))
+ (let ((domain (nth 1 form)))
+ (or (null domain)
+ (stringp domain)
+ (progn
+ (byte-compile-warn
+ "argument to `domain' declaration must be a literal string: %s"
+ form)
+ (setq domain nil)))
+ (setq byte-compile-file-domain domain))
+ (byte-compile-keep-pending form 'byte-compile-normal-call))
+
+(defun byte-compile-domain (form)
+ (byte-compile-warn "The `domain' declaration is legal only at top-level: %s"
+ (let ((print-escape-newlines t)
+ (print-level 4)
+ (print-length 4))
+ (prin1-to-string form)))
+ (byte-compile-normal-call
+ (list 'signal ''error
+ (list 'quote (list "`domain' used inside a function" form)))))
+
+;; This is part of bytecomp.el in 19.35:
+(put 'custom-declare-variable 'byte-hunk-handler
+ 'byte-compile-file-form-custom-declare-variable)
+(defun byte-compile-file-form-custom-declare-variable (form)
+ (if (memq 'free-vars byte-compile-warnings)
+ (setq byte-compile-bound-variables
+ (cons (cons (nth 1 (nth 1 form))
+ byte-compile-global-bit)
+ byte-compile-bound-variables)))
+ form)
+
+\f
+;;;###autoload
+(defun byte-compile (form)
+ "If FORM is a symbol, byte-compile its function definition.
+If FORM is a lambda or a macro, byte-compile it as a function."
+ (displaying-byte-compile-warnings
+ (byte-compile-close-variables
+ (let* ((fun (if (symbolp form)
+ (and (fboundp form) (symbol-function form))
+ form))
+ (macro (eq (car-safe fun) 'macro)))
+ (if macro
+ (setq fun (cdr fun)))
+ (cond ((eq (car-safe fun) 'lambda)
+ (setq fun (if macro
+ (cons 'macro (byte-compile-lambda fun))
+ (byte-compile-lambda fun)))
+ (if (symbolp form)
+ (defalias form fun)
+ fun)))))))
+
+;;;###autoload
+(defun byte-compile-sexp (sexp &optional msg)
+ "Compile and return SEXP."
+ (displaying-byte-compile-warnings
+ (byte-compile-close-variables
+ (prog1
+ (byte-compile-top-level sexp)
+ (byte-compile-warn-about-unresolved-functions msg)))))
+
+;; Given a function made by byte-compile-lambda, make a form which produces it.
+(defun byte-compile-byte-code-maker (fun)
+ (cond
+ ;; ## atom is faster than compiled-func-p.
+ ((atom fun) ; compiled-function-p
+ fun)
+ ;; b-c-lambda didn't produce a compiled-function, so it must be a trivial
+ ;; function.
+ ((let (tmp)
+ (if (and (setq tmp (assq 'byte-code (cdr-safe (cdr fun))))
+ (null (cdr (memq tmp fun))))
+ ;; Generate a make-byte-code call.
+ (let* ((interactive (assq 'interactive (cdr (cdr fun)))))
+ (nconc (list 'make-byte-code
+ (list 'quote (nth 1 fun)) ;arglist
+ (nth 1 tmp) ;bytes
+ (nth 2 tmp) ;consts
+ (nth 3 tmp)) ;depth
+ (cond ((stringp (nth 2 fun))
+ (list (nth 2 fun))) ;doc
+ (interactive
+ (list nil)))
+ (cond (interactive
+ (list (if (or (null (nth 1 interactive))
+ (stringp (nth 1 interactive)))
+ (nth 1 interactive)
+ ;; Interactive spec is a list or a variable
+ ;; (if it is correct).
+ (list 'quote (nth 1 interactive))))))))
+ ;; a non-compiled function (probably trivial)
+ (list 'quote fun))))))
+
+;; Byte-compile a lambda-expression and return a valid function.
+;; The value is usually a compiled function but may be the original
+;; lambda-expression.
+(defun byte-compile-lambda (fun)
+ (or (eq 'lambda (car-safe fun))
+ (error "not a lambda -- %s" (prin1-to-string fun)))
+ (let* ((arglist (nth 1 fun))
+ (byte-compile-bound-variables
+ (let ((new-bindings
+ (mapcar (function (lambda (x)
+ (cons x byte-compile-arglist-bit)))
+ (and (memq 'free-vars byte-compile-warnings)
+ (delq '&rest (delq '&optional
+ (copy-sequence arglist)))))))
+ (nconc new-bindings
+ (cons 'new-scope byte-compile-bound-variables))))
+ (body (cdr (cdr fun)))
+ (doc (if (stringp (car body))
+ (prog1 (car body)
+ (setq body (cdr body)))))
+ (int (assq 'interactive body)))
+ (let ((rest arglist))
+ (while rest
+ (cond ((not (symbolp (car rest)))
+ (byte-compile-warn "non-symbol in arglist: %s"
+ (prin1-to-string (car rest))))
+ ((memq (car rest) '(t nil))
+ (byte-compile-warn "constant in arglist: %s" (car rest)))
+ ((and (char= ?\& (aref (symbol-name (car rest)) 0))
+ (not (memq (car rest) '(&optional &rest))))
+ (byte-compile-warn "unrecognised `&' keyword in arglist: %s"
+ (car rest))))
+ (setq rest (cdr rest))))
+ (cond (int
+ ;; Skip (interactive) if it is in front (the most usual location).
+ (if (eq int (car body))
+ (setq body (cdr body)))
+ (cond ((consp (cdr int))
+ (if (cdr (cdr int))
+ (byte-compile-warn "malformed interactive spec: %s"
+ (prin1-to-string int)))
+ ;; If the interactive spec is a call to `list',
+ ;; don't compile it, because `call-interactively'
+ ;; looks at the args of `list'.
+ (let ((form (nth 1 int)))
+ (while (or (eq (car-safe form) 'let)
+ (eq (car-safe form) 'let*)
+ (eq (car-safe form) 'save-excursion))
+ (while (consp (cdr form))
+ (setq form (cdr form)))
+ (setq form (car form)))
+ (or (eq (car-safe form) 'list)
+ (setq int (list 'interactive
+ (byte-compile-top-level (nth 1 int)))))))
+ ((cdr int)
+ (byte-compile-warn "malformed interactive spec: %s"
+ (prin1-to-string int))))))
+ (let ((compiled (byte-compile-top-level (cons 'progn body) nil 'lambda)))
+ (if (memq 'unused-vars byte-compile-warnings)
+ ;; done compiling in this scope, warn now.
+ (byte-compile-warn-about-unused-variables))
+ (if (eq 'byte-code (car-safe compiled))
+ (apply 'make-byte-code
+ (append (list arglist)
+ ;; byte-string, constants-vector, stack depth
+ (cdr compiled)
+ ;; optionally, the doc string.
+ (if (or doc int)
+ (list doc))
+ ;; optionally, the interactive spec.
+ (if int
+ (list (nth 1 int)))))
+ (setq compiled
+ (nconc (if int (list int))
+ (cond ((eq (car-safe compiled) 'progn) (cdr compiled))
+ (compiled (list compiled)))))
+ (nconc (list 'lambda arglist)
+ (if (or doc (stringp (car compiled)))
+ (cons doc (cond (compiled)
+ (body (list nil))))
+ compiled))))))
+
+(defun byte-compile-constants-vector ()
+ ;; Builds the constants-vector from the current variables and constants.
+ ;; This modifies the constants from (const . nil) to (const . offset).
+ ;; To keep the byte-codes to look up the vector as short as possible:
+ ;; First 6 elements are vars, as there are one-byte varref codes for those.
+ ;; Next up to byte-constant-limit are constants, still with one-byte codes.
+ ;; Next variables again, to get 2-byte codes for variable lookup.
+ ;; The rest of the constants and variables need 3-byte byte-codes.
+ (let* ((i -1)
+ (rest (nreverse byte-compile-variables)) ; nreverse because the first
+ (other (nreverse byte-compile-constants)) ; vars often are used most.
+ ret tmp
+ (limits '(5 ; Use the 1-byte varref codes,
+ 63 ; 1-constlim ; 1-byte byte-constant codes,
+ 255 ; 2-byte varref codes,
+ 65535)) ; 3-byte codes for the rest.
+ limit)
+ (while (or rest other)
+ (setq limit (car limits))
+ (while (and rest (not (eq i limit)))
+ (if (setq tmp (assq (car (car rest)) ret))
+ (setcdr (car rest) (cdr tmp))
+ (setcdr (car rest) (setq i (1+ i)))
+ (setq ret (cons (car rest) ret)))
+ (setq rest (cdr rest)))
+ (setq limits (cdr limits)
+ rest (prog1 other
+ (setq other rest))))
+ (apply 'vector (nreverse (mapcar 'car ret)))))
+
+;; Given an expression FORM, compile it and return an equivalent byte-code
+;; expression (a call to the function byte-code).
+(defun byte-compile-top-level (form &optional for-effect output-type)
+ ;; OUTPUT-TYPE advises about how form is expected to be used:
+ ;; 'eval or nil -> a single form,
+ ;; 'progn or t -> a list of forms,
+ ;; 'lambda -> body of a lambda,
+ ;; 'file -> used at file-level.
+ (let ((byte-compile-constants nil)
+ (byte-compile-variables nil)
+ (byte-compile-tag-number 0)
+ (byte-compile-depth 0)
+ (byte-compile-maxdepth 0)
+ (byte-compile-output nil))
+ (if (memq byte-optimize '(t source))
+ (setq form (byte-optimize-form form for-effect)))
+ (while (and (eq (car-safe form) 'progn) (null (cdr (cdr form))))
+ (setq form (nth 1 form)))
+ (if (and (eq 'byte-code (car-safe form))
+ (not (memq byte-optimize '(t byte)))
+ (stringp (nth 1 form))
+ (vectorp (nth 2 form))
+ (natnump (nth 3 form)))
+ form
+ (byte-compile-form form for-effect)
+ (byte-compile-out-toplevel for-effect output-type))))
+
+(defun byte-compile-out-toplevel (&optional for-effect output-type)
+ (if for-effect
+ ;; The stack is empty. Push a value to be returned from (byte-code ..).
+ (if (eq (car (car byte-compile-output)) 'byte-discard)
+ (setq byte-compile-output (cdr byte-compile-output))
+ (byte-compile-push-constant
+ ;; Push any constant - preferably one which already is used, and
+ ;; a number or symbol - ie not some big sequence. The return value
+ ;; isn't returned, but it would be a shame if some textually large
+ ;; constant was not optimized away because we chose to return it.
+ (and (not (assq nil byte-compile-constants)) ; Nil is often there.
+ (let ((tmp (reverse byte-compile-constants)))
+ (while (and tmp (not (or (symbolp (car (car tmp)))
+ (numberp (car (car tmp))))))
+ (setq tmp (cdr tmp)))
+ (car (car tmp)))))))
+ (byte-compile-out 'byte-return 0)
+ (setq byte-compile-output (nreverse byte-compile-output))
+ (if (memq byte-optimize '(t byte))
+ (setq byte-compile-output
+ (byte-optimize-lapcode byte-compile-output for-effect)))
+
+ ;; Decompile trivial functions:
+ ;; only constants and variables, or a single funcall except in lambdas.
+ ;; Except for Lisp_Compiled objects, forms like (foo "hi")
+ ;; are still quicker than (byte-code "..." [foo "hi"] 2).
+ ;; Note that even (quote foo) must be parsed just as any subr by the
+ ;; interpreter, so quote should be compiled into byte-code in some contexts.
+ ;; What to leave uncompiled:
+ ;; lambda -> never. we used to leave it uncompiled if the body was
+ ;; a single atom, but that causes confusion if the docstring
+ ;; uses the (file . pos) syntax. Besides, now that we have
+ ;; the Lisp_Compiled type, the compiled form is faster.
+ ;; eval -> atom, quote or (function atom atom atom)
+ ;; progn -> as <<same-as-eval>> or (progn <<same-as-eval>> atom)
+ ;; file -> as progn, but takes both quotes and atoms, and longer forms.
+ (let (rest
+ (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall.
+ tmp body)
+ (cond
+ ;; #### This should be split out into byte-compile-nontrivial-function-p.
+ ((or (eq output-type 'lambda)
+ (nthcdr (if (eq output-type 'file) 50 8) byte-compile-output)
+ (assq 'TAG byte-compile-output) ; Not necessary, but speeds up a bit.
+ (not (setq tmp (assq 'byte-return byte-compile-output)))
+ (progn
+ (setq rest (nreverse
+ (cdr (memq tmp (reverse byte-compile-output)))))
+ (while (cond
+ ((memq (car (car rest)) '(byte-varref byte-constant))
+ (setq tmp (car (cdr (car rest))))
+ (if (if (eq (car (car rest)) 'byte-constant)
+ (or (consp tmp)
+ (and (symbolp tmp)
+ (not (keywordp tmp))
+ (not (memq tmp '(nil t))))))
+ (if maycall
+ (setq body (cons (list 'quote tmp) body)))
+ (setq body (cons tmp body))))
+ ((and maycall
+ ;; Allow a funcall if at most one atom follows it.
+ (null (nthcdr 3 rest))
+ (setq tmp
+ ;; XEmacs change for rms funs
+ (or (and
+ (byte-compile-version-cond
+ byte-compile-emacs19-compatibility)
+ (get (car (car rest))
+ 'byte-opcode19-invert))
+ (get (car (car rest))
+ 'byte-opcode-invert)))
+ (or (null (cdr rest))
+ (and (memq output-type '(file progn t))
+ (cdr (cdr rest))
+ (eq (car (nth 1 rest)) 'byte-discard)
+ (progn (setq rest (cdr rest)) t))))
+ (setq maycall nil) ; Only allow one real function call.
+ (setq body (nreverse body))
+ (setq body (list
+ (if (and (eq tmp 'funcall)
+ (eq (car-safe (car body)) 'quote))
+ (cons (nth 1 (car body)) (cdr body))
+ (cons tmp body))))
+ (or (eq output-type 'file)
+ (not (delq nil (mapcar 'consp (cdr (car body))))))))
+ (setq rest (cdr rest)))
+ rest))
+ (let ((byte-compile-vector (byte-compile-constants-vector)))
+ (list 'byte-code (byte-compile-lapcode byte-compile-output)
+ byte-compile-vector byte-compile-maxdepth)))
+ ;; it's a trivial function
+ ((cdr body) (cons 'progn (nreverse body)))
+ ((car body)))))
+
+;; Given BODY, compile it and return a new body.
+(defun byte-compile-top-level-body (body &optional for-effect)
+ (setq body (byte-compile-top-level (cons 'progn body) for-effect t))
+ (cond ((eq (car-safe body) 'progn)
+ (cdr body))
+ (body
+ (list body))))
+\f
+;; This is the recursive entry point for compiling each subform of an
+;; expression.
+;; If for-effect is non-nil, byte-compile-form will output a byte-discard
+;; before terminating (ie no value will be left on the stack).
+;; A byte-compile handler may, when for-effect is non-nil, choose output code
+;; which does not leave a value on the stack, and then set for-effect to nil
+;; (to prevent byte-compile-form from outputting the byte-discard).
+;; If a handler wants to call another handler, it should do so via
+;; byte-compile-form, or take extreme care to handle for-effect correctly.
+;; (Use byte-compile-form-do-effect to reset the for-effect flag too.)
+;;
+(defun byte-compile-form (form &optional for-effect)
+ (setq form (macroexpand form byte-compile-macro-environment))
+ (cond ((not (consp form))
+ ;; XEmacs addition: keywordp
+ (cond ((or (not (symbolp form)) (keywordp form) (memq form '(nil t)))
+ (byte-compile-constant form))
+ ((and for-effect byte-compile-delete-errors)
+ (setq for-effect nil))
+ (t (byte-compile-variable-ref 'byte-varref form))))
+ ((symbolp (car form))
+ (let* ((fn (car form))
+ (handler (get fn 'byte-compile)))
+ (if (memq fn '(t nil))
+ (byte-compile-warn "%s called as a function" fn))
+ (if (and handler
+ (or (not (byte-compile-version-cond
+ byte-compile-emacs19-compatibility))
+ (not (get (get fn 'byte-opcode) 'emacs20-opcode))))
+ (funcall handler form)
+ (if (memq 'callargs byte-compile-warnings)
+ (byte-compile-callargs-warn form))
+ (byte-compile-normal-call form))))
+ ((and (or (compiled-function-p (car form))
+ (eq (car-safe (car form)) 'lambda))
+ ;; if the form comes out the same way it went in, that's
+ ;; because it was malformed, and we couldn't unfold it.
+ (not (eq form (setq form (byte-compile-unfold-lambda form)))))
+ (byte-compile-form form for-effect)
+ (setq for-effect nil))
+ ((byte-compile-normal-call form)))
+ (if for-effect
+ (byte-compile-discard)))
+
+(defun byte-compile-normal-call (form)
+ (if byte-compile-generate-call-tree
+ (byte-compile-annotate-call-tree form))
+ (byte-compile-push-constant (car form))
+ (mapcar 'byte-compile-form (cdr form)) ; wasteful, but faster.
+ (byte-compile-out 'byte-call (length (cdr form))))
+
+;; kludge added to XEmacs to work around the bogosities of a nonlexical lisp.
+(or (fboundp 'globally-boundp) (fset 'globally-boundp 'boundp))
+
+(defun byte-compile-variable-ref (base-op var &optional varbind-flags)
+ (if (or (not (symbolp var)) (keywordp var) (memq var '(nil t)))
+ (byte-compile-warn (if (eq base-op 'byte-varbind)
+ "Attempt to let-bind %s %s"
+ "Variable reference to %s %s")
+ (if (symbolp var) "constant" "nonvariable")
+ (prin1-to-string var))
+ (if (and (get var 'byte-obsolete-variable)
+ (memq 'obsolete byte-compile-warnings))
+ (let ((ob (get var 'byte-obsolete-variable)))
+ (byte-compile-warn "%s is an obsolete variable; %s" var
+ (if (stringp ob)
+ ob
+ (format "use %s instead." ob)))))
+ (if (and (get var 'byte-compatible-variable)
+ (memq 'pedantic byte-compile-warnings))
+ (let ((ob (get var 'byte-compatible-variable)))
+ (byte-compile-warn "%s is provided for compatibility; %s" var
+ (if (stringp ob)
+ ob
+ (format "use %s instead." ob)))))
+ (if (memq 'free-vars byte-compile-warnings)
+ (if (eq base-op 'byte-varbind)
+ (setq byte-compile-bound-variables
+ (cons (cons var (or varbind-flags 0))
+ byte-compile-bound-variables))
+ (or (globally-boundp var)
+ (let ((cell (assq var byte-compile-bound-variables)))
+ (if cell (setcdr cell
+ (logior (cdr cell)
+ (if (eq base-op 'byte-varset)
+ byte-compile-assigned-bit
+ byte-compile-referenced-bit)))))
+ (if (eq base-op 'byte-varset)
+ (or (memq var byte-compile-free-assignments)
+ (progn
+ (byte-compile-warn "assignment to free variable %s"
+ var)
+ (setq byte-compile-free-assignments
+ (cons var byte-compile-free-assignments))))
+ (or (memq var byte-compile-free-references)
+ (progn
+ (byte-compile-warn "reference to free variable %s" var)
+ (setq byte-compile-free-references
+ (cons var byte-compile-free-references)))))))))
+ (let ((tmp (assq var byte-compile-variables)))
+ (or tmp
+ (setq tmp (list var)
+ byte-compile-variables (cons tmp byte-compile-variables)))
+ (byte-compile-out base-op tmp)))
+
+(defmacro byte-compile-get-constant (const)
+ (` (or (if (stringp (, const))
+ (assoc (, const) byte-compile-constants)
+ (assq (, const) byte-compile-constants))
+ (car (setq byte-compile-constants
+ (cons (list (, const)) byte-compile-constants))))))
+
+;; Use this when the value of a form is a constant. This obeys for-effect.
+(defun byte-compile-constant (const)
+ (if for-effect
+ (setq for-effect nil)
+ (byte-compile-out 'byte-constant (byte-compile-get-constant const))))
+
+;; Use this for a constant that is not the value of its containing form.
+;; This ignores for-effect.
+(defun byte-compile-push-constant (const)
+ (let ((for-effect nil))
+ (inline (byte-compile-constant const))))
+
+\f
+;; Compile those primitive ordinary functions
+;; which have special byte codes just for speed.
+
+(defmacro byte-defop-compiler (function &optional compile-handler)
+ ;; add a compiler-form for FUNCTION.
+ ;; If function is a symbol, then the variable "byte-SYMBOL" must name
+ ;; the opcode to be used. If function is a list, the first element
+ ;; is the function and the second element is the bytecode-symbol.
+ ;; COMPILE-HANDLER is the function to use to compile this byte-op, or
+ ;; may be the abbreviations 0, 1, 2, 3, 0-1, 1-2, 2-3, 0+1, 1+1, 2+1,
+ ;; 0-1+1, 1-2+1, 2-3+1, 0+2, or 1+2. If it is nil, then the handler is
+ ;; "byte-compile-SYMBOL."
+ (let (opcode)
+ (if (symbolp function)
+ (setq opcode (intern (concat "byte-" (symbol-name function))))
+ (setq opcode (car (cdr function))
+ function (car function)))
+ (let ((fnform
+ (list 'put (list 'quote function) ''byte-compile
+ (list 'quote
+ (or (cdr (assq compile-handler
+ '((0 . byte-compile-no-args)
+ (1 . byte-compile-one-arg)
+ (2 . byte-compile-two-args)
+ (3 . byte-compile-three-args)
+ (0-1 . byte-compile-zero-or-one-arg)
+ (1-2 . byte-compile-one-or-two-args)
+ (2-3 . byte-compile-two-or-three-args)
+ (0+1 . byte-compile-no-args-with-one-extra)
+ (1+1 . byte-compile-one-arg-with-one-extra)
+ (2+1 . byte-compile-two-args-with-one-extra)
+ (0-1+1 . byte-compile-zero-or-one-arg-with-one-extra)
+ (1-2+1 . byte-compile-one-or-two-args-with-one-extra)
+ (2-3+1 . byte-compile-two-or-three-args-with-one-extra)
+ (0+2 . byte-compile-no-args-with-two-extra)
+ (1+2 . byte-compile-one-arg-with-two-extra)
+
+ )))
+ compile-handler
+ (intern (concat "byte-compile-"
+ (symbol-name function))))))))
+ (if opcode
+ (list 'progn fnform
+ (list 'put (list 'quote function)
+ ''byte-opcode (list 'quote opcode))
+ (list 'put (list 'quote opcode)
+ ''byte-opcode-invert (list 'quote function)))
+ fnform))))
+
+(defmacro byte-defop-compiler20 (function &optional compile-handler)
+ ;; Just like byte-defop-compiler, but defines an opcode that will only
+ ;; be used when byte-compile-emacs19-compatibility is false.
+ (if (and (byte-compile-single-version)
+ byte-compile-emacs19-compatibility)
+ ;; #### instead of doing nothing, this should do some remprops,
+ ;; #### to protect against the case where a single-version compiler
+ ;; #### is loaded into a world that has contained a multi-version one.
+ nil
+ (list 'progn
+ (list 'put
+ (list 'quote
+ (or (car (cdr-safe function))
+ (intern (concat "byte-"
+ (symbol-name (or (car-safe function) function))))))
+ ''emacs20-opcode t)
+ (list 'byte-defop-compiler function compile-handler))))
+
+;; XEmacs addition:
+(defmacro byte-defop-compiler-rmsfun (function &optional compile-handler)
+ ;; for functions like `eq' that compile into different opcodes depending
+ ;; on the Emacs version: byte-old-eq for v19, byte-eq for v20.
+ (let ((opcode (intern (concat "byte-" (symbol-name function))))
+ (opcode19 (intern (concat "byte-old-" (symbol-name function))))
+ (fnform
+ (list 'put (list 'quote function) ''byte-compile
+ (list 'quote
+ (or (cdr (assq compile-handler
+ '((2 . byte-compile-two-args-19->20)
+ )))
+ compile-handler
+ (intern (concat "byte-compile-"
+ (symbol-name function))))))))
+ (list 'progn fnform
+ (list 'put (list 'quote function)
+ ''byte-opcode (list 'quote opcode))
+ (list 'put (list 'quote function)
+ ''byte-opcode19 (list 'quote opcode19))
+ (list 'put (list 'quote opcode)
+ ''byte-opcode-invert (list 'quote function))
+ (list 'put (list 'quote opcode19)
+ ''byte-opcode19-invert (list 'quote function)))))
+
+(defmacro byte-defop-compiler-1 (function &optional compile-handler)
+ (list 'byte-defop-compiler (list function nil) compile-handler))
+
+\f
+(put 'byte-call 'byte-opcode-invert 'funcall)
+(put 'byte-list1 'byte-opcode-invert 'list)
+(put 'byte-list2 'byte-opcode-invert 'list)
+(put 'byte-list3 'byte-opcode-invert 'list)
+(put 'byte-list4 'byte-opcode-invert 'list)
+(put 'byte-listN 'byte-opcode-invert 'list)
+(put 'byte-concat2 'byte-opcode-invert 'concat)
+(put 'byte-concat3 'byte-opcode-invert 'concat)
+(put 'byte-concat4 'byte-opcode-invert 'concat)
+(put 'byte-concatN 'byte-opcode-invert 'concat)
+(put 'byte-insertN 'byte-opcode-invert 'insert)
+
+;; How old is this stuff? -slb
+;(byte-defop-compiler (dot byte-point) 0+1)
+;(byte-defop-compiler (dot-max byte-point-max) 0+1)
+;(byte-defop-compiler (dot-min byte-point-min) 0+1)
+(byte-defop-compiler point 0+1)
+(byte-defop-compiler-rmsfun eq 2)
+(byte-defop-compiler point-max 0+1)
+(byte-defop-compiler point-min 0+1)
+(byte-defop-compiler following-char 0+1)
+(byte-defop-compiler preceding-char 0+1)
+(byte-defop-compiler current-column 0+1)
+;; FSF has special function here; generalized here by the 1+2 stuff.
+(byte-defop-compiler (indent-to-column byte-indent-to) 1+2)
+(byte-defop-compiler indent-to 1+2)
+(byte-defop-compiler-rmsfun equal 2)
+(byte-defop-compiler eolp 0+1)
+(byte-defop-compiler eobp 0+1)
+(byte-defop-compiler bolp 0+1)
+(byte-defop-compiler bobp 0+1)
+(byte-defop-compiler current-buffer 0)
+;;(byte-defop-compiler read-char 0) ;; obsolete
+(byte-defop-compiler-rmsfun memq 2)
+(byte-defop-compiler interactive-p 0)
+(byte-defop-compiler widen 0+1)
+(byte-defop-compiler end-of-line 0-1+1)
+(byte-defop-compiler forward-char 0-1+1)
+(byte-defop-compiler forward-line 0-1+1)
+(byte-defop-compiler symbolp 1)
+(byte-defop-compiler consp 1)
+(byte-defop-compiler stringp 1)
+(byte-defop-compiler listp 1)
+(byte-defop-compiler not 1)
+(byte-defop-compiler (null byte-not) 1)
+(byte-defop-compiler car 1)
+(byte-defop-compiler cdr 1)
+(byte-defop-compiler length 1)
+(byte-defop-compiler symbol-value 1)
+(byte-defop-compiler symbol-function 1)
+(byte-defop-compiler (1+ byte-add1) 1)
+(byte-defop-compiler (1- byte-sub1) 1)
+(byte-defop-compiler goto-char 1+1)
+(byte-defop-compiler char-after 0-1+1)
+(byte-defop-compiler set-buffer 1)
+;;(byte-defop-compiler set-mark 1) ;; obsolete
+(byte-defop-compiler forward-word 1+1)
+(byte-defop-compiler char-syntax 1+1)
+(byte-defop-compiler nreverse 1)
+(byte-defop-compiler car-safe 1)
+(byte-defop-compiler cdr-safe 1)
+(byte-defop-compiler numberp 1)
+(byte-defop-compiler integerp 1)
+(byte-defop-compiler skip-chars-forward 1-2+1)
+(byte-defop-compiler skip-chars-backward 1-2+1)
+(byte-defop-compiler (eql byte-eq) 2)
+(byte-defop-compiler20 old-eq 2)
+(byte-defop-compiler20 old-memq 2)
+(byte-defop-compiler cons 2)
+(byte-defop-compiler aref 2)
+(byte-defop-compiler (= byte-eqlsign) byte-compile-one-or-more-args)
+(byte-defop-compiler (< byte-lss) byte-compile-one-or-more-args)
+(byte-defop-compiler (> byte-gtr) byte-compile-one-or-more-args)
+(byte-defop-compiler (<= byte-leq) byte-compile-one-or-more-args)
+(byte-defop-compiler (>= byte-geq) byte-compile-one-or-more-args)
+(byte-defop-compiler /= byte-compile-/=)
+(byte-defop-compiler get 2+1)
+(byte-defop-compiler nth 2)
+(byte-defop-compiler substring 2-3)
+(byte-defop-compiler (move-marker byte-set-marker) 2-3)
+(byte-defop-compiler set-marker 2-3)
+(byte-defop-compiler match-beginning 1)
+(byte-defop-compiler match-end 1)
+(byte-defop-compiler upcase 1+1)
+(byte-defop-compiler downcase 1+1)
+(byte-defop-compiler string= 2)
+(byte-defop-compiler string< 2)
+(byte-defop-compiler (string-equal byte-string=) 2)
+(byte-defop-compiler (string-lessp byte-string<) 2)
+(byte-defop-compiler20 old-equal 2)
+(byte-defop-compiler nthcdr 2)
+(byte-defop-compiler elt 2)
+(byte-defop-compiler20 old-member 2)
+(byte-defop-compiler20 old-assq 2)
+(byte-defop-compiler (rplaca byte-setcar) 2)
+(byte-defop-compiler (rplacd byte-setcdr) 2)
+(byte-defop-compiler setcar 2)
+(byte-defop-compiler setcdr 2)
+;; buffer-substring now has its own function. This used to be
+;; 2+1, but now all args are optional.
+(byte-defop-compiler buffer-substring)
+(byte-defop-compiler delete-region 2+1)
+(byte-defop-compiler narrow-to-region 2+1)
+(byte-defop-compiler (% byte-rem) 2)
+(byte-defop-compiler aset 3)
+
+(byte-defop-compiler-rmsfun member 2)
+(byte-defop-compiler-rmsfun assq 2)
+
+(byte-defop-compiler max byte-compile-associative)
+(byte-defop-compiler min byte-compile-associative)
+(byte-defop-compiler (+ byte-plus) byte-compile-associative)
+(byte-defop-compiler (* byte-mult) byte-compile-associative)
+
+;;####(byte-defop-compiler move-to-column 1)
+(byte-defop-compiler-1 interactive byte-compile-noop)
+(byte-defop-compiler-1 domain byte-compile-domain)
+
+;; As of GNU Emacs 19.18 and Lucid Emacs 19.8, mod and % are different: `%'
+;; means integral remainder and may have a negative result; `mod' is always
+;; positive, and accepts floating point args. All code which uses `mod' and
+;; requires the new interpretation must be compiled with bytecomp version 2.18
+;; or newer, or the emitted code will run the byte-code for `%' instead of an
+;; actual call to `mod'. So be careful of compiling new code with an old
+;; compiler. Note also that `%' is more efficient than `mod' because the
+;; former is byte-coded and the latter is not.
+;;(byte-defop-compiler (mod byte-rem) 2)
+
+\f
+(defun byte-compile-subr-wrong-args (form n)
+ (byte-compile-warn "%s called with %d arg%s, but requires %s"
+ (car form) (length (cdr form))
+ (if (= 1 (length (cdr form))) "" "s") n)
+ ;; get run-time wrong-number-of-args error.
+ (byte-compile-normal-call form))
+
+(defun byte-compile-no-args (form)
+ (if (not (= (length form) 1))
+ (byte-compile-subr-wrong-args form "none")
+ (byte-compile-out (get (car form) 'byte-opcode) 0)))
+
+(defun byte-compile-one-arg (form)
+ (if (not (= (length form) 2))
+ (byte-compile-subr-wrong-args form 1)
+ (byte-compile-form (car (cdr form))) ;; Push the argument
+ (byte-compile-out (get (car form) 'byte-opcode) 0)))
+
+(defun byte-compile-two-args (form)
+ (if (not (= (length form) 3))
+ (byte-compile-subr-wrong-args form 2)
+ (byte-compile-form (car (cdr form))) ;; Push the arguments
+ (byte-compile-form (nth 2 form))
+ (byte-compile-out (get (car form) 'byte-opcode) 0)))
+
+(defun byte-compile-three-args (form)
+ (if (not (= (length form) 4))
+ (byte-compile-subr-wrong-args form 3)
+ (byte-compile-form (car (cdr form))) ;; Push the arguments
+ (byte-compile-form (nth 2 form))
+ (byte-compile-form (nth 3 form))
+ (byte-compile-out (get (car form) 'byte-opcode) 0)))
+
+(defun byte-compile-zero-or-one-arg (form)
+ (let ((len (length form)))
+ (cond ((= len 1) (byte-compile-one-arg (append form '(nil))))
+ ((= len 2) (byte-compile-one-arg form))
+ (t (byte-compile-subr-wrong-args form "0-1")))))
+
+(defun byte-compile-one-or-two-args (form)
+ (let ((len (length form)))
+ (cond ((= len 2) (byte-compile-two-args (append form '(nil))))
+ ((= len 3) (byte-compile-two-args form))
+ (t (byte-compile-subr-wrong-args form "1-2")))))
+
+(defun byte-compile-two-or-three-args (form)
+ (let ((len (length form)))
+ (cond ((= len 3) (byte-compile-three-args (append form '(nil))))
+ ((= len 4) (byte-compile-three-args form))
+ (t (byte-compile-subr-wrong-args form "2-3")))))
+
+;; from Ben Wing <ben@xemacs.org>: some inlined functions have extra
+;; optional args added to them in XEmacs 19.12. Changing the byte
+;; interpreter to deal with these args would be wrong and cause
+;; incompatibility, so we generate non-inlined calls for those cases.
+;; Without the following functions, spurious warnings will be generated;
+;; however, they would still compile correctly because
+;; `byte-compile-subr-wrong-args' also converts the call to non-inlined.
+
+(defun byte-compile-no-args-with-one-extra (form)
+ (let ((len (length form)))
+ (cond ((= len 1) (byte-compile-no-args form))
+ ((= len 2) (byte-compile-normal-call form))
+ (t (byte-compile-subr-wrong-args form "0-1")))))
+
+(defun byte-compile-one-arg-with-one-extra (form)
+ (let ((len (length form)))
+ (cond ((= len 2) (byte-compile-one-arg form))
+ ((= len 3) (byte-compile-normal-call form))
+ (t (byte-compile-subr-wrong-args form "1-2")))))
+
+(defun byte-compile-two-args-with-one-extra (form)
+ (let ((len (length form)))
+ (cond ((= len 3) (byte-compile-two-args form))
+ ((= len 4) (byte-compile-normal-call form))
+ (t (byte-compile-subr-wrong-args form "2-3")))))
+
+(defun byte-compile-zero-or-one-arg-with-one-extra (form)
+ (let ((len (length form)))
+ (cond ((= len 1) (byte-compile-one-arg (append form '(nil))))
+ ((= len 2) (byte-compile-one-arg form))
+ ((= len 3) (byte-compile-normal-call form))
+ (t (byte-compile-subr-wrong-args form "0-2")))))
+
+(defun byte-compile-one-or-two-args-with-one-extra (form)
+ (let ((len (length form)))
+ (cond ((= len 2) (byte-compile-two-args (append form '(nil))))
+ ((= len 3) (byte-compile-two-args form))
+ ((= len 4) (byte-compile-normal-call form))
+ (t (byte-compile-subr-wrong-args form "1-3")))))
+
+(defun byte-compile-two-or-three-args-with-one-extra (form)
+ (let ((len (length form)))
+ (cond ((= len 3) (byte-compile-three-args (append form '(nil))))
+ ((= len 4) (byte-compile-three-args form))
+ ((= len 5) (byte-compile-normal-call form))
+ (t (byte-compile-subr-wrong-args form "2-4")))))
+
+(defun byte-compile-no-args-with-two-extra (form)
+ (let ((len (length form)))
+ (cond ((= len 1) (byte-compile-no-args form))
+ ((or (= len 2) (= len 3)) (byte-compile-normal-call form))
+ (t (byte-compile-subr-wrong-args form "0-2")))))
+
+(defun byte-compile-one-arg-with-two-extra (form)
+ (let ((len (length form)))
+ (cond ((= len 2) (byte-compile-one-arg form))
+ ((or (= len 3) (= len 4)) (byte-compile-normal-call form))
+ (t (byte-compile-subr-wrong-args form "1-3")))))
+
+;; XEmacs: used for functions that have a different opcode in v19 than v20.
+;; this includes `eq', `equal', and other old-ified functions.
+(defun byte-compile-two-args-19->20 (form)
+ (if (not (= (length form) 3))
+ (byte-compile-subr-wrong-args form 2)
+ (byte-compile-form (car (cdr form))) ;; Push the arguments
+ (byte-compile-form (nth 2 form))
+ (if (byte-compile-version-cond byte-compile-emacs19-compatibility)
+ (byte-compile-out (get (car form) 'byte-opcode19) 0)
+ (byte-compile-out (get (car form) 'byte-opcode) 0))))
+
+(defun byte-compile-noop (form)
+ (byte-compile-constant nil))
+
+(defun byte-compile-discard ()
+ (byte-compile-out 'byte-discard 0))
+
+
+;; Compile a function that accepts one or more args and is right-associative.
+;; We do it by left-associativity so that the operations
+;; are done in the same order as in interpreted code.
+(defun byte-compile-associative (form)
+ (if (cdr form)
+ (let ((opcode (get (car form) 'byte-opcode))
+ (args (copy-sequence (cdr form))))
+ (byte-compile-form (car args))
+ (setq args (cdr args))
+ (while args
+ (byte-compile-form (car args))
+ (byte-compile-out opcode 0)
+ (setq args (cdr args))))
+ (byte-compile-constant (eval form))))
+
+\f
+;; more complicated compiler macros
+
+(byte-defop-compiler list)
+(byte-defop-compiler concat)
+(byte-defop-compiler fset)
+(byte-defop-compiler insert)
+(byte-defop-compiler-1 function byte-compile-function-form)
+(byte-defop-compiler-1 - byte-compile-minus)
+(byte-defop-compiler (/ byte-quo) byte-compile-quo)
+(byte-defop-compiler nconc)
+(byte-defop-compiler-1 beginning-of-line)
+
+(defun byte-compile-one-or-more-args (form)
+ (let ((len (length form)))
+ (cond ((= len 1) (byte-compile-subr-wrong-args form "1 or more"))
+ ((= len 2) (byte-compile-constant t))
+ ((= len 3) (byte-compile-two-args form))
+ (t (byte-compile-normal-call form)))))
+
+(defun byte-compile-/= (form)
+ (let ((len (length form)))
+ (cond ((= len 1) (byte-compile-subr-wrong-args form "1 or more"))
+ ((= len 2) (byte-compile-constant t))
+ ;; optimize (/= X Y) to (not (= X Y))
+ ((= len 3) (byte-compile-form-do-effect `(not (= ,@(cdr form)))))
+ (t (byte-compile-normal-call form)))))
+
+(defun byte-compile-buffer-substring (form)
+ (let ((len (length form)))
+ ;; buffer-substring used to take exactly two args, but now takes 0-3.
+ ;; convert 0-2 to two args and use special bytecode operand.
+ ;; convert 3 args to a normal call.
+ (cond ((= len 1) (setq form (append form '(nil nil)))
+ (= len 2) (setq form (append form '(nil)))))
+ (cond ((= len 3) (byte-compile-two-args form))
+ ((= len 4) (byte-compile-normal-call form))
+ (t (byte-compile-subr-wrong-args form "0-3")))))
+
+(defun byte-compile-list (form)
+ (let ((count (length (cdr form))))
+ (cond ((= count 0)
+ (byte-compile-constant nil))
+ ((< count 5)
+ (mapcar 'byte-compile-form (cdr form))
+ (byte-compile-out
+ (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- count)) 0))
+ ((< count 256)
+ (mapcar 'byte-compile-form (cdr form))
+ (byte-compile-out 'byte-listN count))
+ (t (byte-compile-normal-call form)))))
+
+(defun byte-compile-concat (form)
+ (let ((count (length (cdr form))))
+ (cond ((and (< 1 count) (< count 5))
+ (mapcar 'byte-compile-form (cdr form))
+ (byte-compile-out
+ (aref [byte-concat2 byte-concat3 byte-concat4] (- count 2))
+ 0))
+ ;; Concat of one arg is not a no-op if arg is not a string.
+ ((= count 0)
+ (byte-compile-form ""))
+ ((< count 256)
+ (mapcar 'byte-compile-form (cdr form))
+ (byte-compile-out 'byte-concatN count))
+ ((byte-compile-normal-call form)))))
+
+(defun byte-compile-minus (form)
+ (if (null (setq form (cdr form)))
+ (byte-compile-constant 0)
+ (byte-compile-form (car form))
+ (if (cdr form)
+ (while (setq form (cdr form))
+ (byte-compile-form (car form))
+ (byte-compile-out 'byte-diff 0))
+ (byte-compile-out 'byte-negate 0))))
+
+(defun byte-compile-quo (form)
+ (let ((len (length form)))
+ (cond ((<= len 2)
+ (byte-compile-subr-wrong-args form "2 or more"))
+ (t
+ (byte-compile-form (car (setq form (cdr form))))
+ (while (setq form (cdr form))
+ (byte-compile-form (car form))
+ (byte-compile-out 'byte-quo 0))))))
+
+(defun byte-compile-nconc (form)
+ (let ((len (length form)))
+ (cond ((= len 1)
+ (byte-compile-constant nil))
+ ((= len 2)
+ ;; nconc of one arg is a noop, even if that arg isn't a list.
+ (byte-compile-form (nth 1 form)))
+ (t
+ (byte-compile-form (car (setq form (cdr form))))
+ (while (setq form (cdr form))
+ (byte-compile-form (car form))
+ (byte-compile-out 'byte-nconc 0))))))
+
+(defun byte-compile-fset (form)
+ ;; warn about forms like (fset 'foo '(lambda () ...))
+ ;; (where the lambda expression is non-trivial...)
+ ;; Except don't warn if the first argument is 'make-byte-code, because
+ ;; I'm sick of getting mail asking me whether that warning is a problem.
+ (let ((fn (nth 2 form))
+ body)
+ (if (and (eq (car-safe fn) 'quote)
+ (eq (car-safe (setq fn (nth 1 fn))) 'lambda)
+ (not (eq (car-safe (cdr-safe (nth 1 form))) 'make-byte-code)))
+ (progn
+ (setq body (cdr (cdr fn)))
+ (if (stringp (car body)) (setq body (cdr body)))
+ (if (eq 'interactive (car-safe (car body))) (setq body (cdr body)))
+ (if (and (consp (car body))
+ (not (eq 'byte-code (car (car body)))))
+ (byte-compile-warn
+ "A quoted lambda form is the second argument of fset. This is probably
+ not what you want, as that lambda cannot be compiled. Consider using
+ the syntax (function (lambda (...) ...)) instead.")))))
+ (byte-compile-two-args form))
+
+(defun byte-compile-funarg (form)
+ ;; (mapcar '(lambda (x) ..) ..) ==> (mapcar (function (lambda (x) ..)) ..)
+ ;; for cases where it's guaranteed that first arg will be used as a lambda.
+ (byte-compile-normal-call
+ (let ((fn (nth 1 form)))
+ (if (and (eq (car-safe fn) 'quote)
+ (eq (car-safe (nth 1 fn)) 'lambda))
+ (cons (car form)
+ (cons (cons 'function (cdr fn))
+ (cdr (cdr form))))
+ form))))
+
+;; (function foo) must compile like 'foo, not like (symbol-function 'foo).
+;; Otherwise it will be incompatible with the interpreter,
+;; and (funcall (function foo)) will lose with autoloads.
+
+(defun byte-compile-function-form (form)
+ (byte-compile-constant
+ (cond ((symbolp (nth 1 form))
+ (nth 1 form))
+ ((byte-compile-lambda (nth 1 form))))))
+
+(defun byte-compile-insert (form)
+ (cond ((null (cdr form))
+ (byte-compile-constant nil))
+ ((<= (length form) 256)
+ (mapcar 'byte-compile-form (cdr form))
+ (if (cdr (cdr form))
+ (byte-compile-out 'byte-insertN (length (cdr form)))
+ (byte-compile-out 'byte-insert 0)))
+ ((memq t (mapcar 'consp (cdr (cdr form))))
+ (byte-compile-normal-call form))
+ ;; We can split it; there is no function call after inserting 1st arg.
+ (t
+ (while (setq form (cdr form))
+ (byte-compile-form (car form))
+ (byte-compile-out 'byte-insert 0)
+ (if (cdr form)
+ (byte-compile-discard))))))
+
+;; alas, the old (pre-19.12, and all existing versions of FSFmacs 19)
+;; byte compiler will generate incorrect code for
+;; (beginning-of-line nil buffer) because it buggily doesn't
+;; check the number of arguments passed to beginning-of-line.
+
+(defun byte-compile-beginning-of-line (form)
+ (let ((len (length form)))
+ (cond ((> len 3)
+ (byte-compile-subr-wrong-args form "0-2"))
+ ((or (= len 3) (not (byte-compile-constp (nth 1 form))))
+ (byte-compile-normal-call form))
+ (t
+ (byte-compile-form
+ (list 'forward-line
+ (if (integerp (setq form (or (eval (nth 1 form)) 1)))
+ (1- form)
+ (byte-compile-warn
+ "Non-numeric arg to beginning-of-line: %s" form)
+ (list '1- (list 'quote form))))
+ t)
+ (byte-compile-constant nil)))))
+
+\f
+(byte-defop-compiler set)
+(byte-defop-compiler-1 setq)
+(byte-defop-compiler-1 set-default)
+(byte-defop-compiler-1 setq-default)
+
+(byte-defop-compiler-1 quote)
+(byte-defop-compiler-1 quote-form)
+
+(defun byte-compile-setq (form)
+ (let ((args (cdr form)))
+ (if args
+ (while args
+ (byte-compile-form (car (cdr args)))
+ (or for-effect (cdr (cdr args))
+ (byte-compile-out 'byte-dup 0))
+ (byte-compile-variable-ref 'byte-varset (car args))
+ (setq args (cdr (cdr args))))
+ ;; (setq), with no arguments.
+ (byte-compile-form nil for-effect))
+ (setq for-effect nil)))
+
+(defun byte-compile-set (form)
+ ;; Compile (set 'foo x) as (setq foo x) for trivially better code and so
+ ;; that we get applicable warnings. Compile everything else (including
+ ;; malformed calls) like a normal 2-arg byte-coded function.
+ (if (or (not (eq (car-safe (nth 1 form)) 'quote))
+ (not (= (length form) 3))
+ (not (= (length (nth 1 form)) 2)))
+ (byte-compile-two-args form)
+ (byte-compile-setq (list 'setq (nth 1 (nth 1 form)) (nth 2 form)))))
+
+(defun byte-compile-setq-default (form)
+ (let ((rest (cdr form)))
+ ;; emit multiple calls to set-default if necessary
+ (while rest
+ (byte-compile-form
+ (list 'set-default (list 'quote (car rest)) (car (cdr rest)))
+ (not (null (cdr (cdr rest)))))
+ (setq rest (cdr (cdr rest))))))
+
+(defun byte-compile-set-default (form)
+ (let ((rest (cdr form)))
+ (if (cdr (cdr (cdr form)))
+ ;; emit multiple calls to set-default if necessary; all but last
+ ;; for-effect (this recurses.)
+ (while rest
+ (byte-compile-form
+ (list 'set-default (car rest) (car (cdr rest)))
+ (not (null (cdr rest))))
+ (setq rest (cdr (cdr rest))))
+ ;; else, this is the one-armed version
+ (let ((var (nth 1 form))
+ ;;(val (nth 2 form))
+ )
+ ;; notice calls to set-default/setq-default for variables which
+ ;; have not been declared with defvar/defconst.
+ (if (and (memq 'free-vars byte-compile-warnings)
+ (or (null var)
+ (and (eq (car-safe var) 'quote)
+ (= 2 (length var)))))
+ (let ((sym (nth 1 var))
+ cell)
+ (or (and sym (symbolp sym) (globally-boundp sym))
+ (and (setq cell (assq sym byte-compile-bound-variables))
+ (setcdr cell (logior (cdr cell)
+ byte-compile-assigned-bit)))
+ (memq sym byte-compile-free-assignments)
+ (if (or (not (symbolp sym)) (memq sym '(t nil)))
+ (progn
+ (byte-compile-warn
+ "Attempt to set-globally %s %s"
+ (if (symbolp sym) "constant" "nonvariable")
+ (prin1-to-string sym)))
+ (progn
+ (byte-compile-warn "assignment to free variable %s" sym)
+ (setq byte-compile-free-assignments
+ (cons sym byte-compile-free-assignments)))))))
+ ;; now emit a normal call to set-default (or possibly multiple calls)
+ (byte-compile-normal-call form)))))
+
+
+(defun byte-compile-quote (form)
+ (byte-compile-constant (car (cdr form))))
+
+(defun byte-compile-quote-form (form)
+ (byte-compile-constant (byte-compile-top-level (nth 1 form))))
+
+\f
+;;; control structures
+
+(defun byte-compile-body (body &optional for-effect)
+ (while (cdr body)
+ (byte-compile-form (car body) t)
+ (setq body (cdr body)))
+ (byte-compile-form (car body) for-effect))
+
+(proclaim-inline byte-compile-body-do-effect)
+(defun byte-compile-body-do-effect (body)
+ (byte-compile-body body for-effect)
+ (setq for-effect nil))
+
+(proclaim-inline byte-compile-form-do-effect)
+(defun byte-compile-form-do-effect (form)
+ (byte-compile-form form for-effect)
+ (setq for-effect nil))
+
+(byte-defop-compiler-1 inline byte-compile-progn)
+(byte-defop-compiler-1 progn)
+(byte-defop-compiler-1 prog1)
+(byte-defop-compiler-1 prog2)
+(byte-defop-compiler-1 if)
+(byte-defop-compiler-1 cond)
+(byte-defop-compiler-1 and)
+(byte-defop-compiler-1 or)
+(byte-defop-compiler-1 while)
+(byte-defop-compiler-1 funcall)
+(byte-defop-compiler-1 apply byte-compile-funarg)
+(byte-defop-compiler-1 mapcar byte-compile-funarg)
+(byte-defop-compiler-1 mapatoms byte-compile-funarg)
+(byte-defop-compiler-1 mapconcat byte-compile-funarg)
+(byte-defop-compiler-1 let)
+(byte-defop-compiler-1 let*)
+
+(defun byte-compile-progn (form)
+ (byte-compile-body-do-effect (cdr form)))
+
+(defun byte-compile-prog1 (form)
+ (byte-compile-form-do-effect (car (cdr form)))
+ (byte-compile-body (cdr (cdr form)) t))
+
+(defun byte-compile-prog2 (form)
+ (byte-compile-form (nth 1 form) t)
+ (byte-compile-form-do-effect (nth 2 form))
+ (byte-compile-body (cdr (cdr (cdr form))) t))
+
+(defmacro byte-compile-goto-if (cond discard tag)
+ (` (byte-compile-goto
+ (if (, cond)
+ (if (, discard) 'byte-goto-if-not-nil 'byte-goto-if-not-nil-else-pop)
+ (if (, discard) 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
+ (, tag))))
+
+(defun byte-compile-if (form)
+ (byte-compile-form (car (cdr form)))
+ (if (null (nthcdr 3 form))
+ ;; No else-forms
+ (let ((donetag (byte-compile-make-tag)))
+ (byte-compile-goto-if nil for-effect donetag)
+ (byte-compile-form (nth 2 form) for-effect)
+ (byte-compile-out-tag donetag))
+ (let ((donetag (byte-compile-make-tag)) (elsetag (byte-compile-make-tag)))
+ (byte-compile-goto 'byte-goto-if-nil elsetag)
+ (byte-compile-form (nth 2 form) for-effect)
+ (byte-compile-goto 'byte-goto donetag)
+ (byte-compile-out-tag elsetag)
+ (byte-compile-body (cdr (cdr (cdr form))) for-effect)
+ (byte-compile-out-tag donetag)))
+ (setq for-effect nil))
+
+(defun byte-compile-cond (clauses)
+ (let ((donetag (byte-compile-make-tag))
+ nexttag clause)
+ (while (setq clauses (cdr clauses))
+ (setq clause (car clauses))
+ (cond ((or (eq (car clause) t)
+ (and (eq (car-safe (car clause)) 'quote)
+ (car-safe (cdr-safe (car clause)))))
+ ;; Unconditional clause
+ (setq clause (cons t clause)
+ clauses nil))
+ ((cdr clauses)
+ (byte-compile-form (car clause))
+ (if (null (cdr clause))
+ ;; First clause is a singleton.
+ (byte-compile-goto-if t for-effect donetag)
+ (setq nexttag (byte-compile-make-tag))
+ (byte-compile-goto 'byte-goto-if-nil nexttag)
+ (byte-compile-body (cdr clause) for-effect)
+ (byte-compile-goto 'byte-goto donetag)
+ (byte-compile-out-tag nexttag)))))
+ ;; Last clause
+ (and (cdr clause) (not (eq (car clause) t))
+ (progn (byte-compile-form (car clause))
+ (byte-compile-goto-if nil for-effect donetag)
+ (setq clause (cdr clause))))
+ (byte-compile-body-do-effect clause)
+ (byte-compile-out-tag donetag)))
+
+(defun byte-compile-and (form)
+ (let ((failtag (byte-compile-make-tag))
+ (args (cdr form)))
+ (if (null args)
+ (byte-compile-form-do-effect t)
+ (while (cdr args)
+ (byte-compile-form (car args))
+ (byte-compile-goto-if nil for-effect failtag)
+ (setq args (cdr args)))
+ (byte-compile-form-do-effect (car args))
+ (byte-compile-out-tag failtag))))
+
+(defun byte-compile-or (form)
+ (let ((wintag (byte-compile-make-tag))
+ (args (cdr form)))
+ (if (null args)
+ (byte-compile-form-do-effect nil)
+ (while (cdr args)
+ (byte-compile-form (car args))
+ (byte-compile-goto-if t for-effect wintag)
+ (setq args (cdr args)))
+ (byte-compile-form-do-effect (car args))
+ (byte-compile-out-tag wintag))))
+
+(defun byte-compile-while (form)
+ (let ((endtag (byte-compile-make-tag))
+ (looptag (byte-compile-make-tag)))
+ (byte-compile-out-tag looptag)
+ (byte-compile-form (car (cdr form)))
+ (byte-compile-goto-if nil for-effect endtag)
+ (byte-compile-body (cdr (cdr form)) t)
+ (byte-compile-goto 'byte-goto looptag)
+ (byte-compile-out-tag endtag)
+ (setq for-effect nil)))
+
+(defun byte-compile-funcall (form)
+ (mapcar 'byte-compile-form (cdr form))
+ (byte-compile-out 'byte-call (length (cdr (cdr form)))))
+
+
+(defun byte-compile-let (form)
+ ;; First compute the binding values in the old scope.
+ (let ((varlist (car (cdr form))))
+ (while varlist
+ (if (consp (car varlist))
+ (byte-compile-form (car (cdr (car varlist))))
+ (byte-compile-push-constant nil))
+ (setq varlist (cdr varlist))))
+ (let ((byte-compile-bound-variables
+ (cons 'new-scope byte-compile-bound-variables))
+ (varlist (reverse (car (cdr form))))
+ (extra-flags
+ ;; If this let is of the form (let (...) (byte-code ...))
+ ;; then assume that it is the result of a transformation of
+ ;; ((lambda (...) (byte-code ... )) ...) and thus compile
+ ;; the variable bindings as if they were arglist bindings
+ ;; (which matters for what warnings.)
+ (if (eq 'byte-code (car-safe (nth 2 form)))
+ byte-compile-arglist-bit
+ nil)))
+ (while varlist
+ (byte-compile-variable-ref 'byte-varbind
+ (if (consp (car varlist))
+ (car (car varlist))
+ (car varlist))
+ extra-flags)
+ (setq varlist (cdr varlist)))
+ (byte-compile-body-do-effect (cdr (cdr form)))
+ (if (memq 'unused-vars byte-compile-warnings)
+ ;; done compiling in this scope, warn now.
+ (byte-compile-warn-about-unused-variables))
+ (byte-compile-out 'byte-unbind (length (car (cdr form))))))
+
+(defun byte-compile-let* (form)
+ (let ((byte-compile-bound-variables
+ (cons 'new-scope byte-compile-bound-variables))
+ (varlist (copy-sequence (car (cdr form)))))
+ (while varlist
+ (if (atom (car varlist))
+ (byte-compile-push-constant nil)
+ (byte-compile-form (car (cdr (car varlist))))
+ (setcar varlist (car (car varlist))))
+ (byte-compile-variable-ref 'byte-varbind (car varlist))
+ (setq varlist (cdr varlist)))
+ (byte-compile-body-do-effect (cdr (cdr form)))
+ (if (memq 'unused-vars byte-compile-warnings)
+ ;; done compiling in this scope, warn now.
+ (byte-compile-warn-about-unused-variables))
+ (byte-compile-out 'byte-unbind (length (car (cdr form))))))
+
+
+;;(byte-defop-compiler-1 /= byte-compile-negated)
+(byte-defop-compiler-1 atom byte-compile-negated)
+(byte-defop-compiler-1 nlistp byte-compile-negated)
+
+;;(put '/= 'byte-compile-negated-op '=)
+(put 'atom 'byte-compile-negated-op 'consp)
+(put 'nlistp 'byte-compile-negated-op 'listp)
+
+(defun byte-compile-negated (form)
+ (byte-compile-form-do-effect (byte-compile-negation-optimizer form)))
+
+;; Even when optimization is off, atom is optimized to (not (consp ...)).
+(defun byte-compile-negation-optimizer (form)
+ ;; an optimizer for forms where <form1> is less efficient than (not <form2>)
+ (list 'not
+ (cons (or (get (car form) 'byte-compile-negated-op)
+ (error
+ "Compiler error: `%s' has no `byte-compile-negated-op' property"
+ (car form)))
+ (cdr form))))
+\f
+;;; other tricky macro-like special-forms
+
+(byte-defop-compiler-1 catch)
+(byte-defop-compiler-1 unwind-protect)
+(byte-defop-compiler-1 condition-case)
+(byte-defop-compiler-1 save-excursion)
+(byte-defop-compiler-1 save-current-buffer)
+(byte-defop-compiler-1 save-restriction)
+(byte-defop-compiler-1 save-window-excursion)
+(byte-defop-compiler-1 with-output-to-temp-buffer)
+;; no track-mouse.
+
+(defun byte-compile-catch (form)
+ (byte-compile-form (car (cdr form)))
+ (byte-compile-push-constant
+ (byte-compile-top-level (cons 'progn (cdr (cdr form))) for-effect))
+ (byte-compile-out 'byte-catch 0))
+
+(defun byte-compile-unwind-protect (form)
+ (byte-compile-push-constant
+ (byte-compile-top-level-body (cdr (cdr form)) t))
+ (byte-compile-out 'byte-unwind-protect 0)
+ (byte-compile-form-do-effect (car (cdr form)))
+ (byte-compile-out 'byte-unbind 1))
+
+;;(defun byte-compile-track-mouse (form)
+;; (byte-compile-form
+;; (list
+;; 'funcall
+;; (list 'quote
+;; (list 'lambda nil
+;; (cons 'track-mouse
+;; (byte-compile-top-level-body (cdr form))))))))
+
+(defun byte-compile-condition-case (form)
+ (let* ((var (nth 1 form))
+ (byte-compile-bound-variables
+ (if var
+ (cons (cons var 0)
+ (cons 'new-scope byte-compile-bound-variables))
+ (cons 'new-scope byte-compile-bound-variables))))
+ (or (symbolp var)
+ (byte-compile-warn
+ "%s is not a variable-name or nil (in condition-case)"
+ (prin1-to-string var)))
+ (byte-compile-push-constant var)
+ (byte-compile-push-constant (byte-compile-top-level
+ (nth 2 form) for-effect))
+ (let ((clauses (cdr (cdr (cdr form))))
+ compiled-clauses)
+ (while clauses
+ (let* ((clause (car clauses))
+ (condition (car clause)))
+ (cond ((not (or (symbolp condition)
+ (and (listp condition)
+ (let ((syms condition) (ok t))
+ (while syms
+ (if (not (symbolp (car syms)))
+ (setq ok nil))
+ (setq syms (cdr syms)))
+ ok))))
+ (byte-compile-warn
+ "%s is not a symbol naming a condition or a list of such (in condition-case)"
+ (prin1-to-string condition)))
+;; ((not (or (eq condition 't)
+;; (and (stringp (get condition 'error-message))
+;; (consp (get condition 'error-conditions)))))
+;; (byte-compile-warn
+;; "%s is not a known condition name (in condition-case)"
+;; condition))
+ )
+ (setq compiled-clauses
+ (cons (cons condition
+ (byte-compile-top-level-body
+ (cdr clause) for-effect))
+ compiled-clauses)))
+ (setq clauses (cdr clauses)))
+ (byte-compile-push-constant (nreverse compiled-clauses)))
+ (if (memq 'unused-vars byte-compile-warnings)
+ ;; done compiling in this scope, warn now.
+ (byte-compile-warn-about-unused-variables))
+ (byte-compile-out 'byte-condition-case 0)))
+
+
+(defun byte-compile-save-excursion (form)
+ (byte-compile-out 'byte-save-excursion 0)
+ (byte-compile-body-do-effect (cdr form))
+ (byte-compile-out 'byte-unbind 1))
+
+(defun byte-compile-save-restriction (form)
+ (byte-compile-out 'byte-save-restriction 0)
+ (byte-compile-body-do-effect (cdr form))
+ (byte-compile-out 'byte-unbind 1))
+
+(defun byte-compile-save-current-buffer (form)
+ (if (byte-compile-version-cond byte-compile-emacs19-compatibility)
+ ;; `save-current-buffer' special form is not available in XEmacs 19.
+ (byte-compile-form
+ `(let ((_byte_compiler_save_buffer_emulation_closure_ (current-buffer)))
+ (unwind-protect
+ (progn ,@(cdr form))
+ (and (buffer-live-p _byte_compiler_save_buffer_emulation_closure_)
+ (set-buffer _byte_compiler_save_buffer_emulation_closure_)))))
+ (byte-compile-out 'byte-save-current-buffer 0)
+ (byte-compile-body-do-effect (cdr form))
+ (byte-compile-out 'byte-unbind 1)))
+
+(defun byte-compile-save-window-excursion (form)
+ (byte-compile-push-constant
+ (byte-compile-top-level-body (cdr form) for-effect))
+ (byte-compile-out 'byte-save-window-excursion 0))
+
+(defun byte-compile-with-output-to-temp-buffer (form)
+ (byte-compile-form (car (cdr form)))
+ (byte-compile-out 'byte-temp-output-buffer-setup 0)
+ (byte-compile-body (cdr (cdr form)))
+ (byte-compile-out 'byte-temp-output-buffer-show 0))
+
+\f
+;;; top-level forms elsewhere
+
+(byte-defop-compiler-1 defun)
+(byte-defop-compiler-1 defmacro)
+(byte-defop-compiler-1 defvar)
+(byte-defop-compiler-1 defconst byte-compile-defvar)
+(byte-defop-compiler-1 autoload)
+;; According to Mly this can go now that lambda is a macro
+;(byte-defop-compiler-1 lambda byte-compile-lambda-form)
+(byte-defop-compiler-1 defalias)
+(byte-defop-compiler-1 define-function)
+
+(defun byte-compile-defun (form)
+ ;; This is not used for file-level defuns with doc strings.
+ (byte-compile-two-args ; Use this to avoid byte-compile-fset's warning.
+ (list 'fset (list 'quote (nth 1 form))
+ (byte-compile-byte-code-maker
+ (byte-compile-lambda (cons 'lambda (cdr (cdr form)))))))
+ (byte-compile-discard)
+ (byte-compile-constant (nth 1 form)))
+
+(defun byte-compile-defmacro (form)
+ ;; This is not used for file-level defmacros with doc strings.
+ (byte-compile-body-do-effect
+ (list (list 'fset (list 'quote (nth 1 form))
+ (let ((code (byte-compile-byte-code-maker
+ (byte-compile-lambda
+ (cons 'lambda (cdr (cdr form)))))))
+ (if (eq (car-safe code) 'make-byte-code)
+ (list 'cons ''macro code)
+ (list 'quote (cons 'macro (eval code))))))
+ (list 'quote (nth 1 form)))))
+
+(defun byte-compile-defvar (form)
+ ;; This is not used for file-level defvar/consts with doc strings:
+ ;; byte-compile-file-form-defvar will be used in that case.
+ (let ((var (nth 1 form))
+ (value (nth 2 form))
+ (string (nth 3 form)))
+ (if (> (length form) 4)
+ (byte-compile-warn "%s used with too many args" (car form)))
+ (if (memq 'free-vars byte-compile-warnings)
+ (setq byte-compile-bound-variables
+ (cons (cons var byte-compile-global-bit)
+ byte-compile-bound-variables)))
+ (byte-compile-body-do-effect
+ (list (if (cdr (cdr form))
+ (if (eq (car form) 'defconst)
+ (list 'setq var value)
+ (list 'or (list 'boundp (list 'quote var))
+ (list 'setq var value))))
+ ;; Put the defined variable in this library's load-history entry
+ ;; just as a real defvar would.
+ (list 'setq 'current-load-list
+ (list 'cons (list 'quote var)
+ 'current-load-list))
+ (if string
+ (list 'put (list 'quote var) ''variable-documentation string))
+ (list 'quote var)))))
+
+(defun byte-compile-autoload (form)
+ (and (byte-compile-constp (nth 1 form))
+ (byte-compile-constp (nth 5 form))
+ (memq (eval (nth 5 form)) '(t macro)) ; macro-p
+ (not (fboundp (eval (nth 1 form))))
+ (byte-compile-warn
+ "The compiler ignores `autoload' except at top level. You should
+ probably put the autoload of the macro `%s' at top-level."
+ (eval (nth 1 form))))
+ (byte-compile-normal-call form))
+
+;; Lambda's in valid places are handled as special cases by various code.
+;; The ones that remain are errors.
+;; According to Mly this can go now that lambda is a macro
+;(defun byte-compile-lambda-form (form)
+; (byte-compile-warn
+; "`lambda' used in function position is invalid: probably you mean #'%s"
+; (let ((print-escape-newlines t)
+; (print-level 4)
+; (print-length 4))
+; (prin1-to-string form)))
+; (byte-compile-normal-call
+; (list 'signal ''error
+; (list 'quote (list "`lambda' used in function position" form)))))
+
+;; Compile normally, but deal with warnings for the function being defined.
+(defun byte-compile-defalias (form)
+ (if (and (consp (cdr form)) (consp (nth 1 form))
+ (eq (car (nth 1 form)) 'quote)
+ (consp (cdr (nth 1 form)))
+ (symbolp (nth 1 (nth 1 form)))
+ (consp (nthcdr 2 form))
+ (consp (nth 2 form))
+ (eq (car (nth 2 form)) 'quote)
+ (consp (cdr (nth 2 form)))
+ (symbolp (nth 1 (nth 2 form))))
+ (progn
+ (byte-compile-defalias-warn (nth 1 (nth 1 form))
+ (nth 1 (nth 2 form)))
+ (setq byte-compile-function-environment
+ (cons (cons (nth 1 (nth 1 form))
+ (nth 1 (nth 2 form)))
+ byte-compile-function-environment))))
+ (byte-compile-normal-call form))
+
+(defun byte-compile-define-function (form)
+ (byte-compile-defalias form))
+
+;; Turn off warnings about prior calls to the function being defalias'd.
+;; This could be smarter and compare those calls with
+;; the function it is being aliased to.
+(defun byte-compile-defalias-warn (new alias)
+ (let ((calls (assq new byte-compile-unresolved-functions)))
+ (if calls
+ (setq byte-compile-unresolved-functions
+ (delq calls byte-compile-unresolved-functions)))))
+\f
+;;; tags
+
+;; Note: Most operations will strip off the 'TAG, but it speeds up
+;; optimization to have the 'TAG as a part of the tag.
+;; Tags will be (TAG . (tag-number . stack-depth)).
+(defun byte-compile-make-tag ()
+ (list 'TAG (setq byte-compile-tag-number (1+ byte-compile-tag-number))))
+
+
+(defun byte-compile-out-tag (tag)
+ (setq byte-compile-output (cons tag byte-compile-output))
+ (if (cdr (cdr tag))
+ (progn
+ ;; ## remove this someday
+ (and byte-compile-depth
+ (not (= (cdr (cdr tag)) byte-compile-depth))
+ (error "Compiler bug: depth conflict at tag %d" (car (cdr tag))))
+ (setq byte-compile-depth (cdr (cdr tag))))
+ (setcdr (cdr tag) byte-compile-depth)))
+
+(defun byte-compile-goto (opcode tag)
+ (setq byte-compile-output (cons (cons opcode tag) byte-compile-output))
+ (setcdr (cdr tag) (if (memq opcode byte-goto-always-pop-ops)
+ (1- byte-compile-depth)
+ byte-compile-depth))
+ (setq byte-compile-depth (and (not (eq opcode 'byte-goto))
+ (1- byte-compile-depth))))
+
+(defun byte-compile-out (opcode offset)
+ (setq byte-compile-output (cons (cons opcode offset) byte-compile-output))
+ (cond ((eq opcode 'byte-call)
+ (setq byte-compile-depth (- byte-compile-depth offset)))
+ ((eq opcode 'byte-return)
+ ;; This is actually an unnecessary case, because there should be
+ ;; no more opcodes behind byte-return.
+ (setq byte-compile-depth nil))
+ (t
+ (setq byte-compile-depth (+ byte-compile-depth
+ (or (aref byte-stack+-info
+ (symbol-value opcode))
+ (- (1- offset))))
+ byte-compile-maxdepth (max byte-compile-depth
+ byte-compile-maxdepth))))
+ ;;(if (< byte-compile-depth 0) (error "Compiler error: stack underflow"))
+ )
+
+\f
+;;; call tree stuff
+
+(defun byte-compile-annotate-call-tree (form)
+ (let (entry)
+ ;; annotate the current call
+ (if (setq entry (assq (car form) byte-compile-call-tree))
+ (or (memq byte-compile-current-form (nth 1 entry)) ;callers
+ (setcar (cdr entry)
+ (cons byte-compile-current-form (nth 1 entry))))
+ (setq byte-compile-call-tree
+ (cons (list (car form) (list byte-compile-current-form) nil)
+ byte-compile-call-tree)))
+ ;; annotate the current function
+ (if (setq entry (assq byte-compile-current-form byte-compile-call-tree))
+ (or (memq (car form) (nth 2 entry)) ;called
+ (setcar (cdr (cdr entry))
+ (cons (car form) (nth 2 entry))))
+ (setq byte-compile-call-tree
+ (cons (list byte-compile-current-form nil (list (car form)))
+ byte-compile-call-tree)))
+ ))
+
+;; Renamed from byte-compile-report-call-tree
+;; to avoid interfering with completion of byte-compile-file.
+;;;###autoload
+(defun display-call-tree (&optional filename)
+ "Display a call graph of a specified file.
+This lists which functions have been called, what functions called
+them, and what functions they call. The list includes all functions
+whose definitions have been compiled in this Emacs session, as well as
+all functions called by those functions.
+
+The call graph does not include macros, inline functions, or
+primitives that the byte-code interpreter knows about directly \(eq,
+cons, etc.\).
+
+The call tree also lists those functions which are not known to be called
+\(that is, to which no calls have been compiled\), and which cannot be
+invoked interactively."
+ (interactive)
+ (message "Generating call tree...")
+ (with-output-to-temp-buffer "*Call-Tree*"
+ (set-buffer "*Call-Tree*")
+ (erase-buffer)
+ (message "Generating call tree... (sorting on %s)"
+ byte-compile-call-tree-sort)
+ (insert "Call tree for "
+ (cond ((null byte-compile-current-file) (or filename "???"))
+ ((stringp byte-compile-current-file)
+ byte-compile-current-file)
+ (t (buffer-name byte-compile-current-file)))
+ " sorted on "
+ (prin1-to-string byte-compile-call-tree-sort)
+ ":\n\n")
+ (if byte-compile-call-tree-sort
+ (setq byte-compile-call-tree
+ (sort byte-compile-call-tree
+ (cond
+ ((eq byte-compile-call-tree-sort 'callers)
+ (function (lambda (x y) (< (length (nth 1 x))
+ (length (nth 1 y))))))
+ ((eq byte-compile-call-tree-sort 'calls)
+ (function (lambda (x y) (< (length (nth 2 x))
+ (length (nth 2 y))))))
+ ((eq byte-compile-call-tree-sort 'calls+callers)
+ (function (lambda (x y) (< (+ (length (nth 1 x))
+ (length (nth 2 x)))
+ (+ (length (nth 1 y))
+ (length (nth 2 y)))))))
+ ((eq byte-compile-call-tree-sort 'name)
+ (function (lambda (x y) (string< (car x)
+ (car y)))))
+ (t (error
+ "`byte-compile-call-tree-sort': `%s' - unknown sort mode"
+ byte-compile-call-tree-sort))))))
+ (message "Generating call tree...")
+ (let ((rest byte-compile-call-tree)
+ (b (current-buffer))
+ f p
+ callers calls)
+ (while rest
+ (prin1 (car (car rest)) b)
+ (setq callers (nth 1 (car rest))
+ calls (nth 2 (car rest)))
+ (insert "\t"
+ (cond ((not (fboundp (setq f (car (car rest)))))
+ (if (null f)
+ " <top level>";; shouldn't insert nil then, actually -sk
+ " <not defined>"))
+ ((subrp (setq f (symbol-function f)))
+ " <subr>")
+ ((symbolp f)
+ (format " ==> %s" f))
+ ((compiled-function-p f)
+ "<compiled function>")
+ ((not (consp f))
+ "<malformed function>")
+ ((eq 'macro (car f))
+ (if (or (compiled-function-p (cdr f))
+ (assq 'byte-code (cdr (cdr (cdr f)))))
+ " <compiled macro>"
+ " <macro>"))
+ ((assq 'byte-code (cdr (cdr f)))
+ "<compiled lambda>")
+ ((eq 'lambda (car f))
+ "<function>")
+ (t "???"))
+ (format " (%d callers + %d calls = %d)"
+ ;; Does the optimizer eliminate common subexpressions?-sk
+ (length callers)
+ (length calls)
+ (+ (length callers) (length calls)))
+ "\n")
+ (if callers
+ (progn
+ (insert " called by:\n")
+ (setq p (point))
+ (insert " " (if (car callers)
+ (mapconcat 'symbol-name callers ", ")
+ "<top level>"))
+ (let ((fill-prefix " "))
+ (fill-region-as-paragraph p (point)))))
+ (if calls
+ (progn
+ (insert " calls:\n")
+ (setq p (point))
+ (insert " " (mapconcat 'symbol-name calls ", "))
+ (let ((fill-prefix " "))
+ (fill-region-as-paragraph p (point)))))
+ (insert "\n")
+ (setq rest (cdr rest)))
+
+ (message "Generating call tree...(finding uncalled functions...)")
+ (setq rest byte-compile-call-tree)
+ (let ((uncalled nil))
+ (while rest
+ (or (nth 1 (car rest))
+ (null (setq f (car (car rest))))
+ (byte-compile-fdefinition f t)
+ (commandp (byte-compile-fdefinition f nil))
+ (setq uncalled (cons f uncalled)))
+ (setq rest (cdr rest)))
+ (if uncalled
+ (let ((fill-prefix " "))
+ (insert "Noninteractive functions not known to be called:\n ")
+ (setq p (point))
+ (insert (mapconcat 'symbol-name (nreverse uncalled) ", "))
+ (fill-region-as-paragraph p (point)))))
+ )
+ (message "Generating call tree...done.")
+ ))
+
+\f
+;;; by crl@newton.purdue.edu
+;;; Only works noninteractively.
+;;;###autoload
+(defun batch-byte-compile ()
+ "Run `byte-compile-file' on the files remaining on the command line.
+Use this from the command line, with `-batch';
+it won't work in an interactive Emacs.
+Each file is processed even if an error occurred previously.
+For example, invoke \"xemacs -batch -f batch-byte-compile $emacs/ ~/*.el\""
+ ;; command-line-args-left is what is left of the command line (from
+ ;; startup.el)
+ (defvar command-line-args-left) ;Avoid 'free variable' warning
+ (if (not noninteractive)
+ (error "`batch-byte-compile' is to be used only with -batch"))
+ (let ((error nil)
+ (debug-issue-ebola-notices 0)) ; Hack -slb
+ (while command-line-args-left
+ (if (file-directory-p (expand-file-name (car command-line-args-left)))
+ (let ((files (directory-files (car command-line-args-left)))
+ source dest)
+ (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)
+ (car command-line-args-left)))
+ (setq dest (byte-compile-dest-file source))
+ (file-exists-p dest)
+ (file-newer-than-file-p source dest))
+ (if (null (batch-byte-compile-1 source))
+ (setq error t)))
+ (setq files (cdr files))))
+ (if (null (batch-byte-compile-1 (car command-line-args-left)))
+ (setq error t)))
+ (setq command-line-args-left (cdr command-line-args-left)))
+ (message "Done")
+ (kill-emacs (if error 1 0))))
+
+(defun batch-byte-compile-1 (file)
+ (condition-case err
+ (progn (byte-compile-file file) t)
+ (error
+ (princ ">>Error occurred processing ")
+ (princ file)
+ (princ ": ")
+ (if (fboundp 'display-error) ; XEmacs 19.8+
+ (display-error err nil)
+ (princ (or (get (car err) 'error-message) (car err)))
+ (mapcar '(lambda (x) (princ " ") (prin1 x)) (cdr err)))
+ (princ "\n")
+ nil)))
+
+;;;###autoload
+(defun batch-byte-recompile-directory-norecurse ()
+ "Same as `batch-byte-recompile-directory' but without recursion."
+ (setq byte-recompile-directory-recursively nil)
+ (batch-byte-recompile-directory))
+
+;;;###autoload
+(defun batch-byte-recompile-directory ()
+ "Runs `byte-recompile-directory' on the dirs remaining on the command line.
+Must be used only with `-batch', and kills Emacs on completion.
+For example, invoke `xemacs -batch -f batch-byte-recompile-directory .'."
+ ;; command-line-args-left is what is left of the command line (startup.el)
+ (defvar command-line-args-left) ;Avoid 'free variable' warning
+ (if (not noninteractive)
+ (error "batch-byte-recompile-directory is to be used only with -batch"))
+ (or command-line-args-left
+ (setq command-line-args-left '(".")))
+ (let ((byte-recompile-directory-ignore-errors-p t)
+ (debug-issue-ebola-notices 0))
+ (while command-line-args-left
+ (byte-recompile-directory (car command-line-args-left))
+ (setq command-line-args-left (cdr command-line-args-left))))
+ (kill-emacs 0))
+
+(make-obsolete 'elisp-compile-defun 'compile-defun)
+(make-obsolete 'byte-compile-report-call-tree 'display-call-tree)
+
+;; other make-obsolete calls in obsolete.el.
+
+(provide 'byte-compile)
+(provide 'bytecomp)
+
+\f
+;;; report metering (see the hacks in bytecode.c)
+
+(if (boundp 'byte-code-meter)
+ (defun byte-compile-report-ops ()
+ (defvar byte-code-meter)
+ (with-output-to-temp-buffer "*Meter*"
+ (set-buffer "*Meter*")
+ (let ((i 0) n op off)
+ (while (< i 256)
+ (setq n (aref (aref byte-code-meter 0) i)
+ off nil)
+ (if t ;(not (zerop n))
+ (progn
+ (setq op i)
+ (setq off nil)
+ (cond ((< op byte-nth)
+ (setq off (logand op 7))
+ (setq op (logand op 248)))
+ ((>= op byte-constant)
+ (setq off (- op byte-constant)
+ op byte-constant)))
+ (setq op (aref byte-code-vector op))
+ (insert (format "%-4d" i))
+ (insert (symbol-name op))
+ (if off (insert " [" (int-to-string off) "]"))
+ (indent-to 40)
+ (insert (int-to-string n) "\n")))
+ (setq i (1+ i)))))))
+
+\f
+;; To avoid "lisp nesting exceeds max-lisp-eval-depth" when bytecomp compiles
+;; itself, compile some of its most used recursive functions (at load time).
+;;
+(eval-when-compile
+ (or (compiled-function-p (symbol-function 'byte-compile-form))
+ (assq 'byte-code (symbol-function 'byte-compile-form))
+ (let ((byte-optimize nil) ; do it fast
+ (byte-compile-warnings nil))
+ (mapcar '(lambda (x)
+ (or noninteractive (message "compiling %s..." x))
+ (byte-compile x)
+ (or noninteractive (message "compiling %s...done" x)))
+ '(byte-compile-normal-call
+ byte-compile-form
+ byte-compile-body
+ ;; Inserted some more than necessary, to speed it up.
+ byte-compile-top-level
+ byte-compile-out-toplevel
+ byte-compile-constant
+ byte-compile-variable-ref))))
+ nil)
+
+;;; bytecomp.el ends here
--- /dev/null
+;;; custom-load.el --- automatically extracted custom dependencies
+
+;;; Code:
+
+(custom-add-loads 'extensions '("auto-show" "wid-edit"))
+(custom-add-loads 'info-faces '("info"))
+(custom-add-loads 'custom-buffer '("cus-edit"))
+(custom-add-loads 'custom-faces '("cus-edit"))
+(custom-add-loads 'auto-show '("auto-show"))
+(custom-add-loads 'drag-n-drop '("dragdrop"))
+(custom-add-loads 'mouse '("mouse" "mwheel"))
+(custom-add-loads 'etags '("etags"))
+(custom-add-loads 'widgets '("wid-browse" "wid-edit"))
+(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 'sound '("sound"))
+(custom-add-loads 'terminals '("gnuserv"))
+(custom-add-loads 'auto-save '("files" "auto-save"))
+(custom-add-loads 'mail '("simple"))
+(custom-add-loads 'custom-menu '("cus-edit"))
+(custom-add-loads 'docs '("hyper-apropos" "info"))
+(custom-add-loads 'tools '("etags" "hyper-apropos"))
+(custom-add-loads 'editing-basics '("cmdloop" "simple" "files" "lisp"))
+(custom-add-loads 'internal '("cus-edit"))
+(custom-add-loads 'help-appearance '("help" "help-macro"))
+(custom-add-loads 'build-report '("build-report"))
+(custom-add-loads 'buffers-menu '("menubar-items"))
+(custom-add-loads 'hypermedia '("wid-edit"))
+(custom-add-loads 'lisp '("lisp" "lisp-mode" "hyper-apropos"))
+(custom-add-loads 'applications '("cus-edit"))
+(custom-add-loads 'help '("help" "cus-edit" "hyper-apropos" "info"))
+(custom-add-loads 'keyboard '("cmdloop"))
+(custom-add-loads 'hyper-apropos-faces '("hyper-apropos"))
+(custom-add-loads 'widget-browse '("wid-browse"))
+(custom-add-loads 'data '("auto-save"))
+(custom-add-loads 'warnings '("simple"))
+(custom-add-loads 'widget-documentation '("wid-edit"))
+(custom-add-loads 'backup '("files"))
+(custom-add-loads 'frames '("frame" "window-xemacs" "gui" "gnuserv"))
+(custom-add-loads 'customize '("cus-edit" "wid-edit"))
+(custom-add-loads 'custom-browse '("cus-edit"))
+(custom-add-loads 'abbrev '("abbrev" "files"))
+(custom-add-loads 'programming '("cus-edit"))
+(custom-add-loads 'toolbar '("toolbar-items"))
+(custom-add-loads 'dired '("files"))
+(custom-add-loads 'dnd-debug '("dragdrop"))
+(custom-add-loads 'killing '("simple"))
+(custom-add-loads 'widget-button '("wid-edit"))
+(custom-add-loads 'paren-blinking '("simple"))
+(custom-add-loads 'find-file '("files"))
+(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 '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 '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"))
+(custom-add-loads 'hyper-apropos '("hyper-apropos"))
+(custom-add-loads 'wp '("cus-edit"))
+(custom-add-loads 'vc '("files"))
+(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 '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-load.el ends here
--- /dev/null
+;; dump-paths.el --- set up XEmacs paths for dumping
+
+;; Copyright (C) 1985, 1986, 1992, 1994, 1997 Free Software Foundation, Inc.
+
+;; 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, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;; This sets up the various paths for continuing loading files for
+;; dumping.
+
+(let ((debug-paths (or debug-paths
+ (and (getenv "EMACSDEBUGPATHS")
+ t)))
+ (roots (paths-find-emacs-roots invocation-directory
+ invocation-name)))
+
+ (if debug-paths
+ (princ (format "XEmacs thinks the roots of its hierarchy are:\n%S\n"
+ roots)))
+
+ (let ((stuff (packages-find-packages roots)))
+ (setq late-packages (car (cdr stuff))))
+
+ (setq late-package-load-path (packages-find-package-load-path late-packages))
+
+ (if debug-paths
+ (progn
+ (princ (format "configure-package-path:\n%S\n" configure-package-path)
+ 'external-debugging-output)
+ (princ (format "late-packages and late-package-load-path:\n%S\n%S\n"
+ late-packages late-package-load-path)
+ 'external-debugging-output)))
+
+ (setq lisp-directory (paths-find-lisp-directory roots))
+ (if debug-paths
+ (princ (format "lisp-directory:\n%S\n" lisp-directory)
+ 'external-debugging-output))
+ (setq site-directory (and (null inhibit-site-lisp)
+ (paths-find-site-lisp-directory roots)))
+ (if (and debug-paths (null inhibit-site-lisp))
+ (princ (format "site-directory:\n%S\n" site-directory)
+ 'external-debugging-output))
+
+ (setq load-path (paths-construct-load-path roots
+ '()
+ late-package-load-path
+ '()
+ lisp-directory
+ site-directory)))
+
+;;; dump-paths.el ends here
--- /dev/null
+(setq preloaded-file-list
+ (assemble-list
+ "backquote" ; needed for defsubst etc.
+ "bytecomp-runtime" ; define defsubst
+ "Installation.el"
+ "find-paths"
+ "packages" ; Bootstrap run-time lisp environment
+ "setup-paths"
+ "dump-paths"
+ "subr" ; load the most basic Lisp functions
+ "replace" ; match-string used in version.el.
+ ; Ignore compiled-by-mistake version.elc
+ "version.el"
+ "cl"
+ "cl-extra"
+ "cl-seq"
+ "widget"
+ "custom" ; Before the world so everything can be
+ ; customized
+ "cus-start" ; for customization of builtin variables
+ "cmdloop"
+ "keymap"
+ "syntax"
+ "device"
+ "console"
+ "obsolete"
+ "specifier"
+ "faces" ; must be loaded before any make-face call
+;;(pureload "facemenu") #### not yet ported
+ "glyphs"
+ "objects"
+ "extents"
+ "events"
+ "text-props"
+ "process" ;; This is bad. network-streams may not be defined.
+ (when-feature multicast "multicast") ; #+network-streams implicitely true
+ "frame" ; move up here cause some stuff needs it here
+ "map-ynp"
+ "simple"
+ "keydefs" ; Before loaddefs so that keymap vars exist.
+ "abbrev"
+ "derived"
+ "minibuf"
+ "list-mode"
+ "modeline" ; needs simple.el to be loaded first
+;; If SparcWorks support is included some additional packages are
+;; dumped which would normally have autoloads. To avoid
+;; duplicate doc string warnings, SparcWorks uses a separate
+;; autoloads file with the dumped packages removed.
+;; After fixing, eos/loaddefs-eos and loaddefs appear identical?!!
+;; So just make loaddefs-eos go away...
+;;(pureload (if (featurep 'sparcworks) "eos/loaddefs-eos" "loaddefs"))
+ "startup" ; For initialization of
+ ; `emacs-user-extension-dir'
+ "misc"
+ ;; (pureload "profile")
+ (unless-feature mule "help-nomule")
+ "help"
+ ;; (pureload "hyper-apropos") Soon...
+ (unless-feature file-coding "files-nomule")
+ "files"
+ "lib-complete"
+ "format"
+ "indent"
+ "isearch-mode"
+ "buffer"
+ "buff-menu"
+ "undo-stack"
+ "window"
+ "window-xemacs"
+ "paths.el" ; don't get confused if paths compiled.
+ "lisp"
+ "page"
+ "register"
+ "iso8859-1" ; This must be before any modes
+ ; (sets standard syntax table.)
+ "paragraphs"
+ "easymenu" ; Added for 20.3.
+ "lisp-mode"
+ "text-mode"
+ "fill"
+ "auto-save" ; Added for 20.4
+
+ (when-feature windows-nt "winnt")
+ (when-feature lisp-float-type "float-sup")
+ "itimer" ; for vars auto-save-timeout and
+ ; auto-gc-threshold
+ "itimer-autosave"
+ (when-feature toolbar "toolbar")
+ (when-feature scrollbar "scrollbar")
+ (when-feature menubar "menubar")
+ (when-feature dialog "dialog")
+ (when-feature mule "mule-charset")
+ (when-feature file-coding "coding")
+ (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")
+;; Load the remaining basic files.
+ (when-feature mule "mule-category")
+ (when-feature mule "mule-ccl")
+ (when-feature mule "mule-misc")
+ (when-feature mule "kinsoku")
+ (when-feature (and mule x) "mule-x-init")
+ (when-feature (and mule tty) "mule-tty-init")
+ (when-feature mule "mule-cmds") ; to sync with Emacs 20.1
+
+;; after this goes the specific lisp routines for a particular input system
+;; 97.2.5 JHod Shouldn't these go into a site-load file to allow site
+;; or user switching of input systems???
+;(if (featurep 'wnn)
+; (progn
+; (pureload "egg")
+; (pureload "egg-wnn")
+; (setq egg-default-startup-file "eggrc-wnn")))
+
+;; (if (and (boundp 'CANNA) CANNA)
+;; (pureload "canna")
+;; )
+
+;; Now load files to set up all the different languages/environments
+;; that Mule knows about.
+
+ (when-feature mule "arabic")
+ (when-feature mule "chinese")
+ (when-feature mule "mule-base/cyrillic") ; overloaded in leim/quail
+ (when-feature mule "english")
+;; (when-feature mule "ethiopic")
+ (when-feature mule "european")
+ (when-feature mule "mule-base/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 "viet-chars")
+;; (when-feature mule "vietnamese")
+
+ ;; Specialized language support
+ (when-feature (and mule CANNA) "canna-leim")
+;; Egg/Its is now a package
+; (when-feature (and mule wnn) "egg-leim")
+; (when-feature (and mule wnn) "egg-kwnn-leim")
+; (when-feature (and mule wnn) "egg-cwnn-leim")
+; (when-feature mule "egg-sj3-leim")
+;; SKK is now a package
+; (when-feature mule "skk-leim")
+
+;; Set up the XEmacs environment for Mule.
+;; Assumes the existence of various stuff above.
+ (when-feature mule "mule-init")
+
+;; Enable Mule capability for Gnus, mail, etc...
+;; Moved to sunpro-load.el - the default only for Sun.
+;;(pureload "mime-setup")
+;;; mule-load.el ends here
+ (when-feature window-system "gui")
+ (when-feature window-system "mode-motion")
+ (when-feature window-system "mouse")
+ (when-feature window-system "select")
+ (when-feature dragdrop-api "dragdrop")
+;; preload the X code, for faster startup.
+ (when-feature (and (not infodock)
+ (or x mswindows) menubar) "menubar-items")
+ (when-feature (and infodock (or x mswindows) menubar) "id-menus")
+ (when-feature x "x-faces")
+ (when-feature x "x-iso8859-1")
+ (when-feature x "x-mouse")
+ (when-feature x "x-select")
+ (when-feature (and x scrollbar) "x-scrollbar")
+ (when-feature x "x-misc")
+ (when-feature x "x-init")
+ (when-feature (and (not infodock)
+ window-system toolbar) "toolbar-items")
+ (when-feature x "x-win-xfree86")
+ (when-feature x "x-win-sun")
+;; preload the mswindows code.
+ (when-feature mswindows "msw-glyphs")
+ (when-feature mswindows "msw-faces")
+ (when-feature mswindows "msw-mouse")
+ (when-feature mswindows "msw-init")
+ (when-feature mswindows "msw-select")
+;; preload the TTY init code.
+ (when-feature tty "tty-init")
+;;; Formerly in tooltalk/tooltalk-load.el
+ ;; Moved to tooltalk package
+ ;; (when-feature tooltalk "tooltalk-macros")
+ ;; (when-feature tooltalk "tooltalk-util")
+ ;; (when-feature tooltalk "tooltalk-init")
+ ;; "vc-hooks" ; Packaged. Available in two versions.
+ ;; "ediff-hook" ; Packaged.
+ "fontl-hooks"
+ "auto-show"
+ (when-feature ldap "ldap")
+
+;; (when-feature energize "energize/energize-load.el")
+;;; formerly in sunpro/sunpro-load.el
+;; (when-feature (and mule sparcworks) "mime-setup")
+
+ ;; Moved to Sun package
+ ;; (when-feature sparcworks "cc-mode") ; Requires cc-mode package
+ ;; (when-feature sparcworks "sunpro-init")
+ ;; (when-feature sparcworks "ring")
+ ;; (when-feature sparcworks "comint") ; Requires comint package
+ ;; (when-feature sparcworks "annotations")
+
+;;; formerly in eos/sun-eos-load.el
+;; (when-feature sparcworks "sun-eos-init")
+;; (when-feature sparcworks "sun-eos-common")
+;; (when-feature sparcworks "sun-eos-editor")
+;; (when-feature sparcworks "sun-eos-browser")
+;; (when-feature sparcworks "sun-eos-debugger")
+;; (when-feature sparcworks "sun-eos-debugger-extra")
+;; (when-feature sparcworks "sun-eos-menubar")
+ "loadhist" ; Must be dumped before loaddefs is loaded
+ "loaddefs" ; <=== autoloads get loaded here
+))
--- /dev/null
+;;; files.el --- file input and output commands for XEmacs.
+
+;; Copyright (C) 1985-1987, 1992-1995, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1995 Sun Microsystems.
+
+;; Maintainer: XEmacs Development Team
+;; Keywords: extensions, 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, Inc. 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: FSF 20.3 (but diverging)
+;;; Warning: Merging this file is tough. Beware.
+
+;;; Commentary:
+
+;; This file is dumped with XEmacs.
+
+;; Defines most of XEmacs's file- and directory-handling functions,
+;; including basic file visiting, backup generation, link handling,
+;; ITS-id version control, load- and write-hook handling, and the like.
+
+;;; Code:
+
+;; XEmacs: Avoid compilation warnings.
+(defvar coding-system-for-read)
+(defvar buffer-file-coding-system)
+
+(defgroup files nil
+ "Support editing files."
+ :group 'emacs)
+
+(defgroup backup nil
+ "Backups of edited data files."
+ :group 'files)
+
+(defgroup find-file nil
+ "Finding and editing files."
+ :group 'files)
+
+
+;; XEmacs: In buffer.c
+;(defconst delete-auto-save-files t
+; "*Non-nil means delete auto-save file when a buffer is saved or killed.")
+
+;; FSF has automount-dir-prefix. Our directory-abbrev-alist is more general.
+;; note: tmp_mnt bogosity conversion is established in paths.el.
+(defcustom directory-abbrev-alist nil
+ "*Alist of abbreviations for file directories.
+A list of elements of the form (FROM . TO), each meaning to replace
+FROM with TO when it appears in a directory name.
+This replacement is done when setting up the default directory of a
+newly visited file. *Every* FROM string should start with \\\\` or ^.
+
+Use this feature when you have directories which you normally refer to
+via absolute symbolic links or to eliminate automounter mount points
+from the beginning of your filenames. Make TO the name of the link,
+and FROM the name it is linked to."
+ :type '(repeat (cons :format "%v"
+ :value ("\\`" . "")
+ (regexp :tag "From")
+ (regexp :tag "To")))
+ :group 'find-file)
+
+;;; Turn off backup files on VMS since it has version numbers.
+(defcustom make-backup-files (not (eq system-type 'vax-vms))
+ "*Non-nil means make a backup of a file the first time it is saved.
+This can be done by renaming the file or by copying.
+
+Renaming means that XEmacs renames the existing file so that it is a
+backup file, then writes the buffer into a new file. Any other names
+that the old file had will now refer to the backup file. The new file
+is owned by you and its group is defaulted.
+
+Copying means that XEmacs copies the existing file into the backup
+file, then writes the buffer on top of the existing file. Any other
+names that the old file had will now refer to the new (edited) file.
+The file's owner and group are unchanged.
+
+The choice of renaming or copying is controlled by the variables
+`backup-by-copying', `backup-by-copying-when-linked' and
+`backup-by-copying-when-mismatch'. See also `backup-inhibited'."
+ :type 'boolean
+ :group 'backup)
+
+;; Do this so that local variables based on the file name
+;; are not overridden by the major mode.
+(defvar backup-inhibited nil
+ "Non-nil means don't make a backup, regardless of the other parameters.
+This variable is intended for use by making it local to a buffer.
+But it is local only if you make it local.")
+(put 'backup-inhibited 'permanent-local t)
+
+(defcustom backup-by-copying nil
+ "*Non-nil means always use copying to create backup files.
+See documentation of variable `make-backup-files'."
+ :type 'boolean
+ :group 'backup)
+
+(defcustom backup-by-copying-when-linked nil
+ "*Non-nil means use copying to create backups for files with multiple names.
+This causes the alternate names to refer to the latest version as edited.
+This variable is relevant only if `backup-by-copying' is nil."
+ :type 'boolean
+ :group 'backup)
+
+(defcustom backup-by-copying-when-mismatch nil
+ "*Non-nil means create backups by copying if this preserves owner or group.
+Renaming may still be used (subject to control of other variables)
+when it would not result in changing the owner or group of the file;
+that is, for files which are owned by you and whose group matches
+the default for a new file created there by you.
+This variable is relevant only if `backup-by-copying' is nil."
+ :type 'boolean
+ :group 'backup)
+
+(defvar backup-enable-predicate
+ #'(lambda (name)
+ (not (or (null name)
+ (string-match "^/tmp/" name)
+ (let ((tmpdir (temp-directory)))
+ (and tmpdir
+ (string-match (concat "\\`" (regexp-quote tmpdir) "/")
+ tmpdir))))))
+ "Predicate that looks at a file name and decides whether to make backups.
+Called with an absolute file name as argument, it returns t to enable backup.")
+
+(defcustom buffer-offer-save nil
+ "*Non-nil in a buffer means offer to save the buffer on exit
+even if the buffer is not visiting a file.
+Automatically local in all buffers."
+ :type 'boolean
+ :group 'find-file)
+(make-variable-buffer-local 'buffer-offer-save)
+
+;; FSF uses normal defconst
+(defvaralias 'find-file-visit-truename 'find-file-use-truenames)
+(defvaralias 'find-file-existing-other-name 'find-file-compare-truenames)
+
+(defcustom revert-without-query nil
+ "*Specify which files should be reverted without query.
+The value is a list of regular expressions.
+If the file name matches one of these regular expressions,
+then `revert-buffer' reverts the file without querying
+if the file has changed on disk and you have not edited the buffer."
+ :type '(repeat (regexp ""))
+ :group 'find-file)
+
+(defvar buffer-file-number nil
+ "The device number and file number of the file visited in the current buffer.
+The value is a list of the form (FILENUM DEVNUM).
+This pair of numbers uniquely identifies the file.
+If the buffer is visiting a new file, the value is nil.")
+(make-variable-buffer-local 'buffer-file-number)
+(put 'buffer-file-number 'permanent-local t)
+
+(defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt)))
+ "Non-nil means that buffer-file-number uniquely identifies files.")
+
+(defcustom file-precious-flag nil
+ "*Non-nil means protect against I/O errors while saving files.
+Some modes set this non-nil in particular buffers.
+
+This feature works by writing the new contents into a temporary file
+and then renaming the temporary file to replace the original.
+In this way, any I/O error in writing leaves the original untouched,
+and there is never any instant where the file is nonexistent.
+
+Note that this feature forces backups to be made by copying.
+Yet, at the same time, saving a precious file
+breaks any hard links between it and other files."
+ :type 'boolean
+ :group 'backup)
+
+(defcustom version-control nil
+ "*Control use of version numbers for backup files.
+t means make numeric backup versions unconditionally.
+nil means make them for files that have some already.
+`never' means do not make them."
+ :type 'boolean
+ :group 'backup
+ :group 'vc)
+
+;; This is now defined in efs.
+;(defvar dired-kept-versions 2
+; "*When cleaning directory, number of versions to keep.")
+
+(defcustom delete-old-versions nil
+ "*If t, delete excess backup versions silently.
+If nil, ask confirmation. Any other value prevents any trimming."
+ :type '(choice (const :tag "Delete" t)
+ (const :tag "Ask" nil)
+ (sexp :tag "Leave" :format "%t\n" other))
+ :group 'backup)
+
+(defcustom kept-old-versions 2
+ "*Number of oldest versions to keep when a new numbered backup is made."
+ :type 'integer
+ :group 'backup)
+
+(defcustom kept-new-versions 2
+ "*Number of newest versions to keep when a new numbered backup is made.
+Includes the new backup. Must be > 0"
+ :type 'integer
+ :group 'backup)
+
+(defcustom require-final-newline nil
+ "*Value of t says silently ensure a file ends in a newline when it is saved.
+Non-nil but not t says ask user whether to add a newline when there isn't one.
+nil means don't add newlines."
+ :type '(choice (const :tag "Off" nil)
+ (const :tag "Add" t)
+ (sexp :tag "Ask" :format "%t\n" ask))
+ :group 'editing-basics)
+
+(defcustom auto-save-default t
+ "*Non-nil says by default do auto-saving of every file-visiting buffer."
+ :type 'boolean
+ :group 'auto-save)
+
+(defcustom auto-save-visited-file-name nil
+ "*Non-nil says auto-save a buffer in the file it is visiting, when practical.
+Normally auto-save files are written under other names."
+ :type 'boolean
+ :group 'auto-save)
+
+(defcustom save-abbrevs nil
+ "*Non-nil means save word abbrevs too when files are saved.
+Loading an abbrev file sets this to t."
+ :type 'boolean
+ :group 'abbrev)
+
+(defcustom find-file-run-dired t
+ "*Non-nil says run dired if `find-file' is given the name of a directory."
+ :type 'boolean
+ :group 'find-file)
+
+;;;It is not useful to make this a local variable.
+;;;(put 'find-file-not-found-hooks 'permanent-local t)
+(defvar find-file-not-found-hooks nil
+ "List of functions to be called for `find-file' on nonexistent file.
+These functions are called as soon as the error is detected.
+`buffer-file-name' is already set up.
+The functions are called in the order given until one of them returns non-nil.")
+
+;;;It is not useful to make this a local variable.
+;;;(put 'find-file-hooks 'permanent-local t)
+(defvar find-file-hooks nil
+ "List of functions to be called after a buffer is loaded from a file.
+The buffer's local variables (if any) will have been processed before the
+functions are called.")
+
+(defvar write-file-hooks nil
+ "List of functions to be called before writing out a buffer to a file.
+If one of them returns non-nil, the file is considered already written
+and the rest are not called.
+These hooks are considered to pertain to the visited file.
+So this list is cleared if you change the visited file name.
+See also `write-contents-hooks' and `continue-save-buffer'.")
+;;; However, in case someone does make it local...
+(put 'write-file-hooks 'permanent-local t)
+
+(defvar local-write-file-hooks nil
+ "Just like `write-file-hooks', except intended for per-buffer use.
+The functions in this list are called before the ones in
+`write-file-hooks'.
+
+This variable is meant to be used for hooks that have to do with a
+particular visited file. Therefore, it is a permanent local, so that
+changing the major mode does not clear it. However, calling
+`set-visited-file-name' does clear it.")
+(make-variable-buffer-local 'local-write-file-hooks)
+(put 'local-write-file-hooks 'permanent-local t)
+
+
+;; #### think about this (added by Sun).
+(put 'after-set-visited-file-name-hooks 'permanent-local t)
+(defvar after-set-visited-file-name-hooks nil
+ "List of functions to be called after \\[set-visited-file-name]
+or during \\[write-file].
+You can use this hook to restore local values of write-file-hooks,
+after-save-hook, and revert-buffer-function, which pertain
+to a specific file and therefore are normally killed by a rename.
+Put hooks pertaining to the buffer contents on write-contents-hooks
+and revert-buffer-insert-file-contents-function.")
+
+(defvar write-contents-hooks nil
+ "List of functions to be called before writing out a buffer to a file.
+If one of them returns non-nil, the file is considered already written
+and the rest are not called.
+These hooks are considered to pertain to the buffer's contents,
+not to the particular visited file; thus, `set-visited-file-name' does
+not clear this variable, but changing the major mode does clear it.
+See also `write-file-hooks' and `continue-save-buffer'.")
+
+;; XEmacs addition
+;; Energize needed this to hook into save-buffer at a lower level; we need
+;; to provide a new output method, but don't want to have to duplicate all
+;; of the backup file and file modes logic.that does not occur if one uses
+;; a write-file-hook which returns non-nil.
+(put 'write-file-data-hooks 'permanent-local t)
+(defvar write-file-data-hooks nil
+ "List of functions to be called to put the bytes on disk.
+These functions receive the name of the file to write to as argument.
+The default behavior is to call
+ (write-region (point-min) (point-max) filename nil t)
+If one of them returns non-nil, the file is considered already written
+and the rest are not called.
+These hooks are considered to pertain to the visited file.
+So this list is cleared if you change the visited file name.
+See also `write-file-hooks'.")
+
+(defcustom enable-local-variables t
+ "*Control use of local-variables lists in files you visit.
+The value can be t, nil or something else.
+A value of t means local-variables lists are obeyed;
+nil means they are ignored; anything else means query.
+
+The command \\[normal-mode] always obeys local-variables lists
+and ignores this variable."
+ :type '(choice (const :tag "Obey" t)
+ (const :tag "Ignore" nil)
+ (sexp :tag "Query" :format "%t\n" other))
+ :group 'find-file)
+
+(defcustom enable-local-eval 'maybe
+ "*Control processing of the \"variable\" `eval' in a file's local variables.
+The value can be t, nil or something else.
+A value of t means obey `eval' variables;
+nil means ignore them; anything else means query.
+
+The command \\[normal-mode] always obeys local-variables lists
+and ignores this variable."
+ :type '(choice (const :tag "Obey" t)
+ (const :tag "Ignore" nil)
+ (sexp :tag "Query" :format "%t\n" other))
+ :group 'find-file)
+
+;; Avoid losing in versions where CLASH_DETECTION is disabled.
+(or (fboundp 'lock-buffer)
+ (defalias 'lock-buffer 'ignore))
+(or (fboundp 'unlock-buffer)
+ (defalias 'unlock-buffer 'ignore))
+\f
+;;FSFmacs bastardized ange-ftp cruft
+;; This hook function provides support for ange-ftp host name
+;; completion. It runs the usual ange-ftp hook, but only for
+;; completion operations. Having this here avoids the need
+;; to load ange-ftp when it's not really in use.
+;(defun ange-ftp-completion-hook-function (op &rest args)
+; (if (memq op '(file-name-completion file-name-all-completions))
+; (apply 'ange-ftp-hook-function op args)
+; (let ((inhibit-file-name-handlers
+; (cons 'ange-ftp-completion-hook-function
+; (and (eq inhibit-file-name-operation op)
+; inhibit-file-name-handlers)))
+; (inhibit-file-name-operation op))
+; (apply op args))
+
+(defun convert-standard-filename (filename)
+ "Convert a standard file's name to something suitable for the current OS.
+This function's standard definition is trivial; it just returns the argument.
+However, on some systems, the function is redefined
+with a definition that really does change some file names."
+ filename)
+\f
+(defun pwd ()
+ "Show the current default directory."
+ (interactive nil)
+ (message "Directory %s" default-directory))
+
+(defvar cd-path nil
+ "Value of the CDPATH environment variable, as a list.
+Not actually set up until the first time you use it.")
+
+(defvar cdpath-previous nil
+ "Prior value of the CDPATH environment variable.")
+
+(defun parse-colon-path (cd-path)
+ "Explode a colon-separated search path into a list of directory names.
+
+If you think you want to use this, you probably don't. This function
+is provided for backward compatibility. A more robust implementation
+of the same functionality is available as `split-path', which see."
+ (and cd-path
+ (let (cd-list (cd-start 0) cd-colon)
+ (setq cd-path (concat cd-path path-separator))
+ (while (setq cd-colon (string-match path-separator cd-path cd-start))
+ (setq cd-list
+ (nconc cd-list
+ (list (if (= cd-start cd-colon)
+ nil
+ (substitute-in-file-name
+ (file-name-as-directory
+ (substring cd-path cd-start cd-colon)))))))
+ (setq cd-start (+ cd-colon 1)))
+ cd-list)))
+
+(defun cd-absolute (dir)
+ "Change current directory to given absolute file name DIR."
+ ;; Put the name into directory syntax now,
+ ;; because otherwise expand-file-name may give some bad results.
+ (if (not (eq system-type 'vax-vms))
+ (setq dir (file-name-as-directory dir)))
+ ;; XEmacs change: stig@hackvan.com
+ (if find-file-use-truenames
+ (setq dir (file-truename dir)))
+ (setq dir (abbreviate-file-name (expand-file-name dir)))
+ (cond ((not (file-directory-p dir))
+ (error "%s is not a directory" dir))
+ ;; this breaks ange-ftp, which doesn't (can't?) overload `file-executable-p'.
+ ;;((not (file-executable-p dir))
+ ;; (error "Cannot cd to %s: Permission denied" dir))
+ (t
+ (setq default-directory dir))))
+
+(defun cd (dir)
+ "Make DIR become the current buffer's default directory.
+If your environment includes a `CDPATH' variable, try each one of that
+colon-separated list of directories when resolving a relative directory name."
+ (interactive
+ ;; XEmacs change? (read-file-name => read-directory-name)
+ (list (read-directory-name "Change default directory: "
+ default-directory default-directory
+ (and (member cd-path '(nil ("./")))
+ (null (getenv "CDPATH"))))))
+ (if (file-name-absolute-p dir)
+ (cd-absolute (expand-file-name dir))
+ ;; XEmacs
+ (unless (and cd-path (equal (getenv "CDPATH") cdpath-previous))
+ ;;#### Unix-specific
+ (let ((trypath (parse-colon-path
+ (setq cdpath-previous (getenv "CDPATH")))))
+ (setq cd-path (or trypath (list "./")))))
+ (or (catch 'found
+ (mapcar #'(lambda (x)
+ (let ((f (expand-file-name (concat x dir))))
+ (if (file-directory-p f)
+ (progn
+ (cd-absolute f)
+ (throw 'found t)))))
+ cd-path)
+ nil)
+ ;; jwz: give a better error message to those of us with the
+ ;; good taste not to use a kludge like $CDPATH.
+ (if (equal cd-path '("./"))
+ (error "No such directory: %s" (expand-file-name dir))
+ (error "Directory not found in $CDPATH: %s" dir)))))
+
+(defun load-file (file)
+ "Load the Lisp file named FILE."
+ (interactive "fLoad file: ")
+ (load (expand-file-name file) nil nil t))
+
+; We now dump utils/lib-complete.el which has improved versions of this.
+;(defun load-library (library)
+; "Load the library named LIBRARY.
+;This is an interface to the function `load'."
+; (interactive "sLoad library: ")
+; (load library))
+;
+;(defun find-library (library)
+; "Find the library of Lisp code named LIBRARY.
+;This searches `load-path' for a file named either \"LIBRARY\" or \"LIBRARY.el\"."
+; (interactive "sFind library file: ")
+; (let ((f (locate-file library load-path ":.el:")))
+; (if f
+; (find-file f)
+; (error "Couldn't locate library %s" library))))
+
+(defun file-local-copy (file &optional buffer)
+ "Copy the file FILE into a temporary file on this machine.
+Returns the name of the local copy, or nil, if FILE is directly
+accessible."
+ (let ((handler (find-file-name-handler file 'file-local-copy)))
+ (if handler
+ (funcall handler 'file-local-copy file)
+ nil)))
+
+;; XEmacs change block
+; We have this in C and use the realpath() system call.
+
+;(defun file-truename (filename &optional counter prev-dirs)
+; [... lots of code snipped ...]
+; filename))
+
+;; XEmacs addition. Called from `insert-file-contents-internal'
+;; at the appropriate time.
+(defun compute-buffer-file-truename (&optional buffer)
+ "Recompute BUFFER's value of `buffer-file-truename'
+based on the current value of `buffer-file-name'.
+BUFFER defaults to the current buffer if unspecified."
+ (save-excursion
+ (set-buffer (or buffer (current-buffer)))
+ (cond ((null buffer-file-name)
+ (setq buffer-file-truename nil))
+ ((setq buffer-file-truename (file-truename buffer-file-name))
+ ;; it exists, we're done.
+ nil)
+ (t
+ ;; the file doesn't exist, but maybe the directory does.
+ (let* ((dir (file-name-directory buffer-file-name))
+ (truedir (file-truename dir)))
+ (if truedir (setq dir truedir))
+ (setq buffer-file-truename
+ (expand-file-name (file-name-nondirectory buffer-file-name)
+ dir)))))
+ (if (and find-file-use-truenames buffer-file-truename)
+ (setq buffer-file-name (abbreviate-file-name buffer-file-truename)
+ default-directory (file-name-directory buffer-file-name)))
+ buffer-file-truename))
+;; End XEmacs change block
+
+(defun file-chase-links (filename)
+ "Chase links in FILENAME until a name that is not a link.
+Does not examine containing directories for links,
+unlike `file-truename'."
+ (let (tem (count 100) (newname filename))
+ (while (setq tem (file-symlink-p newname))
+ (save-match-data
+ (if (= count 0)
+ (error "Apparent cycle of symbolic links for %s" filename))
+ ;; In the context of a link, `//' doesn't mean what XEmacs thinks.
+ (while (string-match "//+" tem)
+ (setq tem (concat (substring tem 0 (1+ (match-beginning 0)))
+ (substring tem (match-end 0)))))
+ ;; Handle `..' by hand, since it needs to work in the
+ ;; target of any directory symlink.
+ ;; This code is not quite complete; it does not handle
+ ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose.
+ (while (string-match "\\`\\.\\./" tem) ;#### Unix specific
+ (setq tem (substring tem 3))
+ (setq newname (file-name-as-directory
+ ;; Do the .. by hand.
+ (directory-file-name
+ (file-name-directory
+ ;; Chase links in the default dir of the symlink.
+ (file-chase-links
+ (directory-file-name
+ (file-name-directory newname))))))))
+ (setq newname (expand-file-name tem (file-name-directory newname)))
+ (setq count (1- count))))
+ newname))
+\f
+(defun switch-to-other-buffer (arg)
+ "Switch to the previous buffer. With a numeric arg, n, switch to the nth
+most recent buffer. With an arg of 0, buries the current buffer at the
+bottom of the buffer stack."
+ (interactive "p")
+ (if (eq arg 0)
+ (bury-buffer (current-buffer)))
+ (switch-to-buffer
+ (if (<= arg 1) (other-buffer (current-buffer))
+ (nth (1+ arg) (buffer-list)))))
+
+(defun switch-to-buffer-other-window (buffer)
+ "Select buffer BUFFER in another window."
+ (interactive "BSwitch to buffer in other window: ")
+ (let ((pop-up-windows t))
+ ;; XEmacs: this used to have (selected-frame) as the third argument,
+ ;; but this is obnoxious. If the user wants the buffer in a
+ ;; different frame, then it should be this way.
+
+ ;; Change documented above undone --mrb
+ (pop-to-buffer buffer t (selected-frame))))
+
+(defun switch-to-buffer-other-frame (buffer)
+ "Switch to buffer BUFFER in a newly-created frame."
+ (interactive "BSwitch to buffer in other frame: ")
+ (let* ((name (get-frame-name-for-buffer buffer))
+ (frame (make-frame (if name
+ (list (cons 'name (symbol-name name)))))))
+ (pop-to-buffer buffer t frame)
+ (make-frame-visible frame)
+ buffer))
+
+(defun find-file (filename &optional codesys)
+ "Edit file FILENAME.
+Switch to a buffer visiting file FILENAME,
+creating one if none already exists.
+Under XEmacs/Mule, 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."
+ (interactive "FFind file: \nZCoding system: ")
+ (if codesys
+ (let ((coding-system-for-read
+ (get-coding-system codesys)))
+ (switch-to-buffer (find-file-noselect filename)))
+ (switch-to-buffer (find-file-noselect filename))))
+
+(defun find-file-other-window (filename &optional codesys)
+ "Edit file FILENAME, in another window.
+May create a new window, or reuse an existing one.
+See the function `display-buffer'.
+Under XEmacs/Mule, 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."
+ (interactive "FFind file in other window: \nZCoding system: ")
+ (if codesys
+ (let ((coding-system-for-read
+ (get-coding-system codesys)))
+ (switch-to-buffer-other-window (find-file-noselect filename)))
+ (switch-to-buffer-other-window (find-file-noselect filename))))
+
+(defun find-file-other-frame (filename &optional codesys)
+ "Edit file FILENAME, in a newly-created frame.
+Under XEmacs/Mule, 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."
+ (interactive "FFind file in other frame: \nZCoding system: ")
+ (if codesys
+ (let ((coding-system-for-read
+ (get-coding-system codesys)))
+ (switch-to-buffer-other-frame (find-file-noselect filename)))
+ (switch-to-buffer-other-frame (find-file-noselect filename))))
+
+(defun find-file-read-only (filename &optional codesys)
+ "Edit file FILENAME but don't allow changes.
+Like \\[find-file] but marks buffer as read-only.
+Use \\[toggle-read-only] to permit editing.
+Under XEmacs/Mule, 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."
+ (interactive "fFind file read-only: \nZCoding system: ")
+ (if codesys
+ (let ((coding-system-for-read
+ (get-coding-system codesys)))
+ (find-file filename))
+ (find-file filename))
+ (setq buffer-read-only t)
+ (current-buffer))
+
+(defun find-file-read-only-other-window (filename &optional codesys)
+ "Edit file FILENAME in another window but don't allow changes.
+Like \\[find-file-other-window] but marks buffer as read-only.
+Use \\[toggle-read-only] to permit editing.
+Under XEmacs/Mule, 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."
+ (interactive "fFind file read-only other window: \nZCoding system: ")
+ (if codesys
+ (let ((coding-system-for-read
+ (get-coding-system codesys)))
+ (find-file-other-window filename))
+ (find-file-other-window filename))
+ (setq buffer-read-only t)
+ (current-buffer))
+
+(defun find-file-read-only-other-frame (filename &optional codesys)
+ "Edit file FILENAME in another frame but don't allow changes.
+Like \\[find-file-other-frame] but marks buffer as read-only.
+Use \\[toggle-read-only] to permit editing.
+Under XEmacs/Mule, 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."
+ (interactive "fFind file read-only other frame: \nZCoding system: ")
+ (if codesys
+ (let ((coding-system-for-read
+ (get-coding-system codesys)))
+ (find-file-other-frame filename))
+ (find-file-other-frame filename))
+ (setq buffer-read-only t)
+ (current-buffer))
+
+(defun find-alternate-file-other-window (filename &optional codesys)
+ "Find file FILENAME as a replacement for the file in the next window.
+This command does not select that window.
+Under XEmacs/Mule, 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."
+ (interactive
+ (save-selected-window
+ (other-window 1)
+ (let ((file buffer-file-name)
+ (file-name nil)
+ (file-dir nil))
+ (and file
+ (setq file-name (file-name-nondirectory file)
+ file-dir (file-name-directory file)))
+ (list (read-file-name
+ "Find alternate file: " file-dir nil nil file-name)
+ (if (and current-prefix-arg (featurep 'mule))
+ (read-coding-system "Coding-system: "))))))
+ (if (one-window-p)
+ (find-file-other-window filename)
+ (save-selected-window
+ (other-window 1)
+ (find-alternate-file filename codesys))))
+
+(defun find-alternate-file (filename &optional codesys)
+ "Find file FILENAME, select its buffer, kill previous buffer.
+If the current buffer now contains an empty file that you just visited
+\(presumably by mistake), use this command to visit the file you really want.
+Under XEmacs/Mule, 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."
+ (interactive
+ (let ((file buffer-file-name)
+ (file-name nil)
+ (file-dir nil))
+ (and file
+ (setq file-name (file-name-nondirectory file)
+ file-dir (file-name-directory file)))
+ (list (read-file-name
+ "Find alternate file: " file-dir nil nil file-name)
+ (if (and current-prefix-arg (featurep 'mule))
+ (read-coding-system "Coding-system: ")))))
+ (and (buffer-modified-p) (buffer-file-name)
+ ;; (not buffer-read-only)
+ (not (yes-or-no-p (format
+ "Buffer %s is modified; kill anyway? "
+ (buffer-name))))
+ (error "Aborted"))
+ (let ((obuf (current-buffer))
+ (ofile buffer-file-name)
+ (onum buffer-file-number)
+ (otrue buffer-file-truename)
+ (oname (buffer-name)))
+ (if (get-buffer " **lose**")
+ (kill-buffer " **lose**"))
+ (rename-buffer " **lose**")
+ (setq buffer-file-name nil)
+ (setq buffer-file-number nil)
+ (setq buffer-file-truename nil)
+ (unwind-protect
+ (progn
+ (unlock-buffer)
+ (if codesys
+ (let ((coding-system-for-read
+ (get-coding-system codesys)))
+ (find-file filename))
+ (find-file filename)))
+ (cond ((eq obuf (current-buffer))
+ (setq buffer-file-name ofile)
+ (setq buffer-file-number onum)
+ (setq buffer-file-truename otrue)
+ (lock-buffer)
+ (rename-buffer oname))))
+ (or (eq (current-buffer) obuf)
+ (kill-buffer obuf))))
+
+(defun create-file-buffer (filename)
+ "Create a suitably named buffer for visiting FILENAME, and return it.
+FILENAME (sans directory) is used unchanged if that name is free;
+otherwise a string <2> or <3> or ... is appended to get an unused name."
+ (let ((handler (find-file-name-handler filename 'create-file-buffer)))
+ (if handler
+ (funcall handler 'create-file-buffer filename)
+ (let ((lastname (file-name-nondirectory filename)))
+ (if (string= lastname "")
+ (setq lastname filename))
+ (generate-new-buffer lastname)))))
+
+(defun generate-new-buffer (name)
+ "Create and return a buffer with a name based on NAME.
+Choose the buffer's name using `generate-new-buffer-name'."
+ (get-buffer-create (generate-new-buffer-name name)))
+
+(defvar abbreviated-home-dir nil
+ "The user's homedir abbreviated according to `directory-abbrev-alist'.")
+
+(defun abbreviate-file-name (filename &optional hack-homedir)
+ "Return a version of FILENAME shortened using `directory-abbrev-alist'.
+See documentation of variable `directory-abbrev-alist' for more information.
+If optional argument HACK-HOMEDIR is non-nil, then this also substitutes
+\"~\" for the user's home directory."
+ (let ((handler (find-file-name-handler filename 'abbreviate-file-name)))
+ (if handler
+ (funcall handler 'abbreviate-file-name filename hack-homedir)
+ ;; Get rid of the prefixes added by the automounter.
+ ;;(if (and (string-match automount-dir-prefix filename)
+ ;; (file-exists-p (file-name-directory
+ ;; (substring filename (1- (match-end 0))))))
+ ;; (setq filename (substring filename (1- (match-end 0)))))
+ (let ((tail directory-abbrev-alist))
+ ;; If any elt of directory-abbrev-alist matches this name,
+ ;; abbreviate accordingly.
+ (while tail
+ (if (string-match (car (car tail)) filename)
+ (setq filename
+ (concat (cdr (car tail)) (substring filename (match-end 0)))))
+ (setq tail (cdr tail))))
+ (if hack-homedir
+ (progn
+ ;; 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'.
+ (or abbreviated-home-dir
+ (setq abbreviated-home-dir
+ (let ((abbreviated-home-dir "$foo"))
+ (concat "\\`" (regexp-quote (abbreviate-file-name
+ (expand-file-name "~")))
+ "\\(/\\|\\'\\)"))))
+ ;; 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 (or (eq system-type 'ms-dos)
+ (eq system-type 'windows-nt))
+ (save-match-data
+ (string-match "^[a-zA-Z]:/$" filename)))))
+ (setq filename
+ (concat "~"
+ (substring filename
+ (match-beginning 1) (match-end 1))
+ (substring filename (match-end 0)))))))
+ filename)))
+
+(defcustom find-file-not-true-dirname-list nil
+ "*List of logical names for which visiting shouldn't save the true dirname.
+On VMS, when you visit a file using a logical name that searches a path,
+you may or may not want the visited file name to record the specific
+directory where the file was found. If you *do not* want that, add the logical
+name to this list as a string."
+ :type '(repeat (string :tag "Name"))
+ :group 'find-file)
+
+;; This function is needed by FSF vc.el. I hope somebody can make it
+;; work for XEmacs. -sb.
+;; #### In what way does it not work? --hniksic
+(defun find-buffer-visiting (filename)
+ "Return the buffer visiting file FILENAME (a string).
+This is like `get-file-buffer', except that it checks for any buffer
+visiting the same file, possibly under a different name.
+If there is no such live buffer, return nil."
+ (let ((buf (get-file-buffer filename))
+ (truename (abbreviate-file-name (file-truename filename))))
+ (or buf
+ (let ((list (buffer-list)) found)
+ (while (and (not found) list)
+ (save-excursion
+ (set-buffer (car list))
+ (if (and buffer-file-name
+ (string= buffer-file-truename truename))
+ (setq found (car list))))
+ (setq list (cdr list)))
+ found)
+ (let ((number (nthcdr 10 (file-attributes truename)))
+ (list (buffer-list)) found)
+ (and buffer-file-numbers-unique
+ number
+ (while (and (not found) list)
+ (save-excursion
+ (set-buffer (car list))
+ (if (and buffer-file-number
+ (equal buffer-file-number number)
+ ;; Verify this buffer's file number
+ ;; still belongs to its file.
+ (file-exists-p buffer-file-name)
+ (equal (nthcdr 10 (file-attributes buffer-file-name))
+ number))
+ (setq found (car list))))
+ (setq list (cdr list))))
+ found))))
+
+(defun insert-file-contents-literally (filename &optional visit beg end replace)
+ "Like `insert-file-contents', q.v., but only reads in the file.
+A buffer may be modified in several ways after reading into the buffer due
+to advanced Emacs features, such as file-name-handlers, format decoding,
+find-file-hooks, etc.
+ This function ensures that none of these modifications will take place."
+ (let ((file-name-handler-alist nil)
+ (format-alist nil)
+ (after-insert-file-functions nil)
+ (find-buffer-file-type-function
+ (if (fboundp 'find-buffer-file-type)
+ (symbol-function 'find-buffer-file-type)
+ nil)))
+ (unwind-protect
+ (progn
+ (fset 'find-buffer-file-type (lambda (filename) t))
+ (insert-file-contents filename visit beg end replace))
+ (if find-buffer-file-type-function
+ (fset 'find-buffer-file-type find-buffer-file-type-function)
+ (fmakunbound 'find-buffer-file-type)))))
+
+(defun find-file-noselect (filename &optional nowarn rawfile)
+ "Read file FILENAME into a buffer and return the buffer.
+If a buffer exists visiting FILENAME, return that one, but
+verify that the file has not changed since visited or saved.
+The buffer is not selected, just returned to the caller.
+If NOWARN is non-nil, warning messages will be suppressed.
+If RAWFILE is non-nil, the file is read literally."
+ (setq filename (abbreviate-file-name (expand-file-name filename)))
+ (if (file-directory-p filename)
+ (if (and (fboundp 'dired-noselect) find-file-run-dired)
+ (dired-noselect (if find-file-use-truenames
+ (abbreviate-file-name (file-truename filename))
+ filename))
+ (error "%s is a directory" filename))
+ (let* ((buf (get-file-buffer filename))
+ (truename (abbreviate-file-name (file-truename filename)))
+ (number (nthcdr 10 (file-attributes truename)))
+; ;; Find any buffer for a file which has same truename.
+; (other (and (not buf) (find-buffer-visiting filename)))
+ (error nil))
+
+; ;; Let user know if there is a buffer with the same truename.
+; (if (and (not buf) same-truename (not nowarn))
+; (message "%s and %s are the same file (%s)"
+; filename (buffer-file-name same-truename)
+; truename)
+; (if (and (not buf) same-number (not nowarn))
+; (message "%s and %s are the same file"
+; filename (buffer-file-name same-number))))
+; ;; Optionally also find that buffer.
+; (if (or find-file-existing-other-name find-file-visit-truename)
+; (setq buf (or same-truename same-number)))
+
+ (when (and buf
+ (or find-file-compare-truenames find-file-use-truenames)
+ (not nowarn))
+ (save-excursion
+ (set-buffer buf)
+ (if (not (string-equal buffer-file-name filename))
+ (message "%s and %s are the same file (%s)"
+ filename buffer-file-name
+ buffer-file-truename))))
+
+ (if buf
+ (or nowarn
+ (verify-visited-file-modtime buf)
+ (cond ((not (file-exists-p filename))
+ (error "File %s no longer exists!" filename))
+ ;; Certain files should be reverted automatically
+ ;; if they have changed on disk and not in the buffer.
+ ((and (not (buffer-modified-p buf))
+ (dolist (rx revert-without-query nil)
+ (when (string-match rx filename)
+ (return t))))
+ (with-current-buffer buf
+ (message "Reverting file %s..." filename)
+ (revert-buffer t t)
+ (message "Reverting file %s... done" filename)))
+ ((yes-or-no-p
+ (if (string= (file-name-nondirectory filename)
+ (buffer-name buf))
+ (format
+ (if (buffer-modified-p buf)
+ (gettext "File %s changed on disk. Discard your edits? ")
+ (gettext "File %s changed on disk. Reread from disk? "))
+ (file-name-nondirectory filename))
+ (format
+ (if (buffer-modified-p buf)
+ (gettext "File %s changed on disk. Discard your edits in %s? ")
+ (gettext "File %s changed on disk. Reread from disk into %s? "))
+ (file-name-nondirectory filename)
+ (buffer-name buf))))
+ (with-current-buffer buf
+ (revert-buffer t t)))))
+ ;; Else: we must create a new buffer for filename
+ (save-excursion
+;;; The truename stuff makes this obsolete.
+;;; (let* ((link-name (car (file-attributes filename)))
+;;; (linked-buf (and (stringp link-name)
+;;; (get-file-buffer link-name))))
+;;; (if (bufferp linked-buf)
+;;; (message "Symbolic link to file in buffer %s"
+;;; (buffer-name linked-buf))))
+ (setq buf (create-file-buffer filename))
+ (set-buffer-major-mode buf)
+ (set-buffer buf)
+ (erase-buffer)
+ (if rawfile
+ (condition-case ()
+ (insert-file-contents-literally filename t)
+ (file-error
+ (when (and (file-exists-p filename)
+ (not (file-readable-p filename)))
+ (kill-buffer buf)
+ (signal 'file-error (list "File is not readable" filename)))
+ ;; Unconditionally set error
+ (setq error t)))
+ (condition-case ()
+ (insert-file-contents filename t)
+ (file-error
+ (when (and (file-exists-p filename)
+ (not (file-readable-p filename)))
+ (kill-buffer buf)
+ (signal 'file-error (list "File is not readable" filename)))
+ ;; Run find-file-not-found-hooks until one returns non-nil.
+ (or (run-hook-with-args-until-success 'find-file-not-found-hooks)
+ ;; If they fail too, set error.
+ (setq error t)))))
+ ;; Find the file's truename, and maybe use that as visited name.
+ ;; automatically computed in XEmacs, unless jka-compr was used!
+ (unless buffer-file-truename
+ (setq buffer-file-truename truename))
+ (setq buffer-file-number number)
+ ;; On VMS, we may want to remember which directory in a search list
+ ;; the file was found in.
+ (and (eq system-type 'vax-vms)
+ (let (logical)
+ (if (string-match ":" (file-name-directory filename))
+ (setq logical (substring (file-name-directory filename)
+ 0 (match-beginning 0))))
+ (not (member logical find-file-not-true-dirname-list)))
+ (setq buffer-file-name buffer-file-truename))
+ (and find-file-use-truenames
+ ;; This should be in C. Put pathname abbreviations that have
+ ;; been explicitly requested back into the pathname. Most
+ ;; importantly, strip out automounter /tmp_mnt directories so
+ ;; that auto-save will work
+ (setq buffer-file-name (abbreviate-file-name buffer-file-name)))
+ ;; Set buffer's default directory to that of the file.
+ (setq default-directory (file-name-directory buffer-file-name))
+ ;; Turn off backup files for certain file names. Since
+ ;; this is a permanent local, the major mode won't eliminate it.
+ (and (not (funcall backup-enable-predicate buffer-file-name))
+ (progn
+ (make-local-variable 'backup-inhibited)
+ (setq backup-inhibited t)))
+ (if rawfile
+ ;; #### FSF 20.3 sets buffer-file-coding-system to
+ ;; `no-conversion' here. Should we copy? It also makes
+ ;; `find-file-literally' a local variable and sets it to t.
+ nil
+ (after-find-file error (not nowarn))
+ (setq buf (current-buffer)))))
+ buf)))
+\f
+;; FSF has `insert-file-literally' and `find-file-literally' here.
+
+(defvar after-find-file-from-revert-buffer nil)
+
+(defun after-find-file (&optional error warn noauto
+ after-find-file-from-revert-buffer
+ nomodes)
+ "Called after finding a file and by the default revert function.
+Sets buffer mode, parses local variables.
+Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an
+error in reading the file. WARN non-nil means warn if there
+exists an auto-save file more recent than the visited file.
+NOAUTO means don't mess with auto-save mode.
+Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil
+ means this call was from `revert-buffer'.
+Fifth arg NOMODES non-nil means don't alter the file's modes.
+Finishes by calling the functions in `find-file-hooks'."
+ (setq buffer-read-only (not (file-writable-p buffer-file-name)))
+ (if noninteractive
+ nil
+ (let* (not-serious
+ (msg
+ (cond ((and error (file-attributes buffer-file-name))
+ (setq buffer-read-only t)
+ (gettext "File exists, but cannot be read."))
+ ((not buffer-read-only)
+ (if (and warn
+ (file-newer-than-file-p (make-auto-save-file-name)
+ buffer-file-name))
+ (format "%s has auto save data; consider M-x recover-file"
+ (file-name-nondirectory buffer-file-name))
+ (setq not-serious t)
+ (if error (gettext "(New file)") nil)))
+ ((not error)
+ (setq not-serious t)
+ (gettext "Note: file is write protected"))
+ ((file-attributes (directory-file-name default-directory))
+ (gettext "File not found and directory write-protected"))
+ ((file-exists-p (file-name-directory buffer-file-name))
+ (setq buffer-read-only nil))
+ (t
+ ;; If the directory the buffer is in doesn't exist,
+ ;; offer to create it. It's better to do this now
+ ;; than when we save the buffer, because we want
+ ;; autosaving to work.
+ (setq buffer-read-only nil)
+ ;; XEmacs
+ (or (file-exists-p (file-name-directory buffer-file-name))
+ (condition-case nil
+ (if (yes-or-no-p
+ (format
+ "\
+The directory containing %s does not exist. Create? "
+ (abbreviate-file-name buffer-file-name)))
+ (make-directory (file-name-directory
+ buffer-file-name)
+ t))
+ (quit
+ (kill-buffer (current-buffer))
+ (signal 'quit nil))))
+ nil))))
+ (if msg
+ (progn
+ (message "%s" msg)
+ (or not-serious (sit-for 1 t)))))
+ (if (and auto-save-default (not noauto))
+ (auto-save-mode t)))
+ (unless nomodes
+ (normal-mode t)
+ (run-hooks 'find-file-hooks)))
+
+(defun normal-mode (&optional find-file)
+ "Choose the major mode for this buffer automatically.
+Also sets up any specified local variables of the file.
+Uses the visited file name, the -*- line, and the local variables spec.
+
+This function is called automatically from `find-file'. In that case,
+we may set up specified local variables depending on the value of
+`enable-local-variables': if it is t, we do; if it is nil, we don't;
+otherwise, we query. `enable-local-variables' is ignored if you
+run `normal-mode' explicitly."
+ (interactive)
+ (or find-file (funcall (or default-major-mode 'fundamental-mode)))
+ (and (condition-case err
+ (progn (set-auto-mode)
+ t)
+ (error (message "File mode specification error: %s"
+ (prin1-to-string err))
+ nil))
+ (condition-case err
+ (hack-local-variables (not find-file))
+ (error (lwarn 'local-variables 'warning
+ "File local-variables error: %s"
+ (error-message-string err))))))
+
+;; #### This variable sucks in the package model. There should be a
+;; way for new packages to add their entries to auto-mode-alist in a
+;; clean way. Per Abrahamsen suggested splitting auto-mode-alist to
+;; several distinct variables such as, in order of precedence,
+;; `user-auto-mode-alist' for users, `package-auto-mode-alist' for
+;; packages and `auto-mode-alist' (which might also be called
+;; `default-auto-mode-alist') for default stuff, such as some of the
+;; entries below.
+
+(defvar auto-mode-alist
+ '(("\\.te?xt\\'" . text-mode)
+ ("\\.[ch]\\'" . c-mode)
+ ("\\.el\\'" . emacs-lisp-mode)
+ ("\\.\\([CH]\\|cc\\|hh\\)\\'" . c++-mode)
+ ("\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\'" . c++-mode)
+ ("\\.java\\'" . java-mode)
+ ("\\.idl\\'" . idl-mode)
+ ("\\.f\\(or\\)?\\'" . fortran-mode)
+ ("\\.F\\(OR\\)?\\'" . fortran-mode)
+ ("\\.[fF]90\\'" . f90-mode)
+;;; Less common extensions come here
+;;; so more common ones above are found faster.
+ ("\\.p[lm]\\'" . perl-mode)
+ ("\\.py\\'" . python-mode)
+ ("\\.texi\\(nfo\\)?\\'" . texinfo-mode)
+ ("\\.ad[abs]\\'" . ada-mode)
+ ("\\.c?l\\(i?sp\\)?\\'" . lisp-mode)
+ ("\\.p\\(as\\)?\\'" . pascal-mode)
+ ("\\.ltx\\'" . latex-mode)
+ ("\\.[sS]\\'" . asm-mode)
+ ("[Cc]hange.?[Ll]og?\\(.[0-9]+\\)?\\'" . change-log-mode)
+ ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
+ ("\\.scm?\\(?:\\.[0-9]*\\)?\\'" . scheme-mode)
+ ("\\.e\\'" . eiffel-mode)
+ ("\\.mss\\'" . scribe-mode)
+ ("\\.m\\([mes]\\|an\\)\\'" . nroff-mode)
+ ("\\.icn\\'" . icon-mode)
+ ("\\.\\([ckz]?sh\\|shar\\)\\'" . sh-mode)
+ ;; #### Unix-specific!
+ ("/\\.\\(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
+ ;; ChangeLog.1, etc. and after the .scm.[0-9] pattern too.
+ ("\\.[12345678]\\'" . nroff-mode)
+ ("\\.[tT]e[xX]\\'" . tex-mode)
+ ("\\.\\(sty\\|cls\\|bbl\\)\\'" . latex-mode)
+ ("\\.bib\\'" . bibtex-mode)
+ ("\\.article\\'" . text-mode)
+ ("\\.letter\\'" . text-mode)
+ ("\\.\\(tcl\\|exp\\)\\'" . tcl-mode)
+ ("\\.wrl\\'" . vrml-mode)
+ ("\\.awk\\'" . awk-mode)
+ ("\\.prolog\\'" . prolog-mode)
+ ("\\.tar\\'" . tar-mode)
+ ("\\.\\(arc\\|zip\\|lzh\\|zoo\\)\\'" . archive-mode)
+ ;; Mailer puts message to be edited in /tmp/Re.... or Message
+ ;; #### Unix-specific!
+ ("\\`/tmp/Re" . text-mode)
+ ("/Message[0-9]*\\'" . text-mode)
+ ("/drafts/[0-9]+\\'" . mh-letter-mode)
+ ;; some news reader is reported to use this
+ ("^/tmp/fol/" . text-mode)
+ ("\\.y\\'" . c-mode)
+ ("\\.lex\\'" . c-mode)
+ ("\\.m\\'" . objc-mode)
+ ("\\.oak\\'" . scheme-mode)
+ ("\\.s?html?\\'" . html-mode)
+ ("\\.htm?l?3\\'" . html3-mode)
+ ("\\.\\(sgml?\\|dtd\\)\\'" . sgml-mode)
+ ("\\.c?ps\\'" . postscript-mode)
+ ;; .emacs following a directory delimiter in either Unix or
+ ;; Windows syntax.
+ ("[/\\][._].*emacs\\'" . emacs-lisp-mode)
+ ("\\.m4\\'" . autoconf-mode)
+ ("configure\\.in\\'" . autoconf-mode)
+ ("\\.ml\\'" . lisp-mode)
+ ("\\.ma?k\\'" . makefile-mode)
+ ("[Mm]akefile\\(\\.\\|\\'\\)" . makefile-mode)
+ ("\\.X\\(defaults\\|environment\\|resources\\|modmap\\)\\'" . xrdb-mode)
+ ;; #### The following three are Unix-specific (but do we care?)
+ ("/app-defaults/" . xrdb-mode)
+ ("\\.[^/]*wm\\'" . winmgr-mode)
+ ("\\.[^/]*wm2?rc" . winmgr-mode)
+ ("\\.[Jj][Pp][Ee]?[Gg]\\'" . image-mode)
+ ("\\.[Pp][Nn][Gg]\\'" . image-mode)
+ ("\\.[Gg][Ii][Ff]\\'" . image-mode)
+ )
+"Alist of filename patterns vs. corresponding major mode functions.
+Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
+\(NON-NIL stands for anything that is not nil; the value does not matter.)
+Visiting a file whose name matches REGEXP specifies FUNCTION as the
+mode function to use. FUNCTION will be called, unless it is nil.
+
+If the element has the form (REGEXP FUNCTION NON-NIL), then after
+calling FUNCTION (if it's not nil), we delete the suffix that matched
+REGEXP and search the list again for another match.")
+
+(defvar interpreter-mode-alist
+ '(("^#!.*csh" . sh-mode)
+ ("^#!.*\\b\\(scope\\|wish\\|tcl\\|tclsh\\|expect\\)" . tcl-mode)
+ ("^#!.*sh\\b" . sh-mode)
+ ("perl" . perl-mode)
+ ("python" . python-mode)
+ ("awk\\b" . awk-mode)
+ ("rexx" . rexx-mode)
+ ("scm" . scheme-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
+contents of the first line. This line often contains something like:
+#!/bin/sh
+but may contain something more imaginative like
+#! /bin/env python
+or
+eval 'exec perl -w -S $0 ${1+\"$@\"}'.
+
+Each alist element looks like (INTERPRETER . MODE).
+The car of each element is a regular expression which is compared
+with the name of the interpreter specified in the first line.
+If it matches, mode MODE is selected.")
+
+(defvar inhibit-first-line-modes-regexps (purecopy '("\\.tar\\'" "\\.tgz\\'"
+ "\\.tar\\.gz\\'"))
+ "List of regexps; if one matches a file name, don't look for `-*-'.")
+
+(defvar inhibit-first-line-modes-suffixes nil
+ "List of regexps for what to ignore, for `inhibit-first-line-modes-regexps'.
+When checking `inhibit-first-line-modes-regexps', we first discard
+from the end of the file name anything that matches one of these regexps.")
+
+(defvar user-init-file
+ "" ; set by command-line
+ "File name including directory of user's initialization file.")
+
+(defun set-auto-mode (&optional just-from-file-name)
+ "Select major mode appropriate for current buffer.
+This checks for a -*- mode tag in the buffer's text,
+compares the filename against the entries in `auto-mode-alist',
+or checks the interpreter that runs this file against
+`interpreter-mode-alist'.
+
+It does not check for the `mode:' local variable in the
+Local Variables section of the file; for that, use `hack-local-variables'.
+
+If `enable-local-variables' is nil, this function does not check for a
+-*- mode tag.
+
+If the optional argument JUST-FROM-FILE-NAME is non-nil,
+then we do not set anything but the major mode,
+and we don't even do that unless it would come from the file name."
+ (save-excursion
+ ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
+ ;; Do this by calling the hack-local-variables helper to avoid redundancy.
+ ;; We bind enable-local-variables to nil this time because we're going to
+ ;; call hack-local-variables-prop-line again later, "for real." Note that
+ ;; this temporary binding does not prevent hack-local-variables-prop-line
+ ;; from setting the major mode.
+ (or (and enable-local-variables
+ (let ((enable-local-variables nil))
+ (hack-local-variables-prop-line nil))
+ )
+ ;; It's not in the -*- line, so check the auto-mode-alist, unless
+ ;; this buffer isn't associated with a file.
+ (null buffer-file-name)
+ (let ((name (file-name-sans-versions buffer-file-name))
+ (keep-going t))
+ (while keep-going
+ (setq keep-going nil)
+ (let ((alist auto-mode-alist)
+ (mode nil))
+ ;; Find first matching alist entry.
+ (let ((case-fold-search
+ (memq system-type '(vax-vms windows-nt))))
+ (while (and (not mode) alist)
+ (if (string-match (car (car alist)) name)
+ (if (and (consp (cdr (car alist)))
+ (nth 2 (car alist)))
+ (progn
+ (setq mode (car (cdr (car alist)))
+ name (substring name 0 (match-beginning 0))
+ keep-going t))
+ (setq mode (cdr (car alist))
+ keep-going nil)))
+ (setq alist (cdr alist))))
+ (unless just-from-file-name
+ ;; If we can't deduce a mode from the file name,
+ ;; look for an interpreter specified in the first line.
+ (if (and (null mode)
+ (save-excursion ; XEmacs
+ (goto-char (point-min))
+ (looking-at "#!")))
+ (let ((firstline
+ (buffer-substring
+ (point-min)
+ (save-excursion
+ (goto-char (point-min)) (end-of-line) (point)))))
+ (setq alist interpreter-mode-alist)
+ (while alist
+ (if (string-match (car (car alist)) firstline)
+ (progn
+ (setq mode (cdr (car alist)))
+ (setq alist nil))
+ (setq alist (cdr alist)))))))
+ (if mode
+ (if (not (fboundp mode))
+ (progn
+ (if (or (not (boundp 'package-get-base))
+ (not package-get-base))
+ (load "package-get-base"))
+ (require 'package-get)
+ (let ((name (package-get-package-provider mode)))
+ (if name
+ (message "Mode %s is not installed. Download package %s" mode name)
+ (message "Mode %s either doesn't exist or is not a known package" mode))
+ (sit-for 2)
+ (error "%s" mode)))
+ (unless (and just-from-file-name
+ (or
+ ;; Don't reinvoke major mode.
+ (eq mode major-mode)
+ ;; Don't lose on minor modes.
+ (assq mode minor-mode-alist)))
+ (funcall mode))))))))))
+
+(defvar hack-local-variables-hook nil
+ "Normal hook run after processing a file's local variables specs.
+Major modes can use this to examine user-specified local variables
+in order to initialize other data structure based on them.
+
+This hook runs even if there were no local variables or if their
+evaluation was suppressed. See also `enable-local-variables' and
+`enable-local-eval'.")
+
+(defun hack-local-variables (&optional force)
+ "Parse, and bind or evaluate as appropriate, any local variables
+for current buffer."
+ ;; Don't look for -*- if this file name matches any
+ ;; of the regexps in inhibit-first-line-modes-regexps.
+ (if (or (null buffer-file-name) ; don't lose if buffer has no file!
+ (not (let ((temp inhibit-first-line-modes-regexps)
+ (name (if buffer-file-name
+ (file-name-sans-versions buffer-file-name)
+ (buffer-name))))
+ (while (let ((sufs inhibit-first-line-modes-suffixes))
+ (while (and sufs (not
+ (string-match (car sufs) name)))
+ (setq sufs (cdr sufs)))
+ sufs)
+ (setq name (substring name 0 (match-beginning 0))))
+ (while (and temp
+ (not (string-match (car temp) name)))
+ (setq temp (cdr temp))
+ temp))))
+ (progn
+ ;; Look for variables in the -*- line.
+ (hack-local-variables-prop-line force)
+ ;; Look for "Local variables:" block in last page.
+ (hack-local-variables-last-page force)))
+ (run-hooks 'hack-local-variables-hook))
+
+;;; Local variables may be specified in the last page of the file (within 3k
+;;; from the end of the file and after the last ^L) in the form
+;;;
+;;; Local variables:
+;;; variable-name: variable-value
+;;; end:
+;;;
+;;; The lines may begin with a common prefix, like ";;; " in the above
+;;; example. They may also have a common suffix (" */" for example). In
+;;; this form, the local variable "mode" can be used to change the major
+;;; mode, and the local variable "eval" can be used to evaluate an arbitrary
+;;; form.
+;;;
+;;; Local variables may also be specified in the first line of the file.
+;;; Embedded in this line are a pair of "-*-" sequences. What lies between
+;;; them are variable-name/variable-value pairs, like:
+;;;
+;;; -*- mode: emacs-lisp -*-
+;;; or -*- mode: postscript; version-control: never -*-
+;;; or -*- tags-file-name: "/foo/bar/TAGS" -*-
+;;;
+;;; The local variable "eval" is not used with this form. For hysterical
+;;; reasons, the syntax "-*- modename -*-" is allowed as well.
+;;;
+
+(defun hack-local-variables-p (modeline)
+ (or (eq enable-local-variables t)
+ (and enable-local-variables
+ (save-window-excursion
+ (condition-case nil
+ (switch-to-buffer (current-buffer))
+ (error
+ ;; If we fail to switch in the selected window,
+ ;; it is probably a minibuffer.
+ ;; So try another window.
+ (condition-case nil
+ (switch-to-buffer-other-window (current-buffer))
+ (error
+ (switch-to-buffer-other-frame (current-buffer))))))
+ (or modeline (save-excursion
+ (beginning-of-line)
+ (set-window-start (selected-window) (point))))
+ (y-or-n-p (format
+ "Set local variables as specified %s of %s? "
+ (if modeline "in -*- line" "at end")
+ (if buffer-file-name
+ (file-name-nondirectory buffer-file-name)
+ (concat "buffer " (buffer-name)))))))))
+
+(defun hack-local-variables-last-page (&optional force)
+ ;; Set local variables set in the "Local Variables:" block of the last page.
+ (save-excursion
+ (goto-char (point-max))
+ (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
+ (if (let ((case-fold-search t))
+ (and (search-forward "Local Variables:" nil t)
+ (or force
+ (hack-local-variables-p nil))))
+ (let ((continue t)
+ prefix prefixlen suffix beg
+ (enable-local-eval enable-local-eval))
+ ;; The prefix is what comes before "local variables:" in its line.
+ ;; The suffix is what comes after "local variables:" in its line.
+ (skip-chars-forward " \t")
+ (or (eolp)
+ (setq suffix (buffer-substring (point)
+ (progn (end-of-line) (point)))))
+ (goto-char (match-beginning 0))
+ (or (bolp)
+ (setq prefix
+ (buffer-substring (point)
+ (progn (beginning-of-line) (point)))))
+ (if prefix (setq prefixlen (length prefix)
+ prefix (regexp-quote prefix)))
+ (if suffix (setq suffix (concat (regexp-quote suffix) "$")))
+ (while continue
+ ;; Look at next local variable spec.
+ (if selective-display (re-search-forward "[\n\C-m]")
+ (forward-line 1))
+ ;; Skip the prefix, if any.
+ (if prefix
+ (if (looking-at prefix)
+ (forward-char prefixlen)
+ (error "Local variables entry is missing the prefix")))
+ ;; Find the variable name; strip whitespace.
+ (skip-chars-forward " \t")
+ (setq beg (point))
+ (skip-chars-forward "^:\n")
+ (if (eolp) (error "Missing colon in local variables entry"))
+ (skip-chars-backward " \t")
+ (let* ((str (buffer-substring beg (point)))
+ (var (read str))
+ val)
+ ;; Setting variable named "end" means end of list.
+ (if (string-equal (downcase str) "end")
+ (setq continue nil)
+ ;; Otherwise read the variable value.
+ (skip-chars-forward "^:")
+ (forward-char 1)
+ (setq val (read (current-buffer)))
+ (skip-chars-backward "\n")
+ (skip-chars-forward " \t")
+ (or (if suffix (looking-at suffix) (eolp))
+ (error "Local variables entry is terminated incorrectly"))
+ ;; Set the variable. "Variables" mode and eval are funny.
+ (hack-one-local-variable var val))))))))
+
+;; jwz - New Version 20.1/19.15
+(defun hack-local-variables-prop-line (&optional force)
+ ;; Set local variables specified in the -*- line.
+ ;; Returns t if mode was set.
+ (let ((result nil))
+ (save-excursion
+ (goto-char (point-min))
+ (skip-chars-forward " \t\n\r")
+ (let ((end (save-excursion
+ ;; If the file begins with "#!"
+ ;; (un*x exec interpreter magic), look
+ ;; for mode frobs in the first two
+ ;; lines. You cannot necessarily
+ ;; put them in the first line of
+ ;; such a file without screwing up
+ ;; the interpreter invocation.
+ (end-of-line (and (looking-at "^#!") 2))
+ (point))))
+ ;; Parse the -*- line into the `result' alist.
+ (cond ((not (search-forward "-*-" end t))
+ ;; doesn't have one.
+ (setq force t))
+ ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
+ ;; Antiquated form: "-*- ModeName -*-".
+ (setq result
+ (list (cons 'mode
+ (intern (buffer-substring
+ (match-beginning 1)
+ (match-end 1)))))
+ ))
+ (t
+ ;; Usual form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
+ ;; (last ";" is optional).
+ (save-excursion
+ (if (search-forward "-*-" end t)
+ (setq end (- (point) 3))
+ (error "-*- not terminated before end of line")))
+ (while (< (point) end)
+ (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*")
+ (error "malformed -*- line"))
+ (goto-char (match-end 0))
+ ;; There used to be a downcase here,
+ ;; but the manual didn't say so,
+ ;; and people want to set var names that aren't all lc.
+ (let ((key (intern (buffer-substring
+ (match-beginning 1)
+ (match-end 1))))
+ (val (save-restriction
+ (narrow-to-region (point) end)
+ (read (current-buffer)))))
+ ;; Case sensitivity! Icepicks in my forehead!
+ (if (equal (downcase (symbol-name key)) "mode")
+ (setq key 'mode))
+ (setq result (cons (cons key val) result))
+ (skip-chars-forward " \t;")))
+ (setq result (nreverse result))))))
+
+ (let ((set-any-p (or force
+ ;; It's OK to force null specifications.
+ (null result)
+ ;; It's OK to force mode-only specifications.
+ (let ((remaining result)
+ (mode-specs-only t))
+ (while remaining
+ (if (eq (car (car remaining)) 'mode)
+ (setq remaining (cdr remaining))
+ ;; Otherwise, we have a real local.
+ (setq mode-specs-only nil
+ remaining nil))
+ )
+ mode-specs-only)
+ ;; Otherwise, check.
+ (hack-local-variables-p t)))
+ (mode-p nil))
+ (while result
+ (let ((key (car (car result)))
+ (val (cdr (car result))))
+ (cond ((eq key 'mode)
+ (setq mode-p t)
+ (let ((mode (intern (concat (downcase (symbol-name val))
+ "-mode"))))
+ ;; Without this guard, `normal-mode' would potentially run
+ ;; the major mode function twice: once via `set-auto-mode'
+ ;; and once via `hack-local-variables'.
+ (if (not (eq mode major-mode))
+ (funcall mode))
+ ))
+ (set-any-p
+ (hack-one-local-variable key val))
+ (t
+ nil)))
+ (setq result (cdr result)))
+ mode-p)))
+
+(defconst ignored-local-variables
+ (list 'enable-local-eval)
+ "Variables to be ignored in a file's local variable spec.")
+
+;; Get confirmation before setting these variables as locals in a file.
+(put 'debugger 'risky-local-variable t)
+(put 'enable-local-eval 'risky-local-variable t)
+(put 'ignored-local-variables 'risky-local-variable t)
+(put 'eval 'risky-local-variable t)
+(put 'file-name-handler-alist 'risky-local-variable t)
+(put 'minor-mode-map-alist 'risky-local-variable t)
+(put 'after-load-alist 'risky-local-variable t)
+(put 'buffer-file-name 'risky-local-variable t)
+(put 'buffer-auto-save-file-name 'risky-local-variable t)
+(put 'buffer-file-truename 'risky-local-variable t)
+(put 'exec-path 'risky-local-variable t)
+(put 'load-path 'risky-local-variable t)
+(put 'exec-directory 'risky-local-variable t)
+(put 'process-environment 'risky-local-variable t)
+;; Don't wait for outline.el to be loaded, for the sake of outline-minor-mode.
+(put 'outline-level 'risky-local-variable t)
+(put 'rmail-output-file-alist 'risky-local-variable t)
+
+;; This one is safe because the user gets to check it before it is used.
+(put 'compile-command 'safe-local-variable t)
+
+;(defun hack-one-local-variable-quotep (exp)
+; (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp))))
+
+;; "Set" one variable in a local variables spec.
+;; A few variable names are treated specially.
+(defun hack-one-local-variable (var val)
+ (cond ((eq var 'mode)
+ (funcall (intern (concat (downcase (symbol-name val))
+ "-mode"))))
+ ((memq var ignored-local-variables)
+ nil)
+ ;; "Setting" eval means either eval it or do nothing.
+ ;; Likewise for setting hook variables.
+ ((or (get var 'risky-local-variable)
+ (and
+ (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$"
+ (symbol-name var))
+ (not (get var 'safe-local-variable))))
+; ;; Permit evaling a put of a harmless property
+; ;; if the args do nothing tricky.
+; (if (or (and (eq var 'eval)
+; (consp val)
+; (eq (car val) 'put)
+; (hack-one-local-variable-quotep (nth 1 val))
+; (hack-one-local-variable-quotep (nth 2 val))
+; ;; Only allow safe values of lisp-indent-hook;
+; ;; not functions.
+; (or (numberp (nth 3 val))
+; (equal (nth 3 val) ''defun))
+; (memq (nth 1 (nth 2 val))
+; '(lisp-indent-hook)))
+ (if (and (not (zerop (user-uid)))
+ (or (eq enable-local-eval t)
+ (and enable-local-eval
+ (save-window-excursion
+ (switch-to-buffer (current-buffer))
+ (save-excursion
+ (beginning-of-line)
+ (set-window-start (selected-window) (point)))
+ (setq enable-local-eval
+ (y-or-n-p (format "Process `eval' or hook local variables in file %s? "
+ (file-name-nondirectory buffer-file-name))))))))
+ (if (eq var 'eval)
+ (save-excursion (eval val))
+ (make-local-variable var)
+ (set var val))
+ (message "Ignoring `eval:' in file's local variables")))
+ ;; Ordinary variable, really set it.
+ (t (make-local-variable var)
+ (set var val))))
+\f
+(defcustom change-major-mode-with-file-name t
+ "*Non-nil means \\[write-file] should set the major mode from the file name.
+However, the mode will not be changed if
+\(1) a local variables list or the `-*-' line specifies a major mode, or
+\(2) the current major mode is a \"special\" mode,
+\ not suitable for ordinary files, or
+\(3) the new file name does not particularly specify any mode."
+ :type 'boolean
+ :group 'editing-basics)
+
+(defun set-visited-file-name (filename &optional no-query along-with-file)
+ "Change name of file visited in current buffer to FILENAME.
+The next time the buffer is saved it will go in the newly specified file.
+nil or empty string as argument means make buffer not be visiting any file.
+Remember to delete the initial contents of the minibuffer
+if you wish to pass an empty string as the argument.
+
+The optional second argument NO-QUERY, if non-nil, inhibits asking for
+confirmation in the case where another buffer is already visiting FILENAME.
+
+The optional third argument ALONG-WITH-FILE, if non-nil, means that
+the old visited file has been renamed to the new name FILENAME."
+ (interactive "FSet visited file name: ")
+ (if (buffer-base-buffer)
+ (error "An indirect buffer cannot visit a file"))
+ (let (truename)
+ (if filename
+ (setq filename
+ (if (string-equal filename "")
+ nil
+ (expand-file-name filename))))
+ (if filename
+ (progn
+ (setq truename (file-truename filename))
+ ;; #### Do we need to check if truename is non-nil?
+ (if find-file-use-truenames
+ (setq filename truename))))
+ (let ((buffer (and filename (find-buffer-visiting filename))))
+ (and buffer (not (eq buffer (current-buffer)))
+ (not no-query)
+ (not (y-or-n-p (message "A buffer is visiting %s; proceed? "
+ filename)))
+ (error "Aborted")))
+ (or (equal filename buffer-file-name)
+ (progn
+ (and filename (lock-buffer filename))
+ (unlock-buffer)))
+ (setq buffer-file-name filename)
+ (if filename ; make buffer name reflect filename.
+ (let ((new-name (file-name-nondirectory buffer-file-name)))
+ (if (string= new-name "")
+ (error "Empty file name"))
+ (if (eq system-type 'vax-vms)
+ (setq new-name (downcase new-name)))
+ (setq default-directory (file-name-directory buffer-file-name))
+ (or (string= new-name (buffer-name))
+ (rename-buffer new-name t))))
+ (setq buffer-backed-up nil)
+ (or along-with-file
+ (clear-visited-file-modtime))
+ (compute-buffer-file-truename) ; insert-file-contents does this too.
+; ;; Abbreviate the file names of the buffer.
+; (if truename
+; (progn
+; (setq buffer-file-truename (abbreviate-file-name truename))
+; (if find-file-visit-truename
+; (setq buffer-file-name buffer-file-truename))))
+ (setq buffer-file-number
+ (if filename
+ (nthcdr 10 (file-attributes buffer-file-name))
+ nil)))
+ ;; write-file-hooks is normally used for things like ftp-find-file
+ ;; that visit things that are not local files as if they were files.
+ ;; Changing to visit an ordinary local file instead should flush the hook.
+ (kill-local-variable 'write-file-hooks)
+ (kill-local-variable 'after-save-hook)
+ (kill-local-variable 'local-write-file-hooks)
+ (kill-local-variable 'write-file-data-hooks)
+ (kill-local-variable 'revert-buffer-function)
+ (kill-local-variable 'backup-inhibited)
+ ;; If buffer was read-only because of version control,
+ ;; that reason is gone now, so make it writable.
+ (when (boundp 'vc-mode)
+ (if vc-mode
+ (setq buffer-read-only nil))
+ (kill-local-variable 'vc-mode))
+ ;; Turn off backup files for certain file names.
+ ;; Since this is a permanent local, the major mode won't eliminate it.
+ (and buffer-file-name
+ (not (funcall backup-enable-predicate buffer-file-name))
+ (progn
+ (make-local-variable 'backup-inhibited)
+ (setq backup-inhibited t)))
+ (let ((oauto buffer-auto-save-file-name))
+ ;; If auto-save was not already on, turn it on if appropriate.
+ (if (not buffer-auto-save-file-name)
+ (and buffer-file-name auto-save-default
+ (auto-save-mode t))
+ ;; If auto save is on, start using a new name.
+ ;; We deliberately don't rename or delete the old auto save
+ ;; for the old visited file name. This is because perhaps
+ ;; the user wants to save the new state and then compare with the
+ ;; previous state from the auto save file.
+ (setq buffer-auto-save-file-name
+ (make-auto-save-file-name)))
+ ;; Rename the old auto save file if any.
+ (and oauto buffer-auto-save-file-name
+ (file-exists-p oauto)
+ (rename-file oauto buffer-auto-save-file-name t)))
+ (if buffer-file-name
+ (not along-with-file)
+ (set-buffer-modified-p t))
+ ;; Update the major mode, if the file name determines it.
+ (condition-case nil
+ ;; Don't change the mode if it is special.
+ (or (not change-major-mode-with-file-name)
+ (get major-mode 'mode-class)
+ ;; Don't change the mode if the local variable list specifies it.
+ (hack-local-variables t)
+ (set-auto-mode t))
+ (error nil))
+ ;; #### ??
+ (run-hooks 'after-set-visited-file-name-hooks))
+
+(defun write-file (filename &optional confirm codesys)
+ "Write current buffer into file FILENAME.
+Makes buffer visit that file, and marks it not modified.
+If the buffer is already visiting a file, you can specify
+a directory name as FILENAME, to write a file of the same
+old name in that directory.
+If optional second arg CONFIRM is non-nil,
+ask for confirmation for overwriting an existing file.
+Under XEmacs/Mule, optional third argument specifies the
+coding system to use when encoding the file. Interactively,
+with a prefix argument, you will be prompted for the coding system."
+;; (interactive "FWrite file: ")
+ (interactive
+ (list (if buffer-file-name
+ (read-file-name "Write file: "
+ nil nil nil nil)
+ (read-file-name "Write file: "
+ (cdr (assq 'default-directory
+ (buffer-local-variables)))
+ nil nil (buffer-name)))
+ t
+ (if (and current-prefix-arg (featurep 'mule))
+ (read-coding-system "Coding system: "))))
+ (and (eq (current-buffer) mouse-grabbed-buffer)
+ (error "Can't write minibuffer window"))
+ (or (null filename) (string-equal filename "")
+ (progn
+ ;; If arg is just a directory,
+ ;; use same file name, but in that directory.
+ (if (and (file-directory-p filename) buffer-file-name)
+ (setq filename (concat (file-name-as-directory filename)
+ (file-name-nondirectory buffer-file-name))))
+ (and confirm
+ (file-exists-p filename)
+ (or (y-or-n-p (format "File `%s' exists; overwrite? " filename))
+ (error "Canceled")))
+ (set-visited-file-name filename)))
+ (set-buffer-modified-p t)
+ (setq buffer-read-only nil)
+ (if codesys
+ (let ((buffer-file-coding-system (get-coding-system codesys)))
+ (save-buffer))
+ (save-buffer)))
+\f
+(defun backup-buffer ()
+ "Make a backup of the disk file visited by the current buffer, if appropriate.
+This is normally done before saving the buffer the first time.
+If the value is non-nil, it is the result of `file-modes' on the original file;
+this means that the caller, after saving the buffer, should change the modes
+of the new file to agree with the old modes."
+ (if buffer-file-name
+ (let ((handler (find-file-name-handler buffer-file-name 'backup-buffer)))
+ (if handler
+ (funcall handler 'backup-buffer)
+ (if (and make-backup-files
+ (not backup-inhibited)
+ (not buffer-backed-up)
+ (file-exists-p buffer-file-name)
+ (memq (aref (elt (file-attributes buffer-file-name) 8) 0)
+ '(?- ?l)))
+ (let ((real-file-name buffer-file-name)
+ backup-info backupname targets setmodes)
+ ;; If specified name is a symbolic link, chase it to the target.
+ ;; Thus we make the backups in the directory where the real file is.
+ (setq real-file-name (file-chase-links real-file-name))
+ (setq backup-info (find-backup-file-name real-file-name)
+ backupname (car backup-info)
+ targets (cdr backup-info))
+;;; (if (file-directory-p buffer-file-name)
+;;; (error "Cannot save buffer in directory %s" buffer-file-name))
+ (if backup-info
+ (condition-case ()
+ (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.
+ (and targets
+ (or (eq delete-old-versions t)
+ (eq delete-old-versions nil))
+ (or delete-old-versions
+ (y-or-n-p (format "Delete excess backup versions of %s? "
+ real-file-name))))))
+ ;; Actually write the back up file.
+ (condition-case ()
+ (if (or file-precious-flag
+ ; (file-symlink-p buffer-file-name)
+ backup-by-copying
+ (and backup-by-copying-when-linked
+ (> (file-nlinks real-file-name) 1))
+ (and backup-by-copying-when-mismatch
+ (let ((attr (file-attributes real-file-name)))
+ (or (nth 9 attr)
+ (not (file-ownership-preserved-p real-file-name))))))
+ (condition-case ()
+ (copy-file real-file-name backupname t t)
+ (file-error
+ ;; If copying fails because file BACKUPNAME
+ ;; is not writable, delete that file and try again.
+ (if (and (file-exists-p backupname)
+ (not (file-writable-p backupname)))
+ (delete-file backupname))
+ (copy-file real-file-name backupname t t)))
+ ;; rename-file should delete old backup.
+ (rename-file real-file-name backupname t)
+ (setq setmodes (file-modes backupname)))
+ (file-error
+ ;; If trouble writing the backup, write it in ~.
+ (setq backupname (expand-file-name "~/%backup%~"))
+ (message "Cannot write backup file; backing up in ~/%%backup%%~")
+ (sleep-for 1)
+ (condition-case ()
+ (copy-file real-file-name backupname t t)
+ (file-error
+ ;; If copying fails because file BACKUPNAME
+ ;; is not writable, delete that file and try again.
+ (if (and (file-exists-p backupname)
+ (not (file-writable-p backupname)))
+ (delete-file backupname))
+ (copy-file real-file-name backupname t t)))))
+ (setq buffer-backed-up t)
+ ;; Now delete the old versions, if desired.
+ (if delete-old-versions
+ (while targets
+ (condition-case ()
+ (delete-file (car targets))
+ (file-error nil))
+ (setq targets (cdr targets))))
+ setmodes)
+ (file-error nil)))))))))
+
+(defun file-name-sans-versions (name &optional keep-backup-version)
+ "Return FILENAME sans backup versions or strings.
+This is a separate procedure so your site-init or startup file can
+redefine it.
+If the optional argument KEEP-BACKUP-VERSION is non-nil,
+we do not remove backup version numbers, only true file version numbers."
+ (let ((handler (find-file-name-handler name 'file-name-sans-versions)))
+ (if handler
+ (funcall handler 'file-name-sans-versions name keep-backup-version)
+ (substring name 0
+ (if (eq system-type 'vax-vms)
+ ;; VMS version number is (a) semicolon, optional
+ ;; sign, zero or more digits or (b) period, option
+ ;; sign, zero or more digits, provided this is the
+ ;; second period encountered outside of the
+ ;; device/directory part of the file name.
+ (or (string-match ";[-+]?[0-9]*\\'" name)
+ (if (string-match "\\.[^]>:]*\\(\\.[-+]?[0-9]*\\)\\'"
+ name)
+ (match-beginning 1))
+ (length name))
+ (if keep-backup-version
+ (length name)
+ (or (string-match "\\.~[0-9.]+~\\'" name)
+ ;; XEmacs - VC uses extensions like ".~tagname~" or ".~1.1.5.2~"
+ (let ((pos (string-match "\\.~\\([^.~ \t]+\\|[0-9.]+\\)~\\'" name)))
+ (and pos
+ ;; #### - is this filesystem check too paranoid?
+ (file-exists-p (substring name 0 pos))
+ pos))
+ (string-match "~\\'" name)
+ (length name))))))))
+
+(defun file-ownership-preserved-p (file)
+ "Return t if deleting FILE and rewriting it would preserve the owner."
+ (let ((handler (find-file-name-handler file 'file-ownership-preserved-p)))
+ (if handler
+ (funcall handler 'file-ownership-preserved-p file)
+ (let ((attributes (file-attributes file)))
+ ;; Return t if the file doesn't exist, since it's true that no
+ ;; information would be lost by an (attempted) delete and create.
+ (or (null attributes)
+ (= (nth 2 attributes) (user-uid)))))))
+
+(defun file-name-sans-extension (filename)
+ "Return FILENAME sans final \"extension\".
+The extension, in a file name, is the part that follows the last `.'."
+ (save-match-data
+ (let ((file (file-name-sans-versions (file-name-nondirectory filename)))
+ directory)
+ (if (string-match "\\.[^.]*\\'" file)
+ (if (setq directory (file-name-directory filename))
+ (expand-file-name (substring file 0 (match-beginning 0))
+ directory)
+ (substring file 0 (match-beginning 0)))
+ filename))))
+
+(defun file-name-extension (filename &optional period)
+ "Return FILENAME's final \"extension\".
+The extension, in a file name, is the part that follows the last `.'.
+Return nil for extensionless file names such as `foo'.
+Return the empty string for file names such as `foo.'.
+
+If PERIOD is non-nil, then the returned value includes the period
+that delimits the extension, and if FILENAME has no extension,
+the value is \"\"."
+ (save-match-data
+ (let ((file (file-name-sans-versions (file-name-nondirectory filename))))
+ (if (string-match "\\.[^.]*\\'" file)
+ (substring file (+ (match-beginning 0) (if period 0 1)))
+ (if period
+ "")))))
+
+(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 "~")))
+
+(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)))
+
+;; This is used in various files.
+;; The usage of bv-length is not very clean,
+;; but I can't see a good alternative,
+;; so as of now I am leaving it alone.
+(defun backup-extract-version (fn)
+ "Given the name of a numeric backup file, return the backup number.
+Uses the free variable `bv-length', whose value should be
+the index in the name where the version number begins."
+ (declare (special bv-length))
+ (if (and (string-match "[0-9]+~\\'" fn bv-length)
+ (= (match-beginning 0) bv-length))
+ (string-to-int (substring fn bv-length -1))
+ 0))
+
+;; I believe there is no need to alter this behavior for VMS;
+;; since backup files are not made on VMS, it should not get called.
+(defun find-backup-file-name (fn)
+ "Find a file name for a backup file, and suggestions for deletions.
+Value is a list whose car is the name for the backup file
+ and whose cdr is a list of old versions to consider deleting now.
+If the value is nil, don't make a backup."
+ (let ((handler (find-file-name-handler fn 'find-backup-file-name)))
+ ;; Run a handler for this function so that ange-ftp can refuse to do it.
+ (if handler
+ (funcall handler 'find-backup-file-name fn)
+ (if (eq version-control 'never)
+ (list (make-backup-file-name fn))
+ (let* ((base-versions (concat (file-name-nondirectory fn) ".~"))
+ ;; used by backup-extract-version:
+ (bv-length (length base-versions))
+ possibilities
+ (versions nil)
+ (high-water-mark 0)
+ (deserve-versions-p nil)
+ (number-to-delete 0))
+ (condition-case ()
+ (setq possibilities (file-name-all-completions
+ base-versions
+ (file-name-directory fn))
+ versions (sort (mapcar
+ #'backup-extract-version
+ possibilities)
+ '<)
+ high-water-mark (apply #'max 0 versions)
+ deserve-versions-p (or version-control
+ (> high-water-mark 0))
+ number-to-delete (- (length versions)
+ kept-old-versions kept-new-versions -1))
+ (file-error
+ (setq possibilities nil)))
+ (if (not deserve-versions-p)
+ (list (make-backup-file-name fn))
+ (cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~")
+ (if (and (> number-to-delete 0)
+ ;; Delete nothing if there is overflow
+ ;; in the number of versions to keep.
+ (>= (+ kept-new-versions kept-old-versions -1) 0))
+ (mapcar #'(lambda (n)
+ (concat fn ".~" (int-to-string n) "~"))
+ (let ((v (nthcdr kept-old-versions versions)))
+ (rplacd (nthcdr (1- number-to-delete) v) ())
+ v))))))))))
+
+(defun file-nlinks (filename)
+ "Return number of names file FILENAME has."
+ (car (cdr (file-attributes filename))))
+
+(defun file-relative-name (filename &optional directory)
+ "Convert FILENAME to be relative to DIRECTORY (default: default-directory).
+This function returns a relative file name which is equivalent to FILENAME
+when used with that default directory as the default.
+If this is impossible (which can happen on MSDOS and Windows
+when the file name and directory use different drive names)
+then it returns FILENAME."
+ (save-match-data
+ (let ((fname (expand-file-name filename)))
+ (setq directory (file-name-as-directory
+ (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 (or (eq system-type 'ms-dos)
+ (eq system-type 'windows-nt))
+ (not (string-equal (substring fname 0 2)
+ (substring directory 0 2))))
+ filename
+ (let ((ancestor ".")
+ (fname-dir (file-name-as-directory fname)))
+ (while (and (not (string-match (concat "^" (regexp-quote directory))
+ fname-dir))
+ (not (string-match (concat "^" (regexp-quote directory)) fname)))
+ (setq directory (file-name-directory (substring directory 0 -1))
+ ancestor (if (equal ancestor ".")
+ ".."
+ (concat "../" ancestor))))
+ ;; Now ancestor is empty, or .., or ../.., etc.
+ (if (string-match (concat "^" (regexp-quote directory)) fname)
+ ;; We matched within FNAME's directory part.
+ ;; Add the rest of FNAME onto ANCESTOR.
+ (let ((rest (substring fname (match-end 0))))
+ (if (and (equal ancestor ".")
+ (not (equal rest "")))
+ ;; But don't bother with ANCESTOR if it would give us `./'.
+ rest
+ (concat (file-name-as-directory ancestor) rest)))
+ ;; We matched FNAME's directory equivalent.
+ ancestor))))))
+\f
+(defun save-buffer (&optional args)
+ "Save current buffer in visited file if modified. Versions described below.
+
+By default, makes the previous version into a backup file
+ if previously requested or if this is the first save.
+With 1 or 3 \\[universal-argument]'s, marks this version
+ to become a backup when the next save is done.
+With 2 or 3 \\[universal-argument]'s,
+ unconditionally makes the previous version into a backup file.
+With argument of 0, never makes the previous version into a backup file.
+
+If a file's name is FOO, the names of its numbered backup versions are
+ FOO.~i~ for various integers i. A non-numbered backup file is called FOO~.
+Numeric backups (rather than FOO~) will be made if value of
+ `version-control' is not the atom `never' and either there are already
+ numeric versions of the file being backed up, or `version-control' is
+ non-nil.
+We don't want excessive versions piling up, so there are variables
+ `kept-old-versions', which tells XEmacs how many oldest versions to keep,
+ and `kept-new-versions', which tells how many newest versions to keep.
+ Defaults are 2 old versions and 2 new.
+`dired-kept-versions' controls dired's clean-directory (.) command.
+If `delete-old-versions' is nil, system will query user
+ before trimming versions. Otherwise it does it silently."
+ (interactive "_p")
+ (let ((modp (buffer-modified-p))
+ (large (> (buffer-size) 50000))
+ (make-backup-files (or (and make-backup-files (not (eq args 0)))
+ (memq args '(16 64)))))
+ (and modp (memq args '(16 64)) (setq buffer-backed-up nil))
+ (if (and modp large) (display-message
+ 'progress (format "Saving file %s..."
+ (buffer-file-name))))
+ (basic-save-buffer)
+ (and modp (memq args '(4 64)) (setq buffer-backed-up nil))))
+
+(defun delete-auto-save-file-if-necessary (&optional force)
+ "Delete auto-save file for current buffer if `delete-auto-save-files' is t.
+Normally delete only if the file was written by this XEmacs
+since the last real save, but optional arg FORCE non-nil means delete anyway."
+ (and buffer-auto-save-file-name delete-auto-save-files
+ (not (string= buffer-file-name buffer-auto-save-file-name))
+ (or force (recent-auto-save-p))
+ (progn
+ (condition-case ()
+ (delete-file buffer-auto-save-file-name)
+ (file-error nil))
+ (set-buffer-auto-saved))))
+
+;; XEmacs change (from Sun)
+;; used to communicate with continue-save-buffer:
+(defvar continue-save-buffer-hooks-tail nil)
+
+;; Not in FSFmacs
+(defun basic-write-file-data (realname truename)
+ ;; call the hooks until the bytes are put
+ ;; call write-region as a last resort
+ (let ((region-written nil)
+ (hooks write-file-data-hooks))
+ (while (and hooks (not region-written))
+ (setq region-written (funcall (car hooks) realname)
+ hooks (cdr hooks)))
+ (if (not region-written)
+ (write-region (point-min) (point-max) realname nil t truename))))
+
+(put 'after-save-hook 'permanent-local t)
+(defvar after-save-hook nil
+ "Normal hook that is run after a buffer is saved to its file.
+These hooks are considered to pertain to the visited file.
+So this list is cleared if you change the visited file name.")
+
+(defun files-fetch-hook-value (hook)
+ (let ((localval (symbol-value hook))
+ (globalval (default-value hook)))
+ (if (memq t localval)
+ (setq localval (append (delq t localval) (delq t globalval))))
+ localval))
+
+(defun basic-save-buffer ()
+ "Save the current buffer in its visited file, if it has been modified.
+After saving the buffer, run `after-save-hook'."
+ (interactive)
+ (save-excursion
+ ;; In an indirect buffer, save its base buffer instead.
+ (if (buffer-base-buffer)
+ (set-buffer (buffer-base-buffer)))
+ (if (buffer-modified-p)
+ (let ((recent-save (recent-auto-save-p)))
+ ;; On VMS, rename file and buffer to get rid of version number.
+ (if (and (eq system-type 'vax-vms)
+ (not (string= buffer-file-name
+ (file-name-sans-versions buffer-file-name))))
+ (let (buffer-new-name)
+ ;; Strip VMS version number before save.
+ (setq buffer-file-name
+ (file-name-sans-versions buffer-file-name))
+ ;; Construct a (unique) buffer name to correspond.
+ (let ((buf (create-file-buffer (downcase buffer-file-name))))
+ (setq buffer-new-name (buffer-name buf))
+ (kill-buffer buf))
+ (rename-buffer buffer-new-name)))
+ ;; If buffer has no file name, ask user for one.
+ (or buffer-file-name
+ (let ((filename
+ (expand-file-name
+ (read-file-name "File to save in: ") nil)))
+ (and (file-exists-p filename)
+ (or (y-or-n-p (format "File `%s' exists; overwrite? "
+ filename))
+ (error "Canceled")))
+ (set-visited-file-name filename)))
+ (or (verify-visited-file-modtime (current-buffer))
+ (not (file-exists-p buffer-file-name))
+ (yes-or-no-p
+ (format "%s has changed since visited or saved. Save anyway? "
+ (file-name-nondirectory buffer-file-name)))
+ (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)))
+ ;;
+ ;; 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
+ ;; recursively (from inside a write-file-hook) the
+ ;; after-hooks will only get run once (from the
+ ;; outermost call).
+ ;;
+ ;; Ugh, have to duplicate logic of run-hook-with-args-until-success
+ (let ((hooks (append (files-fetch-hook-value 'write-contents-hooks)
+ (files-fetch-hook-value
+ 'local-write-file-hooks)
+ (files-fetch-hook-value 'write-file-hooks)))
+ (after-save-hook nil)
+ (local-write-file-hooks nil)
+ (write-contents-hooks nil)
+ (write-file-hooks nil)
+ done)
+ (while (and hooks
+ (let ((continue-save-buffer-hooks-tail hooks))
+ (not (setq done (funcall (car hooks))))))
+ (setq hooks (cdr hooks)))
+ ;; If a hook returned t, file is already "written".
+ ;; Otherwise, write it the usual way now.
+ (if (not done)
+ (basic-save-buffer-1)))
+ ;; XEmacs: next two clauses (buffer-file-number setting and
+ ;; set-file-modes) moved into basic-save-buffer-1.
+ )
+ ;; If the auto-save file was recent before this command,
+ ;; delete it now.
+ (delete-auto-save-file-if-necessary recent-save)
+ ;; Support VC `implicit' locking.
+ (when (fboundp 'vc-after-save)
+ (vc-after-save))
+ (run-hooks 'after-save-hook))
+ (display-message 'no-log "(No changes need to be saved)"))))
+
+;; This does the "real job" of writing a buffer into its visited file
+;; and making a backup file. This is what is normally done
+;; but inhibited if one of write-file-hooks returns non-nil.
+;; It returns a value to store in setmodes.
+(defun basic-save-buffer-1 ()
+ (let (setmodes tempsetmodes)
+ (if (not (file-writable-p buffer-file-name))
+ (let ((dir (file-name-directory buffer-file-name)))
+ (if (not (file-directory-p dir))
+ (error "%s is not a directory" dir)
+ (if (not (file-exists-p buffer-file-name))
+ (error "Directory %s write-protected" dir)
+ (if (yes-or-no-p
+ (format "File %s is write-protected; try to save anyway? "
+ (file-name-nondirectory
+ buffer-file-name)))
+ (setq tempsetmodes t)
+ (error
+ "Attempt to save to a file which you aren't allowed to write"))))))
+ (or buffer-backed-up
+ (setq setmodes (backup-buffer)))
+ (let ((dir (file-name-directory buffer-file-name)))
+ (if (and file-precious-flag
+ (file-writable-p dir))
+ ;; If file is precious, write temp name, then rename it.
+ ;; This requires write access to the containing dir,
+ ;; which is why we don't try it if we don't have that access.
+ (let ((realname buffer-file-name)
+ tempname nogood i succeed
+ (old-modtime (visited-file-modtime)))
+ (setq i 0)
+ (setq nogood t)
+ ;; Find the temporary name to write under.
+ (while nogood
+ (setq tempname (format "%s#tmp#%d" dir i))
+ (setq nogood (file-exists-p tempname))
+ (setq i (1+ i)))
+ (unwind-protect
+ (progn (clear-visited-file-modtime)
+ (write-region (point-min) (point-max)
+ tempname nil realname
+ buffer-file-truename)
+ (setq succeed t))
+ ;; If writing the temp file fails,
+ ;; delete the temp file.
+ (or succeed
+ (progn
+ (delete-file tempname)
+ (set-visited-file-modtime old-modtime))))
+ ;; Since we have created an entirely new file
+ ;; and renamed it, make sure it gets the
+ ;; right permission bits set.
+ (setq setmodes (file-modes buffer-file-name))
+ ;; We succeeded in writing the temp file,
+ ;; so rename it.
+ (rename-file tempname buffer-file-name t))
+ ;; If file not writable, see if we can make it writable
+ ;; temporarily while we write it.
+ ;; But no need to do so if we have just backed it up
+ ;; (setmodes is set) because that says we're superseding.
+ (cond ((and tempsetmodes (not setmodes))
+ ;; Change the mode back, after writing.
+ (setq setmodes (file-modes buffer-file-name))
+ (set-file-modes buffer-file-name 511)))
+ (basic-write-file-data buffer-file-name buffer-file-truename)))
+ (setq buffer-file-number
+ (if buffer-file-name
+ (nth 10 (file-attributes buffer-file-name))
+ nil))
+ (if setmodes
+ (condition-case ()
+ (set-file-modes buffer-file-name setmodes)
+ (error nil)))))
+
+;; XEmacs change, from Sun
+(defun continue-save-buffer ()
+ "Provide a clean way for a write-file-hook to wrap AROUND
+the execution of the remaining hooks and writing to disk.
+Do not call this function except from a functions
+on the write-file-hooks or write-contents-hooks list.
+A hook that calls this function must return non-nil,
+to signal completion to its caller. continue-save-buffer
+always returns non-nil."
+ (let ((hooks (cdr (or continue-save-buffer-hooks-tail
+ (error
+ "continue-save-buffer called outside a write-file-hook!"))))
+ (done nil))
+ ;; Do something like this:
+ ;; (let ((write-file-hooks hooks)) (basic-save-buffer))
+ ;; First run the rest of the hooks.
+ (while (and hooks
+ (let ((continue-save-buffer-hooks-tail hooks))
+ (not (setq done (funcall (car hooks))))))
+ (setq hooks (cdr hooks)))
+ ;;
+ ;; If a hook returned t, file is already "written".
+ (if (not done)
+ (basic-save-buffer-1))
+ 'continue-save-buffer))
+
+(defcustom save-some-buffers-query-display-buffer t
+ "*Non-nil makes `\\[save-some-buffers]' switch to the buffer offered for saving."
+ :type 'boolean
+ :group 'editing-basics)
+
+(defun save-some-buffers (&optional arg exiting)
+ "Save some modified file-visiting buffers. Asks user about each one.
+Optional argument (the prefix) non-nil means save all with no questions.
+Optional second argument EXITING means ask about certain non-file buffers
+ as well as about file buffers."
+ (interactive "P")
+ (save-excursion
+ ;; `delete-other-windows' can bomb during autoloads generation, so
+ ;; guard it well.
+ (if (or noninteractive
+ (eq (selected-window) (minibuffer-window))
+ (not save-some-buffers-query-display-buffer))
+ ;; If playing with windows is unsafe or undesired, just do the
+ ;; usual drill.
+ (save-some-buffers-1 arg exiting nil)
+ ;; Else, protect the windows.
+ (when (save-window-excursion
+ (save-some-buffers-1 arg exiting t))
+ ;; Force redisplay.
+ (sit-for 0)))))
+
+;; XEmacs - do not use queried flag
+(defun save-some-buffers-1 (arg exiting switch-buffer)
+ (let* ((switched nil)
+ (files-done
+ (map-y-or-n-p
+ (lambda (buffer)
+ (and (buffer-modified-p buffer)
+ (not (buffer-base-buffer buffer))
+ ;; XEmacs addition:
+ (not (symbol-value-in-buffer 'save-buffers-skip buffer))
+ (or
+ (buffer-file-name buffer)
+ (and exiting
+ (progn
+ (set-buffer buffer)
+ (and buffer-offer-save (> (buffer-size) 0)))))
+ (if arg
+ t
+ ;; #### We should provide a per-buffer means to
+ ;; disable the switching. For instance, you might
+ ;; want to turn it off for buffers the contents of
+ ;; which is meaningless to humans, such as
+ ;; `.newsrc.eld'.
+ (when switch-buffer
+ (unless (one-window-p)
+ (delete-other-windows))
+ (setq switched t)
+ ;; #### Consider using `display-buffer' here for 21.1!
+ ;;(display-buffer buffer nil (selected-frame)))
+ (switch-to-buffer buffer t))
+ (if (buffer-file-name buffer)
+ (format "Save file %s? "
+ (buffer-file-name buffer))
+ (format "Save buffer %s? "
+ (buffer-name buffer))))))
+ (lambda (buffer)
+ (set-buffer buffer)
+ (condition-case ()
+ (save-buffer)
+ (error nil)))
+ (buffer-list)
+ '("buffer" "buffers" "save")
+ ;;instead of this we just say "yes all", "no all", etc.
+ ;;"save all the rest"
+ ;;"save only this buffer" "save no more buffers")
+ ;; this is rather bogus. --ben
+ ;; (it makes the dialog box too big, and you get an error
+ ;; "wrong type argument: framep, nil" when you hit q after
+ ;; choosing the option from the dialog box)
+
+ ;; We should fix the dialog box rather than disabling
+ ;; this! --hniksic
+ (list (list ?\C-r (lambda (buf)
+ ;; #### FSF has an EXIT-ACTION argument
+ ;; to `view-buffer'.
+ (view-buffer buf)
+ (setq view-exit-action
+ (lambda (ignore)
+ (exit-recursive-edit)))
+ (recursive-edit)
+ ;; Return nil to ask about BUF again.
+ nil)
+ "display the current buffer"))))
+ (abbrevs-done
+ (and save-abbrevs abbrevs-changed
+ (progn
+ (if (or arg
+ (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name)))
+ (write-abbrev-file nil))
+ ;; Don't keep bothering user if he says no.
+ (setq abbrevs-changed nil)
+ t))))
+ (or (> files-done 0) abbrevs-done
+ (display-message 'no-log "(No files need saving)"))
+ switched))
+
+\f
+(defun not-modified (&optional arg)
+ "Mark current buffer as unmodified, not needing to be saved.
+With prefix arg, mark buffer as modified, so \\[save-buffer] will save.
+
+It is not a good idea to use this function in Lisp programs, because it
+prints a message in the minibuffer. Instead, use `set-buffer-modified-p'."
+ (interactive "_P")
+ (if arg ;; rewritten for I18N3 snarfing
+ (display-message 'command "Modification-flag set")
+ (display-message 'command "Modification-flag cleared"))
+ (set-buffer-modified-p arg))
+
+(defun toggle-read-only (&optional arg)
+ "Toggle the current buffer's read-only status.
+With arg, set read-only iff arg is positive."
+ (interactive "_P")
+ (setq buffer-read-only
+ (if (null arg)
+ (not buffer-read-only)
+ (> (prefix-numeric-value arg) 0)))
+ ;; Force modeline redisplay
+ (redraw-modeline))
+
+(defun insert-file (filename &optional codesys)
+ "Insert contents of file FILENAME into buffer after point.
+Set mark after the inserted text.
+
+Under XEmacs/Mule, 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.
+
+This function is meant for the user to run interactively.
+Don't call it from programs! Use `insert-file-contents' instead.
+\(Its calling sequence is different; see its documentation)."
+ (interactive "*fInsert file: \nZCoding system: ")
+ (if (file-directory-p filename)
+ (signal 'file-error (list "Opening input file" "file is a directory"
+ filename)))
+ (let ((tem
+ (if codesys
+ (let ((coding-system-for-read
+ (get-coding-system codesys)))
+ (insert-file-contents filename))
+ (insert-file-contents filename))))
+ (push-mark (+ (point) (car (cdr tem))))))
+
+(defun append-to-file (start end filename &optional codesys)
+ "Append the contents of the region to the end of file FILENAME.
+When called from a function, expects three arguments,
+START, END and FILENAME. START and END are buffer positions
+saying what text to write.
+Under XEmacs/Mule, optional fourth argument specifies the
+coding system to use when encoding the file. Interactively,
+with a prefix argument, you will be prompted for the coding system."
+ (interactive "r\nFAppend to file: \nZCoding system: ")
+ (if codesys
+ (let ((buffer-file-coding-system (get-coding-system codesys)))
+ (write-region start end filename t))
+ (write-region start end filename t)))
+
+(defun file-newest-backup (filename)
+ "Return most recent backup file for FILENAME or nil if no backups exist."
+ (let* ((filename (expand-file-name filename))
+ (file (file-name-nondirectory filename))
+ (dir (file-name-directory filename))
+ (comp (file-name-all-completions file dir))
+ newest)
+ (while comp
+ (setq file (concat dir (car comp))
+ comp (cdr comp))
+ (if (and (backup-file-name-p file)
+ (or (null newest) (file-newer-than-file-p file newest)))
+ (setq newest file)))
+ newest))
+
+(defun rename-uniquely ()
+ "Rename current buffer to a similar name not already taken.
+This function is useful for creating multiple shell process buffers
+or multiple mail buffers, etc."
+ (interactive)
+ (save-match-data
+ (let* ((base-name (if (and (string-match "<[0-9]+>\\'" (buffer-name))
+ (not (and buffer-file-name
+ (string= (buffer-name)
+ (file-name-nondirectory
+ buffer-file-name)))))
+ ;; If the existing buffer name has a <NNN>,
+ ;; which isn't part of the file name (if any),
+ ;; then get rid of that.
+ (substring (buffer-name) 0 (match-beginning 0))
+ (buffer-name)))
+ (new-buf (generate-new-buffer base-name))
+ (name (buffer-name new-buf)))
+ (kill-buffer new-buf)
+ (rename-buffer name)
+ (redraw-modeline))))
+
+(defun make-directory-path (path)
+ "Create all the directories along path that don't exist yet."
+ (interactive "Fdirectory path to create: ")
+ (make-directory path t))
+
+(defun make-directory (dir &optional parents)
+ "Create the directory DIR and any nonexistent parent dirs.
+Interactively, the default choice of directory to create
+is the current default directory for file names.
+That is useful when you have visited a file in a nonexistent directory.
+
+Noninteractively, the second (optional) argument PARENTS says whether
+to create parent directories if they don't exist."
+ (interactive (list (let ((current-prefix-arg current-prefix-arg))
+ (read-directory-name "Create directory: "))
+ current-prefix-arg))
+ (let ((handler (find-file-name-handler dir 'make-directory)))
+ (if handler
+ (funcall handler 'make-directory dir parents)
+ (if (not parents)
+ (make-directory-internal dir)
+ (let ((dir (directory-file-name (expand-file-name dir)))
+ create-list)
+ (while (not (file-exists-p dir))
+ (setq create-list (cons dir create-list)
+ dir (directory-file-name (file-name-directory dir))))
+ (while create-list
+ (make-directory-internal (car create-list))
+ (setq create-list (cdr create-list))))))))
+\f
+(put 'revert-buffer-function 'permanent-local t)
+(defvar revert-buffer-function nil
+ "Function to use to revert this buffer, or nil to do the default.
+The function receives two arguments IGNORE-AUTO and NOCONFIRM,
+which are the arguments that `revert-buffer' received.")
+
+(put 'revert-buffer-insert-file-contents-function 'permanent-local t)
+(defvar revert-buffer-insert-file-contents-function nil
+ "Function to use to insert contents when reverting this buffer.
+Gets two args, first the nominal file name to use,
+and second, t if reading the auto-save file.")
+
+(defvar before-revert-hook nil
+ "Normal hook for `revert-buffer' to run before reverting.
+If `revert-buffer-function' is used to override the normal revert
+mechanism, this hook is not used.")
+
+(defvar after-revert-hook nil
+ "Normal hook for `revert-buffer' to run after reverting.
+Note that the hook value that it runs is the value that was in effect
+before reverting; that makes a difference if you have buffer-local
+hook functions.
+
+If `revert-buffer-function' is used to override the normal revert
+mechanism, this hook is not used.")
+
+(defvar revert-buffer-internal-hook nil
+ "Don't use this.")
+
+(defun revert-buffer (&optional ignore-auto noconfirm preserve-modes)
+ "Replace the buffer text with the text of the visited file on disk.
+This undoes all changes since the file was visited or saved.
+With a prefix argument, offer to revert from latest auto-save file, if
+that is more recent than the visited file.
+
+This command also works for special buffers that contain text which
+doesn't come from a file, but reflects some other data base instead:
+for example, Dired buffers and buffer-list buffers. In these cases,
+it reconstructs the buffer contents from the appropriate data base.
+
+When called from Lisp, the first argument is IGNORE-AUTO; only offer
+to revert from the auto-save file when this is nil. Note that the
+sense of this argument is the reverse of the prefix argument, for the
+sake of backward compatibility. IGNORE-AUTO is optional, defaulting
+to nil.
+
+Optional second argument NOCONFIRM means don't ask for confirmation at
+all.
+
+Optional third argument PRESERVE-MODES non-nil means don't alter
+the files modes. Normally we reinitialize them using `normal-mode'.
+
+If the value of `revert-buffer-function' is non-nil, it is called to
+do all the work for this command. Otherwise, the hooks
+`before-revert-hook' and `after-revert-hook' are run at the beginning
+and the end, and if `revert-buffer-insert-file-contents-function' is
+non-nil, it is called instead of rereading visited file contents."
+
+ ;; I admit it's odd to reverse the sense of the prefix argument, but
+ ;; there is a lot of code out there which assumes that the first
+ ;; argument should be t to avoid consulting the auto-save file, and
+ ;; there's no straightforward way to encourage authors to notice a
+ ;; reversal of the argument sense. So I'm just changing the user
+ ;; interface, but leaving the programmatic interface the same.
+ (interactive (list (not current-prefix-arg)))
+ (if revert-buffer-function
+ (funcall revert-buffer-function ignore-auto noconfirm)
+ (let* ((opoint (point))
+ (auto-save-p (and (not ignore-auto)
+ (recent-auto-save-p)
+ buffer-auto-save-file-name
+ (file-readable-p buffer-auto-save-file-name)
+ (y-or-n-p
+ "Buffer has been auto-saved recently. Revert from auto-save file? ")))
+ (file-name (if auto-save-p
+ buffer-auto-save-file-name
+ buffer-file-name)))
+ (cond ((null file-name)
+ (error "Buffer does not seem to be associated with any file"))
+ ((or noconfirm
+ (and (not (buffer-modified-p))
+ (let (found)
+ (dolist (rx revert-without-query found)
+ (when (string-match rx file-name)
+ (setq found t)))))
+ (yes-or-no-p (format "Revert buffer from file %s? "
+ file-name)))
+ (run-hooks 'before-revert-hook)
+ ;; If file was backed up but has changed since,
+ ;; we shd make another backup.
+ (and (not auto-save-p)
+ (not (verify-visited-file-modtime (current-buffer)))
+ (setq buffer-backed-up nil))
+ ;; Get rid of all undo records for this buffer.
+ (or (eq buffer-undo-list t)
+ (setq buffer-undo-list nil))
+ ;; Effectively copy the after-revert-hook status,
+ ;; since after-find-file will clobber it.
+ (let ((global-hook (default-value 'after-revert-hook))
+ (local-hook-p (local-variable-p 'after-revert-hook
+ (current-buffer)))
+ (local-hook (and (local-variable-p 'after-revert-hook
+ (current-buffer))
+ after-revert-hook)))
+ (let (buffer-read-only
+ ;; Don't make undo records for the reversion.
+ (buffer-undo-list t))
+ (if revert-buffer-insert-file-contents-function
+ (funcall revert-buffer-insert-file-contents-function
+ file-name auto-save-p)
+ (if (not (file-exists-p file-name))
+ (error "File %s no longer exists!" file-name))
+ ;; Bind buffer-file-name to nil
+ ;; so that we don't try to lock the file.
+ (let ((buffer-file-name nil))
+ (or auto-save-p
+ (unlock-buffer)))
+ (widen)
+ (insert-file-contents file-name (not auto-save-p)
+ nil nil t)))
+ (goto-char (min opoint (point-max)))
+ ;; Recompute the truename in case changes in symlinks
+ ;; have changed the truename.
+ ;XEmacs: already done by insert-file-contents
+ ;;(setq buffer-file-truename
+ ;;(abbreviate-file-name (file-truename buffer-file-name)))
+ (after-find-file nil nil t t preserve-modes)
+ ;; Run after-revert-hook as it was before we reverted.
+ (setq-default revert-buffer-internal-hook global-hook)
+ (if local-hook-p
+ (progn
+ (make-local-variable 'revert-buffer-internal-hook)
+ (setq revert-buffer-internal-hook local-hook))
+ (kill-local-variable 'revert-buffer-internal-hook))
+ (run-hooks 'revert-buffer-internal-hook))
+ t)))))
+
+(defun recover-file (file)
+ "Visit file FILE, but get contents from its last auto-save file."
+ ;; Actually putting the file name in the minibuffer should be used
+ ;; only rarely.
+ ;; Not just because users often use the default.
+ (interactive "FRecover file: ")
+ (setq file (expand-file-name file))
+ (let ((handler (or (find-file-name-handler file 'recover-file)
+ (find-file-name-handler
+ (let ((buffer-file-name file))
+ (make-auto-save-file-name))
+ 'recover-file))))
+ (if handler
+ (funcall handler 'recover-file file)
+ (if (auto-save-file-name-p file)
+ (error "%s is an auto-save file" file))
+ (let ((file-name (let ((buffer-file-name file))
+ (make-auto-save-file-name))))
+ (cond ((if (file-exists-p file)
+ (not (file-newer-than-file-p file-name file))
+ (not (file-exists-p file-name)))
+ (error "Auto-save file %s not current" file-name))
+ ((save-window-excursion
+ (if (not (eq system-type 'vax-vms))
+ (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))
+ (erase-buffer)
+ (insert-file-contents file-name nil))
+ (after-find-file nil nil t))
+ (t (error "Recover-file cancelled.")))))))
+
+(defun recover-session ()
+ "Recover auto save files from a previous Emacs session.
+This command first displays a Dired buffer showing you the
+previous sessions that you could recover from.
+To choose one, move point to the proper line and then type C-c C-c.
+Then you'll be asked about a number of files to recover."
+ (interactive)
+ (unless (fboundp 'dired)
+ (error "recover-session requires dired"))
+ (if (null auto-save-list-file-prefix)
+ (error
+ "You set `auto-save-list-file-prefix' to disable making session files"))
+ (dired (concat auto-save-list-file-prefix "*"))
+ (goto-char (point-min))
+ (or (looking-at "Move to the session you want to recover,")
+ (let ((inhibit-read-only t))
+ (insert "Move to the session you want to recover,\n"
+ "then type C-c C-c to select it.\n\n"
+ "You can also delete some of these files;\n"
+ "type d on a line to mark that file for deletion.\n\n")))
+ (use-local-map (let ((map (make-sparse-keymap)))
+ (set-keymap-parents map (list (current-local-map)))
+ map))
+ (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish))
+
+(defun recover-session-finish ()
+ "Choose one saved session to recover auto-save files from.
+This command is used in the special Dired buffer created by
+\\[recover-session]."
+ (interactive)
+ ;; Get the name of the session file to recover from.
+ (let ((file (dired-get-filename))
+ files
+ (buffer (get-buffer-create " *recover*")))
+ ;; #### dired-do-flagged-delete in FSF.
+ ;; This version is for ange-ftp
+ ;;(dired-do-deletions t)
+ ;; This version is for efs
+ (dired-expunge-deletions)
+ (unwind-protect
+ (save-excursion
+ ;; Read in the auto-save-list file.
+ (set-buffer buffer)
+ (erase-buffer)
+ (insert-file-contents file)
+ ;; Loop thru the text of that file
+ ;; and get out the names of the files to recover.
+ (while (not (eobp))
+ (let (thisfile autofile)
+ (if (eolp)
+ ;; This is a pair of lines for a non-file-visiting buffer.
+ ;; Get the auto-save file name and manufacture
+ ;; a "visited file name" from that.
+ (progn
+ (forward-line 1)
+ (setq autofile
+ (buffer-substring-no-properties
+ (point)
+ (save-excursion
+ (end-of-line)
+ (point))))
+ (setq thisfile
+ (expand-file-name
+ (substring
+ (file-name-nondirectory autofile)
+ 1 -1)
+ (file-name-directory autofile)))
+ (forward-line 1))
+ ;; This pair of lines is a file-visiting
+ ;; buffer. Use the visited file name.
+ (progn
+ (setq thisfile
+ (buffer-substring-no-properties
+ (point) (progn (end-of-line) (point))))
+ (forward-line 1)
+ (setq autofile
+ (buffer-substring-no-properties
+ (point) (progn (end-of-line) (point))))
+ (forward-line 1)))
+ ;; Ignore a file if its auto-save file does not exist now.
+ (if (file-exists-p autofile)
+ (setq files (cons thisfile files)))))
+ (setq files (nreverse files))
+ ;; The file contains a pair of line for each auto-saved buffer.
+ ;; The first line of the pair contains the visited file name
+ ;; or is empty if the buffer was not visiting a file.
+ ;; The second line is the auto-save file name.
+ (if files
+ (map-y-or-n-p "Recover %s? "
+ (lambda (file)
+ (condition-case nil
+ (save-excursion (recover-file file))
+ (error
+ "Failed to recover `%s'" file)))
+ files
+ '("file" "files" "recover"))
+ (message "No files can be recovered from this session now")))
+ (kill-buffer buffer))))
+
+(defun kill-some-buffers (&optional list)
+ "For each buffer in LIST, ask whether to kill it.
+LIST defaults to all existing live buffers."
+ (interactive)
+ (if (null list)
+ (setq list (buffer-list)))
+ (while list
+ (let* ((buffer (car list))
+ (name (buffer-name buffer)))
+ (and (not (string-equal name ""))
+ (/= (aref name 0) ?\ )
+ (yes-or-no-p
+ (format
+ (if (buffer-modified-p buffer)
+ (gettext "Buffer %s HAS BEEN EDITED. Kill? ")
+ (gettext "Buffer %s is unmodified. Kill? "))
+ name))
+ (kill-buffer buffer)))
+ (setq list (cdr list))))
+\f
+(defun auto-save-mode (arg)
+ "Toggle auto-saving of contents of current buffer.
+With prefix argument ARG, turn auto-saving on if positive, else off."
+ (interactive "P")
+ (setq buffer-auto-save-file-name
+ (and (if (null arg)
+ (or (not buffer-auto-save-file-name)
+ ;; If autosave is off because buffer has shrunk,
+ ;; then toggling should turn it on.
+ (< buffer-saved-size 0))
+ (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0))))
+ (if (and buffer-file-name auto-save-visited-file-name
+ (not buffer-read-only))
+ buffer-file-name
+ (make-auto-save-file-name))))
+ ;; If -1 was stored here, to temporarily turn off saving,
+ ;; turn it back on.
+ (and (< buffer-saved-size 0)
+ (setq buffer-saved-size 0))
+ (if (interactive-p)
+ (if buffer-auto-save-file-name ;; rewritten for I18N3 snarfing
+ (display-message 'command "Auto-save on (in this buffer)")
+ (display-message 'command "Auto-save off (in this buffer)")))
+ buffer-auto-save-file-name)
+
+(defun rename-auto-save-file ()
+ "Adjust current buffer's auto save file name for current conditions.
+Also rename any existing auto save file, if it was made in this session."
+ (let ((osave buffer-auto-save-file-name))
+ (setq buffer-auto-save-file-name
+ (make-auto-save-file-name))
+ (if (and osave buffer-auto-save-file-name
+ (not (string= buffer-auto-save-file-name buffer-file-name))
+ (not (string= buffer-auto-save-file-name osave))
+ (file-exists-p osave)
+ (recent-auto-save-p))
+ (rename-file osave buffer-auto-save-file-name t))))
+
+;; see also ../packages/auto-save.el
+(defun make-auto-save-file-name (&optional filename)
+ "Return file name to use for auto-saves of current buffer.
+Does not consider `auto-save-visited-file-name' as that variable is checked
+before calling this function. You can redefine this for customization.
+See also `auto-save-file-name-p'."
+ (let ((fname (or filename buffer-file-name))
+ name)
+ (setq name
+ (if fname
+ (concat (file-name-directory fname)
+ "#"
+ (file-name-nondirectory fname)
+ "#")
+
+ ;; Deal with buffers that don't have any associated files. (Mail
+ ;; mode tends to create a good number of these.)
+
+ (let ((buffer-name (buffer-name))
+ (limit 0))
+ ;; Use technique from Sebastian Kremer's auto-save
+ ;; package to turn slashes into \\!. This ensures that
+ ;; the auto-save buffer name is unique.
+
+ ;; #### - yuck! yuck! yuck! move this functionality
+ ;; somewhere else and make the name translation customizable.
+ ;; Using "\!" as part of a filename on a UNIX filesystem is nearly
+ ;; IMPOSSIBLE to get past a shell parser. -stig
+
+ (while (string-match "[/\\]" buffer-name limit)
+ (setq buffer-name
+ (concat (substring buffer-name 0 (match-beginning 0))
+ (if (string= (substring buffer-name
+ (match-beginning 0)
+ (match-end 0))
+ "/")
+ "\\!"
+ "\\\\")
+ (substring buffer-name (match-end 0))))
+ (setq limit (1+ (match-end 0))))
+
+ ;; (expand-file-name (format "#%s#%s#" (buffer-name) (make-temp-name "")))
+
+ ;; jwz: putting the emacs PID in the auto-save file name
+ ;; is bad news, because that defeats auto-save-recovery of
+ ;; *mail* buffers -- the (sensible) code in sendmail.el
+ ;; calls (make-auto-save-file-name) to determine whether
+ ;; there is unsent, auto-saved mail to recover. If that
+ ;; mail came from a previous emacs process (far and away
+ ;; the most likely case) then this can never succeed as
+ ;; the pid differs.
+
+ (expand-file-name (format "#%s#" buffer-name)))
+ ))
+ ;; don't try to write auto-save files in unwritable places. Unless
+ ;; there's already an autosave file here, put ours somewhere safe. --Stig
+ (if (or (file-writable-p name)
+ (file-exists-p name))
+ name
+ (expand-file-name (concat "~/" (file-name-nondirectory name))))))
+
+(defun auto-save-file-name-p (filename)
+ "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'.
+FILENAME should lack slashes.
+You can redefine this for customization."
+ (string-match "\\`#.*#\\'" filename))
+\f
+(defun wildcard-to-regexp (wildcard)
+ "Given a shell file name pattern WILDCARD, return an equivalent regexp.
+The generated regexp will match a filename iff the filename
+matches that wildcard according to shell rules. Only wildcards known
+by `sh' are supported."
+ (let* ((i (string-match "[[.*+\\^$?]" wildcard))
+ ;; Copy the initial run of non-special characters.
+ (result (substring wildcard 0 i))
+ (len (length wildcard)))
+ ;; If no special characters, we're almost done.
+ (if i
+ (while (< i len)
+ (let ((ch (aref wildcard i))
+ j)
+ (setq
+ result
+ (concat result
+ (cond
+ ((eq ch ?\[) ; [...] maps to regexp char class
+ (progn
+ (setq i (1+ i))
+ (concat
+ (cond
+ ((eq (aref wildcard i) ?!) ; [!...] -> [^...]
+ (progn
+ (setq i (1+ i))
+ (if (eq (aref wildcard i) ?\])
+ (progn
+ (setq i (1+ i))
+ "[^]")
+ "[^")))
+ ((eq (aref wildcard i) ?^)
+ ;; Found "[^". Insert a `\0' character
+ ;; (which cannot happen in a filename)
+ ;; into the character class, so that `^'
+ ;; is not the first character after `[',
+ ;; and thus non-special in a regexp.
+ (progn
+ (setq i (1+ i))
+ "[\000^"))
+ ((eq (aref wildcard i) ?\])
+ ;; I don't think `]' can appear in a
+ ;; character class in a wildcard, but
+ ;; let's be general here.
+ (progn
+ (setq i (1+ i))
+ "[]"))
+ (t "["))
+ (prog1 ; copy everything upto next `]'.
+ (substring wildcard
+ i
+ (setq j (string-match
+ "]" wildcard i)))
+ (setq i (if j (1- j) (1- len)))))))
+ ((eq ch ?.) "\\.")
+ ((eq ch ?*) "[^\000]*")
+ ((eq ch ?+) "\\+")
+ ((eq ch ?^) "\\^")
+ ((eq ch ?$) "\\$")
+ ((eq ch ?\\) "\\\\") ; probably cannot happen...
+ ((eq ch ??) "[^\000]")
+ (t (char-to-string ch)))))
+ (setq i (1+ i)))))
+ ;; Shell wildcards should match the entire filename,
+ ;; not its part. Make the regexp say so.
+ (concat "\\`" result "\\'")))
+\f
+(defcustom list-directory-brief-switches
+ (if (eq system-type 'vax-vms) "" "-CF")
+ "*Switches for list-directory to pass to `ls' for brief listing."
+ :type 'string
+ :group 'dired)
+
+(defcustom list-directory-verbose-switches
+ (if (eq system-type 'vax-vms)
+ "/PROTECTION/SIZE/DATE/OWNER/WIDTH=(OWNER:10)"
+ "-l")
+ "*Switches for list-directory to pass to `ls' for verbose listing,"
+ :type 'string
+ :group 'dired)
+
+(defun list-directory (dirname &optional verbose)
+ "Display a list of files in or matching DIRNAME, a la `ls'.
+DIRNAME is globbed by the shell if necessary.
+Prefix arg (second arg if noninteractive) means supply -l switch to `ls'.
+Actions controlled by variables `list-directory-brief-switches'
+and `list-directory-verbose-switches'."
+ (interactive (let ((pfx current-prefix-arg))
+ (list (read-file-name (if pfx (gettext "List directory (verbose): ")
+ (gettext "List directory (brief): "))
+ nil default-directory nil)
+ pfx)))
+ (let ((switches (if verbose list-directory-verbose-switches
+ list-directory-brief-switches)))
+ (or dirname (setq dirname default-directory))
+ (setq dirname (expand-file-name dirname))
+ (with-output-to-temp-buffer "*Directory*"
+ (buffer-disable-undo standard-output)
+ (princ "Directory ")
+ (princ dirname)
+ (terpri)
+ (save-excursion
+ (set-buffer "*Directory*")
+ (setq default-directory (file-name-directory dirname))
+ (let ((wildcard (not (file-directory-p dirname))))
+ (insert-directory dirname switches wildcard (not wildcard)))))))
+
+(defvar insert-directory-program "ls"
+ "Absolute or relative name of the `ls' program used by `insert-directory'.")
+
+;; insert-directory
+;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
+;; FULL-DIRECTORY-P is nil.
+;; The single line of output must display FILE's name as it was
+;; given, namely, an absolute path name.
+;; - must insert exactly one line for each file if WILDCARD or
+;; FULL-DIRECTORY-P is t, plus one optional "total" line
+;; before the file lines, plus optional text after the file lines.
+;; Lines are delimited by "\n", so filenames containing "\n" are not
+;; allowed.
+;; File lines should display the basename.
+;; - must be consistent with
+;; - functions dired-move-to-filename, (these two define what a file line is)
+;; dired-move-to-end-of-filename,
+;; dired-between-files, (shortcut for (not (dired-move-to-filename)))
+;; dired-insert-headerline
+;; dired-after-subdir-garbage (defines what a "total" line is)
+;; - variable dired-subdir-regexp
+(defun insert-directory (file switches &optional wildcard full-directory-p)
+ "Insert directory listing for FILE, formatted according to SWITCHES.
+Leaves point after the inserted text.
+SWITCHES may be a string of options, or a list of strings.
+Optional third arg WILDCARD means treat FILE as shell wildcard.
+Optional fourth arg FULL-DIRECTORY-P means file is a directory and
+switches do not contain `d', so that a full listing is expected.
+
+This works by running a directory listing program
+whose name is in the variable `insert-directory-program'.
+If WILDCARD, it also runs the shell specified by `shell-file-name'."
+ ;; We need the directory in order to find the right handler.
+ (let ((handler (find-file-name-handler (expand-file-name file)
+ 'insert-directory)))
+ (if handler
+ (funcall handler 'insert-directory file switches
+ wildcard full-directory-p)
+ (cond
+ ((eq system-type 'vax-vms)
+ (vms-read-directory file switches (current-buffer)))
+ ((and (fboundp 'mswindows-insert-directory)
+ (eq system-type 'windows-nt))
+ (mswindows-insert-directory file switches wildcard full-directory-p))
+ (t
+ (if wildcard
+ ;; Run ls in the directory of the file pattern we asked for.
+ (let ((default-directory
+ (if (file-name-absolute-p file)
+ (file-name-directory file)
+ (file-name-directory (expand-file-name file))))
+ (pattern (file-name-nondirectory file))
+ (beg 0))
+ ;; Quote some characters that have special meanings in shells;
+ ;; but don't quote the wildcards--we want them to be special.
+ ;; We also currently don't quote the quoting characters
+ ;; in case people want to use them explicitly to quote
+ ;; wildcard characters.
+ ;;#### Unix-specific
+ (while (string-match "[ \t\n;<>&|()#$]" pattern beg)
+ (setq pattern
+ (concat (substring pattern 0 (match-beginning 0))
+ "\\"
+ (substring pattern (match-beginning 0)))
+ beg (1+ (match-end 0))))
+ (call-process shell-file-name nil t nil
+ "-c" (concat "\\" ;; Disregard shell aliases!
+ insert-directory-program
+ " -d "
+ (if (stringp switches)
+ switches
+ (mapconcat 'identity switches " "))
+ " "
+ pattern)))
+ ;; SunOS 4.1.3, SVr4 and others need the "." to list the
+ ;; directory if FILE is a symbolic link.
+ (apply 'call-process
+ insert-directory-program nil t nil
+ (let (list)
+ (if (listp switches)
+ (setq list switches)
+ (if (not (equal switches ""))
+ (progn
+ ;; Split the switches at any spaces
+ ;; so we can pass separate options as separate args.
+ (while (string-match " " switches)
+ (setq list (cons (substring switches 0 (match-beginning 0))
+ list)
+ switches (substring switches (match-end 0))))
+ (setq list (cons switches list)))))
+ (append list
+ (list
+ (if full-directory-p
+ (concat (file-name-as-directory file)
+ ;;#### Unix-specific
+ ".")
+ file)))))))))))
+
+(defvar kill-emacs-query-functions nil
+ "Functions to call with no arguments to query about killing XEmacs.
+If any of these functions returns nil, killing Emacs is cancelled.
+`save-buffers-kill-emacs' (\\[save-buffers-kill-emacs]) calls these functions,
+but `kill-emacs', the low level primitive, does not.
+See also `kill-emacs-hook'.")
+
+(defun save-buffers-kill-emacs (&optional arg)
+ "Offer to save each buffer, then kill this XEmacs process.
+With prefix arg, silently save all file-visiting buffers, then kill."
+ (interactive "P")
+ (save-some-buffers arg t)
+ (and (or (not (memq t (mapcar #'(lambda (buf) (and (buffer-file-name buf)
+ (buffer-modified-p buf)))
+ (buffer-list))))
+ (yes-or-no-p "Modified buffers exist; exit anyway? "))
+ (or (not (fboundp 'process-list))
+ ;; process-list is not defined on VMS.
+ (let ((processes (process-list))
+ active)
+ (while processes
+ (and (memq (process-status (car processes)) '(run stop open))
+ (let ((val (process-kill-without-query (car processes))))
+ (process-kill-without-query (car processes) val)
+ val)
+ (setq active t))
+ (setq processes (cdr processes)))
+ (or
+ (not active)
+ (save-excursion
+ (save-window-excursion
+ (delete-other-windows)
+ (list-processes)
+ (yes-or-no-p
+ "Active processes exist; kill them and exit anyway? "))))))
+ ;; Query the user for other things, perhaps.
+ (run-hook-with-args-until-failure 'kill-emacs-query-functions)
+ (kill-emacs)))
+
+(defun symlink-expand-file-name (filename)
+ "If FILENAME is a symlink, return its non-symlink equivalent.
+Unlike `file-truename', this doesn't chase symlinks in directory
+components of the file or expand a relative pathname into an
+absolute one."
+ (let ((count 20))
+ (while (and (> count 0) (file-symlink-p filename))
+ (setq filename (file-symlink-p filename)
+ count (1- count)))
+ (if (> count 0)
+ filename
+ (error "Apparently circular symlink path"))))
+
+;; Suggested by Michael Kifer <kifer@CS.SunySB.EDU>
+(defun file-remote-p (file-name)
+ "Test whether FILE-NAME is looked for on a remote system."
+ (cond ((not allow-remote-paths) nil)
+ ((featurep 'ange-ftp) (ange-ftp-ftp-path file-name))
+ ((fboundp 'efs-ftp-path) (efs-ftp-path file-name))
+ (t nil)))
+
+;; #### FSF has file-name-non-special here.
+
+;;; files.el ends here
--- /dev/null
+;;; format.el --- read and save files in multiple formats
+
+;; Copyright (c) 1994, 1995, 1997 Free Software Foundation
+
+;; Author: Boris Goldowsky <boris@gnu.ai.mit.edu>
+;; Keywords: extensions, 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, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Emacs 20.2.
+
+;;; Commentary:
+
+;; This file is dumped with XEmacs.
+
+;; This file defines a unified mechanism for saving & loading files stored
+;; in different formats. `format-alist' contains information that directs
+;; Emacs to call an encoding or decoding function when reading or writing
+;; files that match certain conditions.
+;;
+;; When a file is visited, its format is determined by matching the
+;; beginning of the file against regular expressions stored in
+;; `format-alist'. If this fails, you can manually translate the buffer
+;; using `format-decode-buffer'. In either case, the formats used are
+;; listed in the variable `buffer-file-format', and become the default
+;; format for saving the buffer. To save a buffer in a different format,
+;; change this variable, or use `format-write-file'.
+;;
+;; Auto-save files are normally created in the same format as the visited
+;; file, but the variable `auto-save-file-format' can be set to a
+;; particularly fast or otherwise preferred format to be used for
+;; auto-saving (or nil to do no encoding on auto-save files, but then you
+;; risk losing any text-properties in the buffer).
+;;
+;; You can manually translate a buffer into or out of a particular format
+;; with the functions `format-encode-buffer' and `format-decode-buffer'.
+;; To translate just the region use the functions `format-encode-region'
+;; and `format-decode-region'.
+;;
+;; You can define a new format by writing the encoding and decoding
+;; functions, and adding an entry to `format-alist'. See enriched.el for
+;; an example of how to implement a file format. There are various
+;; functions defined in this file that may be useful for writing the
+;; encoding and decoding functions:
+;; * `format-annotate-region' and `format-deannotate-region' allow a
+;; single alist of information to be used for encoding and decoding.
+;; The alist defines a correspondence between strings in the file
+;; ("annotations") and text-properties in the buffer.
+;; * `format-replace-strings' is similarly useful for doing simple
+;; string->string translations in a reversible manner.
+
+;;; Code:
+
+(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)
+
+ ;; 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"
+ enriched-decode enriched-encode t enriched-mode)
+ (text/richtext "Extended MIME obsolete text/richtext format."
+ "Content-[Tt]ype:[ \t]*text/richtext"
+ richtext-decode richtext-encode t enriched-mode)
+ (plain "ISO 8859-1 standard format, no text properties."
+ ;; Plain only exists so that there is an obvious neutral choice in
+ ;; the completion list.
+ nil nil nil nil nil)
+ ;; (ibm "IBM Code Page 850 (DOS)"
+ ;; "1\\(^\\)"
+ ;; "recode ibm-pc:latin1" "recode latin1:ibm-pc" t nil)
+ ;; (mac "Apple Macintosh"
+ ;; "1\\(^\\)"
+ ;; "recode mac:latin1" "recode latin1:mac" t nil)
+ ;; (hp "HP Roman8"
+ ;; "1\\(^\\)"
+ ;; "recode roman8:latin1" "recode latin1:roman8" t nil)
+ ;; (TeX "TeX (encoding)"
+ ;; "1\\(^\\)"
+ ;; iso-tex2iso iso-iso2tex t nil)
+ ;; (gtex "German TeX (encoding)"
+ ;; "1\\(^\\)"
+ ;; iso-gtex2iso iso-iso2gtex t nil)
+ ;; (html "HTML (encoding)"
+ ;; "1\\(^\\)"
+ ;; "recode html:latin1" "recode latin1:html" t nil)
+ ;; (rot13 "rot13"
+ ;; "1\\(^\\)"
+ ;; "tr a-mn-z n-za-m" "tr a-mn-z n-za-m" t nil)
+ ;; (duden "Duden Ersatzdarstellung"
+ ;; "1\\(^\\)"
+ ;; "diac" iso-iso2duden t nil)
+ ;; (de646 "German ASCII (ISO 646)"
+ ;; "1\\(^\\)"
+ ;; "recode iso646-ge:latin1" "recode latin1:iso646-ge" t nil)
+ ;; (denet "net German"
+ ;; "1\\(^\\)"
+ ;; iso-german iso-cvt-read-only t nil)
+ ;; (esnet "net Spanish"
+ ;; "1\\(^\\)"
+ ;; iso-spanish iso-cvt-read-only t nil)
+ )
+ "List of information about understood file formats.
+Elements are of the form \(NAME DOC-STR REGEXP FROM-FN TO-FN MODIFY MODE-FN).
+
+NAME is a symbol, which is stored in `buffer-file-format'.
+
+DOC-STR should be a single line providing more information about the
+ format. It is currently unused, but in the future will be shown to
+ the user if they ask for more information.
+
+REGEXP is a regular expression to match against the beginning of the file;
+ it should match only files in that format.
+
+FROM-FN is called to decode files in that format; it gets two args, BEGIN
+ and END, and can make any modifications it likes, returning the new
+ end. It must make sure that the beginning of the file no longer
+ matches REGEXP, or else it will get called again.
+ Alternatively, FROM-FN can be a string, which specifies a shell command
+ (including options) to be used as a filter to perform the conversion.
+
+TO-FN is called to encode a region into that format; it is passed three
+ arguments: BEGIN, END, and BUFFER. BUFFER is the original buffer that
+ the data being written came from, which the function could use, for
+ example, to find the values of local variables. TO-FN should either
+ return a list of annotations like `write-region-annotate-functions',
+ or modify the region and return the new end.
+ Alternatively, TO-FN can be a string, which specifies a shell command
+ (including options) to be used as a filter to perform the conversion.
+
+MODIFY, if non-nil, means the TO-FN wants to modify the region. If nil,
+ TO-FN will not make any changes but will instead return a list of
+ annotations.
+
+MODE-FN, if specified, is called when visiting a file with that format.")
+
+;;; Basic Functions (called from Lisp)
+
+(defun format-encode-run-method (method from to &optional buffer)
+ "Translate using function or shell script METHOD the text from FROM to TO.
+If METHOD is a string, it is a shell command;
+otherwise, it should be a Lisp function.
+BUFFER should be the buffer that the output originally came from."
+ (if (stringp method)
+ (save-current-buffer
+ (set-buffer buffer)
+ (with-output-to-temp-buffer "*Format Errors*"
+ (shell-command-on-region from to method t nil))
+ (point))
+ (funcall method from to buffer)))
+
+(defun format-decode-run-method (method from to &optional buffer)
+ "Decode using function or shell script METHOD the text from FROM to TO.
+If METHOD is a string, it is a shell command;
+otherwise, it should be a Lisp function."
+ (if (stringp method)
+ (progn
+ (with-output-to-temp-buffer "*Format Errors*"
+ (shell-command-on-region from to method t nil))
+ (point))
+ (funcall method from to)))
+
+(defun format-annotate-function (format from to orig-buf)
+ "Return annotations for writing region as FORMAT.
+FORMAT is a symbol naming one of the formats defined in `format-alist',
+it must be a single symbol, not a list like `buffer-file-format'.
+FROM and TO delimit the region to be operated on in the current buffer.
+ORIG-BUF is the original buffer that the data came from.
+This function works like a function on `write-region-annotate-functions':
+it either returns a list of annotations, or returns with a different buffer
+current, which contains the modified text to write.
+
+For most purposes, consider using `format-encode-region' instead."
+ ;; This function is called by write-region (actually build-annotations)
+ ;; for each element of buffer-file-format.
+ (let* ((info (assq format format-alist))
+ (to-fn (nth 4 info))
+ (modify (nth 5 info)))
+ (if to-fn
+ (if modify
+ ;; To-function wants to modify region. Copy to safe place.
+ (let ((copy-buf (get-buffer-create " *Format Temp*")))
+ (copy-to-buffer copy-buf from to)
+ (set-buffer copy-buf)
+ (format-insert-annotations write-region-annotations-so-far from)
+ (format-encode-run-method to-fn (point-min) (point-max) orig-buf)
+ nil)
+ ;; Otherwise just call function, it will return annotations.
+ (funcall to-fn from to orig-buf)))))
+
+(defun format-decode (format length &optional visit-flag)
+ "Decode text from any known FORMAT.
+FORMAT is a symbol appearing in `format-alist' or a list of such symbols,
+or nil, in which case this function tries to guess the format of the data by
+matching against the regular expressions in `format-alist'. After a match is
+found and the region decoded, the alist is searched again from the beginning
+for another match.
+
+Second arg LENGTH is the number of characters following point to operate on.
+If optional third arg VISIT-FLAG is true, set `buffer-file-format'
+to the list of formats used, and call any mode functions defined for those
+formats.
+
+Returns the new length of the decoded region.
+
+For most purposes, consider using `format-decode-region' instead.
+
+This function is called by insert-file-contents whenever a file is read."
+ (let ((mod (buffer-modified-p))
+ (begin (point))
+ (end (+ (point) length)))
+ (if (null format)
+ ;; Figure out which format it is in, remember list in `format'.
+ (let ((try format-alist))
+ (while try
+ (let* ((f (car try))
+ (regexp (nth 2 f))
+ (p (point)))
+ (if (and regexp (looking-at regexp)
+ (< (match-end 0) (+ begin length)))
+ (progn
+ (setq format (cons (car f) format))
+ ;; Decode it
+ (if (nth 3 f)
+ (setq end (format-decode-run-method (nth 3 f) begin end)))
+ ;; Call visit function if required
+ (if (and visit-flag (nth 6 f)) (funcall (nth 6 f) 1))
+ ;; Safeguard against either of the functions changing pt.
+ (goto-char p)
+ ;; Rewind list to look for another format
+ (setq try format-alist))
+ (setq try (cdr try))))))
+ ;; Deal with given format(s)
+ (or (listp format) (setq format (list format)))
+ (let ((do format) f)
+ (while do
+ (or (setq f (assq (car do) format-alist))
+ (error "Unknown format" (car do)))
+ ;; Decode:
+ (if (nth 3 f)
+ (setq end (format-decode-run-method (nth 3 f) begin end)))
+ ;; Call visit function if required
+ (if (and visit-flag (nth 6 f)) (funcall (nth 6 f) 1))
+ (setq do (cdr do)))))
+ (if visit-flag
+ (setq buffer-file-format format))
+ (set-buffer-modified-p mod)
+ ;; Return new length of region
+ (- end begin)))
+
+;;;
+;;; Interactive functions & entry points
+;;;
+
+(defun format-decode-buffer (&optional format)
+ "Translate the buffer from some FORMAT.
+If the format is not specified, this function attempts to guess.
+`buffer-file-format' is set to the format used, and any mode-functions
+for the format are called."
+ (interactive
+ (list (format-read "Translate buffer from format (default: guess): ")))
+ (save-excursion
+ (goto-char (point-min))
+ (format-decode format (buffer-size) t)))
+
+(defun format-decode-region (from to &optional format)
+ "Decode the region from some format.
+Arg FORMAT is optional; if omitted the format will be determined by looking
+for identifying regular expressions at the beginning of the region."
+ (interactive
+ (list (region-beginning) (region-end)
+ (format-read "Translate region from format (default: guess): ")))
+ (save-excursion
+ (goto-char from)
+ (format-decode format (- to from) nil)))
+
+(defun format-encode-buffer (&optional format)
+ "Translate the buffer into FORMAT.
+FORMAT defaults to `buffer-file-format'. It is a symbol naming one of the
+formats defined in `format-alist', or a list of such symbols."
+ (interactive
+ (list (format-read (format "Translate buffer to format (default %s): "
+ buffer-file-format))))
+ (format-encode-region (point-min) (point-max) format))
+
+(defun format-encode-region (beg end &optional format)
+ "Translate the region into some FORMAT.
+FORMAT defaults to `buffer-file-format', it is a symbol naming
+one of the formats defined in `format-alist', or a list of such symbols."
+ (interactive
+ (list (region-beginning) (region-end)
+ (format-read (format "Translate region to format (default %s): "
+ buffer-file-format))))
+ (if (null format) (setq format buffer-file-format))
+ (if (symbolp format) (setq format (list format)))
+ (save-excursion
+ (goto-char end)
+ (let ( ; (cur-buf (current-buffer))
+ (end (point-marker)))
+ (while format
+ (let* ((info (assq (car format) format-alist))
+ (to-fn (nth 4 info))
+ (modify (nth 5 info))
+ ;; result
+ )
+ (if to-fn
+ (if modify
+ (setq end (format-encode-run-method to-fn beg end
+ (current-buffer)))
+ (format-insert-annotations
+ (funcall to-fn beg end (current-buffer)))))
+ (setq format (cdr format)))))))
+
+(defun format-write-file (filename format)
+ "Write current buffer into a FILE using some FORMAT.
+Makes buffer visit that file and sets the format as the default for future
+saves. If the buffer is already visiting a file, you can specify a directory
+name as FILE, to write a file of the same old name in that directory."
+ (interactive
+ ;; Same interactive spec as write-file, plus format question.
+ (let* ((file (if buffer-file-name
+ (read-file-name "Write file: "
+ nil nil nil nil)
+ (read-file-name "Write file: "
+ (cdr (assq 'default-directory
+ (buffer-local-variables)))
+ nil nil (buffer-name))))
+ (fmt (format-read (format "Write file `%s' in format: "
+ (file-name-nondirectory file)))))
+ (list file fmt)))
+ (setq buffer-file-format format)
+ (write-file filename))
+
+(defun format-find-file (filename format)
+ "Find the file FILE using data format FORMAT.
+If FORMAT is nil then do not do any format conversion."
+ (interactive
+ ;; Same interactive spec as write-file, plus format question.
+ (let* ((file (read-file-name "Find file: "))
+ (fmt (format-read (format "Read file `%s' in format: "
+ (file-name-nondirectory file)))))
+ (list file fmt)))
+ (let ((format-alist nil))
+ (find-file filename))
+ (if format
+ (format-decode-buffer format)))
+
+(defun format-insert-file (filename format &optional beg end)
+ "Insert the contents of file FILE using data format FORMAT.
+If FORMAT is nil then do not do any format conversion.
+The optional third and fourth arguments BEG and END specify
+the part of the file to read.
+
+The return value is like the value of `insert-file-contents':
+a list (ABSOLUTE-FILE-NAME . SIZE)."
+ (interactive
+ ;; Same interactive spec as write-file, plus format question.
+ (let* ((file (read-file-name "Find file: "))
+ (fmt (format-read (format "Read file `%s' in format: "
+ (file-name-nondirectory file)))))
+ (list file fmt)))
+ (let (value size)
+ (let ((format-alist nil))
+ (setq value (insert-file-contents filename nil beg end))
+ (setq size (nth 1 value)))
+ (if format
+ (setq size (format-decode format size)
+ value (cons (car value) size)))
+ value))
+
+(defun format-read (&optional prompt)
+ "Read and return the name of a format.
+Return value is a list, like `buffer-file-format'; it may be nil.
+Formats are defined in `format-alist'. Optional arg is the PROMPT to use."
+ (let* ((table (mapcar (lambda (x) (list (symbol-name (car x))))
+ format-alist))
+ (ans (completing-read (or prompt "Format: ") table nil t)))
+ (if (not (equal "" ans)) (list (intern ans)))))
+
+
+;;;
+;;; Below are some functions that may be useful in writing encoding and
+;;; decoding functions for use in format-alist.
+;;;
+
+(defun format-replace-strings (alist &optional reverse beg end)
+ "Do multiple replacements on the buffer.
+ALIST is a list of (from . to) pairs, which should be proper arguments to
+`search-forward' and `replace-match' respectively.
+Optional 2nd arg REVERSE, if non-nil, means the pairs are (to . from), so that
+you can use the same list in both directions if it contains only literal
+strings.
+Optional args BEGIN and END specify a region of the buffer to operate on."
+ (save-excursion
+ (save-restriction
+ (or beg (setq beg (point-min)))
+ (if end (narrow-to-region (point-min) end))
+ (while alist
+ (let ((from (if reverse (cdr (car alist)) (car (car alist))))
+ (to (if reverse (car (cdr alist)) (cdr (car alist)))))
+ (goto-char beg)
+ (while (search-forward from nil t)
+ (goto-char (match-beginning 0))
+ (insert to)
+ (set-text-properties (- (point) (length to)) (point)
+ (text-properties-at (point)))
+ (delete-region (point) (+ (point) (- (match-end 0)
+ (match-beginning 0)))))
+ (setq alist (cdr alist)))))))
+
+;;; Some list-manipulation functions that we need.
+
+(defun format-delq-cons (cons list)
+ "Remove the given CONS from LIST by side effect,
+and return the new LIST. Since CONS could be the first element
+of LIST, write `\(setq foo \(format-delq-cons element foo))' to be sure of
+changing the value of `foo'."
+ (if (eq cons list)
+ (cdr list)
+ (let ((p list))
+ (while (not (eq (cdr p) cons))
+ (if (null p) (error "format-delq-cons: not an element."))
+ (setq p (cdr p)))
+ ;; Now (cdr p) is the cons to delete
+ (setcdr p (cdr cons))
+ list)))
+
+(defun format-make-relatively-unique (a b)
+ "Delete common elements of lists A and B, return as pair.
+Compares using `equal'."
+ (let* ((acopy (copy-sequence a))
+ (bcopy (copy-sequence b))
+ (tail acopy))
+ (while tail
+ (let ((dup (member (car tail) bcopy))
+ (next (cdr tail)))
+ (if dup (setq acopy (format-delq-cons tail acopy)
+ bcopy (format-delq-cons dup bcopy)))
+ (setq tail next)))
+ (cons acopy bcopy)))
+
+(defun format-common-tail (a b)
+ "Given two lists that have a common tail, return it.
+Compares with `equal', and returns the part of A that is equal to the
+equivalent part of B. If even the last items of the two are not equal,
+returns nil."
+ (let ((la (length a))
+ (lb (length b)))
+ ;; Make sure they are the same length
+ (if (> la lb)
+ (setq a (nthcdr (- la lb) a))
+ (setq b (nthcdr (- lb la) b))))
+ (while (not (equal a b))
+ (setq a (cdr a)
+ b (cdr b)))
+ a)
+
+(defun format-reorder (items order)
+ "Arrange ITEMS to following partial ORDER.
+Elements of ITEMS equal to elements of ORDER will be rearranged to follow the
+ORDER. Unmatched items will go last."
+ (if order
+ (let ((item (member (car order) items)))
+ (if item
+ (cons (car item)
+ (format-reorder (format-delq-cons item items)
+ (cdr order)))
+ (format-reorder items (cdr order))))
+ items))
+
+(put 'face 'format-list-valued t) ; These text-properties take values
+(put 'unknown 'format-list-valued t) ; that are lists, the elements of which
+ ; should be considered separately.
+ ; See format-deannotate-region and
+ ; format-annotate-region.
+
+;;;
+;;; Decoding
+;;;
+
+(defun format-deannotate-region (from to translations next-fn)
+ "Translate annotations in the region into text properties.
+This sets text properties between FROM to TO as directed by the
+TRANSLATIONS and NEXT-FN arguments.
+
+NEXT-FN is a function that searches forward from point for an annotation.
+It should return a list of 4 elements: \(BEGIN END NAME POSITIVE). BEGIN and
+END are buffer positions bounding the annotation, NAME is the name searched
+for in TRANSLATIONS, and POSITIVE should be non-nil if this annotation marks
+the beginning of a region with some property, or nil if it ends the region.
+NEXT-FN should return nil if there are no annotations after point.
+
+The basic format of the TRANSLATIONS argument is described in the
+documentation for the `format-annotate-region' function. There are some
+additional things to keep in mind for decoding, though:
+
+When an annotation is found, the TRANSLATIONS list is searched for a
+text-property name and value that corresponds to that annotation. If the
+text-property has several annotations associated with it, it will be used only
+if the other annotations are also in effect at that point. The first match
+found whose annotations are all present is used.
+
+The text property thus determined is set to the value over the region between
+the opening and closing annotations. However, if the text-property name has a
+non-nil `format-list-valued' property, then the value will be consed onto the
+surrounding value of the property, rather than replacing that value.
+
+There are some special symbols that can be used in the \"property\" slot of
+the TRANSLATIONS list: PARAMETER and FUNCTION \(spelled in uppercase).
+Annotations listed under the pseudo-property PARAMETER are considered to be
+arguments of the immediately surrounding annotation; the text between the
+opening and closing parameter annotations is deleted from the buffer but saved
+as a string. The surrounding annotation should be listed under the
+pseudo-property FUNCTION. Instead of inserting a text-property for this
+annotation, the function listed in the VALUE slot is called to make whatever
+changes are appropriate. The function's first two arguments are the START and
+END locations, and the rest of the arguments are any PARAMETERs found in that
+region.
+
+Any annotations that are found by NEXT-FN but not defined by TRANSLATIONS
+are saved as values of the `unknown' text-property \(which is list-valued).
+The TRANSLATIONS list should usually contain an entry of the form
+ \(unknown \(nil format-annotate-value))
+to write these unknown annotations back into the file."
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (point-min) to)
+ (goto-char from)
+ (let (next open-ans todo
+ ;; loc
+ unknown-ans)
+ (while (setq next (funcall next-fn))
+ (let* ((loc (nth 0 next))
+ (end (nth 1 next))
+ (name (nth 2 next))
+ (positive (nth 3 next))
+ (found nil))
+
+ ;; Delete the annotation
+ (delete-region loc end)
+ (cond
+ ;; Positive annotations are stacked, remembering location
+ (positive (setq open-ans (cons `(,name ((,loc . nil))) open-ans)))
+ ;; It is a negative annotation:
+ ;; Close the top annotation & add its text property.
+ ;; If the file's nesting is messed up, the close might not match
+ ;; the top thing on the open-annotations stack.
+ ;; If no matching annotation is open, just ignore the close.
+ ((not (assoc name open-ans))
+ (message "Extra closing annotation (%s) in file" name))
+ ;; If one is open, but not on the top of the stack, close
+ ;; the things in between as well. Set `found' when the real
+ ;; one is closed.
+ (t
+ (while (not found)
+ (let* ((top (car open-ans)) ; first on stack: should match.
+ (top-name (car top)) ; text property name
+ (top-extents (nth 1 top)) ; property regions
+ (params (cdr (cdr top))) ; parameters
+ (aalist translations)
+ (matched nil))
+ (if (equal name top-name)
+ (setq found t)
+ (message "Improper nesting in file."))
+ ;; Look through property names in TRANSLATIONS
+ (while aalist
+ (let ((prop (car (car aalist)))
+ (alist (cdr (car aalist))))
+ ;; And look through values for each property
+ (while alist
+ (let ((value (car (car alist)))
+ (ans (cdr (car alist))))
+ (if (member top-name ans)
+ ;; This annotation is listed, but still have to
+ ;; check if multiple annotations are satisfied
+ (if (member nil (mapcar (lambda (r)
+ (assoc r open-ans))
+ ans))
+ nil ; multiple ans not satisfied
+ ;; If there are multiple annotations going
+ ;; into one text property, split up the other
+ ;; annotations so they apply individually to
+ ;; the other regions.
+ (setcdr (car top-extents) loc)
+ (let ((to-split ans) this-one extents)
+ (while to-split
+ (setq this-one
+ (assoc (car to-split) open-ans)
+ extents (nth 1 this-one))
+ (if (not (eq this-one top))
+ (setcar (cdr this-one)
+ (format-subtract-regions
+ extents top-extents)))
+ (setq to-split (cdr to-split))))
+ ;; Set loop variables to nil so loop
+ ;; will exit.
+ (setq alist nil aalist nil matched t
+ ;; pop annotation off stack.
+ open-ans (cdr open-ans))
+ (let ((extents top-extents)
+ (start (car (car top-extents)))
+ (loc (cdr (car top-extents))))
+ (while extents
+ (cond
+ ;; Check for pseudo-properties
+ ((eq prop 'PARAMETER)
+ ;; A parameter of the top open ann:
+ ;; delete text and use as arg.
+ (if open-ans
+ ;; (If nothing open, discard).
+ (setq open-ans
+ (cons
+ (append (car open-ans)
+ (list
+ (buffer-substring
+ start loc)))
+ (cdr open-ans))))
+ (delete-region start loc))
+ ((eq prop 'FUNCTION)
+ ;; Not a property, but a function.
+ (let ((rtn
+ (apply value start loc params)))
+ (if rtn (setq todo (cons rtn todo)))))
+ (t
+ ;; Normal property/value pair
+ (setq todo
+ (cons (list start loc prop value)
+ todo))))
+ (setq extents (cdr extents)
+ start (car (car extents))
+ loc (cdr (car extents))))))))
+ (setq alist (cdr alist))))
+ (setq aalist (cdr aalist)))
+ (unless matched
+ ;; Didn't find any match for the annotation:
+ ;; Store as value of text-property `unknown'.
+ (setcdr (car top-extents) loc)
+ (let ((extents top-extents)
+ (start (car (car top-extents)))
+ (loc (cdr (car top-extents))))
+ (while extents
+ (setq open-ans (cdr open-ans)
+ todo (cons (list start loc 'unknown top-name)
+ todo)
+ unknown-ans (cons name unknown-ans)
+ extents (cdr extents)
+ start (car (car extents))
+ loc (cdr (car extents))))))))))))
+
+ ;; Once entire file has been scanned, add the properties.
+ (while todo
+ (let* ((item (car todo))
+ (from (nth 0 item))
+ (to (nth 1 item))
+ (prop (nth 2 item))
+ (val (nth 3 item)))
+
+ (if (numberp val) ; add to ambient value if numeric
+ (format-property-increment-region from to prop val 0)
+ (put-text-property
+ from to prop
+ (cond ((get prop 'format-list-valued) ; value gets consed onto
+ ; list-valued properties
+ (let ((prev (get-text-property from prop)))
+ (cons val (if (listp prev) prev (list prev)))))
+ (t val))))) ; normally, just set to val.
+ (setq todo (cdr todo)))
+
+ (if unknown-ans
+ (message "Unknown annotations: %s" unknown-ans))))))
+
+(defun format-subtract-regions (minu subtra)
+ "Remove the regions in SUBTRAHEND from the regions in MINUEND. A region
+is a dotted pair (from . to). Both parameters are lists of regions. Each
+list must contain nonoverlapping, noncontiguous regions, in descending
+order. The result is also nonoverlapping, noncontiguous, and in descending
+order. The first element of MINUEND can have a cdr of nil, indicating that
+the end of that region is not yet known."
+ (let* ((minuend (copy-alist minu))
+ (subtrahend (copy-alist subtra))
+ (m (car minuend))
+ (s (car subtrahend))
+ results)
+ (while (and minuend subtrahend)
+ (cond
+ ;; The minuend starts after the subtrahend ends; keep it.
+ ((> (car m) (cdr s))
+ (setq results (cons m results)
+ minuend (cdr minuend)
+ m (car minuend)))
+ ;; The minuend extends beyond the end of the subtrahend. Chop it off.
+ ((or (null (cdr m)) (> (cdr m) (cdr s)))
+ (setq results (cons (cons (1+ (cdr s)) (cdr m)) results))
+ (setcdr m (cdr s)))
+ ;; The subtrahend starts after the minuend ends; throw it away.
+ ((< (cdr m) (car s))
+ (setq subtrahend (cdr subtrahend) s (car subtrahend)))
+ ;; The subtrahend extends beyond the end of the minuend. Chop it off.
+ (t ;(<= (cdr m) (cdr s)))
+ (if (>= (car m) (car s))
+ (setq minuend (cdr minuend) m (car minuend))
+ (setcdr m (1- (car s)))
+ (setq subtrahend (cdr subtrahend) s (car subtrahend))))))
+ (nconc (nreverse results) minuend)))
+
+;; This should probably go somewhere other than format.el. Then again,
+;; indent.el has alter-text-property. NOTE: We can also use
+;; next-single-property-change instead of text-property-not-all, but then
+;; we have to see if we passed TO.
+(defun format-property-increment-region (from to prop delta default)
+ "Increment property PROP over the region between FROM and TO by the
+amount DELTA (which may be negative). If property PROP is nil anywhere
+in the region, it is treated as though it were DEFAULT."
+ (let ((cur from) val newval next)
+ (while cur
+ (setq val (get-text-property cur prop)
+ newval (+ (or val default) delta)
+ next (text-property-not-all cur to prop val))
+ (put-text-property cur (or next to) prop newval)
+ (setq cur next))))
+
+;;;
+;;; Encoding
+;;;
+
+(defun format-insert-annotations (list &optional offset)
+ "Apply list of annotations to buffer as `write-region' would.
+Inserts each element of the given LIST of buffer annotations at its
+appropriate place. Use second arg OFFSET if the annotations' locations are
+not relative to the beginning of the buffer: annotations will be inserted
+at their location-OFFSET+1 \(ie, the offset is treated as the character number
+of the first character in the buffer)."
+ (if (not offset)
+ (setq offset 0)
+ (setq offset (1- offset)))
+ (let ((l (reverse list)))
+ (while l
+ (goto-char (- (car (car l)) offset))
+ (insert (cdr (car l)))
+ (setq l (cdr l)))))
+
+(defun format-annotate-value (old new)
+ "Return OLD and NEW as a \(close . open) annotation pair.
+Useful as a default function for TRANSLATIONS alist when the value of the text
+property is the name of the annotation that you want to use, as it is for the
+`unknown' text property."
+ (cons (if old (list old))
+ (if new (list new))))
+
+(defun format-annotate-region (from to trans format-fn ignore)
+ "Generate annotations for text properties in the region.
+Searches for changes between FROM and TO, and describes them with a list of
+annotations as defined by alist TRANSLATIONS and FORMAT-FN. IGNORE lists text
+properties not to consider; any text properties that are neither ignored nor
+listed in TRANSLATIONS are warned about.
+If you actually want to modify the region, give the return value of this
+function to `format-insert-annotations'.
+
+Format of the TRANSLATIONS argument:
+
+Each element is a list whose car is a PROPERTY, and the following
+elements are VALUES of that property followed by the names of zero or more
+ANNOTATIONS. Whenever the property takes on that value, the annotations
+\(as formatted by FORMAT-FN) are inserted into the file.
+When the property stops having that value, the matching negated annotation
+will be inserted \(it may actually be closed earlier and reopened, if
+necessary, to keep proper nesting).
+
+If the property's value is a list, then each element of the list is dealt with
+separately.
+
+If a VALUE is numeric, then it is assumed that there is a single annotation
+and each occurrence of it increments the value of the property by that number.
+Thus, given the entry \(left-margin \(4 \"indent\")), if the left margin
+changes from 4 to 12, two <indent> annotations will be generated.
+
+If the VALUE is nil, then instead of annotations, a function should be
+specified. This function is used as a default: it is called for all
+transitions not explicitly listed in the table. The function is called with
+two arguments, the OLD and NEW values of the property. It should return
+lists of annotations like `format-annotate-location' does.
+
+ The same structure can be used in reverse for reading files."
+ (let ((all-ans nil) ; All annotations - becomes return value
+ (open-ans nil) ; Annotations not yet closed
+ (loc nil) ; Current location
+ (not-found nil)) ; Properties that couldn't be saved
+ (while (or (null loc)
+ (and (setq loc (next-property-change loc nil to))
+ (< loc to)))
+ (or loc (setq loc from))
+ (let* ((ans (format-annotate-location loc (= loc from) ignore trans))
+ (neg-ans (format-reorder (aref ans 0) open-ans))
+ (pos-ans (aref ans 1))
+ (ignored (aref ans 2)))
+ (setq not-found (append ignored not-found)
+ ignore (append ignored ignore))
+ ;; First do the negative (closing) annotations
+ (while neg-ans
+ ;; Check if it's missing. This can happen (eg, a numeric property
+ ;; going negative can generate closing annotations before there are
+ ;; any open). Warn user & ignore.
+ (if (not (member (car neg-ans) open-ans))
+ (message "Can't close %s: not open." (car neg-ans))
+ (while (not (equal (car neg-ans) (car open-ans)))
+ ;; To close anno. N, need to first close ans 1 to N-1,
+ ;; remembering to re-open them later.
+ (setq pos-ans (cons (car open-ans) pos-ans))
+ (setq all-ans
+ (cons (cons loc (funcall format-fn (car open-ans) nil))
+ all-ans))
+ (setq open-ans (cdr open-ans)))
+ ;; Now remove the one we're really interested in from open list.
+ (setq open-ans (cdr open-ans))
+ ;; And put the closing annotation here.
+ (setq all-ans
+ (cons (cons loc (funcall format-fn (car neg-ans) nil))
+ all-ans)))
+ (setq neg-ans (cdr neg-ans)))
+ ;; Now deal with positive (opening) annotations
+ (let ( ; (p pos-ans)
+ )
+ (while pos-ans
+ (setq open-ans (cons (car pos-ans) open-ans))
+ (setq all-ans
+ (cons (cons loc (funcall format-fn (car pos-ans) t))
+ all-ans))
+ (setq pos-ans (cdr pos-ans))))))
+
+ ;; Close any annotations still open
+ (while open-ans
+ (setq all-ans
+ (cons (cons to (funcall format-fn (car open-ans) nil))
+ all-ans))
+ (setq open-ans (cdr open-ans)))
+ (if not-found
+ (message "These text properties could not be saved:\n %s"
+ not-found))
+ (nreverse all-ans)))
+
+;;; Internal functions for format-annotate-region.
+
+(defun format-annotate-location (loc all ignore trans)
+ "Return annotation(s) needed at LOCATION.
+This includes any properties that change between LOC-1 and LOC.
+If ALL is true, don't look at previous location, but generate annotations for
+all non-nil properties.
+Third argument IGNORE is a list of text-properties not to consider.
+
+Return value is a vector of 3 elements:
+1. List of names of the annotations to close
+2. List of the names of annotations to open.
+3. List of properties that were ignored or couldn't be annotated."
+ (let* ((prev-loc (1- loc))
+ (before-plist (if all nil (text-properties-at prev-loc)))
+ (after-plist (text-properties-at loc))
+ p negatives positives prop props not-found)
+ ;; make list of all property names involved
+ (setq p before-plist)
+ (while p
+ (if (not (memq (car p) props))
+ (setq props (cons (car p) props)))
+ (setq p (cdr (cdr p))))
+ (setq p after-plist)
+ (while p
+ (if (not (memq (car p) props))
+ (setq props (cons (car p) props)))
+ (setq p (cdr (cdr p))))
+
+ (while props
+ (setq prop (car props)
+ props (cdr props))
+ (if (memq prop ignore)
+ nil ; If it's been ignored before, ignore it now.
+ (let ((before (if all nil (car (cdr (memq prop before-plist)))))
+ (after (car (cdr (memq prop after-plist)))))
+ (if (equal before after)
+ nil ; no change; ignore
+ (let ((result (format-annotate-single-property-change
+ prop before after trans)))
+ (if (not result)
+ (setq not-found (cons prop not-found))
+ (setq negatives (nconc negatives (car result))
+ positives (nconc positives (cdr result)))))))))
+ (vector negatives positives not-found)))
+
+(defun format-annotate-single-property-change (prop old new trans)
+ "Return annotations for PROPERTY changing from OLD to NEW.
+These are searched for in the TRANSLATIONS alist.
+If NEW does not appear in the list, but there is a default function, then that
+function is called.
+Annotations to open and to close are returned as a dotted pair."
+ (let ((prop-alist (cdr (assoc prop trans)))
+ ;; default
+ )
+ (if (not prop-alist)
+ nil
+ ;; If either old or new is a list, have to treat both that way.
+ (if (or (consp old) (consp new))
+ (let* ((old (if (listp old) old (list old)))
+ (new (if (listp new) new (list new)))
+ ;; (tail (format-common-tail old new))
+ close open)
+ (while old
+ (setq close
+ (append (car (format-annotate-atomic-property-change
+ prop-alist (car old) nil))
+ close)
+ old (cdr old)))
+ (while new
+ (setq open
+ (append (cdr (format-annotate-atomic-property-change
+ prop-alist nil (car new)))
+ open)
+ new (cdr new)))
+ (format-make-relatively-unique close open))
+ (format-annotate-atomic-property-change prop-alist old new)))))
+
+(defun format-annotate-atomic-property-change (prop-alist old new)
+ "Internal function annotate a single property change.
+PROP-ALIST is the relevant segment of a TRANSLATIONS list.
+OLD and NEW are the values."
+ (let (num-ann)
+ ;; If old and new values are numbers,
+ ;; look for a number in PROP-ALIST.
+ (if (and (or (null old) (numberp old))
+ (or (null new) (numberp new)))
+ (progn
+ (setq num-ann prop-alist)
+ (while (and num-ann (not (numberp (car (car num-ann)))))
+ (setq num-ann (cdr num-ann)))))
+ (if num-ann
+ ;; Numerical annotation - use difference
+ (progn
+ ;; If property is numeric, nil means 0
+ (cond ((and (numberp old) (null new))
+ (setq new 0))
+ ((and (numberp new) (null old))
+ (setq old 0)))
+
+ (let* ((entry (car num-ann))
+ (increment (car entry))
+ (n (ceiling (/ (float (- new old)) (float increment))))
+ (anno (car (cdr entry))))
+ (if (> n 0)
+ (cons nil (make-list n anno))
+ (cons (make-list (- n) anno) nil))))
+
+ ;; Standard annotation
+ (let ((close (and old (cdr (assoc old prop-alist))))
+ (open (and new (cdr (assoc new prop-alist)))))
+ (if (or close open)
+ (format-make-relatively-unique close open)
+ ;; Call "Default" function, if any
+ (let ((default (assq nil prop-alist)))
+ (if default
+ (funcall (car (cdr default)) old new))))))))
+
+;;; format.el ends here
--- /dev/null
+;;; chinese.el --- Support for Chinese
+
+;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1997 MORIOKA Tomohiko
+
+;; Keywords: multilingual, Chinese
+
+;; 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 Chinese, three character sets GB2312, BIG5, and CNS11643 are
+;; supported.
+
+;;; Code:
+
+;; Syntax of Chinese characters.
+(modify-syntax-entry 'chinese-gb2312 "w")
+(loop for row in '(33 34 41)
+ do (modify-syntax-entry `[chinese-gb2312 ,row] "."))
+;;(loop for row from 35 to 40
+;; do (modify-syntax-entry `[chinese-gb2312 ,row] "w"))
+;;(loop for row from 42 to 126
+;; do (modify-syntax-entry `[chinese-gb2312 ,row] "w"))
+
+(modify-syntax-entry 'chinese-cns11643-1 "w")
+(modify-syntax-entry 'chinese-cns11643-2 "w")
+(modify-syntax-entry 'chinese-big5-1 "w")
+(modify-syntax-entry 'chinese-big5-2 "w")
+
+;; CNS11643 Plane3 thru Plane7
+;; These represent more and more obscure Chinese characters.
+;; By the time you get to Plane 7, we're talking about characters
+;; that appear once in some ancient manuscript and whose meaning
+;; is unknown.
+
+(flet
+ ((make-chinese-cns11643-charset
+ (name plane final)
+ (make-charset
+ name (concat "CNS 11643 Plane " plane " (Chinese traditional)")
+ `(registry
+ ,(concat "CNS11643[.-]\\(.*[.-]\\)?" plane "$")
+ dimension 2
+ chars 94
+ final ,final
+ graphic 0))
+ (modify-syntax-entry name "w")
+ (modify-category-entry name ?t)
+ ))
+ (make-chinese-cns11643-charset 'chinese-cns11643-3 "3" ?I)
+ (make-chinese-cns11643-charset 'chinese-cns11643-4 "4" ?J)
+ (make-chinese-cns11643-charset 'chinese-cns11643-5 "5" ?K)
+ (make-chinese-cns11643-charset 'chinese-cns11643-6 "6" ?L)
+ (make-chinese-cns11643-charset 'chinese-cns11643-7 "7" ?M)
+ )
+
+;; ISO-IR-165 (CCITT Extended GB)
+;; It is based on CCITT Recommendation T.101, includes GB 2312-80 +
+;; GB 8565-88 table A4 + 293 characters.
+(make-charset
+ 'chinese-isoir165
+ "ISO-IR-165 (CCITT Extended GB; Chinese simplified)"
+ `(registry "isoir165"
+ dimension 2
+ chars 94
+ final ?E
+ graphic 0))
+
+;; PinYin-ZhuYin
+(make-charset 'sisheng "PinYin-ZhuYin"
+ '(registry "sisheng_cwnn\\|OMRON_UDC_ZH"
+ dimension 1
+ chars 94
+ final ?0
+ graphic 0
+ ))
+
+;; If you prefer QUAIL to EGG, please modify below as you wish.
+;;(when (and (featurep 'egg) (featurep 'wnn))
+;; (setq wnn-server-type 'cserver)
+;; (load "pinyin")
+;; (setq its:*standard-modes*
+;; (cons (its:get-mode-map "PinYin") its:*standard-modes*)))
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Chinese (general)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; (make-coding-system
+;; 'chinese-iso-7bit 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 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)
+
+;; (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)
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Chinese GB2312 (simplified)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; (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))
+
+(make-coding-system
+ 'cn-gb-2312 'iso2022
+ "Coding-system of Chinese EUC (Extended Unix Code)."
+ '(charset-g0 ascii
+ charset-g1 chinese-gb2312
+ charset-g2 sisheng
+ charset-g3 t
+ mnemonic "Zh-GB/EUC"
+ ))
+
+;; (define-coding-system-alias 'cn-gb-2312 'chinese-iso-8bit)
+;; (define-coding-system-alias 'euc-china 'chinese-iso-8bit)
+
+(copy-coding-system 'cn-gb-2312 'gb2312)
+(copy-coding-system 'cn-gb-2312 'chinese-euc)
+
+;; (make-coding-system
+;; 'chinese-hz 0 ?z
+;; "Hz/ZW 7-bit encoding for Chinese GB2312 (MIME:HZ-GB-2312)"
+;; nil)
+;; (put 'chinese-hz 'post-read-conversion 'post-read-decode-hz)
+;; (put 'chinese-hz 'pre-write-conversion 'pre-write-encode-hz)
+
+(make-coding-system
+ 'hz-gb-2312 'no-conversion
+ "Coding-system of Hz/ZW used for Chinese."
+ '(mnemonic "Zh-GB/Hz"
+ eol-type lf
+ post-read-conversion post-read-decode-hz
+ pre-write-conversion pre-write-encode-hz))
+
+;; (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)
+
+(defun post-read-decode-hz (len)
+ (let ((pos (point)))
+ (decode-hz-region pos (+ pos len))))
+
+(defun pre-write-encode-hz (from to)
+ (let ((buf (current-buffer))
+ (work (get-buffer-create " *pre-write-encoding-work*")))
+ (set-buffer work)
+ (erase-buffer)
+ (if (stringp from)
+ (insert from)
+ (insert-buffer-substring buf from to))
+ (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))
+ (sample-text . "Chinese (\e$AVPND\e(B,\e$AFUM(;0\e(B,\e$A::So\e(B) \e$ADc:C\e(B")
+ (documentation . ("Support for Chinese GB2312 character set."
+ . describe-chinese-environment-map))
+ ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Chinese BIG5 (traditional)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; (make-coding-system
+;; 'chinese-big5 3 ?B "BIG5 8-bit encoding for Chinese (MIME:CN-BIG5)")
+
+(make-coding-system
+ 'big5 'big5
+ "Coding-system of BIG5."
+ '(mnemonic "Zh/Big5"))
+
+;; (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)
+
+;; Big5 font requires special encoding.
+(define-ccl-program ccl-encode-big5-font
+ `(0
+ ;; In: R0:chinese-big5-1 or chinese-big5-2
+ ;; R1:position code 1
+ ;; R2:position code 2
+ ;; Out: R1:font code point 1
+ ;; R2:font code point 2
+ ((r2 = ((((r1 - ?\x21) * 94) + r2) - ?\x21))
+ (if (r0 == ,(charset-id 'chinese-big5-2)) (r2 += 6280))
+ (r1 = ((r2 / 157) + ?\xA1))
+ (r2 %= 157)
+ (if (r2 < ?\x3F) (r2 += ?\x40) (r2 += ?\x62))))
+ "CCL program to encode a Big5 code to code point of Big5 font.")
+
+;; (setq font-ccl-encoder-alist
+;; (cons (cons "big5" ccl-encode-big5-font) font-ccl-encoder-alist))
+
+(set-charset-ccl-program 'chinese-big5-1 ccl-encode-big5-font)
+(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))
+ (sample-text . "Cantonese (\e$(0GnM$\e(B,\e$(0N]0*Hd\e(B) \e$(0*/=(\e(B, \e$(0+$)p\e(B")
+ (documentation . ("Support for Chinese Big5 character set."
+ . describe-chinese-environment-map))
+ ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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.el ends here
--- /dev/null
+;;; japanese.el --- Japanese support
+
+;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1997 MORIOKA Tomohiko
+
+;; Keywords: multilingual, Japanese
+
+;; 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 Japanese, character sets JISX0201, JISX0208, JISX0212 are
+;; supported.
+
+;;; Code:
+
+;;; Syntax of Japanese characters.
+(modify-syntax-entry 'katakana-jisx0201 "w")
+(modify-syntax-entry 'japanese-jisx0212 "w")
+
+(modify-syntax-entry 'japanese-jisx0208 "w")
+(loop for row in '(33 34 40)
+ do (modify-syntax-entry `[japanese-jisx0208 ,row] "_"))
+(loop for char in '(?\e$B!<\e(B ?\e$B!+\e(B ?\e$B!,\e(B ?\e$B!3\e(B ?\e$B!4\e(B ?\e$B!5\e(B ?\e$B!6\e(B ?\e$B!7\e(B ?\e$B!8\e(B ?\e$B!9\e(B ?\e$B!:\e(B ?\e$B!;\e(B)
+ do (modify-syntax-entry char "w"))
+(modify-syntax-entry ?\\e$B!J\e(B "(\e$B!K\e(B")
+(modify-syntax-entry ?\\e$B!N\e(B "(\e$B!O\e(B")
+(modify-syntax-entry ?\\e$B!P\e(B "(\e$B!Q\e(B")
+(modify-syntax-entry ?\\e$B!V\e(B "(\e$B!W\e(B")
+(modify-syntax-entry ?\\e$B!X\e(B "(\e$B!Y\e(B")
+(modify-syntax-entry ?\\e$B!K\e(B ")\e$B!J\e(B")
+(modify-syntax-entry ?\\e$B!O\e(B ")\e$B!N\e(B")
+(modify-syntax-entry ?\\e$B!Q\e(B ")\e$B!P\e(B")
+(modify-syntax-entry ?\\e$B!W\e(B ")\e$B!V\e(B")
+(modify-syntax-entry ?\\e$B!Y\e(B ")\e$B!X\e(B")
+
+;;; Character categories S, A, H, K, G, Y, and C
+(define-category ?S "Japanese 2-byte symbol character.")
+(modify-category-entry [japanese-jisx0208 33] ?S)
+(modify-category-entry [japanese-jisx0208 34] ?S)
+(modify-category-entry [japanese-jisx0208 40] ?S)
+(define-category ?A "Japanese 2-byte Alphanumeric character.")
+(modify-category-entry [japanese-jisx0208 35] ?A)
+(define-category ?H "Japanese 2-byte Hiragana character.")
+(modify-category-entry [japanese-jisx0208 36] ?H)
+(define-category ?K "Japanese 2-byte Katakana character.")
+(modify-category-entry [japanese-jisx0208 37] ?K)
+(define-category ?G "Japanese 2-byte Greek character.")
+(modify-category-entry [japanese-jisx0208 38] ?G)
+(define-category ?Y "Japanese 2-byte Cyrillic character.")
+(modify-category-entry [japanese-jisx0208 39] ?Y)
+(define-category ?C "Japanese 2-byte Kanji characters.")
+(loop for row from 48 to 126
+ do (modify-category-entry `[japanese-jisx0208 ,row] ?C))
+(loop for char in '(?\e$B!<\e(B ?\e$B!+\e(B ?\e$B!,\e(B)
+ do (modify-category-entry char ?K)
+ (modify-category-entry char ?H))
+(loop for char in '(?\e$B!3\e(B ?\e$B!4\e(B ?\e$B!5\e(B ?\e$B!6\e(B ?\e$B!7\e(B ?\e$B!8\e(B ?\e$B!9\e(B ?\e$B!:\e(B ?\e$B!;\e(B)
+ do (modify-category-entry char ?C))
+(modify-category-entry 'japanese-jisx0212 ?C)
+
+(defvar japanese-word-regexp
+ "\\cA+\\cH*\\|\\cK+\\cH*\\|\\cC+\\cH*\\|\\cH+\\|\\ck+\\|\\sw+"
+ "Regular expression used to match a Japanese word.")
+
+(set-word-regexp japanese-word-regexp)
+(setq forward-word-regexp "\\w\\>")
+(setq backward-word-regexp "\\<\\w")
+
+;;; Paragraph setting
+(setq sentence-end
+ (concat
+ "\\("
+ "\\("
+ "[.?!][]\"')}]*"
+ "\\|"
+ "[\e$B!%!)!*\e(B][\e$B!O!I!G!K!Q!M!S!U!W!Y\e(B]*"
+ "\\)"
+ "\\($\\|\t\\| \\)"
+ "\\|"
+ "\e$B!#\e(B"
+ "\\)"
+ "[ \t\n]*"))
+(setq paragraph-start "^[ \e$B!!\e(B\t\n\f]")
+(setq paragraph-separate "^[ \e$B!!\e(B\t\f]*$")
+
+;; EGG specific setup
+(define-egg-environment 'japanese
+ "Japanese settings for egg."
+ (lambda ()
+ (when (not (featurep 'egg-jpn))
+ (load "its-hira")
+ (load "its-kata")
+ (load "its-hankaku")
+ (load "its-zenkaku")
+ (setq its:*standard-modes*
+ (append
+ (list (its:get-mode-map "roma-kana")
+ (its:get-mode-map "roma-kata")
+ (its:get-mode-map "downcase")
+ (its:get-mode-map "upcase")
+ (its:get-mode-map "zenkaku-downcase")
+ (its:get-mode-map "zenkaku-upcase"))
+ its:*standard-modes*))
+ (provide 'egg-jpn))
+ (setq wnn-server-type 'jserver)
+ ;; Can't do this here any more. Must do it when selecting egg-wnn
+ ;; or egg-sj3
+ ;; (setq egg-default-startup-file "eggrc-wnn")
+ (setq-default its:*current-map* (its:get-mode-map "roma-kana"))))
+
+;; stuff for providing gramatic processing of Japanese text
+;; something like this should probably be created for all environments...
+
+(defvar aletter (concat "\\(" ascii-char "\\|" kanji-char "\\)"))
+(defvar kanji-space-insertable (concat
+ "\e$B!"\e(B" aletter "\\|"
+ "\e$B!#\e(B" aletter "\\|"
+ aletter "\e$B!J\e(B" "\\|"
+ "\e$B!K\e(B" aletter "\\|"
+ ascii-alphanumeric kanji-kanji-char "\\|"
+ kanji-kanji-char ascii-alphanumeric ))
+
+(defvar space-insertable (concat " " aletter "\\|" kanji-space-insertable)
+ "Regexp for finding points that can have spaces inserted into them for justification")
+\f
+;; (make-coding-system
+;; '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)
+
+(make-coding-system
+ 'iso-2022-jp 'iso2022
+ "Coding-system used for communication with mail and news in Japan."
+ '(charset-g0 ascii
+ short t
+ seven t
+ input-charset-conversion ((latin-jisx0201 ascii)
+ (japanese-jisx0208-1978 japanese-jisx0208))
+ mnemonic "MULE/7bit"
+ ))
+
+(copy-coding-system 'iso-2022-jp 'junet)
+
+;; (make-coding-system
+;; 'shift_jis 1 ?S
+;; "Coding-system of Shift-JIS used in Japan." t)
+
+(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)
+
+;; (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))
+
+(make-coding-system
+ 'iso-2022-jp-1978-irv 'iso2022
+ "Coding-system used for old JIS terminal."
+ '(charset-g0 ascii
+ short t
+ seven t
+ output-charset-conversion ((ascii latin-jisx0201)
+ (japanese-jisx0208 japanese-jisx0208-1978))
+ mnemonic "Ja-78/7bit"
+ ))
+
+;;(define-coding-system-alias 'iso-2022-jp-1978-irv 'old-jis)
+
+(copy-coding-system 'iso-2022-jp-1978-irv 'old-jis)
+
+;; (make-coding-system
+;; 'euc-japan-1990 2 ?E
+;; "Coding-system of Japanese EUC (Extended Unix Code)."
+;; '(ascii japanese-jisx0208 katakana-jisx0201 japanese-jisx0212
+;; short ascii-eol ascii-cntl nil nil single-shift))
+
+(make-coding-system
+ 'euc-jp 'iso2022
+ "Coding-system of Japanese EUC (Extended Unix Code)."
+ '(charset-g0 ascii
+ charset-g1 japanese-jisx0208
+ charset-g2 katakana-jisx0201
+ charset-g3 japanese-jisx0212
+ short t
+ mnemonic "Ja/EUC"
+ ))
+
+;;(define-coding-system-alias 'euc-japan-1990 'euc-japan)
+
+(copy-coding-system 'euc-jp 'euc-japan) ; only for w3
+(copy-coding-system 'euc-jp 'japanese-euc)
+
+(set-language-info-alist
+ "Japanese" '((setup-function . setup-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 (\e$BF|K\8l\e(B) \e$B$3$s$K$A$O\e(B, \e(I:]FAJ\e(B")
+ (documentation . t)))
+
+;;; japanese.el ends here
--- /dev/null
+;;; misc-lang.el --- support for miscellaneous languages (characters)
+
+;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1997 MORIOKA Tomohiko
+
+;; Keywords: multilingual, character set, coding system
+
+;; 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.
+
+;;; Code:
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; IPA (International Phonetic Alphabet)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(make-charset 'ipa "International Phonetic Alphabet"
+ '(registry "MuleIPA"
+ dimension 1
+ chars 96
+ final ?0
+ graphic 1
+ )) ; for XEmacs
+
+(defun setup-ipa-environment ()
+ "Setup multilingual environment (MULE) for IPA."
+ (interactive)
+ (setup-english-environment))
+
+(set-language-info-alist
+ "IPA" '((setup-function . setup-ipa-environment)
+ (charset . (ipa))
+ (documentation . "\
+IPA is International Phonetic Alphabet for English, French, German
+and Italian.")))
+
+;;; misc-lang.el ends here
--- /dev/null
+;;; mule-category.el --- category 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:
+
+;; Functions for working with category tables, which are a particular
+;; type of char table. Some function names / arguments should be
+;; parallel with syntax tables.
+
+;; Written by Ben Wing <wing@666.com>. The initialization code
+;; at the end of this file comes from Mule.
+;; Some bugfixes by Jareth Hein <jhod@po.iijnet.or.jp>
+
+;;; Code:
+
+(defvar defined-category-hashtable (make-hashtable 50))
+
+(defun define-category (designator doc-string)
+ "Make a new category whose designator is DESIGNATOR.
+DESIGNATOR should be a visible letter of ' ' thru '~'.
+STRING is a doc string for the category.
+Letters of 'a' thru 'z' are already used or kept for the system."
+ (check-argument-type 'category-designator-p designator)
+ (check-argument-type 'stringp doc-string)
+ (puthash designator doc-string defined-category-hashtable))
+
+(defun undefine-category (designator)
+ "Undefine DESIGNATOR as a designator for a category."
+ (check-argument-type 'category-designator-p designator)
+ (remhash designator defined-category-hashtable))
+
+(defun defined-category-p (designator)
+ "Return non-nil if DESIGNATOR is a designator for a defined category."
+ (and (category-designator-p designator)
+ (gethash designator defined-category-hashtable)))
+
+(defun defined-category-list ()
+ "Return a list of the currently defined categories.
+Categories are given by their designators."
+ (let (list)
+ (maphash #'(lambda (key value)
+ (setq list (cons key list)))
+ defined-category-hashtable)
+ (nreverse list)))
+
+(defun undefined-category-designator ()
+ "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))
+ (setq a (1+ a)))
+ found))
+
+(defun category-doc-string (designator)
+ "Return the doc-string for the category denoted by DESIGNATOR."
+ (check-argument-type 'defined-category-p designator)
+ (gethash designator defined-category-hashtable))
+
+(defun modify-category-entry (char-range designator &optional table reset)
+ "Add a category to the categories associated with CHAR-RANGE.
+CHAR-RANGE is a single character or a range of characters,
+ as per `put-char-table'.
+The category is given by a designator character.
+The changes are made in TABLE, which defaults to the current buffer's
+ category table.
+If optional fourth argument RESET is non-nil, previous categories associated
+ with CHAR-RANGE are removed before adding the specified category."
+ (or table (setq table (category-table)))
+ (check-argument-type 'category-table-p table)
+ (check-argument-type 'defined-category-p designator)
+ (if reset
+ ;; clear all existing stuff.
+ (put-char-table char-range nil table))
+ (map-char-table
+ #'(lambda (key value)
+ ;; make sure that this range has a bit-vector assigned to it
+ (if (not (bit-vector-p value))
+ (setq value (make-bit-vector 95 0))
+ (setq value (copy-sequence value)))
+ ;; set the appropriate bit in that vector.
+ (aset value (- designator 32) 1)
+ ;; put the vector back, thus assuring we have a unique setting for this range
+ (put-char-table key value table))
+ table char-range))
+
+(defun char-category-list (char &optional table)
+ "Return a list of the categories that CHAR is in.
+TABLE defaults to the current buffer's category table.
+The categories are given by their designators."
+ (or table (setq table (category-table)))
+ (check-argument-type 'category-table-p table)
+ (let ((vec (get-char-table char table)))
+ (if (null vec) nil
+ (let ((a 32) list)
+ (while (< a 127)
+ (if (= 1 (aref vec (- a 32)))
+ (setq list (cons a list)))
+ (setq a (1+ a)))
+ (nreverse list)))))
+
+;; implimented 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.
+;Categories are specified by their designators."
+; (or table (setq table (category-table)))
+; (check-argument-type 'category-table-p table)
+; (check-argument-type 'category-designator-p category)
+; (let ((vec (get-char-table char table)))
+; (if (null vec) nil
+; (= 1 (aref vec (- category 32))))))
+
+(defun describe-category ()
+ "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)))
+
+(defun describe-category-table (table stream)
+ (let (first-char
+ last-char
+ prev-val
+ (describe-one
+ (lambda (first last value stream)
+ (if (and (bit-vector-p value)
+ (> (reduce '+ value) 0))
+ (progn
+ (if (equal first last)
+ (cond ((vectorp first)
+ (princ (format "%s, row %d"
+ (charset-name
+ (aref first 0))
+ (aref first 1))
+ stream))
+ ((charsetp first)
+ (princ (charset-name first) stream))
+ (t (princ first stream)))
+ (cond ((vectorp first)
+ (princ (format "%s, rows %d .. %d"
+ (charset-name
+ (aref first 0))
+ (aref first 1)
+ (aref last 1))
+ stream))
+ (t
+ (princ (format "%s .. %s" first last)
+ stream))))
+ (describe-category-code value stream))))))
+ (map-char-table
+ (lambda (range value)
+ (if (and (or
+ (and (characterp range)
+ (characterp first-char)
+ (eq (char-charset range) (char-charset first-char))
+ (= (char-to-int last-char) (1- (char-to-int range))))
+ (and (vectorp range)
+ (vectorp first-char)
+ (eq (aref range 0) (aref first-char 0))
+ (= (aref last-char 1) (1- (aref range 1))))
+ (equal value prev-val)))
+ (setq last-char range)
+ (if first-char
+ (progn
+ (funcall describe-one first-char last-char prev-val stream)
+ (setq first-char nil)))
+ (funcall describe-one range range value stream))
+ nil)
+ table)
+ (if first-char
+ (funcall describe-one first-char last-char prev-val stream))))
+
+(defun describe-category-code (code stream)
+ (let ((standard-output (or stream standard-output)))
+ (princ "\tin categories: ")
+ (if (not (bit-vector-p code))
+ (princ "(none)")
+ (let ((i 0)
+ already-matched)
+ (while (< i 95)
+ (if (= 1 (aref code i))
+ (progn
+ (if (not already-matched)
+ (setq already-matched t)
+ (princ " "))
+ (princ (int-to-char (+ 32 i)))))
+ (setq i (1+ i)))
+ (if (not already-matched)
+ (princ "(none)")))
+ (let ((i 0))
+ (while (< i 95)
+ (if (= 1 (aref code i))
+ (princ (format "\n\t\tmeaning: %s"
+ (category-doc-string (int-to-char (+ 32 i))))))
+ (setq i (1+ i)))))
+ (terpri)))
+
+(defconst predefined-category-list
+ '((latin-iso8859-1 ?l "Latin-1 through Latin-5 character set")
+ (latin-iso8859-2 ?l)
+ (latin-iso8859-3 ?l)
+ (latin-iso8859-4 ?l)
+ (latin-iso8859-9 ?l)
+ (cyrillic-iso8859-5 ?y "Cyrillic character set")
+ (arabic-iso8859-6 ?b "Arabic character set")
+ (greek-iso8859-7 ?g "Greek character set")
+ (hebrew-iso8859-8 ?w "Hebrew character set")
+ (katakana-jisx0201 ?k "Japanese 1-byte Katakana character set")
+ (latin-jisx0201 ?r "Japanese 1-byte Roman character set")
+ (japanese-jisx0208-1978 ?j "Japanese 2-byte character set (old)")
+ (japanese-jisx0208 ?j "Japanese 2-byte character set")
+ (japanese-jisx0212 ?j)
+ (chinese-gb2312 ?c "Chinese GB (China, PRC) 2-byte character set")
+ (chinese-cns11643-1 ?t "Chinese Taiwan (CNS or Big5) 2-byte character set")
+ (chinese-cns11643-2 ?t)
+ (chinese-big5-1 ?t)
+ (chinese-big5-2 ?t)
+ (korean-ksc5601 ?h "Hangul (Korean) 2-byte character set")
+ )
+ "List of predefined categories.
+Each element is a list of a charset, a designator, and maybe a doc string.")
+
+(let (i l)
+ (define-category ?a "ASCII character set.")
+ (setq i 32)
+ (while (< i 127)
+ (modify-category-entry i ?a)
+ (setq i (1+ i)))
+ (setq l predefined-category-list)
+ (while l
+ (if (and (nth 2 (car l))
+ (not (defined-category-p (nth 2 (car l)))))
+ (define-category (nth 1 (car l)) (nth 2 (car l))))
+ (modify-category-entry (car (car l)) (nth 1 (car l)))
+ (setq l (cdr l))))
+
+;;; 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\\)"
+ "Regular expression of such characters which can be a word across newline.")
+
+(defvar ascii-char "[\40-\176]")
+(defvar ascii-space "[ \t]")
+(defvar ascii-symbols "[\40-\57\72-\100\133-\140\173-\176]")
+(defvar ascii-numeric "[\60-\71]")
+(defvar ascii-English-Upper "[\101-\132]")
+(defvar ascii-English-Lower "[\141-\172]")
+(defvar ascii-alphanumeric "[\60-\71\101-\132\141-\172]")
+
+(defvar kanji-char "\\cj")
+(defvar kanji-space "\e$B!!\e(B")
+(defvar kanji-symbols "\\cS")
+(defvar kanji-numeric "[\e$B#0\e(B-\e$B#9\e(B]")
+(defvar kanji-English-Upper "[\e$B#A\e(B-\e$B#Z\e(B]")
+(defvar kanji-English-Lower "[\e$B#a\e(B-\e$B#z\e(B]")
+(defvar kanji-hiragana "\\cH")
+(defvar kanji-katakana "\\cK")
+(defvar kanji-Greek-Upper "[\e$B&!\e(B-\e$B&8\e(B]")
+(defvar kanji-Greek-Lower "[\e$B&A\e(B-\e$B&X\e(B]")
+(defvar kanji-Russian-Upper "[\e$B'!\e(B-\e$B'A\e(B]")
+(defvar kanji-Russian-Lower "[\e$B'Q\e(B-\e$B'q\e(B]")
+(defvar kanji-Kanji-1st-Level "[\e$B0!\e(B-\e$BOS\e(B]")
+(defvar kanji-Kanji-2nd-Level "[\e$BP!\e(B-\e$Bt$\e(B]")
+
+(defvar kanji-kanji-char "\\(\\cH\\|\\cK\\|\\cC\\)")
--- /dev/null
+;;; mule-charset.el --- Charset functions for Mule.
+;; Copyright (C) 1992 Free Software Foundation, Inc.
+;; Copyright (C) 1995 Amdahl Corporation.
+;; Copyright (C) 1996 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.
+
+\f
+;;;; Composite character support
+
+(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)))
+
+(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))))))))))
+
+\f
+;;;; Classifying text according to charsets
+
+(defun charsets-in-region (start end &optional buffer)
+ "Return a list of the charsets in the region between START and END.
+BUFFER defaults to the current buffer if omitted."
+ (let (list)
+ (save-excursion
+ (if buffer
+ (set-buffer buffer))
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let* (prev-charset
+ (ch (char-after (point)))
+ (charset (char-charset ch)))
+ (if (not (eq prev-charset charset))
+ (progn
+ (setq prev-charset charset)
+ (or (memq charset list)
+ (setq list (cons charset list))))))
+ (forward-char))))
+ list))
+
+(defun charsets-in-string (string)
+ "Return a list of the charsets in STRING."
+ (let ((i 0)
+ (len (length string))
+ prev-charset charset list)
+ (while (< i len)
+ (setq charset (char-charset (aref string i)))
+ (if (not (eq prev-charset charset))
+ (progn
+ (setq prev-charset charset)
+ (or (memq charset list)
+ (setq list (cons charset list)))))
+ (setq i (1+ i)))
+ list))
+
+\f
+;;;; Charset accessors
+
+(defun charset-graphic (charset)
+ "Return the `graphic' property of CHARSET.
+See `make-charset'."
+ (charset-property charset 'graphic))
+
+(defun charset-final (charset)
+ "Return the final byte of the ISO 2022 escape sequence designating CHARSET."
+ (charset-property charset 'final))
+
+(defun charset-chars (charset)
+ "Return the number of characters per dimension of CHARSET."
+ (charset-property charset 'chars))
+
+(defun charset-columns (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))
+
+(defun charset-direction (charset)
+ "Return the display direction (`l2r' or `r2l') of CHARSET."
+ (charset-property charset 'direction))
+
+(defun charset-registry (charset)
+ "Return the registry of CHARSET.
+This is a regular expression matching the registry field of fonts
+that can display the characters in CHARSET."
+ (charset-property charset 'registry))
+
+(defun charset-ccl-program (charset)
+ "Return the CCL program of CHARSET.
+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))
+
+;;;; Define setf methods for all settable Charset properties
+
+(defsetf charset-registry set-charset-registry)
+(defsetf charset-ccl-program set-charset-ccl-program)
--- /dev/null
+;;; mule-cmds.el --- Commands for multilingual environment
+
+;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1997 MORIOKA Tomohiko
+
+;; Keywords: mule, multilingual
+
+;; 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.
+
+;;; Code:
+
+;;; MULE related key bindings and menus.
+
+(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)
+
+(define-key mule-keymap "f" 'set-buffer-file-coding-system)
+(define-key mule-keymap "F" 'set-default-buffer-file-coding-system) ; XEmacs
+(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 "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 "r" 'toggle-display-direction) ; XEmacs
+(define-key mule-keymap "l" 'set-language-environment)
+
+(define-key help-map "\C-L" 'describe-language-support)
+(define-key help-map "L" 'describe-language-environment)
+(define-key help-map "\C-\\" 'describe-input-method)
+(define-key help-map "I" 'describe-input-method)
+(define-key help-map "C" 'describe-coding-system)
+(define-key help-map "h" 'view-hello-file)
+
+;; Menu for XEmacs were moved to menubar-items.el.
+
+
+;; This should be a single character key binding because users use it
+;; very frequently while editing multilingual text. Now we can use
+;; only two such keys: "\C-\\" and "\C-^", but the latter is not
+;; convenient because it requires shifting on most keyboards. An
+;; alternative is "\C-\]" which is now bound to `abort-recursive-edit'
+;; but it won't be used that frequently.
+(define-key global-map "\C-\\" 'toggle-input-method)
+
+(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))
+ (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: "))
+ (keyseq (read-key-sequence
+ (format "Command to execute with %s:" coding-system)))
+ (cmd (key-binding keyseq)))
+ (let ((coding-system-for-read coding-system)
+ (coding-system-for-write coding-system))
+ (message "")
+ (call-interactively cmd))))
+
+(defun set-default-coding-systems (coding-system)
+ "Set default value of various coding systems to CODING-SYSTEM.
+The follwing coding systems are set:
+ 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"
+ (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)
+ (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))
+ (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)))
+ '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:
+ 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"
+ (interactive "zPrefer coding system: ")
+ (if (not (and coding-system (coding-system-p coding-system)))
+ (error "Invalid coding system `%s'" coding-system))
+ (let ((coding-category (coding-system-category coding-system))
+ (parent (coding-system-parent 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)))
+ ;; 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))))
+
+\f
+;;; Language support staffs.
+
+(defvar language-info-alist nil
+ "Alist of language names vs the corresponding information of various kind.
+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.")
+
+(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)))
+ (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.
+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'.
+
+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)))
+ (let (lang-slot key-slot)
+ (setq lang-slot (assoc language-name language-info-alist))
+ (if (null lang-slot) ; If no slot for the language, add it.
+ (setq lang-slot (list language-name)
+ 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
+ "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))))
+ ))
+
+ (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))))
+
+(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."
+ (let* ((completion-ignore-case t)
+ (name (completing-read prompt
+ language-info-alist
+ (function (lambda (elm) (assq key elm)))
+ t nil default)))
+ (if (and (> (length name) 0)
+ (get-language-info name key))
+ name)))
+\f
+;;; Multilingual input methods.
+
+(defconst leim-list-file-name "leim-list.el"
+ "Name of LEIM list file.
+This file contains a list of libraries of Emacs input methods (LEIM)
+in the format of Lisp expression for registering each input method.
+Emacs loads this file at startup time.")
+
+(defvar leim-list-header (format
+";;; %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
+;; the whole input methods in Emacs.
+;;
+;; Each entry has the form:
+;; (register-input-method
+;; INPUT-METHOD LANGUAGE-NAME ACTIVATE-FUNC
+;; TITLE DESCRIPTION
+;; ARG ...)
+;; See the function `register-input-method' for the meanings of arguments.
+;;
+;; If this directory is included in load-path, Emacs automatically
+;; loads this file at startup time.
+
+"
+ leim-list-file-name)
+ "Header to be inserted in LEIM list file.")
+
+(defvar leim-list-entry-regexp "^(register-input-method"
+ "Regexp matching head of each entry in LEIM list file.
+See also the variable `leim-list-header'")
+
+(defvar update-leim-list-functions
+ '(quail-update-leim-list-file)
+ "List of functions to call to update LEIM list file.
+Each function is called with one arg, LEIM directory name.")
+
+(defun update-leim-list-file (&rest dirs)
+ "Update LEIM list file in directories DIRS."
+ (let ((functions update-leim-list-functions))
+ (while functions
+ (apply (car functions) dirs)
+ (setq functions (cdr functions)))))
+
+(defvar current-input-method nil
+ "The current input method for multilingual text.
+If nil, that means no input method is activated now.")
+(make-variable-buffer-local 'current-input-method)
+(put 'current-input-method 'permanent-local t)
+
+(defvar current-input-method-title nil
+ "Title string of the current input method shown in mode line.")
+(make-variable-buffer-local 'current-input-method-title)
+(put 'current-input-method-title 'permanent-local t)
+
+(defcustom default-input-method nil
+ "*Default input method for multilingual text.
+This is the input method activated automatically by the command
+`toggle-input-method' (\\[toggle-input-method])."
+ :group 'mule)
+
+(defvar input-method-history nil
+ "History list for some commands that read input methods.")
+(make-variable-buffer-local 'input-method-history)
+(put 'input-method-history 'permanent-local t)
+
+(defvar inactivate-current-input-method-function nil
+ "Function to call for inactivating the current input method.
+Every input method should set this to an appropriate value when activated.
+This function is called with no argument.
+
+This function should never change the value of `current-input-method'.
+It is set to nil by the function `inactivate-input-method'.")
+(make-variable-buffer-local 'inactivate-current-input-method-function)
+(put 'inactivate-current-input-method-function 'permanent-local t)
+
+(defvar describe-current-input-method-function nil
+ "Function to call for describing the current input method.
+This function is called with no argument.")
+(make-variable-buffer-local 'describe-current-input-method-function)
+(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.
+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.")
+
+(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.
+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)))
+ (if (symbolp input-method)
+ (setq input-method (symbol-name input-method)))
+ (let ((info (cons language-name args))
+ (slot (assoc input-method input-method-alist)))
+ (if slot
+ (setcdr slot info)
+ (setq slot (cons input-method info))
+ (setq input-method-alist (cons slot input-method-alist)))))
+
+(defun read-input-method-name (prompt &optional default inhibit-null)
+ "Read a name of input method from a minibuffer prompting with PROMPT.
+If DEFAULT is non-nil, use that as the default,
+ and substitute it into PROMPT at the first `%s'.
+If INHIBIT-NULL is non-nil, null input signals an error.
+
+The return value is a string."
+ (if default
+ (setq prompt (format prompt default)))
+ (let* ((completion-ignore-case t)
+ ;; 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)
+ ))
+ (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)
+ (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
+ (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))
+ (setq current-input-method input-method)
+ (setq current-input-method-title (nth 3 slot))
+ (run-hooks 'input-method-activate-hook))))
+
+(defun inactivate-input-method ()
+ "Turn off the current input method."
+ (when current-input-method
+ (if input-method-history
+ (unless (string= current-input-method (car input-method-history))
+ (setq input-method-history
+ (cons current-input-method
+ (delete current-input-method input-method-history))))
+ (setq input-method-history (list current-input-method)))
+ (unwind-protect
+ (funcall inactivate-current-input-method-function)
+ (unwind-protect
+ (run-hooks 'input-method-inactivate-hook)
+ (setq current-input-method nil
+ current-input-method-title nil)))))
+
+(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."
+ (interactive
+ (let* ((default (or (car input-method-history) default-input-method)))
+ (list (read-input-method-name
+ (if default "Select input method (default %s): " "Select input method: ")
+ default t))))
+ (activate-input-method input-method)
+ (setq default-input-method input-method))
+
+(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.
+
+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').
+
+When there's no input method to turn on, turn on what read from minibuffer."
+ (interactive "P")
+ (let* ((default (or (car input-method-history) default-input-method)))
+ (if (and current-input-method (not arg))
+ (inactivate-input-method)
+ (activate-input-method
+ (if (or arg (not default))
+ (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."
+ (interactive
+ (list (read-input-method-name
+ "Describe input method (default, current choice): ")))
+ (if (and input-method (symbolp input-method))
+ (setq input-method (symbol-name input-method)))
+ (if (null input-method)
+ (describe-current-input-method)
+ (with-output-to-temp-buffer "*Help*"
+ (let ((elt (assoc input-method input-method-alist)))
+ (princ (format "Input method: %s (`%s' in mode line) for %s\n %s\n"
+ input-method (nth 3 elt) (nth 1 elt) (nth 4 elt)))))))
+
+(defun describe-current-input-method ()
+ "Describe the input method currently in use."
+ (if current-input-method
+ (if (and (symbolp describe-current-input-method-function)
+ (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))
+ (ding))
+ (error "No input method is activated now")))
+
+(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
+initially.
+Optional 3rd argument INPUT-METHOD specifies the input method
+to be activated instead of the one selected last time. It is a symbol
+or a string."
+ (setq input-method
+ (or 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)))
+
+;; 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.
+
+The extra guidance is done by showing list of available keys in echo
+area.
+
+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
+ :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."
+ :type 'boolean
+ :group 'mule)
+
+(defvar input-method-activate-hook nil
+ "Normal hook run just after an input method is activated.
+
+The variable `current-input-method' keeps the input method name
+just activated.")
+
+(defvar input-method-inactivate-hook nil
+ "Normal hook run just after an input method is inactivated.
+
+The variable `current-input-method' still keeps the input method name
+just inacitvated.")
+
+(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-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.
+But, if this flag is non-nil, the input method is never back on.")
+
+\f
+(defun setup-specified-language-environment ()
+ "Set up multi-lingual environment convenient for the specified language."
+ (interactive)
+ (let (language-name)
+ (if (and (symbolp last-command-event)
+ (or (not (eq last-command-event 'Default))
+ (setq last-command-event 'English))
+ (setq language-name (symbol-name last-command-event)))
+ (set-language-environment language-name)
+ (error "Bogus calling sequence"))))
+
+(defvar current-language-environment "English"
+ "The last language environment specified with `set-language-environment'.")
+
+(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: ")))
+ (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))
+ (error "Language environment not defined: %S" language-name))
+ (funcall (get-language-info language-name 'setup-function))
+ (setq current-language-environment language-name)
+ (force-mode-line-update t))
+
+;; Print all arguments with `princ', then print "\n".
+(defsubst princ-list (&rest args)
+ (while args (princ (car args)) (setq args (cdr args)))
+ (princ "\n"))
+
+;; Print a language specific information such as input methods,
+;; charsets, and coding systems. This function is intended to be
+;; called from the menu:
+;; [menu-bar mule describe-language-environment LANGUAGE]
+;; and should not run it by `M-x describe-current-input-method-function'.
+(defun describe-specified-language-support ()
+ "Describe how Emacs supports the specified language environment."
+ (interactive)
+ (let (language-name)
+ (if (not (and (symbolp last-command-event)
+ (setq language-name (symbol-name last-command-event))))
+ (error "Bogus calling sequence"))
+ (describe-language-environment language-name)))
+
+(defun describe-language-environment (language-name)
+ "Describe how Emacs supports language environment LANGUAGE-NAME."
+ (interactive
+ (list (read-language-name
+ 'documentation
+ "Describe language environment (default, current choise): ")))
+ (if (null language-name)
+ (setq language-name current-language-environment))
+ (if (or (null language-name)
+ (null (get-language-info language-name 'documentation)))
+ (error "No documentation for the specified language"))
+ (if (symbolp language-name)
+ (setq language-name (symbol-name language-name)))
+ (let ((doc (get-language-info language-name 'documentation)))
+ (with-output-to-temp-buffer "*Help*"
+ (if (stringp doc)
+ (progn
+ (princ-list doc)
+ (terpri)))
+ (let ((str (get-language-info language-name 'sample-text)))
+ (if (stringp str)
+ (progn
+ (princ "Sample text:\n")
+ (princ-list " " str)
+ (terpri))))
+ (princ "Input methods:\n")
+ (let ((l input-method-alist))
+ (while l
+ (if (string= language-name (nth 1 (car l)))
+ (princ-list " " (car (car l))
+ (format " (`%s' in mode line)" (nth 3 (car l)))))
+ (setq l (cdr l))))
+ (terpri)
+ (princ "Character sets:\n")
+ (let ((l (get-language-info language-name 'charset)))
+ (if (null l)
+ (princ-list " nothing specific to " language-name)
+ (while l
+ (princ-list " " (car l) ": "
+ (charset-description (car l)))
+ (setq l (cdr l)))))
+ (terpri)
+ (princ "Coding systems:\n")
+ (let ((l (get-language-info language-name 'coding-system)))
+ (if (null l)
+ (princ-list " nothing specific to " language-name)
+ (while l
+ (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))))
+ (setq l (cdr l))))))))
+\f
+;;; Charset property
+
+;; (defsubst get-charset-property (charset propname)
+;; "Return the value of CHARSET's PROPNAME property.
+;; This is the last value stored with
+;; `(put-charset-property CHARSET PROPNAME VALUE)'."
+;; (plist-get (charset-plist charset) propname))
+
+;; (defsubst put-charset-property (charset propname value)
+;; "Store CHARSETS's PROPNAME property with value VALUE.
+;; It can be retrieved with `(get-charset-property CHARSET PROPNAME)'."
+;; (set-charset-plist charset
+;; (plist-put (charset-plist charset) propname value)))
+
+(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)))
+(defun get-char-code-property (char propname)
+ "Return the value of CHAR's PROPNAME property in `char-code-property-table'."
+ (let ((plist (get-char-table char char-code-property-table)))
+ (if (listp plist)
+ (car (cdr (memq propname plist))))))
+
+(defun put-char-code-property (char propname value)
+ "Store CHAR's PROPNAME property with VALUE in `char-code-property-table'.
+It can be retrieved with `(get-char-code-property CHAR PROPNAME)'."
+ (let ((plist (get-char-table char char-code-property-table)))
+ (if plist
+ (let ((slot (memq propname plist)))
+ (if slot
+ (setcar (cdr slot) value)
+ (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)))))
+
+;;; mule-cmds.el ends here
--- /dev/null
+;;; mule-coding.el --- Coding-system functions for Mule.
+
+;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1995 Amdahl Corporation.
+;; Copyright (C) 1995 Sun Microsystems.
+;; Copyright (C) 1997 MORIOKA Tomohiko
+
+;; 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:
+
+;;; split off of mule.el and mostly moved to coding.el
+
+;;; Code:
+
+(defun coding-system-force-on-output (coding-system register)
+ "Return the 'force-on-output property of CODING-SYSTEM for the specified REGISTER."
+ (unless (integerp register)
+ (signal 'wrong-type-argument (list 'integerp register)))
+ (coding-system-property
+ coding-system
+ (case register
+ (0 'force-g0-on-output)
+ (1 'force-g1-on-output)
+ (2 'force-g2-on-output)
+ (3 'force-g3-on-output)
+ (t (signal 'args-out-of-range (list register 0 3))))))
+
+(defun coding-system-short (coding-system)
+ "Return the 'short property of CODING-SYSTEM."
+ (coding-system-property coding-system 'short))
+
+(defun coding-system-no-ascii-eol (coding-system)
+ "Return the 'no-ascii-eol property of CODING-SYSTEM."
+ (coding-system-property coding-system 'no-ascii-eol))
+
+(defun coding-system-no-ascii-cntl (coding-system)
+ "Return the 'no-ascii-cntl property of CODING-SYSTEM."
+ (coding-system-property coding-system 'no-ascii-cntl))
+
+(defun coding-system-seven (coding-system)
+ "Return the 'seven property of CODING-SYSTEM."
+ (coding-system-property coding-system 'seven))
+
+(defun coding-system-lock-shift (coding-system)
+ "Return the 'lock-shift property of CODING-SYSTEM."
+ (coding-system-property coding-system 'lock-shift))
+
+;;(defun coding-system-use-japanese-jisx0201-roman (coding-system)
+;; "Return the 'use-japanese-jisx0201-roman property of CODING-SYSTEM."
+;; (coding-system-property coding-system 'use-japanese-jisx0201-roman))
+
+;;(defun coding-system-use-japanese-jisx0208-1978 (coding-system)
+;; "Return the 'use-japanese-jisx0208-1978 property of CODING-SYSTEM."
+;; (coding-system-property coding-system 'use-japanese-jisx0208-2978))
+
+(defun coding-system-no-iso6429 (coding-system)
+ "Return the 'no-iso6429 property of CODING-SYSTEM."
+ (coding-system-property coding-system 'no-iso6429))
+
+(defun coding-system-ccl-encode (coding-system)
+ "Return the CCL 'encode property of CODING-SYSTEM."
+ (coding-system-property coding-system 'encode))
+
+(defun coding-system-ccl-decode (coding-system)
+ "Return the CCL 'decode property of CODING-SYSTEM."
+ (coding-system-property coding-system 'decode))
+
+\f
+;;;; Definitions of predefined coding systems
+
+(make-coding-system
+ 'ctext 'iso2022
+ "Coding-system used in X as Compound Text Encoding."
+ '(charset-g0 ascii
+ charset-g1 latin-iso8859-1
+ eol-type nil
+ mnemonic "CText"))
+
+;;; iso-8859-1 and ctext are aliases.
+
+;; (copy-coding-system 'ctext 'iso-8859-1)
+(make-coding-system
+ 'iso-8859-1 'no-conversion
+ "Coding-system used in X as Compound Text Encoding."
+ '(eol-type nil mnemonic "Noconv"))
+
+(make-coding-system
+ 'iso-2022-8bit-ss2 'iso2022
+ "ISO-2022 coding system using SS2 for 96-charset in 8-bit code."
+ '(charset-g0 ascii
+ charset-g1 latin-iso8859-1
+ charset-g2 t ;; unspecified but can be used later.
+ short t
+ mnemonic "ISO8/SS"
+ ))
+
+(make-coding-system
+ 'iso-2022-7bit-ss2 'iso2022
+ "ISO-2022 coding system using SS2 for 96-charset in 7-bit code."
+ '(charset-g0 ascii
+ charset-g2 t ;; unspecified but can be used later.
+ seven t
+ short t
+ mnemonic "ISO7/SS"
+ eol-type nil))
+
+;; (copy-coding-system 'iso-2022-7bit-ss2 'iso-2022-jp-2)
+(make-coding-system
+ 'iso-2022-jp-2 'iso2022
+ "ISO-2022 coding system using SS2 for 96-charset in 7-bit code."
+ '(charset-g0 ascii
+ charset-g2 t ;; unspecified but can be used later.
+ seven t
+ short t
+ mnemonic "ISO7/SS"
+ eol-type nil))
+
+(make-coding-system
+ 'iso-2022-7bit 'iso2022
+ "ISO 2022 based 7-bit encoding using only G0"
+ '(charset-g0 ascii
+ seven t
+ short t
+ mnemonic "ISO7"))
+
+;; compatibility for old XEmacsen
+(copy-coding-system 'iso-2022-7bit 'iso-2022-7)
+
+(make-coding-system
+ 'iso-2022-8 'iso2022
+ "ISO-2022 eight-bit coding system. No single-shift or locking-shift."
+ '(charset-g0 ascii
+ charset-g1 latin-iso8859-1
+ short t
+ mnemonic "ISO8"
+ ))
+
+(make-coding-system
+ 'escape-quoted 'iso2022
+ "ISO-2022 eight-bit coding system with escape quoting; used for .ELC files."
+ '(charset-g0 ascii
+ charset-g1 latin-iso8859-1
+ eol-type lf
+ escape-quoted t
+ mnemonic "ESC/Quot"
+ ))
+
+(make-coding-system
+ 'iso-2022-lock 'iso2022
+ "ISO-2022 coding system using Locking-Shift for 96-charset."
+ '(charset-g0 ascii
+ charset-g1 t ;; unspecified but can be used later.
+ seven t
+ lock-shift t
+ mnemonic "ISO7/Lock"
+ ))
+
+;; initialize the coding categories to something semi-reasonable
+;; so that the remaining Lisp files can contain extended characters.
+;; (They will be in ISO-7 format)
+
+(set-coding-priority-list '(iso-8-2 iso-8-designate iso-8-1
+ iso-7 iso-lock-shift no-conversion))
+
+(set-coding-category-system 'iso-7 'iso-2022-7)
+(set-coding-category-system 'iso-8-designate 'ctext)
+(set-coding-category-system 'iso-8-1 'ctext)
+(set-coding-category-system 'iso-lock-shift 'iso-2022-lock)
+(set-coding-category-system 'no-conversion 'no-conversion)
+
+;;; mule-coding.el ends here
--- /dev/null
+;;; vietnamese-chars.el --- pre-loaded support for Vietnamese, part 1.
+
+;; 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.
+
+;;; Synched up with: Mule 2.3.
+
+;; We have to split up the Vietnamese stuff into two files because
+;; we are registering new charsets and then immediately using characters
+;; from those sets. We cannot reliably expect this to work if they
+;; are in the same file because of the buffering that happens while
+;; reading -- the place where we use the newly-defined sets may be
+;; read in before the code that creates those sets is evaluated.
+
+;; Vietnamese VISCII with two tables.
+(make-charset 'vietnamese-viscii-lower "VISCII lower (Vietnamese)"
+ '(registry "VISCII1.1"
+ dimension 1
+ chars 96
+ final ?1
+ graphic 1
+ ))
+
+(make-charset 'vietnamese-viscii-upper "VISCII upper (Vietnamese)"
+ '(registry "VISCII1.1"
+ dimension 1
+ chars 96
+ final ?2
+ graphic 1
+ ))
+
+(modify-syntax-entry 'vietnamese-viscii-lower "w")
+(modify-syntax-entry 'vietnamese-viscii-upper "w")
+
+(define-category ?v "Vietnamese character.")
+(modify-category-entry 'vietnamese-viscii-lower ?v)
+(modify-category-entry 'vietnamese-viscii-upper ?v)
+
+;;; vietnamese-chars.el ends here
--- /dev/null
+;;; obsolete.el --- obsoleteness support
+
+;; Copyright (C) 1985-1994, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1995 Amdahl Corporation.
+;; Copyright (C) 1995 Sun Microsystems.
+
+;; 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.
+
+;; The obsoleteness support used to be scattered throughout various
+;; source files. We put the stuff in one place to remove the junkiness
+;; from other source files and to facilitate creating/updating things
+;; like sysdep.el.
+
+;;; Code:
+
+(defsubst define-obsolete-function-alias (oldfun newfun)
+ "Define OLDFUN as an obsolete alias for function NEWFUN.
+This makes calling OLDFUN equivalent to calling NEWFUN and marks OLDFUN
+as obsolete."
+ (define-function oldfun newfun)
+ (make-obsolete oldfun newfun))
+
+(defsubst define-compatible-function-alias (oldfun newfun)
+ "Define OLDFUN as a compatible alias for function NEWFUN.
+This makes calling OLDFUN equivalent to calling NEWFUN and marks OLDFUN
+as provided for compatibility only."
+ (define-function oldfun newfun)
+ (make-compatible oldfun newfun))
+
+(defsubst define-obsolete-variable-alias (oldvar newvar)
+ "Define OLDVAR as an obsolete alias for variable NEWVAR.
+This makes referencing or setting OLDVAR equivalent to referencing or
+setting NEWVAR and marks OLDVAR as obsolete.
+If OLDVAR was bound and NEWVAR was not, Set NEWVAR to OLDVAR.
+
+Note: Use this before any other references (defvar/defcustom) to NEWVAR"
+ (let ((needs-setting (and (boundp oldvar) (not (boundp newvar))))
+ (value (and (boundp oldvar) (symbol-value oldvar))))
+ (defvaralias oldvar newvar)
+ (make-obsolete-variable oldvar newvar)
+ (and needs-setting (set newvar value))))
+
+(defsubst define-compatible-variable-alias (oldvar newvar)
+ "Define OLDVAR as a compatible alias for variable NEWVAR.
+This makes referencing or setting OLDVAR equivalent to referencing or
+setting NEWVAR and marks OLDVAR as provided for compatibility only."
+ (defvaralias oldvar newvar)
+ (make-compatible-variable oldvar newvar))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; device stuff
+
+(make-compatible-variable 'window-system "use (console-type)")
+
+(defun x-display-color-p (&optional device)
+ "Return t if DEVICE is a color device."
+ (eq 'color (device-class device)))
+(make-compatible 'x-display-color-p 'device-class)
+
+(define-function 'x-color-display-p 'x-display-color-p)
+(make-compatible 'x-display-color-p 'device-class)
+
+(defun x-display-grayscale-p (&optional device)
+ "Return t if DEVICE is a grayscale device."
+ (eq 'grayscale (device-class device)))
+(make-compatible 'x-display-grayscale-p 'device-class)
+
+(define-function 'x-grayscale-display-p 'x-display-grayscale-p)
+(make-compatible 'x-display-grayscale-p 'device-class)
+
+(define-compatible-function-alias 'x-display-pixel-width 'device-pixel-width)
+(define-compatible-function-alias 'x-display-pixel-height 'device-pixel-height)
+(define-compatible-function-alias 'x-display-planes 'device-bitplanes)
+(define-compatible-function-alias 'x-display-color-cells 'device-color-cells)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; events
+
+(define-obsolete-function-alias 'menu-event-p 'misc-user-event-p)
+(make-obsolete-variable 'unread-command-char 'unread-command-events)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; extents
+
+(make-obsolete 'set-window-dot 'set-window-point)
+
+(define-obsolete-function-alias 'extent-buffer 'extent-object)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; frames
+(defun frame-first-window (frame)
+ "Return the topmost, leftmost window of FRAME.
+If omitted, FRAME defaults to the currently selected frame."
+ (frame-highest-window frame 0))
+(make-compatible 'frame-first-window 'frame-highest-window)
+
+(define-obsolete-variable-alias 'initial-frame-alist 'initial-frame-plist)
+(define-obsolete-variable-alias 'minibuffer-frame-alist
+ 'minibuffer-frame-plist)
+(define-obsolete-variable-alias 'pop-up-frame-alist 'pop-up-frame-plist)
+(define-obsolete-variable-alias 'special-display-frame-alist
+ 'special-display-frame-plist)
+
+;; Defined in C.
+
+(define-obsolete-variable-alias 'default-frame-alist 'default-frame-plist)
+(define-obsolete-variable-alias 'default-x-frame-alist 'default-x-frame-plist)
+(define-obsolete-variable-alias 'default-tty-frame-alist
+ 'default-tty-frame-plist)
+
+(make-compatible 'frame-parameters 'frame-property)
+(defun frame-parameters (&optional frame)
+ "Return the parameters-alist of frame FRAME.
+It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
+The meaningful PARMs depend on the kind of frame.
+If FRAME is omitted, return information on the currently selected frame.
+
+See the variables `default-frame-plist', `default-x-frame-plist', and
+`default-tty-frame-plist' for a description of the parameters meaningful
+for particular types of frames."
+ (or frame (setq frame (selected-frame)))
+ ;; #### This relies on a `copy-sequence' of the user properties in
+ ;; `frame-properties'. Removing that would make `frame-properties' more
+ ;; efficient but this function less efficient, as we couldn't be
+ ;; destructive. Since most callers now use `frame-parameters', we'll
+ ;; do it this way. Should probably change this at some point in the
+ ;; future.
+ (destructive-plist-to-alist (frame-properties frame)))
+
+(make-compatible 'modify-frame-parameters 'set-frame-properties)
+(defun modify-frame-parameters (frame alist)
+ "Modify the properties of frame FRAME according to ALIST.
+ALIST is an alist of properties to change and their new values.
+Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
+The meaningful PARMs depend on the kind of frame.
+
+See `set-frame-properties' for built-in property names."
+ ;; it would be nice to be destructive here but that's not safe.
+ (set-frame-properties frame (alist-to-plist alist)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; faces
+
+(define-obsolete-function-alias 'list-faces-display 'edit-faces)
+(define-obsolete-function-alias 'list-faces 'face-list)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; paths
+
+(defvar Info-default-directory-list nil
+ "This used to be the initial value of Info-directory-list.
+If you want to change the locations where XEmacs looks for info files,
+set Info-directory-list.")
+(make-obsolete-variable 'Info-default-directory-list 'Info-directory-list)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; hooks
+
+(make-compatible-variable 'lisp-indent-hook 'lisp-indent-function)
+(make-compatible-variable 'comment-indent-hook 'comment-indent-function)
+(make-obsolete-variable 'temp-buffer-show-hook
+ 'temp-buffer-show-function)
+(make-obsolete-variable 'inhibit-local-variables
+ "use `enable-local-variables' (with the reversed sense).")
+(make-obsolete-variable 'suspend-hooks 'suspend-hook)
+(make-obsolete-variable 'first-change-function 'first-change-hook)
+(make-obsolete-variable 'before-change-function
+ "use before-change-functions; which is a list of functions rather than a single function.")
+(make-obsolete-variable 'after-change-function
+ "use after-change-functions; which is a list of functions rather than a single function.")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; insertion and deletion
+
+(define-compatible-function-alias 'insert-and-inherit 'insert)
+(define-compatible-function-alias 'insert-before-markers-and-inherit
+ 'insert-before-markers)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; keymaps
+
+(defun keymap-parent (keymap)
+ "Return the first parent of the given keymap."
+ (car (keymap-parents keymap)))
+(make-compatible 'keymap-parent 'keymap-parents)
+
+(defun set-keymap-parent (keymap parent)
+ "Make the given keymap have (only) the given parent."
+ (set-keymap-parents keymap (if parent (list parent) '()))
+ parent)
+(make-compatible 'set-keymap-parent 'set-keymap-parents)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; menu stuff
+
+(defun add-menu-item (menu-path item-name function enabled-p &optional before)
+ "Obsolete. See the function `add-menu-button'."
+ (or item-name (error "must specify an item name"))
+ (add-menu-button menu-path (vector item-name function enabled-p) before))
+(make-obsolete 'add-menu-item 'add-menu-button)
+
+(defun add-menu (menu-path menu-name menu-items &optional before)
+ "See the function `add-submenu'."
+ (or menu-name (error (gettext "must specify a menu name")))
+ (or menu-items (error (gettext "must specify some menu items")))
+ (add-submenu menu-path (cons menu-name menu-items) before))
+;; Can't make this obsolete. easymenu depends on it.
+(make-compatible 'add-menu 'add-submenu)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; minibuffer
+
+(define-compatible-function-alias 'read-minibuffer
+ 'read-expression) ; misleading name
+(define-compatible-function-alias 'read-input 'read-string)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; misc
+
+;; (defun user-original-login-name ()
+;; "Return user's login name from original login.
+;; This tries to remain unaffected by `su', by looking in environment variables."
+;; (or (getenv "LOGNAME") (getenv "USER") (user-login-name)))
+(define-obsolete-function-alias 'user-original-login-name 'user-login-name)
+
+; old names
+(define-obsolete-function-alias 'show-buffer 'set-window-buffer)
+(define-obsolete-function-alias 'buffer-flush-undo 'buffer-disable-undo)
+(make-compatible 'eval-current-buffer 'eval-buffer)
+(define-compatible-function-alias 'byte-code-function-p
+ 'compiled-function-p) ;FSFmacs
+
+;; 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...
+
+(make-obsolete-variable 'executing-macro 'executing-kbd-macro)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; modeline
+
+(define-compatible-function-alias 'redraw-mode-line 'redraw-modeline)
+(define-compatible-function-alias 'force-mode-line-update
+ 'redraw-modeline) ;; FSF compatibility
+(define-compatible-variable-alias 'mode-line-map 'modeline-map)
+(define-compatible-variable-alias 'mode-line-buffer-identification
+ 'modeline-buffer-identification)
+(define-compatible-variable-alias 'mode-line-process 'modeline-process)
+(define-compatible-variable-alias 'mode-line-modified 'modeline-modified)
+(make-compatible-variable 'mode-line-inverse-video
+ "use set-face-highlight-p and set-face-reverse-p")
+(define-compatible-variable-alias 'default-mode-line-format
+ 'default-modeline-format)
+(define-compatible-variable-alias 'mode-line-format 'modeline-format)
+(define-compatible-variable-alias 'mode-line-menu 'modeline-menu)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; mouse
+
+;;; (defun mouse-eval-last-sexpr (event)
+;;; (interactive "@e")
+;;; (save-excursion
+;;; (mouse-set-point event)
+;;; (eval-last-sexp nil)))
+
+(define-obsolete-function-alias 'mouse-eval-last-sexpr 'mouse-eval-sexp)
+
+(defun read-mouse-position (frame)
+ (cdr (mouse-position (frame-device frame))))
+(make-obsolete 'read-mouse-position 'mouse-position)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; redisplay
+
+(defun redraw-display (&optional device)
+ (if (eq device t)
+ (mapcar 'redisplay-device (device-list))
+ (redisplay-device device)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; window-system objects
+
+;; the functionality of column.el has been moved into C
+;; Function obsoleted for XEmacs 20.0/February 1997.
+(defalias 'display-column-mode 'column-number-mode)
+
+(defun x-color-values (color &optional frame)
+ "Return a description of the color named COLOR on frame FRAME.
+The value is a list of integer RGB values--(RED GREEN BLUE).
+These values appear to range from 0 to 65280 or 65535, depending
+on the system; white is (65280 65280 65280) or (65535 65535 65535).
+If FRAME is omitted or nil, use the selected frame."
+ (color-instance-rgb-components (make-color-instance color)))
+(make-compatible 'x-color-values 'color-instance-rgb-components)
+
+;; Two loser functions which shouldn't be used.
+(make-obsolete 'following-char 'char-after)
+(make-obsolete 'preceding-char 'char-before)
+
+
+;; The following several functions are useful in GNU Emacs 20 because
+;; of the multibyte "characters" the internal representation of which
+;; leaks into Lisp. In XEmacs/Mule they are trivial and unnecessary.
+;; We provide them for compatibility reasons solely.
+
+(defun string-to-sequence (string type)
+ "Convert STRING to a sequence of TYPE which contains characters in STRING.
+TYPE should be `list' or `vector'.
+Multibyte characters are concerned."
+ (ecase type
+ (list
+ (mapcar #'identity string))
+ (vector
+ (mapvector #'identity string))))
+
+(defun string-to-list (string)
+ "Return a list of characters in STRING."
+ (mapcar #'identity string))
+
+(defun string-to-vector (string)
+ "Return a vector of characters in STRING."
+ (mapvector #'identity string))
+
+(defun store-substring (string idx obj)
+ "Embed OBJ (string or character) at index IDX of STRING."
+ (let* ((str (cond ((stringp obj) obj)
+ ((characterp obj) (char-to-string obj))
+ (t (error
+ "Invalid argument (should be string or character): %s"
+ obj))))
+ (string-len (length string))
+ (len (length str))
+ (i 0))
+ (while (and (< i len) (< idx string-len))
+ (aset string idx (aref str i))
+ (setq idx (1+ idx) i (1+ i)))
+ string))
+
+;; ### 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 behaviour, we can always copy the FSF
+;; version, which is very long and does lots of unnecessary stuff.
+(defun truncate-string-to-width (str end-column &optional start-column padding)
+ "Truncate string STR to end at column END-COLUMN.
+The optional 2nd arg START-COLUMN, if non-nil, specifies
+the starting column; that means to return the characters occupying
+columns START-COLUMN ... END-COLUMN of STR.
+
+The optional 3rd arg PADDING, if non-nil, specifies a padding character
+to add at the end of the result if STR doesn't reach column END-COLUMN,
+or if END-COLUMN comes in the middle of a character in STR.
+PADDING is also added at the beginning of the result
+if column START-COLUMN appears in the middle of a character in STR.
+
+If PADDING is nil, no padding is added in these cases, so
+the resulting string may be narrower than END-COLUMN."
+ (or start-column
+ (setq start-column 0))
+ (let ((len (length str)))
+ (concat (substring str (min start-column len) (min end-column len))
+ (and padding (> end-column len)
+ (make-string (- end-column len) padding)))))
+
+(defalias 'truncate-string 'truncate-string-to-width)
+(make-obsolete 'truncate-string 'truncate-string-to-width)
+
+;; Keywords already do The Right Thing in XEmacs
+(make-compatible 'define-widget-keywords "Just use them")
+
+(make-obsolete 'function-called-at-point 'function-at-point)
+
+;;; obsolete.el ends here
--- /dev/null
+;;; setup-paths.el --- setup various XEmacs paths
+
+;; 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 <sperber@informatik.uni-tuebingen.de>
+;; 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 describes and constructs the various paths into the
+;; XEmacs hierarchy from a global viewpoint.
+
+;; It requires find-paths.el and packages.el.
+\f
+;;; Code:
+
+(defvar paths-load-path-depth 1
+ "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)))
+ "Directories appended to the end of the info path by default.")
+
+(defun paths-find-site-lisp-directory (roots)
+ "Find the site Lisp directory of the XEmacs hierarchy."
+ (paths-find-site-directory roots "site-lisp"
+ nil
+ configure-site-directory))
+
+(defun paths-find-lisp-directory (roots)
+ "Find the main Lisp directory of the XEmacs hierarchy."
+ (paths-find-version-directory roots "lisp"
+ nil
+ configure-lisp-directory))
+
+(defun paths-construct-load-path
+ (roots early-package-load-path late-package-load-path last-package-load-path
+ lisp-directory
+ &optional site-lisp-directory)
+ "Construct the load path."
+ (let* ((envvar-value (getenv "EMACSLOADPATH"))
+ (env-load-path
+ (and envvar-value
+ (paths-decode-directory-path envvar-value 'drop-empties)))
+ (site-lisp-load-path
+ (and site-lisp-directory
+ (paths-find-recursive-load-path (list site-lisp-directory)
+ paths-load-path-depth)))
+ (lisp-load-path
+ (and lisp-directory
+ (paths-find-recursive-load-path (list lisp-directory)
+ paths-load-path-depth))))
+ (append env-load-path
+ early-package-load-path
+ site-lisp-load-path
+ late-package-load-path
+ lisp-load-path
+ last-package-load-path)))
+
+(defun paths-construct-info-path (roots early-packages late-packages last-packages)
+ "Construct the info path."
+ (let ((info-path-envval (getenv "INFOPATH")))
+ (paths-uniq-append
+ (append
+ (let ((info-directory
+ (paths-find-version-directory roots "info"
+ nil
+ configure-info-directory)))
+ (and info-directory
+ (list info-directory)))
+ (packages-find-package-info-path early-packages)
+ (packages-find-package-info-path late-packages)
+ (packages-find-package-info-path last-packages)
+ (and info-path-envval
+ (paths-decode-directory-path info-path-envval 'drop-empties)))
+ (and (null info-path-envval)
+ (paths-uniq-append
+ (paths-directories-which-exist configure-info-path)
+ (paths-directories-which-exist paths-default-info-directories))))))
+
+(defun paths-find-doc-directory (roots)
+ "Find the documentation directory."
+ (paths-find-architecture-directory roots "lib-src"))
+
+(defun paths-find-lock-directory (roots)
+ "Find the lock directory."
+ (paths-find-site-directory roots "lock" "EMACSLOCKDIR" configure-lock-directory))
+
+(defun paths-find-superlock-file (lock-directory)
+ "Find the superlock file."
+ (cond
+ ((null lock-directory)
+ nil)
+ ((and configure-superlock-file
+ (file-directory-p (file-name-directory configure-superlock-file)))
+ configure-superlock-file)
+ (t
+ (expand-file-name "!!!SuperLock!!!" lock-directory))))
+
+(defun paths-find-exec-directory (roots)
+ "Find the binary directory."
+ (paths-find-architecture-directory roots "lib-src" configure-exec-directory))
+
+(defun paths-construct-exec-path (roots exec-directory
+ early-packages late-packages last-packages)
+ "Find the binary path."
+ (append
+ (let ((path-envval (getenv "PATH")))
+ (if path-envval
+ (paths-decode-directory-path path-envval 'drop-empties)))
+ (packages-find-package-exec-path early-packages)
+ (packages-find-package-exec-path late-packages)
+ (packages-find-package-exec-path last-packages)
+ (let ((emacspath-envval (getenv "EMACSPATH")))
+ (and emacspath-envval
+ (split-path emacspath-envval)))
+ (and exec-directory
+ (list exec-directory))))
+
+(defun paths-find-data-directory (roots)
+ "Find the data directory."
+ (paths-find-version-directory roots "etc" "EMACSDATA" configure-data-directory))
+
+(defun paths-construct-data-directory-list (data-directory
+ early-packages late-packages last-packages)
+ "Find the data path."
+ (append
+ (packages-find-package-data-path early-packages)
+ (packages-find-package-data-path late-packages)
+ (packages-find-package-data-path last-packages)
+ (list data-directory)))
+
+;;; setup-paths.el ends here
--- /dev/null
+;;; startup.el --- process XEmacs shell arguments
+
+;; 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
+
+;; 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: FSF 19.34.
+
+;;; Commentary:
+
+;; This file is dumped with XEmacs.
+
+;; -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,
+;; but are left on the list for lisp code to process.
+
+;;; Code:
+\f
+(setq top-level '(normal-top-level))
+
+(defvar command-line-processed nil "t once command line has been processed")
+
+(defconst startup-message-timeout 12000) ; More or less disable the timeout
+
+(defconst inhibit-startup-message nil
+ "*Non-nil inhibits the initial startup message.
+This is for use in your personal init file, once you are familiar
+with the contents of the startup message.")
+
+;; #### FSFmacs randomness
+;;(defconst inhibit-startup-echo-area-message nil
+;; "*Non-nil inhibits the initial startup echo area message.
+;;Inhibition takes effect only if your `.emacs' file contains
+;;a line of this form:
+;; (setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\")
+;;If your `.emacs' file is byte-compiled, use the following form instead:
+;; (eval '(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\"))
+;;Thus, someone else using a copy of your `.emacs' file will see
+;;the startup message unless he personally acts to inhibit it.")
+
+(defconst inhibit-default-init nil
+ "*Non-nil inhibits loading the `default' library.")
+
+(defvar command-line-args-left nil
+ "List of command-line args not yet processed.") ; bound by `command-line'
+
+(defvar command-line-default-directory nil
+ "Default directory to use for command line arguments.
+This is normally copied from `default-directory' when XEmacs starts.")
+
+(defvar before-init-hook nil
+ "Functions to call after handling urgent options but before init files.
+The frame system uses this to open frames to display messages while
+XEmacs loads the user's initialization file.")
+
+(defvar after-init-hook nil
+ "*Functions to call after loading the init file (`.emacs').
+The call is not protected by a condition-case, so you can set `debug-on-error'
+in `.emacs', and put all the actual code on `after-init-hook'.")
+
+(defvar term-setup-hook nil
+ "*Functions to be called after loading terminal-specific Lisp code.
+See `run-hooks'. This variable exists for users to set, so as to
+override the definitions made by the terminal-specific file. XEmacs
+never sets this variable itself.")
+
+(defvar keyboard-type nil
+ "The brand of keyboard you are using.
+This variable is used to define the proper function and keypad keys
+for use under X. It is used in a fashion analogous to the environment
+value TERM.")
+
+(defvar window-setup-hook nil
+ "Normal hook run to initialize window system display.
+XEmacs runs this hook after processing the command line arguments and loading
+the user's init file.")
+
+(defconst initial-major-mode 'lisp-interaction-mode
+ "Major mode command symbol to use for the initial *scratch* buffer.")
+
+(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.
+
+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.
+
+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'.")
+
+;; #### called `site-run-file' in FSFmacs
+
+(defvar site-start-file (purecopy "site-start")
+ "File containing site-wide run-time initializations.
+This file is loaded at run-time before `.emacs'. It
+contains inits that need to be in place for the entire site, but
+which, due to their higher incidence of change, don't make sense to
+load into XEmacs' dumped image. Thus, the run-time load order is:
+
+ 1. file described in this variable, if non-nil;
+ 2. `.emacs';
+ 3. `/path/to/xemacs/lisp/default.el'.
+
+Don't use the `site-start.el' file for things some users may not like.
+Put them in `default.el' instead, so that users can more easily
+override them. Users can prevent loading `default.el' with the `-q'
+option or by setting `inhibit-default-init' in their own init files,
+but inhibiting `site-start.el' requires `--no-site-file', which
+is less convenient.")
+
+;;(defconst iso-8859-1-locale-regexp "8859[-_]?1"
+;; "Regexp that specifies when to enable the ISO 8859-1 character set.
+;;We do that if this regexp matches the locale name
+;;specified by the LC_ALL, LC_CTYPE and LANG environment variables.")
+
+(defvar mail-host-address nil
+ "*Name of this machine, for purposes of naming users.")
+
+(defvar user-mail-address nil
+ "*Full mailing address of this user.
+This is initialized based on `mail-host-address',
+after your init file is read, in case it sets `mail-host-address'.")
+
+(defvar auto-save-list-file-prefix "~/.saves-"
+ "Prefix for generating auto-save-list-file-name.
+Emacs's pid and the system name will be appended to
+this prefix to create a unique file name.")
+
+(defvar init-file-debug nil)
+
+(defvar init-file-had-error nil)
+
+(defvar init-file-loaded nil
+ "True after the user's init file has been loaded (or suppressed with -q).
+This will be true when `after-init-hook' is run and at all times
+after, and will not be true at any time before.")
+
+(defvar initial-frame-unmapped-p nil)
+
+\f
+
+(defvar command-switch-alist
+ (purecopy
+ '(("-help" . command-line-do-help)
+ ("-version". command-line-do-version)
+ ("-V" . command-line-do-version)
+ ("-funcall". command-line-do-funcall)
+ ("-f" . command-line-do-funcall)
+ ("-e" . command-line-do-funcall-1)
+ ("-eval" . command-line-do-eval)
+ ("-load" . command-line-do-load)
+ ("-l" . command-line-do-load)
+ ("-insert" . command-line-do-insert)
+ ("-i" . command-line-do-insert)
+ ("-kill" . command-line-do-kill)
+ ;; Options like +35 are handled specially.
+ ;; Window-system, site, or package-specific code might add to this.
+ ;; X11 handles its options by letting Xt remove args from this list.
+ ))
+ "Alist of command-line switches.
+Elements look like (SWITCH-STRING . HANDLER-FUNCTION).
+HANDLER-FUNCTION receives switch name as sole arg;
+remaining command-line args are in the variable `command-line-args-left'.")
+
+;;; default switches
+;;; Note: these doc strings are semi-magical.
+
+(defun command-line-do-help (arg)
+ "Print the XEmacs usage message and exit."
+ (let ((standard-output 'external-debugging-output))
+ (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")
+ "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
+ display code: use the current tty.
+ -batch Execute noninteractively (messages go to stderr).
+ -debug-init Enter the debugger if an error in the init file occurs.
+ -unmapped Do not map the initial frame.
+ -no-site-file Do not load the site-specific init file (site-start.el).
+ -no-init-file Do not load the user-specific init file (~/.emacs).
+ -no-early-packages Do not process early packages.
+ -no-autoloads Do not load global symbol files (auto-autoloads) at
+ startup. Also implies `-vanilla'.
+ -vanilla Equivalent to -q -no-site-file -no-early-packages.
+ -q Same as -no-init-file.
+ -user <user> Load user's init file instead of your own.
+ -u <user> Same as -user.\n")
+ (let ((l command-switch-alist)
+ (insert (lambda (&rest x)
+ (princ " ")
+ (let ((len 2))
+ (while x
+ (princ (car x))
+ (incf len (length (car x)))
+ (setq x (cdr x)))
+ (when (>= len 24)
+ (terpri) (setq len 0))
+ (while (< len 24)
+ (princ " ")
+ (incf len))))))
+ (while l
+ (let ((name (car (car l)))
+ (fn (cdr (car l)))
+ doc arg cons)
+ (cond
+ ((and (symbolp fn) (get fn 'undocumented)) nil)
+ (t
+ (setq doc (documentation fn))
+ (if (member doc '(nil "")) (setq doc "(undocumented)"))
+ (cond ((string-match "\n\\(<.*>\\)\n?\\'" doc)
+ ;; Doc of the form "The frobber switch\n<arg1> <arg2>"
+ (setq arg (substring doc (match-beginning 1) (match-end 1))
+ doc (substring doc 0 (match-beginning 0))))
+ ((string-match "\n+\\'" doc)
+ (setq doc (substring doc 0 (match-beginning 0)))))
+ (if (and (setq cons (rassq fn command-switch-alist))
+ (not (eq cons (car l))))
+ (setq doc (format "Same as %s." (car cons))))
+ (if arg
+ (funcall insert name " " arg)
+ (funcall insert name))
+ (princ doc)
+ (terpri))))
+ (setq l (cdr l))))
+ (princ (concat "\
+ +N <file> Start displaying <file> at line N.
+
+Anything else is considered a file name, and is placed into a buffer for
+editing.
+
+" (emacs-name) " has an online tutorial and manuals. Type ^Ht (Control-h t) after
+starting XEmacs to run the tutorial. Type ^Hi to enter the manual browser.
+Type ^H^H^H (Control-h Control-h Control-h) to get more help options.\n")
+
+ (kill-emacs 0))))
+
+(defun command-line-do-funcall (arg)
+ "Invoke the named lisp function with no arguments.
+<function>"
+ (funcall (intern (pop command-line-args-left))))
+(fset 'command-line-do-funcall-1 'command-line-do-funcall)
+(put 'command-line-do-funcall-1 'undocumented t)
+
+(defun command-line-do-eval (arg)
+ "Evaluate the lisp form. Quote it carefully.
+<form>"
+ (eval (read (pop command-line-args-left))))
+
+(defun command-line-do-load (arg)
+ "Load the named file of Lisp code into XEmacs.
+<file>"
+ (let ((file (pop command-line-args-left)))
+ ;; Take file from default dir if it exists there;
+ ;; otherwise let `load' search for it.
+ (if (file-exists-p (expand-file-name file))
+ (setq file (expand-file-name file)))
+ (load file nil t)))
+
+(defun command-line-do-insert (arg)
+ "Insert file into the current buffer.
+<file>"
+ (insert-file-contents (pop command-line-args-left)))
+
+(defun command-line-do-kill (arg)
+ "Exit XEmacs."
+ (kill-emacs t))
+
+(defun command-line-do-version (arg)
+ "Print version info and exit."
+ (princ (concat (emacs-version) "\n"))
+ (kill-emacs 0))
+
+\f
+;;; Processing the command line and loading various init files
+
+(defun early-error-handler (&rest debugger-args)
+ "You should probably not be using this."
+ ;; Used as the debugger during XEmacs initialization; if an error occurs,
+ ;; print some diagnostics, and kill XEmacs.
+
+ ;; output the contents of the warning buffer, since it won't be seen
+ ;; otherwise.
+ ;; #### kludge! The call to Feval forces the pending warnings to
+ ;; get output. There definitely needs to be a better way.
+ (let ((buffer (eval (get-buffer-create "*Warnings*"))))
+ (princ (buffer-substring (point-min buffer) (point-max buffer) buffer)
+ 'external-debugging-output))
+
+ (let ((string "Initialization error")
+ (error (nth 1 debugger-args))
+ (debug-on-error nil)
+ (stream 'external-debugging-output))
+ (if (null error)
+ (princ string stream)
+ (princ (concat "\n" string ": ") stream)
+ (condition-case ()
+ (display-error error stream)
+ (error (princ "<<< error printing error message >>>" stream)))
+ (princ "\n" stream)
+ (if (memq (car-safe error) '(void-function void-variable))
+ (princ "
+ This probably means that XEmacs is picking up an old version of
+ the lisp library, or that some .elc files are not up-to-date.\n"
+ stream)))
+ (when (not suppress-early-error-handler-backtrace)
+ (let ((print-length 1000)
+ (print-level 1000)
+ (print-escape-newlines t)
+ (print-readably nil))
+ (when (getenv "EMACSLOADPATH")
+ (princ (format "\n$EMACSLOADPATH is %s" (getenv "EMACSLOADPATH"))
+ stream))
+ (princ (format "\nexec-directory is %S" exec-directory) stream)
+ (princ (format "\ndata-directory is %S" data-directory) stream)
+ (princ (format "\ndata-directory-list is %S" data-directory-list) stream)
+ (princ (format "\ndoc-directory is %S" doc-directory) stream)
+ (princ (format "\nload-path is %S" load-path) stream)
+ (princ "\n\n" stream)))
+ (when (not suppress-early-error-handler-backtrace)
+ (backtrace stream t)))
+ (kill-emacs -1))
+
+(defvar lock-directory)
+(defvar superlock-file)
+
+(defun normal-top-level ()
+ (if command-line-processed
+ (message "Back to top level.")
+ (setq command-line-processed t)
+ ;; Canonicalize HOME (PWD is canonicalized by init_buffer in buffer.c)
+ (unless (eq system-type 'vax-vms)
+ (let ((value (user-home-directory)))
+ (if (and value
+ (< (length value) (length default-directory))
+ (equal (file-attributes default-directory)
+ (file-attributes value)))
+ (setq default-directory (file-name-as-directory value)))))
+ (setq default-directory (abbreviate-file-name default-directory))
+ (initialize-xemacs-paths)
+
+ (startup-set-invocation-environment)
+
+ (let ((debug-paths (or debug-paths
+ (and (getenv "EMACSDEBUGPATHS")
+ t))))
+
+ (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
+ inhibit-early-packages
+ inhibit-site-lisp
+ debug-paths))
+ (startup-setup-paths-warning))
+
+ (if (and (not inhibit-autoloads)
+ lisp-directory)
+ (load (expand-file-name (file-name-sans-extension autoload-file-name)
+ lisp-directory) nil t))
+
+ (if (not inhibit-autoloads)
+ (progn
+ (packages-load-package-auto-autoloads last-package-load-path)
+ (packages-load-package-auto-autoloads late-package-load-path)
+ (if (not inhibit-early-packages)
+ (packages-load-package-auto-autoloads early-package-load-path))))
+
+ (unwind-protect
+ (command-line)
+ ;; Do this again, in case .emacs defined more abbreviations.
+ (setq default-directory (abbreviate-file-name default-directory))
+ ;; Specify the file for recording all the auto save files of
+ ;; this session. This is used by recover-session.
+ (setq auto-save-list-file-name
+ (expand-file-name
+ (format "%s%d-%s"
+ auto-save-list-file-prefix
+ (emacs-pid)
+ (system-name))))
+ (run-hooks 'emacs-startup-hook)
+ (and term-setup-hook
+ (run-hooks 'term-setup-hook))
+ (setq term-setup-hook nil)
+ ;; ;; Modify the initial frame based on what .emacs puts into
+ ;; ;; ...-frame-alist.
+ (frame-notice-user-settings)
+ ;; ;;####FSFmacs junk
+ ;; ;; Now we know the user's default font, so add it to the menu.
+ ;; (if (fboundp 'font-menu-add-default)
+ ;; (font-menu-add-default))
+ (when window-setup-hook
+ (run-hooks 'window-setup-hook))
+ (setq window-setup-hook nil))
+ ;;####FSFmacs junk
+ ;; (or menubar-bindings-done
+ ;; (precompute-menubar-bindings))
+ ))
+
+;;####FSFmacs junk
+;;; Precompute the keyboard equivalents in the menu bar items.
+;;(defun precompute-menubar-bindings ()
+;; (if (eq window-system 'x)
+;; (let ((submap (lookup-key global-map [menu-bar])))
+;; (while submap
+;; (and (consp (car submap))
+;; (symbolp (car (car submap)))
+;; (stringp (car-safe (cdr (car submap))))
+;; (keymapp (cdr (cdr (car submap))))
+;; (x-popup-menu nil (cdr (cdr (car submap)))))
+;; (setq submap (cdr submap))))))
+
+(defun command-line-early (args)
+ ;; This processes those switches which need to be processed before
+ ;; starting up the window system.
+
+ (setq command-line-default-directory default-directory)
+
+ ;; See if we should import version-control from the environment variable.
+ (let ((vc (getenv "VERSION_CONTROL")))
+ (cond ((eq vc nil)) ;don't do anything if not set
+ ((or (string= vc "t")
+ (string= vc "numbered"))
+ (setq version-control t))
+ ((or (string= vc "nil")
+ (string= vc "existing"))
+ (setq version-control nil))
+ ((or (string= vc "never")
+ (string= vc "simple"))
+ (setq version-control 'never))))
+
+ ;;####FSFmacs
+ ;; (if (let ((ctype
+ ;; ;; Use the first of these three envvars that has a nonempty value.
+ ;; (or (let ((string (getenv "LC_ALL")))
+ ;; (and (not (equal string "")) string))
+ ;; (let ((string (getenv "LC_CTYPE")))
+ ;; (and (not (equal string "")) string))
+ ;; (let ((string (getenv "LANG")))
+ ;; (and (not (equal string "")) string)))))
+ ;; (and ctype
+ ;; (string-match iso-8859-1-locale-regexp ctype)))
+ ;; (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 ""))
+
+ ;; Allow (at least) these arguments anywhere in the command line
+ (let ((new-args nil)
+ (arg nil))
+ (while args
+ (setq arg (pop args))
+ (cond
+ ((or (string= arg "-q")
+ (string= arg "-no-init-file"))
+ (setq init-file-user nil))
+ ((string= arg "-no-site-file")
+ (setq site-start-file nil))
+ ((or (string= arg "-no-early-packages")
+ (string= arg "--no-early-packages"))
+ (setq inhibit-early-packages t))
+ ((or (string= arg "-vanilla")
+ (string= arg "--vanilla")
+ ;; Some work on this one already done in emacs.c.
+ (string= arg "-no-autoloads")
+ (string= arg "--no-autoloads"))
+ (setq init-file-user nil
+ site-start-file nil))
+ ((or (string= arg "-u")
+ (string= arg "-user"))
+ (setq init-file-user (pop args)))
+ ((string= arg "-debug-init")
+ (setq init-file-debug t))
+ ((string= arg "-unmapped")
+ (setq initial-frame-unmapped-p t))
+ ((or (string= arg "-debug-paths")
+ (string= arg "--debug-paths"))
+ t)
+ ((or (string= arg "--") (string= arg "-"))
+ (while args
+ (push (pop args) new-args)))
+ (t (push arg new-args))))
+
+ (nreverse new-args)))
+
+(defconst initial-scratch-message "\
+;; This buffer is for notes you don't want to save, and for Lisp evaluation.
+;; If you want to create a file, first visit that file with C-x C-f,
+;; then enter the text in that file's own buffer.
+
+"
+ "Initial message displayed in *scratch* buffer at startup.
+If this is nil, no message will be displayed.")
+
+(defun command-line ()
+ (let ((command-line-args-left (cdr command-line-args)))
+
+ (let ((debugger 'early-error-handler)
+ (debug-on-error t))
+
+ ;; Process magic command-line switches like -q and -u. Do this
+ ;; before creating the first frame because some of these switches
+ ;; may affect that. I think it's ok to do this before establishing
+ ;; the X connection, and maybe someday things like -nw can be
+ ;; handled here instead of down in C.
+ (setq command-line-args-left (command-line-early command-line-args-left))
+
+ ;; Setup the toolbar icon directory
+ (when (featurep 'toolbar)
+ (init-toolbar-location))
+
+ ;; Run the window system's init function. tty is considered to be
+ ;; a type of window system for this purpose. This creates the
+ ;; initial (non stdio) device.
+ (when (and initial-window-system (not noninteractive))
+ (funcall (intern (concat "init-"
+ (symbol-name initial-window-system)
+ "-win"))))
+
+ ;; When not in batch mode, this creates the first visible frame,
+ ;; and deletes the stdio device.
+ (frame-initialize))
+
+ ;;
+ ;; 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
+ ;; to kill XEmacs for it.)
+ ;;
+
+ ;;; Load init files.
+ (load-init-file)
+
+ (with-current-buffer (get-buffer "*scratch*")
+ (erase-buffer)
+ ;; (insert initial-scratch-message)
+ (set-buffer-modified-p nil)
+ (when (eq major-mode 'fundamental-mode)
+ (funcall initial-major-mode)))
+
+ ;; Load library for our terminal type.
+ ;; User init file can set term-file-prefix to nil to prevent this.
+ ;; Note that for any TTY's opened subsequently, the TTY init
+ ;; code will run this.
+ (when (and (eq 'tty (console-type))
+ (not (noninteractive)))
+ (load-terminal-library))
+
+ ;; Process the remaining args.
+ (command-line-1)
+
+ ;; it was turned on by default so that the warnings don't get displayed
+ ;; until after the splash screen.
+ (setq inhibit-warning-display nil)
+ ;; If -batch, terminate after processing the command options.
+ (when (noninteractive) (kill-emacs t))))
+
+(defun load-terminal-library ()
+ (when term-file-prefix
+ (let ((term (getenv "TERM"))
+ hyphend)
+ (while (and term
+ (not (load (concat term-file-prefix term) t t)))
+ ;; Strip off last hyphen and what follows, then try again
+ (if (setq hyphend (string-match "[-_][^-_]+\\'" term))
+ (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 load-user-init-file (init-file-user)
+ "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)))))
+
+;;; Load user's init file and default ones.
+(defun load-init-file ()
+ (run-hooks 'before-init-hook)
+
+ ;; Run the site-start library if it exists. The point of this file is
+ ;; that it is run before .emacs. There is no point in doing this after
+ ;; .emacs; that is useless.
+ (when site-start-file
+ (load site-start-file t t))
+
+ ;; Sites should not disable this. Only individuals should disable
+ ;; the startup message.
+ (setq inhibit-startup-message nil)
+
+ (let (debug-on-error-from-init-file
+ debug-on-error-should-be-set
+ (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
+ ;; Do this without a condition-case if the user wants to debug.
+ (load-user-init-file init-file-user)
+ (condition-case error
+ (progn
+ (load-user-init-file init-file-user)
+ (setq init-file-had-error nil))
+ (error
+ (message "Error in init file: %s" (error-message-string error))
+ (display-warning 'initialization
+ (format "\
+An error has occured while loading %s:
+
+%s
+
+To ensure normal operation, you should investigate the cause of the error
+in your initialization file and remove it. Use the `-debug-init' option
+to XEmacs to view a complete error backtrace."
+ user-init-file (error-message-string error))
+ 'error)
+ (setq init-file-had-error t))))
+ ;; If we can tell that the init file altered debug-on-error,
+ ;; arrange to preserve the value that it set up.
+ (or (eq debug-on-error debug-on-error-initial)
+ (setq debug-on-error-should-be-set t
+ debug-on-error-from-init-file debug-on-error)))
+ (when debug-on-error-should-be-set
+ (setq debug-on-error debug-on-error-from-init-file)))
+
+ (setq init-file-loaded t)
+
+ ;; Do this here in case the init file sets mail-host-address.
+ ;; Don't do this here unless noninteractive, it is frequently wrong. -sb
+ ;; (or user-mail-address
+ (when noninteractive
+ (setq user-mail-address (concat (user-login-name) "@"
+ (or mail-host-address
+ (system-name)))))
+
+ (run-hooks 'after-init-hook)
+ nil)
+
+(defun load-options-file (filename)
+ "Load the file of saved options (from the Options menu) called FILENAME.
+Currently this does nothing but call `load', but it might be redefined
+in the future to support automatically converting older options files to
+a new format, when variables have changed, etc."
+ (load filename))
+
+(defun command-line-1 ()
+ (cond
+ ((null command-line-args-left)
+ (unless noninteractive
+ ;; If there are no switches to process, run the term-setup-hook
+ ;; before displaying the copyright notice; there may be some need
+ ;; to do it before doing any output. If we're not going to
+ ;; display a copyright notice (because other options are present)
+ ;; then this is run after those options are processed.
+ (run-hooks 'term-setup-hook)
+ ;; Don't let the hook be run twice.
+ (setq term-setup-hook nil)
+
+ ;; Don't clobber a non-scratch buffer if init file
+ ;; has selected it.
+ (when (string= (buffer-name) "*scratch*")
+ (unless (or inhibit-startup-message
+ (input-pending-p))
+ (let ((timeout nil))
+ (unwind-protect
+ ;; Guts of with-timeout
+ (catch 'timeout
+ (setq timeout (add-timeout startup-message-timeout
+ (lambda (ignore)
+ (condition-case nil
+ (throw 'timeout t)
+ (error nil)))
+ nil))
+ (startup-splash-frame)
+ (or nil;; (pos-visible-in-window-p (point-min))
+ (goto-char (point-min)))
+ (sit-for 0)
+ (setq unread-command-event (next-command-event)))
+ (when timeout (disable-timeout timeout)))))
+ (with-current-buffer (get-buffer "*scratch*")
+ ;; In case the XEmacs server has already selected
+ ;; another buffer, erase the one our message is in.
+ (erase-buffer)
+ (when (stringp initial-scratch-message)
+ (insert initial-scratch-message))
+ (set-buffer-modified-p nil)))))
+
+ (t
+ ;; Command-line-options exist
+ (let ((dir command-line-default-directory)
+ (file-count 0)
+ (line nil)
+ (end-of-options nil)
+ first-file-buffer file-p arg tem)
+ (while command-line-args-left
+ (setq arg (pop command-line-args-left))
+ (cond
+ (end-of-options
+ (setq file-p t))
+ ((setq tem (when (eq (aref arg 0) ?-)
+ (or (assoc arg command-switch-alist)
+ (assoc (substring arg 1)
+ command-switch-alist))))
+ (funcall (cdr tem) arg))
+ ((string-match "\\`\\+[0-9]+\\'" arg)
+ (setq line (string-to-int arg)))
+ ;; "- file" means don't treat "file" as a switch
+ ;; ("+0 file" has the same effect; "-" added
+ ;; for unixoidiality).
+ ;; This is worthless; the `unixoid' way is "./file". -jwz
+ ((or (string= arg "-") (string= arg "--"))
+ (setq end-of-options t))
+ (t
+ (setq file-p t)))
+
+ (when file-p
+ (setq file-p nil)
+ (incf file-count)
+ (setq arg (expand-file-name arg dir))
+ (cond
+ ((= file-count 1) (setq first-file-buffer
+ (progn (find-file arg) (current-buffer))))
+ (noninteractive (find-file arg))
+ (t (find-file-other-window arg)))
+ (when line
+ (goto-line line)
+ (setq line nil))))))))
+
+(defvar startup-presentation-hack-keymap
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-name map 'startup-presentation-hack-keymap)
+ (define-key map '[button1] 'startup-presentation-hack)
+ (define-key map '[button2] 'startup-presentation-hack)
+ map)
+ "Putting yesterday in the future tomorrow.")
+
+(defun startup-presentation-hack ()
+ (interactive)
+ (let ((e last-command-event))
+ (and (button-press-event-p e)
+ (setq e (extent-at (event-point e)
+ (event-buffer e)
+ 'startup-presentation-hack))
+ (setq e (extent-property e 'startup-presentation-hack))
+ (if (consp e)
+ (apply (car e) (cdr e))
+ (while (keymapp (indirect-function e))
+ (let ((map e)
+ (overriding-local-map (indirect-function e)))
+ (setq e (read-key-sequence
+ (let ((p (keymap-prompt map t)))
+ (cond ((symbolp map)
+ (if p
+ (format "%s %s " map p)
+ (format "%s " map)))
+ (p)
+ (t
+ (prin1-to-string map))))))
+ (if (and (button-release-event-p (elt e 0))
+ (null (key-binding e)))
+ (setq e map) ; try again
+ (setq e (key-binding e)))))
+ (call-interactively e)))))
+
+(defun startup-presentation-hack-help (e)
+ (setq e (extent-property e 'startup-presentation-hack))
+ (if (consp e)
+ (format "Evaluate %S" e)
+ (symbol-name e)))
+
+(defun splash-frame-present-hack (e v)
+ ;; (set-extent-property e 'mouse-face 'highlight)
+ ;; (set-extent-property e 'keymap
+ ;; startup-presentation-hack-keymap)
+ ;; (set-extent-property e 'startup-presentation-hack v)
+ ;; (set-extent-property e 'help-echo
+ ;; 'startup-presentation-hack-help))
+ )
+
+(defun splash-hack-version-string ()
+ (save-excursion
+ (save-restriction
+ (goto-char (point-min))
+ (re-search-forward "^XEmacs" nil t)
+ (narrow-to-region (point-at-bol) (point-at-eol))
+ (goto-char (point-min))
+ (when (re-search-forward " \\[Lucid\\]" nil t)
+ (delete-region (match-beginning 0) (match-end 0)))
+ (when (re-search-forward "[^(][^)]*-[^)]*-" nil t)
+ (delete-region (1+ (match-beginning 0)) (match-end 0))
+ (insert "("))
+ (goto-char (point-max))
+ (search-backward " " nil t)
+ (when (search-forward "." nil t)
+ (delete-region (1- (point)) (point-max))))))
+
+(defun splash-frame-present (l)
+ (cond ((stringp l)
+ (insert l))
+ ((eq (car-safe l) 'face)
+ ;; (face name string)
+ (let ((p (point)))
+ (splash-frame-present (elt l 2))
+ (if (fboundp 'set-extent-face)
+ (set-extent-face (make-extent p (point))
+ (elt l 1)))))
+ ((eq (car-safe l) 'key)
+ (let* ((c (elt l 1))
+ (p (point))
+ (k (where-is-internal c nil t)))
+ (insert (if k (key-description k)
+ (format "M-x %s" c)))
+ (if (fboundp 'set-extent-face)
+ (let ((e (make-extent p (point))))
+ (set-extent-face e 'bold)
+ (splash-frame-present-hack e c)))))
+ ((eq (car-safe l) 'funcall)
+ ;; (funcall (fun . args) string)
+ (let ((p (point)))
+ (splash-frame-present (elt l 2))
+ (if (fboundp 'set-extent-face)
+ (splash-frame-present-hack (make-extent p (point))
+ (elt l 1)))))
+ ((consp l)
+ (mapcar 'splash-frame-present l))
+ (t
+ (error "WTF!?"))))
+
+(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.
+ ;; 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
+ ;;; #### this was expecting. Or is it?
+ ;; (An alternate way to get avg-pixwidth would be to use x-font-properties
+ ;; and calculate RESOLUTION_X * AVERAGE_WIDTH / 722.7, but it's no better.)
+
+ ;; 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)
+ (* avg-pixwidth (length glyph)))
+ ;; #### the pixmap option should be removed
+ ;;((pixmapp glyph)
+ ;; (pixmap-width glyph))
+ ((glyphp glyph)
+ (glyph-width glyph))
+ (t
+ (error "startup-center-spaces: bad arg")))))
+ (+ left-margin
+ (round (/ (/ (- fill-area-width glyph-pixwidth) 2) avg-pixwidth)))))
+
+(defun startup-splash-frame-body ()
+ `("\n" ,(emacs-version) "\n"
+ ,@(if (string-match "beta" emacs-version)
+ `( (face (bold blue) ( "This is an Experimental version of XEmacs. "
+ " Type " (key describe-beta)
+ " to see what this means.\n")))
+ `( "\n"))
+ (face bold-italic "\
+Copyright (C) 1985-1997 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\n")
+
+ ,@(if (featurep 'sparcworks)
+ `( "\
+Sun provides support for the WorkShop/XEmacs integration package only.
+All other XEmacs packages are provided to you \"AS IS\".
+For full details, type " (key describe-no-warranty)
+" to refer to the GPL Version 2, dated June 1991.\n\n"
+,@(let ((lang (or (getenv "LC_ALL") (getenv "LC_MESSAGES") (getenv "LANG"))))
+ (if (and
+ (not (featurep 'mule)) ; Already got mule?
+ (not (eq 'tty (console-type))) ; No Mule support on tty's yet
+ lang ; Non-English locale?
+ (not (string= lang "C"))
+ (not (string-match "^en" lang))
+ (locate-file "xemacs-mule" exec-path)) ; Comes with Sun WorkShop
+ '( "\
+This version of XEmacs has been built with support for Latin-1 languages only.
+To handle other languages you need to run a Multi-lingual (`Mule') version of
+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\n"))))
+
+ '("XEmacs comes with ABSOLUTELY NO WARRANTY; type "
+ (key describe-no-warranty) " for full details.\n"))
+
+ "You may give out copies of XEmacs; type "
+ (key describe-copying) " to see the conditions.\n"
+ "Type " (key describe-distribution)
+ " for information on getting the latest version.\n\n"
+
+ "Type " (key help-command) " or use the " (face bold "Help") " menu to get help.\n"
+ "Type " (key advertised-undo) " to undo changes (`C-' means use the Control key).\n"
+ "To get out of XEmacs, type " (key save-buffers-kill-emacs) ".\n"
+ "Type " (key help-with-tutorial) " for a tutorial on using XEmacs.\n"
+ "Type " (key info) " to enter Info, "
+ "which you can use to read online documentation.\n"
+ (face (bold red) ( "\
+For tips and answers to frequently asked questions, see the XEmacs FAQ.
+\(It's on the Help menu, or type " (key xemacs-local-faq) " [a capital F!].\)"))))
+
+;; I really hate global variables, oh well.
+;(defvar xemacs-startup-logo-function nil
+; "If non-nil, function called to provide the startup logo.
+;This function should return an initialized glyph if it is used.")
+
+(defun startup-splash-frame ()
+ (let ((p (point))
+; (logo (cond (xemacs-startup-logo-function
+; (funcall xemacs-startup-logo-function))
+; (t xemacs-logo)))
+ (logo xemacs-logo)
+ (cramped-p (eq 'tty (console-type))))
+ (unless cramped-p (insert "\n"))
+ (indent-to (startup-center-spaces logo))
+ (set-extent-begin-glyph (make-extent (point) (point)) logo)
+ (insert (if cramped-p "\n" "\n\n"))
+ (splash-frame-present-hack (make-extent p (point)) 'about-xemacs))
+
+ (let ((after-change-functions nil)) ; no font-lock, thank you
+ (dolist (l (startup-splash-frame-body))
+ (splash-frame-present l)))
+ (splash-hack-version-string)
+ (set-buffer-modified-p nil))
+
+;; (let ((present-file
+;; #'(lambda (f)
+;; (splash-frame-present
+;; (list 'funcall
+;; (list 'find-file-other-window
+;; (expand-file-name f data-directory))
+;; f)))))
+;; (insert "For customization examples, see the files ")
+;; (funcall present-file "sample.emacs")
+;; (insert " and ")
+;; (funcall present-file "sample.Xdefaults")
+;; (insert (format "\nin the directory %s." data-directory)))
+
+(defun startup-set-invocation-environment ()
+ ;; XEmacs -- Steven Baur says invocation directory is nil if you
+ ;; try to use XEmacs as a login shell.
+ (or invocation-directory (setq invocation-directory default-directory))
+ (setq invocation-directory
+ ;; don't let /tmp_mnt/... get into the load-path or exec-path.
+ (abbreviate-file-name invocation-directory)))
+
+(defun startup-setup-paths (roots &optional
+ inhibit-early-packages inhibit-site-lisp
+ debug-paths)
+ "Setup all the various paths.
+ROOTS is a list of plausible roots of the XEmacs directory hierarchy.
+If INHIBIT-PACKAGES is non-NIL, don't do packages.
+If INHIBIT-SITE-LISP is non-NIL, don't do site-lisp.
+If DEBUG-PATHS is non-NIL, print paths as they are detected.
+It's idempotent, so call this as often as you like!"
+
+ (apply #'(lambda (early late last)
+ (setq early-packages (and (not inhibit-early-packages)
+ early))
+ (setq late-packages late)
+ (setq last-packages last))
+ (packages-find-packages roots))
+
+ (setq early-package-load-path (packages-find-package-load-path early-packages))
+ (setq late-package-load-path (packages-find-package-load-path late-packages))
+ (setq last-package-load-path (packages-find-package-load-path last-packages))
+
+ (if debug-paths
+ (progn
+ (princ (format "configure-package-path:\n%S\n" configure-package-path)
+ 'external-debugging-output)
+ (princ (format "early-packages and early-package-load-path:\n%S\n%S\n"
+ early-packages early-package-load-path)
+ 'external-debugging-output)
+ (princ (format "late-packages and late-package-load-path:\n%S\n%S\n"
+ late-packages late-package-load-path)
+ 'external-debugging-output)
+ (princ (format "last-packages and last-package-load-path:\n%S\n%S\n"
+ last-packages last-package-load-path)
+ 'external-debugging-output)))
+
+ (setq lisp-directory (paths-find-lisp-directory roots))
+
+ (if debug-paths
+ (princ (format "lisp-directory:\n%S\n" lisp-directory)
+ 'external-debugging-output))
+
+ (setq site-directory (and (null inhibit-site-lisp)
+ (paths-find-site-lisp-directory roots)))
+
+ (if (and debug-paths (null inhibit-site-lisp))
+ (princ (format "site-directory:\n%S\n" site-directory)
+ 'external-debugging-output))
+
+ (setq load-path (paths-construct-load-path roots
+ early-package-load-path
+ late-package-load-path
+ last-package-load-path
+ lisp-directory
+ site-directory))
+
+ (setq Info-directory-list
+ (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))
+
+ (if (boundp 'lock-directory)
+ (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)
+ 'external-debugging-output)
+ (princ (format "superlock-file:\n%S\n" superlock-file)
+ 'external-debugging-output)))))
+
+ (setq exec-directory (paths-find-exec-directory roots))
+
+ (if debug-paths
+ (princ (format "exec-directory:\n%s\n" exec-directory)
+ 'external-debugging-output))
+
+ (setq exec-path
+ (paths-construct-exec-path roots exec-directory
+ early-packages late-packages last-packages))
+
+ (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
+ (princ (format "doc-directory:\n%S\n" doc-directory)
+ 'external-debugging-output))
+
+ (setq data-directory (paths-find-data-directory roots))
+
+ (if debug-paths
+ (princ (format "data-directory:\n%S\n" data-directory)
+ 'external-debugging-output))
+
+ (setq data-directory-list (paths-construct-data-directory-list data-directory
+ early-packages
+ late-packages
+ last-packages))
+ (if debug-paths
+ (princ (format "data-directory-list:\n%S\n" data-directory-list)
+ 'external-debugging-output)))
+
+(defun startup-find-roots-warning ()
+ (save-excursion
+ (set-buffer (get-buffer-create " *warning-tmp*"))
+ (erase-buffer)
+ (buffer-disable-undo (current-buffer))
+
+ (insert "Couldn't find an obvious default for the root of the\n"
+ "XEmacs hierarchy.")
+
+ (princ "\nWARNING:\n" 'external-debugging-output)
+ (princ (buffer-string) 'external-debugging-output)))
+
+(defun startup-setup-paths-warning ()
+ (let ((lock (if (boundp 'lock-directory) lock-directory 't))
+ (warnings '()))
+ (if (and (stringp lock) (null (file-directory-p lock)))
+ (setq lock nil))
+ (cond
+ ((null (and lisp-directory exec-directory data-directory doc-directory
+ load-path
+ lock))
+ (save-excursion
+ (set-buffer (get-buffer-create " *warning-tmp*"))
+ (erase-buffer)
+ (buffer-disable-undo (current-buffer))
+ (if (null lisp-directory) (push "lisp-directory" warnings))
+ (if (null lock) (push "lock-directory" warnings))
+ (if (null exec-directory) (push "exec-directory" warnings))
+ (if (null data-directory) (push "data-directory" warnings))
+ (if (null doc-directory) (push "doc-directory" warnings))
+ (if (null load-path) (push "load-path" warnings))
+
+ (insert "Couldn't find obvious defaults for:\n")
+ (while warnings
+ (insert (car warnings) "\n")
+ (setq warnings (cdr warnings)))
+ (insert "Perhaps some directories don't exist, "
+ "or the XEmacs executable,\n" (concat invocation-directory
+ invocation-name)
+ "\nis in a strange place?")
+
+ (princ "\nWARNING:\n" 'external-debugging-output)
+ (princ (buffer-string) 'external-debugging-output)
+ (erase-buffer)
+ t)))))
+
+;;; startup.el ends here
--- /dev/null
+;;; update-elc.el --- Bytecompile out-of-date dumped files
+
+;; Copyright (C) 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1996 Unknown
+
+;; Maintainer: XEmacs Development Team
+;; Keywords: internal
+
+;; 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:
+
+;; Byte compile the .EL files necessary to dump out xemacs.
+;; Use this file like this:
+
+;; temacs -batch -l ../lisp/update-elc.el $lisp
+
+;; where $lisp comes from the Makefile. .elc files listed in $lisp will
+;; cause the corresponding .el file to be compiled. .el files listed in
+;; $lisp will be ignored.
+
+;; (the idea here is that you can bootstrap if your .ELC files
+;; are missing or badly out-of-date)
+
+;; Currently this code gets the list of files to check passed to it from
+;; src/Makefile. This must be fixed. -slb
+
+;;; Code:
+
+(defvar processed nil)
+(defvar update-elc-files-to-compile nil)
+
+;(setq update-elc-files-to-compile
+; (delq nil
+; (mapcar (function
+; (lambda (x)
+; (if (string-match "\.elc$" x)
+; (let ((src (substring x 0 -1)))
+; (if (file-newer-than-file-p src x)
+; (progn
+; (and (file-exists-p x)
+; (null (file-writable-p x))
+; (set-file-modes x (logior (file-modes x) 128)))
+; src))))))
+; ;; -batch gets filtered out.
+; (nthcdr 3 command-line-args))))
+
+(setq load-path (split-path (getenv "EMACSBOOTSTRAPLOADPATH")))
+
+(load "very-early-lisp" nil t)
+
+(load "find-paths.el")
+(load "packages.el")
+(load "setup-paths.el")
+(load "dump-paths.el")
+
+(let ((autol (packages-list-autoloads)))
+ ;; (print (prin1-to-string autol))
+ (while autol
+ (let ((src (car autol)))
+ (if (and (file-exists-p src)
+ (file-newer-than-file-p src (concat src "c")))
+ (setq update-elc-files-to-compile
+ (cons src update-elc-files-to-compile))))
+ (setq autol (cdr autol))))
+
+;; (print (prin1-to-string update-elc-files-to-compile))
+
+(let (preloaded-file-list site-load-packages)
+ (load (concat default-directory "../lisp/dumped-lisp.el"))
+
+ ;; Path setup
+ (let ((package-preloaded-file-list
+ (packages-collect-package-dumped-lisps late-package-load-path)))
+
+ (setq preloaded-file-list
+ (append package-preloaded-file-list
+ preloaded-file-list
+ packages-hardcoded-lisp)))
+
+ (load (concat default-directory "../site-packages") t t)
+ (setq preloaded-file-list
+ (append packages-hardcoded-lisp
+ preloaded-file-list
+ packages-useful-lisp
+ site-load-packages))
+ (while preloaded-file-list
+ (let ((arg (car preloaded-file-list)))
+ ;; (print (prin1-to-string arg))
+ (if (null (member (file-name-nondirectory arg)
+ packages-unbytecompiled-lisp))
+ (progn
+ (setq arg (locate-library arg))
+ (if (null arg)
+ (progn
+ (print (format "Error: Library file %s not found"
+ (car preloaded-file-list)))
+ ;; Uncomment in case of trouble
+ ;;(print (format "late-packages: %S" late-packages))
+ ;;(print (format "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name)))
+ (kill-emacs)))
+ (if (string-match "\\.elc?\\'" arg)
+ (setq arg (substring arg 0 (match-beginning 0))))
+ (if (and (null (member arg processed))
+ (file-exists-p (concat arg ".el"))
+ (file-newer-than-file-p (concat arg ".el")
+ (concat arg ".elc")))
+ (setq processed (cons (concat arg ".el") processed)))))
+ (setq preloaded-file-list (cdr preloaded-file-list)))))
+
+(setq update-elc-files-to-compile (append update-elc-files-to-compile
+ processed))
+
+;; (print (prin1-to-string update-elc-files-to-compile))
+
+(if update-elc-files-to-compile
+ (progn
+ (setq command-line-args
+ (append '("-l" "loadup-el.el" "run-temacs"
+ "-batch" "-q" "-no-site-file"
+ "-l" "bytecomp" "-f" "batch-byte-compile")
+ update-elc-files-to-compile))
+ (load "loadup-el.el"))
+ (condition-case nil
+ (delete-file "./NOBYTECOMPILE")
+ (file-error nil)))
+
+(kill-emacs)
+
+;;; update-elc.el ends here
--- /dev/null
+;; version.el --- Record version number of Emacs.
+
+;; Copyright (C) 1985, 1991-1994, 1997 Free Software Foundation, Inc.
+
+;; 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 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.
+
+;;; Synched up with: FSF 19.34.
+
+;;; Commentary:
+
+;; This file is dumped with XEmacs.
+
+;;; Code:
+
+(defconst xemacs-betaname
+ (and emacs-beta-version (format "(beta%d)" emacs-beta-version))
+ "Non-nil when this is a test (beta) version of XEmacs.
+Warning, this variable did not exist in XEmacs versions prior to 20.3")
+
+(defconst emacs-version
+ (purecopy
+ (format "%d.%d %s%s%s"
+ emacs-major-version
+ emacs-minor-version
+ (if xemacs-codename
+ (concat "\"" xemacs-codename "\"")
+ "")
+ " XEmacs Lucid"
+ (if xemacs-betaname
+ (concat " " xemacs-betaname)
+ "")))
+ "Version numbers of this version of XEmacs.")
+
+(if (featurep 'infodock)
+ (require 'id-vers))
+
+;; Moved to C code as of XEmacs 20.3
+;(defconst emacs-major-version
+; (progn (or (string-match "^[0-9]+" emacs-version)
+; (error "emacs-version unparsable"))
+; (string-to-int (match-string 0 emacs-version)))
+; "Major version number of this version of Emacs, as an integer.
+;Warning, this variable did not exist in Emacs versions earlier than:
+; FSF Emacs: 19.23
+; XEmacs: 19.10")
+
+;; Moved to C code as of XEmacs 20.3
+;(defconst emacs-minor-version
+; (progn (or (string-match "^[0-9]+\\.\\([0-9]+\\)" emacs-version)
+; (error "emacs-version unparsable"))
+; (string-to-int (match-string 1 emacs-version)))
+; "Minor version number of this version of Emacs, as an integer.
+;Warning, this variable did not exist in Emacs versions earlier than:
+; FSF Emacs: 19.23
+; XEmacs: 19.10")
+
+(defconst emacs-build-time (current-time-string)
+ "Time at which Emacs was dumped out.")
+
+(defconst emacs-build-system (system-name))
+
+(defun emacs-version (&optional arg)
+ "Return string describing the version of Emacs that is running.
+When called interactively with a prefix argument, insert string at point.
+Don't use this function in programs to choose actions according
+to the system configuration; look at `system-configuration' instead."
+ (interactive "p")
+ (save-match-data
+ (let ((version-string
+ (format
+ "XEmacs %s %s(%s%s) of %s %s on %s"
+ (substring emacs-version 0 (string-match " XEmacs" emacs-version))
+ (if (not (featurep 'infodock))
+ "[Lucid] "
+ "")
+ system-configuration
+ (cond ((or (and (fboundp 'featurep)
+ (featurep 'mule))
+ (memq 'mule features)) ", Mule")
+ (t ""))
+ (substring emacs-build-time 0
+ (string-match " *[0-9]*:" emacs-build-time))
+ (substring emacs-build-time
+ (string-match "[0-9]*$" emacs-build-time))
+ emacs-build-system)))
+ (cond
+ ((null arg) version-string)
+ ((eq arg 1) (message "%s" version-string))
+ (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)))))
+
+;;; We hope that this alias is easier for people to find.
+(define-function 'version 'emacs-version)
+
+;; Put the emacs version number into the `pure[]' array in a form that
+;; `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 '(vax-vms windows-nt ms-dos))
+ (purecopy (concat "\n@" "(#)" (emacs-version)
+ "\n@" "(#)" "Configuration: "
+ system-configuration "\n")))
+
+;;Local variables:
+;;version-control: never
+;;End:
+
+;;; version.el ends here
--- /dev/null
+Makefile.in
+config.h
+Makefile
+GNUmakefile
--- /dev/null
+ZLIB=\path\to\zlib
+
+all: minitar.exe
+
+minitar.exe: minitar.obj
+ cl -o minitar.exe minitar.obj $(ZLIB)\zlib.lib
+
+minitar.obj: minitar.c
+ cl -c minitar.c -I $(ZLIB)
+
--- /dev/null
+Makefile.in
+paths.h
+config.h
+Emacs.ad.h
+Makefile
+GNUmakefile
+puresize-adjust.h
+sheap-adjust.h
+temacs
+SATISFIED
+update-elc.stamp
--- /dev/null
+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 <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>
+
+ * 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_enviroment.
+
+ * 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.
+
--- /dev/null
+/* Primitives for word-abbrev mode.
+ Copyright (C) 1985, 1986, 1992, 1993 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: FSF 19.30. Note that there are many more functions in
+ FSF's abbrev.c. These have been moved into Lisp in XEmacs. */
+
+/* Authorship:
+
+ FSF: Original version; a long time ago.
+ JWZ or Mly: Mostly moved into Lisp; maybe 1992.
+ Ben Wing: Some changes for Mule for 19.12.
+ Hrvoje Niksic: Largely rewritten in June 1997.
+*/
+
+/* This file has been Mule-ized. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "commands.h"
+#include "insdel.h"
+#include "syntax.h"
+#include "window.h"
+
+/* An abbrev table is an obarray.
+ Each defined abbrev is represented by a symbol in that obarray
+ whose print name is the abbreviation.
+ The symbol's value is a string which is the expansion.
+ If its function definition is non-nil, it is called
+ after the expansion is done.
+ The plist slot of the abbrev symbol is its usage count. */
+
+/* The table of global abbrevs. These are in effect
+ in any buffer in which abbrev mode is turned on. */
+Lisp_Object Vglobal_abbrev_table;
+
+int abbrev_all_caps;
+
+/* Non-nil => use this location as the start of abbrev to expand
+ (rather than taking the word before point as the abbrev) */
+Lisp_Object Vabbrev_start_location;
+
+/* Buffer that Vabbrev_start_location applies to */
+Lisp_Object Vabbrev_start_location_buffer;
+
+/* The symbol representing the abbrev most recently expanded */
+Lisp_Object Vlast_abbrev;
+
+/* A string for the actual text of the abbrev most recently expanded.
+ This has more info than Vlast_abbrev since case is significant. */
+Lisp_Object Vlast_abbrev_text;
+
+/* Character address of start of last abbrev expanded */
+int last_abbrev_location;
+
+/* Hook to run before expanding any abbrev. */
+Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook;
+
+\f
+struct abbrev_match_mapper_closure {
+ struct buffer *buf;
+ struct Lisp_Char_Table *chartab;
+ Charcount point, maxlen;
+ struct Lisp_Symbol *found;
+};
+
+/* For use by abbrev_match(): Match SYMBOL's name against buffer text
+ before point, case-insensitively. When found, return non-zero, so
+ that map_obarray terminates mapping. */
+static int
+abbrev_match_mapper (Lisp_Object symbol, void *arg)
+{
+ 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;
+
+ /* symbol_value should be OK here, because abbrevs are not expected
+ to contain any SYMBOL_MAGIC stuff. */
+ if (UNBOUNDP (symbol_value (sym)) || NILP (symbol_value (sym)))
+ {
+ /* The symbol value of nil means that abbrev got undefined. */
+ return 0;
+ }
+ abbrev = symbol_name (sym);
+ abbrev_length = string_char_length (abbrev);
+ if (abbrev_length > closure->maxlen)
+ {
+ /* This abbrev is too large -- it wouldn't fit. */
+ return 0;
+ }
+ /* If `bar' is an abbrev, and a user presses `fubar<SPC>', we don't
+ normally want to expand it. OTOH, if the abbrev begins with
+ non-word syntax (e.g. `#if'), it is OK to abbreviate it anywhere. */
+ if (abbrev_length < closure->maxlen && abbrev_length > 0
+ && (WORD_SYNTAX_P (closure->chartab, string_char (abbrev, 0)))
+ && (WORD_SYNTAX_P (closure->chartab,
+ BUF_FETCH_CHAR (closure->buf,
+ closure->point - (abbrev_length + 1)))))
+ {
+ return 0;
+ }
+ /* Match abbreviation string against buffer text. */
+ {
+ Bufbyte *ptr = string_data (abbrev);
+ Charcount idx;
+
+ for (idx = 0; idx < abbrev_length; idx++)
+ {
+ if (DOWNCASE (closure->buf,
+ BUF_FETCH_CHAR (closure->buf,
+ closure->point - abbrev_length + idx))
+ != DOWNCASE (closure->buf, charptr_emchar (ptr)))
+ {
+ break;
+ }
+ INC_CHARPTR (ptr);
+ }
+ if (idx == abbrev_length)
+ {
+ /* This is the one. */
+ closure->found = sym;
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/* Match the buffer text against names of symbols in obarray. Returns
+ the matching symbol, or 0 if not found. */
+static struct Lisp_Symbol *
+abbrev_match (struct buffer *buf, Lisp_Object obarray)
+{
+ struct abbrev_match_mapper_closure closure;
+
+ /* Precalculate some stuff, so mapper function needn't to it in each
+ iteration. */
+ closure.buf = buf;
+ closure.point = BUF_PT (buf);
+ closure.maxlen = closure.point - BUF_BEGV (buf);
+ closure.chartab = XCHAR_TABLE (buf->mirror_syntax_table);
+ closure.found = 0;
+
+ map_obarray (obarray, abbrev_match_mapper, &closure);
+
+ return closure.found;
+}
+\f
+/* Take the word before point (or Vabbrev_start_location, if non-nil),
+ and look it up in OBARRAY, and return the symbol (or zero). This
+ used to be the default method of searching, with the obvious
+ limitation that the abbrevs may consist only of word characters.
+ It is an order of magnitude faster than the proper abbrev_match(),
+ but then again, vi is an order of magnitude faster than Emacs.
+
+ This speed difference should be unnoticable, 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 *
+abbrev_oblookup (struct buffer *buf, Lisp_Object obarray)
+{
+ Bufpos wordstart, wordend;
+ Bufbyte *word, *p;
+ Bytecount idx;
+ Lisp_Object lookup;
+
+ CHECK_VECTOR (obarray);
+
+ if (!NILP (Vabbrev_start_location))
+ {
+ wordstart = get_buffer_pos_char (buf, Vabbrev_start_location,
+ GB_COERCE_RANGE);
+ Vabbrev_start_location = Qnil;
+#if 0
+ /* Previously, abbrev-prefix-mark crockishly inserted a dash to
+ indicate the abbrev start point. It now uses an extent with
+ a begin glyph so there's no dash to remove. */
+ if (wordstart != BUF_ZV (buf)
+ && BUF_FETCH_CHAR (buf, wordstart) == '-')
+ {
+ buffer_delete_range (buf, wordstart, wordstart + 1, 0);
+ }
+#endif
+ wordend = BUF_PT (buf);
+ }
+ else
+ {
+ Bufpos point = BUF_PT (buf);
+
+ wordstart = scan_words (buf, point, -1);
+ if (!wordstart)
+ return 0;
+
+ wordend = scan_words (buf, wordstart, 1);
+ if (!wordend)
+ return 0;
+ if (wordend > BUF_ZV (buf))
+ wordend = BUF_ZV (buf);
+ if (wordend > point)
+ wordend = point;
+ /* Unlike the original function, we allow expansion only after
+ the abbrev, not preceded by a number of spaces. This is
+ because of consistency with abbrev_match. */
+ if (wordend < point)
+ return 0;
+ if (wordend <= wordstart)
+ return 0;
+ }
+
+ p = word = (Bufbyte *) alloca (MAX_EMCHAR_LEN * (wordend - wordstart));
+ for (idx = wordstart; idx < wordend; idx++)
+ {
+ Emchar c = BUF_FETCH_CHAR (buf, idx);
+ if (UPPERCASEP (buf, c))
+ c = DOWNCASE (buf, c);
+ p += set_charptr_emchar (p, c);
+ }
+ lookup = oblookup (obarray, word, p - word);
+ if (SYMBOLP (lookup) && !NILP (symbol_value (XSYMBOL (lookup))))
+ return XSYMBOL (lookup);
+ else
+ return NULL;
+}
+\f
+/* Return non-zero if OBARRAY contains an interned symbol ` '. */
+static int
+obarray_has_blank_p (Lisp_Object obarray)
+{
+ return !ZEROP (oblookup (obarray, (Bufbyte *)" ", 1));
+}
+
+/* Analyze case in the buffer substring, and report it. */
+static void
+abbrev_count_case (struct buffer *buf, Bufpos pos, Charcount length,
+ int *lccount, int *uccount)
+{
+ *lccount = *uccount = 0;
+ while (length--)
+ {
+ Emchar c = BUF_FETCH_CHAR (buf, pos);
+ if (UPPERCASEP (buf, c))
+ ++*uccount;
+ else if (LOWERCASEP (buf, c))
+ ++*lccount;
+ ++pos;
+ }
+}
+\f
+DEFUN ("expand-abbrev", Fexpand_abbrev, 0, 0, "", /*
+Expand the abbrev before point, if any.
+Effective when explicitly called even when `abbrev-mode' is nil.
+Returns the abbrev symbol, if expansion took place.
+If no abbrev matched, but `pre-abbrev-expand-hook' changed the buffer,
+ returns t.
+*/
+ ())
+{
+ /* This function can GC */
+ struct buffer *buf = current_buffer;
+ int oldmodiff = BUF_MODIFF (buf);
+ Lisp_Object pre_modiff_p;
+ Bufpos point; /* position of point */
+ Bufpos abbrev_start; /* position of abbreviation beginning */
+
+ struct Lisp_Symbol *(*fun) (struct buffer *, Lisp_Object);
+
+ struct Lisp_Symbol *abbrev_symbol;
+ struct Lisp_String *abbrev_string;
+ Lisp_Object expansion, count, hook;
+ Charcount abbrev_length;
+ int lccount, uccount;
+
+ run_hook (Qpre_abbrev_expand_hook);
+ /* If the hook changes the buffer, treat that as having "done an
+ expansion". */
+ pre_modiff_p = (BUF_MODIFF (buf) != oldmodiff ? Qt : Qnil);
+
+ abbrev_symbol = NULL;
+ if (!BUFFERP (Vabbrev_start_location_buffer) ||
+ XBUFFER (Vabbrev_start_location_buffer) != buf)
+ Vabbrev_start_location = Qnil;
+ /* We use the more general abbrev_match() if the obarray blank flag
+ is not set, and Vabbrev_start_location is nil. Otherwise, use
+ abbrev_oblookup(). */
+#define MATCHFUN(tbl) ((obarray_has_blank_p (tbl) \
+ && NILP (Vabbrev_start_location)) \
+ ? abbrev_match : abbrev_oblookup)
+ if (!NILP (buf->abbrev_table))
+ {
+ fun = MATCHFUN (buf->abbrev_table);
+ abbrev_symbol = fun (buf, buf->abbrev_table);
+ }
+ if (!abbrev_symbol && !NILP (Vglobal_abbrev_table))
+ {
+ fun = MATCHFUN (Vglobal_abbrev_table);
+ abbrev_symbol = fun (buf, Vglobal_abbrev_table);
+ }
+ if (!abbrev_symbol)
+ return pre_modiff_p;
+
+ /* NOTE: we hope that `pre-abbrev-expand-hook' didn't do something
+ nasty, such as changed the buffer. Here we protect against the
+ buffer getting killed. */
+ if (! BUFFER_LIVE_P (buf))
+ return Qnil;
+ point = BUF_PT (buf);
+
+ /* OK, we're out of the must-be-fast part. An abbreviation matched.
+ Now find the parameters, insert the expansion, and make it all
+ look pretty. */
+ abbrev_string = symbol_name (abbrev_symbol);
+ abbrev_length = string_char_length (abbrev_string);
+ abbrev_start = point - abbrev_length;
+
+ expansion = symbol_value (abbrev_symbol);
+ CHECK_STRING (expansion);
+
+ count = symbol_plist (abbrev_symbol); /* Gag */
+ if (NILP (count))
+ count = Qzero;
+ else
+ CHECK_NATNUM (count);
+ symbol_plist (abbrev_symbol) = make_int (1 + XINT (count));
+
+ /* Count the case in the original text. */
+ abbrev_count_case (buf, abbrev_start, abbrev_length, &lccount, &uccount);
+
+ /* Remember the last abbrev text, location, etc. */
+ XSETSYMBOL (Vlast_abbrev, abbrev_symbol);
+ Vlast_abbrev_text =
+ make_string_from_buffer (buf, abbrev_start, abbrev_length);
+ last_abbrev_location = abbrev_start;
+
+ /* Add an undo boundary, in case we are doing this for a
+ self-inserting command which has avoided making one so far. */
+ if (INTERACTIVE)
+ Fundo_boundary ();
+
+ /* Remove the abbrev */
+ buffer_delete_range (buf, abbrev_start, point, 0);
+ /* And insert the expansion. */
+ buffer_insert_lisp_string (buf, expansion);
+ point = BUF_PT (buf);
+
+ /* Now fiddle with the case. */
+ if (uccount && !lccount)
+ {
+ /* Abbrev was all caps */
+ if (!abbrev_all_caps
+ && scan_words (buf, point, -1) > scan_words (buf, abbrev_start, 1))
+ {
+ Fupcase_initials_region (make_int (abbrev_start), make_int (point),
+ make_buffer (buf));
+ }
+ else
+ {
+ /* If expansion is one word, or if user says so, upcase it all. */
+ Fupcase_region (make_int (abbrev_start), make_int (point),
+ make_buffer (buf));
+ }
+ }
+ else if (uccount)
+ {
+ /* Abbrev included some caps. Cap first initial of expansion */
+ Bufpos pos = abbrev_start;
+ /* Find the initial. */
+ while (pos < point
+ && !WORD_SYNTAX_P (XCHAR_TABLE (buf->mirror_syntax_table),
+ BUF_FETCH_CHAR (buf, pos)))
+ pos++;
+ /* Change just that. */
+ Fupcase_initials_region (make_int (pos), make_int (pos + 1),
+ make_buffer (buf));
+ }
+
+ hook = symbol_function (abbrev_symbol);
+ if (!NILP (hook) && !UNBOUNDP (hook))
+ call0 (hook);
+
+ return Vlast_abbrev;
+}
+
+\f
+void
+syms_of_abbrev (void)
+{
+ defsymbol (&Qpre_abbrev_expand_hook, "pre-abbrev-expand-hook");
+ DEFSUBR (Fexpand_abbrev);
+}
+
+void
+vars_of_abbrev (void)
+{
+ DEFVAR_LISP ("global-abbrev-table", &Vglobal_abbrev_table /*
+The abbrev table whose abbrevs affect all buffers.
+Each buffer may also have a local abbrev table.
+If it does, the local table overrides the global one
+for any particular abbrev defined in both.
+*/ );
+ Vglobal_abbrev_table = Qnil; /* setup by Lisp code */
+
+ DEFVAR_LISP ("last-abbrev", &Vlast_abbrev /*
+The abbrev-symbol of the last abbrev expanded.
+See the function `abbrev-symbol'.
+*/ );
+
+ DEFVAR_LISP ("last-abbrev-text", &Vlast_abbrev_text /*
+The exact text of the last abbrev expanded.
+nil if the abbrev has already been unexpanded.
+*/ );
+
+ DEFVAR_INT ("last-abbrev-location", &last_abbrev_location /*
+The location of the start of the last abbrev expanded.
+*/ );
+
+ Vlast_abbrev = Qnil;
+ Vlast_abbrev_text = Qnil;
+ last_abbrev_location = 0;
+
+ DEFVAR_LISP ("abbrev-start-location", &Vabbrev_start_location /*
+Buffer position for `expand-abbrev' to use as the start of the abbrev.
+nil means use the word before point as the abbrev.
+Calling `expand-abbrev' sets this to nil.
+*/ );
+ Vabbrev_start_location = Qnil;
+
+ DEFVAR_LISP ("abbrev-start-location-buffer", &Vabbrev_start_location_buffer /*
+Buffer that `abbrev-start-location' has been set for.
+Trying to expand an abbrev in any other buffer clears `abbrev-start-location'.
+*/ );
+ Vabbrev_start_location_buffer = Qnil;
+
+ DEFVAR_BOOL ("abbrev-all-caps", &abbrev_all_caps /*
+*Non-nil means expand multi-word abbrevs all caps if abbrev was so.
+*/ );
+ abbrev_all_caps = 0;
+
+ DEFVAR_LISP ("pre-abbrev-expand-hook", &Vpre_abbrev_expand_hook /*
+Function or functions to be called before abbrev expansion is done.
+This is the first thing that `expand-abbrev' does, and so this may change
+the current abbrev table before abbrev lookup happens.
+*/ );
+ Vpre_abbrev_expand_hook = Qnil;
+}
--- /dev/null
+/* Storage allocation and gc for XEmacs Lisp interpreter.
+ Copyright (C) 1985-1998 Free Software Foundation, Inc.
+ Copyright (C) 1995 Sun Microsystems, 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: FSF 19.28, Mule 2.0. Substantially different from
+ FSF. */
+
+/* Authorship:
+
+ FSF: Original version; a long time ago.
+ Mly: Significantly rewritten to use new 3-bit tags and
+ nicely abstracted object definitions, for 19.8.
+ JWZ: Improved code to keep track of purespace usage and
+ issue nice purespace and GC stats.
+ Ben Wing: Cleaned up frob-block lrecord code, added error-checking
+ and various changes for Mule, for 19.12.
+ Added bit vectors for 19.13.
+ 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.
+*/
+
+#include <config.h>
+#include "lisp.h"
+
+#include "backtrace.h"
+#include "buffer.h"
+#include "bytecode.h"
+#include "chartab.h"
+#include "device.h"
+#include "elhash.h"
+#include "events.h"
+#include "extents.h"
+#include "frame.h"
+#include "glyphs.h"
+#include "redisplay.h"
+#include "specifier.h"
+#include "sysfile.h"
+#include "window.h"
+
+#ifdef DOUG_LEA_MALLOC
+#include <malloc.h>
+#endif
+
+EXFUN (Fgarbage_collect, 0);
+
+/* #define GDB_SUCKS */
+
+#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 */
+/* If somebody wants to see this they can ask for it.
+#ifdef DEBUG_XEMACS
+#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 */
+#ifdef USE_DEBUG_MALLOC /* Taking the above comment at face value -slb */
+#include <dmalloc.h>
+#define ALLOC_NO_POOLS
+#endif
+
+#include "puresize.h"
+
+#ifdef DEBUG_XEMACS
+int debug_allocation;
+
+int debug_allocation_backtrace_length;
+#endif
+
+/* Number of bytes of consing done since the last gc */
+EMACS_INT consing_since_gc;
+#ifdef EMACS_BTL
+extern void cadillac_record_backtrace ();
+#define INCREMENT_CONS_COUNTER_1(size) \
+ do { \
+ EMACS_INT __sz__ = ((EMACS_INT) (size)); \
+ consing_since_gc += __sz__; \
+ cadillac_record_backtrace (2, __sz__); \
+ } while (0)
+#else
+#define INCREMENT_CONS_COUNTER_1(size) (consing_since_gc += (size))
+#endif /* EMACS_BTL */
+
+#define debug_allocation_backtrace() \
+do { \
+ if (debug_allocation_backtrace_length > 0) \
+ debug_short_backtrace (debug_allocation_backtrace_length); \
+} while (0)
+
+#ifdef DEBUG_XEMACS
+#define INCREMENT_CONS_COUNTER(foosize, type) \
+ do { \
+ if (debug_allocation) \
+ { \
+ stderr_out ("allocating %s (size %ld)\n", type, (long)foosize); \
+ debug_allocation_backtrace (); \
+ } \
+ INCREMENT_CONS_COUNTER_1 (foosize); \
+ } while (0)
+#define NOSEEUM_INCREMENT_CONS_COUNTER(foosize, type) \
+ do { \
+ if (debug_allocation > 1) \
+ { \
+ stderr_out ("allocating noseeum %s (size %ld)\n", type, (long)foosize); \
+ debug_allocation_backtrace (); \
+ } \
+ INCREMENT_CONS_COUNTER_1 (foosize); \
+ } while (0)
+#else
+#define INCREMENT_CONS_COUNTER(size, type) INCREMENT_CONS_COUNTER_1 (size)
+#define NOSEEUM_INCREMENT_CONS_COUNTER(size, type) \
+ INCREMENT_CONS_COUNTER_1 (size)
+#endif
+
+#define DECREMENT_CONS_COUNTER(size) \
+ do { \
+ EMACS_INT __sz__ = ((EMACS_INT) (size)); \
+ if (consing_since_gc >= __sz__) \
+ consing_since_gc -= __sz__; \
+ else \
+ consing_since_gc = 0; \
+ } while (0)
+
+/* Number of bytes of consing since gc before another gc should be done. */
+EMACS_INT gc_cons_threshold;
+
+/* Nonzero during gc */
+int gc_in_progress;
+
+/* Number of times GC has happened at this level or below.
+ * Level 0 is most volatile, contrary to usual convention.
+ * (Of course, there's only one level at present) */
+EMACS_INT gc_generation_number[1];
+
+/* This is just for use by the printer, to allow things to print uniquely */
+static int lrecord_uid_counter;
+
+/* Nonzero when calling certain hooks or doing other things where
+ a GC would be bad */
+int gc_currently_forbidden;
+
+/* Hooks. */
+Lisp_Object Vpre_gc_hook, Qpre_gc_hook;
+Lisp_Object Vpost_gc_hook, Qpost_gc_hook;
+
+/* "Garbage collecting" */
+Lisp_Object Vgc_message;
+Lisp_Object Vgc_pointer_glyph;
+static CONST char gc_default_message[] = "Garbage collecting";
+Lisp_Object Qgarbage_collecting;
+
+#ifndef VIRT_ADDR_VARIES
+extern
+#endif /* VIRT_ADDR_VARIES */
+ EMACS_INT malloc_sbrk_used;
+
+#ifndef VIRT_ADDR_VARIES
+extern
+#endif /* VIRT_ADDR_VARIES */
+ EMACS_INT malloc_sbrk_unused;
+
+/* Non-zero means defun should do purecopy on the function definition */
+int purify_flag;
+
+#ifdef HEAP_IN_DATA
+extern void sheap_adjust_h();
+#endif
+
+#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;
+
+#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)
+{
+ 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;
+}
+
+
+\f
+#ifndef PURESTAT
+
+#define bump_purestat(p,b) DO_NOTHING
+
+#else /* PURESTAT */
+
+static int purecopying_for_bytecode;
+
+static size_t pure_sizeof (Lisp_Object /*, int recurse */);
+
+/* Keep statistics on how much of what is in purespace */
+static struct purestat
+{
+ int nobjects;
+ int nbytes;
+ CONST char *name;
+}
+ purestat_cons = {0, 0, "cons cells"},
+ purestat_float = {0, 0, "float objects"},
+ purestat_string_pname = {0, 0, "symbol-name strings"},
+ purestat_bytecode = {0, 0, "compiled-function objects"},
+ purestat_string_bytecodes = {0, 0, "byte-code strings"},
+ purestat_vector_bytecode_constants = {0, 0, "byte-constant 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 struct purestat *purestats[] =
+{
+ &purestat_cons,
+ &purestat_float,
+ &purestat_string_pname,
+ &purestat_bytecode,
+ &purestat_string_bytecodes,
+ &purestat_vector_bytecode_constants,
+ &purestat_string_interactive,
+#ifdef I18N3
+ &purestat_string_domain,
+#endif
+ &purestat_string_documentation,
+ &purestat_string_other_function,
+ &purestat_vector_other,
+ &purestat_string_other,
+ 0,
+ &purestat_string_all,
+ &purestat_vector_all
+};
+
+static void
+bump_purestat (struct purestat *purestat, size_t nbytes)
+{
+ if (pure_lossage) return;
+ purestat->nobjects += 1;
+ purestat->nbytes += nbytes;
+}
+#endif /* PURESTAT */
+
+\f
+/* Maximum amount of C stack to save when a GC happens. */
+
+#ifndef MAX_SAVE_STACK
+#define MAX_SAVE_STACK 16000
+#endif
+
+/* Non-zero means ignore malloc warnings. Set during initialization. */
+int ignore_malloc_warnings;
+
+\f
+static void *breathing_space;
+
+void
+release_breathing_space (void)
+{
+ if (breathing_space)
+ {
+ void *tmp = breathing_space;
+ breathing_space = 0;
+ xfree (tmp);
+ }
+}
+
+/* malloc calls this if it finds we are near exhausting storage */
+void
+malloc_warning (CONST char *str)
+{
+ if (ignore_malloc_warnings)
+ return;
+
+ warn_when_safe
+ (Qmemory, Qcritical,
+ "%s\n"
+ "Killing some buffers may delay running out of memory.\n"
+ "However, certainly by the time you receive the 95%% warning,\n"
+ "you should clean up, kill this Emacs, and start a new one.",
+ str);
+}
+
+/* Called if malloc returns zero */
+DOESNT_RETURN
+memory_full (void)
+{
+ /* Force a GC next time eval is called.
+ It's better to loop garbage-collecting (we might reclaim enough
+ to win) than to loop beeping and barfing "Memory exhausted"
+ */
+ consing_since_gc = gc_cons_threshold + 1;
+ release_breathing_space ();
+
+ /* Flush some histories which might conceivably contain garbalogical
+ inhibitors. */
+ if (!NILP (Fboundp (Qvalues)))
+ Fset (Qvalues, Qnil);
+ Vcommand_history = Qnil;
+
+ error ("Memory exhausted");
+}
+
+/* like malloc and realloc but check for no memory left, and block input. */
+
+#ifdef xmalloc
+#undef xmalloc
+#endif
+
+void *
+xmalloc (size_t size)
+{
+ void *val = (void *) malloc (size);
+
+ if (!val && (size != 0)) memory_full ();
+ return val;
+}
+
+void *
+xmalloc_and_zero (size_t size)
+{
+ void *val = xmalloc (size);
+ memset (val, 0, size);
+ return val;
+}
+
+#ifdef xrealloc
+#undef xrealloc
+#endif
+
+void *
+xrealloc (void *block, size_t size)
+{
+ /* We must call malloc explicitly when BLOCK is 0, since some
+ reallocs don't do this. */
+ void *val = (void *) (block ? realloc (block, size) : malloc (size));
+
+ if (!val && (size != 0)) memory_full ();
+ return val;
+}
+
+void
+#ifdef ERROR_CHECK_MALLOC
+xfree_1 (void *block)
+#else
+xfree (void *block)
+#endif
+{
+#ifdef ERROR_CHECK_MALLOC
+ /* Unbelievably, calling free() on 0xDEADBEEF doesn't cause an
+ error until much later on for many system mallocs, such as
+ the one that comes with Solaris 2.3. FMH!! */
+ assert (block != (void *) 0xDEADBEEF);
+ assert (block);
+#endif /* ERROR_CHECK_MALLOC */
+ free (block);
+}
+
+#ifdef ERROR_CHECK_GC
+
+#if SIZEOF_INT == 4
+typedef unsigned int four_byte_t;
+#elif SIZEOF_LONG == 4
+typedef unsigned long four_byte_t;
+#elif SIZEOF_SHORT == 4
+typedef unsigned short four_byte_t;
+#else
+What kind of strange-ass system are we running on?
+#endif
+
+static void
+deadbeef_memory (void *ptr, size_t size)
+{
+ four_byte_t *ptr4 = (four_byte_t *) ptr;
+ size_t beefs = size >> 2;
+
+ /* In practice, size will always be a multiple of four. */
+ while (beefs--)
+ (*ptr4++) = 0xDEADBEEF;
+}
+
+#else /* !ERROR_CHECK_GC */
+
+
+#define deadbeef_memory(ptr, size)
+
+#endif /* !ERROR_CHECK_GC */
+
+#ifdef xstrdup
+#undef xstrdup
+#endif
+
+char *
+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;
+}
+
+#ifdef NEED_STRDUP
+char *
+strdup (CONST char *s)
+{
+ return xstrdup (s);
+}
+#endif /* NEED_STRDUP */
+
+\f
+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;
+}
+
+
+/* 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.
+ */
+static struct lcrecord_header *all_lcrecords;
+
+void *
+alloc_lcrecord (size_t size, CONST struct lrecord_implementation *implementation)
+{
+ struct lcrecord_header *lcheader;
+
+ if (size <= 0) abort ();
+ if (implementation->static_size == 0)
+ {
+ if (!implementation->size_in_bytes_method)
+ abort ();
+ }
+ else if (implementation->static_size != size)
+ abort ();
+
+ lcheader = (struct lcrecord_header *) allocate_lisp_storage (size);
+ set_lheader_implementation(&(lcheader->lheader), implementation);
+ lcheader->next = all_lcrecords;
+#if 1 /* mly prefers to see small ID numbers */
+ lcheader->uid = lrecord_uid_counter++;
+#else /* jwz prefers to see real addrs */
+ lcheader->uid = (int) &lcheader;
+#endif
+ lcheader->free = 0;
+ all_lcrecords = lcheader;
+ INCREMENT_CONS_COUNTER (size, implementation->name);
+ return lcheader;
+}
+
+#if 0 /* Presently unused */
+/* Very, very poor man's EGC?
+ * This may be slow and thrash pages all over the place.
+ * Only call it if you really feel you must (and if the
+ * lrecord was fairly recently allocated).
+ * Otherwise, just let the GC do its job -- that's what it's there for
+ */
+void
+free_lcrecord (struct lcrecord_header *lcrecord)
+{
+ if (all_lcrecords == lcrecord)
+ {
+ all_lcrecords = lcrecord->next;
+ }
+ else
+ {
+ struct lrecord_header *header = all_lcrecords;
+ for (;;)
+ {
+ struct lrecord_header *next = header->next;
+ if (next == lcrecord)
+ {
+ header->next = lrecord->next;
+ break;
+ }
+ else if (next == 0)
+ abort ();
+ else
+ header = next;
+ }
+ }
+ if (lrecord->implementation->finalizer)
+ ((lrecord->implementation->finalizer) (lrecord, 0));
+ xfree (lrecord);
+ return;
+}
+#endif /* Unused */
+
+
+static void
+disksave_object_finalization_1 (void)
+{
+ struct lcrecord_header *header;
+
+ for (header = all_lcrecords; header; header = header->next)
+ {
+ if (LHEADER_IMPLEMENTATION(&header->lheader)->finalizer &&
+ !header->free)
+ ((LHEADER_IMPLEMENTATION(&header->lheader)->finalizer)
+ (header, 1));
+ }
+}
+
+
+/* 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.
+ This sits in lheader->implementation->marker. */
+
+Lisp_Object
+this_one_is_unmarkable (Lisp_Object obj, void (*markobj) (Lisp_Object))
+{
+ 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
+}
+
+\f
+/**********************************************************************/
+/* Debugger support */
+/**********************************************************************/
+/* Give gdb/dbx enough information to decode Lisp Objects.
+ We make sure certain symbols are defined, so gdb doesn't complain
+ about expressions in src/gdbinit. Values are randomly chosen.
+ See src/gdbinit or src/dbxrc to see how this is used. */
+
+enum dbg_constants
+{
+#ifdef USE_MINIMAL_TAGBITS
+ dbg_valmask = (EMACS_INT) (((1UL << VALBITS) - 1) << GCBITS),
+ dbg_typemask = (EMACS_INT) ((1UL << GCTYPEBITS) - 1),
+ dbg_USE_MINIMAL_TAGBITS = 1,
+ dbg_Lisp_Type_Int = 100,
+#else /* ! USE_MIMIMAL_TAGBITS */
+ dbg_valmask = (EMACS_INT) ((1UL << VALBITS) - 1),
+ dbg_typemask = (EMACS_INT) (((1UL << GCTYPEBITS) - 1) << (VALBITS + GCMARKBITS)),
+ dbg_USE_MINIMAL_TAGBITS = 0,
+ dbg_Lisp_Type_Int = Lisp_Type_Int,
+#endif /* ! USE_MIMIMAL_TAGBITS */
+#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
+ dbg_USE_INDEXED_LRECORD_IMPLEMENTATION = 1,
+#else
+ dbg_USE_INDEXED_LRECORD_IMPLEMENTATION = 0,
+#endif
+ dbg_Lisp_Type_Char = Lisp_Type_Char,
+ dbg_Lisp_Type_Record = Lisp_Type_Record,
+#ifdef LRECORD_CONS
+ dbg_Lisp_Type_Cons = 101,
+#else
+ dbg_Lisp_Type_Cons = Lisp_Type_Cons,
+ lrecord_cons = 201,
+#endif
+#ifdef LRECORD_STRING
+ dbg_Lisp_Type_String = 102,
+#else
+ dbg_Lisp_Type_String = Lisp_Type_String,
+ lrecord_string = 202,
+#endif
+#ifdef LRECORD_VECTOR
+ dbg_Lisp_Type_Vector = 103,
+#else
+ dbg_Lisp_Type_Vector = Lisp_Type_Vector,
+ lrecord_vector = 203,
+#endif
+#ifdef LRECORD_SYMBOL
+ dbg_Lisp_Type_Symbol = 104,
+#else
+ dbg_Lisp_Type_Symbol = Lisp_Type_Symbol,
+ lrecord_symbol = 204,
+#endif
+#ifndef MULE
+ lrecord_char_table_entry = 205,
+ lrecord_charset = 206,
+ lrecord_coding_system = 207,
+#endif
+#ifndef HAVE_TOOLBARS
+ lrecord_toolbar_button = 208,
+#endif
+#ifndef HAVE_TOOLTALK
+ lrecord_tooltalk_message = 210,
+ lrecord_tooltalk_pattern = 211,
+#endif
+#ifndef HAVE_DATABASE
+ lrecord_database = 212,
+#endif
+ dbg_valbits = VALBITS,
+ dbg_gctypebits = GCTYPEBITS
+ /* If we don't have an actual object of this enum, pgcc (and perhaps
+ other compilers) might optimize away the entire type declaration :-( */
+} dbg_dummy;
+
+\f
+/**********************************************************************/
+/* Fixed-size type macros */
+/**********************************************************************/
+
+/* For fixed-size types that are commonly used, we malloc() large blocks
+ of memory at a time and subdivide them into chunks of the correct
+ size for an object of that type. This is more efficient than
+ malloc()ing each object separately because we save on malloc() time
+ and overhead due to the fewer number of malloc()ed blocks, and
+ also because we don't need any extra pointers within each object
+ to keep them threaded together for GC purposes. For less common
+ (and frequently large-size) types, we use lcrecords, which are
+ malloc()ed individually and chained together through a pointer
+ in the lcrecord header. lcrecords do not need to be fixed-size
+ (i.e. two objects of the same type need not have the same size;
+ however, the size of a particular object cannot vary dynamically).
+ It is also much easier to create a new lcrecord type because no
+ additional code needs to be added to alloc.c. Finally, lcrecords
+ may be more efficient when there are only a small number of them.
+
+ The types that are stored in these large blocks (or "frob blocks")
+ are cons, float, compiled-function, symbol, marker, extent, event,
+ and string.
+
+ Note that strings are special in that they are actually stored in
+ two parts: a structure containing information about the string, and
+ the actual data associated with the string. The former structure
+ (a struct Lisp_String) is a fixed-size structure and is managed the
+ same way as all the other such types. This structure contains a
+ 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
+ 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
+ make more sense) are malloc()ed separately and not stored in
+ string_chars_blocks. Furthermore, no one string stretches across
+ two string_chars_blocks.
+
+ Vectors are each malloc()ed separately, similar to lcrecords.
+
+ In the following discussion, we use conses, but it applies equally
+ well to the other fixed-size types.
+
+ We store cons cells inside of cons_blocks, allocating a new
+ cons_block with malloc() whenever necessary. Cons cells reclaimed
+ by GC are put on a free list to be reallocated before allocating
+ any new cons cells from the latest cons_block. Each cons_block is
+ just under 2^n - MALLOC_OVERHEAD bytes long, since malloc (at least
+ the versions in malloc.c and gmalloc.c) really allocates in units
+ of powers of two and uses 4 bytes for its own overhead.
+
+ What GC actually does is to search through all the cons_blocks,
+ from the most recently allocated to the oldest, and put all
+ cons cells that are not marked (whether or not they're already
+ free) on a cons_free_list. The cons_free_list is a stack, and
+ so the cons cells in the oldest-allocated cons_block end up
+ at the head of the stack and are the first to be reallocated.
+ If any cons_block is entirely free, it is freed with free()
+ and its cons cells removed from the cons_free_list. Because
+ the cons_free_list ends up basically in memory order, we have
+ a high locality of reference (assuming a reasonable turnover
+ of allocating and freeing) and have a reasonable probability
+ of entirely freeing up cons_blocks that have been more recently
+ allocated. This stage is called the "sweep stage" of GC, and
+ is executed after the "mark stage", which involves starting
+ from all places that are known to point to in-use Lisp objects
+ (e.g. the obarray, where are all symbols are stored; the
+ current catches and condition-cases; the backtrace list of
+ currently executing functions; the gcpro list; etc.) and
+ recursively marking all objects that are accessible.
+
+ At the beginning of the sweep stage, the conses in the cons
+ blocks are in one of three states: in use and marked, in use
+ but not marked, and not in use (already freed). Any conses
+ that are marked have been marked in the mark stage just
+ executed, because as part of the sweep stage we unmark any
+ marked objects. The way we tell whether or not a cons cell
+ is in use is through the FREE_STRUCT_P macro. This basically
+ looks at the first 4 bytes (or however many bytes a pointer
+ fits in) to see if all the bits in those bytes are 1. The
+ resulting value (0xFFFFFFFF) is not a valid pointer and is
+ not a valid Lisp_Object. All current fixed-size types have
+ a pointer or Lisp_Object as their first element with the
+ exception of strings; they have a size value, which can
+ never be less than zero, and so 0xFFFFFFFF is invalid for
+ strings as well. Now assuming that a cons cell is in use,
+ the way we tell whether or not it is marked is to look at
+ the mark bit of its car (each Lisp_Object has one bit
+ reserved as a mark bit, in case it's needed). Note that
+ different types of objects use different fields to indicate
+ whether the object is marked, but the principle is the same.
+
+ Conses on the free_cons_list are threaded through a pointer
+ stored in the bytes directly after the bytes that are set
+ to 0xFFFFFFFF (we cannot overwrite these because the cons
+ is still in a cons_block and needs to remain marked as
+ not in use for the next time that GC happens). This
+ implies that all fixed-size types must be at least big
+ enough to store two pointers, which is indeed the case
+ for all current fixed-size types.
+
+ Some types of objects need additional "finalization" done
+ when an object is converted from in use to not in use;
+ this is the purpose of the ADDITIONAL_FREE_type macro.
+ For example, markers need to be removed from the chain
+ of markers that is kept in each buffer. This is because
+ markers in a buffer automatically disappear if the marker
+ is no longer referenced anywhere (the same does not
+ apply to extents, however).
+
+ WARNING: Things are in an extremely bizarre state when
+ the ADDITIONAL_FREE_type macros are called, so beware!
+
+ When ERROR_CHECK_GC is defined, we do things differently
+ so as to maximize our chances of catching places where
+ there is insufficient GCPROing. The thing we want to
+ avoid is having an object that we're using but didn't
+ GCPRO get freed by GC and then reallocated while we're
+ in the process of using it -- this will result in something
+ seemingly unrelated getting trashed, and is extremely
+ difficult to track down. If the object gets freed but
+ not reallocated, we can usually catch this because we
+ set all bytes of a freed object to 0xDEADBEEF. (The
+ first four bytes, however, are 0xFFFFFFFF, and the next
+ four are a pointer used to chain freed objects together;
+ we play some tricks with this pointer to make it more
+ bogus, so crashes are more likely to occur right away.)
+
+ We want freed objects to stay free as long as possible,
+ so instead of doing what we do above, we maintain the
+ free objects in a first-in first-out queue. We also
+ don't recompute the free list each GC, unlike above;
+ this ensures that the queue ordering is preserved.
+ [This means that we are likely to have worse locality
+ of reference, and that we can never free a frob block
+ once it's allocated. (Even if we know that all cells
+ in it are free, there's no easy way to remove all those
+ cells from the free list because the objects on the
+ free list are unlikely to be in memory order.)]
+ Furthermore, we never take objects off the free list
+ unless there's a large number (usually 1000, but
+ 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.
+*/
+
+#ifndef MALLOC_OVERHEAD
+#ifdef GNU_MALLOC
+#define MALLOC_OVERHEAD 0
+#elif defined (rcheck)
+#define MALLOC_OVERHEAD 20
+#else
+#define MALLOC_OVERHEAD 8
+#endif
+#endif /* MALLOC_OVERHEAD */
+
+#if !defined(HAVE_MMAP) || defined(DOUG_LEA_MALLOC)
+/* If we released our reserve (due to running out of memory),
+ and we have a fair amount free once again,
+ try to set aside another reserve in case we run out once more.
+
+ This is called when a relocatable block is freed in ralloc.c. */
+void refill_memory_reserve (void);
+void
+refill_memory_reserve ()
+{
+ if (breathing_space == 0)
+ breathing_space = (char *) malloc (4096 - MALLOC_OVERHEAD);
+}
+#endif
+
+#ifdef ALLOC_NO_POOLS
+# define TYPE_ALLOC_SIZE(type, structtype) 1
+#else
+# define TYPE_ALLOC_SIZE(type, structtype) \
+ ((2048 - MALLOC_OVERHEAD - sizeof (struct type##_block *)) \
+ / sizeof (structtype))
+#endif /* ALLOC_NO_POOLS */
+
+#define DECLARE_FIXED_TYPE_ALLOC(type, structtype) \
+ \
+struct type##_block \
+{ \
+ struct type##_block *prev; \
+ structtype block[TYPE_ALLOC_SIZE (type, structtype)]; \
+}; \
+ \
+static struct type##_block *current_##type##_block; \
+static int current_##type##_block_index; \
+ \
+static structtype *type##_free_list; \
+static structtype *type##_free_list_tail; \
+ \
+static void \
+init_##type##_alloc (void) \
+{ \
+ current_##type##_block = 0; \
+ current_##type##_block_index = countof (current_##type##_block->block); \
+ type##_free_list = 0; \
+ type##_free_list_tail = 0; \
+} \
+ \
+static int gc_count_num_##type##_in_use, gc_count_num_##type##_freelist
+
+#define ALLOCATE_FIXED_TYPE_FROM_BLOCK(type, result) \
+ do { \
+ if (current_##type##_block_index \
+ == countof (current_##type##_block->block)) \
+ { \
+ struct type##_block *__new__ = (struct type##_block *) \
+ allocate_lisp_storage (sizeof (struct type##_block)); \
+ __new__->prev = current_##type##_block; \
+ current_##type##_block = __new__; \
+ current_##type##_block_index = 0; \
+ } \
+ (result) = \
+ &(current_##type##_block->block[current_##type##_block_index++]); \
+ } while (0)
+
+/* Allocate an instance of a type that is stored in blocks.
+ TYPE is the "name" of the type, STRUCTTYPE is the corresponding
+ structure type. */
+
+#ifdef ERROR_CHECK_GC
+
+/* Note: if you get crashes in this function, suspect incorrect calls
+ to free_cons() and friends. This happened once because the cons
+ cell was not GC-protected and was getting collected before
+ free_cons() was called. */
+
+#define ALLOCATE_FIXED_TYPE_1(type, structtype, result) \
+do \
+{ \
+ if (gc_count_num_##type##_freelist > \
+ MINIMUM_ALLOWED_FIXED_TYPE_CELLS_##type) \
+ { \
+ result = type##_free_list; \
+ /* Before actually using the chain pointer, we complement all its \
+ bits; see FREE_FIXED_TYPE(). */ \
+ type##_free_list = \
+ (structtype *) ~(unsigned long) \
+ (* (structtype **) ((char *) result + sizeof (void *))); \
+ gc_count_num_##type##_freelist--; \
+ } \
+ else \
+ ALLOCATE_FIXED_TYPE_FROM_BLOCK (type, result); \
+ MARK_STRUCT_AS_NOT_FREE (result); \
+} while (0)
+
+#else /* !ERROR_CHECK_GC */
+
+#define ALLOCATE_FIXED_TYPE_1(type, structtype, result) \
+do \
+{ \
+ if (type##_free_list) \
+ { \
+ result = type##_free_list; \
+ type##_free_list = \
+ * (structtype **) ((char *) result + sizeof (void *)); \
+ } \
+ else \
+ ALLOCATE_FIXED_TYPE_FROM_BLOCK (type, result); \
+ MARK_STRUCT_AS_NOT_FREE (result); \
+} while (0)
+
+#endif /* !ERROR_CHECK_GC */
+
+#define ALLOCATE_FIXED_TYPE(type, structtype, result) \
+do \
+{ \
+ ALLOCATE_FIXED_TYPE_1 (type, structtype, result); \
+ INCREMENT_CONS_COUNTER (sizeof (structtype), #type); \
+} while (0)
+
+#define NOSEEUM_ALLOCATE_FIXED_TYPE(type, structtype, result) \
+do \
+{ \
+ ALLOCATE_FIXED_TYPE_1 (type, structtype, result); \
+ NOSEEUM_INCREMENT_CONS_COUNTER (sizeof (structtype), #type); \
+} while (0)
+
+/* INVALID_POINTER_VALUE should be a value that is invalid as a pointer
+ to a Lisp object and invalid as an actual Lisp_Object value. We have
+ to make sure that this value cannot be an integer in Lisp_Object form.
+ 0xFFFFFFFF could be so on a 64-bit system, so we extend it to 64 bits.
+ On a 32-bit system, the type bits will be non-zero, making the value
+ be a pointer, and the pointer will be misaligned.
+
+ Even if Emacs is run on some weirdo system that allows and allocates
+ byte-aligned pointers, this pointer is at the very top of the address
+ space and so it's almost inconceivable that it could ever be valid. */
+
+#if INTBITS == 32
+# define INVALID_POINTER_VALUE 0xFFFFFFFF
+#elif INTBITS == 48
+# define INVALID_POINTER_VALUE 0xFFFFFFFFFFFF
+#elif INTBITS == 64
+# define INVALID_POINTER_VALUE 0xFFFFFFFFFFFFFFFF
+#else
+You have some weird system and need to supply a reasonable value here.
+#endif
+
+#define FREE_STRUCT_P(ptr) \
+ (* (void **) ptr == (void *) INVALID_POINTER_VALUE)
+#define MARK_STRUCT_AS_FREE(ptr) \
+ (* (void **) ptr = (void *) INVALID_POINTER_VALUE)
+#define MARK_STRUCT_AS_NOT_FREE(ptr) \
+ (* (void **) ptr = 0)
+
+#ifdef ERROR_CHECK_GC
+
+#define PUT_FIXED_TYPE_ON_FREE_LIST(type, structtype, ptr) \
+do { if (type##_free_list_tail) \
+ { \
+ /* When we store the chain pointer, we complement all \
+ its bits; this should significantly increase its \
+ bogosity in case someone tries to use the value, and \
+ should make us dump faster if someone stores something \
+ over the pointer because when it gets un-complemented in \
+ ALLOCATED_FIXED_TYPE(), the resulting pointer will be \
+ extremely bogus. */ \
+ * (structtype **) \
+ ((char *) type##_free_list_tail + sizeof (void *)) = \
+ (structtype *) ~(unsigned long) ptr; \
+ } \
+ else \
+ type##_free_list = ptr; \
+ type##_free_list_tail = ptr; \
+ } while (0)
+
+#else /* !ERROR_CHECK_GC */
+
+#define PUT_FIXED_TYPE_ON_FREE_LIST(type, structtype, ptr) \
+do { * (structtype **) ((char *) ptr + sizeof (void *)) = \
+ type##_free_list; \
+ type##_free_list = ptr; \
+ } while (0)
+
+#endif /* !ERROR_CHECK_GC */
+
+/* TYPE and STRUCTTYPE are the same as in ALLOCATE_FIXED_TYPE(). */
+
+#define FREE_FIXED_TYPE(type, structtype, ptr) \
+do { structtype *_weird_ = (ptr); \
+ ADDITIONAL_FREE_##type (_weird_); \
+ deadbeef_memory (ptr, sizeof (structtype)); \
+ PUT_FIXED_TYPE_ON_FREE_LIST (type, structtype, ptr); \
+ MARK_STRUCT_AS_FREE (_weird_); \
+ } while (0)
+
+/* Like FREE_FIXED_TYPE() but used when we are explicitly
+ freeing a structure through free_cons(), free_marker(), etc.
+ rather than through the normal process of sweeping.
+ We attempt to undo the changes made to the allocation counters
+ as a result of this structure being allocated. This is not
+ completely necessary but helps keep things saner: e.g. this way,
+ repeatedly allocating and freeing a cons will not result in
+ the consing-since-gc counter advancing, which would cause a GC
+ and somewhat defeat the purpose of explicitly freeing. */
+
+#define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(type, structtype, ptr) \
+do { FREE_FIXED_TYPE (type, structtype, ptr); \
+ DECREMENT_CONS_COUNTER (sizeof (structtype)); \
+ gc_count_num_##type##_freelist++; \
+ } while (0)
+
+
+\f
+/**********************************************************************/
+/* Cons allocation */
+/**********************************************************************/
+
+DECLARE_FIXED_TYPE_ALLOC (cons, struct 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))
+{
+ if (NILP (XCDR (obj)))
+ return XCAR (obj);
+
+ (markobj) (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))
+ {
+ ob1 = XCDR (ob1);
+ ob2 = XCDR (ob2);
+ if (! CONSP (ob1) || ! CONSP (ob2))
+ return internal_equal (ob1, ob2, depth + 1);
+ }
+ return 0;
+}
+
+DEFINE_BASIC_LRECORD_IMPLEMENTATION ("cons", cons,
+ mark_cons, print_cons, 0,
+ cons_equal,
+ /*
+ * No `hash' method needed.
+ * internal_hash knows how to
+ * handle conses.
+ */
+ 0,
+ struct Lisp_Cons);
+#endif /* LRECORD_CONS */
+
+DEFUN ("cons", Fcons, 2, 2, 0, /*
+Create a new cons, give it CAR and CDR as components, and return it.
+*/
+ (car, cdr))
+{
+ /* 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
+ XSETCONS (val, c);
+ c->car = car;
+ c->cdr = cdr;
+ return val;
+}
+
+/* This is identical to Fcons() but it used for conses that we're
+ going to free later, and is useful when trying to track down
+ "real" consing. */
+Lisp_Object
+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
+ XSETCONS (val, c);
+ XCAR (val) = car;
+ XCDR (val) = cdr;
+ return val;
+}
+
+DEFUN ("list", Flist, 0, MANY, 0, /*
+Return a newly created list with specified arguments as elements.
+Any number of arguments, even zero arguments, are allowed.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ Lisp_Object val = Qnil;
+ Lisp_Object *argp = args + nargs;
+
+ while (nargs-- > 0)
+ val = Fcons (*--argp, val);
+ return val;
+}
+
+Lisp_Object
+list1 (Lisp_Object obj0)
+{
+ /* This cannot GC. */
+ return Fcons (obj0, Qnil);
+}
+
+Lisp_Object
+list2 (Lisp_Object obj0, Lisp_Object obj1)
+{
+ /* This cannot GC. */
+ return Fcons (obj0, Fcons (obj1, Qnil));
+}
+
+Lisp_Object
+list3 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2)
+{
+ /* This cannot GC. */
+ return Fcons (obj0, Fcons (obj1, Fcons (obj2, Qnil)));
+}
+
+Lisp_Object
+cons3 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2)
+{
+ /* This cannot GC. */
+ return Fcons (obj0, Fcons (obj1, obj2));
+}
+
+Lisp_Object
+acons (Lisp_Object key, Lisp_Object value, Lisp_Object alist)
+{
+ return Fcons (Fcons (key, value), alist);
+}
+
+Lisp_Object
+list4 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2, Lisp_Object obj3)
+{
+ /* This cannot GC. */
+ return Fcons (obj0, Fcons (obj1, Fcons (obj2, Fcons (obj3, Qnil))));
+}
+
+Lisp_Object
+list5 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2, Lisp_Object obj3,
+ Lisp_Object obj4)
+{
+ /* This cannot GC. */
+ return Fcons (obj0, Fcons (obj1, Fcons (obj2, Fcons (obj3, Fcons (obj4, Qnil)))));
+}
+
+Lisp_Object
+list6 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2, Lisp_Object obj3,
+ Lisp_Object obj4, Lisp_Object obj5)
+{
+ /* This cannot GC. */
+ return Fcons (obj0, Fcons (obj1, Fcons (obj2, Fcons (obj3, Fcons (obj4, Fcons (obj5, Qnil))))));
+}
+
+DEFUN ("make-list", Fmake_list, 2, 2, 0, /*
+Return a new list of length LENGTH, with each element being INIT.
+*/
+ (length, init))
+{
+ CHECK_NATNUM (length);
+
+ {
+ Lisp_Object val = Qnil;
+ int size = XINT (length);
+
+ while (size-- > 0)
+ val = Fcons (init, val);
+ return val;
+ }
+}
+
+\f
+/**********************************************************************/
+/* Float allocation */
+/**********************************************************************/
+
+#ifdef LISP_FLOAT_TYPE
+
+DECLARE_FIXED_TYPE_ALLOC (float, struct 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);
+ float_data (f) = float_value;
+ XSETFLOAT (val, f);
+ return val;
+}
+
+#endif /* LISP_FLOAT_TYPE */
+
+\f
+/**********************************************************************/
+/* Vector allocation */
+/**********************************************************************/
+
+#ifdef LRECORD_VECTOR
+static Lisp_Object
+mark_vector (Lisp_Object obj, void (*markobj) (Lisp_Object))
+{
+ struct Lisp_Vector *ptr = XVECTOR (obj);
+ int len = vector_length (ptr);
+ int i;
+
+ for (i = 0; i < len - 1; i++)
+ (markobj) (ptr->contents[i]);
+ return (len > 0) ? ptr->contents[len - 1] : Qnil;
+}
+
+static size_t
+size_vector (CONST void *lheader)
+{
+ /* * -1 because struct Lisp_Vector includes 1 slot */
+ return sizeof (struct Lisp_Vector) +
+ ((((struct Lisp_Vector *) lheader)->size - 1) * sizeof (Lisp_Object));
+}
+
+static int
+vector_equal (Lisp_Object o1, Lisp_Object o2, int depth)
+{
+ int indice;
+ int len = XVECTOR_LENGTH (o1);
+ if (len != XVECTOR_LENGTH (o2))
+ return 0;
+ for (indice = 0; indice < len; indice++)
+ {
+ if (!internal_equal (XVECTOR_DATA (o1) [indice],
+ XVECTOR_DATA (o2) [indice],
+ depth + 1))
+ return 0;
+ }
+ return 1;
+}
+
+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,
+ size_vector, struct Lisp_Vector);
+
+/* #### should allocate `small' vectors from a frob-block */
+static struct Lisp_Vector *
+make_vector_internal (size_t sizei)
+{
+ size_t sizem = (sizeof (struct Lisp_Vector)
+ /* -1 because struct Lisp_Vector includes 1 slot */
+ + (sizei - 1) * sizeof (Lisp_Object));
+ struct Lisp_Vector *p =
+ (struct 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 struct Lisp_Vector *
+make_vector_internal (size_t sizei)
+{
+ size_t sizem = (sizeof (struct Lisp_Vector)
+ /* -1 because struct Lisp_Vector includes 1 slot,
+ * +1 to account for vector_next */
+ + (sizei - 1 + 1) * sizeof (Lisp_Object));
+ struct Lisp_Vector *p = (struct 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 (EMACS_INT length, Lisp_Object init)
+{
+ int elt;
+ Lisp_Object vector;
+ struct Lisp_Vector *p;
+
+ if (length < 0)
+ length = XINT (wrong_type_argument (Qnatnump, make_int (length)));
+
+ p = make_vector_internal (length);
+ XSETVECTOR (vector, p);
+
+#if 0
+ /* Initialize big arrays full of 0's quickly, for what that's worth */
+ {
+ char *travesty = (char *) &init;
+ for (i = 1; i < sizeof (Lisp_Object); i++)
+ {
+ if (travesty[i] != travesty[0])
+ goto fill;
+ }
+ memset (vector_data (p), travesty[0], length * sizeof (Lisp_Object));
+ return vector;
+ }
+ fill:
+#endif
+ for (elt = 0; elt < length; elt++)
+ vector_data(p)[elt] = init;
+
+ return vector;
+}
+
+DEFUN ("make-vector", Fmake_vector, 2, 2, 0, /*
+Return a new vector of length LENGTH, with each element being INIT.
+See also the function `vector'.
+*/
+ (length, init))
+{
+ CHECK_NATNUM (length);
+ return make_vector (XINT (length), init);
+}
+
+DEFUN ("vector", Fvector, 0, MANY, 0, /*
+Return a newly created vector with specified arguments as elements.
+Any number of arguments, even zero arguments, are allowed.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ Lisp_Object vector;
+ int elt;
+ struct Lisp_Vector *p = make_vector_internal (nargs);
+
+ for (elt = 0; elt < nargs; elt++)
+ vector_data(p)[elt] = args[elt];
+
+ XSETVECTOR (vector, p);
+ return vector;
+}
+
+Lisp_Object
+vector1 (Lisp_Object obj0)
+{
+ return Fvector (1, &obj0);
+}
+
+Lisp_Object
+vector2 (Lisp_Object obj0, Lisp_Object obj1)
+{
+ Lisp_Object args[2];
+ args[0] = obj0;
+ args[1] = obj1;
+ return Fvector (2, args);
+}
+
+Lisp_Object
+vector3 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2)
+{
+ Lisp_Object args[3];
+ args[0] = obj0;
+ args[1] = obj1;
+ args[2] = obj2;
+ return Fvector (3, args);
+}
+
+#if 0 /* currently unused */
+
+Lisp_Object
+vector4 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2,
+ Lisp_Object obj3)
+{
+ Lisp_Object args[4];
+ args[0] = obj0;
+ args[1] = obj1;
+ args[2] = obj2;
+ args[3] = obj3;
+ return Fvector (4, args);
+}
+
+Lisp_Object
+vector5 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2,
+ Lisp_Object obj3, Lisp_Object obj4)
+{
+ Lisp_Object args[5];
+ args[0] = obj0;
+ args[1] = obj1;
+ args[2] = obj2;
+ args[3] = obj3;
+ args[4] = obj4;
+ return Fvector (5, args);
+}
+
+Lisp_Object
+vector6 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2,
+ Lisp_Object obj3, Lisp_Object obj4, Lisp_Object obj5)
+{
+ Lisp_Object args[6];
+ args[0] = obj0;
+ args[1] = obj1;
+ args[2] = obj2;
+ args[3] = obj3;
+ args[4] = obj4;
+ args[5] = obj5;
+ return Fvector (6, args);
+}
+
+Lisp_Object
+vector7 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2,
+ Lisp_Object obj3, Lisp_Object obj4, Lisp_Object obj5,
+ Lisp_Object obj6)
+{
+ Lisp_Object args[7];
+ args[0] = obj0;
+ args[1] = obj1;
+ args[2] = obj2;
+ args[3] = obj3;
+ args[4] = obj4;
+ args[5] = obj5;
+ args[6] = obj6;
+ return Fvector (7, args);
+}
+
+Lisp_Object
+vector8 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2,
+ Lisp_Object obj3, Lisp_Object obj4, Lisp_Object obj5,
+ Lisp_Object obj6, Lisp_Object obj7)
+{
+ Lisp_Object args[8];
+ args[0] = obj0;
+ args[1] = obj1;
+ args[2] = obj2;
+ args[3] = obj3;
+ args[4] = obj4;
+ args[5] = obj5;
+ args[6] = obj6;
+ args[7] = obj7;
+ return Fvector (8, args);
+}
+#endif /* unused */
+
+/**********************************************************************/
+/* Bit Vector allocation */
+/**********************************************************************/
+
+static Lisp_Object all_bit_vectors;
+
+/* #### should allocate `small' bit vectors from a frob-block */
+static struct Lisp_Bit_Vector *
+make_bit_vector_internal (size_t sizei)
+{
+ size_t sizem = sizeof (struct Lisp_Bit_Vector) +
+ /* -1 because struct Lisp_Bit_Vector includes 1 slot */
+ sizeof (long) * (BIT_VECTOR_LONG_STORAGE (sizei) - 1);
+ struct Lisp_Bit_Vector *p =
+ (struct Lisp_Bit_Vector *) allocate_lisp_storage (sizem);
+ set_lheader_implementation (&(p->lheader), lrecord_bit_vector);
+
+ INCREMENT_CONS_COUNTER (sizem, "bit-vector");
+
+ bit_vector_length (p) = sizei;
+ bit_vector_next (p) = all_bit_vectors;
+ /* make sure the extra bits in the last long are 0; the calling
+ functions might not set them. */
+ p->bits[BIT_VECTOR_LONG_STORAGE (sizei) - 1] = 0;
+ XSETBIT_VECTOR (all_bit_vectors, p);
+ return p;
+}
+
+Lisp_Object
+make_bit_vector (EMACS_INT length, Lisp_Object init)
+{
+ Lisp_Object bit_vector;
+ struct Lisp_Bit_Vector *p;
+ EMACS_INT num_longs;
+
+ CHECK_BIT (init);
+
+ num_longs = BIT_VECTOR_LONG_STORAGE (length);
+ p = make_bit_vector_internal (length);
+ XSETBIT_VECTOR (bit_vector, p);
+
+ if (ZEROP (init))
+ memset (p->bits, 0, num_longs * sizeof (long));
+ else
+ {
+ EMACS_INT bits_in_last = length & (LONGBITS_POWER_OF_2 - 1);
+ memset (p->bits, ~0, num_longs * sizeof (long));
+ /* But we have to make sure that the unused bits in the
+ last integer are 0, so that equal/hash is easy. */
+ if (bits_in_last)
+ p->bits[num_longs - 1] &= (1 << bits_in_last) - 1;
+ }
+
+ return bit_vector;
+}
+
+Lisp_Object
+make_bit_vector_from_byte_vector (unsigned char *bytevec, EMACS_INT length)
+{
+ Lisp_Object bit_vector;
+ struct Lisp_Bit_Vector *p;
+ int i;
+
+ if (length < 0)
+ length = XINT (wrong_type_argument (Qnatnump, make_int (length)));
+
+ p = make_bit_vector_internal (length);
+ XSETBIT_VECTOR (bit_vector, p);
+
+ for (i = 0; i < length; i++)
+ set_bit_vector_bit (p, i, bytevec[i]);
+
+ return bit_vector;
+}
+
+DEFUN ("make-bit-vector", Fmake_bit_vector, 2, 2, 0, /*
+Return a new bit vector of length LENGTH. with each bit being INIT.
+Each element is set to INIT. See also the function `bit-vector'.
+*/
+ (length, init))
+{
+ CONCHECK_NATNUM (length);
+
+ return make_bit_vector (XINT (length), init);
+}
+
+DEFUN ("bit-vector", Fbit_vector, 0, MANY, 0, /*
+Return a newly created bit vector with specified arguments as elements.
+Any number of arguments, even zero arguments, are allowed.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ Lisp_Object bit_vector;
+ int elt;
+ struct Lisp_Bit_Vector *p;
+
+ for (elt = 0; elt < nargs; elt++)
+ CHECK_BIT (args[elt]);
+
+ p = make_bit_vector_internal (nargs);
+
+ for (elt = 0; elt < nargs; elt++)
+ set_bit_vector_bit (p, elt, !ZEROP (args[elt]));
+
+ XSETBIT_VECTOR (bit_vector, p);
+ return bit_vector;
+}
+
+\f
+/**********************************************************************/
+/* Compiled-function allocation */
+/**********************************************************************/
+
+DECLARE_FIXED_TYPE_ALLOC (compiled_function, struct Lisp_Compiled_Function);
+#define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_compiled_function 1000
+
+static Lisp_Object
+make_compiled_function (int make_pure)
+{
+ struct Lisp_Compiled_Function *b;
+ Lisp_Object new;
+ size_t size = sizeof (struct Lisp_Compiled_Function);
+
+ if (make_pure && check_purespace (size))
+ {
+ b = (struct Lisp_Compiled_Function *) (PUREBEG + pure_bytes_used);
+ set_lheader_implementation (&(b->lheader), lrecord_compiled_function);
+#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
+ b->lheader.pure = 1;
+#endif
+ pure_bytes_used += size;
+ bump_purestat (&purestat_bytecode, size);
+ }
+ else
+ {
+ ALLOCATE_FIXED_TYPE (compiled_function, struct Lisp_Compiled_Function,
+ b);
+ set_lheader_implementation (&(b->lheader), lrecord_compiled_function);
+ }
+ b->maxdepth = 0;
+ b->flags.documentationp = 0;
+ b->flags.interactivep = 0;
+ b->flags.domainp = 0; /* I18N3 */
+ b->bytecodes = Qzero;
+ b->constants = Qzero;
+ b->arglist = Qnil;
+ b->doc_and_interactive = Qnil;
+#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+ b->annotated = Qnil;
+#endif
+ XSETCOMPILED_FUNCTION (new, b);
+ return new;
+}
+
+DEFUN ("make-byte-code", Fmake_byte_code, 4, MANY, 0, /*
+Return a new compiled-function object.
+Usage: (arglist instructions constants stack-size
+ &optional doc-string interactive-spec)
+Note that, unlike all other emacs-lisp functions, calling this with five
+arguments is NOT the same as calling it with six arguments, the last of
+which is nil. If the INTERACTIVE arg is specified as nil, then that means
+that this function was defined with `(interactive)'. If the arg is not
+specified, then that means the function is not interactive.
+This is terrible behavior which is retained for compatibility with old
+`.elc' files which expected these semantics.
+*/
+ (int nargs, Lisp_Object *args))
+{
+/* In a non-insane world this function would have this arglist...
+ (arglist, instructions, constants, stack_size, doc_string, interactive)
+ Lisp_Object arglist, instructions, constants, stack_size, doc_string,
+ interactive;
+ */
+ Lisp_Object arglist = args[0];
+ Lisp_Object instructions = args[1];
+ Lisp_Object constants = args[2];
+ Lisp_Object stack_size = args[3];
+ 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 the trouble. But during that entire window,
+ the objects are sitting on Vload_force_doc_string_list, which
+ is staticpro'd, so we're OK. */
+ int purecopy_instructions = 1;
+
+ if (nargs > 6)
+ return Fsignal (Qwrong_number_of_arguments,
+ list2 (intern ("make-byte-code"), make_int (nargs)));
+
+ CHECK_LIST (arglist);
+ /* instructions is a string or a cons (string . int) for a
+ lazy-loaded function. */
+ if (CONSP (instructions))
+ {
+ CHECK_STRING (XCAR (instructions));
+ CHECK_INT (XCDR (instructions));
+ if (!NILP (constants))
+ CHECK_VECTOR (constants);
+ purecopy_instructions = 0;
+ }
+ else
+ {
+ CHECK_STRING (instructions);
+ CHECK_VECTOR (constants);
+ }
+ CHECK_NATNUM (stack_size);
+ /* doc_string may be nil, string, int, or a cons (string . int). */
+
+ /* interactive may be list or string (or unbound). */
+
+ if (purify_flag)
+ {
+ if (!purified (arglist))
+ arglist = Fpurecopy (arglist);
+ if (purecopy_instructions && !purified (instructions))
+ instructions = Fpurecopy (instructions);
+ if (!purified (doc_string))
+ doc_string = Fpurecopy (doc_string);
+ if (!purified (interactive) && !UNBOUNDP (interactive))
+ interactive = Fpurecopy (interactive);
+
+ /* Statistics are kept differently for the constants */
+ if (!purified (constants))
+#ifdef PURESTAT
+ {
+ int old = purecopying_for_bytecode;
+ purecopying_for_bytecode = 1;
+ constants = Fpurecopy (constants);
+ purecopying_for_bytecode = old;
+ }
+#else
+ constants = Fpurecopy (constants);
+#endif /* PURESTAT */
+
+#ifdef PURESTAT
+ if (STRINGP (instructions))
+ bump_purestat (&purestat_string_bytecodes, pure_sizeof (instructions));
+ if (VECTORP (constants))
+ bump_purestat (&purestat_vector_bytecode_constants,
+ pure_sizeof (constants));
+ if (STRINGP (doc_string))
+ /* These should be have been snagged by make-docfile... */
+ bump_purestat (&purestat_string_documentation,
+ pure_sizeof (doc_string));
+ if (STRINGP (interactive))
+ bump_purestat (&purestat_string_interactive,
+ pure_sizeof (interactive));
+#endif /* PURESTAT */
+ }
+
+ {
+ int docp = !NILP (doc_string);
+ int intp = !UNBOUNDP (interactive);
+#ifdef I18N3
+ int domp = !NILP (Vfile_domain);
+#endif
+ Lisp_Object val = make_compiled_function (purify_flag);
+ struct Lisp_Compiled_Function *b = XCOMPILED_FUNCTION (val);
+ b->flags.documentationp = docp;
+ b->flags.interactivep = intp;
+#ifdef I18N3
+ b->flags.domainp = domp;
+#endif
+ b->maxdepth = XINT (stack_size);
+ b->bytecodes = instructions;
+ b->constants = constants;
+ b->arglist = arglist;
+#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+ if (!NILP (Vcurrent_compiled_function_annotation))
+ b->annotated = Fpurecopy (Vcurrent_compiled_function_annotation);
+ else if (!NILP (Vload_file_name_internal_the_purecopy))
+ b->annotated = Vload_file_name_internal_the_purecopy;
+ else if (!NILP (Vload_file_name_internal))
+ {
+ struct gcpro gcpro1;
+ GCPRO1(val); /* don't let val or b get reaped */
+ Vload_file_name_internal_the_purecopy =
+ Fpurecopy (Ffile_name_nondirectory (Vload_file_name_internal));
+ b->annotated = Vload_file_name_internal_the_purecopy;
+ UNGCPRO;
+ }
+#endif /* COMPILED_FUNCTION_ANNOTATION_HACK */
+
+#ifdef I18N3
+ if (docp && intp && domp)
+ b->doc_and_interactive = (((purify_flag) ? pure_cons : Fcons)
+ (doc_string,
+ (((purify_flag) ? pure_cons : Fcons)
+ (interactive, Vfile_domain))));
+ else if (docp && domp)
+ b->doc_and_interactive = (((purify_flag) ? pure_cons : Fcons)
+ (doc_string, Vfile_domain));
+ else if (intp && domp)
+ b->doc_and_interactive = (((purify_flag) ? pure_cons : Fcons)
+ (interactive, Vfile_domain));
+ else
+#endif
+ if (docp && intp)
+ b->doc_and_interactive = (((purify_flag) ? pure_cons : Fcons)
+ (doc_string, interactive));
+ else if (intp)
+ b->doc_and_interactive = interactive;
+#ifdef I18N3
+ else if (domp)
+ b->doc_and_interactive = Vfile_domain;
+#endif
+ else
+ b->doc_and_interactive = doc_string;
+
+ return val;
+ }
+}
+
+\f
+/**********************************************************************/
+/* Symbol allocation */
+/**********************************************************************/
+
+DECLARE_FIXED_TYPE_ALLOC (symbol, struct Lisp_Symbol);
+#define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_symbol 1000
+
+DEFUN ("make-symbol", Fmake_symbol, 1, 1, 0, /*
+Return a newly allocated uninterned symbol whose name is NAME.
+Its value and function definition are void, and its property list is nil.
+*/
+ (str))
+{
+ Lisp_Object val;
+ struct Lisp_Symbol *p;
+
+ CHECK_STRING (str);
+
+ ALLOCATE_FIXED_TYPE (symbol, struct Lisp_Symbol, p);
+#ifdef LRECORD_SYMBOL
+ set_lheader_implementation (&(p->lheader), lrecord_symbol);
+#endif
+ p->name = XSTRING (str);
+ p->plist = Qnil;
+ p->value = Qunbound;
+ p->function = Qunbound;
+ p->obarray = Qnil;
+ symbol_next (p) = 0;
+ XSETSYMBOL (val, p);
+ return val;
+}
+
+\f
+/**********************************************************************/
+/* Extent allocation */
+/**********************************************************************/
+
+DECLARE_FIXED_TYPE_ALLOC (extent, struct extent);
+#define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_extent 1000
+
+struct extent *
+allocate_extent (void)
+{
+ struct extent *e;
+
+ ALLOCATE_FIXED_TYPE (extent, struct extent, e);
+ /* xzero (*e); */
+ set_lheader_implementation (&(e->lheader), lrecord_extent);
+ extent_object (e) = Qnil;
+ set_extent_start (e, -1);
+ set_extent_end (e, -1);
+ e->plist = Qnil;
+
+ xzero (e->flags);
+
+ extent_face (e) = Qnil;
+ e->flags.end_open = 1; /* default is for endpoints to behave like markers */
+ e->flags.detachable = 1;
+
+ return e;
+}
+
+\f
+/**********************************************************************/
+/* Event allocation */
+/**********************************************************************/
+
+DECLARE_FIXED_TYPE_ALLOC (event, struct 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);
+
+ XSETEVENT (val, e);
+ return val;
+}
+
+\f
+/**********************************************************************/
+/* Marker allocation */
+/**********************************************************************/
+
+DECLARE_FIXED_TYPE_ALLOC (marker, struct Lisp_Marker);
+#define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_marker 1000
+
+DEFUN ("make-marker", Fmake_marker, 0, 0, 0, /*
+Return a new marker which does not point at any place.
+*/
+ ())
+{
+ Lisp_Object val;
+ struct Lisp_Marker *p;
+
+ ALLOCATE_FIXED_TYPE (marker, struct Lisp_Marker, p);
+ set_lheader_implementation (&(p->lheader), lrecord_marker);
+ p->buffer = 0;
+ p->memind = 0;
+ marker_next (p) = 0;
+ marker_prev (p) = 0;
+ p->insertion_type = 0;
+ XSETMARKER (val, p);
+ return val;
+}
+
+Lisp_Object
+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);
+ p->buffer = 0;
+ p->memind = 0;
+ marker_next (p) = 0;
+ marker_prev (p) = 0;
+ p->insertion_type = 0;
+ XSETMARKER (val, p);
+ return val;
+}
+
+\f
+/**********************************************************************/
+/* String allocation */
+/**********************************************************************/
+
+/* The data for "short" strings generally resides inside of structs of type
+ string_chars_block. The Lisp_String structure is allocated just like any
+ other Lisp object (except for vectors), and these are freelisted when
+ they get garbage collected. The data for short strings get compacted,
+ but the data for large strings do not.
+
+ Previously Lisp_String structures were relocated, but this caused a lot
+ of bus-errors because the C code didn't include enough GCPRO's for
+ strings (since EVERY REFERENCE to a short string needed to be GCPRO'd so
+ that the reference would get relocated).
+
+ This new method makes things somewhat bigger, but it is MUCH safer. */
+
+DECLARE_FIXED_TYPE_ALLOC (string, struct 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))
+{
+ struct Lisp_String *ptr = XSTRING (obj);
+
+ if (GC_CONSP (ptr->plist) && GC_EXTENT_INFOP (XCAR (ptr->plist)))
+ flush_cached_extent_info (XCAR (ptr->plist));
+ return ptr->plist;
+}
+
+static int
+string_equal (Lisp_Object o1, Lisp_Object o2, int depth)
+{
+ Bytecount len;
+ return (((len = XSTRING_LENGTH (o1)) == XSTRING_LENGTH (o2)) &&
+ !memcmp (XSTRING_DATA (o1), XSTRING_DATA (o2), 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 */
+
+/* String blocks contain this many useful bytes. */
+#define STRING_CHARS_BLOCK_SIZE \
+((Bytecount) (8192 - MALLOC_OVERHEAD - \
+ ((2 * sizeof (struct string_chars_block *)) \
+ + sizeof (EMACS_INT))))
+/* Block header for small strings. */
+struct string_chars_block
+{
+ EMACS_INT pos;
+ struct string_chars_block *next;
+ struct string_chars_block *prev;
+ /* Contents of string_chars_block->string_chars are interleaved
+ string_chars structures (see below) and the actual string data */
+ unsigned char string_chars[STRING_CHARS_BLOCK_SIZE];
+};
+
+struct string_chars_block *first_string_chars_block;
+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 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;
+ unsigned char chars[1];
+};
+
+struct unused_string_chars
+{
+ struct Lisp_String *string;
+ EMACS_INT fullsize;
+};
+
+static void
+init_string_chars_alloc (void)
+{
+ first_string_chars_block = xnew (struct string_chars_block);
+ first_string_chars_block->prev = 0;
+ first_string_chars_block->next = 0;
+ first_string_chars_block->pos = 0;
+ current_string_chars_block = first_string_chars_block;
+}
+
+static struct string_chars *
+allocate_string_chars_struct (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))
+ {
+ /* This string can fit in the current string chars block */
+ s_chars = (struct string_chars *)
+ (current_string_chars_block->string_chars
+ + current_string_chars_block->pos);
+ current_string_chars_block->pos += fullsize;
+ }
+ else
+ {
+ /* Make a new current string chars block */
+ struct string_chars_block *new = xnew (struct string_chars_block);
+
+ current_string_chars_block->next = new;
+ new->prev = current_string_chars_block;
+ new->next = 0;
+ current_string_chars_block = new;
+ new->pos = fullsize;
+ s_chars = (struct string_chars *)
+ current_string_chars_block->string_chars;
+ }
+
+ s_chars->string = string_it_goes_with;
+
+ INCREMENT_CONS_COUNTER (fullsize, "string chars");
+
+ return s_chars;
+}
+
+Lisp_Object
+make_uninit_string (Bytecount length)
+{
+ struct Lisp_String *s;
+ struct string_chars *s_chars;
+ EMACS_INT fullsize = STRING_FULLSIZE (length);
+ Lisp_Object val;
+
+ if ((length < 0) || (fullsize <= 0))
+ abort ();
+
+ /* 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]));
+ set_string_length (s, length);
+ s->plist = Qnil;
+
+ set_string_byte (s, length, 0);
+
+ XSETSTRING (val, s);
+ return val;
+}
+
+#ifdef VERIFY_STRING_CHARS_INTEGRITY
+static void verify_string_chars_integrity (void);
+#endif
+
+/* Resize the string S so that DELTA bytes can be inserted starting
+ at POS. If DELTA < 0, it means deletion starting at POS. If
+ POS < 0, resize the string but don't copy any characters. Use
+ this if you're planning on completely overwriting the string.
+*/
+
+void
+resize_string (struct Lisp_String *s, Bytecount pos, Bytecount delta)
+{
+#ifdef VERIFY_STRING_CHARS_INTEGRITY
+ verify_string_chars_integrity ();
+#endif
+
+#ifdef ERROR_CHECK_BUFPOS
+ if (pos >= 0)
+ {
+ assert (pos <= string_length (s));
+ if (delta < 0)
+ assert (pos + (-delta) <= string_length (s));
+ }
+ else
+ {
+ if (delta < 0)
+ assert ((-delta) <= string_length (s));
+ }
+#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
+ {
+ Bytecount oldfullsize = STRING_FULLSIZE (string_length (s));
+ Bytecount newfullsize = STRING_FULLSIZE (string_length (s) + delta);
+
+ if (oldfullsize == 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). */
+ if (pos >= 0)
+ {
+ Bufbyte *addroff = pos + string_data (s);
+
+ memmove (addroff + delta, addroff,
+ /* +1 due to zero-termination. */
+ string_length (s) + 1 - pos);
+ }
+ }
+ else if (BIG_STRING_FULLSIZE_P (oldfullsize) &&
+ BIG_STRING_FULLSIZE_P (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));
+ if (pos >= 0)
+ {
+ Bufbyte *addroff = pos + string_data (s);
+
+ memmove (addroff + delta, addroff,
+ /* +1 due to zero-termination. */
+ string_length (s) + 1 - pos);
+ }
+ }
+ 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);
+ if (pos >= 0)
+ {
+ memcpy (new_addr, old_addr, pos);
+ memcpy (new_addr + pos + delta, old_addr + 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_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
+ verify_string_chars_integrity ();
+#endif
+}
+
+#ifdef MULE
+
+void
+set_string_char (struct Lisp_String *s, Charcount i, Emchar c)
+{
+ Bytecount oldlen, newlen;
+ Bufbyte newstr[MAX_EMCHAR_LEN];
+ Bytecount bytoff = charcount_to_bytecount (string_data (s), i);
+
+ oldlen = charcount_to_bytecount (string_data (s) + bytoff, 1);
+ newlen = set_charptr_emchar (newstr, c);
+
+ if (oldlen != newlen)
+ resize_string (s, bytoff, newlen - oldlen);
+ /* Remember, string_data (s) might have changed so we can't cache it. */
+ memcpy (string_data (s) + bytoff, newstr, newlen);
+}
+
+#endif /* MULE */
+
+DEFUN ("make-string", Fmake_string, 2, 2, 0, /*
+Return a new string of length LENGTH, with each character being INIT.
+LENGTH must be an integer and INIT must be a character.
+*/
+ (length, init))
+{
+ Lisp_Object val;
+
+ CHECK_NATNUM (length);
+ CHECK_CHAR_COERCE_INT (init);
+ {
+ Bufbyte str[MAX_EMCHAR_LEN];
+ int len = set_charptr_emchar (str, XCHAR (init));
+
+ val = make_uninit_string (len * XINT (length));
+ if (len == 1)
+ /* Optimize the single-byte case */
+ memset (XSTRING_DATA (val), XCHAR (init), XSTRING_LENGTH (val));
+ else
+ {
+ int i, j, k;
+ Bufbyte *ptr = XSTRING_DATA (val);
+
+ k = 0;
+ for (i = 0; i < XINT (length); i++)
+ for (j = 0; j < len; j++)
+ ptr[k++] = str[j];
+ }
+ }
+ return val;
+}
+
+DEFUN ("string", Fstring, 0, MANY, 0, /*
+Concatenate all the argument characters and make the result a string.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ Bufbyte *storage = alloca_array (Bufbyte, nargs * MAX_EMCHAR_LEN);
+ Bufbyte *p = storage;
+
+ for (; nargs; nargs--, args++)
+ {
+ Lisp_Object lisp_char = *args;
+ CHECK_CHAR_COERCE_INT (lisp_char);
+ p += set_charptr_emchar (p, XCHAR (lisp_char));
+ }
+ 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)
+{
+ Lisp_Object val;
+
+ /* Make sure we find out about bad make_string's when they happen */
+#if defined (ERROR_CHECK_BUFPOS) && defined (MULE)
+ bytecount_to_charcount (contents, length); /* Just for the assertions */
+#endif
+
+ val = make_uninit_string (length);
+ memcpy (XSTRING_DATA (val), contents, length);
+ return val;
+}
+
+/* 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)
+{
+ Bufbyte *intstr;
+ Bytecount intlen;
+
+ GET_CHARPTR_INT_DATA_ALLOCA (contents, length, fmt, intstr, intlen);
+ return make_string (intstr, intlen);
+}
+
+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, enum external_data_format fmt)
+{
+ /* 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));
+}
+
+\f
+/************************************************************************/
+/* lcrecord lists */
+/************************************************************************/
+
+/* Lcrecord lists are used to manage the allocation of particular
+ sorts of lcrecords, to avoid calling alloc_lcrecord() (and thus
+ malloc() and garbage-collection junk) as much as possible.
+ It is similar to the Blocktype class.
+
+ It works like this:
+
+ 1) Create an lcrecord-list object using make_lcrecord_list().
+ This is often done at initialization. Remember to staticpro
+ 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()
+ and pass the lcrecord-list earlier created.
+ 3) When done with the lcrecord, call free_managed_lcrecord().
+ The standard freeing caveats apply: ** make sure there are no
+ pointers to the object anywhere! **
+ 4) Calling free_managed_lcrecord() is just like kissing the
+ lcrecord goodbye as if it were garbage-collected. This means:
+ -- the contents of the freed lcrecord are undefined, and the
+ contents of something produced by allocate_managed_lcrecord()
+ are undefined, just like for alloc_lcrecord().
+ -- the mark method for the lcrecord's type will *NEVER* be called
+ on freed lcrecords.
+ -- the finalize method for the lcrecord's type will be called
+ at the time that free_managed_lcrecord() is called.
+
+ */
+
+static Lisp_Object
+mark_lcrecord_list (Lisp_Object obj, void (*markobj) (Lisp_Object))
+{
+ struct lcrecord_list *list = XLCRECORD_LIST (obj);
+ Lisp_Object chain = list->free;
+
+ while (!NILP (chain))
+ {
+ struct lrecord_header *lheader = XRECORD_LHEADER (chain);
+ struct free_lcrecord_header *free_header =
+ (struct free_lcrecord_header *) lheader;
+
+#ifdef ERROR_CHECK_GC
+ CONST struct lrecord_implementation *implementation
+ = LHEADER_IMPLEMENTATION(lheader);
+
+ /* There should be no other pointers to the free list. */
+ assert (!MARKED_RECORD_HEADER_P (lheader));
+ /* Only lcrecords should be here. */
+ assert (!implementation->basic_p);
+ /* Only free lcrecords should be here. */
+ assert (free_header->lcheader.free);
+ /* The type of the lcrecord must be right. */
+ assert (implementation == list->implementation);
+ /* So must the size. */
+ assert (implementation->static_size == 0
+ || implementation->static_size == list->size);
+#endif /* ERROR_CHECK_GC */
+
+ MARK_RECORD_HEADER (lheader);
+ chain = free_header->chain;
+ }
+
+ return Qnil;
+}
+
+DEFINE_LRECORD_IMPLEMENTATION ("lcrecord-list", lcrecord_list,
+ mark_lcrecord_list, internal_object_printer,
+ 0, 0, 0, struct lcrecord_list);
+Lisp_Object
+make_lcrecord_list (size_t size,
+ CONST struct lrecord_implementation *implementation)
+{
+ struct lcrecord_list *p = alloc_lcrecord_type (struct lcrecord_list,
+ lrecord_lcrecord_list);
+ Lisp_Object val;
+
+ p->implementation = implementation;
+ p->size = size;
+ p->free = Qnil;
+ XSETLCRECORD_LIST (val, p);
+ return val;
+}
+
+Lisp_Object
+allocate_managed_lcrecord (Lisp_Object lcrecord_list)
+{
+ struct lcrecord_list *list = XLCRECORD_LIST (lcrecord_list);
+ if (!NILP (list->free))
+ {
+ Lisp_Object val = list->free;
+ struct free_lcrecord_header *free_header =
+ (struct free_lcrecord_header *) XPNTR (val);
+
+#ifdef ERROR_CHECK_GC
+ struct lrecord_header *lheader =
+ (struct lrecord_header *) free_header;
+ CONST struct lrecord_implementation *implementation
+ = LHEADER_IMPLEMENTATION (lheader);
+
+ /* There should be no other pointers to the free list. */
+ assert (!MARKED_RECORD_HEADER_P (lheader));
+ /* Only lcrecords should be here. */
+ assert (!implementation->basic_p);
+ /* Only free lcrecords should be here. */
+ assert (free_header->lcheader.free);
+ /* The type of the lcrecord must be right. */
+ assert (implementation == list->implementation);
+ /* So must the size. */
+ assert (implementation->static_size == 0
+ || implementation->static_size == list->size);
+#endif /* ERROR_CHECK_GC */
+ list->free = free_header->chain;
+ free_header->lcheader.free = 0;
+ return val;
+ }
+ else
+ {
+ Lisp_Object val;
+
+ XSETOBJ (val, Lisp_Type_Record,
+ alloc_lcrecord (list->size, list->implementation));
+ return val;
+ }
+}
+
+void
+free_managed_lcrecord (Lisp_Object lcrecord_list, Lisp_Object lcrecord)
+{
+ struct lcrecord_list *list = XLCRECORD_LIST (lcrecord_list);
+ struct free_lcrecord_header *free_header =
+ (struct free_lcrecord_header *) XPNTR (lcrecord);
+ struct lrecord_header *lheader =
+ (struct lrecord_header *) free_header;
+ CONST struct lrecord_implementation *implementation
+ = LHEADER_IMPLEMENTATION (lheader);
+
+#ifdef ERROR_CHECK_GC
+ /* Make sure the size is correct. This will catch, for example,
+ putting a window configuration on the wrong free list. */
+ if (implementation->size_in_bytes_method)
+ assert (((implementation->size_in_bytes_method) (lheader))
+ == list->size);
+ else
+ assert (implementation->static_size == list->size);
+#endif /* ERROR_CHECK_GC */
+
+ if (implementation->finalizer)
+ ((implementation->finalizer) (lheader, 0));
+ free_header->chain = list->free;
+ free_header->lcheader.free = 1;
+ list->free = lcrecord;
+}
+
+\f
+/**********************************************************************/
+/* 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_Object new;
+ struct Lisp_String *s;
+ size_t size = sizeof (struct 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 ();
+ XSETSTRING (new, s);
+ return new;
+ }
+ }
+
+ if (!check_purespace (size))
+ return make_string (data, length);
+
+ s = (struct 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 (struct 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_for_bytecode)
+ bump_purestat (&purestat_string_other_function, size);
+#endif /* PURESTAT */
+
+ /* Do this after the official "completion" of the purecopying. */
+ s->plist = Fpurecopy (plist);
+
+ XSETSTRING (new, s);
+ return new;
+}
+
+
+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_Object new;
+ struct Lisp_Cons *c;
+
+ if (!check_purespace (sizeof (struct Lisp_Cons)))
+ return Fcons (Fpurecopy (car), Fpurecopy (cdr));
+
+ c = (struct 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 (struct Lisp_Cons);
+ bump_purestat (&purestat_cons, sizeof (struct Lisp_Cons));
+
+ c->car = Fpurecopy (car);
+ c->cdr = Fpurecopy (cdr);
+ XSETCONS (new, c);
+ return new;
+}
+
+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_Object new;
+ struct Lisp_Vector *v;
+ size_t size = (sizeof (struct Lisp_Vector)
+ + (len - 1) * sizeof (Lisp_Object));
+
+ init = Fpurecopy (init);
+
+ if (!check_purespace (size))
+ return make_vector (len, init);
+
+ v = (struct 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;
+
+ XSETVECTOR (new, v);
+ return new;
+}
+
+#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 */
+
+
+\f
+DEFUN ("purecopy", Fpurecopy, 1, 1, 0, /*
+Make a copy of OBJECT in pure storage.
+Recursively copies contents of vectors and cons cells.
+Does not copy symbols.
+*/
+ (obj))
+{
+ int i;
+ if (!purify_flag)
+ return obj;
+
+ if (!POINTER_TYPE_P (XTYPE (obj))
+ || PURIFIED (XPNTR (obj))
+ /* happens when bootstrapping Qnil */
+ || EQ (obj, Qnull_pointer))
+ return obj;
+
+ switch (XTYPE (obj))
+ {
+#ifndef LRECORD_CONS
+ case Lisp_Type_Cons:
+ return pure_cons (XCAR (obj), XCDR (obj));
+#endif
+
+#ifndef LRECORD_STRING
+ case Lisp_Type_String:
+ return make_pure_string (XSTRING_DATA (obj),
+ XSTRING_LENGTH (obj),
+ XSTRING (obj)->plist,
+ 0);
+#endif /* ! LRECORD_STRING */
+
+#ifndef LRECORD_VECTOR
+ case Lisp_Type_Vector:
+ {
+ struct Lisp_Vector *o = XVECTOR (obj);
+ Lisp_Object new = make_pure_vector (vector_length (o), Qnil);
+ for (i = 0; i < vector_length (o); i++)
+ XVECTOR_DATA (new)[i] = Fpurecopy (o->contents[i]);
+ return new;
+ }
+#endif /* !LRECORD_VECTOR */
+
+ default:
+ {
+ if (COMPILED_FUNCTIONP (obj))
+ {
+ struct Lisp_Compiled_Function *o = XCOMPILED_FUNCTION (obj);
+ Lisp_Object new = make_compiled_function (1);
+ /* How on earth could this code have worked before? -sb */
+ struct Lisp_Compiled_Function *n = XCOMPILED_FUNCTION (new);
+ n->flags = o->flags;
+ n->bytecodes = Fpurecopy (o->bytecodes);
+ n->constants = Fpurecopy (o->constants);
+ n->arglist = Fpurecopy (o->arglist);
+ n->doc_and_interactive = Fpurecopy (o->doc_and_interactive);
+ n->maxdepth = o->maxdepth;
+ return new;
+ }
+#ifdef LRECORD_CONS
+ else if (CONSP (obj))
+ return pure_cons (XCAR (obj), XCDR (obj));
+#endif /* LRECORD_CONS */
+#ifdef LRECORD_VECTOR
+ else if (VECTORP (obj))
+ {
+ struct Lisp_Vector *o = XVECTOR (obj);
+ Lisp_Object new = make_pure_vector (vector_length (o), Qnil);
+ for (i = 0; i < vector_length (o); i++)
+ XVECTOR_DATA (new)[i] = Fpurecopy (o->contents[i]);
+ return new;
+ }
+#endif /* LRECORD_VECTOR */
+#ifdef LRECORD_STRING
+ else if (STRINGP (obj))
+ {
+ return make_pure_string (XSTRING_DATA (obj),
+ XSTRING_LENGTH (obj),
+ XSTRING (obj)->plist,
+ 0);
+ }
+#endif /* LRECORD_STRING */
+#ifdef LISP_FLOAT_TYPE
+ else if (FLOATP (obj))
+ return make_pure_float (float_data (XFLOAT (obj)));
+#endif /* LISP_FLOAT_TYPE */
+ 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 hashtable pointed to by
+ * Vpure_uninterned_symbol_table, which is itself
+ * staticpro'd.
+ */
+ if (!NILP (XSYMBOL (obj)->obarray))
+ return obj;
+ Fputhash (obj, Qnil, Vpure_uninterned_symbol_table);
+ return obj;
+ }
+ else
+ signal_simple_error ("Can't purecopy %S", obj);
+ }
+ }
+ return obj;
+}
+
+
+\f
+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);
+}
+
+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_bytecode_constants.nbytes;
+ purestat_vector_other.nobjects =
+ purestat_vector_all.nobjects -
+ purestat_vector_bytecode_constants.nobjects;
+
+ purestat_string_other.nbytes =
+ purestat_string_all.nbytes -
+ (purestat_string_pname.nbytes +
+ purestat_string_bytecodes.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_bytecodes.nobjects +
+ purestat_string_interactive.nobjects +
+ purestat_string_documentation.nobjects +
+#ifdef I18N3
+ purestat_string_domain.nobjects +
+#endif
+ purestat_string_other_function.nobjects);
+
+ message (" %-26s Total Bytes", "");
+
+ {
+ int j;
+
+ for (j = 0; j < countof (purestats); j++)
+ if (!purestats[j])
+ clear_message ();
+ else
+ {
+ char buf [100];
+ sprintf(buf, "%s:", purestats[j]->name);
+ message (" %-26s %5d %7d %2d%%",
+ buf,
+ purestats[j]->nobjects,
+ purestats[j]->nbytes,
+ (int) (purestats[j]->nbytes / (pure_bytes_used / 100.0) + 0.5));
+ }
+ }
+#endif /* PURESTAT */
+
+
+ if (report_impurities)
+ {
+ Lisp_Object tem = Felt (Fgarbage_collect (), make_int (5));
+ struct gcpro gcpro1;
+ GCPRO1 (tem);
+ message ("\nImpurities:");
+ while (!NILP (tem))
+ {
+ if (CONSP (tem) && SYMBOLP (Fcar (tem)) && CONSP (Fcdr (tem)))
+ {
+ int total = XINT (Fcar (Fcdr (tem)));
+ if (total > 0)
+ {
+ char buf [100];
+ char *s = buf;
+ memcpy (buf, string_data (XSYMBOL (Fcar (tem))->name),
+ string_length (XSYMBOL (Fcar (tem))->name) + 1);
+ while (*s++) if (*s == '-') *s = ' ';
+ s--; *s++ = ':'; *s = 0;
+ message (" %-33s %6d", buf, total);
+ }
+ tem = Fcdr (Fcdr (tem));
+ }
+ else /* WTF?! */
+ {
+ Fprin1 (tem, Qexternal_debugging_output);
+ tem = Qnil;
+ }
+ }
+ UNGCPRO;
+ garbage_collect_1 (); /* GC garbage_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");
+ }
+}
+
+\f
+/**********************************************************************/
+/* staticpro */
+/**********************************************************************/
+
+struct gcpro *gcprolist;
+
+/* 415 used Mly 29-Jun-93 */
+/* 1327 used slb 28-Feb-98 */
+#ifdef HAVE_SHLIB
+#define NSTATICS 4000
+#else
+#define NSTATICS 2000
+#endif
+/* Not "static" because of linker lossage on some systems */
+Lisp_Object *staticvec[NSTATICS]
+ /* Force it into data space! */
+ = {0};
+static int staticidx;
+
+/* Put an entry in staticvec, pointing at the variable whose address is given
+ */
+void
+staticpro (Lisp_Object *varaddress)
+{
+ if (staticidx >= countof (staticvec))
+ /* #### This is now a dubious abort() since this routine may be called */
+ /* by Lisp attempting to load a DLL. */
+ abort ();
+ staticvec[staticidx++] = varaddress;
+}
+
+\f
+/* 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
+mark_object (Lisp_Object obj)
+{
+ tail_recurse:
+
+ if (EQ (obj, Qnull_pointer))
+ return;
+ if (!POINTER_TYPE_P (XGCTYPE (obj)))
+ return;
+ if (PURIFIED (XPNTR (obj)))
+ return;
+ switch (XGCTYPE (obj))
+ {
+#ifndef LRECORD_CONS
+ case Lisp_Type_Cons:
+ {
+ struct Lisp_Cons *ptr = XCONS (obj);
+ if (CONS_MARKED_P (ptr))
+ break;
+ MARK_CONS (ptr);
+ /* If the cdr is nil, tail-recurse on the car. */
+ if (NILP (ptr->cdr))
+ {
+ obj = ptr->car;
+ }
+ else
+ {
+ mark_object (ptr->car);
+ obj = ptr->cdr;
+ }
+ goto tail_recurse;
+ }
+#endif
+
+ case Lisp_Type_Record:
+ /* case Lisp_Symbol_Value_Magic: */
+ {
+ struct lrecord_header *lheader = XRECORD_LHEADER (obj);
+ CONST struct lrecord_implementation *implementation
+ = LHEADER_IMPLEMENTATION (lheader);
+
+ if (! MARKED_RECORD_HEADER_P (lheader) &&
+ ! UNMARKABLE_RECORD_HEADER_P (lheader))
+ {
+ MARK_RECORD_HEADER (lheader);
+#ifdef ERROR_CHECK_GC
+ if (!implementation->basic_p)
+ assert (! ((struct lcrecord_header *) lheader)->free);
+#endif
+ if (implementation->marker != 0)
+ {
+ obj = ((implementation->marker) (obj, mark_object));
+ if (!NILP (obj)) goto tail_recurse;
+ }
+ }
+ }
+ break;
+
+#ifndef LRECORD_STRING
+ case Lisp_Type_String:
+ {
+ struct Lisp_String *ptr = XSTRING (obj);
+
+ 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 = vector_length (ptr);
+ int i;
+
+ 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);
+
+ while (!XMARKBIT (sym->plist))
+ {
+ XMARK (sym->plist);
+ mark_object (sym->value);
+ mark_object (sym->function);
+ {
+ /*
+ * 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);
+ }
+ 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 */
+
+ default:
+ abort ();
+ }
+}
+
+/* mark all of the conses in a list and mark the final cdr; but
+ DO NOT mark the cars.
+
+ Use only for internal lists! There should never be other pointers
+ to the cons cells, because if so, the cars will remain unmarked
+ even when they maybe should be marked. */
+void
+mark_conses_in_list (Lisp_Object obj)
+{
+ Lisp_Object rest;
+
+ for (rest = obj; CONSP (rest); rest = XCDR (rest))
+ {
+ if (CONS_MARKED_P (XCONS (rest)))
+ return;
+ MARK_CONS (XCONS (rest));
+ }
+
+ mark_object (rest);
+}
+
+\f
+#ifdef PURESTAT
+/* Simpler than mark-object, because pure structure can't
+ have any circularities */
+
+#if 0 /* unused */
+static int idiot_c_doesnt_have_closures;
+static void
+idiot_c (Lisp_Object obj)
+{
+ idiot_c_doesnt_have_closures += pure_sizeof (obj, 1);
+}
+#endif /* unused */
+
+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;
+ }
+}
+
+/* recurse arg isn't actually used */
+static size_t
+pure_sizeof (Lisp_Object obj /*, int recurse */)
+{
+ size_t total = 0;
+
+ /*tail_recurse: */
+ if (!POINTER_TYPE_P (XTYPE (obj))
+ || !PURIFIED (XPNTR (obj)))
+ return total;
+
+ /* symbol's sizes are accounted for separately */
+ if (SYMBOLP (obj))
+ return total;
+
+ switch (XTYPE (obj))
+ {
+
+#ifndef LRECORD_STRING
+ case Lisp_Type_String:
+ total += pure_string_sizeof (obj);
+ break;
+#endif /* ! LRECORD_STRING */
+
+#ifndef LRECORD_VECTOR
+ case Lisp_Type_Vector:
+ {
+ struct Lisp_Vector *ptr = XVECTOR (obj);
+ int len = vector_length (ptr);
+
+ total += (sizeof (struct Lisp_Vector)
+ + (len - 1) * sizeof (Lisp_Object));
+#if 0 /* unused */
+ if (!recurse)
+ break;
+ {
+ int i;
+ for (i = 0; i < len - 1; i++)
+ total += pure_sizeof (ptr->contents[i], 1);
+ }
+ if (len > 0)
+ {
+ obj = ptr->contents[len - 1];
+ goto tail_recurse;
+ }
+#endif /* unused */
+ }
+ break;
+#endif /* !LRECORD_VECTOR */
+
+ case Lisp_Type_Record:
+ {
+ struct lrecord_header *lheader = XRECORD_LHEADER (obj);
+ CONST struct lrecord_implementation *implementation
+ = LHEADER_IMPLEMENTATION (lheader);
+
+#ifdef LRECORD_STRING
+ if (STRINGP (obj))
+ total += pure_string_sizeof (obj);
+ else
+#endif
+ if (implementation->size_in_bytes_method)
+ total += ((implementation->size_in_bytes_method) (lheader));
+ else
+ total += implementation->static_size;
+
+#if 0 /* unused */
+ if (!recurse)
+ break;
+
+ if (implementation->marker != 0)
+ {
+ int old = idiot_c_doesnt_have_closures;
+
+ idiot_c_doesnt_have_closures = 0;
+ obj = ((implementation->marker) (obj, idiot_c));
+ total += idiot_c_doesnt_have_closures;
+ idiot_c_doesnt_have_closures = old;
+
+ if (!NILP (obj)) goto tail_recurse;
+ }
+#endif /* unused */
+ }
+ break;
+
+#ifndef LRECORD_CONS
+ case Lisp_Type_Cons:
+ {
+ struct Lisp_Cons *ptr = XCONS (obj);
+ total += sizeof (*ptr);
+#if 0 /* unused */
+ if (!recurse)
+ break;
+ /* If the cdr is nil, tail-recurse on the car. */
+ if (NILP (ptr->cdr))
+ {
+ obj = ptr->car;
+ }
+ else
+ {
+ total += pure_sizeof (ptr->car, 1);
+ obj = ptr->cdr;
+ }
+ goto tail_recurse;
+#endif /* unused */
+ }
+ break;
+#endif
+
+ /* Others can't be purified */
+ default:
+ abort ();
+ }
+ return total;
+}
+#endif /* PURESTAT */
+
+
+
+\f
+/* 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;
+static int gc_count_string_total_size;
+static int gc_count_short_string_total_size;
+
+/* static int gc_count_total_records_used, gc_count_records_total_size; */
+
+\f
+/* This will be used more extensively In The Future */
+static int last_lrecord_type_index_assigned;
+
+CONST struct lrecord_implementation *lrecord_implementations_table[128];
+#define max_lrecord_type (countof (lrecord_implementations_table) - 1)
+
+int
+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
+ dumping out initialized variables (ie can't set xxx_type_index to -1
+ because that would make xxx_type_index read-only in a dumped emacs. */
+ if (type_index < 0 || type_index > max_lrecord_type
+ || lrecord_implementations_table[type_index] != implementation)
+ {
+ if (last_lrecord_type_index_assigned == max_lrecord_type)
+ abort ();
+ type_index = ++last_lrecord_type_index_assigned;
+ lrecord_implementations_table[type_index] = implementation;
+ *(implementation->lrecord_type_index) = type_index;
+ }
+ return type_index;
+}
+
+/* stats on lcrecords in use - kinda kludgy */
+
+static struct
+{
+ int instances_in_use;
+ int bytes_in_use;
+ int instances_freed;
+ int bytes_freed;
+ int instances_on_free_list;
+} lcrecord_stats [countof (lrecord_implementations_table)];
+
+
+static void
+reset_lcrecord_stats (void)
+{
+ int i;
+ for (i = 0; i < countof (lcrecord_stats); i++)
+ {
+ lcrecord_stats[i].instances_in_use = 0;
+ lcrecord_stats[i].bytes_in_use = 0;
+ lcrecord_stats[i].instances_freed = 0;
+ lcrecord_stats[i].bytes_freed = 0;
+ lcrecord_stats[i].instances_on_free_list = 0;
+ }
+}
+
+static void
+tick_lcrecord_stats (CONST struct lrecord_header *h, int free_p)
+{
+ CONST struct lrecord_implementation *implementation =
+ LHEADER_IMPLEMENTATION (h);
+ int type_index = lrecord_type_index (implementation);
+
+ if (((struct lcrecord_header *) h)->free)
+ {
+ assert (!free_p);
+ lcrecord_stats[type_index].instances_on_free_list++;
+ }
+ else
+ {
+ size_t sz = (implementation->size_in_bytes_method
+ ? ((implementation->size_in_bytes_method) (h))
+ : implementation->static_size);
+
+ if (free_p)
+ {
+ lcrecord_stats[type_index].instances_freed++;
+ lcrecord_stats[type_index].bytes_freed += sz;
+ }
+ else
+ {
+ lcrecord_stats[type_index].instances_in_use++;
+ lcrecord_stats[type_index].bytes_in_use += sz;
+ }
+ }
+}
+
+\f
+/* Free all unmarked records */
+static void
+sweep_lcrecords_1 (struct lcrecord_header **prev, int *used)
+{
+ struct lcrecord_header *header;
+ int num_used = 0;
+ /* int total_size = 0; */
+ reset_lcrecord_stats ();
+
+ /* First go through and call all the finalize methods.
+ Then go through and free the objects. There used to
+ be only one loop here, with the call to the finalizer
+ occurring directly before the xfree() below. That
+ is marginally faster but much less safe -- if the
+ finalize method for an object needs to reference any
+ other objects contained within it (and many do),
+ we could easily be screwed by having already freed that
+ other object. */
+
+ for (header = *prev; header; header = header->next)
+ {
+ struct lrecord_header *h = &(header->lheader);
+ if (!MARKED_RECORD_HEADER_P (h) && ! (header->free))
+ {
+ if (LHEADER_IMPLEMENTATION (h)->finalizer)
+ ((LHEADER_IMPLEMENTATION (h)->finalizer) (h, 0));
+ }
+ }
+
+ for (header = *prev; header; )
+ {
+ struct lrecord_header *h = &(header->lheader);
+ if (MARKED_RECORD_HEADER_P (h))
+ {
+ UNMARK_RECORD_HEADER (h);
+ num_used++;
+ /* total_size += ((n->implementation->size_in_bytes) (h));*/
+ prev = &(header->next);
+ header = *prev;
+ tick_lcrecord_stats (h, 0);
+ }
+ else
+ {
+ struct lcrecord_header *next = header->next;
+ *prev = next;
+ tick_lcrecord_stats (h, 1);
+ /* used to call finalizer right here. */
+ xfree (header);
+ header = next;
+ }
+ }
+ *used = num_used;
+ /* *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); )
+ {
+ struct 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
+ + sizeof (struct Lisp_Vector)
+ + (len - 1 + 1) * sizeof (Lisp_Object));
+ 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,
+ int *used, int *total, int *storage)
+{
+ Lisp_Object bit_vector;
+ int num_used = 0;
+ int total_size = 0;
+ int total_storage = 0;
+
+ /* BIT_VECTORP fails because the objects are marked, which changes
+ their implementation */
+ for (bit_vector = *prev; !EQ (bit_vector, Qzero); )
+ {
+ struct Lisp_Bit_Vector *v = XBIT_VECTOR (bit_vector);
+ int len = v->size;
+ if (MARKED_RECORD_P (bit_vector))
+ {
+ UNMARK_RECORD_HEADER (&(v->lheader));
+ total_size += len;
+ total_storage += (MALLOC_OVERHEAD
+ + sizeof (struct Lisp_Bit_Vector)
+ + (BIT_VECTOR_LONG_STORAGE (len) - 1)
+ * sizeof (long));
+ num_used++;
+ prev = &(bit_vector_next (v));
+ bit_vector = *prev;
+ }
+ else
+ {
+ Lisp_Object next = bit_vector_next (v);
+ *prev = next;
+ xfree (v);
+ bit_vector = next;
+ }
+ }
+ *used = num_used;
+ *total = total_size;
+ *storage = total_storage;
+}
+
+/* And the Lord said: Thou shalt use the `c-backslash-region' command
+ to make macros prettier. */
+
+#ifdef ERROR_CHECK_GC
+
+#define SWEEP_FIXED_TYPE_BLOCK(typename, obj_type) \
+do { \
+ struct typename##_block *_frob_current; \
+ struct typename##_block **_frob_prev; \
+ int _frob_limit; \
+ int num_free = 0, num_used = 0; \
+ \
+ for (_frob_prev = ¤t_##typename##_block, \
+ _frob_current = current_##typename##_block, \
+ _frob_limit = current_##typename##_block_index; \
+ _frob_current; \
+ ) \
+ { \
+ int _frob_iii; \
+ \
+ for (_frob_iii = 0; _frob_iii < _frob_limit; _frob_iii++) \
+ { \
+ obj_type *_frob_victim = &(_frob_current->block[_frob_iii]); \
+ \
+ if (FREE_STRUCT_P (_frob_victim)) \
+ { \
+ num_free++; \
+ } \
+ else if (!MARKED_##typename##_P (_frob_victim)) \
+ { \
+ num_free++; \
+ FREE_FIXED_TYPE (typename, obj_type, _frob_victim); \
+ } \
+ else \
+ { \
+ num_used++; \
+ UNMARK_##typename (_frob_victim); \
+ } \
+ } \
+ _frob_prev = &(_frob_current->prev); \
+ _frob_current = _frob_current->prev; \
+ _frob_limit = countof (current_##typename##_block->block); \
+ } \
+ \
+ gc_count_num_##typename##_in_use = num_used; \
+ gc_count_num_##typename##_freelist = num_free; \
+} while (0)
+
+#else /* !ERROR_CHECK_GC */
+
+#define SWEEP_FIXED_TYPE_BLOCK(typename, obj_type) \
+do { \
+ struct typename##_block *_frob_current; \
+ struct typename##_block **_frob_prev; \
+ int _frob_limit; \
+ int num_free = 0, num_used = 0; \
+ \
+ typename##_free_list = 0; \
+ \
+ for (_frob_prev = ¤t_##typename##_block, \
+ _frob_current = current_##typename##_block, \
+ _frob_limit = current_##typename##_block_index; \
+ _frob_current; \
+ ) \
+ { \
+ int _frob_iii; \
+ int _frob_empty = 1; \
+ obj_type *_frob_old_free_list = typename##_free_list; \
+ \
+ for (_frob_iii = 0; _frob_iii < _frob_limit; _frob_iii++) \
+ { \
+ obj_type *_frob_victim = &(_frob_current->block[_frob_iii]); \
+ \
+ if (FREE_STRUCT_P (_frob_victim)) \
+ { \
+ num_free++; \
+ PUT_FIXED_TYPE_ON_FREE_LIST (typename, obj_type, _frob_victim); \
+ } \
+ else if (!MARKED_##typename##_P (_frob_victim)) \
+ { \
+ num_free++; \
+ FREE_FIXED_TYPE (typename, obj_type, _frob_victim); \
+ } \
+ else \
+ { \
+ _frob_empty = 0; \
+ num_used++; \
+ UNMARK_##typename (_frob_victim); \
+ } \
+ } \
+ if (!_frob_empty) \
+ { \
+ _frob_prev = &(_frob_current->prev); \
+ _frob_current = _frob_current->prev; \
+ } \
+ else if (_frob_current == current_##typename##_block \
+ && !_frob_current->prev) \
+ { \
+ /* No real point in freeing sole allocation block */ \
+ break; \
+ } \
+ else \
+ { \
+ struct typename##_block *_frob_victim_block = _frob_current; \
+ if (_frob_victim_block == current_##typename##_block) \
+ current_##typename##_block_index \
+ = countof (current_##typename##_block->block); \
+ _frob_current = _frob_current->prev; \
+ { \
+ *_frob_prev = _frob_current; \
+ xfree (_frob_victim_block); \
+ /* Restore free list to what it was before victim was swept */ \
+ typename##_free_list = _frob_old_free_list; \
+ num_free -= _frob_limit; \
+ } \
+ } \
+ _frob_limit = countof (current_##typename##_block->block); \
+ } \
+ \
+ gc_count_num_##typename##_in_use = num_used; \
+ gc_count_num_##typename##_freelist = num_free; \
+} while (0)
+
+#endif /* !ERROR_CHECK_GC */
+
+\f
+
+
+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 ADDITIONAL_FREE_cons(ptr)
+
+ SWEEP_FIXED_TYPE_BLOCK (cons, struct Lisp_Cons);
+}
+
+/* Explicitly free a cons cell. */
+void
+free_cons (struct Lisp_Cons *ptr)
+{
+#ifdef ERROR_CHECK_GC
+ /* If the CAR is not an int, then it will be a pointer, which will
+ always be four-byte aligned. If this cons cell has already been
+ placed on the free list, however, its car will probably contain
+ a chain pointer to the next cons on the list, which has cleverly
+ had all its 0's and 1's inverted. This allows for a quick
+ check to make sure we're not freeing something already freed. */
+ if (POINTER_TYPE_P (XTYPE (ptr->car)))
+ ASSERT_VALID_POINTER (XPNTR (ptr->car));
+#endif /* ERROR_CHECK_GC */
+
+#ifndef ALLOC_NO_POOLS
+ FREE_FIXED_TYPE_WHEN_NOT_IN_GC (cons, struct Lisp_Cons, ptr);
+#endif /* ALLOC_NO_POOLS */
+}
+
+/* explicitly free a list. You **must make sure** that you have
+ created all the cons cells that make up this list and that there
+ are no pointers to any of these cons cells anywhere else. If there
+ are, you will lose. */
+
+void
+free_list (Lisp_Object list)
+{
+ Lisp_Object rest, next;
+
+ for (rest = list; !NILP (rest); rest = next)
+ {
+ next = XCDR (rest);
+ free_cons (XCONS (rest));
+ }
+}
+
+/* explicitly free an alist. You **must make sure** that you have
+ created all the cons cells that make up this alist and that there
+ are no pointers to any of these cons cells anywhere else. If there
+ are, you will lose. */
+
+void
+free_alist (Lisp_Object alist)
+{
+ Lisp_Object rest, next;
+
+ for (rest = alist; !NILP (rest); rest = next)
+ {
+ next = XCDR (rest);
+ free_cons (XCONS (XCAR (rest)));
+ free_cons (XCONS (rest));
+ }
+}
+
+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)
+
+ SWEEP_FIXED_TYPE_BLOCK (compiled_function, struct Lisp_Compiled_Function);
+}
+
+
+#ifdef LISP_FLOAT_TYPE
+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);
+}
+#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 ADDITIONAL_FREE_symbol(ptr)
+
+ SWEEP_FIXED_TYPE_BLOCK (symbol, struct 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)
+
+ SWEEP_FIXED_TYPE_BLOCK (extent, struct extent);
+}
+
+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);
+}
+
+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; \
+ XSETMARKER (tem, ptr); \
+ unchain_marker (tem); \
+ } while (0)
+
+ SWEEP_FIXED_TYPE_BLOCK (marker, struct Lisp_Marker);
+}
+
+/* Explicitly free a marker. */
+void
+free_marker (struct 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));
+#endif /* ERROR_CHECK_GC */
+
+#ifndef ALLOC_NO_POOLS
+ FREE_FIXED_TYPE_WHEN_NOT_IN_GC (marker, struct Lisp_Marker, ptr);
+#endif /* ALLOC_NO_POOLS */
+}
+\f
+
+#if defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY)
+
+static void
+verify_string_chars_integrity (void)
+{
+ struct string_chars_block *sb;
+
+ /* Scan each existing string block sequentially, string by string. */
+ for (sb = first_string_chars_block; sb; sb = sb->next)
+ {
+ int pos = 0;
+ /* POS is the index of the next string in the block. */
+ while (pos < sb->pos)
+ {
+ struct string_chars *s_chars =
+ (struct string_chars *) &(sb->string_chars[pos]);
+ struct Lisp_String *string;
+ int size;
+ int fullsize;
+
+ /* If the string_chars struct is marked as free (i.e. the STRING
+ pointer is 0xFFFFFFFF) then this is an unused chunk of string
+ storage. (See below.) */
+
+ if (FREE_STRUCT_P (s_chars))
+ {
+ fullsize = ((struct unused_string_chars *) s_chars)->fullsize;
+ pos += fullsize;
+ continue;
+ }
+
+ string = s_chars->string;
+ /* Must be 32-bit aligned. */
+ assert ((((int) string) & 3) == 0);
+
+ size = string_length (string);
+ fullsize = STRING_FULLSIZE (size);
+
+ assert (!BIG_STRING_FULLSIZE_P (fullsize));
+ assert (string_data (string) == s_chars->chars);
+ pos += fullsize;
+ }
+ assert (pos == sb->pos);
+ }
+}
+
+#endif /* MULE && ERROR_CHECK_GC */
+
+/* Compactify string chars, relocating the reference to each --
+ free any empty string_chars_block we see. */
+static void
+compact_string_chars (void)
+{
+ struct string_chars_block *to_sb = first_string_chars_block;
+ int to_pos = 0;
+ struct string_chars_block *from_sb;
+
+ /* Scan each existing string block sequentially, string by string. */
+ for (from_sb = first_string_chars_block; from_sb; from_sb = from_sb->next)
+ {
+ int from_pos = 0;
+ /* FROM_POS is the index of the next string in the block. */
+ while (from_pos < from_sb->pos)
+ {
+ 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;
+ int size;
+ int fullsize;
+
+ /* If the string_chars struct is marked as free (i.e. the STRING
+ pointer is 0xFFFFFFFF) then this is an unused chunk of string
+ storage. This happens under Mule when a string's size changes
+ in such a way that its fullsize changes. (Strings can change
+ size because a different-length character can be substituted
+ for another character.) In this case, after the bogus string
+ pointer is the "fullsize" of this entry, i.e. how many bytes
+ to skip. */
+
+ if (FREE_STRUCT_P (from_s_chars))
+ {
+ fullsize = ((struct unused_string_chars *) from_s_chars)->fullsize;
+ from_pos += fullsize;
+ continue;
+ }
+
+ string = from_s_chars->string;
+ assert (!(FREE_STRUCT_P (string)));
+
+ size = string_length (string);
+ fullsize = STRING_FULLSIZE (size);
+
+ if (BIG_STRING_FULLSIZE_P (fullsize))
+ 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;
+ }
+
+ /* If it won't fit in what's left of TO_SB, close TO_SB out
+ and go on to the next string_chars_block. We know that TO_SB
+ cannot advance past FROM_SB here since FROM_SB is large enough
+ to currently contain this string. */
+ if ((to_pos + fullsize) > countof (to_sb->string_chars))
+ {
+ to_sb->pos = to_pos;
+ to_sb = to_sb->next;
+ to_pos = 0;
+ }
+
+ /* Compute new address of this string
+ and update TO_POS for the space being used. */
+ to_s_chars = (struct string_chars *) &(to_sb->string_chars[to_pos]);
+
+ /* Copy the string_chars to the new place. */
+ if (from_s_chars != to_s_chars)
+ memmove (to_s_chars, from_s_chars, fullsize);
+
+ /* Relocate FROM_S_CHARS's reference */
+ set_string_data (string, &(to_s_chars->chars[0]));
+
+ from_pos += fullsize;
+ to_pos += fullsize;
+ }
+ }
+
+ /* Set current to the last string chars block still used and
+ free any that follow. */
+ {
+ struct string_chars_block *victim;
+
+ for (victim = to_sb->next; victim; )
+ {
+ struct string_chars_block *next = victim->next;
+ xfree (victim);
+ victim = next;
+ }
+
+ current_string_chars_block = to_sb;
+ current_string_chars_block->pos = to_pos;
+ current_string_chars_block->next = 0;
+ }
+}
+
+#if 1 /* Hack to debug missing purecopy's */
+static int debug_string_purity;
+
+static void
+debug_string_purity_print (struct Lisp_String *p)
+{
+ Charcount i;
+ Charcount s = string_char_length (p);
+ putc ('\"', stderr);
+ for (i = 0; i < s; i++)
+ {
+ Emchar ch = string_char (p, i);
+ if (ch < 32 || ch >= 126)
+ stderr_out ("\\%03o", ch);
+ else if (ch == '\\' || ch == '\"')
+ stderr_out ("\\%c", ch);
+ else
+ stderr_out ("%c", ch);
+ }
+ stderr_out ("\"\n");
+}
+#endif /* 1 */
+
+
+static void
+sweep_strings (void)
+{
+ 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);
+
+ gc_count_num_short_string_in_use = num_small_used;
+ gc_count_string_total_size = num_bytes;
+ gc_count_short_string_total_size = num_small_bytes;
+}
+
+
+/* I hate duplicating all this crap! */
+static int
+marked_p (Lisp_Object obj)
+{
+ if (EQ (obj, Qnull_pointer)) return 1;
+ if (!POINTER_TYPE_P (XGCTYPE (obj))) return 1;
+ if (PURIFIED (XPNTR (obj))) return 1;
+ switch (XGCTYPE (obj))
+ {
+#ifndef LRECORD_CONS
+ case Lisp_Type_Cons:
+ return XMARKBIT (XCAR (obj));
+#endif
+ case Lisp_Type_Record:
+ return MARKED_RECORD_HEADER_P (XRECORD_LHEADER (obj));
+#ifndef LRECORD_STRING
+ case Lisp_Type_String:
+ return XMARKBIT (XSTRING (obj)->plist);
+#endif /* ! LRECORD_STRING */
+#ifndef LRECORD_VECTOR
+ case Lisp_Type_Vector:
+ return XVECTOR_LENGTH (obj) < 0;
+#endif /* !LRECORD_VECTOR */
+#ifndef LRECORD_SYMBOL
+ case Lisp_Type_Symbol:
+ return XMARKBIT (XSYMBOL (obj)->plist);
+#endif
+ default:
+ abort ();
+ }
+ return 0; /* suppress compiler warning */
+}
+
+static void
+gc_sweep (void)
+{
+ /* Free all unmarked records. Do this at the very beginning,
+ before anything else, so that the finalize methods can safely
+ examine items in the objects. sweep_lcrecords_1() makes
+ sure to call all the finalize methods *before* freeing anything,
+ to complete the safety. */
+ {
+ int ignored;
+ sweep_lcrecords_1 (&all_lcrecords, &ignored);
+ }
+
+ compact_string_chars ();
+
+ /* Finalize methods below (called through the ADDITIONAL_FREE_foo
+ macros) must be *extremely* careful to make sure they're not
+ referencing freed objects. The only two existing finalize
+ methods (for strings and markers) pass muster -- the string
+ finalizer doesn't look at anything but its own specially-
+ created block, and the marker finalizer only looks at live
+ buffers (which will never be freed) and at the markers before
+ and after it in the chain (which, by induction, will never be
+ freed because if so, they would have already removed themselves
+ from the chain). */
+
+ /* Put all unmarked strings on free list, free'ing the string chars
+ of large unmarked strings */
+ sweep_strings ();
+
+ /* 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,
+ &gc_count_bit_vector_total_size,
+ &gc_count_bit_vector_storage);
+
+ /* Free all unmarked compiled-function objects */
+ sweep_compiled_functions ();
+
+#ifdef LISP_FLOAT_TYPE
+ /* Put all unmarked floats on free list */
+ sweep_floats ();
+#endif
+
+ /* Put all unmarked symbols on free list */
+ sweep_symbols ();
+
+ /* Put all unmarked extents on free list */
+ sweep_extents ();
+
+ /* Put all unmarked markers on free list.
+ Dechain each one first from the buffer into which it points. */
+ sweep_markers ();
+
+ sweep_events ();
+
+}
+\f
+/* Clearing for disksave. */
+
+void
+disksave_object_finalization (void)
+{
+ /* It's important that certain information from the environment not get
+ dumped with the executable (pathnames, environment variables, etc.).
+ To make it easier to tell when this has happend with strings(1) we
+ clear some known-to-be-garbage blocks of memory, so that leftover
+ 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;
+ Vexec_directory = Qnil;
+ Vdata_directory = Qnil;
+ Vsite_directory = Qnil;
+ Vdoc_directory = Qnil;
+ Vconfigure_info_directory = Qnil;
+ Vexec_path = Qnil;
+ Vload_path = Qnil;
+ /* Vdump_load_path = Qnil; */
+ uncache_home_directory();
+
+#if defined(LOADHIST) && !(defined(LOADHIST_DUMPED) || \
+ defined(LOADHIST_BUILTIN))
+ Vload_history = Qnil;
+#endif
+ Vshell_file_name = Qnil;
+
+ garbage_collect_1 ();
+
+ /* 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. */
+ {
+ struct string_chars_block *scb;
+ for (scb = first_string_chars_block; scb; scb = scb->next)
+ {
+ 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);
+ }
+ }
+ }
+
+ /* There, that ought to be enough... */
+
+}
+
+\f
+Lisp_Object
+restore_gc_inhibit (Lisp_Object val)
+{
+ gc_currently_forbidden = XINT (val);
+ return val;
+}
+
+/* Maybe we want to use this when doing a "panic" gc after memory_full()? */
+static int gc_hooks_inhibited;
+
+\f
+void
+garbage_collect_1 (void)
+{
+ char stack_top_variable;
+ extern char *stack_bottom;
+ int i;
+ struct frame *f;
+ int speccount;
+ int cursor_changed;
+ Lisp_Object pre_gc_cursor;
+ struct gcpro gcpro1;
+
+ if (gc_in_progress
+ || gc_currently_forbidden
+ || in_display
+ || preparing_for_armageddon)
+ return;
+
+ pre_gc_cursor = Qnil;
+ cursor_changed = 0;
+
+ /* This function cannot be called inside GC so we move to after the */
+ /* above tests */
+ f = selected_frame ();
+
+ GCPRO1 (pre_gc_cursor);
+
+ /* Very important to prevent GC during any of the following
+ stuff that might run Lisp code; otherwise, we'll likely
+ have infinite GC recursion. */
+ speccount = specpdl_depth ();
+ record_unwind_protect (restore_gc_inhibit,
+ make_int (gc_currently_forbidden));
+ gc_currently_forbidden = 1;
+
+ if (!gc_hooks_inhibited)
+ run_hook_trapping_errors ("Error in pre-gc-hook", Qpre_gc_hook);
+
+ /* Now show the GC cursor/message. */
+ if (!noninteractive)
+ {
+ if (FRAME_WIN_P (f))
+ {
+ Lisp_Object frame = make_frame (f);
+ Lisp_Object cursor = glyph_image_instance (Vgc_pointer_glyph,
+ FRAME_SELECTED_WINDOW (f),
+ ERROR_ME_NOT, 1);
+ pre_gc_cursor = f->pointer;
+ if (POINTER_IMAGE_INSTANCEP (cursor)
+ /* don't change if we don't know how to change back. */
+ && POINTER_IMAGE_INSTANCEP (pre_gc_cursor))
+ {
+ cursor_changed = 1;
+ Fset_frame_pointer (frame, cursor);
+ }
+ }
+
+ /* Don't print messages to the stream device. */
+ if (!cursor_changed && !FRAME_STREAM_P (f))
+ {
+ char *msg = (STRINGP (Vgc_message)
+ ? GETTEXT ((char *) XSTRING_DATA (Vgc_message))
+ : 0);
+ Lisp_Object args[2], whole_msg;
+ args[0] = build_string (msg ? msg :
+ 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,
+ Qgarbage_collecting);
+ }
+ }
+
+ /***** Now we actually start the garbage collection. */
+
+ gc_in_progress = 1;
+
+ gc_generation_number[0]++;
+
+#if MAX_SAVE_STACK > 0
+
+ /* Save a copy of the contents of the stack, for debugging. */
+ if (!purify_flag)
+ {
+ /* Static buffer in which we save a copy of the C stack at each GC. */
+ static char *stack_copy;
+ static size_t stack_copy_size;
+
+ ptrdiff_t stack_diff = &stack_top_variable - stack_bottom;
+ size_t stack_size = (stack_diff > 0 ? stack_diff : -stack_diff);
+ if (stack_size < MAX_SAVE_STACK)
+ {
+ if (stack_copy_size < stack_size)
+ {
+ stack_copy = (char *) xrealloc (stack_copy, stack_size);
+ stack_copy_size = stack_size;
+ }
+
+ memcpy (stack_copy,
+ stack_diff > 0 ? stack_bottom : &stack_top_variable,
+ stack_size);
+ }
+ }
+#endif /* MAX_SAVE_STACK > 0 */
+
+ /* Do some totally ad-hoc resource clearing. */
+ /* #### generalize this? */
+ clear_event_resource ();
+ cleanup_specifiers ();
+
+ /* Mark all the special slots that serve as the roots of accessibility. */
+ {
+ struct gcpro *tail;
+ struct catchtag *catch;
+ struct backtrace *backlist;
+ struct specbinding *bind;
+
+ for (i = 0; i < staticidx; i++)
+ {
+#ifdef GDB_SUCKS
+ printf ("%d\n", i);
+ debug_print (*staticvec[i]);
+#endif
+ mark_object (*(staticvec[i]));
+ }
+
+ for (tail = gcprolist; tail; tail = tail->next)
+ {
+ for (i = 0; i < tail->nvars; i++)
+ mark_object (tail->var[i]);
+ }
+
+ for (bind = specpdl; bind != specpdl_ptr; bind++)
+ {
+ mark_object (bind->symbol);
+ mark_object (bind->old_value);
+ }
+
+ for (catch = catchlist; catch; catch = catch->next)
+ {
+ mark_object (catch->tag);
+ mark_object (catch->val);
+ }
+
+ for (backlist = backtrace_list; backlist; backlist = backlist->next)
+ {
+ int nargs = backlist->nargs;
+
+ mark_object (*backlist->function);
+ if (nargs == UNEVALLED || nargs == MANY)
+ mark_object (backlist->args[0]);
+ else
+ for (i = 0; i < nargs; i++)
+ mark_object (backlist->args[i]);
+ }
+
+ mark_redisplay (mark_object);
+ mark_profiling_info (mark_object);
+ }
+
+ /* OK, now do the after-mark stuff. This is for things that
+ are only marked when something else is marked (e.g. weak hashtables).
+ There may be complex dependencies between such objects -- e.g.
+ a weak hashtable might be unmarked, but after processing a later
+ weak hashtable, the former one might get marked. So we have to
+ iterate until nothing more gets marked. */
+ {
+ int did_mark;
+ /* Need to iterate until there's nothing more to mark, in case
+ of chains of mark dependencies. */
+ do
+ {
+ did_mark = 0;
+ did_mark += !!finish_marking_weak_hashtables (marked_p, mark_object);
+ did_mark += !!finish_marking_weak_lists (marked_p, mark_object);
+ }
+ while (did_mark);
+ }
+
+ /* 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_hashtables (marked_p);
+ prune_weak_lists (marked_p);
+ prune_specifiers (marked_p);
+ prune_syntax_tables (marked_p);
+
+ gc_sweep ();
+
+ consing_since_gc = 0;
+#ifndef DEBUG_XEMACS
+ /* Allow you to set it really fucking low if you really want ... */
+ if (gc_cons_threshold < 10000)
+ gc_cons_threshold = 10000;
+#endif
+
+ gc_in_progress = 0;
+
+ /******* End of garbage collection ********/
+
+ run_hook_trapping_errors ("Error in post-gc-hook", Qpost_gc_hook);
+
+ /* Now remove the GC cursor/message */
+ if (!noninteractive)
+ {
+ if (cursor_changed)
+ Fset_frame_pointer (make_frame (f), pre_gc_cursor);
+ else if (!FRAME_STREAM_P (f))
+ {
+ char *msg = (STRINGP (Vgc_message)
+ ? GETTEXT ((char *) XSTRING_DATA (Vgc_message))
+ : 0);
+
+ /* Show "...done" only if the echo area would otherwise be empty. */
+ if (NILP (clear_echo_area (selected_frame (),
+ Qgarbage_collecting, 0)))
+ {
+ Lisp_Object args[2], whole_msg;
+ args[0] = build_string (msg ? msg :
+ GETTEXT ((CONST char *)
+ gc_default_message));
+ args[1] = build_string ("... done");
+ whole_msg = Fconcat (2, args);
+ echo_area_message (selected_frame (), (Bufbyte *) 0,
+ whole_msg, 0, -1,
+ Qgarbage_collecting);
+ }
+ }
+ }
+
+ /* now stop inhibiting GC */
+ unbind_to (speccount, Qnil);
+
+ if (!breathing_space)
+ {
+ breathing_space = malloc (4096 - MALLOC_OVERHEAD);
+ }
+
+ UNGCPRO;
+ return;
+}
+
+#ifdef EMACS_BTL
+ /* This isn't actually called. BTL recognizes the stack frame of the top
+ of the garbage collector by noting that PC is between &garbage_collect_1
+ and &BTL_after_garbage_collect_1_stub. So this fn must be right here.
+ There's not any other way to know the address of the end of a function.
+ */
+void BTL_after_garbage_collect_1_stub () { abort (); }
+#endif /* EMACS_BTL */
+
+/* Debugging aids. */
+
+static Lisp_Object
+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
+ arrays, or exceptions, or ...) */
+ return cons3 (intern (name), make_int (value), tail);
+}
+
+#define HACK_O_MATIC(type, name, pl) \
+ { \
+ int s = 0; \
+ struct type##_block *x = current_##type##_block; \
+ while (x) { s += sizeof (*x) + MALLOC_OVERHEAD; x = x->prev; } \
+ (pl) = gc_plist_hack ((name), s, (pl)); \
+ }
+
+DEFUN ("garbage-collect", Fgarbage_collect, 0, 0, "", /*
+Reclaim storage for Lisp objects no longer needed.
+Return info on amount of space in use:
+ ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)
+ (USED-MARKERS . FREE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS
+ PLIST)
+ where `PLIST' is a list of alternating keyword/value pairs providing
+ more detailed information.
+Garbage collection happens automatically if you cons more than
+`gc-cons-threshold' bytes of Lisp data since previous garbage collection.
+*/
+ ())
+{
+ 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++)
+ {
+ 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;
+ 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)
+ 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' */
+ if (name[len-1] == 's')
+ sprintf (buf, "%ses-freed", name);
+ else
+ sprintf (buf, "%ss-freed", name);
+ if (lcrecord_stats[i].instances_freed != 0)
+ pl = gc_plist_hack (buf, lcrecord_stats[i].instances_freed, pl);
+ if (name[len-1] == 's')
+ sprintf (buf, "%ses-on-free-list", name);
+ else
+ sprintf (buf, "%ss-on-free-list", name);
+ if (lcrecord_stats[i].instances_on_free_list != 0)
+ pl = gc_plist_hack (buf, lcrecord_stats[i].instances_on_free_list,
+ pl);
+ if (name[len-1] == 's')
+ sprintf (buf, "%ses-used", name);
+ else
+ sprintf (buf, "%ss-used", name);
+ pl = gc_plist_hack (buf, lcrecord_stats[i].instances_in_use, pl);
+ }
+ }
+
+ HACK_O_MATIC (extent, "extent-storage", pl);
+ pl = gc_plist_hack ("extents-free", gc_count_num_extent_freelist, pl);
+ pl = gc_plist_hack ("extents-used", gc_count_num_extent_in_use, pl);
+ HACK_O_MATIC (event, "event-storage", pl);
+ pl = gc_plist_hack ("events-free", gc_count_num_event_freelist, pl);
+ pl = gc_plist_hack ("events-used", gc_count_num_event_in_use, pl);
+ HACK_O_MATIC (marker, "marker-storage", pl);
+ pl = gc_plist_hack ("markers-free", gc_count_num_marker_freelist, pl);
+ pl = gc_plist_hack ("markers-used", gc_count_num_marker_in_use, pl);
+#ifdef LISP_FLOAT_TYPE
+ HACK_O_MATIC (float, "float-storage", pl);
+ pl = gc_plist_hack ("floats-free", gc_count_num_float_freelist, pl);
+ pl = gc_plist_hack ("floats-used", gc_count_num_float_in_use, pl);
+#endif /* LISP_FLOAT_TYPE */
+ HACK_O_MATIC (string, "string-header-storage", pl);
+ pl = gc_plist_hack ("long-strings-total-length",
+ gc_count_string_total_size
+ - gc_count_short_string_total_size, pl);
+ HACK_O_MATIC (string_chars, "short-string-storage", pl);
+ pl = gc_plist_hack ("short-strings-total-length",
+ gc_count_short_string_total_size, pl);
+ pl = gc_plist_hack ("strings-free", gc_count_num_string_freelist, pl);
+ pl = gc_plist_hack ("long-strings-used",
+ gc_count_num_string_in_use
+ - gc_count_num_short_string_in_use, pl);
+ pl = gc_plist_hack ("short-strings-used",
+ gc_count_num_short_string_in_use, pl);
+
+ HACK_O_MATIC (compiled_function, "compiled-function-storage", pl);
+ pl = gc_plist_hack ("compiled-functions-free",
+ gc_count_num_compiled_function_freelist, pl);
+ 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);
+ pl = gc_plist_hack ("bit-vectors-used", gc_count_num_bit_vector_used, pl);
+
+ HACK_O_MATIC (symbol, "symbol-storage", pl);
+ pl = gc_plist_hack ("symbols-free", gc_count_num_symbol_freelist, pl);
+ pl = gc_plist_hack ("symbols-used", gc_count_num_symbol_in_use, pl);
+
+ HACK_O_MATIC (cons, "cons-storage", pl);
+ pl = gc_plist_hack ("conses-free", gc_count_num_cons_freelist, pl);
+ pl = gc_plist_hack ("conses-used", gc_count_num_cons_in_use, pl);
+
+ /* The things we do for backwards-compatibility */
+ return
+ list6 (Fcons (make_int (gc_count_num_cons_in_use),
+ make_int (gc_count_num_cons_freelist)),
+ Fcons (make_int (gc_count_num_symbol_in_use),
+ make_int (gc_count_num_symbol_freelist)),
+ Fcons (make_int (gc_count_num_marker_in_use),
+ make_int (gc_count_num_marker_freelist)),
+ make_int (gc_count_string_total_size),
+ make_int (gc_count_vector_total_size),
+ pl);
+}
+#undef HACK_O_MATIC
+
+DEFUN ("consing-since-gc", Fconsing_since_gc, 0, 0, "", /*
+Return the number of bytes consed since the last garbage collection.
+\"Consed\" is a misnomer in that this actually counts allocation
+of all different kinds of objects, not just conses.
+
+If this value exceeds `gc-cons-threshold', a garbage collection happens.
+*/
+ ())
+{
+ return make_int (consing_since_gc);
+}
+
+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.
+The value is divided by 1024 to make sure it will fit in a lisp integer.
+*/
+ ())
+{
+ return make_int ((EMACS_INT) sbrk (0) / 1024);
+}
+
+
+\f
+int
+object_dead_p (Lisp_Object obj)
+{
+ return ((BUFFERP (obj) && !BUFFER_LIVE_P (XBUFFER (obj))) ||
+ (FRAMEP (obj) && !FRAME_LIVE_P (XFRAME (obj))) ||
+ (WINDOWP (obj) && !WINDOW_LIVE_P (XWINDOW (obj))) ||
+ (DEVICEP (obj) && !DEVICE_LIVE_P (XDEVICE (obj))) ||
+ (CONSOLEP (obj) && !CONSOLE_LIVE_P (XCONSOLE (obj))) ||
+ (EVENTP (obj) && !EVENT_LIVE_P (XEVENT (obj))) ||
+ (EXTENTP (obj) && !EXTENT_LIVE_P (XEXTENT (obj))));
+}
+
+#ifdef MEMORY_USAGE_STATS
+
+/* Attempt to determine the actual amount of space that is used for
+ the block allocated starting at PTR, supposedly of size "CLAIMED_SIZE".
+
+ It seems that the following holds:
+
+ 1. When using the old allocator (malloc.c):
+
+ -- blocks are always allocated in chunks of powers of two. For
+ each block, there is an overhead of 8 bytes if rcheck is not
+ defined, 20 bytes if it is defined. In other words, a
+ one-byte allocation needs 8 bytes of overhead for a total of
+ 9 bytes, and needs to have 16 bytes of memory chunked out for
+ it.
+
+ 2. When using the new allocator (gmalloc.c):
+
+ -- blocks are always allocated in chunks of powers of two up
+ to 4096 bytes. Larger blocks are allocated in chunks of
+ an integral multiple of 4096 bytes. The minimum block
+ size is 2*sizeof (void *), or 16 bytes if SUNOS_LOCALTIME_BUG
+ is defined. There is no per-block overhead, but there
+ is an overhead of 3*sizeof (size_t) for each 4096 bytes
+ allocated.
+
+ 3. When using the system malloc, anything goes, but they are
+ generally slower and more space-efficient than the GNU
+ allocators. One possibly reasonable assumption to make
+ for want of better data is that sizeof (void *), or maybe
+ 2 * sizeof (void *), is required as overhead and that
+ blocks are allocated in the minimum required size except
+ that some minimum block size is imposed (e.g. 16 bytes). */
+
+size_t
+malloced_storage_size (void *ptr, size_t claimed_size,
+ struct overhead_stats *stats)
+{
+ size_t orig_claimed_size = claimed_size;
+
+#ifdef GNU_MALLOC
+
+ if (claimed_size < 2 * sizeof (void *))
+ claimed_size = 2 * sizeof (void *);
+# ifdef SUNOS_LOCALTIME_BUG
+ if (claimed_size < 16)
+ claimed_size = 16;
+# endif
+ if (claimed_size < 4096)
+ {
+ int log = 1;
+
+ /* compute the log base two, more or less, then use it to compute
+ the block size needed. */
+ claimed_size--;
+ /* It's big, it's heavy, it's wood! */
+ while ((claimed_size /= 2) != 0)
+ ++log;
+ claimed_size = 1;
+ /* It's better than bad, it's good! */
+ while (log > 0)
+ {
+ claimed_size *= 2;
+ log--;
+ }
+ /* We have to come up with some average about the amount of
+ blocks used. */
+ if ((size_t) (rand () & 4095) < claimed_size)
+ claimed_size += 3 * sizeof (void *);
+ }
+ else
+ {
+ claimed_size += 4095;
+ claimed_size &= ~4095;
+ claimed_size += (claimed_size / 4096) * 3 * sizeof (size_t);
+ }
+
+#elif defined (SYSTEM_MALLOC)
+
+ if (claimed_size < 16)
+ claimed_size = 16;
+ claimed_size += 2 * sizeof (void *);
+
+#else /* old GNU allocator */
+
+# ifdef rcheck /* #### may not be defined here */
+ claimed_size += 20;
+# else
+ claimed_size += 8;
+# endif
+ {
+ int log = 1;
+
+ /* compute the log base two, more or less, then use it to compute
+ the block size needed. */
+ claimed_size--;
+ /* It's big, it's heavy, it's wood! */
+ while ((claimed_size /= 2) != 0)
+ ++log;
+ claimed_size = 1;
+ /* It's better than bad, it's good! */
+ while (log > 0)
+ {
+ claimed_size *= 2;
+ log--;
+ }
+ }
+
+#endif /* old GNU allocator */
+
+ if (stats)
+ {
+ stats->was_requested += orig_claimed_size;
+ stats->malloc_overhead += claimed_size - orig_claimed_size;
+ }
+ return claimed_size;
+}
+
+size_t
+fixed_type_block_overhead (size_t size)
+{
+ size_t per_block = TYPE_ALLOC_SIZE (cons, unsigned char);
+ size_t overhead = 0;
+ size_t storage_size = malloced_storage_size (0, per_block, 0);
+ while (size >= per_block)
+ {
+ size -= per_block;
+ overhead += sizeof (void *) + per_block - storage_size;
+ }
+ if (rand () % per_block < size)
+ overhead += sizeof (void *) + per_block - storage_size;
+ return overhead;
+}
+
+#endif /* MEMORY_USAGE_STATS */
+
+\f
+/* Initialization */
+void
+init_alloc_once_early (void)
+{
+ int iii;
+
+#ifdef PURESTAT
+ for (iii = 0; iii < countof (purestats); iii++)
+ {
+ if (! purestats[iii]) continue;
+ purestats[iii]->nobjects = 0;
+ purestats[iii]->nbytes = 0;
+ }
+ purecopying_for_bytecode = 0;
+#endif /* PURESTAT */
+
+ 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;
+ ignore_malloc_warnings = 1;
+#ifdef DOUG_LEA_MALLOC
+ mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */
+ mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */
+#if 0 /* Moved to emacs.c */
+ mallopt (M_MMAP_MAX, 64); /* max. number of mmap'ed areas */
+#endif
+#endif
+ init_string_alloc ();
+ init_string_chars_alloc ();
+ init_cons_alloc ();
+ init_symbol_alloc ();
+ init_compiled_function_alloc ();
+#ifdef LISP_FLOAT_TYPE
+ init_float_alloc ();
+#endif /* LISP_FLOAT_TYPE */
+ init_marker_alloc ();
+ init_extent_alloc ();
+ init_event_alloc ();
+
+ ignore_malloc_warnings = 0;
+ staticidx = 0;
+ consing_since_gc = 0;
+#if 1
+ gc_cons_threshold = 500000; /* XEmacs change */
+#else
+ gc_cons_threshold = 15000; /* debugging */
+#endif
+#ifdef VIRT_ADDR_VARIES
+ malloc_sbrk_unused = 1<<22; /* A large number */
+ malloc_sbrk_used = 100000; /* as reasonable as any number */
+#endif /* VIRT_ADDR_VARIES */
+ lrecord_uid_counter = 259;
+ debug_string_purity = 0;
+ gcprolist = 0;
+
+ gc_currently_forbidden = 0;
+ gc_hooks_inhibited = 0;
+
+#ifdef ERROR_CHECK_TYPECHECK
+ ERROR_ME.really_unlikely_name_to_have_accidentally_in_a_non_errb_structure =
+ 666;
+ ERROR_ME_NOT.
+ really_unlikely_name_to_have_accidentally_in_a_non_errb_structure = 42;
+ ERROR_ME_WARN.
+ really_unlikely_name_to_have_accidentally_in_a_non_errb_structure =
+ 3333632;
+#endif /* ERROR_CHECK_TYPECHECK */
+}
+
+void
+reinit_alloc (void)
+{
+ gcprolist = 0;
+}
+
+void
+syms_of_alloc (void)
+{
+ defsymbol (&Qpre_gc_hook, "pre-gc-hook");
+ defsymbol (&Qpost_gc_hook, "post-gc-hook");
+ defsymbol (&Qgarbage_collecting, "garbage-collecting");
+
+ DEFSUBR (Fcons);
+ DEFSUBR (Flist);
+ DEFSUBR (Fvector);
+ DEFSUBR (Fbit_vector);
+ DEFSUBR (Fmake_byte_code);
+ DEFSUBR (Fmake_list);
+ DEFSUBR (Fmake_vector);
+ DEFSUBR (Fmake_bit_vector);
+ DEFSUBR (Fmake_string);
+ DEFSUBR (Fstring);
+ DEFSUBR (Fmake_symbol);
+ DEFSUBR (Fmake_marker);
+ DEFSUBR (Fpurecopy);
+ DEFSUBR (Fgarbage_collect);
+ DEFSUBR (Fmemory_limit);
+ DEFSUBR (Fconsing_since_gc);
+}
+
+void
+vars_of_alloc (void)
+{
+ DEFVAR_INT ("gc-cons-threshold", &gc_cons_threshold /*
+*Number of bytes of consing between garbage collections.
+\"Consing\" is a misnomer in that this actually counts allocation
+of all different kinds of objects, not just conses.
+Garbage collection can happen automatically once this many bytes have been
+allocated since the last garbage collection. All data types count.
+
+Garbage collection happens automatically when `eval' or `funcall' are
+called. (Note that `funcall' is called implicitly as part of evaluation.)
+By binding this temporarily to a large number, you can effectively
+prevent garbage collection during a part of the program.
+
+See also `consing-since-gc'.
+*/ );
+
+ DEFVAR_INT ("pure-bytes-used", &pure_bytes_used /*
+Number of bytes of sharable Lisp data allocated so far.
+*/ );
+
+#if 0
+ DEFVAR_INT ("data-bytes-used", &malloc_sbrk_used /*
+Number of bytes of unshared memory allocated in this session.
+*/ );
+
+ DEFVAR_INT ("data-bytes-free", &malloc_sbrk_unused /*
+Number of bytes of unshared memory remaining available in this session.
+*/ );
+#endif
+
+#ifdef DEBUG_XEMACS
+ DEFVAR_INT ("debug-allocation", &debug_allocation /*
+If non-zero, print out information to stderr about all objects allocated.
+See also `debug-allocation-backtrace-length'.
+*/ );
+ debug_allocation = 0;
+
+ DEFVAR_INT ("debug-allocation-backtrace-length",
+ &debug_allocation_backtrace_length /*
+Length (in stack frames) of short backtrace printed out by `debug-allocation'.
+*/ );
+ debug_allocation_backtrace_length = 2;
+#endif
+
+ 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.
+*/ );
+
+ DEFVAR_LISP ("pre-gc-hook", &Vpre_gc_hook /*
+Function or functions to be run just before each garbage collection.
+Interrupts, garbage collection, and errors are inhibited while this hook
+runs, so be extremely careful in what you add here. In particular, avoid
+consing, and do not interact with the user.
+*/ );
+ Vpre_gc_hook = Qnil;
+
+ DEFVAR_LISP ("post-gc-hook", &Vpost_gc_hook /*
+Function or functions to be run just after each garbage collection.
+Interrupts, garbage collection, and errors are inhibited while this hook
+runs, so be extremely careful in what you add here. In particular, avoid
+consing, and do not interact with the user.
+*/ );
+ Vpost_gc_hook = Qnil;
+
+ DEFVAR_LISP ("gc-message", &Vgc_message /*
+String to print to indicate that a garbage collection is in progress.
+This is printed in the echo area. If the selected frame is on a
+window system and `gc-pointer-glyph' specifies a value (i.e. a pointer
+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);
+
+ DEFVAR_LISP ("gc-pointer-glyph", &Vgc_pointer_glyph /*
+Pointer glyph used to indicate that a garbage collection is in progress.
+If the selected window is on a window system and this glyph specifies a
+value (i.e. a pointer image instance) in the domain of the selected
+window, the pointer will be changed as specified during garbage collection.
+Otherwise, a message will be printed in the echo area, as controlled
+by `gc-message'.
+*/ );
+}
+
+void
+complex_vars_of_alloc (void)
+{
+ Vgc_pointer_glyph = Fmake_glyph_internal (Qpointer);
+}
--- /dev/null
+/* Buffer manipulation primitives for XEmacs.
+ Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc.
+ Copyright (C) 1995 Sun Microsystems, 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: Mule 2.0, FSF 19.30. */
+
+/* Authorship:
+
+ FSF: long ago.
+ JWZ: some changes for Lemacs, long ago. (e.g. separate buffer
+ list per frame.)
+ Mly: a few changes for buffer-local vars, 19.8 or 19.9.
+ Ben Wing: some changes and cleanups for Mule, 19.12.
+ */
+
+/* This file contains functions that work with buffer objects.
+ Functions that manipulate a buffer's text, however, are not
+ in this file:
+
+ 1) The low-level functions that actually know about the
+ implementation of a buffer's text are located in insdel.c.
+ 2) The higher-level (mostly Lisp) functions that manipulate a
+ buffer's text are in editfns.c.
+ 3) The highest-level Lisp commands are in cmds.c.
+
+ However:
+
+ -- Functions that know about syntax tables (forward-word,
+ scan-sexps, etc.) are in syntax.c, as are functions
+ that manipulate syntax tables.
+ -- Functions that know about case tables (upcase, downcase,
+ etc.) are in casefiddle.c. Functions that manipulate
+ case tables (case-table-p, set-case-table, etc.) are
+ in casetab.c.
+ -- Functions that do searching and replacing are in
+ search.c. The low-level functions that implement
+ regular expressions are in regex.c.
+
+ Also:
+
+ -- Some file and process functions (in fileio.c and process.c)
+ copy text from or insert text into a buffer; they call
+ low-level functions in insdel.c to do this.
+ -- insdel.c calls low-level functions in undo.c and extents.c
+ to record buffer modifications for undoing and to handle
+ extent adjustment and extent-data creation and insertion.
+
+*/
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "chartab.h"
+#include "commands.h"
+#include "elhash.h"
+#include "extents.h"
+#include "faces.h"
+#include "frame.h"
+#include "insdel.h"
+#include "process.h" /* for kill_buffer_processes */
+#ifdef REGION_CACHE_NEEDS_WORK
+#include "region-cache.h"
+#endif
+#include "syntax.h"
+#include "sysdep.h" /* for getwd */
+#include "window.h"
+
+#include "sysfile.h"
+
+struct buffer *current_buffer; /* the current buffer */
+
+/* This structure holds the default values of the buffer-local variables
+ defined with DEFVAR_BUFFER_LOCAL, that have special slots in each buffer.
+ The default value occupies the same slot in this structure
+ as an individual buffer's value occupies in that buffer.
+ 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;
+
+/* This structure marks which slots in a buffer have corresponding
+ default values in Vbuffer_defaults.
+ Each such slot has a nonzero value in this structure.
+ The value has only one nonzero bit.
+
+ When a buffer has its own local value for a slot,
+ the bit for that slot (found in the same slot in this structure)
+ is turned on in the buffer's local_var_flags slot.
+
+ If a slot in this structure is 0, then there is a DEFVAR_BUFFER_LOCAL
+ for the slot, but there is no default value for it; the corresponding
+ slot in Vbuffer_defaults is not used except to initialize newly-created
+ buffers.
+
+ If a slot is -1, then there is a DEFVAR_BUFFER_LOCAL for it
+ as well as a default value which is used to initialize newly-created
+ buffers and as a reset-value when local-vars are killed.
+
+ If a slot is -2, there is no DEFVAR_BUFFER_LOCAL for it.
+ (The slot is always local, but there's no lisp variable for it.)
+ The default value is only used to initialize newly-creation buffers.
+
+ If a slot is -3, then there is no DEFVAR_BUFFER_LOCAL for it but
+ there is a default which is used to initialize newly-creation
+ buffers and as a reset-value when local-vars are killed. */
+struct buffer buffer_local_flags;
+
+/* This is the initial (startup) directory, as used for the *scratch* buffer.
+ We're making this a global to make others aware of the startup directory.
+ */
+char initial_directory[MAXPATHLEN+1];
+
+/* 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;
+
+/* Alist of all buffer names vs the buffers. */
+/* This used to be a variable, but is no longer,
+ to prevent lossage due to user rplac'ing this alist or its elements.
+ Note that there is a per-frame copy of this as well; the frame slot
+ and the global variable contain the same data, but possibly in different
+ orders, so that the buffer ordering can be per-frame.
+ */
+Lisp_Object Vbuffer_alist;
+
+/* Functions to call before and after each text change. */
+Lisp_Object Qbefore_change_functions;
+Lisp_Object Qafter_change_functions;
+Lisp_Object Vbefore_change_functions;
+Lisp_Object Vafter_change_functions;
+
+/* #### Obsolete, for compatibility */
+Lisp_Object Qbefore_change_function;
+Lisp_Object Qafter_change_function;
+Lisp_Object Vbefore_change_function;
+Lisp_Object Vafter_change_function;
+
+#if 0 /* FSFmacs */
+Lisp_Object Vtransient_mark_mode;
+#endif
+
+/* t means ignore all read-only text properties.
+ A list means ignore such a property if its value is a member of the list.
+ Any non-nil value means ignore buffer-read-only. */
+Lisp_Object Vinhibit_read_only;
+
+/* List of functions to call that can query about killing a buffer.
+ If any of these functions returns nil, we don't kill it. */
+Lisp_Object Vkill_buffer_query_functions;
+
+/* Non-nil means delete a buffer's auto-save file when the buffer is saved. */
+int delete_auto_save_files;
+
+Lisp_Object Qbuffer_live_p;
+Lisp_Object Qbuffer_or_string_p;
+
+/* List of functions to call before changing an unmodified buffer. */
+Lisp_Object Vfirst_change_hook;
+Lisp_Object Qfirst_change_hook;
+
+Lisp_Object Qfundamental_mode;
+Lisp_Object Qmode_class;
+Lisp_Object Qpermanent_local;
+
+Lisp_Object Qprotected_field;
+
+Lisp_Object QSFundamental; /* A string "Fundamental" */
+Lisp_Object QSscratch; /* "*scratch*" */
+Lisp_Object Qdefault_directory;
+
+Lisp_Object Qkill_buffer_hook;
+Lisp_Object Qbuffer_file_name, Qbuffer_undo_list;
+
+Lisp_Object Qrename_auto_save_file;
+
+Lisp_Object Qget_file_buffer;
+Lisp_Object Qchange_major_mode_hook, Vchange_major_mode_hook;
+
+Lisp_Object Qfind_file_compare_truenames;
+
+Lisp_Object Qswitch_to_buffer;
+
+/* Two thresholds controlling how much undo information to keep. */
+int undo_threshold;
+int undo_high_threshold;
+
+int find_file_compare_truenames;
+int find_file_use_truenames;
+
+\f
+static void reset_buffer_local_variables (struct buffer *, int first_time);
+static void nuke_all_buffer_slots (struct buffer *b, Lisp_Object zap);
+
+Lisp_Object
+make_buffer (struct buffer *buf)
+{
+ Lisp_Object obj;
+ XSETBUFFER (obj, buf);
+ return obj;
+}
+
+static Lisp_Object
+mark_buffer (Lisp_Object obj, void (*markobj) (Lisp_Object))
+{
+ struct buffer *buf = XBUFFER (obj);
+
+ /* Truncate undo information. */
+ buf->undo_list = truncate_undo_list (buf->undo_list,
+ undo_threshold,
+ undo_high_threshold);
+
+#define MARKED_SLOT(x) ((markobj) (buf->x));
+#include "bufslots.h"
+#undef MARKED_SLOT
+
+ ((markobj) (buf->extent_info));
+
+ /* Don't mark normally through the children slot.
+ (Actually, in this case, it doesn't matter.) */
+ if (! EQ (buf->indirect_children, Qnull_pointer))
+ mark_conses_in_list (buf->indirect_children);
+
+ return buf->base_buffer ? make_buffer (buf->base_buffer) : Qnil;
+}
+
+static void
+print_buffer (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+ struct buffer *b = XBUFFER (obj);
+
+ if (print_readably)
+ {
+ if (!BUFFER_LIVE_P (b))
+ error ("printing unreadable object #<killed buffer>");
+ else
+ error ("printing unreadable object #<buffer %s>",
+ XSTRING_DATA (b->name));
+ }
+ else if (!BUFFER_LIVE_P (b))
+ write_c_string ("#<killed buffer>", printcharfun);
+ else if (escapeflag)
+ {
+ write_c_string ("#<buffer ", printcharfun);
+ print_internal (b->name, printcharfun, 1);
+ write_c_string (">", printcharfun);
+ }
+ else
+ {
+ print_internal (b->name, printcharfun, 0);
+ }
+}
+
+/* We do not need a finalize method to handle a buffer's children list
+ 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,
+ struct buffer);
+\f
+DEFUN ("bufferp", Fbufferp, 1, 1, 0, /*
+Return t if OBJECT is an editor buffer.
+*/
+ (object))
+{
+ return BUFFERP (object) ? Qt : Qnil;
+}
+
+DEFUN ("buffer-live-p", Fbuffer_live_p, 1, 1, 0, /*
+Return t if OBJECT is an editor buffer that has not been deleted.
+*/
+ (object))
+{
+ return BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object)) ? Qt : Qnil;
+}
+
+static void
+nsberror (Lisp_Object spec)
+{
+ if (STRINGP (spec))
+ error ("No buffer named %s", XSTRING_DATA (spec));
+ signal_simple_error ("Invalid buffer argument", spec);
+}
+
+DEFUN ("buffer-list", Fbuffer_list, 0, 1, 0, /*
+Return a list of all existing live buffers.
+The order is specific to the selected frame; if the optional FRAME
+argument is provided, the ordering for that frame is returned instead.
+If the FRAME argument is t, then the global (non-frame) ordering is
+returned instead.
+*/
+ (frame))
+{
+ Lisp_Object list;
+ if (EQ (frame, Qt))
+ list = Vbuffer_alist;
+ else
+ list = decode_frame (frame)->buffer_alist;
+ return Fmapcar (Qcdr, list);
+}
+
+Lisp_Object
+get_buffer (Lisp_Object name, int error_if_deleted_or_does_not_exist)
+{
+ if (BUFFERP (name))
+ {
+ if (!BUFFER_LIVE_P (XBUFFER (name)))
+ {
+ if (error_if_deleted_or_does_not_exist)
+ nsberror (name);
+ return Qnil;
+ }
+ return name;
+ }
+ else
+ {
+ Lisp_Object buf;
+ struct gcpro gcpro1;
+
+ CHECK_STRING (name);
+ name = LISP_GETTEXT (name); /* I18N3 */
+ GCPRO1 (name);
+ buf = Fcdr (Fassoc (name, Vbuffer_alist));
+ UNGCPRO;
+ if (NILP (buf) && error_if_deleted_or_does_not_exist)
+ nsberror (name);
+ return buf;
+ }
+}
+
+struct buffer *
+decode_buffer (Lisp_Object buffer, int allow_string)
+{
+ if (NILP (buffer))
+ return current_buffer;
+
+ if (allow_string && STRINGP (buffer))
+ return XBUFFER (get_buffer (buffer, 1));
+
+ CHECK_LIVE_BUFFER (buffer);
+ return XBUFFER (buffer);
+}
+
+DEFUN ("decode-buffer", Fdecode_buffer, 1, 1, 0, /*
+Validate BUFFER or if BUFFER is nil, return the current buffer.
+If BUFFER is a valid buffer or a string representing a valid buffer,
+the corresponding buffer object will be returned. Otherwise an error
+will be signaled.
+*/
+ (buffer))
+{
+ struct buffer *b = decode_buffer (buffer, 1);
+ XSETBUFFER (buffer, b);
+ return buffer;
+}
+
+#if 0 /* FSFmacs */
+/* bleagh!!! */
+/* Like Fassoc, but use Fstring_equal to compare
+ (which ignores text properties),
+ and don't ever QUIT. */
+
+static Lisp_Object
+assoc_ignore_text_properties (REGISTER Lisp_Object key, Lisp_Object list)
+{
+ REGISTER Lisp_Object tail;
+ for (tail = list; !NILP (tail); tail = Fcdr (tail))
+ {
+ REGISTER Lisp_Object elt, tem;
+ elt = Fcar (tail);
+ tem = Fstring_equal (Fcar (elt), key);
+ if (!NILP (tem))
+ return elt;
+ }
+ return Qnil;
+}
+
+#endif /* FSFmacs */
+
+DEFUN ("get-buffer", Fget_buffer, 1, 1, 0, /*
+Return the buffer named NAME (a string).
+If there is no live buffer named NAME, return nil.
+NAME may also be a buffer; if so, the value is that buffer.
+*/
+ (name))
+{
+#ifdef I18N3
+ /* #### Doc string should indicate that the buffer name will get
+ translated. */
+#endif
+
+ /* #### This might return a dead buffer. This is gross. This is
+ called FSF compatibility. */
+ if (BUFFERP (name))
+ return name;
+ return get_buffer (name, 0);
+ /* FSFmacs 19.29 calls assoc_ignore_text_properties() here.
+ Bleagh!! */
+}
+
+\f
+DEFUN ("get-file-buffer", Fget_file_buffer, 1, 1, 0, /*
+Return the buffer visiting file FILENAME (a string).
+The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.
+If there is no such live buffer, return nil.
+
+Normally, the comparison is done by canonicalizing FILENAME (using
+`expand-file-name') and comparing that to the value of `buffer-file-name'
+for each existing buffer. However, If `find-file-compare-truenames' is
+non-nil, FILENAME will be converted to its truename and the search will be
+done on each buffer's value of `buffer-file-truename' instead of
+`buffer-file-name'. Otherwise, if `find-file-use-truenames' is non-nil,
+FILENAME will be converted to its truename and used for searching, but
+the search will still be done on `buffer-file-name'.
+*/
+ (filename))
+{
+ /* This function can GC. GC checked 1997.04.06. */
+ REGISTER Lisp_Object tail, buf, tem;
+ struct gcpro gcpro1;
+
+#ifdef I18N3
+ /* DO NOT translate the filename. */
+#endif
+ GCPRO1 (filename);
+ CHECK_STRING (filename);
+ filename = Fexpand_file_name (filename, Qnil);
+ {
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ Lisp_Object handler = Ffind_file_name_handler (filename, Qget_file_buffer);
+ if (!NILP (handler))
+ {
+ UNGCPRO;
+ return call2 (handler, Qget_file_buffer, filename);
+ }
+ }
+ UNGCPRO;
+
+ if (find_file_compare_truenames || find_file_use_truenames)
+ {
+ struct gcpro ngcpro1, ngcpro2, ngcpro3;
+ Lisp_Object fn = Qnil;
+ Lisp_Object dn = Qnil;
+
+ NGCPRO3 (fn, dn, filename);
+ fn = Ffile_truename (filename, Qnil);
+ if (NILP (fn))
+ {
+ dn = Ffile_name_directory (filename);
+ fn = Ffile_truename (dn, Qnil);
+ if (! NILP (fn)) dn = fn;
+ fn = Fexpand_file_name (Ffile_name_nondirectory (filename),
+ dn);
+ }
+ filename = fn;
+ NUNGCPRO;
+ }
+
+ LIST_LOOP (tail, Vbuffer_alist)
+ {
+ buf = Fcdr (XCAR (tail));
+ if (!BUFFERP (buf)) continue;
+ if (!STRINGP (XBUFFER (buf)->filename)) continue;
+ tem = Fstring_equal (filename,
+ (find_file_compare_truenames
+ ? XBUFFER (buf)->file_truename
+ : XBUFFER (buf)->filename));
+ if (!NILP (tem))
+ return buf;
+ }
+ return Qnil;
+}
+
+
+static void
+push_buffer_alist (Lisp_Object name, Lisp_Object buf)
+{
+ Lisp_Object cons = Fcons (name, buf);
+ Lisp_Object frmcons, devcons, concons;
+
+ Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (cons, Qnil));
+ FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
+ {
+ struct frame *f;
+ f = XFRAME (XCAR (frmcons));
+ f->buffer_alist = nconc2 (f->buffer_alist, Fcons (cons, Qnil));
+ }
+}
+
+static void
+delete_from_buffer_alist (Lisp_Object buf)
+{
+ Lisp_Object cons = Frassq (buf, Vbuffer_alist);
+ Lisp_Object frmcons, devcons, concons;
+ if (NILP (cons))
+ return; /* abort() ? */
+ Vbuffer_alist = delq_no_quit (cons, Vbuffer_alist);
+
+ FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
+ {
+ struct frame *f;
+ f = XFRAME (XCAR (frmcons));
+ f->buffer_alist = delq_no_quit (cons, f->buffer_alist);
+ }
+}
+
+Lisp_Object
+get_truename_buffer (REGISTER Lisp_Object filename)
+{
+ /* FSFmacs has its own code here and doesn't call get-file-buffer.
+ That's because their equivalent of find-file-compare-truenames
+ (find-file-existing-other-name) isn't looked at in get-file-buffer.
+ This way is more correct. */
+ int count = specpdl_depth ();
+
+ specbind (Qfind_file_compare_truenames, Qt);
+ return unbind_to (count, Fget_file_buffer (filename));
+}
+
+static struct buffer *
+allocate_buffer (void)
+{
+ struct buffer *b = alloc_lcrecord_type (struct buffer, lrecord_buffer);
+
+ copy_lcrecord (b, XBUFFER (Vbuffer_defaults));
+
+ return b;
+}
+
+static Lisp_Object
+finish_init_buffer (struct buffer *b, Lisp_Object name)
+{
+ Lisp_Object buf;
+
+ XSETBUFFER (buf, b);
+
+ name = Fcopy_sequence (name);
+ /* #### This really does not need to be called. We already
+ initialized the buffer-local variables in allocate_buffer().
+ local_var_alist is set to Qnil at the same point, in
+ nuke_all_buffer_slots(). */
+ reset_buffer_local_variables (b, 1);
+ b->directory = ((current_buffer) ? current_buffer->directory : Qnil);
+
+ b->last_window_start = 1;
+
+ b->name = name;
+ if (string_byte (XSTRING (name), 0) != ' ')
+ b->undo_list = Qnil;
+ else
+ b->undo_list = Qt;
+
+ /* initialize the extent list */
+ init_buffer_extents (b);
+
+ /* Put this in the alist of all live buffers. */
+ push_buffer_alist (name, buf);
+
+ init_buffer_markers (b);
+
+ b->generated_modeline_string = Fmake_string (make_int (84), make_int (' '));
+ b->modeline_extent_table = make_lisp_hashtable (20, HASHTABLE_KEY_WEAK,
+ HASHTABLE_EQ);
+
+ return buf;
+}
+
+DEFUN ("get-buffer-create", Fget_buffer_create, 1, 1, 0, /*
+Return the buffer named NAME, or create such a buffer and return it.
+A new buffer is created if there is no live buffer named NAME.
+If NAME starts with a space, the new buffer does not keep undo information.
+If NAME is a buffer instead of a string, then it is the value returned.
+The value is never nil.
+*/
+ (name))
+{
+ /* This function can GC */
+ Lisp_Object buf;
+ REGISTER struct buffer *b;
+
+#ifdef I18N3
+ /* #### Doc string should indicate that the buffer name will get
+ translated. */
+#endif
+
+ name = LISP_GETTEXT (name);
+ buf = Fget_buffer (name);
+ if (!NILP (buf))
+ return buf;
+
+ if (XSTRING_LENGTH (name) == 0)
+ error ("Empty string for buffer name is not allowed");
+
+ b = allocate_buffer ();
+
+ b->text = &b->own_text;
+ b->base_buffer = 0;
+ b->indirect_children = Qnil;
+ init_buffer_text (b, 0);
+
+ return finish_init_buffer (b, name);
+}
+
+#if 0 /* #### implement this! Need various changes in insdel.c */
+DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, 2, 2,
+ "bMake indirect buffer (to buffer): \nBName of indirect buffer: ", /*
+Create and return an indirect buffer for buffer BASE, named NAME.
+BASE should be an existing buffer (or buffer name).
+NAME should be a string which is not the name of an existing buffer.
+If BASE is an indirect buffer itself, the base buffer for that buffer
+ is made the base buffer for the newly created buffer. (Thus, there will
+ never be indirect buffers whose base buffers are themselves indirect.)
+*/
+ (base_buffer, name))
+{
+ Lisp_Object buf;
+ REGISTER struct buffer *b;
+
+#ifdef I18N3
+ /* #### Doc string should indicate that the buffer name will get
+ translated. */
+#endif
+
+ name = LISP_GETTEXT (name);
+ buf = Fget_buffer (name);
+ if (!NILP (buf))
+ error ("Buffer name `%s' is in use", XSTRING_DATA (name));
+
+ base_buffer = Fget_buffer (base_buffer);
+ if (NILP (base_buffer))
+ error ("No such buffer: `%s'", XSTRING_DATA (XBUFFER (base_buffer)->name));
+
+ if (XSTRING_LENGTH (name) == 0)
+ error ("Empty string for buffer name is not allowed");
+
+ b = allocate_buffer ();
+
+ if (XBUFFER (base_buffer)->base_buffer)
+ b->base_buffer = XBUFFER (base_buffer)->base_buffer;
+ else
+ b->base_buffer = XBUFFER (base_buffer);
+
+ /* Use the base buffer's text object. */
+ b->text = b->base_buffer->text;
+ b->indirect_children = Qnil;
+ XSETBUFFER (buf, b);
+ b->base_buffer->indirect_children =
+ Fcons (buf, b->base_buffer->indirect_children);
+ init_buffer_text (b, 1);
+
+ return finish_init_buffer (b, name);
+}
+#endif /* 0 */
+
+
+\f
+static void
+reset_buffer_local_variables (struct buffer *b, int first_time)
+{
+ struct buffer *def = XBUFFER (Vbuffer_defaults);
+
+ b->local_var_flags = 0;
+ /* For each slot that has a default value,
+ copy that into the slot. */
+#define MARKED_SLOT(slot) \
+ { int mask = XINT (buffer_local_flags.slot); \
+ if ((mask > 0 || mask == -1 || mask == -3) \
+ && (first_time \
+ || NILP (Fget (XBUFFER (Vbuffer_local_symbols)->slot, \
+ Qpermanent_local, Qnil)))) \
+ b->slot = def->slot; \
+ }
+#include "bufslots.h"
+#undef MARKED_SLOT
+#if 0
+#define STRING256_P(obj) \
+ (STRINGP (obj) && XSTRING_CHAR_LENGTH (obj) == 256)
+ /* If the standard case table has been altered and invalidated,
+ fix up its insides first. */
+ if (!(STRING256_P(Vascii_upcase_table) &&
+ STRING256_P(Vascii_canon_table) &&
+ STRING256_P(Vascii_eqv_table)))
+ {
+ Fset_standard_case_table (Vascii_downcase_table);
+ }
+ b->downcase_table = Vascii_downcase_table;
+ b->upcase_table = Vascii_upcase_table;
+ b->case_canon_table = Vascii_canon_table;
+ b->case_eqv_table = Vascii_eqv_table;
+#ifdef MULE
+ b->mirror_downcase_table = Vmirror_ascii_downcase_table;
+ b->mirror_upcase_table = Vmirror_ascii_upcase_table;
+ b->mirror_case_canon_table = Vmirror_ascii_canon_table;
+ b->mirror_case_eqv_table = Vmirror_ascii_eqv_table;
+#endif
+#endif
+}
+
+\f
+/* We split this away from generate-new-buffer, because rename-buffer
+ and set-visited-file-name ought to be able to use this to really
+ rename the buffer properly. */
+
+DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, 1, 2, 0, /*
+Return a string that is the name of no existing buffer based on NAME.
+If there is no live buffer named NAME, then return NAME.
+Otherwise modify name by appending `<NUMBER>', incrementing NUMBER
+until an unused name is found, and then return that name.
+Optional second argument IGNORE specifies a name that is okay to use
+\(if it is in the sequence to be tried)
+even if a buffer with that name exists.
+*/
+ (name, ignore))
+{
+ REGISTER Lisp_Object gentemp, tem;
+ int count;
+ char number[10];
+
+ CHECK_STRING (name);
+
+ name = LISP_GETTEXT (name);
+#ifdef I18N3
+ /* #### Doc string should indicate that the buffer name will get
+ translated. */
+#endif
+
+ tem = Fget_buffer (name);
+ if (NILP (tem))
+ return name;
+
+ count = 1;
+ while (1)
+ {
+ sprintf (number, "<%d>", ++count);
+ gentemp = concat2 (name, build_string (number));
+ if (!NILP (ignore))
+ {
+ tem = Fstring_equal (gentemp, ignore);
+ if (!NILP (tem))
+ return gentemp;
+ }
+ tem = Fget_buffer (gentemp);
+ if (NILP (tem))
+ return gentemp;
+ }
+}
+
+\f
+DEFUN ("buffer-name", Fbuffer_name, 0, 1, 0, /*
+Return the name of BUFFER, as a string.
+With no argument or nil as argument, return the name of the current buffer.
+*/
+ (buffer))
+{
+ /* For compatibility, we allow a dead buffer here.
+ Earlier versions of Emacs didn't provide buffer-live-p. */
+ if (NILP (buffer))
+ return current_buffer->name;
+ CHECK_BUFFER (buffer);
+ return XBUFFER (buffer)->name;
+}
+
+DEFUN ("buffer-file-name", Fbuffer_file_name, 0, 1, 0, /*
+Return name of file BUFFER is visiting, or nil if none.
+No argument or nil as argument means use the current buffer.
+*/
+ (buffer))
+{
+ /* For compatibility, we allow a dead buffer here. Yuck! */
+ if (NILP (buffer))
+ return current_buffer->filename;
+ CHECK_BUFFER (buffer);
+ return XBUFFER (buffer)->filename;
+}
+
+DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, 0, 1, 0, /*
+Return the base buffer of indirect buffer BUFFER.
+If BUFFER is not indirect, return nil.
+*/
+ (buffer))
+{
+ struct buffer *buf = decode_buffer (buffer, 0);
+
+ return buf->base_buffer ? make_buffer (buf->base_buffer) : Qnil;
+}
+
+DEFUN ("buffer-indirect-children", Fbuffer_indirect_children, 0, 1, 0, /*
+Return a list of all indirect buffers whose base buffer is BUFFER.
+If BUFFER is indirect, the return value will always be nil; see
+`make-indirect-buffer'.
+*/
+ (buffer))
+{
+ struct buffer *buf = decode_buffer (buffer, 0);
+
+ return Fcopy_sequence (buf->indirect_children);
+}
+
+/* Map MAPFUN over all buffers that share the same text as BUF
+ (this includes BUF). Pass two arguments to MAPFUN: a buffer,
+ and CLOSURE. If any invocation of MAPFUN returns non-zero,
+ halt immediately and return that value. Otherwise, continue
+ the mapping to the end and return 0. */
+
+int
+map_over_sharing_buffers (struct buffer *buf,
+ int (*mapfun) (struct buffer *buf, void *closure),
+ void *closure)
+{
+ int result;
+ Lisp_Object tail;
+
+ if (buf->base_buffer)
+ {
+ buf = buf->base_buffer;
+ assert (!buf->base_buffer);
+ }
+
+ result = (mapfun) (buf, closure);
+ if (result)
+ return result;
+
+ LIST_LOOP (tail, buf->indirect_children)
+ {
+ Lisp_Object buffer = XCAR (tail);
+ result = (mapfun) (XBUFFER (buffer), closure);
+ if (result)
+ return result;
+ }
+
+ return 0;
+}
+
+DEFUN ("buffer-local-variables", Fbuffer_local_variables, 0, 1, 0, /*
+Return an alist of variables that are buffer-local in BUFFER.
+Most elements look like (SYMBOL . VALUE), describing one variable.
+For a symbol that is locally unbound, just the symbol appears in the value.
+Note that storing new VALUEs in these elements doesn't change the variables.
+No argument or nil as argument means use current buffer as BUFFER.
+*/
+ (buffer))
+{
+ struct buffer *buf = decode_buffer (buffer, 0);
+ Lisp_Object result = Qnil;
+
+ {
+ Lisp_Object tail;
+ for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
+ {
+ Lisp_Object elt = XCAR (tail);
+ /* Reference each variable in the alist in buf.
+ If inquiring about the current buffer, this gets the current values,
+ so store them into the alist so the alist is up to date.
+ If inquiring about some other buffer, this swaps out any values
+ for that buffer, making the alist up to date automatically. */
+ Lisp_Object val = find_symbol_value (XCAR (elt));
+ /* Use the current buffer value only if buf is the current buffer. */
+ if (buf != current_buffer)
+ val = XCDR (elt);
+
+ /* If symbol is unbound, put just the symbol in the list. */
+ if (UNBOUNDP (val))
+ result = Fcons (XCAR (elt), result);
+ /* Otherwise, put (symbol . value) in the list. */
+ else
+ result = Fcons (Fcons (XCAR (elt), val), result);
+ }
+ }
+
+ /* Add on all the variables stored in special slots. */
+ {
+ struct buffer *syms = XBUFFER (Vbuffer_local_symbols);
+#define MARKED_SLOT(slot) \
+ { int mask = XINT (buffer_local_flags.slot); \
+ if (mask == 0 || mask == -1 \
+ || ((mask > 0) && (buf->local_var_flags & mask))) \
+ result = Fcons (Fcons (syms->slot, buf->slot), result); \
+ }
+#include "bufslots.h"
+#undef MARKED_SLOT
+ }
+ return result;
+}
+
+DEFUN ("buffer-dedicated-frame", Fbuffer_dedicated_frame, 0, 1, 0, /*
+Return the frame dedicated to this BUFFER, or nil if there is none.
+No argument or nil as argument means use current buffer as BUFFER.
+*/
+ (buffer))
+{
+ struct buffer *buf = decode_buffer (buffer, 0);
+
+ /* XEmacs addition: if the frame is dead, silently make it go away. */
+ if (!NILP (buf->dedicated_frame) &&
+ !FRAME_LIVE_P (XFRAME (buf->dedicated_frame)))
+ buf->dedicated_frame = Qnil;
+
+ return buf->dedicated_frame;
+}
+
+DEFUN ("set-buffer-dedicated-frame", Fset_buffer_dedicated_frame, 2, 2, 0, /*
+For this BUFFER, set the FRAME dedicated to it.
+FRAME must be a frame or nil.
+*/
+ (buffer, frame))
+{
+ struct buffer *buf = decode_buffer (buffer, 0);
+
+ if (!NILP (frame))
+ CHECK_LIVE_FRAME (frame); /* XEmacs change */
+
+ return buf->dedicated_frame = frame;
+}
+
+
+\f
+DEFUN ("buffer-modified-p", Fbuffer_modified_p, 0, 1, 0, /*
+Return t if BUFFER was modified since its file was last read or saved.
+No argument or nil as argument means use current buffer as BUFFER.
+*/
+ (buffer))
+{
+ struct buffer *buf = decode_buffer (buffer, 0);
+
+ return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil;
+}
+
+DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, 1, 2, 0, /*
+Mark BUFFER as modified or unmodified according to FLAG.
+A non-nil FLAG means mark the buffer modified. No argument or nil
+as BUFFER means use current buffer.
+*/
+ (flag, buffer))
+{
+ /* This function can GC */
+ struct buffer *buf = decode_buffer (buffer, 0);
+
+#ifdef CLASH_DETECTION
+ /* If buffer becoming modified, lock the file.
+ If buffer becoming unmodified, unlock the file. */
+
+ Lisp_Object fn = buf->file_truename;
+ if (!NILP (fn))
+ {
+ int already = BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf);
+ if (already == NILP (flag))
+ {
+ int count = specpdl_depth ();
+ /* lock_file() and unlock_file() currently use current_buffer */
+ /* #### - dmoore, what if lock_file or unlock_file kill
+ the current buffer? */
+ record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ set_buffer_internal (buf);
+ if (!already && !NILP (flag))
+ lock_file (fn);
+ else if (already && NILP (flag))
+ unlock_file (fn);
+ unbind_to (count, Qnil);
+ }
+ }
+#endif /* CLASH_DETECTION */
+
+ /* This is often called when the buffer contents are altered but we
+ don't want to treat the changes that way (e.g. selective
+ display). We still need to make sure redisplay realizes that the
+ contents have potentially altered and it needs to do some
+ work. */
+ buf = decode_buffer(buffer, 0);
+ BUF_MODIFF (buf)++;
+ BUF_SAVE_MODIFF (buf) = NILP (flag) ? BUF_MODIFF (buf) : 0;
+ MARK_MODELINE_CHANGED;
+
+ return flag;
+}
+
+DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, 0, 1, 0, /*
+Return BUFFER's tick counter, incremented for each change in text.
+Each buffer has a tick counter which is incremented each time the text in
+that buffer is changed. It wraps around occasionally.
+No argument or nil as argument means use current buffer as BUFFER.
+*/
+ (buffer))
+{
+ struct buffer *buf = decode_buffer (buffer, 0);
+
+ return make_int (BUF_MODIFF (buf));
+}
+\f
+DEFUN ("rename-buffer", Frename_buffer, 1, 2,
+ "sRename buffer (to new name): \nP", /*
+Change current buffer's name to NEWNAME (a string).
+If second arg UNIQUE is nil or omitted, it is an error if a
+buffer named NEWNAME already exists.
+If UNIQUE is non-nil, come up with a new name using
+`generate-new-buffer-name'.
+Interactively, one can set UNIQUE with a prefix argument.
+Returns the name we actually gave the buffer.
+This does not change the name of the visited file (if any).
+*/
+ (newname, unique))
+{
+ /* This function can GC */
+ Lisp_Object tem, buf;
+
+#ifdef I18N3
+ /* #### Doc string should indicate that the buffer name will get
+ translated. */
+#endif
+ CHECK_STRING (newname);
+ newname = LISP_GETTEXT (newname);
+
+ if (XSTRING_LENGTH (newname) == 0)
+ error ("Empty string is invalid as a buffer name");
+
+ tem = Fget_buffer (newname);
+ /* Don't short-circuit if UNIQUE is t. That is a useful way to rename
+ the buffer automatically so you can create another with the original name.
+ It makes UNIQUE equivalent to
+ (rename-buffer (generate-new-buffer-name NEWNAME)). */
+ /* XEmacs change: added check for nil */
+ if (NILP (unique) && !NILP (tem) && XBUFFER (tem) == current_buffer)
+ return current_buffer->name;
+ if (!NILP (tem))
+ {
+ if (!NILP (unique))
+ newname = Fgenerate_new_buffer_name (newname, current_buffer->name);
+ else
+ error ("Buffer name \"%s\" is in use",
+ XSTRING_DATA (newname));
+ }
+
+ current_buffer->name = newname;
+
+ /* Catch redisplay's attention. Unless we do this, the modelines for
+ any windows displaying current_buffer will stay unchanged. */
+ MARK_MODELINE_CHANGED;
+
+ buf = Fcurrent_buffer ();
+
+ /* The aconses in the Vbuffer_alist are shared with frame->buffer_alist,
+ so this will change it in the per-frame ordering as well. */
+ Fsetcar (Frassq (buf, Vbuffer_alist), newname);
+ if (NILP (current_buffer->filename)
+ && !NILP (current_buffer->auto_save_file_name))
+ call0 (Qrename_auto_save_file);
+ /* refetch since that last call may have done GC */
+ /* (hypothetical relocating GC) */
+ return current_buffer->name;
+}
+
+DEFUN ("other-buffer", Fother_buffer, 0, 3, 0, /*
+Return most recently selected buffer other than BUFFER.
+Buffers not visible in windows are preferred to visible buffers,
+unless optional third argument VISIBLE-OK is non-nil.
+If no other buffer exists, the buffer `*scratch*' is returned.
+If BUFFER is omitted or nil, some interesting buffer is returned.
+
+The ordering is for this frame; If second optional argument FRAME
+is provided, then the ordering is for that frame. If the second arg
+is t, then the global ordering is returned.
+
+Note: In FSF Emacs, this function takes two arguments: BUFFER and
+VISIBLE-OK.
+*/
+ (buffer, frame, visible_ok))
+{
+ /* This function can GC */
+ Lisp_Object tail, buf, notsogood, tem;
+ Lisp_Object alist;
+
+ notsogood = Qnil;
+
+ if (EQ (frame, Qt))
+ alist = Vbuffer_alist;
+ else
+ {
+ struct frame *f = decode_frame (frame);
+
+ XSETFRAME (frame, f);
+ alist = f->buffer_alist;
+ }
+
+ for (tail = alist; !NILP (tail); tail = Fcdr (tail))
+ {
+ buf = Fcdr (Fcar (tail));
+ if (EQ (buf, buffer))
+ continue;
+ if (string_byte (XSTRING (XBUFFER (buf)->name), 0) == ' ')
+ continue;
+ /* If FRAME has a buffer_predicate,
+ disregard buffers that don't fit the predicate. */
+ if (FRAMEP (frame))
+ {
+ tem = XFRAME (frame)->buffer_predicate;
+ if (!NILP (tem))
+ {
+ tem = call1 (tem, buf);
+ if (NILP (tem))
+ continue;
+ }
+ }
+
+ if (NILP (visible_ok))
+ {
+ /* get-buffer-window will handle nil or t frame */
+ tem = Fget_buffer_window (buf, frame, Qnil);
+ }
+ else
+ tem = Qnil;
+ if (NILP (tem))
+ return buf;
+ if (NILP (notsogood))
+ notsogood = buf;
+ }
+ if (!NILP (notsogood))
+ return notsogood;
+ return Fget_buffer_create (QSscratch);
+}
+\f
+DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, 0, 1, "", /*
+Make BUFFER stop keeping undo information.
+Any undo records it already has are discarded.
+No argument or nil as argument means do this for the current buffer.
+*/
+ (buffer))
+{
+ /* Allowing nil is an RMSism */
+ struct buffer *real_buf = decode_buffer (buffer, 1);
+ real_buf->undo_list = Qt;
+ return Qnil;
+}
+
+DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, 0, 1, "", /*
+Start keeping undo information for buffer BUFFER.
+No argument or nil as argument means do this for the current buffer.
+*/
+ (buffer))
+{
+ /* Allowing nil is an RMSism */
+ struct buffer *real_buf = decode_buffer (buffer, 1);
+ if (EQ (real_buf->undo_list, Qt))
+ real_buf->undo_list = Qnil;
+
+ return Qnil;
+}
+
+DEFUN ("kill-buffer", Fkill_buffer, 1, 1, "bKill buffer: ", /*
+Kill the buffer BUFNAME.
+The argument may be a buffer or may be the name of a buffer.
+An argument of nil means kill the current buffer.
+
+Value is t if the buffer is actually killed, nil if user says no.
+
+The value of `kill-buffer-hook' (which may be local to that buffer),
+if not void, is a list of functions to be called, with no arguments,
+before the buffer is actually killed. The buffer to be killed is current
+when the hook functions are called.
+
+Any processes that have this buffer as the `process-buffer' are killed
+with `delete-process'.
+*/
+ (bufname))
+{
+ /* This function can call lisp */
+ Lisp_Object buf;
+ REGISTER struct buffer *b;
+ struct gcpro gcpro1, gcpro2;
+
+ if (NILP (bufname))
+ buf = Fcurrent_buffer ();
+ else if (BUFFERP (bufname))
+ buf = bufname;
+ else
+ {
+ buf = get_buffer (bufname, 0);
+ if (NILP (buf)) nsberror (bufname);
+ }
+
+ b = XBUFFER (buf);
+
+ /* OK to delete an already-deleted buffer. */
+ if (!BUFFER_LIVE_P (b))
+ return Qnil;
+
+ /* Don't kill the minibuffer now current. */
+ if (EQ (buf, Vminibuffer_zero))
+ return Qnil;
+
+ /* Or the echo area. */
+ if (EQ (buf, Vecho_area_buffer))
+ return Qnil;
+
+ /* Query if the buffer is still modified. */
+ if (INTERACTIVE && !NILP (b->filename)
+ && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
+ {
+ Lisp_Object killp;
+ GCPRO2 (buf, bufname);
+ killp = call1
+ (Qyes_or_no_p,
+ (emacs_doprnt_string_c
+ ((CONST Bufbyte *) GETTEXT ("Buffer %s modified; kill anyway? "),
+ Qnil, -1, XSTRING_DATA (b->name))));
+ UNGCPRO;
+ if (NILP (killp))
+ return Qnil;
+ b = XBUFFER (buf); /* Hypothetical relocating GC. */
+ }
+
+ /* Run hooks with the buffer to be killed temporarily selected,
+ unless the buffer is already dead (could have been deleted
+ in the question above).
+ */
+ if (BUFFER_LIVE_P (b))
+ {
+ int speccount = specpdl_depth ();
+ Lisp_Object tail = Qnil;
+
+ GCPRO2 (buf, tail);
+ record_unwind_protect (save_excursion_restore, save_excursion_save ());
+ Fset_buffer (buf);
+
+ /* First run the query functions; if any query is answered no,
+ don't kill the buffer. */
+ EXTERNAL_LIST_LOOP (tail, Vkill_buffer_query_functions)
+ {
+ if (NILP (call0 (Fcar (tail))))
+ {
+ UNGCPRO;
+ return unbind_to (speccount, Qnil);
+ }
+ }
+
+ /* Then run the hooks. */
+ run_hook (Qkill_buffer_hook);
+#ifdef HAVE_X_WINDOWS
+ /* If an X selection was in this buffer, disown it.
+ We could have done this by simply adding this function to the
+ kill-buffer-hook, but the user might mess that up.
+ */
+ if (EQ (Vwindow_system, Qx))
+ call0 (intern ("xselect-kill-buffer-hook"));
+ /* #### generalize me! */
+#endif /* HAVE_X_WINDOWS */
+ unbind_to (speccount, Qnil);
+ UNGCPRO;
+ b = XBUFFER (buf); /* Hypothetical relocating GC. */
+ }
+
+ /* We have no more questions to ask. Verify that it is valid
+ to kill the buffer. This must be done after the questions
+ since anything can happen within yes-or-no-p. */
+
+ /* Might have been deleted during the last question above */
+ if (!BUFFER_LIVE_P (b))
+ return Qnil;
+
+ /* Don't kill the minibuffer now current. */
+ if (EQ (buf, XWINDOW (minibuf_window)->buffer))
+ return Qnil;
+
+ /* When we kill a base buffer, kill all its indirect buffers.
+ We do it at this stage so nothing terrible happens if they
+ ask questions or their hooks get errors. */
+ if (! b->base_buffer)
+ {
+ Lisp_Object rest;
+
+ GCPRO1 (buf);
+
+ LIST_LOOP (rest, b->indirect_children)
+ Fkill_buffer (XCAR (rest));
+
+ UNGCPRO;
+ }
+
+ /* Make this buffer not be current.
+ In the process, notice if this is the sole visible buffer
+ and give up if so. */
+ if (b == current_buffer)
+ {
+ Fset_buffer (Fother_buffer (buf, Qnil, Qnil));
+ if (b == current_buffer)
+ return Qnil;
+ }
+
+ /* Now there is no question: we can kill the buffer. */
+
+#ifdef CLASH_DETECTION
+ /* Unlock this buffer's file, if it is locked. unlock_buffer
+ can both GC and kill the current buffer, and wreak general
+ havok by running lisp code. */
+ GCPRO1 (buf);
+ unlock_buffer (b);
+ UNGCPRO;
+ b = XBUFFER (buf);
+
+ if (!BUFFER_LIVE_P (b))
+ return Qnil;
+
+ if (b == current_buffer)
+ {
+ Fset_buffer (Fother_buffer (buf, Qnil, Qnil));
+ if (b == current_buffer)
+ return Qnil;
+ }
+#endif /* CLASH_DETECTION */
+
+ {
+ int speccount = specpdl_depth ();
+ specbind (Qinhibit_quit, Qt);
+
+ kill_buffer_processes (buf);
+
+ /* #### This is a problem if this buffer is in a dedicated window.
+ Need to undedicate any windows of this buffer first (and delete them?)
+ */
+ Freplace_buffer_in_windows (buf);
+
+ delete_from_buffer_alist (buf);
+
+ font_lock_buffer_was_killed (b);
+
+ /* Delete any auto-save file, if we saved it in this session. */
+ if (STRINGP (b->auto_save_file_name)
+ && b->auto_save_modified != 0
+ && BUF_SAVE_MODIFF (b) < b->auto_save_modified)
+ {
+ if (delete_auto_save_files != 0)
+ {
+ /* deleting the auto save file might kill b! */
+ /* #### dmoore - fix this crap, we do this same gcpro and
+ buffer liveness check multiple times. Let's get a
+ macro or something for it. */
+ GCPRO1 (buf);
+ internal_delete_file (b->auto_save_file_name);
+ UNGCPRO;
+ b = XBUFFER (buf);
+
+ if (!BUFFER_LIVE_P (b))
+ return Qnil;
+
+ if (b == current_buffer)
+ {
+ Fset_buffer (Fother_buffer (buf, Qnil, Qnil));
+ if (b == current_buffer)
+ return Qnil;
+ }
+ }
+ }
+
+ uninit_buffer_markers (b);
+
+ kill_buffer_local_variables (b);
+
+ b->name = Qnil;
+ uninit_buffer_text (b, !!b->base_buffer);
+ b->undo_list = Qnil;
+ uninit_buffer_extents (b);
+ if (b->base_buffer)
+ {
+#ifdef ERROR_CHECK_BUFPOS
+ assert (!NILP (memq_no_quit (buf, b->base_buffer->indirect_children)));
+#endif
+ b->base_buffer->indirect_children =
+ delq_no_quit (buf, b->base_buffer->indirect_children);
+ }
+
+ /* Clear away all Lisp objects, so that they
+ won't be protected from GC. */
+ nuke_all_buffer_slots (b, Qnil);
+
+ unbind_to (speccount, Qnil);
+ }
+ return Qt;
+}
+\f
+DEFUN ("record-buffer", Frecord_buffer, 1, 1, 0, /*
+Place buffer BUF first in the buffer order.
+Call this function when a buffer is selected "visibly".
+
+This function changes the global buffer order and the per-frame buffer
+order for the selected frame. The buffer order keeps track of recency
+of selection so that `other-buffer' will return a recently selected
+buffer. See `other-buffer' for more information.
+*/
+ (buf))
+{
+ REGISTER Lisp_Object lynk, prev;
+ struct frame *f = selected_frame ();
+
+ prev = Qnil;
+ for (lynk = Vbuffer_alist; CONSP (lynk); lynk = XCDR (lynk))
+ {
+ if (EQ (XCDR (XCAR (lynk)), buf))
+ break;
+ prev = lynk;
+ }
+ /* Effectively do Vbuffer_alist = delq_no_quit (lynk, Vbuffer_alist) */
+ if (NILP (prev))
+ Vbuffer_alist = XCDR (Vbuffer_alist);
+ else
+ XCDR (prev) = XCDR (XCDR (prev));
+ XCDR (lynk) = Vbuffer_alist;
+ Vbuffer_alist = lynk;
+
+ /* That was the global one. Now do the same thing for the
+ per-frame buffer-alist. */
+ prev = Qnil;
+ for (lynk = f->buffer_alist; CONSP (lynk); lynk = XCDR (lynk))
+ {
+ if (EQ (XCDR (XCAR (lynk)), buf))
+ break;
+ prev = lynk;
+ }
+ /* Effectively do f->buffer_alist = delq_no_quit (lynk, f->buffer_alist) */
+ if (NILP (prev))
+ f->buffer_alist = XCDR (f->buffer_alist);
+ else
+ XCDR (prev) = XCDR (XCDR (prev));
+ XCDR (lynk) = f->buffer_alist;
+ f->buffer_alist = lynk;
+ return Qnil;
+}
+
+DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, 1, 1, 0, /*
+Set an appropriate major mode for BUFFER, according to `default-major-mode'.
+Use this function before selecting the buffer, since it may need to inspect
+the current buffer's major mode.
+*/
+ (buf))
+{
+ int speccount = specpdl_depth ();
+ REGISTER Lisp_Object function, tem;
+
+ function = XBUFFER (Vbuffer_defaults)->major_mode;
+ if (NILP (function))
+ {
+ tem = Fget (current_buffer->major_mode, Qmode_class, Qnil);
+ if (NILP (tem))
+ function = current_buffer->major_mode;
+ }
+
+ if (NILP (function) || EQ (function, Qfundamental_mode))
+ return Qnil;
+
+ /* To select a nonfundamental mode,
+ select the buffer temporarily and then call the mode function. */
+
+ record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+
+ Fset_buffer (buf);
+ call0 (function);
+
+ return unbind_to (speccount, Qnil);
+}
+
+void
+switch_to_buffer (Lisp_Object bufname, Lisp_Object norecord)
+{
+ call2 (Qswitch_to_buffer, bufname, norecord);
+}
+
+
+DEFUN ("current-buffer", Fcurrent_buffer, 0, 0, 0, /*
+Return the current buffer as a Lisp object.
+*/
+ ())
+{
+ Lisp_Object buf;
+ XSETBUFFER (buf, current_buffer);
+ return buf;
+}
+\f
+/* Set the current buffer to B. */
+
+void
+set_buffer_internal (struct buffer *b)
+{
+ REGISTER struct buffer *old_buf;
+ REGISTER Lisp_Object tail;
+
+ if (current_buffer == b)
+ return;
+
+ INVALIDATE_PIXEL_TO_GLYPH_CACHE;
+
+ old_buf = current_buffer;
+ current_buffer = b;
+ invalidate_current_column (); /* invalidate indentation cache */
+
+#ifdef HAVE_FEP
+ if (!noninteractive && initialized)
+ {
+ extern Lisp_Object Ffep_force_on (), Ffep_force_off (), Ffep_get_mode ();
+
+ old_buf->fep_mode = Ffep_get_mode ();
+
+ if (!NILP (current_buffer->fep_mode))
+ Ffep_force_on ();
+ else
+ Ffep_force_off ();
+ }
+#endif /* HAVE_FEP */
+
+ if (old_buf)
+ {
+ /* Put the undo list back in the base buffer, so that it appears
+ that an indirect buffer shares the undo list of its base. */
+ if (old_buf->base_buffer)
+ old_buf->base_buffer->undo_list = old_buf->undo_list;
+ }
+
+ /* Get the undo list from the base buffer, so that it appears
+ that an indirect buffer shares the undo list of its base. */
+ if (b->base_buffer)
+ b->undo_list = b->base_buffer->undo_list;
+
+ /* Look down buffer's list of local Lisp variables
+ to find and update any that forward into C variables. */
+
+ LIST_LOOP (tail, b->local_var_alist)
+ {
+ Lisp_Object sym = XCAR (XCAR (tail));
+ Lisp_Object valcontents = XSYMBOL (sym)->value;
+ if (SYMBOL_VALUE_MAGIC_P (valcontents))
+ {
+ /* Just reference the variable
+ to cause it to become set for this buffer. */
+ /* Use find_symbol_value_quickly to avoid an unnecessary O(n)
+ lookup. */
+ (void) find_symbol_value_quickly (XCAR (tail), 1);
+ }
+ }
+
+ /* Do the same with any others that were local to the previous buffer */
+
+ if (old_buf)
+ {
+ LIST_LOOP (tail, old_buf->local_var_alist)
+ {
+ Lisp_Object sym = XCAR (XCAR (tail));
+ Lisp_Object valcontents = XSYMBOL (sym)->value;
+
+ if (SYMBOL_VALUE_MAGIC_P (valcontents))
+ {
+ /* Just reference the variable
+ to cause it to become set for this buffer. */
+ /* Use find_symbol_value_quickly with find_it_p as 0 to avoid an
+ unnecessary O(n) lookup which is guaranteed to be worst case.
+ Any symbols which are local are guaranteed to have been
+ handled in the previous loop, above. */
+ (void) find_symbol_value_quickly (sym, 0);
+ }
+ }
+ }
+}
+
+DEFUN ("set-buffer", Fset_buffer, 1, 1, 0, /*
+Make the buffer BUFFER current for editing operations.
+BUFFER may be a buffer or the name of an existing buffer.
+See also `save-excursion' when you want to make a buffer current temporarily.
+This function does not display the buffer, so its effect ends
+when the current command terminates.
+Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently.
+*/
+ (buffer))
+{
+ buffer = get_buffer (buffer, 0);
+ if (NILP (buffer))
+ error ("Selecting deleted or non-existent buffer");
+ set_buffer_internal (XBUFFER (buffer));
+ return buffer;
+}
+
+\f
+DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only, 0, 3, 0, /*
+Signal a `buffer-read-only' error if the buffer is read-only.
+Optional argument BUFFER defaults to the current buffer.
+
+If optional argument START is non-nil, all extents in the buffer
+which overlap that part of the buffer are checked to ensure none has a
+`read-only' property. (Extents that lie completely within the range,
+however, are not checked.) END defaults to the value of START.
+
+If START and END are equal, the range checked is [START, END] (i.e.
+closed on both ends); otherwise, the range checked is (START, END)
+\(open on both ends), except that extents that lie completely within
+[START, END] are not checked. See `extent-in-region-p' for a fuller
+discussion.
+*/
+ (buffer, start, end))
+{
+ struct buffer *b = decode_buffer (buffer, 0);
+ Bufpos s, e;
+
+ if (NILP (start))
+ s = e = -1;
+ else
+ {
+ if (NILP (end))
+ end = start;
+ get_buffer_range_char (b, start, end, &s, &e, 0);
+ }
+ barf_if_buffer_read_only (b, s, e);
+
+ return Qnil;
+}
+
+static void
+bury_buffer_1 (Lisp_Object buffer, Lisp_Object before,
+ Lisp_Object *buffer_alist)
+{
+ Lisp_Object aelt = rassq_no_quit (buffer, *buffer_alist);
+ Lisp_Object lynk = memq_no_quit (aelt, *buffer_alist);
+ Lisp_Object iter, before_before;
+
+ *buffer_alist = delq_no_quit (aelt, *buffer_alist);
+ for (before_before = Qnil, iter = *buffer_alist;
+ !NILP (iter) && !EQ (XCDR (XCAR (iter)), before);
+ before_before = iter, iter = XCDR (iter))
+ ;
+ XCDR (lynk) = iter;
+ if (!NILP (before_before))
+ XCDR (before_before) = lynk;
+ else
+ *buffer_alist = lynk;
+}
+
+DEFUN ("bury-buffer", Fbury_buffer, 0, 2, "", /*
+Put BUFFER at the end of the list of all buffers.
+There it is the least likely candidate for `other-buffer' to return;
+thus, the least likely buffer for \\[switch-to-buffer] to select by default.
+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.
+If BEFORE is non-nil, it specifies a buffer before which BUFFER
+will be placed, instead of being placed at the end.
+*/
+ (buffer, before))
+{
+ /* This function can GC */
+ struct buffer *buf = decode_buffer (buffer, 1);
+ /* If we're burying the current buffer, unshow it. */
+ /* Note that the behavior of (bury-buffer nil) and
+ (bury-buffer (current-buffer)) is not the same.
+ This is illogical but is historical. Changing it
+ breaks mh-e and TeX and such packages. */
+ if (NILP (buffer))
+ switch_to_buffer (Fother_buffer (Fcurrent_buffer (), Qnil, Qnil), Qnil);
+ XSETBUFFER (buffer, buf);
+
+ if (!NILP (before))
+ before = get_buffer (before, 1);
+
+ if (EQ (before, buffer))
+ error ("Cannot place a buffer before itself");
+
+ bury_buffer_1 (buffer, before, &Vbuffer_alist);
+ bury_buffer_1 (buffer, before, &selected_frame ()->buffer_alist);
+
+ return Qnil;
+}
+
+\f
+DEFUN ("erase-buffer", Ferase_buffer, 0, 1, "*", /*
+Delete the entire contents of the BUFFER.
+Any clipping restriction in effect (see `narrow-to-region') is removed,
+so the buffer is truly empty after this.
+BUFFER defaults to the current buffer if omitted.
+*/
+ (buffer))
+{
+ /* This function can GC */
+ struct buffer *b = decode_buffer (buffer, 1);
+ /* #### yuck yuck yuck. This is gross. The old echo-area code,
+ however, was the only place that called erase_buffer() with a
+ non-zero NO_CLIP argument.
+
+ Someone needs to fix up the redisplay code so it is smarter
+ about this, so that the NO_CLIP junk isn't necessary. */
+ int no_clip = (b == XBUFFER (Vecho_area_buffer));
+
+ INVALIDATE_PIXEL_TO_GLYPH_CACHE;
+
+ widen_buffer (b, no_clip);
+ buffer_delete_range (b, BUF_BEG (b), BUF_Z (b), 0);
+ b->last_window_start = 1;
+
+ /* Prevent warnings, or suspension of auto saving, that would happen
+ if future size is less than past size. Use of erase-buffer
+ implies that the future text is not really related to the past text. */
+ b->saved_size = Qzero;
+
+ zmacs_region_stays = 0;
+ return Qnil;
+}
+
+\f
+
+DEFUN ("kill-all-local-variables", Fkill_all_local_variables, 0, 0, 0, /*
+Switch to Fundamental mode by killing current buffer's local variables.
+Most local variable bindings are eliminated so that the default values
+become effective once more. Also, the syntax table is set from
+`standard-syntax-table', the category table is set from
+`standard-category-table' (if support for Mule exists), local keymap is set
+to nil, the abbrev table is set from `fundamental-mode-abbrev-table',
+and all specifier specifications whose locale is the current buffer
+are removed. This function also forces redisplay of the modeline.
+
+Every function to select a new major mode starts by
+calling this function.
+
+As a special exception, local variables whose names have
+a non-nil `permanent-local' property are not eliminated by this function.
+
+The first thing this function does is run
+the normal hook `change-major-mode-hook'.
+*/
+ ())
+{
+ /* This function can GC */
+ run_hook (Qchange_major_mode_hook);
+
+ reset_buffer_local_variables (current_buffer, 0);
+
+ kill_buffer_local_variables (current_buffer);
+
+ kill_specifier_buffer_locals (Fcurrent_buffer ());
+
+ /* Force modeline redisplay. Useful here because all major mode
+ commands call this function. */
+ MARK_MODELINE_CHANGED;
+
+ return Qnil;
+}
+
+#ifdef MEMORY_USAGE_STATS
+
+struct buffer_stats
+{
+ int text;
+ int markers;
+ int extents;
+ int other;
+};
+
+static size_t
+compute_buffer_text_usage (struct buffer *b, struct overhead_stats *ovstats)
+{
+ int was_requested = b->text->z - 1;
+ size_t gap = b->text->gap_size + b->text->end_gap_size;
+ size_t malloc_use = malloced_storage_size (b->text->beg, was_requested + gap, 0);
+
+ ovstats->gap_overhead += gap;
+ ovstats->was_requested += was_requested;
+ ovstats->malloc_overhead += malloc_use - (was_requested + gap);
+ return malloc_use;
+}
+
+static void
+compute_buffer_usage (struct buffer *b, struct buffer_stats *stats,
+ struct overhead_stats *ovstats)
+{
+ xzero (*stats);
+ stats->other += malloced_storage_size (b, sizeof (*b), ovstats);
+ stats->text += compute_buffer_text_usage (b, ovstats);
+ stats->markers += compute_buffer_marker_usage (b, ovstats);
+ stats->extents += compute_buffer_extent_usage (b, ovstats);
+}
+
+DEFUN ("buffer-memory-usage", Fbuffer_memory_usage, 1, 1, 0, /*
+Return stats about the memory usage of buffer BUFFER.
+The values returned are in the form of an alist of usage types and byte
+counts. The byte counts attempt to encompass all the memory used
+by the buffer (separate from the memory logically associated with a
+buffer or frame), including internal structures and any malloc()
+overhead associated with them. In practice, the byte counts are
+underestimated because certain memory usage is very hard to determine
+\(e.g. the amount of memory used inside the Xt library or inside the
+X server) and because there is other stuff that might logically
+be associated with a window, buffer, or frame (e.g. window configurations,
+glyphs) but should not obviously be included in the usage counts.
+
+Multiple slices of the total memory usage may be returned, separated
+by a nil. Each slice represents a particular view of the memory, a
+particular way of partitioning it into groups. Within a slice, there
+is no overlap between the groups of memory, and each slice collectively
+represents all the memory concerned.
+*/
+ (buffer))
+{
+ struct buffer_stats stats;
+ struct overhead_stats ovstats;
+ Lisp_Object val = Qnil;
+
+ CHECK_BUFFER (buffer); /* dead buffers should be allowed, no? */
+ xzero (ovstats);
+ compute_buffer_usage (XBUFFER (buffer), &stats, &ovstats);
+
+ val = acons (Qtext, make_int (stats.text), val);
+ val = acons (Qmarkers, make_int (stats.markers), val);
+ val = acons (Qextents, make_int (stats.extents), val);
+ val = acons (Qother, make_int (stats.other), val);
+ val = Fcons (Qnil, val);
+ val = acons (Qactually_requested, make_int (ovstats.was_requested), val);
+ val = acons (Qmalloc_overhead, make_int (ovstats.malloc_overhead), val);
+ val = acons (Qgap_overhead, make_int (ovstats.gap_overhead), val);
+ val = acons (Qdynarr_overhead, make_int (ovstats.dynarr_overhead), val);
+
+ return Fnreverse (val);
+}
+
+#endif /* MEMORY_USAGE_STATS */
+
+void
+syms_of_buffer (void)
+{
+ defsymbol (&Qbuffer_live_p, "buffer-live-p");
+ defsymbol (&Qbuffer_or_string_p, "buffer-or-string-p");
+ defsymbol (&Qmode_class, "mode-class");
+ defsymbol (&Qrename_auto_save_file, "rename-auto-save-file");
+ defsymbol (&Qkill_buffer_hook, "kill-buffer-hook");
+ defsymbol (&Qpermanent_local, "permanent-local");
+
+ defsymbol (&Qfirst_change_hook, "first-change-hook");
+ defsymbol (&Qbefore_change_functions, "before-change-functions");
+ defsymbol (&Qafter_change_functions, "after-change-functions");
+
+ /* #### Obsolete, for compatibility */
+ 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");
+ defsymbol (&Qchange_major_mode_hook, "change-major-mode-hook");
+
+ defsymbol (&Qfundamental_mode, "fundamental-mode");
+
+ defsymbol (&Qfind_file_compare_truenames, "find-file-compare-truenames");
+
+ defsymbol (&Qswitch_to_buffer, "switch-to-buffer");
+
+ DEFSUBR (Fbufferp);
+ DEFSUBR (Fbuffer_live_p);
+ DEFSUBR (Fbuffer_list);
+ DEFSUBR (Fdecode_buffer);
+ DEFSUBR (Fget_buffer);
+ DEFSUBR (Fget_file_buffer);
+ DEFSUBR (Fget_buffer_create);
+#if 0
+ DEFSUBR (Fmake_indirect_buffer);
+#endif
+
+ DEFSUBR (Fgenerate_new_buffer_name);
+ DEFSUBR (Fbuffer_name);
+ DEFSUBR (Fbuffer_file_name);
+ DEFSUBR (Fbuffer_base_buffer);
+ DEFSUBR (Fbuffer_indirect_children);
+ DEFSUBR (Fbuffer_local_variables);
+ DEFSUBR (Fbuffer_dedicated_frame);
+ DEFSUBR (Fset_buffer_dedicated_frame);
+ DEFSUBR (Fbuffer_modified_p);
+ DEFSUBR (Fset_buffer_modified_p);
+ DEFSUBR (Fbuffer_modified_tick);
+ DEFSUBR (Frename_buffer);
+ DEFSUBR (Fother_buffer);
+ DEFSUBR (Fbuffer_disable_undo);
+ DEFSUBR (Fbuffer_enable_undo);
+ DEFSUBR (Fkill_buffer);
+ DEFSUBR (Ferase_buffer);
+ DEFSUBR (Frecord_buffer);
+ DEFSUBR (Fset_buffer_major_mode);
+ DEFSUBR (Fcurrent_buffer);
+ DEFSUBR (Fset_buffer);
+ DEFSUBR (Fbarf_if_buffer_read_only);
+ DEFSUBR (Fbury_buffer);
+ DEFSUBR (Fkill_all_local_variables);
+#ifdef MEMORY_USAGE_STATS
+ DEFSUBR (Fbuffer_memory_usage);
+#endif
+
+ deferror (&Qprotected_field, "protected-field",
+ "Attempt to modify a protected field", Qerror);
+}
+
+/* initialize the buffer routines */
+void
+vars_of_buffer (void)
+{
+ /* This function can GC */
+ 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;
+
+ DEFVAR_LISP ("change-major-mode-hook", &Vchange_major_mode_hook /*
+List of hooks to be run before killing local variables in a buffer.
+This should be used by any mode that temporarily alters the contents or
+the read-only state of the buffer. See also `kill-all-local-variables'.
+*/ );
+ Vchange_major_mode_hook = Qnil;
+
+ DEFVAR_BOOL ("find-file-compare-truenames", &find_file_compare_truenames /*
+If this is true, then the find-file command will check the truenames
+of all visited files when deciding whether a given file is already in
+a buffer, instead of just the buffer-file-name. This means that if you
+attempt to visit another file which is a symbolic-link to a file which is
+already in a buffer, the existing buffer will be found instead of a newly-
+created one. This works if any component of the pathname (including a non-
+terminal component) is a symbolic link as well, but doesn't work with hard
+links (nothing does).
+
+See also the variable find-file-use-truenames.
+*/ );
+ find_file_compare_truenames = 0;
+
+ DEFVAR_BOOL ("find-file-use-truenames", &find_file_use_truenames /*
+If this is true, then a buffer's visited file-name will always be
+chased back to the real file; it will never be a symbolic link, and there
+will never be a symbolic link anywhere in its directory path.
+That is, the buffer-file-name and buffer-file-truename will be equal.
+This doesn't work with hard links.
+
+See also the variable find-file-compare-truenames.
+*/ );
+ find_file_use_truenames = 0;
+
+ DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions /*
+List of functions to call before each text change.
+Two arguments are passed to each function: the positions of
+the beginning and end of the range of old text to be changed.
+\(For an insertion, the beginning and end are at the same place.)
+No information is given about the length of the text after the change.
+
+Buffer changes made while executing the `before-change-functions'
+don't call any before-change or after-change functions.
+*/ );
+ Vbefore_change_functions = Qnil;
+
+ /* FSF Emacs has the following additional doc at the end of
+ before-change-functions and after-change-functions:
+
+That's because these variables are temporarily set to nil.
+As a result, a hook function cannot straightforwardly alter the value of
+these variables. See the Emacs Lisp manual for a way of
+accomplishing an equivalent result by using other variables.
+
+ But this doesn't apply under XEmacs because things are
+ handled better. */
+
+ DEFVAR_LISP ("after-change-functions", &Vafter_change_functions /*
+List of functions to call after each text change.
+Three arguments are passed to each function: the positions of
+the beginning and end of the range of changed text,
+and the length of the pre-change text replaced by that range.
+\(For an insertion, the pre-change length is zero;
+for a deletion, that length is the number of characters deleted,
+and the post-change beginning and end are at the same place.)
+
+Buffer changes made while executing `after-change-functions'
+don't call any before-change or after-change functions.
+*/ );
+ Vafter_change_functions = Qnil;
+
+ DEFVAR_LISP ("before-change-function", &Vbefore_change_function /*
+
+*/ ); /* obsoleteness will be documented */
+ Vbefore_change_function = Qnil;
+
+ DEFVAR_LISP ("after-change-function", &Vafter_change_function /*
+
+*/ ); /* obsoleteness will be documented */
+ Vafter_change_function = Qnil;
+
+ DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook /*
+A list of functions to call before changing a buffer which is unmodified.
+The functions are run using the `run-hooks' function.
+*/ );
+ Vfirst_change_hook = Qnil;
+
+#if 0 /* FSFmacs */
+ xxDEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode /*
+*Non-nil means deactivate the mark when the buffer contents change.
+*/ );
+ Vtransient_mark_mode = Qnil;
+#endif /* FSFmacs */
+
+ DEFVAR_INT ("undo-threshold", &undo_threshold /*
+Keep no more undo information once it exceeds this size.
+This threshold is applied when garbage collection happens.
+The size is counted as the number of bytes occupied,
+which includes both saved text and other data.
+*/ );
+ undo_threshold = 20000;
+
+ DEFVAR_INT ("undo-high-threshold", &undo_high_threshold /*
+Don't keep more than this much size of undo information.
+A command which pushes past this size is itself forgotten.
+This threshold is applied when garbage collection happens.
+The size is counted as the number of bytes occupied,
+which includes both saved text and other data.
+*/ );
+ undo_high_threshold = 30000;
+
+ DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only /*
+*Non-nil means disregard read-only status of buffers or characters.
+If the value is t, disregard `buffer-read-only' and all `read-only'
+text properties. If the value is a list, disregard `buffer-read-only'
+and disregard a `read-only' extent property or text property if the
+property value is a member of the list.
+*/ );
+ Vinhibit_read_only = Qnil;
+
+ DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions /*
+List of functions called with no args to query before killing a buffer.
+*/ );
+ Vkill_buffer_query_functions = Qnil;
+
+ DEFVAR_BOOL ("delete-auto-save-files", &delete_auto_save_files /*
+*Non-nil means delete auto-save file when a buffer is saved or killed.
+*/ );
+ delete_auto_save_files = 1;
+}
+
+/* DOC is ignored because it is snagged and recorded externally
+ * by make-docfile */
+/* Renamed from DEFVAR_PER_BUFFER because FSFmacs D_P_B takes
+ * a bogus extra arg, which confuses an otherwise identical make-docfile.c */
+/* Declaring this stuff as const produces 'Cannot reinitialize' messages
+ from SunPro C's fix-and-continue feature (a way neato feature that
+ makes debugging unbelievably more bearable) */
+#define DEFVAR_BUFFER_LOCAL(lname, field_name) 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 }, \
+ SYMVAL_CURRENT_BUFFER_FORWARD }, 0 }; \
+ defvar_buffer_local ((lname), &I_hate_C); \
+ } while (0)
+
+#define DEFVAR_BUFFER_LOCAL_MAGIC(lname, field_name, 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 }, \
+ SYMVAL_CURRENT_BUFFER_FORWARD }, magicfun }; \
+ defvar_buffer_local ((lname), &I_hate_C); \
+ } while (0)
+
+#define DEFVAR_CONST_BUFFER_LOCAL(lname, field_name) 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 }, \
+ SYMVAL_CONST_CURRENT_BUFFER_FORWARD }, 0 }; \
+ defvar_buffer_local ((lname), &I_hate_C); \
+ } while (0)
+
+#define DEFVAR_CONST_BUFFER_LOCAL_MAGIC(lname, field_name, 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 }, \
+ SYMVAL_CONST_CURRENT_BUFFER_FORWARD }, magicfun }; \
+ defvar_buffer_local ((lname), &I_hate_C); \
+ } while (0)
+
+static void
+defvar_buffer_local (CONST char *namestring,
+ CONST struct symbol_value_forward *m)
+{
+ int offset = ((char *)symbol_value_forward_forward (m)
+ - (char *)&buffer_local_flags);
+
+ defvar_mumble (namestring, m, sizeof (*m));
+
+ *((Lisp_Object *)(offset + (char *)XBUFFER (Vbuffer_local_symbols)))
+ = intern (namestring);
+}
+
+/* DOC is ignored because it is snagged and recorded externally
+ * by make-docfile */
+#define DEFVAR_BUFFER_DEFAULTS(lname, field_name) 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 }, \
+ SYMVAL_DEFAULT_BUFFER_FORWARD }, 0 }; \
+ defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C)); \
+ } while (0)
+
+#define DEFVAR_BUFFER_DEFAULTS_MAGIC(lname, field_name, 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 }, \
+ SYMVAL_DEFAULT_BUFFER_FORWARD }, magicfun }; \
+ defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C)); \
+ } while (0)
+
+static void
+nuke_all_buffer_slots (struct buffer *b, Lisp_Object zap)
+{
+ zero_lcrecord (b);
+
+#define MARKED_SLOT(x) b->x = (zap);
+#include "bufslots.h"
+#undef MARKED_SLOT
+}
+
+void
+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);
+ XSETBUFFER (Vbuffer_defaults, defs);
+ XSETBUFFER (Vbuffer_local_symbols, syms);
+
+ nuke_all_buffer_slots (syms, Qnil);
+ nuke_all_buffer_slots (defs, Qnil);
+ defs->text = &defs->own_text;
+ syms->text = &syms->own_text;
+
+ /* Set up the non-nil default values of various buffer slots.
+ Must do these before making the first buffer. */
+ defs->major_mode = Qfundamental_mode;
+ defs->mode_name = QSFundamental;
+ defs->abbrev_table = Qnil; /* real default setup by Lisp code */
+ defs->downcase_table = Vascii_downcase_table;
+ defs->upcase_table = Vascii_upcase_table;
+ defs->case_canon_table = Vascii_canon_table;
+ defs->case_eqv_table = Vascii_eqv_table;
+#ifdef MULE
+ defs->mirror_downcase_table = Vmirror_ascii_downcase_table;
+ defs->mirror_upcase_table = Vmirror_ascii_upcase_table;
+ defs->mirror_case_canon_table = Vmirror_ascii_canon_table;
+ defs->mirror_case_eqv_table = Vmirror_ascii_eqv_table;
+ defs->category_table = Vstandard_category_table;
+#endif /* MULE */
+ defs->syntax_table = Vstandard_syntax_table;
+ defs->mirror_syntax_table =
+ XCHAR_TABLE (Vstandard_syntax_table)->mirror_table;
+ defs->modeline_format = build_string ("%-"); /* reset in loaddefs.el */
+ defs->case_fold_search = Qt;
+ defs->selective_display_ellipses = Qt;
+ defs->tab_width = make_int (8);
+ defs->ctl_arrow = Qt;
+ defs->fill_column = make_int (70);
+ defs->left_margin = Qzero;
+ defs->saved_size = Qzero; /* lisp code wants int-or-nil */
+ defs->modtime = 0;
+ defs->auto_save_modified = 0;
+ defs->auto_save_failure_time = -1;
+ defs->invisibility_spec = Qt;
+
+ defs->indirect_children = Qnil;
+ syms->indirect_children = Qnil;
+
+ {
+ /* 0 means var is always local. Default used only at creation.
+ * -1 means var is always local. Default used only at reset and
+ * creation.
+ * -2 means there's no lisp variable corresponding to this slot
+ * and the default is only used at creation.
+ * -3 means no Lisp variable. Default used only at reset and creation.
+ * >0 is mask. Var is local if ((buffer->local_var_flags & mask) != 0)
+ * Otherwise default is used.
+ */
+ Lisp_Object always_local_no_default = make_int (0);
+ Lisp_Object always_local_resettable = make_int (-1);
+ Lisp_Object resettable = make_int (-3);
+
+ /* Assign the local-flags to the slots that have default values.
+ The local flag is a bit that is used in the buffer
+ to say that it has its own local value for the slot.
+ The local flag bits are in the local_var_flags slot of the
+ buffer. */
+
+ nuke_all_buffer_slots (&buffer_local_flags, make_int (-2));
+ buffer_local_flags.filename = always_local_no_default;
+ buffer_local_flags.directory = always_local_no_default;
+ buffer_local_flags.backed_up = always_local_no_default;
+ buffer_local_flags.saved_size = always_local_no_default;
+ buffer_local_flags.auto_save_file_name = always_local_no_default;
+ buffer_local_flags.read_only = always_local_no_default;
+
+ buffer_local_flags.major_mode = always_local_resettable;
+ buffer_local_flags.mode_name = always_local_resettable;
+ buffer_local_flags.undo_list = always_local_no_default;
+#if 0 /* FSFmacs */
+ buffer_local_flags.mark_active = always_local_resettable;
+#endif
+ buffer_local_flags.point_before_scroll = always_local_resettable;
+ buffer_local_flags.file_truename = always_local_no_default;
+ buffer_local_flags.invisibility_spec = always_local_resettable;
+ buffer_local_flags.file_format = always_local_resettable;
+ buffer_local_flags.generated_modeline_string = always_local_no_default;
+
+ buffer_local_flags.keymap = resettable;
+ buffer_local_flags.downcase_table = resettable;
+ buffer_local_flags.upcase_table = resettable;
+ buffer_local_flags.case_canon_table = resettable;
+ buffer_local_flags.case_eqv_table = resettable;
+ buffer_local_flags.syntax_table = resettable;
+#ifdef MULE
+ buffer_local_flags.category_table = resettable;
+#endif
+
+ buffer_local_flags.modeline_format = make_int (1);
+ buffer_local_flags.abbrev_mode = make_int (2);
+ buffer_local_flags.overwrite_mode = make_int (4);
+ buffer_local_flags.case_fold_search = make_int (8);
+ buffer_local_flags.auto_fill_function = make_int (0x10);
+ buffer_local_flags.selective_display = make_int (0x20);
+ buffer_local_flags.selective_display_ellipses = make_int (0x40);
+ buffer_local_flags.tab_width = make_int (0x80);
+ buffer_local_flags.truncate_lines = make_int (0x100);
+ buffer_local_flags.ctl_arrow = make_int (0x200);
+ buffer_local_flags.fill_column = make_int (0x400);
+ buffer_local_flags.left_margin = make_int (0x800);
+ buffer_local_flags.abbrev_table = make_int (0x1000);
+#ifdef REGION_CACHE_NEEDS_WORK
+ buffer_local_flags.cache_long_line_scans = make_int (0x2000);
+#endif
+#ifdef FILE_CODING
+ buffer_local_flags.buffer_file_coding_system = make_int (0x4000);
+#endif
+
+ /* #### Warning, 0x4000000 (that's six zeroes) is the largest number
+ currently allowable due to the XINT() handling of this value.
+ With some rearrangement you can get 4 more bits. */
+ }
+
+ DEFVAR_BUFFER_DEFAULTS ("default-modeline-format", modeline_format /*
+Default value of `modeline-format' for buffers that don't override it.
+This is the same as (default-value 'modeline-format).
+*/ );
+
+ DEFVAR_BUFFER_DEFAULTS ("default-abbrev-mode", abbrev_mode /*
+Default value of `abbrev-mode' for buffers that do not override it.
+This is the same as (default-value 'abbrev-mode).
+*/ );
+
+ DEFVAR_BUFFER_DEFAULTS ("default-ctl-arrow", ctl_arrow /*
+Default value of `ctl-arrow' for buffers that do not override it.
+This is the same as (default-value 'ctl-arrow).
+*/ );
+
+#if 0 /* #### make this a specifier! */
+ DEFVAR_BUFFER_DEFAULTS ("default-display-direction", display_direction /*
+Default display-direction for buffers that do not override it.
+This is the same as (default-value 'display-direction).
+Note: This is not yet implemented.
+*/ );
+#endif
+
+ DEFVAR_BUFFER_DEFAULTS ("default-truncate-lines", truncate_lines /*
+Default value of `truncate-lines' for buffers that do not override it.
+This is the same as (default-value 'truncate-lines).
+*/ );
+
+ DEFVAR_BUFFER_DEFAULTS ("default-fill-column", fill_column /*
+Default value of `fill-column' for buffers that do not override it.
+This is the same as (default-value 'fill-column).
+*/ );
+
+ DEFVAR_BUFFER_DEFAULTS ("default-left-margin", left_margin /*
+Default value of `left-margin' for buffers that do not override it.
+This is the same as (default-value 'left-margin).
+*/ );
+
+ DEFVAR_BUFFER_DEFAULTS ("default-tab-width", tab_width /*
+Default value of `tab-width' for buffers that do not override it.
+This is the same as (default-value 'tab-width).
+*/ );
+
+ DEFVAR_BUFFER_DEFAULTS ("default-case-fold-search", case_fold_search /*
+Default value of `case-fold-search' for buffers that don't override it.
+This is the same as (default-value 'case-fold-search).
+*/ );
+
+ DEFVAR_BUFFER_LOCAL ("modeline-format", modeline_format /*
+Template for displaying modeline for current buffer.
+Each buffer has its own value of this variable.
+Value may be a string, a symbol or a list or cons cell.
+For a symbol, its value is used (but it is ignored if t or nil).
+ A string appearing directly as the value of a symbol is processed verbatim
+ in that the %-constructs below are not recognized.
+For a glyph, it is inserted as is.
+For a list whose car is a symbol, the symbol's value is taken,
+ and if that is non-nil, the cadr of the list is processed recursively.
+ Otherwise, the caddr of the list (if there is one) is processed.
+For a list whose car is a string or list, each element is processed
+ recursively and the results are effectively concatenated.
+For a list whose car is an integer, the cdr of the list is processed
+ and padded (if the number is positive) or truncated (if negative)
+ to the width specified by that number.
+For a list whose car is an extent, the cdr of the list is processed
+ normally but the results are displayed using the face of the
+ extent, and mouse clicks over this section are processed using the
+ keymap of the extent. (In addition, if the extent has a help-echo
+ property, that string will be echoed when the mouse moves over this
+ section.) See `generated-modeline-string' for more information.
+For a list whose car is a face, the cdr of the list is processed
+ normally but the results will be displayed using the face in the car.
+For a list whose car is a keymap, the cdr of the list is processed
+ normally but the keymap will apply for mouse clicks over the results,
+ in addition to `modeline-map'. Nested keymap specifications are
+ handled properly.
+A string is printed verbatim in the modeline except for %-constructs:
+ (%-constructs are processed when the string is the entire modeline-format
+ or when it is found in a cons-cell or a list)
+ %b -- print buffer name. %c -- print the current column number.
+ %f -- print visited file name.
+ %* -- print %, * or hyphen. %+ -- print *, % or hyphen.
+ % means buffer is read-only and * means it is modified.
+ For a modified read-only buffer, %* gives % and %+ gives *.
+ %s -- print process status. %l -- print the current line number.
+ %S -- print name of selected frame (only meaningful under X Windows).
+ %p -- print percent of buffer above top of window, or Top, Bot or All.
+ %P -- print percent of buffer above bottom of window, perhaps plus Top,
+ or print Bottom or All.
+ %n -- print Narrow if appropriate.
+ %C -- under XEmacs/mule, print the mnemonic for `buffer-file-coding-system'.
+ %[ -- print one [ for each recursive editing level. %] similar.
+ %% -- print %. %- -- print infinitely many dashes.
+Decimal digits after the % specify field width to which to pad.
+*/ );
+
+ DEFVAR_BUFFER_DEFAULTS ("default-major-mode", major_mode /*
+*Major mode for new buffers. Defaults to `fundamental-mode'.
+nil here means use current buffer's major mode.
+*/ );
+
+ DEFVAR_BUFFER_DEFAULTS ("fundamental-mode-abbrev-table", abbrev_table /*
+The abbrev table of mode-specific abbrevs for Fundamental Mode.
+*/ );
+
+ DEFVAR_BUFFER_LOCAL ("major-mode", major_mode /*
+Symbol for current buffer's major mode.
+*/ );
+
+ DEFVAR_BUFFER_LOCAL ("mode-name", mode_name /*
+Pretty name of current buffer's major mode (a string).
+*/ );
+
+ DEFVAR_BUFFER_LOCAL ("abbrev-mode", abbrev_mode /*
+Non-nil turns on automatic expansion of abbrevs as they are inserted.
+Automatically becomes buffer-local when set in any fashion.
+*/ );
+
+ DEFVAR_BUFFER_LOCAL ("case-fold-search", case_fold_search /*
+*Non-nil if searches should ignore case.
+Automatically becomes buffer-local when set in any fashion.
+
+BUG: Under XEmacs/Mule, translations to or from non-ASCII characters
+ (this includes chars in the range 128 - 255) are ignored by
+ the string/buffer-searching routines. Thus, `case-fold-search'
+ will not correctly conflate a-umlaut and A-umlaut even if the
+ case tables call for this.
+*/ );
+
+ DEFVAR_BUFFER_LOCAL ("fill-column", fill_column /*
+*Column beyond which automatic line-wrapping should happen.
+Automatically becomes buffer-local when set in any fashion.
+*/ );
+
+ DEFVAR_BUFFER_LOCAL ("left-margin", left_margin /*
+*Column for the default indent-line-function to indent to.
+Linefeed indents to this column in Fundamental mode.
+Automatically becomes buffer-local when set in any fashion.
+Do not confuse this with the specifier `left-margin-width';
+that controls the size of a margin that is displayed outside
+of the text area.
+*/ );
+
+ DEFVAR_BUFFER_LOCAL_MAGIC ("tab-width", tab_width /*
+*Distance between tab stops (for display of tab characters), in columns.
+Automatically becomes buffer-local when set in any fashion.
+*/ , redisplay_variable_changed);
+
+ DEFVAR_BUFFER_LOCAL_MAGIC ("ctl-arrow", ctl_arrow /*
+*Non-nil means display control chars with uparrow.
+Nil means use backslash and octal digits.
+An integer means characters >= ctl-arrow are assumed to be printable, and
+will be displayed as a single glyph.
+Any other value is the same as 160 - the code SPC with the high bit on.
+
+The interpretation of this variable is likely to change in the future.
+
+Automatically becomes buffer-local when set in any fashion.
+This variable does not apply to characters whose display is specified
+in the current display table (if there is one).
+*/ , redisplay_variable_changed);
+
+#if 0 /* #### Make this a specifier! */
+ xxDEFVAR_BUFFER_LOCAL ("display-direction", display_direction /*
+*Non-nil means lines in the buffer are displayed right to left.
+Nil means left to right. (Not yet implemented.)
+*/ );
+#endif /* Not yet implemented */
+
+ DEFVAR_BUFFER_LOCAL_MAGIC ("truncate-lines", truncate_lines /*
+*Non-nil means do not display continuation lines;
+give each line of text one frame line.
+Automatically becomes buffer-local when set in any fashion.
+
+Note that this is overridden by the variable
+`truncate-partial-width-windows' if that variable is non-nil
+and this buffer is not full-frame width.
+*/ , redisplay_variable_changed);
+
+ DEFVAR_BUFFER_LOCAL ("default-directory", directory /*
+Name of default directory of current buffer. Should end with slash.
+Each buffer has its own value of this variable.
+*/ );
+
+#ifdef FILE_CODING
+ DEFVAR_BUFFER_DEFAULTS ("default-buffer-file-coding-system", buffer_file_coding_system /*
+Default value of `buffer-file-coding-system' for buffers that do not override it.
+This is the same as (default-value 'buffer-file-coding-system).
+This value is used both for buffers without associated files and
+for buffers whose files do not have any apparent coding system.
+See `buffer-file-coding-system'.
+*/ );
+
+ DEFVAR_BUFFER_LOCAL ("buffer-file-coding-system", buffer_file_coding_system /*
+*Current coding system for the current buffer.
+When the buffer is written out into a file, this coding system will be
+used for the encoding. Automatically buffer-local when set in any
+fashion. This is normally set automatically when a file is loaded in
+based on the determined coding system of the file (assuming that
+`buffer-file-coding-system-for-read' is set to `undecided', which
+calls for automatic determination of the file's coding system).
+Normally the modeline indicates the current file coding system using
+its mnemonic abbreviation.
+
+The default value for this variable (which is normally used for
+buffers without associated files) is also used when automatic
+detection of a file's encoding is called for and there was no
+discernable encoding in the file (i.e. it was entirely or almost
+entirely ASCII). The default value should generally *not* be set to
+nil (equivalent to `no-conversion'), because if extended characters
+are ever inserted into the buffer, they will be lost when the file is
+written out. A good choice is `iso-2022-8' (the simple ISO 2022 8-bit
+encoding), which will write out ASCII and Latin-1 characters in the
+standard (and highly portable) fashion and use standard escape
+sequences for other charsets. Another reasonable choice is
+`escape-quoted', which is equivalent to `iso-2022-8' but prefixes
+certain control characters with ESC to make sure they are not
+interpreted as escape sequences when read in. This latter coding
+system results in more "correct" output in the presence of control
+characters in the buffer, in the sense that when read in again using
+the same coding system, the result will virtually always match the
+original contents of the buffer, which is not the case with
+`iso-2022-8'; but the output is less portable when dealing with binary
+data -- there may be stray ESC characters when the file is read by
+another program.
+
+`buffer-file-coding-system' does *not* control the coding system used when
+a file is read in. Use the variables `buffer-file-coding-system-for-read'
+and `buffer-file-coding-system-alist' for that. From a Lisp program, if
+you wish to unilaterally specify the coding system used for one
+particular operation, you should bind the variable
+`coding-system-for-read' rather than changing the other two
+variables just mentioned, which are intended to be used for
+global environment specification.
+*/ );
+#endif
+
+ DEFVAR_BUFFER_LOCAL ("auto-fill-function", auto_fill_function /*
+Function called (if non-nil) to perform auto-fill.
+It is called after self-inserting a space at a column beyond `fill-column'.
+Each buffer has its own value of this variable.
+NOTE: This variable is not an ordinary hook;
+It may not be a list of functions.
+*/ );
+
+ DEFVAR_BUFFER_LOCAL ("buffer-file-name", filename /*
+Name of file visited in current buffer, or nil if not visiting a file.
+Each buffer has its own value of this variable.
+*/ );
+
+#if 0 /* FSFmacs */
+/*
+Abbreviated truename of file visited in current buffer, or nil if none.
+The truename of a file is calculated by `file-truename'
+and then abbreviated with `abbreviate-file-name'.
+Each buffer has its own value of this variable.
+*/
+#endif /* FSFmacs */
+
+ DEFVAR_BUFFER_LOCAL ("buffer-file-truename", file_truename /*
+The real name of the file visited in the current buffer,
+or nil if not visiting a file. This is the result of passing
+buffer-file-name to the `file-truename' function. Every buffer has
+its own value of this variable. This variable is automatically
+maintained by the functions that change the file name associated
+with a buffer.
+*/ );
+
+ DEFVAR_BUFFER_LOCAL ("buffer-auto-save-file-name", auto_save_file_name /*
+Name of file for auto-saving current buffer,
+or nil if buffer should not be auto-saved.
+Each buffer has its own value of this variable.
+*/ );
+
+ DEFVAR_BUFFER_LOCAL ("buffer-read-only", read_only /*
+Non-nil if this buffer is read-only.
+Each buffer has its own value of this variable.
+*/ );
+
+ DEFVAR_BUFFER_LOCAL ("buffer-backed-up", backed_up /*
+Non-nil if this buffer's file has been backed up.
+Backing up is done before the first time the file is saved.
+Each buffer has its own value of this variable.
+*/ );
+
+ DEFVAR_BUFFER_LOCAL ("buffer-saved-size", saved_size /*
+Length of current buffer when last read in, saved or auto-saved.
+0 initially.
+Each buffer has its own value of this variable.
+*/ );
+
+ DEFVAR_BUFFER_LOCAL_MAGIC ("selective-display", selective_display /*
+Non-nil enables selective display:
+Integer N as value means display only lines
+ that start with less than n columns of space.
+A value of t means, after a ^M, all the rest of the line is invisible.
+ Then ^M's in the file are written into files as newlines.
+
+Automatically becomes buffer-local when set in any fashion.
+*/, redisplay_variable_changed);
+
+#ifndef old
+ DEFVAR_BUFFER_LOCAL_MAGIC ("selective-display-ellipses",
+ selective_display_ellipses /*
+t means display ... on previous line when a line is invisible.
+Automatically becomes buffer-local when set in any fashion.
+*/, redisplay_variable_changed);
+#endif
+
+ DEFVAR_BUFFER_LOCAL ("local-abbrev-table", abbrev_table /*
+Local (mode-specific) abbrev table of current buffer.
+*/ );
+
+ DEFVAR_BUFFER_LOCAL ("overwrite-mode", overwrite_mode /*
+Non-nil if self-insertion should replace existing text.
+The value should be one of `overwrite-mode-textual',
+`overwrite-mode-binary', or nil.
+If it is `overwrite-mode-textual', self-insertion still
+inserts at the end of a line, and inserts when point is before a tab,
+until the tab is filled in.
+If `overwrite-mode-binary', self-insertion replaces newlines and tabs too.
+Automatically becomes buffer-local when set in any fashion.
+
+Normally, you shouldn't modify this variable by hand, but use the functions
+`overwrite-mode' and `binary-overwrite-mode' instead. However, you can
+customize the default value from the options menu.
+*/ );
+
+#if 0 /* FSFmacs */
+ /* Adds the following to the doc string for buffer-undo-list:
+
+An entry (nil PROPERTY VALUE BEG . END) indicates that a text property
+was modified between BEG and END. PROPERTY is the property name,
+and VALUE is the old value.
+*/
+#endif /* FSFmacs */
+
+ DEFVAR_BUFFER_LOCAL ("buffer-undo-list", undo_list /*
+List of undo entries in current buffer.
+Recent changes come first; older changes follow newer.
+
+An entry (BEG . END) represents an insertion which begins at
+position BEG and ends at position END.
+
+An entry (TEXT . POSITION) represents the deletion of the string TEXT
+from (abs POSITION). If POSITION is positive, point was at the front
+of the text being deleted; if negative, point was at the end.
+
+An entry (t HIGH . LOW) indicates that the buffer previously had
+"unmodified" status. HIGH and LOW are the high and low 16-bit portions
+of the visited file's modification time, as of that time. If the
+modification time of the most recent save is different, this entry is
+obsolete.
+
+An entry of the form EXTENT indicates that EXTENT was attached in
+the buffer. Undoing an entry of this form detaches EXTENT.
+
+An entry of the form (EXTENT START END) indicates that EXTENT was
+detached from the buffer. Undoing an entry of this form attaches
+EXTENT from START to END.
+
+An entry of the form POSITION indicates that point was at the buffer
+location given by the integer. Undoing an entry of this form places
+point at POSITION.
+
+nil marks undo boundaries. The undo command treats the changes
+between two undo boundaries as a single step to be undone.
+
+If the value of the variable is t, undo information is not recorded.
+*/ );
+
+#if 0 /* FSFmacs */
+ xxDEFVAR_BUFFER_LOCAL ("mark-active", mark_active /*
+Non-nil means the mark and region are currently active in this buffer.
+Automatically local in all buffers.
+*/ );
+#endif /* FSFmacs */
+
+#ifdef REGION_CACHE_NEEDS_WORK
+ xxDEFVAR_BUFFER_LOCAL ("cache-long-line-scans", cache_long_line_scans /*
+Non-nil means that Emacs should use caches to handle long lines more quickly.
+This variable is buffer-local, in all buffers.
+
+Normally, the line-motion functions work by scanning the buffer for
+newlines. Columnar operations (like move-to-column and
+compute-motion) also work by scanning the buffer, summing character
+widths as they go. This works well for ordinary text, but if the
+buffer's lines are very long (say, more than 500 characters), these
+motion functions will take longer to execute. Emacs may also take
+longer to update the display.
+
+If cache-long-line-scans is non-nil, these motion functions cache the
+results of their scans, and consult the cache to avoid rescanning
+regions of the buffer until the text is modified. The caches are most
+beneficial when they prevent the most searching---that is, when the
+buffer contains long lines and large regions of characters with the
+same, fixed screen width.
+
+When cache-long-line-scans is non-nil, processing short lines will
+become slightly slower (because of the overhead of consulting the
+cache), and the caches will use memory roughly proportional to the
+number of newlines and characters whose screen width varies.
+
+The caches require no explicit maintenance; their accuracy is
+maintained internally by the Emacs primitives. Enabling or disabling
+the cache should not affect the behavior of any of the motion
+functions; it should only affect their performance.
+*/ );
+#endif /* REGION_CACHE_NEEDS_WORK */
+
+ DEFVAR_BUFFER_LOCAL ("point-before-scroll", point_before_scroll /*
+Value of point before the last series of scroll operations, or nil.
+*/ );
+
+ DEFVAR_BUFFER_LOCAL ("buffer-file-format", file_format /*
+List of formats to use when saving this buffer.
+Formats are defined by `format-alist'. This variable is
+set when a file is visited. Automatically local in all buffers.
+*/ );
+
+ DEFVAR_BUFFER_LOCAL_MAGIC ("buffer-invisibility-spec", invisibility_spec /*
+Invisibility spec of this buffer.
+The default is t, which means that text is invisible
+if it has (or is covered by an extent with) a non-nil `invisible' property.
+If the value is a list, a text character is invisible if its `invisible'
+property is an element in that list.
+If an element is a cons cell of the form (PROP . ELLIPSIS),
+then characters with property value PROP are invisible,
+and they have an ellipsis as well if ELLIPSIS is non-nil.
+Note that the actual characters used for the ellipsis are controllable
+using `invisible-text-glyph', and default to "...".
+*/, redisplay_variable_changed);
+
+ DEFVAR_CONST_BUFFER_LOCAL ("generated-modeline-string",
+ generated_modeline_string /*
+String of characters in this buffer's modeline as of the last redisplay.
+Each time the modeline is recomputed, the resulting characters are
+stored in this string, which is resized as necessary. You may not
+set this variable, and modifying this string will not change the
+modeline; you have to change `modeline-format' if you want that.
+
+For each extent in `modeline-format' that is encountered when
+processing the modeline, a corresponding extent is placed in
+`generated-modeline-string' and covers the text over which the
+extent in `modeline-format' applies. The extent in
+`generated-modeline-string' is made a child of the extent in
+`modeline-format', which means that it inherits all properties from
+that extent. Note that the extents in `generated-modeline-string'
+are managed automatically. You should not explicitly put any extents
+in `generated-modeline-string'; if you do, they will disappear the
+next time the modeline is processed.
+
+For extents in `modeline-format', the following properties are currently
+handled:
+
+`face'
+ Affects the face of the modeline text. Currently, faces do
+ not merge properly; only the most recently encountered face
+ is used. This is a bug.
+
+`keymap'
+ Affects the disposition of button events over the modeline
+ text. Multiple applicable keymaps *are* handled properly,
+ and `modeline-map' still applies to any events that don't
+ have bindings in extent-specific keymaps.
+
+`help-echo'
+ If a string, causes the string to be displayed when the mouse
+ moves over the text.
+*/ );
+
+ /* Check for DEFVAR_BUFFER_LOCAL without initializing the corresponding
+ slot of buffer_local_flags and vice-versa. Must be done after all
+ DEFVAR_BUFFER_LOCAL() calls. */
+#define MARKED_SLOT(slot) \
+ if ((XINT (buffer_local_flags.slot) != -2 && \
+ XINT (buffer_local_flags.slot) != -3) \
+ != !(NILP (XBUFFER (Vbuffer_local_symbols)->slot))) \
+ abort ()
+#include "bufslots.h"
+#undef MARKED_SLOT
+
+ {
+ Lisp_Object scratch = Fget_buffer_create (QSscratch);
+ Fset_buffer (scratch);
+ /* Want no undo records for *scratch* until after Emacs is dumped */
+ Fbuffer_disable_undo (scratch);
+ }
+}
+
+void
+init_initial_directory (void)
+{
+ /* This function can GC */
+
+ char *pwd;
+ struct stat dotstat, pwdstat;
+ int rc;
+
+ 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")) != 0 && IS_DIRECTORY_SEP (*pwd)
+ && stat (pwd, &pwdstat) == 0
+ && stat (".", &dotstat) == 0
+ && dotstat.st_ino == pwdstat.st_ino
+ && dotstat.st_dev == pwdstat.st_dev
+ && (int) strlen (pwd) < MAXPATHLEN)
+ strcpy (initial_directory, pwd);
+ else if (getcwd (initial_directory, MAXPATHLEN) == NULL)
+ fatal ("`getcwd' failed: %s\n", strerror (errno));
+
+ /* Maybe this should really use some standard subroutine
+ whose definition is filename syntax dependent. */
+ rc = strlen (initial_directory);
+ if (!(IS_DIRECTORY_SEP (initial_directory[rc - 1])))
+ {
+ initial_directory[rc] = DIRECTORY_SEP;
+ initial_directory[rc + 1] = '\0';
+ }
+ /* XEmacs change: store buffer's default directory
+ using prefered (i.e. as defined at compile-time)
+ directory separator. --marcpa */
+#ifdef DOS_NT
+#define CORRECT_DIR_SEPS(s) \
+ do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
+ else unixtodos_filename (s); \
+ } while (0)
+
+ CORRECT_DIR_SEPS(initial_directory);
+#endif
+}
+
+void
+init_buffer (void)
+{
+ /* This function can GC */
+
+ Fset_buffer (Fget_buffer_create (QSscratch));
+
+ current_buffer->directory = build_string (initial_directory);
+
+#if 0 /* FSFmacs */
+ /* #### is this correct? */
+ temp = get_minibuffer (0);
+ XBUFFER (temp)->directory = current_buffer->directory;
+#endif /* FSFmacs */
+}
--- /dev/null
+/* Header file for the buffer manipulation primitives.
+ Copyright (C) 1985, 1986, 1992, 1993, 1994, 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: FSF 19.30. */
+
+/* Authorship:
+
+ FSF: long ago.
+ JWZ: separated out bufslots.h, early in Lemacs.
+ Ben Wing: almost completely rewritten for Mule, 19.12.
+ */
+
+#ifndef _XEMACS_BUFFER_H_
+#define _XEMACS_BUFFER_H_
+
+#ifdef MULE
+#include "mule-charset.h"
+#endif
+
+/************************************************************************/
+/* */
+/* definition of Lisp buffer object */
+/* */
+/************************************************************************/
+
+/* Note: we keep both Bytind and Bufpos versions of some of the
+ important buffer positions because they are accessed so much.
+ If we didn't do this, we would constantly be invalidating the
+ bufpos<->bytind cache under Mule.
+
+ Note that under non-Mule, both versions will always be the
+ same so we don't really need to keep track of them. But it
+ simplifies the logic to go ahead and do so all the time and
+ the memory loss is insignificant. */
+
+/* Formerly, it didn't much matter what went inside the struct buffer_text
+ and what went outside it. Now it does, with the advent of "indirect
+ buffers" that share text with another buffer. An indirect buffer
+ shares the same *text* as another buffer, but has its own buffer-local
+ variables, its own accessible region, and its own markers and extents.
+ (Due to the nature of markers, it doesn't actually matter much whether
+ we stick them inside or out of the struct buffer_text -- the user won't
+ notice any difference -- but we go ahead and put them outside for
+ consistency and overall saneness of algorithm.)
+
+ FSFmacs gets away with not maintaining any "children" pointers from
+ a buffer to the indirect buffers that refer to it by putting the
+ markers inside of the struct buffer_text, using markers to keep track
+ of BEGV and ZV in indirect buffers, and relying on the fact that
+ all intervals (text properties and overlays) use markers for their
+ start and end points. We don't do this for extents (markers are
+ inefficient anyway and take up space), so we have to maintain
+ children pointers. This is not terribly hard, though, and the
+ code to maintain this is just like the code already present in
+ extent-parent and extent-children.
+ */
+
+struct buffer_text
+{
+ Bufbyte *beg; /* Actual address of buffer contents. */
+ Bytind gpt; /* Index of gap in buffer. */
+ Bytind z; /* Index of end of buffer. */
+ Bufpos bufz; /* Equivalent as a Bufpos. */
+ int gap_size; /* Size of buffer's gap */
+ int end_gap_size; /* Size of buffer's end gap */
+ long modiff; /* This counts buffer-modification events
+ for this buffer. It is incremented for
+ each such event, and never otherwise
+ changed. */
+ long save_modiff; /* Previous value of modiff, as of last
+ time buffer visited or saved a file. */
+
+#ifdef MULE
+ /* We keep track of a "known" region for very fast access.
+ This information is text-only so it goes here. */
+ Bufpos mule_bufmin, mule_bufmax;
+ Bytind mule_bytmin, mule_bytmax;
+ int mule_shifter, mule_three_p;
+
+ /* And we also cache 16 positions for fairly fast access near those
+ positions. */
+ Bufpos mule_bufpos_cache[16];
+ Bytind mule_bytind_cache[16];
+#endif
+
+ /* Change data that goes with the text. */
+ struct buffer_text_change_data *changes;
+
+};
+
+struct buffer
+{
+ struct lcrecord_header header;
+
+ /* This structure holds the coordinates of the buffer contents
+ in ordinary buffers. In indirect buffers, this is not used. */
+ struct buffer_text own_text;
+
+ /* This points to the `struct buffer_text' that is used for this buffer.
+ In an ordinary buffer, this is the own_text field above.
+ In an indirect buffer, this is the own_text field of another buffer. */
+ struct buffer_text *text;
+
+ Bytind pt; /* Position of point in buffer. */
+ Bufpos bufpt; /* Equivalent as a Bufpos. */
+ Bytind begv; /* Index of beginning of accessible range. */
+ Bufpos bufbegv; /* Equivalent as a Bufpos. */
+ Bytind zv; /* Index of end of accessible range. */
+ Bufpos bufzv; /* Equivalent as a Bufpos. */
+
+ int face_change; /* This is set when a change in how the text should
+ be displayed (e.g., font, color) is made. */
+
+ /* change data indicating what portion of the text has changed
+ since the last time this was reset. Used by redisplay.
+ Logically we should keep this with the text structure, but
+ redisplay resets it for each buffer individually and we don't
+ want interference between an indirect buffer and its base
+ buffer. */
+ struct each_buffer_change_data *changes;
+
+#ifdef REGION_CACHE_NEEDS_WORK
+ /* If the long line scan cache is enabled (i.e. the buffer-local
+ variable cache-long-line-scans is non-nil), newline_cache
+ points to the newline cache, and width_run_cache points to the
+ width run cache.
+
+ The newline cache records which stretches of the buffer are
+ known *not* to contain newlines, so that they can be skipped
+ quickly when we search for newlines.
+
+ The width run cache records which stretches of the buffer are
+ known to contain characters whose widths are all the same. If
+ the width run cache maps a character to a value > 0, that value
+ is the character's width; if it maps a character to zero, we
+ don't know what its width is. This allows compute_motion to
+ process such regions very quickly, using algebra instead of
+ inspecting each character. See also width_table, below. */
+ struct region_cache *newline_cache;
+ struct region_cache *width_run_cache;
+#endif /* REGION_CACHE_NEEDS_WORK */
+
+ /* 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;
+
+ /* The buffer's extent info. This is its own type, an extent-info
+ object (done this way for ease in marking / finalizing). */
+ Lisp_Object extent_info;
+
+ /* ----------------------------------------------------------------- */
+ /* All the stuff above this line is the responsibility of insdel.c,
+ with some help from marker.c and extents.c.
+ All the stuff below this line is the responsibility of buffer.c. */
+
+ /* In an indirect buffer, this points to the base buffer.
+ In an ordinary buffer, it is 0.
+ We DO mark through this slot. */
+ struct buffer *base_buffer;
+
+ /* List of indirect buffers whose base is this buffer.
+ If we are an indirect buffer, this will be nil.
+ Do NOT mark through this. */
+ Lisp_Object indirect_children;
+
+ /* Flags saying which DEFVAR_PER_BUFFER variables
+ are local to this buffer. */
+ int local_var_flags;
+
+ /* Set to the modtime of the visited file when read or written.
+ -1 means visited file was nonexistent.
+ 0 means visited file modtime unknown; in no case complain
+ about any mismatch on next save attempt. */
+ int modtime;
+
+ /* the value of text->modiff at the last auto-save. */
+ int auto_save_modified;
+
+ /* The time at which we detected a failure to auto-save,
+ Or -1 if we didn't have a failure. */
+ int auto_save_failure_time;
+
+ /* Position in buffer at which display started
+ the last time this buffer was displayed. */
+ int last_window_start;
+
+ /* Everything from here down must be a Lisp_Object */
+
+#define MARKED_SLOT(x) Lisp_Object x
+#include "bufslots.h"
+#undef MARKED_SLOT
+};
+
+DECLARE_LRECORD (buffer, struct buffer);
+#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)
+
+#define BUFFER_LIVE_P(b) (!NILP ((b)->name))
+
+#define CHECK_LIVE_BUFFER(x) do { \
+ CHECK_BUFFER (x); \
+ if (!BUFFER_LIVE_P (XBUFFER (x))) \
+ dead_wrong_type_argument (Qbuffer_live_p, (x)); \
+} while (0)
+
+#define CONCHECK_LIVE_BUFFER(x) do { \
+ CONCHECK_BUFFER (x); \
+ if (!BUFFER_LIVE_P (XBUFFER (x))) \
+ x = wrong_type_argument (Qbuffer_live_p, (x)); \
+} while (0)
+
+\f
+/* NOTE: In all the following macros, we follow these rules concerning
+ multiple evaluation of the arguments:
+
+ 1) Anything that's an lvalue can be evaluated more than once.
+ 2) Anything that's a Lisp Object can be evaluated more than once.
+ This should probably be changed, but this follows the way
+ that all the macros in lisp.h do things.
+ 3) 'struct buffer *' arguments can be evaluated more than once.
+ 4) Nothing else can be evaluated more than once. Use inline
+ functions, if necessary, to prevent multiple evaluation.
+ 5) An exception to (4) is that there are some macros below that
+ may evaluate their arguments more than once. They are all
+ denoted with the word "unsafe" in their name and are generally
+ meant to be called only by other macros that have already
+ stored the calling values in temporary variables.
+ */
+
+/************************************************************************/
+/* */
+/* working with raw internal-format data */
+/* */
+/************************************************************************/
+
+/* Use these on contiguous strings of data. If the text you're
+ operating on is known to come from a buffer, use the buffer-level
+ functions below -- they know about the gap and may be more
+ efficient. */
+
+/* Functions are as follows:
+
+
+ (A) For working with charptr's (pointers to internally-formatted text):
+ -----------------------------------------------------------------------
+
+ VALID_CHARPTR_P(ptr):
+ Given a charptr, does it point to the beginning of a character?
+
+ ASSERT_VALID_CHARPTR(ptr):
+ If error-checking is enabled, assert that the given charptr
+ points to the beginning of a character. Otherwise, do nothing.
+
+ INC_CHARPTR(ptr):
+ Given a charptr (assumed to point at the beginning of a character),
+ modify that pointer so it points to the beginning of the next
+ character.
+
+ DEC_CHARPTR(ptr):
+ Given a charptr (assumed to point at the beginning of a
+ character or at the very end of the text), modify that pointer
+ so it points to the beginning of the previous character.
+
+ VALIDATE_CHARPTR_BACKWARD(ptr):
+ Make sure that PTR is pointing to the beginning of a character.
+ If not, back up until this is the case. Note that there are not
+ too many places where it is legitimate to do this sort of thing.
+ It's an error if you're passed an "invalid" char * pointer.
+ NOTE: PTR *must* be pointing to a valid part of the string (i.e.
+ not the very end, unless the string is zero-terminated or
+ something) in order for this function to not cause crashes.
+
+ VALIDATE_CHARPTR_FORWARD(ptr):
+ Make sure that PTR is pointing to the beginning of a character.
+ If not, move forward until this is the case. Note that there
+ are not too many places where it is legitimate to do this sort
+ of thing. It's an error if you're passed an "invalid" char *
+ pointer.
+
+
+ (B) For working with the length (in bytes and characters) of a
+ section of internally-formatted text:
+ --------------------------------------------------------------
+
+ bytecount_to_charcount(ptr, nbi):
+ Given a pointer to a text string and a length in bytes,
+ return the equivalent length in characters.
+
+ charcount_to_bytecount(ptr, nch):
+ Given a pointer to a text string and a length in characters,
+ return the equivalent length in bytes.
+
+ charptr_n_addr(ptr, n):
+ Return a pointer to the beginning of the character offset N
+ (in characters) from PTR.
+
+ charptr_length(ptr):
+ Given a zero-terminated pointer to Emacs characters,
+ return the number of Emacs characters contained within.
+
+
+ (C) For retrieving or changing the character pointed to by a charptr:
+ ---------------------------------------------------------------------
+
+ charptr_emchar(ptr):
+ Retrieve the character pointed to by PTR as an Emchar.
+
+ charptr_emchar_n(ptr, n):
+ Retrieve the character at offset N (in characters) from PTR,
+ as an Emchar.
+
+ set_charptr_emchar(ptr, ch):
+ Store the character CH (an Emchar) as internally-formatted
+ text starting at PTR. Return the number of bytes stored.
+
+ charptr_copy_char(ptr, ptr2):
+ Retrieve the character pointed to by PTR and store it as
+ internally-formatted text in PTR2.
+
+
+ (D) For working with Emchars:
+ -----------------------------
+
+ [Note that there are other functions/macros for working with Emchars
+ in mule-charset.h, for retrieving the charset of an Emchar
+ and such. These are only valid when MULE is defined.]
+
+ valid_char_p(ch):
+ Return whether the given Emchar is valid.
+
+ CHARP(ch):
+ Return whether the given Lisp_Object is a valid character.
+ This is approximately the same as saying the Lisp_Object is
+ an int whose value is a valid Emchar. (But not exactly
+ because when MULE is not defined, we allow arbitrary values
+ in all but the lowest 8 bits and mask them off, for backward
+ compatibility.)
+
+ CHECK_CHAR_COERCE_INT(ch):
+ Signal an error if CH is not a valid character as per CHARP().
+ Also canonicalize the value into a valid Emchar, as necessary.
+ (This only means anything when MULE is not defined.)
+
+ COERCE_CHAR(ch):
+ Coerce an object that is known to satisfy CHARP() into a
+ valid Emchar.
+
+ MAX_EMCHAR_LEN:
+ Maximum number of buffer bytes per Emacs character.
+
+*/
+
+
+/* ---------------------------------------------------------------------- */
+/* (A) For working with charptr's (pointers to internally-formatted text) */
+/* ---------------------------------------------------------------------- */
+
+#ifdef MULE
+# define VALID_CHARPTR_P(ptr) BUFBYTE_FIRST_BYTE_P (* (unsigned char *) ptr)
+#else
+# define VALID_CHARPTR_P(ptr) 1
+#endif
+
+#ifdef ERROR_CHECK_BUFPOS
+# define ASSERT_VALID_CHARPTR(ptr) assert (VALID_CHARPTR_P (ptr))
+#else
+# define ASSERT_VALID_CHARPTR(ptr)
+#endif
+
+/* Note that INC_CHARPTR() and DEC_CHARPTR() have to be written in
+ completely separate ways. INC_CHARPTR() cannot use the DEC_CHARPTR()
+ trick of looking for a valid first byte because it might run off
+ the end of the string. DEC_CHARPTR() can't use the INC_CHARPTR()
+ method because it doesn't have easy access to the first byte of
+ the character it's moving over. */
+
+#define real_inc_charptr_fun(ptr) \
+ ((ptr) += REP_BYTES_BY_FIRST_BYTE (* (unsigned char *) (ptr)))
+#ifdef ERROR_CHECK_BUFPOS
+#define inc_charptr_fun(ptr) (ASSERT_VALID_CHARPTR (ptr), \
+ real_inc_charptr_fun (ptr))
+#else
+#define inc_charptr_fun(ptr) real_inc_charptr_fun (ptr)
+#endif
+
+#define REAL_INC_CHARPTR(ptr) ((void) (real_inc_charptr_fun (ptr)))
+
+#define INC_CHARPTR(ptr) do { \
+ ASSERT_VALID_CHARPTR (ptr); \
+ REAL_INC_CHARPTR (ptr); \
+} while (0)
+
+#define REAL_DEC_CHARPTR(ptr) do { \
+ (ptr)--; \
+} while (!VALID_CHARPTR_P (ptr))
+
+#ifdef ERROR_CHECK_BUFPOS
+#define DEC_CHARPTR(ptr) do { \
+ CONST Bufbyte *__dcptr__ = (ptr); \
+ CONST Bufbyte *__dcptr2__ = __dcptr__; \
+ REAL_DEC_CHARPTR (__dcptr2__); \
+ assert (__dcptr__ - __dcptr2__ == \
+ REP_BYTES_BY_FIRST_BYTE (*__dcptr2__)); \
+ (ptr) = __dcptr2__; \
+} while (0)
+#else
+#define DEC_CHARPTR(ptr) REAL_DEC_CHARPTR (ptr)
+#endif
+
+#ifdef MULE
+
+#define VALIDATE_CHARPTR_BACKWARD(ptr) do { \
+ while (!VALID_CHARPTR_P (ptr)) ptr--; \
+} while (0)
+
+/* This needs to be trickier to avoid the possibility of running off
+ the end of the string. */
+
+#define VALIDATE_CHARPTR_FORWARD(ptr) do { \
+ Bufbyte *__vcfptr__ = (ptr); \
+ VALIDATE_CHARPTR_BACKWARD (__vcfptr__); \
+ if (__vcfptr__ != (ptr)) \
+ { \
+ (ptr) = __vcfptr__; \
+ INC_CHARPTR (ptr); \
+ } \
+} while (0)
+
+#else /* not MULE */
+#define VALIDATE_CHARPTR_BACKWARD(ptr)
+#define VALIDATE_CHARPTR_FORWARD(ptr)
+#endif /* not MULE */
+
+/* -------------------------------------------------------------- */
+/* (B) For working with the length (in bytes and characters) of a */
+/* 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)
+{
+ return ptr + charcount_to_bytecount (ptr, offset);
+}
+
+INLINE Charcount charptr_length (CONST Bufbyte *ptr);
+INLINE Charcount
+charptr_length (CONST Bufbyte *ptr)
+{
+ return bytecount_to_charcount (ptr, strlen ((CONST char *) ptr));
+}
+
+
+/* -------------------------------------------------------------------- */
+/* (C) For retrieving or changing the character pointed to by a charptr */
+/* -------------------------------------------------------------------- */
+
+#define simple_charptr_emchar(ptr) ((Emchar) (ptr)[0])
+#define simple_set_charptr_emchar(ptr, x) ((ptr)[0] = (Bufbyte) (x), 1)
+#define simple_charptr_copy_char(ptr, ptr2) ((ptr2)[0] = *(ptr), 1)
+
+#ifdef MULE
+
+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);
+
+INLINE Emchar charptr_emchar (CONST Bufbyte *ptr);
+INLINE Emchar
+charptr_emchar (CONST Bufbyte *ptr)
+{
+ return BYTE_ASCII_P (*ptr) ?
+ simple_charptr_emchar (ptr) :
+ non_ascii_charptr_emchar (ptr);
+}
+
+INLINE Bytecount set_charptr_emchar (Bufbyte *ptr, Emchar x);
+INLINE Bytecount
+set_charptr_emchar (Bufbyte *ptr, Emchar x)
+{
+ return !CHAR_MULTIBYTE_P (x) ?
+ simple_set_charptr_emchar (ptr, x) :
+ 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)
+{
+ return BYTE_ASCII_P (*ptr) ?
+ simple_charptr_copy_char (ptr, ptr2) :
+ non_ascii_charptr_copy_char (ptr, ptr2);
+}
+
+#else /* not MULE */
+
+# define charptr_emchar(ptr) simple_charptr_emchar (ptr)
+# define set_charptr_emchar(ptr, x) simple_set_charptr_emchar (ptr, x)
+# define charptr_copy_char(ptr, ptr2) simple_charptr_copy_char (ptr, ptr2)
+
+#endif /* not MULE */
+
+#define charptr_emchar_n(ptr, offset) \
+ charptr_emchar (charptr_n_addr (ptr, offset))
+
+
+/* ---------------------------- */
+/* (D) For working with Emchars */
+/* ---------------------------- */
+
+#ifdef MULE
+
+int non_ascii_valid_char_p (Emchar ch);
+
+INLINE int valid_char_p (Emchar ch);
+INLINE int
+valid_char_p (Emchar ch)
+{
+ return (ch >= 0 && ch <= 255) || non_ascii_valid_char_p (ch);
+}
+
+#else /* not MULE */
+
+#define valid_char_p(ch) ((unsigned int) (ch) <= 255)
+
+#endif /* not MULE */
+
+#define CHAR_INTP(x) (INTP (x) && valid_char_p (XINT (x)))
+
+#define CHAR_OR_CHAR_INTP(x) (CHARP (x) || CHAR_INTP (x))
+
+#ifdef ERROR_CHECK_TYPECHECK
+
+INLINE Emchar XCHAR_OR_CHAR_INT (Lisp_Object obj);
+INLINE Emchar
+XCHAR_OR_CHAR_INT (Lisp_Object obj)
+{
+ assert (CHAR_OR_CHAR_INTP (obj));
+ return CHARP (obj) ? XCHAR (obj) : XINT (obj);
+}
+
+#else
+
+#define XCHAR_OR_CHAR_INT(obj) (CHARP ((obj)) ? XCHAR ((obj)) : XINT ((obj)))
+
+#endif
+
+#define CHECK_CHAR_COERCE_INT(x) do { \
+ if (CHARP (x)) \
+ ; \
+ else if (CHAR_INTP (x)) \
+ x = make_char (XINT (x)); \
+ else \
+ x = wrong_type_argument (Qcharacterp, x); \
+} while (0)
+
+#ifdef MULE
+# define MAX_EMCHAR_LEN 4
+#else
+# define MAX_EMCHAR_LEN 1
+#endif
+
+\f
+/*----------------------------------------------------------------------*/
+/* Accessor macros for important positions in a buffer */
+/*----------------------------------------------------------------------*/
+
+/* We put them here because some stuff below wants them before the
+ place where we would normally put them. */
+
+/* None of these are lvalues. Use the settor macros below to change
+ the positions. */
+
+/* Beginning of buffer. */
+#define BI_BUF_BEG(buf) ((Bytind) 1)
+#define BUF_BEG(buf) ((Bufpos) 1)
+
+/* Beginning of accessible range of buffer. */
+#define BI_BUF_BEGV(buf) ((buf)->begv + 0)
+#define BUF_BEGV(buf) ((buf)->bufbegv + 0)
+
+/* End of accessible range of buffer. */
+#define BI_BUF_ZV(buf) ((buf)->zv + 0)
+#define BUF_ZV(buf) ((buf)->bufzv + 0)
+
+/* End of buffer. */
+#define BI_BUF_Z(buf) ((buf)->text->z + 0)
+#define BUF_Z(buf) ((buf)->text->bufz + 0)
+
+/* Point. */
+#define BI_BUF_PT(buf) ((buf)->pt + 0)
+#define BUF_PT(buf) ((buf)->bufpt + 0)
+
+/*----------------------------------------------------------------------*/
+/* Converting between positions and addresses */
+/*----------------------------------------------------------------------*/
+
+/* Convert the address of a byte in the buffer into a position. */
+INLINE Bytind BI_BUF_PTR_BYTE_POS (struct buffer *buf, Bufbyte *ptr);
+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));
+}
+
+#define BUF_PTR_BYTE_POS(buf, ptr) \
+ bytind_to_bufpos (buf, BI_BUF_PTR_BYTE_POS (buf, ptr))
+
+/* Address of byte at position POS in buffer. */
+INLINE Bufbyte * BI_BUF_BYTE_ADDRESS (struct buffer *buf, Bytind pos);
+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)
+ - 1));
+}
+
+#define BUF_BYTE_ADDRESS(buf, pos) \
+ BI_BUF_BYTE_ADDRESS (buf, bufpos_to_bytind (buf, pos))
+
+/* Address of byte before position POS in buffer. */
+INLINE Bufbyte * BI_BUF_BYTE_ADDRESS_BEFORE (struct buffer *buf, Bytind pos);
+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)
+ - 2));
+}
+
+#define BUF_BYTE_ADDRESS_BEFORE(buf, pos) \
+ BI_BUF_BYTE_ADDRESS_BEFORE (buf, bufpos_to_bytind (buf, pos))
+
+/*----------------------------------------------------------------------*/
+/* Converting between byte indices and memory indices */
+/*----------------------------------------------------------------------*/
+
+INLINE int valid_memind_p (struct buffer *buf, Memind x);
+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)));
+}
+
+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);
+}
+
+
+INLINE Bytind memind_to_bytind (struct buffer *buf, Memind x);
+INLINE Bytind
+memind_to_bytind (struct buffer *buf, Memind x)
+{
+#ifdef ERROR_CHECK_BUFPOS
+ assert (valid_memind_p (buf, x));
+#endif
+ return (Bytind) ((x > (Memind) (buf)->text->gpt) ?
+ x - (buf)->text->gap_size :
+ x);
+}
+
+#define memind_to_bufpos(buf, x) \
+ bytind_to_bufpos (buf, memind_to_bytind (buf, x))
+#define bufpos_to_memind(buf, x) \
+ bytind_to_memind (buf, bufpos_to_bytind (buf, x))
+
+/* These macros generalize many standard buffer-position functions to
+ either a buffer or a string. */
+
+/* Converting between Meminds and Bytinds, for a buffer-or-string.
+ For strings, this is a no-op. For buffers, this resolves
+ to the standard memind<->bytind converters. */
+
+#define buffer_or_string_bytind_to_memind(obj, ind) \
+ (BUFFERP (obj) ? bytind_to_memind (XBUFFER (obj), ind) : (Memind) ind)
+
+#define buffer_or_string_memind_to_bytind(obj, ind) \
+ (BUFFERP (obj) ? memind_to_bytind (XBUFFER (obj), ind) : (Bytind) ind)
+
+/* Converting between Bufpos's and Bytinds, for a buffer-or-string.
+ For strings, this maps to the bytecount<->charcount converters. */
+
+#define buffer_or_string_bufpos_to_bytind(obj, pos) \
+ (BUFFERP (obj) ? bufpos_to_bytind (XBUFFER (obj), pos) : \
+ (Bytind) charcount_to_bytecount (XSTRING_DATA (obj), pos))
+
+#define buffer_or_string_bytind_to_bufpos(obj, ind) \
+ (BUFFERP (obj) ? bytind_to_bufpos (XBUFFER (obj), ind) : \
+ (Bufpos) bytecount_to_charcount (XSTRING_DATA (obj), ind))
+
+/* Similar for Bufpos's and Meminds. */
+
+#define buffer_or_string_bufpos_to_memind(obj, pos) \
+ (BUFFERP (obj) ? bufpos_to_memind (XBUFFER (obj), pos) : \
+ (Memind) charcount_to_bytecount (XSTRING_DATA (obj), pos))
+
+#define buffer_or_string_memind_to_bufpos(obj, ind) \
+ (BUFFERP (obj) ? memind_to_bufpos (XBUFFER (obj), ind) : \
+ (Bufpos) bytecount_to_charcount (XSTRING_DATA (obj), ind))
+
+/************************************************************************/
+/* */
+/* working with buffer-level data */
+/* */
+/************************************************************************/
+
+/*
+
+ (A) Working with byte indices:
+ ------------------------------
+
+ VALID_BYTIND_P(buf, bi):
+ Given a byte index, does it point to the beginning of a character?
+
+ ASSERT_VALID_BYTIND_UNSAFE(buf, bi):
+ If error-checking is enabled, assert that the given byte index
+ is within range and points to the beginning of a character
+ or to the end of the buffer. Otherwise, do nothing.
+
+ ASSERT_VALID_BYTIND_BACKWARD_UNSAFE(buf, bi):
+ If error-checking is enabled, assert that the given byte index
+ is within range and satisfies ASSERT_VALID_BYTIND() and also
+ does not refer to the beginning of the buffer. (i.e. movement
+ backwards is OK.) Otherwise, do nothing.
+
+ ASSERT_VALID_BYTIND_FORWARD_UNSAFE(buf, bi):
+ If error-checking is enabled, assert that the given byte index
+ is within range and satisfies ASSERT_VALID_BYTIND() and also
+ does not refer to the end of the buffer. (i.e. movement
+ forwards is OK.) Otherwise, do nothing.
+
+ VALIDATE_BYTIND_BACKWARD(buf, bi):
+ Make sure that the given byte index is pointing to the beginning
+ of a character. If not, back up until this is the case. Note
+ that there are not too many places where it is legitimate to do
+ this sort of thing. It's an error if you're passed an "invalid"
+ byte index.
+
+ VALIDATE_BYTIND_FORWARD(buf, bi):
+ Make sure that the given byte index is pointing to the beginning
+ of a character. If not, move forward until this is the case.
+ Note that there are not too many places where it is legitimate
+ to do this sort of thing. It's an error if you're passed an
+ "invalid" byte index.
+
+ INC_BYTIND(buf, bi):
+ Given a byte index (assumed to point at the beginning of a
+ character), modify that value so it points to the beginning
+ of the next character.
+
+ DEC_BYTIND(buf, bi):
+ Given a byte index (assumed to point at the beginning of a
+ character), modify that value so it points to the beginning
+ of the previous character. Unlike for DEC_CHARPTR(), we can
+ do all the assert()s because there are sentinels at the
+ beginning of the gap and the end of the buffer.
+
+ BYTIND_INVALID:
+ A constant representing an invalid Bytind. Valid Bytinds
+ can never have this value.
+
+
+ (B) Converting between Bufpos's and Bytinds:
+ --------------------------------------------
+
+ bufpos_to_bytind(buf, bu):
+ Given a Bufpos, return the equivalent Bytind.
+
+ bytind_to_bufpos(buf, bi):
+ Given a Bytind, return the equivalent Bufpos.
+
+ make_bufpos(buf, bi):
+ Given a Bytind, return the equivalent Bufpos as a Lisp Object.
+ */
+
+
+/*----------------------------------------------------------------------*/
+/* working with byte indices */
+/*----------------------------------------------------------------------*/
+
+#ifdef MULE
+# define VALID_BYTIND_P(buf, x) \
+ BUFBYTE_FIRST_BYTE_P (*BI_BUF_BYTE_ADDRESS (buf, x))
+#else
+# define VALID_BYTIND_P(buf, x) 1
+#endif
+
+#ifdef ERROR_CHECK_BUFPOS
+
+# define ASSERT_VALID_BYTIND_UNSAFE(buf, x) do { \
+ assert (BUFFER_LIVE_P (buf)); \
+ assert ((x) >= BI_BUF_BEG (buf) && x <= BI_BUF_Z (buf)); \
+ assert (VALID_BYTIND_P (buf, x)); \
+} while (0)
+# define ASSERT_VALID_BYTIND_BACKWARD_UNSAFE(buf, x) do { \
+ assert (BUFFER_LIVE_P (buf)); \
+ assert ((x) > BI_BUF_BEG (buf) && x <= BI_BUF_Z (buf)); \
+ assert (VALID_BYTIND_P (buf, x)); \
+} while (0)
+# define ASSERT_VALID_BYTIND_FORWARD_UNSAFE(buf, x) do { \
+ assert (BUFFER_LIVE_P (buf)); \
+ assert ((x) >= BI_BUF_BEG (buf) && x < BI_BUF_Z (buf)); \
+ assert (VALID_BYTIND_P (buf, x)); \
+} while (0)
+
+#else /* not ERROR_CHECK_BUFPOS */
+# define ASSERT_VALID_BYTIND_UNSAFE(buf, x)
+# define ASSERT_VALID_BYTIND_BACKWARD_UNSAFE(buf, x)
+# define ASSERT_VALID_BYTIND_FORWARD_UNSAFE(buf, x)
+
+#endif /* not ERROR_CHECK_BUFPOS */
+
+/* Note that, although the Mule version will work fine for non-Mule
+ as well (it should reduce down to nothing), we provide a separate
+ version to avoid compilation warnings and possible non-optimal
+ results with stupid compilers. */
+
+#ifdef MULE
+# define VALIDATE_BYTIND_BACKWARD(buf, x) do \
+{ \
+ Bufbyte *__ibptr = BI_BUF_BYTE_ADDRESS (buf, x); \
+ while (!BUFBYTE_FIRST_BYTE_P (*__ibptr)) \
+ __ibptr--, (x)--; \
+} while (0)
+#else
+# define VALIDATE_BYTIND_BACKWARD(buf, x)
+#endif
+
+/* Note that, although the Mule version will work fine for non-Mule
+ as well (it should reduce down to nothing), we provide a separate
+ version to avoid compilation warnings and possible non-optimal
+ results with stupid compilers. */
+
+#ifdef MULE
+# define VALIDATE_BYTIND_FORWARD(buf, x) do \
+{ \
+ Bufbyte *__ibptr = BI_BUF_BYTE_ADDRESS (buf, x); \
+ while (!BUFBYTE_FIRST_BYTE_P (*__ibptr)) \
+ __ibptr++, (x)++; \
+} while (0)
+#else
+# define VALIDATE_BYTIND_FORWARD(buf, x)
+#endif
+
+/* Note that in the simplest case (no MULE, no ERROR_CHECK_BUFPOS),
+ this crap reduces down to simply (x)++. */
+
+#define INC_BYTIND(buf, x) do \
+{ \
+ ASSERT_VALID_BYTIND_FORWARD_UNSAFE (buf, x); \
+ /* Note that we do the increment first to \
+ make sure that the pointer in \
+ VALIDATE_BYTIND_FORWARD() ends up on \
+ the correct side of the gap */ \
+ (x)++; \
+ VALIDATE_BYTIND_FORWARD (buf, x); \
+} while (0)
+
+/* Note that in the simplest case (no MULE, no ERROR_CHECK_BUFPOS),
+ this crap reduces down to simply (x)--. */
+
+#define DEC_BYTIND(buf, x) do \
+{ \
+ ASSERT_VALID_BYTIND_BACKWARD_UNSAFE (buf, x); \
+ /* Note that we do the decrement first to \
+ make sure that the pointer in \
+ VALIDATE_BYTIND_BACKWARD() ends up on \
+ the correct side of the gap */ \
+ (x)--; \
+ VALIDATE_BYTIND_BACKWARD (buf, x); \
+} while (0)
+
+INLINE Bytind prev_bytind (struct buffer *buf, Bytind x);
+INLINE Bytind
+prev_bytind (struct buffer *buf, Bytind x)
+{
+ DEC_BYTIND (buf, x);
+ return x;
+}
+
+INLINE Bytind next_bytind (struct buffer *buf, Bytind x);
+INLINE Bytind
+next_bytind (struct buffer *buf, Bytind x)
+{
+ INC_BYTIND (buf, x);
+ return x;
+}
+
+#define BYTIND_INVALID ((Bytind) -1)
+
+/*----------------------------------------------------------------------*/
+/* Converting between buffer positions and byte indices */
+/*----------------------------------------------------------------------*/
+
+#ifdef MULE
+
+Bytind bufpos_to_bytind_func (struct buffer *buf, Bufpos x);
+Bufpos bytind_to_bufpos_func (struct buffer *buf, Bytind x);
+
+/* The basic algorithm we use is to keep track of a known region of
+ characters in each buffer, all of which are of the same width. We
+ keep track of the boundaries of the region in both Bufpos and
+ Bytind coordinates and also keep track of the char width, which
+ is 1 - 4 bytes. If the position we're translating is not in
+ the known region, then we invoke a function to update the known
+ region to surround the position in question. This assumes
+ locality of reference, which is usually the case.
+
+ Note that the function to update the known region can be simple
+ or complicated depending on how much information we cache.
+ For the moment, we don't cache any information, and just move
+ linearly forward or back from the known region, with a few
+ shortcuts to catch all-ASCII buffers. (Note that this will
+ thrash with bad locality of reference.) A smarter method would
+ be to keep some sort of pseudo-extent layer over the buffer;
+ maybe keep track of the bufpos/bytind correspondence at the
+ beginning of each line, which would allow us to do a binary
+ search over the pseudo-extents to narrow things down to the
+ correct line, at which point you could use a linear movement
+ method. This would also mesh well with efficiently
+ implementing a line-numbering scheme.
+
+ Note also that we have to multiply or divide by the char width
+ in order to convert the positions. We do some tricks to avoid
+ ever actually having to do a multiply or divide, because that
+ is typically an expensive operation (esp. divide). Multiplying
+ or dividing by 1, 2, or 4 can be implemented simply as a
+ shift left or shift right, and we keep track of a shifter value
+ (0, 1, or 2) indicating how much to shift. Multiplying by 3
+ can be implemented by doubling and then adding the original
+ value. Dividing by 3, alas, cannot be implemented in any
+ simple shift/subtract method, as far as I know; so we just
+ do a table lookup. For simplicity, we use a table of size
+ 128K, which indexes the "divide-by-3" values for the first
+ 64K non-negative numbers. (Note that we can increase the
+ size up to 384K, i.e. indexing the first 192K non-negative
+ numbers, while still using shorts in the array.) This also
+ means that the size of the known region can be at most
+ 64K for width-three characters.
+ */
+
+extern short three_to_one_table[];
+
+INLINE int real_bufpos_to_bytind (struct buffer *buf, Bufpos x);
+INLINE int
+real_bufpos_to_bytind (struct buffer *buf, Bufpos x)
+{
+ if (x >= buf->text->mule_bufmin && x <= buf->text->mule_bufmax)
+ return (buf->text->mule_bytmin +
+ ((x - buf->text->mule_bufmin) << buf->text->mule_shifter) +
+ (buf->text->mule_three_p ? (x - buf->text->mule_bufmin) : 0));
+ else
+ return bufpos_to_bytind_func (buf, x);
+}
+
+INLINE int real_bytind_to_bufpos (struct buffer *buf, Bytind x);
+INLINE int
+real_bytind_to_bufpos (struct buffer *buf, Bytind x)
+{
+ if (x >= buf->text->mule_bytmin && x <= buf->text->mule_bytmax)
+ return (buf->text->mule_bufmin +
+ ((buf->text->mule_three_p
+ ? three_to_one_table[x - buf->text->mule_bytmin]
+ : (x - buf->text->mule_bytmin) >> buf->text->mule_shifter)));
+ else
+ return bytind_to_bufpos_func (buf, x);
+}
+
+#else /* not MULE */
+
+# define real_bufpos_to_bytind(buf, x) ((Bytind) x)
+# define real_bytind_to_bufpos(buf, x) ((Bufpos) x)
+
+#endif /* not MULE */
+
+#ifdef ERROR_CHECK_BUFPOS
+
+Bytind bufpos_to_bytind (struct buffer *buf, Bufpos x);
+Bufpos bytind_to_bufpos (struct buffer *buf, Bytind x);
+
+#else /* not ERROR_CHECK_BUFPOS */
+
+#define bufpos_to_bytind real_bufpos_to_bytind
+#define bytind_to_bufpos real_bytind_to_bufpos
+
+#endif /* not ERROR_CHECK_BUFPOS */
+
+#define make_bufpos(buf, ind) make_int (bytind_to_bufpos (buf, ind))
+
+/*----------------------------------------------------------------------*/
+/* Converting between buffer bytes and Emacs characters */
+/*----------------------------------------------------------------------*/
+
+/* The character at position POS in buffer. */
+#define BI_BUF_FETCH_CHAR(buf, pos) \
+ charptr_emchar (BI_BUF_BYTE_ADDRESS (buf, pos))
+#define BUF_FETCH_CHAR(buf, pos) \
+ BI_BUF_FETCH_CHAR (buf, bufpos_to_bytind (buf, pos))
+
+/* The character at position POS in buffer, as a string. This is
+ equivalent to set_charptr_emchar (str, BUF_FETCH_CHAR (buf, pos))
+ but is faster for Mule. */
+
+# define BI_BUF_CHARPTR_COPY_CHAR(buf, pos, str) \
+ charptr_copy_char (BI_BUF_BYTE_ADDRESS (buf, pos), str)
+#define BUF_CHARPTR_COPY_CHAR(buf, pos, str) \
+ BI_BUF_CHARPTR_COPY_CHAR (buf, bufpos_to_bytind (buf, pos), str)
+
+
+
+\f
+/************************************************************************/
+/* */
+/* working with externally-formatted data */
+/* */
+/************************************************************************/
+
+/* 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.
+*/
+
+#ifdef FILE_CODING
+
+/* 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. */
+
+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 */
+
+#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))
+
+#endif /* ! MULE */
+
+/* In all of the following macros we use the following general principles:
+
+ -- Functions that work with charptr's accept two sorts of charptr's:
+
+ 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)
+
+ -- 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.
+
+ -- 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.
+ */
+
+
+/* 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; \
+ (len_out) = (Extcount) gceda_len_in; \
+ } \
+ else \
+ { \
+ (ptr_out) = (Extbyte *) alloca (1 + gceda_len_out); \
+ memcpy ((void *) ptr_out, gceda_ptr_out, 1 + gceda_len_out); \
+ (len_out) = (Extcount) gceda_len_out; \
+ } \
+} 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; \
+} 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)
+
+#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.
+
+ 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_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; \
+ (len_out) = (Bytecount) gcida_len_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; \
+ } \
+} 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); \
+} 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; \
+} 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.) */
+
+#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)
+
+
+\f
+/************************************************************************/
+/* */
+/* fake charset functions */
+/* */
+/************************************************************************/
+
+/* used when MULE is not defined, so that Charset-type stuff can still
+ be done */
+
+#ifndef MULE
+
+#define Vcharset_ascii Qnil
+
+#define CHAR_CHARSET(ch) Vcharset_ascii
+#define CHAR_LEADING_BYTE(ch) LEADING_BYTE_ASCII
+#define LEADING_BYTE_ASCII 0x80
+#define NUM_LEADING_BYTES 1
+#define MIN_LEADING_BYTE 0x80
+#define CHARSETP(cs) 1
+#define CHARSET_BY_LEADING_BYTE(lb) Vcharset_ascii
+#define XCHARSET_LEADING_BYTE(cs) LEADING_BYTE_ASCII
+#define XCHARSET_GRAPHIC(cs) -1
+#define XCHARSET_COLUMNS(cs) 1
+#define XCHARSET_DIMENSION(cs) 1
+#define REP_BYTES_BY_FIRST_BYTE(fb) 1
+#define BREAKUP_CHAR(ch, charset, byte1, byte2) do { \
+ (charset) = Vcharset_ascii; \
+ (byte1) = (ch); \
+ (byte2) = 0; \
+} while (0)
+#define BYTE_ASCII_P(byte) 1
+
+#endif /* ! MULE */
+\f
+/************************************************************************/
+/* */
+/* higher-level buffer-position functions */
+/* */
+/************************************************************************/
+
+/*----------------------------------------------------------------------*/
+/* Settor macros for important positions in a buffer */
+/*----------------------------------------------------------------------*/
+
+/* Set beginning of accessible range of buffer. */
+#define SET_BOTH_BUF_BEGV(buf, val, bival) \
+do \
+{ \
+ (buf)->begv = (bival); \
+ (buf)->bufbegv = (val); \
+} while (0)
+
+/* Set end of accessible range of buffer. */
+#define SET_BOTH_BUF_ZV(buf, val, bival) \
+do \
+{ \
+ (buf)->zv = (bival); \
+ (buf)->bufzv = (val); \
+} while (0)
+
+/* Set point. */
+/* Since BEGV and ZV are almost never set, it's reasonable to enforce
+ the restriction that the Bufpos and Bytind values must both be
+ specified. However, point is set in lots and lots of places. So
+ we provide the ability to specify both (for efficiency) or just
+ one. */
+#define BOTH_BUF_SET_PT(buf, val, bival) set_buffer_point (buf, val, bival)
+#define BI_BUF_SET_PT(buf, bival) \
+ BOTH_BUF_SET_PT (buf, bytind_to_bufpos (buf, bival), bival)
+#define BUF_SET_PT(buf, value) \
+ BOTH_BUF_SET_PT (buf, value, bufpos_to_bytind (buf, value))
+
+
+#if 0 /* FSFmacs */
+/* These macros exist in FSFmacs because SET_PT() in FSFmacs incorrectly
+ does too much stuff, such as moving out of invisible extents. */
+#define TEMP_SET_PT(position) (temp_set_point ((position), current_buffer))
+#define SET_BUF_PT(buf, value) ((buf)->pt = (value))
+#endif /* FSFmacs */
+
+/*----------------------------------------------------------------------*/
+/* Miscellaneous buffer values */
+/*----------------------------------------------------------------------*/
+
+/* Number of characters in buffer */
+#define BUF_SIZE(buf) (BUF_Z (buf) - BUF_BEG (buf))
+
+/* Is this buffer narrowed? */
+#define BUF_NARROWED(buf) \
+ ((BI_BUF_BEGV (buf) != BI_BUF_BEG (buf)) || \
+ (BI_BUF_ZV (buf) != BI_BUF_Z (buf)))
+
+/* Modification count. */
+#define BUF_MODIFF(buf) ((buf)->text->modiff)
+
+/* Saved modification count. */
+#define BUF_SAVE_MODIFF(buf) ((buf)->text->save_modiff)
+
+/* Face changed. */
+#define BUF_FACECHANGE(buf) ((buf)->face_change)
+
+#define POINT_MARKER_P(marker) \
+ (XMARKER (marker)->buffer != 0 && \
+ EQ ((marker), XMARKER (marker)->buffer->point_marker))
+
+#define BUF_MARKERS(buf) ((buf)->markers)
+
+/* WARNING:
+
+ The new definitions of CEILING_OF() and FLOOR_OF() differ semantically
+ from the old ones (in FSF Emacs and XEmacs 19.11 and before).
+ Conversion is as follows:
+
+ OLD_BI_CEILING_OF(n) = NEW_BI_CEILING_OF(n) - 1
+ OLD_BI_FLOOR_OF(n) = NEW_BI_FLOOR_OF(n + 1)
+
+ The definitions were changed because the new definitions are more
+ consistent with the way everything else works in Emacs.
+ */
+
+/* Properties of CEILING_OF and FLOOR_OF (also apply to BI_ variants):
+
+ 1) FLOOR_OF (CEILING_OF (n)) = n
+ CEILING_OF (FLOOR_OF (n)) = n
+
+ 2) CEILING_OF (n) = n if and only if n = ZV
+ FLOOR_OF (n) = n if and only if n = BEGV
+
+ 3) CEILING_OF (CEILING_OF (n)) = ZV
+ FLOOR_OF (FLOOR_OF (n)) = BEGV
+
+ 4) The bytes in the regions
+
+ [BYTE_ADDRESS (n), BYTE_ADDRESS_BEFORE (CEILING_OF (n))]
+
+ and
+
+ [BYTE_ADDRESS (FLOOR_OF (n)), BYTE_ADDRESS_BEFORE (n)]
+
+ are contiguous.
+ */
+
+
+/* Return the maximum index in the buffer it is safe to scan forwards
+ past N to. This is used to prevent buffer scans from running into
+ the gap (e.g. search.c). All characters between N and CEILING_OF(N)
+ are located contiguous in memory. Note that the character *at*
+ CEILING_OF(N) is not contiguous in memory. */
+#define BI_BUF_CEILING_OF(b, n) \
+ ((n) < (b)->text->gpt && (b)->text->gpt < BI_BUF_ZV (b) ? \
+ (b)->text->gpt : BI_BUF_ZV (b))
+#define BUF_CEILING_OF(b, n) \
+ bytind_to_bufpos (b, BI_BUF_CEILING_OF (b, bufpos_to_bytind (b, n)))
+
+/* Return the minimum index in the buffer it is safe to scan backwards
+ past N to. All characters between FLOOR_OF(N) and N are located
+ contiguous in memory. Note that the character *at* N may not be
+ contiguous in memory. */
+#define BI_BUF_FLOOR_OF(b, n) \
+ (BI_BUF_BEGV (b) < (b)->text->gpt && (b)->text->gpt < (n) ? \
+ (b)->text->gpt : BI_BUF_BEGV (b))
+#define BUF_FLOOR_OF(b, n) \
+ bytind_to_bufpos (b, BI_BUF_FLOOR_OF (b, bufpos_to_bytind (b, n)))
+
+#define BI_BUF_CEILING_OF_IGNORE_ACCESSIBLE(b, n) \
+ ((n) < (b)->text->gpt && (b)->text->gpt < BI_BUF_Z (b) ? \
+ (b)->text->gpt : BI_BUF_Z (b))
+#define BUF_CEILING_OF_IGNORE_ACCESSIBLE(b, n) \
+ bytind_to_bufpos \
+ (b, BI_BUF_CEILING_OF_IGNORE_ACCESSIBLE (b, bufpos_to_bytind (b, n)))
+
+#define BI_BUF_FLOOR_OF_IGNORE_ACCESSIBLE(b, n) \
+ (BI_BUF_BEG (b) < (b)->text->gpt && (b)->text->gpt < (n) ? \
+ (b)->text->gpt : BI_BUF_BEG (b))
+#define BUF_FLOOR_OF_IGNORE_ACCESSIBLE(b, n) \
+ bytind_to_bufpos \
+ (b, BI_BUF_FLOOR_OF_IGNORE_ACCESSIBLE (b, bufpos_to_bytind (b, n)))
+
+
+extern struct buffer *current_buffer;
+
+/* This is the initial (startup) directory, as used for the *scratch* buffer.
+ We're making this a global to make others aware of the startup directory.
+ */
+extern char initial_directory[];
+extern void init_initial_directory (void); /* initialize initial_directory */
+
+EXFUN (Fbuffer_disable_undo, 1);
+EXFUN (Fbuffer_modified_p, 1);
+EXFUN (Fbuffer_name, 1);
+EXFUN (Fcurrent_buffer, 0);
+EXFUN (Ferase_buffer, 1);
+EXFUN (Fget_buffer, 1);
+EXFUN (Fget_buffer_create, 1);
+EXFUN (Fget_file_buffer, 1);
+EXFUN (Fkill_buffer, 1);
+EXFUN (Fother_buffer, 3);
+EXFUN (Frecord_buffer, 1);
+EXFUN (Fset_buffer, 1);
+EXFUN (Fset_buffer_modified_p, 2);
+
+extern Lisp_Object QSscratch, Qafter_change_function, Qafter_change_functions;
+extern Lisp_Object Qbefore_change_function, Qbefore_change_functions;
+extern Lisp_Object Qbuffer_or_string_p, Qdefault_directory, Qfirst_change_hook;
+extern Lisp_Object Qpermanent_local, Vafter_change_function;
+extern Lisp_Object Vafter_change_functions, Vbefore_change_function;
+extern Lisp_Object Vbefore_change_functions, Vbuffer_alist, Vbuffer_defaults;
+extern Lisp_Object Vinhibit_read_only, Vtransient_mark_mode;
+
+/* This structure marks which slots in a buffer have corresponding
+ default values in Vbuffer_defaults.
+ Each such slot has a nonzero value in this structure.
+ The value has only one nonzero bit.
+
+ When a buffer has its own local value for a slot,
+ the bit for that slot (found in the same slot in this structure)
+ is turned on in the buffer's local_var_flags slot.
+
+ If a slot in this structure is zero, then even though there may
+ be a DEFVAR_BUFFER_LOCAL for the slot, there is no default value for it;
+ and the corresponding slot in Vbuffer_defaults is not used. */
+
+extern struct buffer buffer_local_flags;
+
+
+/* Allocation of buffer data. */
+
+#ifdef REL_ALLOC
+
+char *r_alloc (unsigned char **, unsigned long);
+char *r_re_alloc (unsigned char **, unsigned long);
+void r_alloc_free (unsigned char **);
+
+#define BUFFER_ALLOC(data, size) \
+ ((Bufbyte *) r_alloc ((unsigned char **) &data, (size) * sizeof(Bufbyte)))
+#define BUFFER_REALLOC(data, size) \
+ ((Bufbyte *) r_re_alloc ((unsigned char **) &data, (size) * sizeof(Bufbyte)))
+#define BUFFER_FREE(data) r_alloc_free ((unsigned char **) &(data))
+#define R_ALLOC_DECLARE(var,data) r_alloc_declare (&(var), data)
+
+#else /* !REL_ALLOC */
+
+#define BUFFER_ALLOC(data,size)\
+ ((void) (data = xnew_array (Bufbyte, size)))
+#define BUFFER_REALLOC(data,size)\
+ ((Bufbyte *) xrealloc (data, (size) * sizeof(Bufbyte)))
+/* Avoid excess parentheses, or syntax errors may rear their heads. */
+#define BUFFER_FREE(data) xfree (data)
+#define R_ALLOC_DECLARE(var,data)
+
+#endif /* !REL_ALLOC */
+
+extern Lisp_Object Vbuffer_alist;
+void set_buffer_internal (struct buffer *b);
+struct buffer *decode_buffer (Lisp_Object buffer, int allow_string);
+
+/* from editfns.c */
+void widen_buffer (struct buffer *b, int no_clip);
+int beginning_of_line_p (struct buffer *b, Bufpos pt);
+
+/* 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,
+ Bytecount len);
+void find_charsets_in_emchar_string (unsigned char *charsets,
+ 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,
+ Bytecount len,
+ Emchar_dynarr *dyn);
+int convert_bufbyte_string_into_emchar_string (CONST Bufbyte *str,
+ Bytecount len,
+ Emchar *arr);
+void convert_emchar_string_into_bufbyte_dynarr (Emchar *arr, int nels,
+ Bufbyte_dynarr *dyn);
+Bufbyte *convert_emchar_string_into_malloced_string (Emchar *arr, int nels,
+ Bytecount *len_out);
+/* from marker.c */
+void init_buffer_markers (struct buffer *b);
+void uninit_buffer_markers (struct buffer *b);
+
+/* flags for get_buffer_pos_char(), get_buffer_range_char(), etc. */
+/* At most one of GB_COERCE_RANGE and GB_NO_ERROR_IF_BAD should be
+ specified. At most one of GB_NEGATIVE_FROM_END and GB_NO_ERROR_IF_BAD
+ should be specified. */
+
+#define GB_ALLOW_PAST_ACCESSIBLE (1 << 0)
+#define GB_ALLOW_NIL (1 << 1)
+#define GB_CHECK_ORDER (1 << 2)
+#define GB_COERCE_RANGE (1 << 3)
+#define GB_NO_ERROR_IF_BAD (1 << 4)
+#define GB_NEGATIVE_FROM_END (1 << 5)
+#define GB_HISTORICAL_STRING_BEHAVIOR (GB_NEGATIVE_FROM_END | GB_ALLOW_NIL)
+
+Bufpos get_buffer_pos_char (struct buffer *b, Lisp_Object pos,
+ unsigned int flags);
+Bytind get_buffer_pos_byte (struct buffer *b, Lisp_Object pos,
+ unsigned int flags);
+void get_buffer_range_char (struct buffer *b, Lisp_Object from, Lisp_Object to,
+ Bufpos *from_out, Bufpos *to_out,
+ unsigned int flags);
+void get_buffer_range_byte (struct buffer *b, Lisp_Object from, Lisp_Object to,
+ Bytind *from_out, Bytind *to_out,
+ unsigned int flags);
+Charcount get_string_pos_char (Lisp_Object string, Lisp_Object pos,
+ unsigned int flags);
+Bytecount get_string_pos_byte (Lisp_Object string, Lisp_Object pos,
+ unsigned int flags);
+void get_string_range_char (Lisp_Object string, Lisp_Object from,
+ Lisp_Object to, Charcount *from_out,
+ Charcount *to_out, unsigned int flags);
+void get_string_range_byte (Lisp_Object string, Lisp_Object from,
+ Lisp_Object to, Bytecount *from_out,
+ Bytecount *to_out, unsigned int flags);
+Bufpos get_buffer_or_string_pos_char (Lisp_Object object, Lisp_Object pos,
+ unsigned int flags);
+Bytind get_buffer_or_string_pos_byte (Lisp_Object object, Lisp_Object pos,
+ unsigned int flags);
+void get_buffer_or_string_range_char (Lisp_Object object, Lisp_Object from,
+ Lisp_Object to, Bufpos *from_out,
+ Bufpos *to_out, unsigned int flags);
+void get_buffer_or_string_range_byte (Lisp_Object object, Lisp_Object from,
+ Lisp_Object to, Bytind *from_out,
+ Bytind *to_out, unsigned int flags);
+Bufpos buffer_or_string_accessible_begin_char (Lisp_Object object);
+Bufpos buffer_or_string_accessible_end_char (Lisp_Object object);
+Bytind buffer_or_string_accessible_begin_byte (Lisp_Object object);
+Bytind buffer_or_string_accessible_end_byte (Lisp_Object object);
+Bufpos buffer_or_string_absolute_begin_char (Lisp_Object object);
+Bufpos buffer_or_string_absolute_end_char (Lisp_Object object);
+Bytind buffer_or_string_absolute_begin_byte (Lisp_Object object);
+Bytind buffer_or_string_absolute_end_byte (Lisp_Object object);
+void record_buffer (Lisp_Object buf);
+Lisp_Object get_buffer (Lisp_Object name,
+ int error_if_deleted_or_does_not_exist);
+int map_over_sharing_buffers (struct buffer *buf,
+ int (*mapfun) (struct buffer *buf,
+ void *closure),
+ void *closure);
+
+\f
+/************************************************************************/
+/* Case conversion */
+/************************************************************************/
+
+/* A "trt" table is a mapping from characters to other characters,
+ typically used to convert between uppercase and lowercase. For
+ compatibility reasons, trt tables are currently in the form of
+ a Lisp string of 256 characters, specifying the conversion for each
+ of the first 256 Emacs characters (i.e. the 256 extended-ASCII
+ characters). This should be generalized at some point to support
+ conversions for all of the allowable Mule characters.
+ */
+
+/* The _1 macros are named as such because they assume that you have
+ already guaranteed that the character values are all in the range
+ 0 - 255. Bad lossage will happen otherwise. */
+
+# define MAKE_TRT_TABLE() Fmake_string (make_int (256), make_char (0))
+# define TRT_TABLE_AS_STRING(table) XSTRING_DATA (table)
+# define TRT_TABLE_CHAR_1(table, ch) \
+ string_char (XSTRING (table), (Charcount) ch)
+# define SET_TRT_TABLE_CHAR_1(table, ch1, ch2) \
+ set_string_char (XSTRING (table), (Charcount) ch1, ch2)
+
+#ifdef MULE
+# define MAKE_MIRROR_TRT_TABLE() make_opaque (256, 0)
+# 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]))
+# define SET_MIRROR_TRT_TABLE_CHAR_1(table, ch1, ch2) \
+ (MIRROR_TRT_TABLE_AS_STRING (table)[ch1] = (Bufbyte) (ch2))
+#endif
+
+# define IN_TRT_TABLE_DOMAIN(c) (((EMACS_UINT) (c)) <= 255)
+
+#ifdef MULE
+#define MIRROR_DOWNCASE_TABLE_AS_STRING(buf) \
+ MIRROR_TRT_TABLE_AS_STRING (buf->mirror_downcase_table)
+#define MIRROR_UPCASE_TABLE_AS_STRING(buf) \
+ MIRROR_TRT_TABLE_AS_STRING (buf->mirror_upcase_table)
+#define MIRROR_CANON_TABLE_AS_STRING(buf) \
+ MIRROR_TRT_TABLE_AS_STRING (buf->mirror_case_canon_table)
+#define MIRROR_EQV_TABLE_AS_STRING(buf) \
+ MIRROR_TRT_TABLE_AS_STRING (buf->mirror_case_eqv_table)
+#else
+#define MIRROR_DOWNCASE_TABLE_AS_STRING(buf) \
+ TRT_TABLE_AS_STRING (buf->downcase_table)
+#define MIRROR_UPCASE_TABLE_AS_STRING(buf) \
+ TRT_TABLE_AS_STRING (buf->upcase_table)
+#define MIRROR_CANON_TABLE_AS_STRING(buf) \
+ TRT_TABLE_AS_STRING (buf->case_canon_table)
+#define MIRROR_EQV_TABLE_AS_STRING(buf) \
+ TRT_TABLE_AS_STRING (buf->case_eqv_table)
+#endif
+
+INLINE Emchar TRT_TABLE_OF (Lisp_Object trt, Emchar c);
+INLINE Emchar
+TRT_TABLE_OF (Lisp_Object trt, Emchar c)
+{
+ return IN_TRT_TABLE_DOMAIN (c) ? TRT_TABLE_CHAR_1 (trt, c) : c;
+}
+
+/* Macros used below. */
+#define DOWNCASE_TABLE_OF(buf, c) TRT_TABLE_OF (buf->downcase_table, c)
+#define UPCASE_TABLE_OF(buf, c) TRT_TABLE_OF (buf->upcase_table, c)
+
+/* 1 if CH is upper case. */
+
+INLINE int UPPERCASEP (struct buffer *buf, Emchar ch);
+INLINE int
+UPPERCASEP (struct buffer *buf, Emchar ch)
+{
+ return DOWNCASE_TABLE_OF (buf, ch) != ch;
+}
+
+/* 1 if CH is lower case. */
+
+INLINE int LOWERCASEP (struct buffer *buf, Emchar ch);
+INLINE int
+LOWERCASEP (struct buffer *buf, Emchar ch)
+{
+ return (UPCASE_TABLE_OF (buf, ch) != ch &&
+ DOWNCASE_TABLE_OF (buf, ch) == ch);
+}
+
+/* 1 if CH is neither upper nor lower case. */
+
+INLINE int NOCASEP (struct buffer *buf, Emchar ch);
+INLINE int
+NOCASEP (struct buffer *buf, Emchar ch)
+{
+ return UPCASE_TABLE_OF (buf, ch) == ch;
+}
+
+/* Upcase a character, or make no change if that cannot be done. */
+
+INLINE Emchar UPCASE (struct buffer *buf, Emchar ch);
+INLINE Emchar
+UPCASE (struct buffer *buf, Emchar ch)
+{
+ return (DOWNCASE_TABLE_OF (buf, ch) == ch) ? UPCASE_TABLE_OF (buf, ch) : ch;
+}
+
+/* Upcase a character known to be not upper case. */
+
+#define UPCASE1(buf, ch) UPCASE_TABLE_OF (buf, ch)
+
+/* Downcase a character, or make no change if that cannot be done. */
+
+#define DOWNCASE(buf, ch) DOWNCASE_TABLE_OF (buf, ch)
+
+#endif /* _XEMACS_BUFFER_H_ */
--- /dev/null
+/* Definitions of marked slots in buffers
+ Copyright (C) 1990, 1992, 1993 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: Mule 2.0, FSF 19.30. Split out of buffer.h. */
+
+/* Authorship:
+
+ FSF: long ago (part of buffer.h).
+ JWZ: separated out from buffer.h, early in Lemacs.
+ XEmacs: a few other changes.
+ */
+
+/* In the declaration of the buffer structure, this file is included
+ after defining MARKED_SLOT(x) to be Lisp_Object x; i.e. just a slot
+ definition. In the garbage collector this file is included after
+ defining MARKED_SLOT(x) to be mark_object(buffer->x). */
+
+ /* The name of this buffer. */
+ MARKED_SLOT (name);
+
+ /* The name of the file visited in this buffer, or nil. */
+ MARKED_SLOT (filename);
+
+ /* Dir for expanding relative file names. */
+ MARKED_SLOT (directory);
+
+ /* True iff this buffer has been backed up (if you write to the
+ visited file and it hasn't been backed up, then a backup will
+ be made). */
+ /* #### This isn't really used by the C code, so could be deleted. */
+ MARKED_SLOT (backed_up);
+
+ /* Length of file when last read or saved.
+ This is not in the struct buffer_text
+ because it's not used in indirect buffers at all. */
+ MARKED_SLOT (saved_size);
+
+ /* File name used for auto-saving this buffer.
+ This is not in the struct buffer_text
+ because it's not used in indirect buffers at all. */
+ MARKED_SLOT (auto_save_file_name);
+
+ /* Non-nil if buffer read-only. */
+ MARKED_SLOT (read_only);
+
+ /* "The mark". This is a marker which may
+ point into this buffer or may point nowhere. */
+ MARKED_SLOT (mark);
+
+ /* Alist of elements (SYMBOL . VALUE-IN-THIS-BUFFER)
+ for all per-buffer variables of this buffer.
+ Specifically, this lists those variables that have
+ a buffer-local value in this buffer: i.e. those
+ whose value does not shadow the default value.
+ (Remember that for any particlar variable created
+ with `make-local-variable' or `make-variable-buffer-local',
+ it will have a per-buffer value in some buffers and a
+ default value in others.)
+
+ Variables declared in C with DEFVAR_BUFFER_LOCAL() (i.e.
+ those stored in the struct buffer) are not listed here. */
+ MARKED_SLOT (local_var_alist);
+
+ /* Symbol naming major mode (eg, lisp-mode). */
+ MARKED_SLOT (major_mode);
+
+ /* Pretty name of major mode (eg, "Lisp"). */
+ MARKED_SLOT (mode_name);
+
+ /* Modeline element that controls format of modeline. */
+ MARKED_SLOT (modeline_format);
+
+ /* Keys that are bound local to this buffer. */
+ MARKED_SLOT (keymap);
+
+ /* This buffer's local abbrev table. */
+ MARKED_SLOT (abbrev_table);
+ /* This buffer's syntax table. */
+ MARKED_SLOT (syntax_table);
+ /* Massaged values from the syntax table, for faster lookup. */
+ MARKED_SLOT (mirror_syntax_table);
+
+#ifdef MULE
+ /* This buffer's category table. */
+ MARKED_SLOT (category_table);
+#endif /* MULE */
+#ifdef FILE_CODING
+ /* This buffer's coding system. */
+ MARKED_SLOT (buffer_file_coding_system);
+#endif
+ /* Values of several buffer-local variables.
+
+ tab-width is buffer-local so that redisplay can find it
+ in buffers that are not current */
+ MARKED_SLOT (case_fold_search);
+ MARKED_SLOT (tab_width);
+ MARKED_SLOT (fill_column);
+ MARKED_SLOT (left_margin);
+
+ /* Function to call when insert space past fill column. */
+ MARKED_SLOT (auto_fill_function);
+
+ /* Case table for case-conversion in this buffer.
+ This char-table maps each char into its lower-case version. */
+ MARKED_SLOT (downcase_table);
+ /* Char-table mapping each char to its upper-case version. */
+ MARKED_SLOT (upcase_table);
+
+ /* Char-table for conversion for case-folding search. */
+ MARKED_SLOT (case_canon_table);
+ /* Char-table of equivalences for case-folding search. */
+ MARKED_SLOT (case_eqv_table);
+
+#ifdef MULE
+ /* #### The purpose of these bogos is to deal with the fact that
+ the Boyer-Moore and regex searching routines don't know how to
+ deal with translating multi-byte characters. Fixing this is hard,
+ so instead we maintain these mirror tables that have all incorrect
+ mappings (see casetab.c) sanitized out of them. If we don't do
+ this, we may get weird and unpredictable results in the presence
+ of extended chars and extended mappings, and it could even lead
+ to a crash.
+
+ #### Eventually we should deal with this properly. */
+ MARKED_SLOT (mirror_downcase_table);
+ MARKED_SLOT (mirror_upcase_table);
+ MARKED_SLOT (mirror_case_canon_table);
+ MARKED_SLOT (mirror_case_eqv_table);
+#endif
+
+ /* #### This ought to be a specifier: */
+ /* Non-nil means do not display continuation lines. */
+ MARKED_SLOT (truncate_lines);
+ /* #### This ought to be a specifier: */
+ /* #### Better yet, it ought to be junked. It really sucks. */
+ /* Non-nil means display ctl chars with uparrow. */
+ MARKED_SLOT (ctl_arrow);
+ /* #### This ought to be a specifier: */
+ /* #### Better yet, it ought to be junked. It really sucks. */
+ /* Non-nil means do selective display;
+ see doc string in syms_of_buffer (buffer.c) for details. */
+ MARKED_SLOT (selective_display);
+ /* #### This ought to be a specifier: */
+ /* #### Better yet, it ought to be junked. It really sucks. */
+ /* Non-nil means show ... at end of line followed by invisible lines. */
+ MARKED_SLOT (selective_display_ellipses);
+ /* Alist of (FUNCTION . STRING) for each minor mode enabled in buffer. */
+ /* Unused: MARKED_SLOT (minor_modes); */
+ /* t if "self-insertion" should overwrite */
+ MARKED_SLOT (overwrite_mode);
+ /* non-nil means abbrev mode is on. Expand abbrevs automatically. */
+ MARKED_SLOT (abbrev_mode);
+
+ /* No display table here. It's a specifier. */
+#if 0 /* FSFmacs */
+ /* t means the mark and region are currently active. */
+ MARKED_SLOT (mark_active);
+#endif
+
+ /* Changes in the buffer are recorded here for undo.
+ t means don't record anything.
+ This information belongs to the base buffer of an indirect buffer,
+ But we can't store it in the struct buffer_text
+ because local variables have to be right in the struct buffer.
+ So we copy it around in set_buffer_internal. */
+ MARKED_SLOT (undo_list);
+
+ /* FSFmacs has overlay stuff here. We have extent info elsewhere in the
+ struct buffer. */
+
+ /* If dedicated_frame is non-nil, display_buffer tries to use it instead
+ of the current frame */
+ MARKED_SLOT (dedicated_frame);
+
+ /* Lisp of symbols naming the file format used for visited file. */
+ MARKED_SLOT (file_format);
+
+#ifdef REGION_CACHE_NEEDS_WORK
+ /* True if the newline position cache and width run cache are
+ enabled. See search.c and indent.c. */
+ MARKED_SLOT (cache_long_line_scans);
+
+ /* If the width run cache is enabled, this table contains the
+ character widths width_run_cache (see above) assumes. When we
+ do a thorough redisplay, we compare this against the buffer's
+ current display table to see whether the display table has
+ affected the widths of any characters. If it has, we
+ invalidate the width run cache, and re-initialize width_table. */
+ MARKED_SLOT (width_table);
+#endif /* REGION_CACHE_NEEDS_WORK */
+
+ /* A redundant copy of text.pt, in the form of a marker. Every time one
+ is updated, so is the other.
+ */
+ MARKED_SLOT (point_marker);
+
+ /* FSFmacs has pt_marker, begv_marker, zv_marker here, used for
+ indirect buffers. We don't need them because we handle these
+ values directly instead of playing games with markers. */
+
+ /* This holds the point value before the last scroll operation.
+ Explicitly setting point sets this to nil. */
+ MARKED_SLOT (point_before_scroll);
+
+ /* Truename of the visited file (via the realpath() system call),
+ or nil. */
+ MARKED_SLOT (file_truename);
+
+ /* Invisibility spec of this buffer.
+ t => any non-nil `invisible' property means invisible.
+ A list => `invisible' property means invisible
+ if it is memq in that list. */
+ MARKED_SLOT (invisibility_spec);
+
+ /* The string generated by formatting the modeline in this buffer. */
+ MARKED_SLOT (generated_modeline_string);
+
+ /* A hash table that maps from a "generic extent" (an extent in
+ `modeline-format') into a buffer-specific extent. */
+ MARKED_SLOT (modeline_extent_table);
+#if 0 /* FSFmacs */
+ /* This is silly and stupid */
+ /* These are so we don't have to recompile everything
+ the next few times we add a new slot. */
+ MARKED_SLOT (extra1, extra2, extra3);
+#endif
+ /* The cache of positions for whilch line number has last been
+ calculated. See line-number.c. */
+ MARKED_SLOT (line_number_cache);
+
--- /dev/null
+/* XEmacs case conversion functions.
+ Copyright (C) 1985, 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: FSF 19.34. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "commands.h"
+#include "insdel.h"
+#include "syntax.h"
+
+enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP};
+\f
+static Lisp_Object
+casify_object (enum case_action flag, Lisp_Object obj, Lisp_Object buffer)
+{
+ struct buffer *buf = decode_buffer (buffer, 0);
+ REGISTER int inword = (flag == CASE_DOWN);
+ struct Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table);
+
+ while (1)
+ {
+ if (CHAR_OR_CHAR_INTP (obj))
+ {
+ Emchar c;
+ CHECK_CHAR_COERCE_INT (obj);
+ c = XCHAR (obj);
+ if (IN_TRT_TABLE_DOMAIN (c))
+ {
+ if (inword)
+ obj = make_char (DOWNCASE (buf, c));
+ else if (!UPPERCASEP (buf, c))
+ obj = make_char (UPCASE1 (buf, c));
+ }
+ return obj;
+ }
+ if (STRINGP (obj))
+ {
+ Charcount i;
+ Charcount len = XSTRING_CHAR_LENGTH (obj);
+ obj = Fcopy_sequence (obj);
+ for (i = 0; i < len; i++)
+ {
+ Emchar c = string_char (XSTRING (obj), i);
+ if (inword && flag != CASE_CAPITALIZE_UP)
+ c = DOWNCASE (buf, c);
+ else if (!UPPERCASEP (buf, c)
+ && (!inword || flag != CASE_CAPITALIZE_UP))
+ c = UPCASE1 (buf, c);
+ set_string_char (XSTRING (obj), i, c);
+ if ((int) flag >= (int) CASE_CAPITALIZE)
+ inword = WORD_SYNTAX_P (syntax_table, c);
+ }
+ return obj;
+ }
+ obj = wrong_type_argument (Qchar_or_string_p, obj);
+ }
+}
+
+DEFUN ("upcase", Fupcase, 1, 2, 0, /*
+Convert argument to upper case and return that.
+The argument may be a character or string. The result has the same type.
+The argument object is not altered--the value is a copy.
+See also `capitalize', `downcase' and `upcase-initials'.
+Optional second arg BUFFER specifies which buffer's case tables to use,
+ and defaults to the current buffer.
+*/
+ (obj, buffer))
+{
+ return casify_object (CASE_UP, obj, buffer);
+}
+
+DEFUN ("downcase", Fdowncase, 1, 2, 0, /*
+Convert argument to lower case and return that.
+The argument may be a character or string. The result has the same type.
+The argument object is not altered--the value is a copy.
+Optional second arg BUFFER specifies which buffer's case tables to use,
+ and defaults to the current buffer.
+*/
+ (obj, buffer))
+{
+ return casify_object (CASE_DOWN, obj, buffer);
+}
+
+DEFUN ("capitalize", Fcapitalize, 1, 2, 0, /*
+Convert argument to capitalized form and return that.
+This means that each word's first character is upper case
+and the rest is lower case.
+The argument may be a character or string. The result has the same type.
+The argument object is not altered--the value is a copy.
+Optional second arg BUFFER specifies which buffer's case tables to use,
+ and defaults to the current buffer.
+*/
+ (obj, buffer))
+{
+ return casify_object (CASE_CAPITALIZE, obj, buffer);
+}
+
+/* Like Fcapitalize but change only the initials. */
+
+DEFUN ("upcase-initials", Fupcase_initials, 1, 2, 0, /*
+Convert the initial of each word in the argument to upper case.
+Do not change the other letters of each word.
+The argument may be a character or string. The result has the same type.
+The argument object is not altered--the value is a copy.
+Optional second arg BUFFER specifies which buffer's case tables to use,
+ and defaults to the current buffer.
+*/
+ (obj, buffer))
+{
+ return casify_object (CASE_CAPITALIZE_UP, obj, buffer);
+}
+\f
+/* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP.
+ b and e specify range of buffer to operate on. */
+
+static void
+casify_region_internal (enum case_action flag, Lisp_Object b, Lisp_Object e,
+ struct buffer *buf)
+{
+ /* This function can GC */
+ REGISTER Bufpos i;
+ Bufpos start, end;
+ REGISTER int inword = (flag == CASE_DOWN);
+ struct Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table);
+ int mccount;
+
+ if (EQ (b, e))
+ /* Not modifying because nothing marked */
+ return;
+
+ get_buffer_range_char (buf, b, e, &start, &end, 0);
+
+ mccount = begin_multiple_change (buf, start, end);
+ record_change (buf, start, end - start);
+
+ for (i = start; i < end; i++)
+ {
+ Emchar c = BUF_FETCH_CHAR (buf, i);
+ Emchar oldc = c;
+
+ if (inword && flag != CASE_CAPITALIZE_UP)
+ c = DOWNCASE (buf, c);
+ else if (!UPPERCASEP (buf, c)
+ && (!inword || flag != CASE_CAPITALIZE_UP))
+ c = UPCASE1 (buf, c);
+
+ if (oldc != c)
+ {
+ buffer_replace_char (buf, i, c, 1, (i == start));
+ BUF_MODIFF (buf)++;
+ }
+ /* !!#### need to revalidate the start and end pointers in case
+ the buffer was changed */
+ if ((int) flag >= (int) CASE_CAPITALIZE)
+ inword = WORD_SYNTAX_P (syntax_table, c);
+ }
+ end_multiple_change (buf, mccount);
+}
+
+static Lisp_Object
+casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e,
+ Lisp_Object buffer)
+{
+ casify_region_internal (flag, b, e, decode_buffer (buffer, 1));
+ return Qnil;
+}
+
+DEFUN ("upcase-region", Fupcase_region, 2, 3, "r", /*
+Convert the region to upper case. In programs, wants two arguments.
+These arguments specify the starting and ending character numbers of
+ the region to operate on. When used as a command, the text between
+ point and the mark is operated on.
+See also `capitalize-region'.
+Optional third arg BUFFER defaults to the current buffer.
+*/
+ (b, e, buffer))
+{
+ /* This function can GC */
+ return casify_region (CASE_UP, b, e, buffer);
+}
+
+DEFUN ("downcase-region", Fdowncase_region, 2, 3, "r", /*
+Convert the region to lower case. In programs, wants two arguments.
+These arguments specify the starting and ending character numbers of
+ the region to operate on. When used as a command, the text between
+ point and the mark is operated on.
+Optional third arg BUFFER defaults to the current buffer.
+*/
+ (b, e, buffer))
+{
+ /* This function can GC */
+ return casify_region (CASE_DOWN, b, e, buffer);
+}
+
+DEFUN ("capitalize-region", Fcapitalize_region, 2, 3, "r", /*
+Convert the region to capitalized form.
+Capitalized form means each word's first character is upper case
+ and the rest of it is lower case.
+In programs, give two arguments, the starting and ending
+ character positions to operate on.
+Optional third arg BUFFER defaults to the current buffer.
+*/
+ (b, e, buffer))
+{
+ /* This function can GC */
+ return casify_region (CASE_CAPITALIZE, b, e, buffer);
+}
+
+/* Like Fcapitalize_region but change only the initials. */
+
+DEFUN ("upcase-initials-region", Fupcase_initials_region, 2, 3, "r", /*
+Upcase the initial of each word in the region.
+Subsequent letters of each word are not changed.
+In programs, give two arguments, the starting and ending
+ character positions to operate on.
+Optional third arg BUFFER defaults to the current buffer.
+*/
+ (b, e, buffer))
+{
+ return casify_region (CASE_CAPITALIZE_UP, b, e, buffer);
+}
+
+\f
+static Lisp_Object
+casify_word (enum case_action flag, Lisp_Object arg, Lisp_Object buffer)
+{
+ Bufpos farend;
+ struct buffer *buf = decode_buffer (buffer, 1);
+
+ CHECK_INT (arg);
+
+ farend = scan_words (buf, BUF_PT (buf), XINT (arg));
+ if (!farend)
+ farend = XINT (arg) > 0 ? BUF_ZV (buf) : BUF_BEGV (buf);
+
+ casify_region_internal (flag, make_int (BUF_PT (buf)), make_int (farend), buf);
+ BUF_SET_PT (buf, max (BUF_PT (buf), farend));
+ return Qnil;
+}
+
+DEFUN ("upcase-word", Fupcase_word, 1, 2, "p", /*
+Convert following word (or ARG words) to upper case, moving over.
+With negative argument, convert previous words but do not move.
+See also `capitalize-word'.
+Optional second arg BUFFER defaults to the current buffer.
+*/
+ (arg, buffer))
+{
+ /* This function can GC */
+ return casify_word (CASE_UP, arg, buffer);
+}
+
+DEFUN ("downcase-word", Fdowncase_word, 1, 2, "p", /*
+Convert following word (or ARG words) to lower case, moving over.
+With negative argument, convert previous words but do not move.
+Optional second arg BUFFER defaults to the current buffer.
+*/
+ (arg, buffer))
+{
+ /* This function can GC */
+ return casify_word (CASE_DOWN, arg, buffer);
+}
+
+DEFUN ("capitalize-word", Fcapitalize_word, 1, 2, "p", /*
+Capitalize the following word (or ARG words), moving over.
+This gives the word(s) a first character in upper case
+ and the rest lower case.
+With negative argument, capitalize previous words but do not move.
+Optional second arg BUFFER defaults to the current buffer.
+*/
+ (arg, buffer))
+{
+ /* This function can GC */
+ return casify_word (CASE_CAPITALIZE, arg, buffer);
+}
+\f
+
+void
+syms_of_casefiddle (void)
+{
+ DEFSUBR (Fupcase);
+ DEFSUBR (Fdowncase);
+ DEFSUBR (Fcapitalize);
+ DEFSUBR (Fupcase_initials);
+ DEFSUBR (Fupcase_region);
+ DEFSUBR (Fdowncase_region);
+ DEFSUBR (Fcapitalize_region);
+ DEFSUBR (Fupcase_initials_region);
+ DEFSUBR (Fupcase_word);
+ DEFSUBR (Fdowncase_word);
+ DEFSUBR (Fcapitalize_word);
+}
--- /dev/null
+/* XEmacs routines to deal with case tables.
+ Copyright (C) 1987, 1992, 1993, 1994 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: FSF 19.28. Between FSF 19.28 and 19.30, casetab.c
+ was rewritten to use junky FSF char tables. Meanwhile I rewrote it
+ to use more logical char tables. RMS also discards the "list of four
+ tables" format and instead stuffs the other tables as "extra slots"
+ in the downcase table. I've kept the four-lists format for now. */
+
+/* Written by Howard Gayle. See some mythical and not-in-the-Emacs-
+ distribution file chartab.c for details. */
+
+/* Modified for Mule by Ben Wing. */
+
+/* #### We do not currently deal properly with translating non-ASCII
+ (including Latin-1!) characters under Mule. Getting this right is
+ *hard*, way fucking hard. So we at least preserve consistency by
+ sanitizing all the case tables to remove translations that would
+ get us into trouble and possibly result in inconsistent internal
+ text, which would likely lead to crashes. */
+
+#include <config.h>
+#include "lisp.h"
+#include "buffer.h"
+#include "opaque.h"
+
+Lisp_Object Qcase_table_p;
+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);
+
+#define STRING256_P(obj) (STRINGP (obj) && XSTRING_CHAR_LENGTH (obj) == 256)
+
+DEFUN ("case-table-p", Fcase_table_p, 1, 1, 0, /*
+Return t if ARG is a case table.
+See `set-case-table' for more information on these data structures.
+*/
+ (table))
+{
+ Lisp_Object down, up, canon, eqv;
+ if (!CONSP (table)) return Qnil; down = XCAR (table); table = XCDR (table);
+ if (!CONSP (table)) return Qnil; up = XCAR (table); table = XCDR (table);
+ if (!CONSP (table)) return Qnil; canon = XCAR (table); table = XCDR (table);
+ if (!CONSP (table)) return Qnil; eqv = XCAR (table);
+
+ return (STRING256_P (down)
+ && (NILP (up) || STRING256_P (up))
+ && ((NILP (canon) && NILP (eqv))
+ || (STRING256_P (canon)
+ && (NILP (eqv) || STRING256_P (eqv))))
+ ? Qt : Qnil);
+}
+
+static Lisp_Object
+check_case_table (Lisp_Object obj)
+{
+ REGISTER Lisp_Object tem;
+
+ while (tem = Fcase_table_p (obj), NILP (tem))
+ obj = wrong_type_argument (Qcase_table_p, obj);
+ return (obj);
+}
+
+DEFUN ("current-case-table", Fcurrent_case_table, 0, 1, 0, /*
+Return the case table of BUFFER, which defaults to the current buffer.
+*/
+ (buffer))
+{
+ struct buffer *buf = decode_buffer (buffer, 0);
+
+ return list4 (buf->downcase_table,
+ buf->upcase_table,
+ buf->case_canon_table,
+ buf->case_eqv_table);
+}
+
+DEFUN ("standard-case-table", Fstandard_case_table, 0, 0, 0, /*
+Return the standard case table.
+This is the one used for new buffers.
+*/
+ ())
+{
+ return list4 (Vascii_downcase_table,
+ Vascii_upcase_table,
+ Vascii_canon_table,
+ Vascii_eqv_table);
+}
+
+static Lisp_Object set_case_table (Lisp_Object table, int standard);
+
+
+DEFUN ("set-case-table", Fset_case_table, 1, 1, 0, /*
+Select a new case table for the current buffer.
+A case table is a list (DOWNCASE UPCASE CANONICALIZE EQUIVALENCES)
+ where each element is either nil or a string of length 256.
+DOWNCASE maps each character to its lower-case equivalent.
+UPCASE maps each character to its upper-case equivalent;
+ if lower and upper case characters are in 1-1 correspondence,
+ you may use nil and the upcase table will be deduced from DOWNCASE.
+CANONICALIZE maps each character to a canonical equivalent;
+ any two characters that are related by case-conversion have the same
+ canonical equivalent character; it may be nil, in which case it is
+ deduced from DOWNCASE and UPCASE.
+EQUIVALENCES is a map that cyclicly permutes each equivalence class
+ (of characters with the same canonical equivalent); it may be nil,
+ in which case it is deduced from CANONICALIZE.
+
+BUG: Under XEmacs/Mule, translations to or from non-ASCII characters
+ (this includes chars in the range 128 - 255) are ignored by
+ the string/buffer-searching routines. Thus, `case-fold-search'
+ will not correctly conflate a-umlaut and A-umlaut even if the
+ case tables call for this.
+*/
+ (table))
+{
+ return set_case_table (table, 0);
+}
+
+DEFUN ("set-standard-case-table", Fset_standard_case_table, 1, 1, 0, /*
+Select a new standard case table for new buffers.
+See `set-case-table' for more info on case tables.
+*/
+ (table))
+{
+ return set_case_table (table, 1);
+}
+
+#ifdef MULE
+
+static Lisp_Object
+make_mirror_trt_table (Lisp_Object table)
+{
+ Lisp_Object new_table;
+
+ if (!STRING256_P (table))
+ {
+#ifdef DEBUG_XEMACS
+ /* This should be caught farther up. */
+ abort ();
+#else
+ signal_simple_error ("Invalid translate table", table);
+#endif
+ }
+
+ new_table = MAKE_MIRROR_TRT_TABLE ();
+ {
+ int i;
+
+ for (i = 0; i < 256; i++)
+ {
+ Emchar newval = string_char (XSTRING (table), i);
+ if ((i >= 128 && newval != i)
+ || (i < 128 && newval >= 128))
+ {
+ newval = (Emchar) i;
+ }
+ SET_MIRROR_TRT_TABLE_CHAR_1 (new_table, i, newval);
+ }
+ }
+ return new_table;
+}
+
+#endif /* MULE */
+
+static Lisp_Object
+set_case_table (Lisp_Object table, int standard)
+{
+ Lisp_Object down, up, canon, eqv, tail = table;
+ struct buffer *buf = current_buffer;
+
+ check_case_table (table);
+
+ down = XCAR (tail); tail = XCDR (tail);
+ up = XCAR (tail); tail = XCDR (tail);
+ canon = XCAR (tail); tail = XCDR (tail);
+ eqv = XCAR (tail);
+
+ if (NILP (up))
+ {
+ up = MAKE_TRT_TABLE ();
+ compute_trt_inverse (down, up);
+ }
+
+ if (NILP (canon))
+ {
+ REGISTER Charcount i;
+
+ canon = MAKE_TRT_TABLE ();
+
+ /* Set up the CANON vector; for each character,
+ this sequence of upcasing and downcasing ought to
+ get the "preferred" lowercase equivalent. */
+ for (i = 0; i < 256; i++)
+ SET_TRT_TABLE_CHAR_1 (canon, i,
+ TRT_TABLE_CHAR_1
+ (down,
+ TRT_TABLE_CHAR_1
+ (up,
+ TRT_TABLE_CHAR_1 (down, i))));
+ }
+
+ if (NILP (eqv))
+ {
+ eqv = MAKE_TRT_TABLE ();
+
+ compute_trt_inverse (canon, eqv);
+ }
+
+ if (standard)
+ {
+ Vascii_downcase_table = down;
+ Vascii_upcase_table = up;
+ Vascii_canon_table = canon;
+ Vascii_eqv_table = eqv;
+#ifdef MULE
+ Vmirror_ascii_downcase_table = make_mirror_trt_table (down);
+ Vmirror_ascii_upcase_table = make_mirror_trt_table (up);
+ Vmirror_ascii_canon_table = make_mirror_trt_table (canon);
+ Vmirror_ascii_eqv_table = make_mirror_trt_table (eqv);
+#endif
+ }
+ else
+ {
+ buf->downcase_table = down;
+ buf->upcase_table = up;
+ buf->case_canon_table = canon;
+ buf->case_eqv_table = eqv;
+#ifdef MULE
+ buf->mirror_downcase_table = make_mirror_trt_table (down);
+ buf->mirror_upcase_table = make_mirror_trt_table (up);
+ buf->mirror_case_canon_table = make_mirror_trt_table (canon);
+ buf->mirror_case_eqv_table = make_mirror_trt_table (eqv);
+#endif
+ }
+ return table;
+}
+\f
+/* Given a translate table TRT, store the inverse mapping into INVERSE.
+ Since TRT is not one-to-one, INVERSE is not a simple mapping.
+ Instead, it divides the space of characters into equivalence classes.
+ All characters in a given class form one circular list, chained through
+ the elements of INVERSE. */
+
+static void
+compute_trt_inverse (Lisp_Object trt, Lisp_Object inverse)
+{
+ Charcount i = 0400;
+ Emchar c, q;
+
+ while (--i)
+ SET_TRT_TABLE_CHAR_1 (inverse, i, (Emchar) i);
+ i = 0400;
+ while (--i)
+ {
+ if ((q = TRT_TABLE_CHAR_1 (trt, i)) != (Emchar) i)
+ {
+ c = TRT_TABLE_CHAR_1 (inverse, q);
+ SET_TRT_TABLE_CHAR_1 (inverse, q, (Emchar) i);
+ SET_TRT_TABLE_CHAR_1 (inverse, i, c);
+ }
+ }
+}
+
+\f
+void
+syms_of_casetab (void)
+{
+ defsymbol (&Qcase_table_p, "case-table-p");
+ defsymbol (&Qtranslate_table, "translate-table");
+
+ DEFSUBR (Fcase_table_p);
+ DEFSUBR (Fcurrent_case_table);
+ DEFSUBR (Fstandard_case_table);
+ DEFSUBR (Fset_case_table);
+ DEFSUBR (Fset_standard_case_table);
+}
+
+void
+complex_vars_of_casetab (void)
+{
+ REGISTER Emchar i;
+ Lisp_Object tem;
+
+ staticpro (&Vascii_downcase_table);
+ staticpro (&Vascii_upcase_table);
+ staticpro (&Vascii_canon_table);
+ staticpro (&Vascii_eqv_table);
+
+ tem = MAKE_TRT_TABLE ();
+ Vascii_downcase_table = tem;
+ Vascii_canon_table = tem;
+
+ /* Under Mule, can't do set_string_char() until Vcharset_control_1
+ and Vcharset_ascii are initialized. */
+ for (i = 0; i < 256; i++)
+ {
+ unsigned char lowered = tolower (i);
+
+ SET_TRT_TABLE_CHAR_1 (tem, i, lowered);
+ }
+
+#ifdef MULE
+ tem = make_mirror_trt_table (tem);
+ Vmirror_ascii_downcase_table = tem;
+ Vmirror_ascii_canon_table = tem;
+#endif
+
+ tem = MAKE_TRT_TABLE ();
+ Vascii_upcase_table = tem;
+ Vascii_eqv_table = tem;
+
+ for (i = 0; i < 256; i++)
+ {
+ unsigned char flipped = (isupper (i) ? tolower (i)
+ : (islower (i) ? toupper (i) : i));
+
+ SET_TRT_TABLE_CHAR_1 (tem, i, flipped);
+ }
+
+#ifdef MULE
+ tem = make_mirror_trt_table (tem);
+ Vmirror_ascii_upcase_table = tem;
+ Vmirror_ascii_eqv_table = tem;
+#endif
+}
--- /dev/null
+/* XEmacs routines to deal with char tables.
+ Copyright (C) 1992, 1995 Free Software Foundation, Inc.
+ Copyright (C) 1995 Sun Microsystems, 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: Mule 2.3. Not synched with FSF.
+
+ This file was written independently of the FSF implementation,
+ and is not compatible. */
+
+/* Authorship:
+
+ Ben Wing: wrote, for 19.13 (Mule). Some category table stuff
+ loosely based on the original Mule.
+ Jareth Hein: fixed a couple of bugs in the implementation, and
+ added regex support for categories with check_category_at
+ */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "chartab.h"
+#include "commands.h"
+#include "syntax.h"
+
+Lisp_Object Qchar_tablep, Qchar_table;
+
+Lisp_Object Vall_syntax_tables;
+
+#ifdef MULE
+Lisp_Object Qcategory_table_p;
+Lisp_Object Qcategory_designator_p;
+Lisp_Object Qcategory_table_value_p;
+
+Lisp_Object Vstandard_category_table;
+#endif /* MULE */
+
+\f
+/* A char table maps from ranges of characters to values.
+
+ Implementing a general data structure that maps from arbitrary
+ ranges of numbers to values is tricky to do efficiently. As it
+ happens, it should suffice (and is usually more convenient, anyway)
+ when dealing with characters to restrict the sorts of ranges that
+ can be assigned values, as follows:
+
+ 1) All characters.
+ 2) All characters in a charset.
+ 3) All characters in a particular row of a charset, where a "row"
+ means all characters with the same first byte.
+ 4) A particular character in a charset.
+
+ We use char tables to generalize the 256-element vectors now
+ littering the Emacs code.
+
+ Possible uses (all should be converted at some point):
+
+ 1) category tables
+ 2) syntax tables
+ 3) display tables
+ 4) case tables
+ 5) keyboard-translate-table?
+
+ We provide an
+ abstract type to generalize the Emacs vectors and Mule
+ vectors-of-vectors goo.
+ */
+
+/************************************************************************/
+/* Char Table object */
+/************************************************************************/
+
+#ifdef MULE
+
+static Lisp_Object
+mark_char_table_entry (Lisp_Object obj, void (*markobj) (Lisp_Object))
+{
+ struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
+ int i;
+
+ for (i = 0; i < 96; i++)
+ {
+ (markobj) (cte->level2[i]);
+ }
+ return Qnil;
+}
+
+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);
+ int i;
+
+ for (i = 0; i < 96; i++)
+ if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
+ return 0;
+
+ return 1;
+}
+
+static unsigned long
+char_table_entry_hash (Lisp_Object obj, int depth)
+{
+ struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
+
+ return internal_array_hash (cte->level2, 96, depth);
+}
+
+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);
+#endif /* MULE */
+
+static Lisp_Object
+mark_char_table (Lisp_Object obj, void (*markobj) (Lisp_Object))
+{
+ struct Lisp_Char_Table *ct = XCHAR_TABLE (obj);
+ int i;
+
+ for (i = 0; i < NUM_ASCII_CHARS; i++)
+ (markobj) (ct->ascii[i]);
+#ifdef MULE
+ for (i = 0; i < NUM_LEADING_BYTES; i++)
+ (markobj) (ct->level1[i]);
+#endif
+ return ct->mirror_table;
+}
+
+/* WARNING: All functions of this nature need to be written extremely
+ carefully to avoid crashes during GC. Cf. prune_specifiers()
+ and prune_weak_hashtables(). */
+
+void
+prune_syntax_tables (int (*obj_marked_p) (Lisp_Object))
+{
+ Lisp_Object rest, prev = Qnil;
+
+ for (rest = Vall_syntax_tables;
+ !GC_NILP (rest);
+ rest = XCHAR_TABLE (rest)->next_table)
+ {
+ if (! ((*obj_marked_p) (rest)))
+ {
+ /* This table is garbage. Remove it from the list. */
+ if (GC_NILP (prev))
+ Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
+ else
+ XCHAR_TABLE (prev)->next_table =
+ XCHAR_TABLE (rest)->next_table;
+ }
+ }
+}
+
+static Lisp_Object
+char_table_type_to_symbol (enum char_table_type type)
+{
+ switch (type)
+ {
+ case CHAR_TABLE_TYPE_GENERIC: return Qgeneric;
+ case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax;
+ case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay;
+ case CHAR_TABLE_TYPE_CHAR: return Qchar;
+#ifdef MULE
+ case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
+#endif
+ }
+
+ abort ();
+ return Qnil; /* not reached */
+}
+
+static enum char_table_type
+symbol_to_char_table_type (Lisp_Object symbol)
+{
+ CHECK_SYMBOL (symbol);
+
+ if (EQ (symbol, Qgeneric)) return CHAR_TABLE_TYPE_GENERIC;
+ if (EQ (symbol, Qsyntax)) return CHAR_TABLE_TYPE_SYNTAX;
+ if (EQ (symbol, Qdisplay)) return CHAR_TABLE_TYPE_DISPLAY;
+ if (EQ (symbol, Qchar)) return CHAR_TABLE_TYPE_CHAR;
+#ifdef MULE
+ if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
+#endif
+
+ signal_simple_error ("Unrecognized char table type", symbol);
+ return CHAR_TABLE_TYPE_GENERIC; /* not reached */
+}
+
+static void
+print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
+ Lisp_Object printcharfun)
+{
+ if (first != last)
+ {
+ write_c_string (" (", printcharfun);
+ print_internal (make_char (first), printcharfun, 0);
+ write_c_string (" ", printcharfun);
+ print_internal (make_char (last), printcharfun, 0);
+ write_c_string (") ", printcharfun);
+ }
+ else
+ {
+ write_c_string (" ", printcharfun);
+ print_internal (make_char (first), printcharfun, 0);
+ write_c_string (" ", printcharfun);
+ }
+ print_internal (val, printcharfun, 1);
+}
+
+#ifdef MULE
+
+static void
+print_chartab_charset_row (Lisp_Object charset,
+ int row,
+ struct Lisp_Char_Table_Entry *cte,
+ Lisp_Object printcharfun)
+{
+ int i;
+ Lisp_Object cat = Qunbound;
+ int first = -1;
+
+ for (i = 32; i < 128; i++)
+ {
+ Lisp_Object pam = cte->level2[i - 32];
+
+ if (first == -1)
+ {
+ first = i;
+ cat = pam;
+ continue;
+ }
+
+ if (!EQ (cat, pam))
+ {
+ if (row == -1)
+ print_chartab_range (MAKE_CHAR (charset, first, 0),
+ MAKE_CHAR (charset, i - 1, 0),
+ cat, printcharfun);
+ else
+ print_chartab_range (MAKE_CHAR (charset, row, first),
+ MAKE_CHAR (charset, row, i - 1),
+ cat, printcharfun);
+ first = -1;
+ i--;
+ }
+ }
+
+ if (first != -1)
+ {
+ if (row == -1)
+ print_chartab_range (MAKE_CHAR (charset, first, 0),
+ MAKE_CHAR (charset, i - 1, 0),
+ cat, printcharfun);
+ else
+ print_chartab_range (MAKE_CHAR (charset, row, first),
+ MAKE_CHAR (charset, row, i - 1),
+ cat, printcharfun);
+ }
+}
+
+static void
+print_chartab_two_byte_charset (Lisp_Object charset,
+ struct Lisp_Char_Table_Entry *cte,
+ Lisp_Object printcharfun)
+{
+ int i;
+
+ for (i = 32; i < 128; i++)
+ {
+ Lisp_Object jen = cte->level2[i - 32];
+
+ if (!CHAR_TABLE_ENTRYP (jen))
+ {
+ char buf[100];
+
+ write_c_string (" [", printcharfun);
+ print_internal (XCHARSET_NAME (charset), printcharfun, 0);
+ sprintf (buf, " %d] ", i);
+ write_c_string (buf, printcharfun);
+ print_internal (jen, printcharfun, 0);
+ }
+ else
+ print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen),
+ printcharfun);
+ }
+}
+
+#endif /* MULE */
+
+static void
+print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+ struct Lisp_Char_Table *ct = XCHAR_TABLE (obj);
+ char buf[200];
+
+ sprintf (buf, "#s(char-table type %s data (",
+ string_data (symbol_name (XSYMBOL
+ (char_table_type_to_symbol (ct->type)))));
+ write_c_string (buf, printcharfun);
+
+ /* Now write out the ASCII/Control-1 stuff. */
+ {
+ int i;
+ int first = -1;
+ Lisp_Object val = Qunbound;
+
+ for (i = 0; i < NUM_ASCII_CHARS; i++)
+ {
+ if (first == -1)
+ {
+ first = i;
+ val = ct->ascii[i];
+ continue;
+ }
+
+ if (!EQ (ct->ascii[i], val))
+ {
+ print_chartab_range (first, i - 1, val, printcharfun);
+ first = -1;
+ i--;
+ }
+ }
+
+ if (first != -1)
+ print_chartab_range (first, i - 1, val, printcharfun);
+ }
+
+#ifdef MULE
+ {
+ int i;
+
+ for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
+ i++)
+ {
+ Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE];
+ Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i);
+
+ if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII
+ || i == LEADING_BYTE_CONTROL_1)
+ continue;
+ if (!CHAR_TABLE_ENTRYP (ann))
+ {
+ write_c_string (" ", printcharfun);
+ print_internal (XCHARSET_NAME (charset),
+ printcharfun, 0);
+ write_c_string (" ", printcharfun);
+ print_internal (ann, printcharfun, 0);
+ }
+ else
+ {
+ struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
+ if (XCHARSET_DIMENSION (charset) == 1)
+ print_chartab_charset_row (charset, -1, cte, printcharfun);
+ else
+ print_chartab_two_byte_charset (charset, cte, printcharfun);
+ }
+ }
+ }
+#endif /* MULE */
+
+ write_c_string ("))", printcharfun);
+}
+
+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);
+ int i;
+
+ if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
+ return 0;
+
+ for (i = 0; i < NUM_ASCII_CHARS; i++)
+ if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1))
+ return 0;
+
+#ifdef MULE
+ for (i = 0; i < NUM_LEADING_BYTES; i++)
+ if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1))
+ return 0;
+#endif /* MULE */
+
+ return 1;
+}
+
+static unsigned long
+char_table_hash (Lisp_Object obj, int depth)
+{
+ struct Lisp_Char_Table *ct = XCHAR_TABLE (obj);
+ unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
+ depth);
+#ifdef MULE
+ hashval = HASH2 (hashval,
+ internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
+#endif /* MULE */
+ return hashval;
+}
+
+DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
+ mark_char_table, print_char_table, 0,
+ char_table_equal, char_table_hash,
+ struct Lisp_Char_Table);
+
+DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
+Return non-nil if OBJECT is a char table.
+
+A char table is a table that maps characters (or ranges of characters)
+to values. Char tables are specialized for characters, only allowing
+particular sorts of ranges to be assigned values. Although this
+loses in generality, it makes for extremely fast (constant-time)
+lookups, and thus is feasible for applications that do an extremely
+large number of lookups (e.g. scanning a buffer for a character in
+a particular syntax, where a lookup in the syntax table must occur
+once per character).
+
+When Mule support exists, the types of ranges that can be assigned
+values are
+
+-- all characters
+-- an entire charset
+-- a single row in a two-octet charset
+-- a single character
+
+When Mule support is not present, the types of ranges that can be
+assigned values are
+
+-- all characters
+-- a single character
+
+To create a char table, use `make-char-table'. To modify a char
+table, use `put-char-table' or `remove-char-table'. To retrieve the
+value for a particular character, use `get-char-table'. See also
+`map-char-table', `clear-char-table', `copy-char-table',
+`valid-char-table-type-p', `char-table-type-list', `valid-char-table-value-p',
+and `check-char-table-value'.
+*/
+ (object))
+{
+ return CHAR_TABLEP (object) ? Qt : Qnil;
+}
+
+DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
+Return a list of the recognized char table types.
+See `valid-char-table-type-p'.
+*/
+ ())
+{
+#ifdef MULE
+ return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
+#else
+ return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);
+#endif
+}
+
+DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
+Return t if TYPE if a recognized char table type.
+
+Each char table type is used for a different purpose and allows different
+sorts of values. The different char table types are
+
+`category'
+ Used for category tables, which specify the regexp categories
+ that a character is in. The valid values are 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 Mule support is present.
+`char'
+ A generalized char table, for mapping from one character to
+ another. Used for case tables, syntax matching tables,
+ `keyboard-translate-table', etc. The valid values are characters.
+`generic'
+ An even more generalized char table, for mapping from a
+ character to anything.
+`display'
+ Used for display tables, which specify how a particular character
+ is to appear when displayed. #### Not yet implemented.
+`syntax'
+ Used for syntax tables, which specify the syntax of a particular
+ character. Higher-level Lisp functions are provided for
+ working with syntax tables. The valid values are integers.
+
+*/
+ (type))
+{
+ return (EQ (type, Qchar) ||
+#ifdef MULE
+ EQ (type, Qcategory) ||
+#endif
+ EQ (type, Qdisplay) ||
+ EQ (type, Qgeneric) ||
+ EQ (type, Qsyntax)) ? Qt : Qnil;
+}
+
+DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
+Return the type of char table TABLE.
+See `valid-char-table-type-p'.
+*/
+ (table))
+{
+ CHECK_CHAR_TABLE (table);
+ return char_table_type_to_symbol (XCHAR_TABLE (table)->type);
+}
+
+void
+fill_char_table (struct Lisp_Char_Table *ct, Lisp_Object value)
+{
+ int i;
+
+ for (i = 0; i < NUM_ASCII_CHARS; i++)
+ ct->ascii[i] = value;
+#ifdef MULE
+ for (i = 0; i < NUM_LEADING_BYTES; i++)
+ ct->level1[i] = value;
+#endif /* MULE */
+
+ if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
+ update_syntax_table (ct);
+}
+
+DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
+Reset a char table to its default state.
+*/
+ (table))
+{
+ struct Lisp_Char_Table *ct;
+
+ CHECK_CHAR_TABLE (table);
+ ct = XCHAR_TABLE (table);
+
+ switch (ct->type)
+ {
+ case CHAR_TABLE_TYPE_CHAR:
+ case CHAR_TABLE_TYPE_DISPLAY:
+ case CHAR_TABLE_TYPE_GENERIC:
+#ifdef MULE
+ case CHAR_TABLE_TYPE_CATEGORY:
+ fill_char_table (ct, Qnil);
+ break;
+#endif /* MULE */
+
+ case CHAR_TABLE_TYPE_SYNTAX:
+ fill_char_table (ct, make_int (Sinherit));
+ break;
+
+ default:
+ abort ();
+ }
+
+ return Qnil;
+}
+
+DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
+Return a new, empty char table of type TYPE.
+Currently recognized types are 'char, 'category, 'display, 'generic,
+and 'syntax. See `valid-char-table-type-p'.
+*/
+ (type))
+{
+ struct 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->type = ty;
+ if (ty == CHAR_TABLE_TYPE_SYNTAX)
+ {
+ ct->mirror_table = Fmake_char_table (Qgeneric);
+ fill_char_table (XCHAR_TABLE (ct->mirror_table),
+ make_int (Spunct));
+ }
+ else
+ ct->mirror_table = Qnil;
+ ct->next_table = Qnil;
+ XSETCHAR_TABLE (obj, ct);
+ if (ty == CHAR_TABLE_TYPE_SYNTAX)
+ {
+ ct->next_table = Vall_syntax_tables;
+ Vall_syntax_tables = obj;
+ }
+ Freset_char_table (obj);
+ return obj;
+}
+
+#ifdef MULE
+
+static Lisp_Object
+make_char_table_entry (Lisp_Object initval)
+{
+ Lisp_Object obj;
+ int i;
+ struct Lisp_Char_Table_Entry *cte =
+ alloc_lcrecord_type (struct Lisp_Char_Table_Entry,
+ lrecord_char_table_entry);
+
+ for (i = 0; i < 96; i++)
+ cte->level2[i] = initval;
+
+ XSETCHAR_TABLE_ENTRY (obj, cte);
+ return obj;
+}
+
+static Lisp_Object
+copy_char_table_entry (Lisp_Object entry)
+{
+ struct 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);
+
+ for (i = 0; i < 96; i++)
+ {
+ Lisp_Object new = cte->level2[i];
+ if (CHAR_TABLE_ENTRYP (new))
+ ctenew->level2[i] = copy_char_table_entry (new);
+ else
+ ctenew->level2[i] = new;
+ }
+
+ XSETCHAR_TABLE_ENTRY (obj, ctenew);
+ return obj;
+}
+
+#endif /* MULE */
+
+DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
+Make a new char table which is a copy of OLD-TABLE.
+It will contain the same values for the same characters and ranges
+as OLD-TABLE. The values will not themselves be copied.
+*/
+ (old_table))
+{
+ struct 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->type = ct->type;
+
+ for (i = 0; i < NUM_ASCII_CHARS; i++)
+ {
+ Lisp_Object new = ct->ascii[i];
+#ifdef MULE
+ assert (! (CHAR_TABLE_ENTRYP (new)));
+#endif /* MULE */
+ ctnew->ascii[i] = new;
+ }
+
+#ifdef MULE
+
+ for (i = 0; i < NUM_LEADING_BYTES; i++)
+ {
+ Lisp_Object new = ct->level1[i];
+ if (CHAR_TABLE_ENTRYP (new))
+ ctnew->level1[i] = copy_char_table_entry (new);
+ else
+ ctnew->level1[i] = new;
+ }
+
+#endif /* MULE */
+
+ if (CHAR_TABLEP (ct->mirror_table))
+ ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
+ else
+ ctnew->mirror_table = ct->mirror_table;
+ XSETCHAR_TABLE (obj, ctnew);
+ return obj;
+}
+
+static void
+decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
+{
+ if (EQ (range, Qt))
+ outrange->type = CHARTAB_RANGE_ALL;
+ else if (CHAR_OR_CHAR_INTP (range))
+ {
+ outrange->type = CHARTAB_RANGE_CHAR;
+ outrange->ch = XCHAR_OR_CHAR_INT (range);
+ }
+#ifndef MULE
+ else
+ signal_simple_error ("Range must be t or a character", range);
+#else /* MULE */
+ else if (VECTORP (range))
+ {
+ struct 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",
+ range);
+ outrange->type = CHARTAB_RANGE_ROW;
+ outrange->charset = Fget_charset (elts[0]);
+ CHECK_INT (elts[1]);
+ outrange->row = XINT (elts[1]);
+ switch (XCHARSET_TYPE (outrange->charset))
+ {
+ case CHARSET_TYPE_94:
+ case CHARSET_TYPE_96:
+ signal_simple_error ("Charset in row vector must be multi-byte",
+ outrange->charset);
+ case CHARSET_TYPE_94X94:
+ check_int_range (outrange->row, 33, 126);
+ break;
+ case CHARSET_TYPE_96X96:
+ check_int_range (outrange->row, 32, 127);
+ break;
+ default:
+ abort ();
+ }
+ }
+ else
+ {
+ if (!CHARSETP (range) && !SYMBOLP (range))
+ signal_simple_error
+ ("Char table range must be t, charset, char, or vector", range);
+ outrange->type = CHARTAB_RANGE_CHARSET;
+ outrange->charset = Fget_charset (range);
+ }
+#endif /* MULE */
+}
+
+#ifdef MULE
+
+/* called from CHAR_TABLE_VALUE(). */
+Lisp_Object
+get_non_ascii_char_table_value (struct Lisp_Char_Table *ct, int leading_byte,
+ Emchar c)
+{
+ Lisp_Object val;
+ Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
+ int byte1, byte2;
+
+ BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
+ val = ct->level1[leading_byte - MIN_LEADING_BYTE];
+ if (CHAR_TABLE_ENTRYP (val))
+ {
+ struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
+ val = cte->level2[byte1 - 32];
+ if (CHAR_TABLE_ENTRYP (val))
+ {
+ cte = XCHAR_TABLE_ENTRY (val);
+ assert (byte2 >= 32);
+ val = cte->level2[byte2 - 32];
+ assert (!CHAR_TABLE_ENTRYP (val));
+ }
+ }
+
+ return val;
+}
+
+#endif /* MULE */
+
+static Lisp_Object
+get_char_table (Emchar ch, struct Lisp_Char_Table *ct)
+{
+#ifdef MULE
+ {
+ Lisp_Object charset;
+ int byte1, byte2;
+ Lisp_Object val;
+
+ BREAKUP_CHAR (ch, charset, byte1, byte2);
+
+ if (EQ (charset, Vcharset_ascii))
+ val = ct->ascii[byte1];
+ else if (EQ (charset, Vcharset_control_1))
+ val = ct->ascii[byte1 + 128];
+ else
+ {
+ int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
+ val = ct->level1[lb];
+ if (CHAR_TABLE_ENTRYP (val))
+ {
+ struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
+ val = cte->level2[byte1 - 32];
+ if (CHAR_TABLE_ENTRYP (val))
+ {
+ cte = XCHAR_TABLE_ENTRY (val);
+ assert (byte2 >= 32);
+ val = cte->level2[byte2 - 32];
+ assert (!CHAR_TABLE_ENTRYP (val));
+ }
+ }
+ }
+
+ return val;
+ }
+#else /* not MULE */
+ return ct->ascii[(unsigned char)ch];
+#endif /* not MULE */
+}
+
+
+DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
+Find value for char CH in TABLE.
+*/
+ (ch, table))
+{
+ struct Lisp_Char_Table *ct;
+
+ CHECK_CHAR_TABLE (table);
+ ct = XCHAR_TABLE (table);
+ CHECK_CHAR_COERCE_INT (ch);
+
+ return get_char_table (XCHAR (ch), ct);
+}
+
+DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
+Find value for a range in TABLE.
+If there is more than one value, return MULTI (defaults to nil).
+*/
+ (range, table, multi))
+{
+ struct Lisp_Char_Table *ct;
+ struct chartab_range rainj;
+
+ if (CHAR_OR_CHAR_INTP (range))
+ return Fget_char_table (range, table);
+ CHECK_CHAR_TABLE (table);
+ ct = XCHAR_TABLE (table);
+
+ decode_char_table_range (range, &rainj);
+ switch (rainj.type)
+ {
+ case CHARTAB_RANGE_ALL:
+ {
+ int i;
+ Lisp_Object first = ct->ascii[0];
+
+ for (i = 1; i < NUM_ASCII_CHARS; i++)
+ if (!EQ (first, ct->ascii[i]))
+ return multi;
+
+#ifdef MULE
+ for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
+ i++)
+ {
+ if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
+ || i == LEADING_BYTE_ASCII
+ || i == LEADING_BYTE_CONTROL_1)
+ continue;
+ if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
+ return multi;
+ }
+#endif /* MULE */
+
+ return first;
+ }
+
+#ifdef MULE
+ case CHARTAB_RANGE_CHARSET:
+ if (EQ (rainj.charset, Vcharset_ascii))
+ {
+ int i;
+ Lisp_Object first = ct->ascii[0];
+
+ for (i = 1; i < 128; i++)
+ if (!EQ (first, ct->ascii[i]))
+ return multi;
+ return first;
+ }
+
+ if (EQ (rainj.charset, Vcharset_control_1))
+ {
+ int i;
+ Lisp_Object first = ct->ascii[128];
+
+ for (i = 129; i < 160; i++)
+ if (!EQ (first, ct->ascii[i]))
+ return multi;
+ return first;
+ }
+
+ {
+ Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
+ MIN_LEADING_BYTE];
+ if (CHAR_TABLE_ENTRYP (val))
+ return multi;
+ return val;
+ }
+
+ case CHARTAB_RANGE_ROW:
+ {
+ Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
+ MIN_LEADING_BYTE];
+ if (!CHAR_TABLE_ENTRYP (val))
+ return val;
+ val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
+ if (CHAR_TABLE_ENTRYP (val))
+ return multi;
+ return val;
+ }
+#endif /* not MULE */
+
+ default:
+ abort ();
+ }
+
+ return Qnil; /* not reached */
+}
+
+static int
+check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
+ Error_behavior errb)
+{
+ switch (type)
+ {
+ case CHAR_TABLE_TYPE_SYNTAX:
+ if (!ERRB_EQ (errb, ERROR_ME))
+ return INTP (value) || (CONSP (value) && INTP (XCAR (value))
+ && CHAR_OR_CHAR_INTP (XCDR (value)));
+ if (CONSP (value))
+ {
+ Lisp_Object cdr = XCDR (value);
+ CHECK_INT (XCAR (value));
+ CHECK_CHAR_COERCE_INT (cdr);
+ }
+ else
+ CHECK_INT (value);
+ break;
+
+#ifdef MULE
+ case CHAR_TABLE_TYPE_CATEGORY:
+ if (!ERRB_EQ (errb, ERROR_ME))
+ return CATEGORY_TABLE_VALUEP (value);
+ CHECK_CATEGORY_TABLE_VALUE (value);
+ break;
+#endif /* MULE */
+
+ case CHAR_TABLE_TYPE_GENERIC:
+ return 1;
+
+ case CHAR_TABLE_TYPE_DISPLAY:
+ /* #### fix this */
+ maybe_signal_simple_error ("Display char tables not yet implemented",
+ value, Qchar_table, errb);
+ return 0;
+
+ case CHAR_TABLE_TYPE_CHAR:
+ if (!ERRB_EQ (errb, ERROR_ME))
+ return CHAR_OR_CHAR_INTP (value);
+ CHECK_CHAR_COERCE_INT (value);
+ break;
+
+ default:
+ abort ();
+ }
+
+ return 0; /* not reached */
+}
+
+static Lisp_Object
+canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)
+{
+ switch (type)
+ {
+ case CHAR_TABLE_TYPE_SYNTAX:
+ if (CONSP (value))
+ {
+ Lisp_Object car = XCAR (value);
+ Lisp_Object cdr = XCDR (value);
+ CHECK_CHAR_COERCE_INT (cdr);
+ return Fcons (car, cdr);
+ }
+ default:
+ break;
+ }
+ return value;
+}
+
+DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
+Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE.
+*/
+ (value, char_table_type))
+{
+ enum char_table_type type = symbol_to_char_table_type (char_table_type);
+
+ return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;
+}
+
+DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
+Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
+*/
+ (value, char_table_type))
+{
+ enum char_table_type type = symbol_to_char_table_type (char_table_type);
+
+ check_valid_char_table_value (value, type, ERROR_ME);
+ return Qnil;
+}
+
+/* Assign VAL to all characters in RANGE in char table CT. */
+
+void
+put_char_table (struct Lisp_Char_Table *ct, struct chartab_range *range,
+ Lisp_Object val)
+{
+ switch (range->type)
+ {
+ case CHARTAB_RANGE_ALL:
+ fill_char_table (ct, val);
+ return; /* avoid the duplicate call to update_syntax_table() below,
+ since fill_char_table() also did that. */
+
+#ifdef MULE
+ case CHARTAB_RANGE_CHARSET:
+ if (EQ (range->charset, Vcharset_ascii))
+ {
+ int i;
+ for (i = 0; i < 128; i++)
+ ct->ascii[i] = val;
+ }
+ else if (EQ (range->charset, Vcharset_control_1))
+ {
+ int i;
+ for (i = 128; i < 160; i++)
+ ct->ascii[i] = val;
+ }
+ else
+ {
+ int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
+ ct->level1[lb] = val;
+ }
+ break;
+
+ case CHARTAB_RANGE_ROW:
+ {
+ struct 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]))
+ ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
+ cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
+ cte->level2[range->row - 32] = val;
+ }
+ break;
+#endif /* MULE */
+
+ case CHARTAB_RANGE_CHAR:
+#ifdef MULE
+ {
+ Lisp_Object charset;
+ int byte1, byte2;
+
+ BREAKUP_CHAR (range->ch, charset, byte1, byte2);
+ if (EQ (charset, Vcharset_ascii))
+ ct->ascii[byte1] = val;
+ else if (EQ (charset, Vcharset_control_1))
+ ct->ascii[byte1 + 128] = val;
+ else
+ {
+ struct 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]))
+ ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
+ cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
+ /* now CTE is a char table entry for the charset;
+ each entry is for a single row (or character of
+ a one-octet charset). */
+ if (XCHARSET_DIMENSION (charset) == 1)
+ cte->level2[byte1 - 32] = val;
+ else
+ {
+ /* assigning to one character in a two-octet charset. */
+ /* make sure that the charset row contains a separate
+ entry for each character. */
+ if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
+ cte->level2[byte1 - 32] =
+ make_char_table_entry (cte->level2[byte1 - 32]);
+ cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
+ cte->level2[byte2 - 32] = val;
+ }
+ }
+ }
+#else /* not MULE */
+ ct->ascii[(unsigned char) (range->ch)] = val;
+ break;
+#endif /* not MULE */
+ }
+
+ if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
+ update_syntax_table (ct);
+}
+
+DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
+Set the value for chars in RANGE to be VAL in TABLE.
+
+RANGE specifies one or more characters to be affected and should be
+one of the following:
+
+-- t (all characters are affected)
+-- A charset (only allowed when Mule support is present)
+-- A vector of two elements: a two-octet charset and a row number
+ (only allowed when Mule support is present)
+-- A single character
+
+VAL must be a value appropriate for the type of TABLE.
+See `valid-char-table-type-p'.
+*/
+ (range, val, table))
+{
+ struct Lisp_Char_Table *ct;
+ struct chartab_range rainj;
+
+ CHECK_CHAR_TABLE (table);
+ ct = XCHAR_TABLE (table);
+ check_valid_char_table_value (val, ct->type, ERROR_ME);
+ decode_char_table_range (range, &rainj);
+ val = canonicalize_char_table_value (val, ct->type);
+ put_char_table (ct, &rainj, val);
+ return Qnil;
+}
+
+/* Map FN over the ASCII chars in CT. */
+
+static int
+map_over_charset_ascii (struct Lisp_Char_Table *ct,
+ int (*fn) (struct chartab_range *range,
+ Lisp_Object val, void *arg),
+ void *arg)
+{
+ struct chartab_range rainj;
+ int i, retval;
+ int start = 0;
+#ifdef MULE
+ int stop = 128;
+#else
+ int stop = 256;
+#endif
+
+ rainj.type = CHARTAB_RANGE_CHAR;
+
+ for (i = start, retval = 0; i < stop && retval == 0; i++)
+ {
+ rainj.ch = (Emchar) i;
+ retval = (fn) (&rainj, ct->ascii[i], arg);
+ }
+
+ return retval;
+}
+
+#ifdef MULE
+
+/* Map FN over the Control-1 chars in CT. */
+
+static int
+map_over_charset_control_1 (struct Lisp_Char_Table *ct,
+ int (*fn) (struct chartab_range *range,
+ Lisp_Object val, void *arg),
+ void *arg)
+{
+ struct chartab_range rainj;
+ int i, retval;
+ int start = 128;
+ int stop = start + 32;
+
+ rainj.type = CHARTAB_RANGE_CHAR;
+
+ for (i = start, retval = 0; i < stop && retval == 0; i++)
+ {
+ rainj.ch = (Emchar) (i);
+ retval = (fn) (&rainj, ct->ascii[i], arg);
+ }
+
+ return retval;
+}
+
+/* Map FN over the row ROW of two-byte charset CHARSET.
+ There must be a separate value for that row in the char table.
+ CTE specifies the char table entry for CHARSET. */
+
+static int
+map_over_charset_row (struct Lisp_Char_Table_Entry *cte,
+ Lisp_Object charset, int row,
+ int (*fn) (struct chartab_range *range,
+ Lisp_Object val, void *arg),
+ void *arg)
+{
+ Lisp_Object val = cte->level2[row - 32];
+
+ if (!CHAR_TABLE_ENTRYP (val))
+ {
+ struct chartab_range rainj;
+
+ rainj.type = CHARTAB_RANGE_ROW;
+ rainj.charset = charset;
+ rainj.row = row;
+ return (fn) (&rainj, val, arg);
+ }
+ else
+ {
+ struct chartab_range rainj;
+ int i, retval;
+ int charset94_p = (XCHARSET_CHARS (charset) == 94);
+ int start = charset94_p ? 33 : 32;
+ int stop = charset94_p ? 127 : 128;
+
+ cte = XCHAR_TABLE_ENTRY (val);
+
+ rainj.type = CHARTAB_RANGE_CHAR;
+
+ for (i = start, retval = 0; i < stop && retval == 0; i++)
+ {
+ rainj.ch = MAKE_CHAR (charset, row, i);
+ retval = (fn) (&rainj, cte->level2[i - 32], arg);
+ }
+ return retval;
+ }
+}
+
+
+static int
+map_over_other_charset (struct Lisp_Char_Table *ct, int lb,
+ int (*fn) (struct chartab_range *range,
+ Lisp_Object val, void *arg),
+ void *arg)
+{
+ Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
+ Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
+
+ if (!CHARSETP (charset)
+ || lb == LEADING_BYTE_ASCII
+ || lb == LEADING_BYTE_CONTROL_1)
+ return 0;
+
+ if (!CHAR_TABLE_ENTRYP (val))
+ {
+ struct chartab_range rainj;
+
+ rainj.type = CHARTAB_RANGE_CHARSET;
+ rainj.charset = charset;
+ return (fn) (&rainj, val, arg);
+ }
+
+ {
+ struct 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;
+ int i, retval;
+
+ if (XCHARSET_DIMENSION (charset) == 1)
+ {
+ struct chartab_range rainj;
+ rainj.type = CHARTAB_RANGE_CHAR;
+
+ for (i = start, retval = 0; i < stop && retval == 0; i++)
+ {
+ rainj.ch = MAKE_CHAR (charset, i, 0);
+ retval = (fn) (&rainj, cte->level2[i - 32], arg);
+ }
+ }
+ else
+ {
+ for (i = start, retval = 0; i < stop && retval == 0; i++)
+ retval = map_over_charset_row (cte, charset, i, fn, arg);
+ }
+
+ return retval;
+ }
+}
+
+#endif /* MULE */
+
+/* Map FN (with client data ARG) over range RANGE in char table CT.
+ Mapping stops the first time FN returns non-zero, and that value
+ becomes the return value of map_char_table(). */
+
+int
+map_char_table (struct Lisp_Char_Table *ct,
+ struct chartab_range *range,
+ int (*fn) (struct chartab_range *range,
+ Lisp_Object val, void *arg),
+ void *arg)
+{
+ switch (range->type)
+ {
+ case CHARTAB_RANGE_ALL:
+ {
+ int retval;
+
+ retval = map_over_charset_ascii (ct, fn, arg);
+ if (retval)
+ return retval;
+#ifdef MULE
+ retval = map_over_charset_control_1 (ct, fn, arg);
+ if (retval)
+ return retval;
+ {
+ int i;
+ int start = MIN_LEADING_BYTE;
+ int stop = start + NUM_LEADING_BYTES;
+
+ for (i = start, retval = 0; i < stop && retval == 0; i++)
+ {
+ retval = map_over_other_charset (ct, i, fn, arg);
+ }
+ }
+#endif /* MULE */
+ return retval;
+ }
+
+#ifdef MULE
+ case CHARTAB_RANGE_CHARSET:
+ return map_over_other_charset (ct,
+ XCHARSET_LEADING_BYTE (range->charset),
+ fn, arg);
+
+ case CHARTAB_RANGE_ROW:
+ {
+ Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE];
+ if (!CHAR_TABLE_ENTRYP (val))
+ {
+ struct chartab_range rainj;
+
+ rainj.type = CHARTAB_RANGE_ROW;
+ rainj.charset = range->charset;
+ rainj.row = range->row;
+ return (fn) (&rainj, val, arg);
+ }
+ else
+ return map_over_charset_row (XCHAR_TABLE_ENTRY (val),
+ range->charset, range->row,
+ fn, arg);
+ }
+#endif /* MULE */
+
+ case CHARTAB_RANGE_CHAR:
+ {
+ Emchar ch = range->ch;
+ Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch);
+ struct chartab_range rainj;
+
+ rainj.type = CHARTAB_RANGE_CHAR;
+ rainj.ch = ch;
+ return (fn) (&rainj, val, arg);
+ }
+
+ default:
+ abort ();
+ }
+
+ return 0;
+}
+
+struct slow_map_char_table_arg
+{
+ Lisp_Object function;
+ Lisp_Object retval;
+};
+
+static int
+slow_map_char_table_fun (struct chartab_range *range,
+ Lisp_Object val, void *arg)
+{
+ Lisp_Object ranjarg = Qnil;
+ struct slow_map_char_table_arg *closure =
+ (struct slow_map_char_table_arg *) arg;
+
+ switch (range->type)
+ {
+ case CHARTAB_RANGE_ALL:
+ ranjarg = Qt;
+ break;
+
+#ifdef MULE
+ case CHARTAB_RANGE_CHARSET:
+ ranjarg = XCHARSET_NAME (range->charset);
+ break;
+
+ case CHARTAB_RANGE_ROW:
+ ranjarg = vector2 (XCHARSET_NAME (range->charset),
+ make_int (range->row));
+ break;
+#endif /* MULE */
+ case CHARTAB_RANGE_CHAR:
+ ranjarg = make_char (range->ch);
+ break;
+ default:
+ abort ();
+ }
+
+ closure->retval = call2 (closure->function, ranjarg, val);
+ return !NILP (closure->retval);
+}
+
+DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
+Map FUNCTION over entries in TABLE, calling it with two args,
+each key and value in the table.
+
+RANGE specifies a subrange to map over and is in the same format as
+the RANGE argument to `put-range-table'. If omitted or t, it defaults to
+the entire table.
+*/
+ (function, table, range))
+{
+ struct Lisp_Char_Table *ct;
+ struct slow_map_char_table_arg slarg;
+ struct gcpro gcpro1, gcpro2;
+ struct chartab_range rainj;
+
+ CHECK_CHAR_TABLE (table);
+ ct = XCHAR_TABLE (table);
+ if (NILP (range))
+ range = Qt;
+ decode_char_table_range (range, &rainj);
+ slarg.function = function;
+ slarg.retval = Qnil;
+ GCPRO2 (slarg.function, slarg.retval);
+ map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
+ UNGCPRO;
+
+ return slarg.retval;
+}
+
+
+\f
+/************************************************************************/
+/* Char table read syntax */
+/************************************************************************/
+
+static int
+chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
+ Error_behavior errb)
+{
+ /* #### should deal with ERRB */
+ symbol_to_char_table_type (value);
+ return 1;
+}
+
+static int
+chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
+ Error_behavior errb)
+{
+ Lisp_Object rest;
+
+ /* #### should deal with ERRB */
+ EXTERNAL_LIST_LOOP (rest, value)
+ {
+ Lisp_Object range = XCAR (rest);
+ struct chartab_range dummy;
+
+ rest = XCDR (rest);
+ if (!CONSP (rest))
+ signal_simple_error ("Invalid list format", value);
+ if (CONSP (range))
+ {
+ if (!CONSP (XCDR (range))
+ || !NILP (XCDR (XCDR (range))))
+ signal_simple_error ("Invalid range format", range);
+ decode_char_table_range (XCAR (range), &dummy);
+ decode_char_table_range (XCAR (XCDR (range)), &dummy);
+ }
+ else
+ decode_char_table_range (range, &dummy);
+ }
+
+ return 1;
+}
+
+static Lisp_Object
+chartab_instantiate (Lisp_Object data)
+{
+ Lisp_Object chartab;
+ Lisp_Object type = Qgeneric;
+ Lisp_Object dataval = Qnil;
+
+ while (!NILP (data))
+ {
+ Lisp_Object keyw = Fcar (data);
+ Lisp_Object valw;
+
+ data = Fcdr (data);
+ valw = Fcar (data);
+ data = Fcdr (data);
+ if (EQ (keyw, Qtype))
+ type = valw;
+ else if (EQ (keyw, Qdata))
+ dataval = valw;
+ }
+
+ chartab = Fmake_char_table (type);
+
+ data = dataval;
+ while (!NILP (data))
+ {
+ Lisp_Object range = Fcar (data);
+ Lisp_Object val = Fcar (Fcdr (data));
+
+ data = Fcdr (Fcdr (data));
+ if (CONSP (range))
+ {
+ if (CHAR_OR_CHAR_INTP (XCAR (range)))
+ {
+ Emchar first = XCHAR_OR_CHAR_INT (Fcar (range));
+ Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range)));
+ Emchar i;
+
+ for (i = first; i <= last; i++)
+ Fput_char_table (make_char (i), val, chartab);
+ }
+ else
+ abort ();
+ }
+ else
+ Fput_char_table (range, val, chartab);
+ }
+
+ return chartab;
+}
+
+#ifdef MULE
+
+\f
+/************************************************************************/
+/* Category Tables, specifically */
+/************************************************************************/
+
+DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /*
+Return t if ARG is a category table.
+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 complicated [] expression (and category lookups are significantly
+faster).
+
+There are 95 different categories available, one for each printable
+character (including space) in the ASCII charset. Each category
+is designated by one such character, called a "category designator".
+They are specified in a regexp using the syntax "\\cX", where X is
+a category designator.
+
+A category table specifies, for each character, the categories that
+the character is in. Note that a character can be in more than one
+category. More specifically, a category table maps from a character
+to either the value nil (meaning the character is in no categories)
+or a 95-element bit vector, specifying for each of the 95 categories
+whether the character is in that category.
+
+Special Lisp functions are provided that abstract this, so you do not
+have to directly manipulate bit vectors.
+*/
+ (obj))
+{
+ return (CHAR_TABLEP (obj) &&
+ XCHAR_TABLE_TYPE (obj) == CHAR_TABLE_TYPE_CATEGORY) ?
+ Qt : Qnil;
+}
+
+static Lisp_Object
+check_category_table (Lisp_Object obj, Lisp_Object def)
+{
+ if (NILP (obj))
+ obj = def;
+ while (NILP (Fcategory_table_p (obj)))
+ obj = wrong_type_argument (Qcategory_table_p, obj);
+ return obj;
+}
+
+int
+check_category_char (Emchar ch, Lisp_Object table,
+ unsigned int designator, unsigned int not)
+{
+ REGISTER Lisp_Object temp;
+ struct Lisp_Char_Table *ctbl;
+#ifdef ERROR_CHECK_TYPECHECK
+ if (NILP (Fcategory_table_p (table)))
+ signal_simple_error ("Expected category table", table);
+#endif
+ ctbl = XCHAR_TABLE (table);
+ temp = get_char_table (ch, ctbl);
+ if (NILP (temp))
+ return not;
+
+ designator -= ' ';
+ return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not : not;
+}
+
+DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
+Return t if category of a character at POS includes DESIGNATOR,
+else return nil. Optional third arg specifies which buffer
+\(defaulting to current), and fourth specifies the CATEGORY-TABLE,
+\(defaulting to the buffer's category table).
+*/
+ (pos, designator, buffer, category_table))
+{
+ Lisp_Object ctbl;
+ Emchar ch;
+ unsigned int des;
+ struct buffer *buf = decode_buffer (buffer, 0);
+
+ CHECK_INT (pos);
+ CHECK_CATEGORY_DESIGNATOR (designator);
+ des = XCHAR (designator);
+ ctbl = check_category_table (category_table, Vstandard_category_table);
+ ch = BUF_FETCH_CHAR (buf, XINT (pos));
+ return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
+}
+
+DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
+Return t if category of character CHR includes DESIGNATOR, else nil.
+Optional third arg specifies the CATEGORY-TABLE to use,
+which defaults to the system default table.
+*/
+ (chr, designator, category_table))
+{
+ Lisp_Object ctbl;
+ Emchar ch;
+ unsigned int des;
+
+ CHECK_CATEGORY_DESIGNATOR (designator);
+ des = XCHAR (designator);
+ CHECK_CHAR (chr);
+ ch = XCHAR (chr);
+ ctbl = check_category_table (category_table, Vstandard_category_table);
+ return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
+}
+
+DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
+Return the current category table.
+This is the one specified by the current buffer, or by BUFFER if it
+is non-nil.
+*/
+ (buffer))
+{
+ return decode_buffer (buffer, 0)->category_table;
+}
+
+DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /*
+Return the standard category table.
+This is the one used for new buffers.
+*/
+ ())
+{
+ return Vstandard_category_table;
+}
+
+DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /*
+Construct a new category table and return it.
+It is a copy of the TABLE, which defaults to the standard category table.
+*/
+ (table))
+{
+ if (NILP (Vstandard_category_table))
+ return Fmake_char_table (Qcategory);
+
+ table = check_category_table (table, Vstandard_category_table);
+ return Fcopy_char_table (table);
+}
+
+DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /*
+Select a new category table for BUFFER.
+One argument, a category table.
+BUFFER defaults to the current buffer if omitted.
+*/
+ (table, buffer))
+{
+ struct buffer *buf = decode_buffer (buffer, 0);
+ table = check_category_table (table, Qnil);
+ buf->category_table = table;
+ /* Indicate that this buffer now has a specified category table. */
+ buf->local_var_flags |= XINT (buffer_local_flags.category_table);
+ return table;
+}
+
+DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /*
+Return t if ARG is a category designator (a char in the range ' ' to '~').
+*/
+ (obj))
+{
+ return CATEGORY_DESIGNATORP (obj) ? Qt : Qnil;
+}
+
+DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /*
+Return t if ARG is a category table value.
+Valid values are nil or a bit vector of size 95.
+*/
+ (obj))
+{
+ return CATEGORY_TABLE_VALUEP (obj) ? Qt : Qnil;
+}
+
+#endif /* MULE */
+
+\f
+void
+syms_of_chartab (void)
+{
+#ifdef MULE
+ defsymbol (&Qcategory_table_p, "category-table-p");
+ defsymbol (&Qcategory_designator_p, "category-designator-p");
+ defsymbol (&Qcategory_table_value_p, "category-table-value-p");
+#endif /* MULE */
+
+ defsymbol (&Qchar_table, "char-table");
+ defsymbol (&Qchar_tablep, "char-table-p");
+
+ DEFSUBR (Fchar_table_p);
+ DEFSUBR (Fchar_table_type_list);
+ DEFSUBR (Fvalid_char_table_type_p);
+ DEFSUBR (Fchar_table_type);
+ DEFSUBR (Freset_char_table);
+ DEFSUBR (Fmake_char_table);
+ DEFSUBR (Fcopy_char_table);
+ DEFSUBR (Fget_char_table);
+ DEFSUBR (Fget_range_char_table);
+ DEFSUBR (Fvalid_char_table_value_p);
+ DEFSUBR (Fcheck_valid_char_table_value);
+ DEFSUBR (Fput_char_table);
+ DEFSUBR (Fmap_char_table);
+
+#ifdef MULE
+ DEFSUBR (Fcategory_table_p);
+ DEFSUBR (Fcategory_table);
+ DEFSUBR (Fstandard_category_table);
+ DEFSUBR (Fcopy_category_table);
+ DEFSUBR (Fset_category_table);
+ DEFSUBR (Fcheck_category_at);
+ DEFSUBR (Fchar_in_category_p);
+ DEFSUBR (Fcategory_designator_p);
+ DEFSUBR (Fcategory_table_value_p);
+#endif /* MULE */
+
+ /* DO NOT staticpro this. It works just like Vweak_hash_tables. */
+ Vall_syntax_tables = Qnil;
+}
+
+void
+structure_type_create_chartab (void)
+{
+ struct structure_type *st;
+
+ st = define_structure_type (Qchar_table, 0, chartab_instantiate);
+
+ define_structure_type_keyword (st, Qtype, chartab_type_validate);
+ define_structure_type_keyword (st, Qdata, chartab_data_validate);
+}
+
+void
+complex_vars_of_chartab (void)
+{
+#ifdef MULE
+ /* Set this now, so first buffer creation can refer to it. */
+ /* Make it nil before calling copy-category-table
+ so that copy-category-table will know not to try to copy from garbage */
+ Vstandard_category_table = Qnil;
+ Vstandard_category_table = Fcopy_category_table (Qnil);
+ staticpro (&Vstandard_category_table);
+#endif /* MULE */
+}
--- /dev/null
+/* Declarations having to do with Mule char tables.
+ Copyright (C) 1992 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 synched with FSF.
+
+ This file was written independently of the FSF implementation,
+ and is not compatible. */
+
+#ifndef _MULE_CHARTAB_H
+#define _MULE_CHARTAB_H
+
+/************************************************************************/
+/* Char Tables */
+/************************************************************************/
+
+/* Under Mule, we use a complex representation (see below).
+ When not under Mule, there are only 256 possible characters
+ so we just represent them directly. */
+
+#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;
+
+ /* In the interests of simplicity, we just use a fixed 96-entry
+ table. If we felt like being smarter, we could make this
+ variable-size and add an offset value into this structure. */
+ Lisp_Object level2[96];
+};
+
+#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,
+#ifdef MULE
+ CHAR_TABLE_TYPE_CATEGORY,
+#endif
+ CHAR_TABLE_TYPE_SYNTAX,
+ CHAR_TABLE_TYPE_DISPLAY,
+ CHAR_TABLE_TYPE_CHAR
+};
+
+#ifdef MULE
+#define NUM_ASCII_CHARS 160
+#else
+#define NUM_ASCII_CHARS 256
+#endif
+
+struct Lisp_Char_Table
+{
+ struct lcrecord_header header;
+
+ Lisp_Object ascii[NUM_ASCII_CHARS];
+
+#ifdef MULE
+ /* We basically duplicate the Mule vectors-of-vectors implementation.
+ We can do this because we know a great deal about the sorts of
+ things we are going to be indexing.
+
+ The current implementation is as follows:
+
+ ascii[0-159] is used for ASCII and Control-1 characters.
+
+ level1[0 .. (NUM_LEADING_BYTES-1)] indexes charsets by leading
+ byte (subtract MIN_LEADING_BYTE from the leading byte). If the
+ value of this is not an opaque, then it specifies a value for all
+ characters in the charset. Otherwise, it will be a
+ 96-Lisp-Object opaque that we created, specifying a value for
+ each row. If the value of this is not an opaque, then it
+ specifies a value for all characters in the row. Otherwise, it
+ will be a 96-Lisp-Object opaque that we created, specifying a
+ value for each character.
+
+ NOTE: 1) This will fail if some C routine passes an opaque to
+ Fput_char_table(). Currently this is not a problem
+ since all char tables that are created are Lisp-visible
+ and thus no one should ever be putting an opaque in
+ a char table. Another possibility is to consider
+ adding a type to */
+
+ Lisp_Object level1[NUM_LEADING_BYTES];
+
+#endif /* MULE */
+
+ enum char_table_type type;
+
+ /* stuff used for syntax tables */
+ Lisp_Object mirror_table;
+ Lisp_Object next_table; /* DO NOT mark through this. */
+};
+
+#ifdef MULE
+
+Lisp_Object get_non_ascii_char_table_value (struct 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);
+INLINE Lisp_Object
+CHAR_TABLE_NON_ASCII_VALUE_UNSAFE (struct Lisp_Char_Table *ct, Emchar ch)
+{
+ unsigned char lb = CHAR_LEADING_BYTE (ch);
+ if (!CHAR_TABLE_ENTRYP ((ct)->level1[lb - MIN_LEADING_BYTE]))
+ return (ct)->level1[lb - MIN_LEADING_BYTE];
+ else
+ return get_non_ascii_char_table_value (ct, lb, ch);
+}
+
+#define CHAR_TABLE_VALUE_UNSAFE(ct, ch) \
+ ((ch) < NUM_ASCII_CHARS \
+ ? (ct)->ascii[ch] \
+ : CHAR_TABLE_NON_ASCII_VALUE_UNSAFE (ct, ch))
+
+#else /* not MULE */
+
+#define CHAR_TABLE_VALUE_UNSAFE(ct, ch) ((ct)->ascii[(unsigned char) (ch)])
+
+#endif /* not MULE */
+
+enum chartab_range_type
+{
+ CHARTAB_RANGE_ALL,
+#ifdef MULE
+ CHARTAB_RANGE_CHARSET,
+ CHARTAB_RANGE_ROW,
+#endif
+ CHARTAB_RANGE_CHAR
+};
+
+struct chartab_range
+{
+ enum chartab_range_type type;
+ Emchar ch;
+ Lisp_Object charset;
+ 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,
+ Lisp_Object val);
+int map_char_table (struct 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));
+
+EXFUN (Fcopy_char_table, 1);
+EXFUN (Fmake_char_table, 1);
+EXFUN (Fput_char_table, 3);
+
+extern Lisp_Object Vall_syntax_tables;
+
+\f
+
+#ifdef MULE
+int check_category_char(Emchar ch, Lisp_Object ctbl,
+ unsigned int designator, unsigned int not);
+
+extern Lisp_Object Vstandard_category_table;
+
+#define CATEGORY_DESIGNATORP(x) \
+ (CHARP (x) && XCHAR (x) >= 32 && XCHAR (x) <= 126)
+
+#define CHECK_CATEGORY_DESIGNATOR(x) do { \
+ if (!CATEGORY_DESIGNATORP (x)) \
+ dead_wrong_type_argument (Qcategory_designator_p, x); \
+} while (0)
+
+#define CONCHECK_CATEGORY_DESIGNATOR(x) do { \
+ if (!CATEGORY_DESIGNATORP (x)) \
+ x = wrong_type_argument (Qcategory_designator_p, x); \
+} while (0)
+
+#define CATEGORY_TABLE_VALUEP(x) \
+ (NILP (x) || (BIT_VECTORP (x) && (bit_vector_length (XBIT_VECTOR (x)) == 95)))
+
+#define CHECK_CATEGORY_TABLE_VALUE(x) do { \
+ if (!CATEGORY_TABLE_VALUEP (x)) \
+ dead_wrong_type_argument (Qcategory_table_value_p, x); \
+} while (0)
+
+#define CONCHECK_CATEGORY_TABLE_VALUE(x) do { \
+ if (!CATEGORY_TABLE_VALUEP (x)) \
+ x = wrong_type_argument (Qcategory_table_value_p, x); \
+} while (0)
+
+#endif /* MULE */
+
+#endif /* _MULE_CHARTAB_H */
--- /dev/null
+/* Simple built-in editing commands.
+ Copyright (C) 1985, 1992, 1993, 1994, 1995 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: Mule 2.0, FSF 19.30. */
+
+#include <config.h>
+#include "lisp.h"
+#include "commands.h"
+#include "buffer.h"
+#include "syntax.h"
+#include "insdel.h"
+
+Lisp_Object Qkill_forward_chars;
+Lisp_Object Qself_insert_command;
+Lisp_Object Qno_self_insert;
+
+Lisp_Object Vblink_paren_function;
+
+/* A possible value for a buffer's overwrite-mode variable. */
+Lisp_Object Qoverwrite_mode_binary;
+
+/* Non-nil means put this face on the next self-inserting character. */
+Lisp_Object Vself_insert_face;
+
+/* This is the command that set up Vself_insert_face. */
+Lisp_Object Vself_insert_face_command;
+\f
+DEFUN ("forward-char", Fforward_char, 0, 2, "_p", /*
+Move point right ARG characters (left if ARG negative).
+On attempt to pass end of buffer, stop and signal `end-of-buffer'.
+On attempt to pass beginning of buffer, stop and signal `beginning-of-buffer'.
+On reaching end of buffer, stop and signal error.
+*/
+ (arg, buffer))
+{
+ struct buffer *buf = decode_buffer (buffer, 1);
+
+ if (NILP (arg))
+ arg = make_int (1);
+ else
+ CHECK_INT (arg);
+
+ /* This used to just set point to point + XINT (arg), and then check
+ to see if it was within boundaries. But now that SET_PT can
+ potentially do a lot of stuff (calling entering and exiting
+ hooks, etcetera), that's not a good approach. So we validate the
+ proposed position, then set point. */
+ {
+ Bufpos new_point = BUF_PT (buf) + XINT (arg);
+
+ if (new_point < BUF_BEGV (buf))
+ {
+ BUF_SET_PT (buf, BUF_BEGV (buf));
+ Fsignal (Qbeginning_of_buffer, Qnil);
+ return Qnil;
+ }
+ if (new_point > BUF_ZV (buf))
+ {
+ BUF_SET_PT (buf, BUF_ZV (buf));
+ Fsignal (Qend_of_buffer, Qnil);
+ return Qnil;
+ }
+
+ BUF_SET_PT (buf, new_point);
+ }
+
+ return Qnil;
+}
+
+DEFUN ("backward-char", Fbackward_char, 0, 2, "_p", /*
+Move point left ARG characters (right if ARG negative).
+On attempt to pass end of buffer, stop and signal `end-of-buffer'.
+On attempt to pass beginning of buffer, stop and signal `beginning-of-buffer'.
+*/
+ (arg, buffer))
+{
+ if (NILP (arg))
+ arg = make_int (1);
+ else
+ CHECK_INT (arg);
+
+ XSETINT (arg, - XINT (arg));
+ return Fforward_char (arg, buffer);
+}
+
+DEFUN ("forward-line", Fforward_line, 0, 2, "_p", /*
+Move ARG lines forward (backward if ARG is negative).
+Precisely, if point is on line I, move to the start of line I + ARG.
+If there isn't room, go as far as possible (no error).
+Returns the count of lines left to move. If moving forward,
+that is ARG - number of lines moved; if backward, ARG + number moved.
+With positive ARG, a non-empty line at the end counts as one line
+ successfully moved (for the return value).
+If BUFFER is nil, the current buffer is assumed.
+*/
+ (arg, buffer))
+{
+ struct buffer *buf = decode_buffer (buffer, 1);
+ Bufpos pos2 = BUF_PT (buf);
+ Bufpos pos;
+ EMACS_INT count, shortage, negp;
+
+ if (NILP (arg))
+ count = 1;
+ else
+ {
+ CHECK_INT (arg);
+ count = XINT (arg);
+ }
+
+ negp = count <= 0;
+ pos = scan_buffer (buf, '\n', pos2, 0, count - negp, &shortage, 1);
+ if (shortage > 0
+ && (negp
+ || (BUF_ZV (buf) > BUF_BEGV (buf)
+ && pos != pos2
+ && BUF_FETCH_CHAR (buf, pos - 1) != '\n')))
+ shortage--;
+ BUF_SET_PT (buf, pos);
+ return make_int (negp ? - shortage : shortage);
+}
+
+DEFUN ("point-at-bol", Fpoint_at_bol, 0, 2, 0, /*
+Return the character position of the first character on the current line.
+With argument N not nil or 1, move forward N - 1 lines first.
+If scan reaches end of buffer, return that position.
+This function does not move point.
+*/
+ (arg, buffer))
+{
+ struct buffer *b = decode_buffer (buffer, 1);
+ REGISTER int orig, end;
+
+ XSETBUFFER (buffer, b);
+ if (NILP (arg))
+ arg = make_int (1);
+ else
+ CHECK_INT (arg);
+
+ orig = BUF_PT(b);
+ Fforward_line (make_int (XINT (arg) - 1), buffer);
+ end = BUF_PT(b);
+ BUF_SET_PT(b, orig);
+
+ return make_int (end);
+}
+
+DEFUN ("beginning-of-line", Fbeginning_of_line, 0, 2, "_p", /*
+Move point to beginning of current line.
+With argument ARG not nil or 1, move forward ARG - 1 lines first.
+If scan reaches end of buffer, stop there without error.
+If BUFFER is nil, the current buffer is assumed.
+*/
+ (arg, buffer))
+{
+ struct buffer *b = decode_buffer (buffer, 1);
+
+ BUF_SET_PT(b, XINT (Fpoint_at_bol(arg, buffer)));
+ return Qnil;
+}
+
+DEFUN ("point-at-eol", Fpoint_at_eol, 0, 2, 0, /*
+Return the character position of the last character on the current line.
+With argument N not nil or 1, move forward N - 1 lines first.
+If scan reaches end of buffer, return that position.
+This function does not move point.
+*/
+ (arg, buffer))
+{
+ struct buffer *buf = decode_buffer (buffer, 1);
+
+ XSETBUFFER (buffer, buf);
+
+ if (NILP (arg))
+ arg = make_int (1);
+ else
+ CHECK_INT (arg);
+
+ return make_int (find_before_next_newline (buf, BUF_PT (buf), 0,
+ XINT (arg) - (XINT (arg) <= 0)));
+}
+
+DEFUN ("end-of-line", Fend_of_line, 0, 2, "_p", /*
+Move point to end of current line.
+With argument ARG not nil or 1, move forward ARG - 1 lines first.
+If scan reaches end of buffer, stop there without error.
+If BUFFER is nil, the current buffer is assumed.
+*/
+ (arg, buffer))
+{
+ struct buffer *b = decode_buffer (buffer, 1);
+
+ BUF_SET_PT(b, XINT (Fpoint_at_eol (arg, buffer)));
+ return Qnil;
+}
+
+DEFUN ("delete-char", Fdelete_char, 1, 2, "*p\nP", /*
+Delete the following ARG characters (previous, with negative arg).
+Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
+Interactively, ARG is the prefix arg, and KILLFLAG is set if
+ARG was explicitly specified.
+*/
+ (arg, killflag))
+{
+ /* This function can GC */
+ Bufpos pos;
+ struct buffer *buf = current_buffer;
+
+ CHECK_INT (arg);
+
+ pos = BUF_PT (buf) + XINT (arg);
+ if (NILP (killflag))
+ {
+ if (XINT (arg) < 0)
+ {
+ if (pos < BUF_BEGV (buf))
+ signal_error (Qbeginning_of_buffer, Qnil);
+ else
+ buffer_delete_range (buf, pos, BUF_PT (buf), 0);
+ }
+ else
+ {
+ if (pos > BUF_ZV (buf))
+ signal_error (Qend_of_buffer, Qnil);
+ else
+ buffer_delete_range (buf, BUF_PT (buf), pos, 0);
+ }
+ }
+ else
+ {
+ call1 (Qkill_forward_chars, arg);
+ }
+ return Qnil;
+}
+
+DEFUN ("delete-backward-char", Fdelete_backward_char, 1, 2, "*p\nP", /*
+Delete the previous ARG characters (following, with negative ARG).
+Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
+Interactively, ARG is the prefix arg, and KILLFLAG is set if
+ARG was explicitly specified.
+*/
+ (arg, killflag))
+{
+ /* This function can GC */
+ CHECK_INT (arg);
+ return Fdelete_char (make_int (-XINT (arg)), killflag);
+}
+
+static void internal_self_insert (Emchar ch, int noautofill);
+
+DEFUN ("self-insert-command", Fself_insert_command, 1, 1, "*p", /*
+Insert the character you type.
+Whichever character you type to run this command is inserted.
+*/
+ (arg))
+{
+ /* This function can GC */
+ int n;
+ Emchar ch;
+ Lisp_Object c;
+ CHECK_INT (arg);
+
+ if (CHAR_OR_CHAR_INTP (Vlast_command_char))
+ c = Vlast_command_char;
+ else
+ c = Fevent_to_character (Vlast_command_event, Qnil, Qnil, Qt);
+
+ if (NILP (c))
+ signal_simple_error ("last typed character has no ASCII equivalent",
+ Fcopy_event (Vlast_command_event, Qnil));
+
+ CHECK_CHAR_COERCE_INT (c);
+
+ n = XINT (arg);
+ ch = XCHAR (c);
+#if 0 /* FSFmacs */
+ /* #### This optimization won't work because of differences in
+ how the start-open and end-open properties default for text
+ properties. See internal_self_insert(). */
+ if (n >= 2 && NILP (current_buffer->overwrite_mode))
+ {
+ n -= 2;
+ /* The first one might want to expand an abbrev. */
+ internal_self_insert (c, 1);
+ /* The bulk of the copies of this char can be inserted simply.
+ We don't have to handle a user-specified face specially
+ because it will get inherited from the first char inserted. */
+ Finsert_char (make_char (c), make_int (n), Qt, Qnil);
+ /* The last one might want to auto-fill. */
+ internal_self_insert (c, 0);
+ }
+ else
+#endif /* 0 */
+ while (n > 0)
+ {
+ n--;
+ internal_self_insert (ch, (n != 0));
+ }
+ return Qnil;
+}
+
+/* Insert character C1. If NOAUTOFILL is nonzero, don't do autofill
+ even if it is enabled.
+
+ FSF:
+
+ If this insertion is suitable for direct output (completely simple),
+ return 0. A value of 1 indicates this *might* not have been simple.
+ A value of 2 means this did things that call for an undo boundary. */
+
+static void
+internal_self_insert (Emchar c1, int noautofill)
+{
+ /* This function can GC */
+ /* int hairy = 0; -- unused */
+ REGISTER enum syntaxcode synt;
+ REGISTER Emchar c2;
+ Lisp_Object overwrite;
+ struct Lisp_Char_Table *syntax_table;
+ struct buffer *buf = current_buffer;
+
+ overwrite = buf->overwrite_mode;
+ syntax_table = XCHAR_TABLE (buf->mirror_syntax_table);
+
+#if 0
+ /* No, this is very bad, it makes undo *always* undo a character at a time
+ instead of grouping consecutive self-inserts together. Nasty nasty.
+ */
+ if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions)
+ || !NILP (Vbefore_change_function) || !NILP (Vafter_change_function))
+ hairy = 1;
+#endif
+
+ if (!NILP (overwrite)
+ && BUF_PT (buf) < BUF_ZV (buf)
+ && (EQ (overwrite, Qoverwrite_mode_binary)
+ || (c1 != '\n' && BUF_FETCH_CHAR (buf, BUF_PT (buf)) != '\n'))
+ && (EQ (overwrite, Qoverwrite_mode_binary)
+ || BUF_FETCH_CHAR (buf, BUF_PT (buf)) != '\t'
+ || XINT (buf->tab_width) <= 0
+ || XINT (buf->tab_width) > 20
+ || !((current_column (buf) + 1) % XINT (buf->tab_width))))
+ {
+ buffer_delete_range (buf, BUF_PT (buf), BUF_PT (buf) + 1, 0);
+ /* hairy = 2; */
+ }
+
+ if (!NILP (buf->abbrev_mode)
+ && !WORD_SYNTAX_P (syntax_table, c1)
+ && NILP (buf->read_only)
+ && BUF_PT (buf) > BUF_BEGV (buf))
+ {
+ c2 = BUF_FETCH_CHAR (buf, BUF_PT (buf) - 1);
+
+ if (WORD_SYNTAX_P (syntax_table, c2))
+ {
+#if 1
+ Fexpand_abbrev ();
+#else /* FSFmacs */
+ Lisp_Object sym = Fexpand_abbrev ();
+
+ /* I think this is too bogus to add. The function should
+ have a way of examining the character to be inserted, so
+ it can decide whether to insert it or not. We should
+ design it better than that. */
+
+ /* Here FSFmacs remembers MODIFF, compares it after
+ Fexpand_abbrev() finishes, and updates HAIRY. */
+
+ /* NOTE: we cannot simply check for Vlast_abbrev, because
+ Fexpand_abbrev() can bail out before setting it to
+ anything meaningful, leaving us stuck with an old value.
+ Thus Fexpand_abbrev() was extended to return the actual
+ abbrev symbol. */
+ if (!NILP (sym)
+ && !NILP (symbol_function (XSYMBOL (sym)))
+ && SYMBOLP (symbol_function (XSYMBOL (sym))))
+ {
+ Lisp_Object prop = Fget (symbol_function (XSYMBOL (sym)),
+ Qno_self_insert, Qnil);
+ if (!NILP (prop))
+ return;
+ }
+#endif /* FSFmacs */
+ }
+ }
+ if ((c1 == ' ' || c1 == '\n')
+ && !noautofill
+ && !NILP (buf->auto_fill_function))
+ {
+ buffer_insert_emacs_char (buf, c1);
+ if (c1 == '\n')
+ /* After inserting a newline, move to previous line and fill */
+ /* that. Must have the newline in place already so filling and */
+ /* justification, if any, know where the end is going to be. */
+ BUF_SET_PT (buf, BUF_PT (buf) - 1);
+ call0 (buf->auto_fill_function);
+ if (c1 == '\n')
+ BUF_SET_PT (buf, BUF_PT (buf) + 1);
+ /* hairy = 2; */
+ }
+ else
+ buffer_insert_emacs_char (buf, c1);
+
+ /* If previous command specified a face to use, use it. */
+ if (!NILP (Vself_insert_face)
+ && EQ (Vlast_command, Vself_insert_face_command))
+ {
+ Lisp_Object before = make_int (BUF_PT (buf) - 1);
+ Lisp_Object after = make_int (BUF_PT (buf));
+ Fput_text_property (before, after, Qface, Vself_insert_face, Qnil);
+ Fput_text_property (before, after, Qstart_open, Qt, Qnil);
+ Fput_text_property (before, after, Qend_open, Qnil, Qnil);
+ /* #### FSFmacs properties are normally closed ("sticky") on the
+ end but not the beginning. It's the opposite for us. */
+ Vself_insert_face = Qnil;
+ }
+ synt = SYNTAX (syntax_table, c1);
+ if ((synt == Sclose || synt == Smath)
+ && !NILP (Vblink_paren_function) && INTERACTIVE
+ && !noautofill)
+ {
+ call0 (Vblink_paren_function);
+ /* hairy = 2; */
+ }
+
+ /* return hairy; */
+}
+
+/* (this comes from Mule but is a generally good idea) */
+
+DEFUN ("self-insert-internal", Fself_insert_internal, 1, 1, 0, /*
+Invoke `self-insert-command' as if CH is entered from keyboard.
+*/
+ (ch))
+{
+ /* This function can GC */
+ CHECK_CHAR_COERCE_INT (ch);
+ internal_self_insert (XCHAR (ch), 0);
+ return Qnil;
+}
+\f
+/* module initialization */
+
+void
+syms_of_cmds (void)
+{
+ defsymbol (&Qkill_forward_chars, "kill-forward-chars");
+ defsymbol (&Qself_insert_command, "self-insert-command");
+ defsymbol (&Qoverwrite_mode_binary, "overwrite-mode-binary");
+ defsymbol (&Qno_self_insert, "no-self-insert");
+
+ DEFSUBR (Fforward_char);
+ DEFSUBR (Fbackward_char);
+ DEFSUBR (Fforward_line);
+ DEFSUBR (Fbeginning_of_line);
+ DEFSUBR (Fend_of_line);
+
+ DEFSUBR (Fpoint_at_bol);
+ DEFSUBR (Fpoint_at_eol);
+
+ DEFSUBR (Fdelete_char);
+ DEFSUBR (Fdelete_backward_char);
+
+ DEFSUBR (Fself_insert_command);
+ DEFSUBR (Fself_insert_internal);
+}
+
+void
+vars_of_cmds (void)
+{
+ DEFVAR_LISP ("self-insert-face", &Vself_insert_face /*
+If non-nil, set the face of the next self-inserting character to this.
+See also `self-insert-face-command'.
+*/ );
+ Vself_insert_face = Qnil;
+
+ DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command /*
+This is the command that set up `self-insert-face'.
+If `last-command' does not equal this value, we ignore `self-insert-face'.
+*/ );
+ Vself_insert_face_command = Qnil;
+
+ DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function /*
+Function called, if non-nil, whenever a close parenthesis is inserted.
+More precisely, a char with closeparen syntax is self-inserted.
+*/ );
+ Vblink_paren_function = Qnil;
+}
--- /dev/null
+/* XEmacs site configuration template file. -*- C -*-
+ Copyright (C) 1986, 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. */
+
+/* Significantly divergent from FSF. */
+
+/* No code in XEmacs #includes config.h twice, but some of the code
+ intended to work with other packages as well (like gmalloc.c)
+ think they can include it as many times as they like. */
+#ifndef _SRC_CONFIG_H_
+#define _SRC_CONFIG_H_
+
+/* alloca twiddling belongs in one place, not the s&m headers
+ AIX requires this to be the first thing in the file. */
+#undef HAVE_ALLOCA_H
+
+#ifndef NOT_C_CODE
+#ifdef __GNUC__
+#define alloca __builtin_alloca
+#elif HAVE_ALLOCA_H
+#include <alloca.h>
+#elif defined(_AIX)
+#pragma alloca
+#elif ! defined (alloca)
+char *alloca();
+#endif
+#endif /* C code */
+
+
+/* Use this to add code in a structured way to FSF-maintained source
+ files so as to make it obvious where XEmacs changes are. */
+#define XEMACS 1
+
+/* Allow s&m files to differentiate OS versions without having
+ multiple files to maintain. */
+#undef OS_RELEASE
+
+/* The configuration name. This is used as the install directory name
+ for the lib-src programs. */
+#undef EMACS_CONFIGURATION
+
+/* The configuration options. This is exported to Lisp. */
+#undef EMACS_CONFIG_OPTIONS
+
+/* The version info from version.sh. Used in #pragma ident in emacs.c */
+#undef EMACS_MAJOR_VERSION
+#undef EMACS_MINOR_VERSION
+#undef EMACS_BETA_VERSION
+#undef EMACS_VERSION
+#undef XEMACS_CODENAME
+/* InfoDock versions, not used with XEmacs */
+#undef INFODOCK_MAJOR_VERSION
+#undef INFODOCK_MINOR_VERSION
+#undef INFODOCK_BUILD_VERSION
+
+/* 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
+
+/* Used to identify the XEmacs version in stack traces. */
+#undef STACK_TRACE_EYE_CATCHER
+
+/* Allow the configurer to specify if she wants site-lisp. */
+#undef INHIBIT_SITE_LISP
+
+/* This will be removed in 19.15. */
+/* Hah! Try 20.3 ... */
+/* Hah! Try never ... */
+/* If at first you don't succeed, try, try again. */
+/* #define LOSING_BYTECODE */
+
+/* Undefine on systems which don't have processes */
+#undef HAVE_UNIX_PROCESSES
+
+/* Does XEmacs support floating-point numbers? */
+#undef LISP_FLOAT_TYPE
+
+/* Define GNU_MALLOC if you want to use the GNU memory allocator. */
+#undef GNU_MALLOC
+
+/* Define if you are using the GNU C Library. -- experimental. */
+#undef DOUG_LEA_MALLOC
+
+/* Define if you are using libmcheck.a from the GNU C Library. */
+#undef HAVE_LIBMCHECK
+
+/* Define if you are using dlmalloc from the Linux C library. */
+#undef _NO_MALLOC_WARNING_
+
+/* Use the system malloc? */
+#undef USE_SYSTEM_MALLOC
+
+/* Use a debugging malloc? -- experimental */
+#undef USE_DEBUG_MALLOC
+
+/* Compile in TTY support? */
+#undef HAVE_TTY
+
+/* Compile in support for MS windows? */
+#undef HAVE_MS_WINDOWS
+
+/* special cygwin process handling? */
+#undef HAVE_MSG_SELECT
+
+/* Compile in support for the X window system? */
+#undef HAVE_X_WINDOWS
+
+/* Defines for building X applications */
+#ifdef HAVE_X_WINDOWS
+/* The following will be defined if xmkmf thinks they are necessary */
+#undef SVR4
+#undef SYSV
+#undef AIXV3
+#undef _POSIX_SOURCE
+#undef _BSD_SOURCE
+#undef _SVID_SOURCE
+#undef X_LOCALE
+#undef NARROWPROTO
+/* The following should always be defined, no matter what xmkmf thinks. */
+#ifndef NeedFunctionPrototypes
+#define NeedFunctionPrototypes 1
+#endif
+#ifndef FUNCPROTO
+#define FUNCPROTO 15
+#endif
+#endif /* HAVE_X_WINDOWS */
+
+/* Define HAVE_WINDOW_SYSTEM if any windowing system is available. */
+#if defined (HAVE_X_WINDOWS) || defined(HAVE_MS_WINDOWS) /* || defined (HAVE_NEXTSTEP) */
+#define HAVE_WINDOW_SYSTEM
+#endif
+
+/* Define HAVE_UNIXOID_EVENT_LOOP if we use select() to wait for events. */
+#if defined (HAVE_X_WINDOWS) || defined (HAVE_TTY) || defined(HAVE_MSG_SELECT)
+#define HAVE_UNIXOID_EVENT_LOOP
+#endif
+
+/* Are we using XFree386? */
+#undef HAVE_XFREE386
+
+#undef THIS_IS_X11R4
+#undef THIS_IS_X11R5
+#undef THIS_IS_X11R6
+
+/* Where do we find bitmaps? */
+#undef BITMAPDIR
+
+/* USER_FULL_NAME returns a string that is the user's full name.
+ It can assume that the variable `pw' points to the password file
+ entry for this user.
+
+ At some sites, the pw_gecos field contains the user's full name.
+ If neither this nor any other field contains the right thing, use
+ pw_name, giving the user's login name, since that is better than
+ nothing. */
+#define USER_FULL_NAME pw->pw_gecos
+
+/* Define AMPERSAND_FULL_NAME if you use the convention
+ that & in the full name stands for the login id. */
+#undef AMPERSAND_FULL_NAME
+
+/* Some things figured out by the configure script, grouped as they are in
+ configure.in. */
+#undef HAVE_MCHECK_H
+#undef HAVE_MACH_MACH_H
+#undef HAVE_SYS_STROPTS_H
+#undef HAVE_SYS_TIMEB_H
+#undef HAVE_SYS_TIME_H
+#undef HAVE_UNISTD_H
+#undef HAVE_UTIME_H
+#undef HAVE_SYS_WAIT_H
+#undef HAVE_LIBINTL_H
+#undef HAVE_LIBGEN_H
+#undef HAVE_LOCALE_H
+#undef HAVE_FCNTL_H
+#undef HAVE_ULIMIT_H
+#undef HAVE_X11_XLOCALE_H
+#undef HAVE_LINUX_VERSION_H
+#undef HAVE_INTTYPES_H
+#undef HAVE_SYS_UN_H
+#undef HAVE_A_OUT_H
+#undef STDC_HEADERS
+#undef TIME_WITH_SYS_TIME
+#undef WORDS_BIGENDIAN
+#undef HAVE_VFORK_H
+#undef HAVE_KSTAT_H
+#undef HAVE_SYS_PSTAT_H
+#undef vfork
+
+#undef HAVE_LONG_FILE_NAMES
+
+/* Use lock files to detect multiple edits of the same file? */
+#undef CLASH_DETECTION
+
+/* Have shared library support */
+#undef HAVE_DLOPEN
+#undef HAVE_DLERROR
+#undef HAVE_SHL_LOAD
+#undef HAVE_DLD_INIT
+#undef HAVE_SHLIB
+
+#undef HAVE_LIBKSTAT
+#undef HAVE_LIBINTL
+#undef HAVE_LIBDNET
+#undef HAVE_LIBRESOLV
+
+/* Is `sys_siglist' declared by <signal.h>? */
+#undef SYS_SIGLIST_DECLARED
+
+/* Is `struct utimbuf' declared by <utime.h>? */
+#undef HAVE_STRUCT_UTIMBUF
+
+/* Is `struct timeval' declared by <sys/time.h>? */
+#undef HAVE_TIMEVAL
+
+
+#undef TM_IN_SYS_TIME
+#undef HAVE_TM_ZONE
+#undef HAVE_TZNAME
+
+/* Is `h_errno' declared by <netdb.h>? */
+#undef HAVE_H_ERRNO
+
+/* Does `localtime' cache TZ? */
+#undef LOCALTIME_CACHE
+
+/* Can `gettimeofday' accept two arguments? */
+#undef GETTIMEOFDAY_ONE_ARGUMENT
+
+#undef HAVE_MMAP
+#undef HAVE_STRCOLL
+#undef HAVE_GETPGRP
+#undef GETPGRP_VOID
+
+#undef HAVE_INVERSE_HYPERBOLIC
+
+#undef HAVE_CBRT
+#undef HAVE_CLOSEDIR
+#undef HAVE_DUP2
+#undef HAVE_EACCESS
+#undef HAVE_FMOD
+#undef HAVE_FPATHCONF
+#undef HAVE_FREXP
+#undef HAVE_FTIME
+#undef HAVE_GETHOSTNAME
+#undef HAVE_GETPAGESIZE
+#undef HAVE_GETTIMEOFDAY
+#undef HAVE_GETWD
+#undef HAVE_GETCWD
+#undef HAVE_LOGB
+#undef HAVE_LRAND48
+#undef HAVE_MATHERR
+#undef HAVE_MKDIR
+#undef HAVE_MKTIME
+#undef HAVE_PERROR
+#undef HAVE_POLL
+#undef HAVE_RANDOM
+#undef HAVE_REALPATH
+#undef HAVE_RENAME
+#undef HAVE_RES_INIT
+#undef HAVE_RINT
+#undef HAVE_RMDIR
+#undef HAVE_SELECT
+#undef HAVE_SETITIMER
+#undef HAVE_SETPGID
+#undef HAVE_SETSID
+#undef HAVE_SIGBLOCK
+#undef HAVE_SIGHOLD
+#undef HAVE_SIGPROCMASK
+#undef HAVE_SIGSETJMP
+#undef HAVE_SNPRINTF
+#undef HAVE_STRCASECMP
+#undef HAVE_STRERROR
+#undef HAVE_TZSET
+#undef HAVE_ULIMIT
+#undef HAVE_USLEEP
+#undef HAVE_UTIMES
+#undef HAVE_WAITPID
+#undef HAVE_VSNPRINTF
+#undef HAVE_SOCKETS
+#undef HAVE_SOCKADDR_SUN_LEN
+#undef HAVE_MULTICAST
+#undef HAVE_SYSVIPC
+
+#undef SYSV_SYSTEM_DIR
+#undef NONSYSTEM_DIR_LIBRARY
+
+#undef HAVE_TERMIOS
+#undef HAVE_TERMIO
+#undef NO_TERMIO
+#undef SIGNALS_VIA_CHARACTERS
+
+#undef NLIST_STRUCT
+
+/* Compile in support for SOCKS? */
+#undef HAVE_SOCKS
+
+/* Compile in support for X pixmaps via the `xpm' library? */
+#undef HAVE_XPM
+#undef FOR_MSW
+
+/* Compile in support for "X faces" via the `compface' library?
+ This enables graphical display of X-face headers in mail/news messages */
+#undef HAVE_XFACE
+
+/* Compile in support for JPEG images */
+#undef HAVE_JPEG
+
+/* Compile in support for TIFF images */
+#undef HAVE_TIFF
+
+/* Compile in support for GIF images */
+#undef HAVE_GIF
+
+/* Compile in support for PNG images */
+#undef HAVE_PNG
+
+/* Do you have the Xmu library?
+ This should always be the case except on losing HP-UX systems. */
+#undef HAVE_XMU
+
+/* Compile in support for DBM databases? May require libgdbm or libdbm. */
+#undef HAVE_DBM
+
+/* Compile in support for Berkeley DB style databases? May require libdb. */
+#undef HAVE_BERKELEY_DB
+/* Full #include file path for Berkeley DB's db.h */
+#undef DB_H_PATH
+
+/* Do we have either DBM or Berkeley DB database support? */
+#undef HAVE_DATABASE
+
+/* 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
+
+/* Do you have the Xauth library present? This will add some extra
+ functionality to gnuserv. */
+#undef HAVE_XAUTH
+
+/* Compile in support for gpm (General Purpose Mouse)? */
+#undef HAVE_GPM
+
+/* Compile in support for ncurses? */
+#undef HAVE_NCURSES
+/* Full #include file paths for ncurses' curses.h and term.h. */
+#undef CURSES_H_PATH
+#undef TERM_H_PATH
+
+/* Define USE_ASSERTIONS if you want the abort() to be changed to assert().
+ If the assertion fails, assert_failed() will be called. This is
+ recommended for general use because it gives more info about the crash
+ than just the abort() message. Too many people "Can't find the corefile"
+ or have limit-ed core dumps out of existence. */
+#undef USE_ASSERTIONS
+
+/* Define one or more of the following if you want lots of extra checks
+ (e.g. structure validation) compiled in. These should be turned
+ on during the beta-test cycle. */
+
+/* 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
+/* Make sure valid buffer positions are passed to BUF_* macros. */
+#undef ERROR_CHECK_BUFPOS
+/* 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
+
+/* Define DEBUG_XEMACS if you want extra debugging code compiled in.
+ This is mainly intended for use by developers. */
+#undef DEBUG_XEMACS
+
+/* Define MEMORY_USAGE_STATS if you want extra code compiled in to
+ determine where XEmacs' memory is going. */
+#undef MEMORY_USAGE_STATS
+
+/* Define QUANTIFY if using Quantify from Pure/Atria Software.
+ This adds some additional calls to control data collection.
+ It is only intended for use by the developers. */
+#undef QUANTIFY
+
+/* Define EXTERNAL_WIDGET to compile support for using the editor as a
+ widget within another program. */
+#undef EXTERNAL_WIDGET
+
+/* There are some special-case defines for gcc and lcc. */
+#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
+ setlocale() library routines. This really should be (NOT! -mrb)
+ defined in the appropriate s/ or m/ file. */
+#undef I18N2
+
+/* Define this if you want level 3 internationalization compliance
+ (localized messaging). This will cause a small runtime performance
+ penalty, as the strings are read from the message catalog(s).
+ For this you need the gettext() and dgetext() library routines.
+ WARNING, this code is under construction. */
+#undef I18N3
+
+/* Compile in support for CDE (Common Desktop Environment) drag and drop?
+ Requires libDtSvc, which typically must be present at runtime. */
+#undef HAVE_CDE
+
+/* Compile in support for OffiX Drag and Drop? */
+#undef HAVE_OFFIX_DND
+
+/* Compile in generic Drag'n'Drop API */
+#undef HAVE_DRAGNDROP
+
+/* Compile in support for proper session-management. */
+#undef HAVE_SESSION
+
+/* Define this if you want Mule support (multi-byte character support).
+ There may be some performance penalty, although it should be small
+ if you're working with ASCII files. */
+#undef MULE
+
+/* Define this if you want file coding support */
+#undef FILE_CODING
+
+/* Do we want to use X window input methods for use with Mule? (requires X11R5)
+ If so, use raw Xlib or higher level Motif interface? */
+#undef HAVE_XIM
+#undef XIM_XLIB
+#undef XIM_MOTIF
+#undef USE_XFONTSET
+
+/* Non-XIM input methods for use with Mule. */
+#undef HAVE_CANNA
+#undef HAVE_WNN
+#undef WNN6
+
+/* Enable special GNU Make features in the Makefiles. */
+#undef USE_GNU_MAKE
+
+/* Debugging option: Don't automatically rebuild the DOC file.
+ This saves a lot of time when you're repeatedly
+ compiling-running-crashing. */
+#undef NO_DOC_FILE
+
+/* Defined by AC_C_CONST in configure.in */
+#undef const
+
+#define CONST const
+
+/* 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.
+
+ See the file ../etc/MACHINES for a list of systems and the
+ configuration names to use for them.
+
+ See s/template.h for documentation on writing s/...h files. */
+
+#if defined (__cplusplus) && !defined (NOT_C_CODE)
+extern "C" {
+#endif
+#undef config_opsysfile
+#include config_opsysfile
+
+/* The configuration script defines machfile to be the name of the
+ m/...h file that describes the machine you are using. The file is
+ chosen based on the configuration name you give.
+
+ See the file ../etc/MACHINES for a list of machines and the
+ configuration names to use for them.
+
+ See m/template.h for documentation on writing m/...h files. */
+#undef config_machfile
+#include config_machfile
+#if defined (__cplusplus) && !defined (NOT_C_CODE)
+}
+#endif
+
+#if defined (USE_SYSTEM_MALLOC) && !defined (SYSTEM_MALLOC)
+#define SYSTEM_MALLOC
+#endif
+
+/* Use the relocating allocator for buffer space? */
+#undef REL_ALLOC
+
+/* Define the return type of signal handlers if the s/xxx.h file
+ did not already do so. */
+#define RETSIGTYPE void
+
+/* SIGTYPE is the macro we actually use. */
+#ifndef SIGTYPE
+#define SIGTYPE RETSIGTYPE
+#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
+
+/* Compile in support for Sun Sparcworks/WorkShop? */
+#undef SUNPRO
+
+/* Sun SparcStations, SGI machines, and HP9000s700s have built-in
+ support for playing sound files. (On Suns, the sound support is
+ usually found in /usr/demo/SOUND - you may need to install the
+ "SUNWaudmo" package.) */
+#undef HAVE_NATIVE_SOUND
+/* Native sound may be provided via soundcard.h, in various directories */
+#undef SOUNDCARD_H_PATH
+
+/* Compile in support for NAS (Network Audio System)?
+ NAS_NO_ERROR_JUMP means that the NAS libraries don't include some
+ error handling changes. */
+#undef HAVE_NAS_SOUND
+#undef NAS_NO_ERROR_JUMP
+
+/* Compile in support for SunPro usage-tracking code? */
+#undef USAGE_TRACKING
+
+/* Compile in support for Tooltalk? */
+#undef TOOLTALK
+/* tt_c.h might be in "Tt" or "desktop" subdirectories */
+#undef TT_C_H_PATH
+
+/* Toolkits used by lwlib for various widgets... */
+#undef LWLIB_USES_MOTIF
+#undef LWLIB_USES_ATHENA
+#undef LWLIB_MENUBARS_LUCID
+#undef LWLIB_MENUBARS_MOTIF
+#undef LWLIB_SCROLLBARS_LUCID
+#undef LWLIB_SCROLLBARS_MOTIF
+#undef LWLIB_SCROLLBARS_ATHENA
+#undef LWLIB_SCROLLBARS_ATHENA3D
+#undef LWLIB_DIALOGS_MOTIF
+#undef LWLIB_DIALOGS_ATHENA
+#undef LWLIB_DIALOGS_ATHENA3D
+
+/* Other things that can be disabled by configure. */
+#undef HAVE_MENUBARS
+#undef HAVE_SCROLLBARS
+#undef HAVE_DIALOGS
+#undef HAVE_TOOLBARS
+
+
+#if defined (HAVE_MENUBARS) || defined (HAVE_DIALOGS)
+#define HAVE_POPUPS
+#endif
+
+/* If you are using SunOS 4.1.1 and X11r5, then you need this patch.
+ There is a stupid bug in the SunOS libc.a: two functions which X11r5
+ uses, mbstowcs() and wcstombs(), are unusable when programs are
+ statically linked (as XEmacs must be) because the static version of
+ libc.a contains the *dynamic* versions of these functions. These
+ functions don't seem to be called when XEmacs is running, so it's
+ enough to define stubs for them.
+
+ This appears to be fixed in SunOS 4.1.2.
+
+ Also, SunOS 4.1.1 contains buggy versions of strcmp and strcpy that
+ sometimes reference memory past the end of the string, which can segv.
+ I don't know whether this is has been fixed as of 4.1.2 or 4.1.3. */
+#if defined (sparc) && !defined (USG)
+#define OBJECTS_SYSTEM sunOS-fix.o strcmp.o strcpy.o
+#endif
+
+/* 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
+
+/* basic system calls */
+
+#if defined (INTERRUPTIBLE_IO) || defined (DEBUG_ENCAPSULATION)
+# define ENCAPSULATE_READ
+# define ENCAPSULATE_WRITE
+#endif
+#if defined (INTERRUPTIBLE_OPEN) || defined (MULE) || defined (DEBUG_ENCAPSULATION)
+# define ENCAPSULATE_OPEN
+#endif
+#if defined (INTERRUPTIBLE_CLOSE) || defined (DEBUG_ENCAPSULATION)
+# define ENCAPSULATE_CLOSE
+#endif
+
+/* stdio calls */
+
+#if defined (INTERRUPTIBLE_IO) || defined (DEBUG_ENCAPSULATION)
+# define ENCAPSULATE_FREAD
+# define ENCAPSULATE_FWRITE
+#endif
+#if defined (INTERRUPTIBLE_OPEN) || defined (MULE) || defined (DEBUG_ENCAPSULATION)
+# define ENCAPSULATE_FOPEN
+#endif
+#if defined (INTERRUPTIBLE_CLOSE) || defined (DEBUG_ENCAPSULATION)
+# define ENCAPSULATE_FCLOSE
+#endif
+
+/* directory calls */
+
+#if defined (MULE) || defined (DEBUG_ENCAPSULATION)
+# define ENCAPSULATE_CHDIR
+# define ENCAPSULATE_MKDIR
+# define ENCAPSULATE_OPENDIR
+# define ENCAPSULATE_CLOSEDIR
+# define ENCAPSULATE_READDIR
+# define ENCAPSULATE_RMDIR
+
+/* file-information calls */
+
+#ifdef HAVE_EACCESS
+# define ENCAPSULATE_EACCESS
+#endif
+# define ENCAPSULATE_ACCESS
+# define ENCAPSULATE_LSTAT
+# define ENCAPSULATE_READLINK
+# define ENCAPSULATE_STAT
+
+/* file-manipulation calls */
+
+# define ENCAPSULATE_CHMOD
+# define ENCAPSULATE_CREAT
+# define ENCAPSULATE_LINK
+# define ENCAPSULATE_RENAME
+# define ENCAPSULATE_SYMLINK
+# define ENCAPSULATE_UNLINK
+# define ENCAPSULATE_EXECVP
+#endif /* defined (MULE) || defined (DEBUG_ENCAPSULATION) */
+
+#ifdef HAVE_CANNA
+# define CANNA2
+# define CANNA_MULE
+# define CANNA_PURESIZE 0
+#else /* not CANNA */
+# define CANNA_PURESIZE 0
+#endif /* not CANNA */
+
+#if (defined (MSDOS) && defined (FEPCTRL)) || (defined (WIN32) && defined (USE_IME))
+#define HAVE_FEP
+#endif
+
+#if defined (HAVE_SOCKS) && !defined (DO_NOT_SOCKSIFY)
+#define accept Raccept
+#define bind Rbind
+#define connect Rconnect
+#define getsockname Rgetsockname
+#define listen Rlisten
+#endif /* HAVE_SOCKS && !DO_NOT_SOCKSIFY */
+
+#undef SIZEOF_SHORT
+#undef SIZEOF_INT
+#undef SIZEOF_LONG
+#undef SIZEOF_LONG_LONG
+#undef SIZEOF_VOID_P
+
+#ifndef BITS_PER_CHAR
+#define BITS_PER_CHAR 8
+#endif
+#define SHORTBITS (SIZEOF_SHORT * BITS_PER_CHAR)
+#define INTBITS (SIZEOF_INT * BITS_PER_CHAR)
+#define LONGBITS (SIZEOF_LONG * BITS_PER_CHAR)
+#define LONG_LONG_BITS (SIZEOF_LONG_LONG * BITS_PER_CHAR)
+#define VOID_P_BITS (SIZEOF_VOID_P * BITS_PER_CHAR)
+
+#ifndef NOT_C_CODE
+#ifdef __cplusplus
+#define HAVE_INLINE 1
+#define INLINE inline
+#else /* not C++ */
+/* Does the keyword `inline' exist? */
+#undef HAVE_INLINE
+#undef inline
+
+# ifdef HAVE_INLINE
+# ifdef __GNUC__
+# ifdef DONT_EXTERN_INLINE_FUNCTIONS
+# define INLINE inline
+# else
+# define INLINE extern inline
+# endif
+# else
+# define INLINE static inline
+# endif /* __GNUC__ */
+# else
+# define INLINE static
+# endif /* HAVE_INLINE */
+#endif /* not C++ */
+#endif /* C code */
+
+#if defined (__cplusplus) && !defined (NOT_C_CODE)
+/* Avoid C++ keywords used as ordinary C identifiers */
+#define class c_class
+#define new c_new
+#define this c_this
+#define catch c_catch
+#endif /* C++ */
+
+/* Strictly speaking, only int or unsigned int are valid types in a
+ bitfield. In practice, we would like to use enums as bitfields.
+ The following should just result in warning avoidance:
+ warning: nonportable bit-field type */
+#ifdef __GNUC__
+#define enum_field(enumeration_type) enum enumeration_type
+#else
+#define enum_field(enumeration_type) unsigned int
+#endif
+
+/* We want to avoid saving the signal mask if possible, because
+ that necessitates a system call. */
+#ifdef HAVE_SIGSETJMP
+# define SETJMP(x) sigsetjmp (x, 0)
+# define LONGJMP(x, y) siglongjmp (x, y)
+# define JMP_BUF sigjmp_buf
+#else
+# define SETJMP(x) setjmp (x)
+# define LONGJMP(x, y) longjmp (x, y)
+# define JMP_BUF jmp_buf
+#endif
+
+/* movemail options */
+/* Should movemail use POP3 for mail access? */
+#undef MAIL_USE_POP
+/* Should movemail use kerberos for POP authentication? */
+#undef KERBEROS
+/* 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 LISPDIR_USER_DEFINED
+#undef PACKAGE_PATH_USER_DEFINED
+#undef SITELISPDIR_USER_DEFINED
+#undef ARCHLIBDIR_USER_DEFINED
+#undef ETCDIR_USER_DEFINED
+#undef LOCKDIR_USER_DEFINED
+#undef INFODIR_USER_DEFINED
+#undef INFOPATH_USER_DEFINED
+
+#endif /* _SRC_CONFIG_H_ */
--- /dev/null
+/* Stream device functions.
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Copyright (C) 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. */
+
+/* This file has been Mule-ized. */
+
+/* Written by Ben Wing. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "console-stream.h"
+#include "console-tty.h"
+#include "events.h"
+#include "frame.h"
+#include "redisplay.h"
+#include "sysdep.h"
+#include "sysfile.h"
+#include "window.h"
+
+DEFINE_CONSOLE_TYPE (stream);
+
+Lisp_Object Vterminal_console;
+Lisp_Object Vterminal_device;
+Lisp_Object Vterminal_frame;
+
+Lisp_Object Vstdio_str;
+
+static void
+allocate_stream_console_struct (struct console *con)
+{
+ if (!CONSOLE_STREAM_DATA (con))
+ CONSOLE_STREAM_DATA (con) = xnew_and_zero (struct stream_console);
+ else
+ xzero (*CONSOLE_STREAM_DATA (con));
+}
+
+static void
+stream_init_console (struct console *con, Lisp_Object params)
+{
+ Lisp_Object tty = CONSOLE_CONNECTION (con);
+ FILE *infd, *outfd, *errfd;
+
+ /* Open the specified console */
+
+ if (NILP (tty) || internal_equal (tty, Vstdio_str, 0))
+ {
+ infd = stdin;
+ outfd = stdout;
+ errfd = stderr;
+ }
+ else
+ {
+ CHECK_STRING (tty);
+ infd = outfd = errfd =
+ fopen ((char *) XSTRING_DATA (tty), "r+");
+ if (!infd)
+ error ("Unable to open tty %s", XSTRING_DATA (tty));
+ }
+
+ allocate_stream_console_struct (con);
+ CONSOLE_STREAM_DATA (con)->infd = infd;
+ CONSOLE_STREAM_DATA (con)->outfd = outfd;
+ CONSOLE_STREAM_DATA (con)->errfd = errfd;
+}
+
+static void
+stream_init_device (struct device *d, Lisp_Object params)
+{
+ struct console *con = XCONSOLE (DEVICE_CONSOLE (d));
+
+ DEVICE_INFD (d) = fileno (CONSOLE_STREAM_DATA (con)->infd);
+ DEVICE_OUTFD (d) = fileno (CONSOLE_STREAM_DATA (con)->outfd);
+ init_baud_rate (d);
+ init_one_device (d);
+}
+
+static int
+stream_initially_selected_for_input (struct console *con)
+{
+ return noninteractive && initialized;
+}
+
+static void
+free_stream_console_struct (struct console *con)
+{
+ if (CONSOLE_STREAM_DATA (con))
+ {
+ xfree (CONSOLE_STREAM_DATA (con));
+ CONSOLE_STREAM_DATA (con) = NULL;
+ }
+}
+
+extern int stdout_needs_newline;
+
+static void
+stream_delete_console (struct console *con)
+{
+ if (/* CONSOLE_STREAM_DATA (con)->needs_newline */
+ stdout_needs_newline) /* #### clean this up */
+ {
+ fputc ('\n', CONSOLE_STREAM_DATA (con)->outfd);
+ fflush (CONSOLE_STREAM_DATA (con)->outfd);
+ }
+ if (CONSOLE_STREAM_DATA (con)->infd != stdin)
+ fclose (CONSOLE_STREAM_DATA (con)->infd);
+ free_stream_console_struct (con);
+}
+
+Lisp_Object
+stream_semi_canonicalize_console_connection (Lisp_Object connection,
+ Error_behavior errb)
+{
+ return NILP (connection) ? Vstdio_str : connection;
+}
+
+Lisp_Object
+stream_canonicalize_console_connection (Lisp_Object connection,
+ Error_behavior errb)
+{
+ if (NILP (connection) || internal_equal (connection, Vstdio_str, 0))
+ return Vstdio_str;
+
+ if (!ERRB_EQ (errb, ERROR_ME))
+ {
+ if (!STRINGP (connection))
+ return Qunbound;
+ }
+ else
+ CHECK_STRING (connection);
+
+ return Ffile_truename (connection, Qnil);
+}
+
+Lisp_Object
+stream_semi_canonicalize_device_connection (Lisp_Object connection,
+ Error_behavior errb)
+{
+ return stream_semi_canonicalize_console_connection (connection, errb);
+}
+
+Lisp_Object
+stream_canonicalize_device_connection (Lisp_Object connection,
+ Error_behavior errb)
+{
+ return stream_canonicalize_console_connection (connection, errb);
+}
+
+\f
+static void
+stream_init_frame_1 (struct frame *f, Lisp_Object props)
+{
+#if 0
+ struct device *d = XDEVICE (FRAME_DEVICE (f));
+ if (!NILP (DEVICE_FRAME_LIST (d)))
+ error ("Only one frame allowed on stream devices");
+#endif
+ f->name = build_string ("stream");
+ f->height = 80;
+ f->width = 24;
+ f->visible = 0; /* so redisplay doesn't try to do anything */
+}
+
+\f
+static int
+stream_text_width (struct frame *f, struct face_cachel *cachel,
+ CONST Emchar *str, Charcount len)
+{
+ return len;
+}
+
+static int
+stream_left_margin_width (struct window *w)
+{
+ return 0;
+}
+
+static int
+stream_right_margin_width (struct window *w)
+{
+ return 0;
+}
+
+static int
+stream_divider_height (void)
+{
+ return 1;
+}
+
+static int
+stream_eol_cursor_width (void)
+{
+ return 1;
+}
+
+static void
+stream_output_begin (struct device *d)
+{
+}
+
+static void
+stream_output_end (struct device *d)
+{
+}
+
+static void
+stream_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_height)
+{
+}
+
+static void
+stream_output_vertical_divider (struct window *w, int clear)
+{
+}
+
+static void
+stream_clear_to_window_end (struct window *w, int ypos1, int ypos2)
+{
+}
+
+static void
+stream_clear_region (Lisp_Object locale, face_index findex, int x, int y,
+ int width, int height)
+{
+}
+
+static void
+stream_clear_frame (struct frame *f)
+{
+}
+
+static int
+stream_flash (struct device *d)
+{
+ return 0; /* sorry can't do it */
+}
+
+static void
+stream_ring_bell (struct device *d, int volume, int pitch, int duration)
+{
+ struct console *c = XCONSOLE (DEVICE_CONSOLE (d));
+ fputc (07, CONSOLE_STREAM_DATA (c)->outfd);
+ fflush (CONSOLE_STREAM_DATA (c)->outfd);
+}
+
+\f
+/************************************************************************/
+/* initialization */
+/************************************************************************/
+
+void
+console_type_create_stream (void)
+{
+ INITIALIZE_CONSOLE_TYPE (stream, "stream", "console-stream-p");
+
+ /* console methods */
+ CONSOLE_HAS_METHOD (stream, init_console);
+ CONSOLE_HAS_METHOD (stream, initially_selected_for_input);
+ CONSOLE_HAS_METHOD (stream, delete_console);
+ CONSOLE_HAS_METHOD (stream, canonicalize_console_connection);
+ CONSOLE_HAS_METHOD (stream, canonicalize_device_connection);
+ CONSOLE_HAS_METHOD (stream, semi_canonicalize_console_connection);
+ CONSOLE_HAS_METHOD (stream, semi_canonicalize_device_connection);
+
+ /* device methods */
+ CONSOLE_HAS_METHOD (stream, init_device);
+
+ /* frame methods */
+ CONSOLE_HAS_METHOD (stream, init_frame_1);
+
+ /* redisplay methods */
+ CONSOLE_HAS_METHOD (stream, left_margin_width);
+ CONSOLE_HAS_METHOD (stream, right_margin_width);
+ CONSOLE_HAS_METHOD (stream, text_width);
+ CONSOLE_HAS_METHOD (stream, output_display_block);
+ CONSOLE_HAS_METHOD (stream, output_vertical_divider);
+ CONSOLE_HAS_METHOD (stream, divider_height);
+ CONSOLE_HAS_METHOD (stream, eol_cursor_width);
+ CONSOLE_HAS_METHOD (stream, clear_to_window_end);
+ CONSOLE_HAS_METHOD (stream, clear_region);
+ CONSOLE_HAS_METHOD (stream, clear_frame);
+ CONSOLE_HAS_METHOD (stream, output_begin);
+ CONSOLE_HAS_METHOD (stream, output_end);
+ CONSOLE_HAS_METHOD (stream, flash);
+ CONSOLE_HAS_METHOD (stream, ring_bell);
+}
+
+void
+vars_of_console_stream (void)
+{
+ DEFVAR_LISP ("terminal-console", &Vterminal_console /*
+The initial console-object, which represents XEmacs' stdout.
+*/ );
+ Vterminal_console = Qnil;
+
+ DEFVAR_LISP ("terminal-device", &Vterminal_device /*
+The initial device-object, which represents XEmacs' stdout.
+*/ );
+ Vterminal_device = Qnil;
+
+ DEFVAR_LISP ("terminal-frame", &Vterminal_frame /*
+The initial frame-object, which represents XEmacs' stdout.
+*/ );
+ Vterminal_frame = Qnil;
+
+ /* Moved from console-tty.c */
+ Vstdio_str = build_string ("stdio");
+ staticpro (&Vstdio_str);
+}
+
+void
+init_console_stream (void)
+{
+ /* This function can GC */
+ if (!initialized)
+ {
+ 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;
+ }
+ else
+ {
+ /* Re-initialize the FILE fields of the console. */
+ stream_init_console (XCONSOLE (Vterminal_console), Qnil);
+ if (noninteractive)
+ event_stream_select_console (XCONSOLE (Vterminal_console));
+ }
+}
--- /dev/null
+/* Define X specific console, device, and frame object for XEmacs.
+ Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+ Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
+
+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. */
+
+
+/* Authorship:
+
+ Ultimately based on FSF, then later on JWZ work for Lemacs.
+ Rewritten over time by Ben Wing and Chuck Thompson (original
+ multi-device work by Chuck Thompson).
+ */
+
+#ifndef _XEMACS_CONSOLE_X_H_
+#define _XEMACS_CONSOLE_X_H_
+
+#ifdef HAVE_X_WINDOWS
+
+#include "console.h"
+#include "xintrinsic.h"
+
+#include <X11/cursorfont.h>
+#include <X11/keysym.h>
+#include <X11/Xatom.h>
+
+#if 0 /* mrb - Xos sux. */
+#ifdef USG
+#undef USG /* ####KLUDGE for Solaris 2.2 and up */
+#include <X11/Xos.h>
+#define USG
+#else
+#include <X11/Xos.h>
+#endif
+#endif /* 0 */
+
+#include <X11/StringDefs.h>
+
+#ifdef HAVE_XPM
+#include <X11/xpm.h>
+#endif
+
+/* R5 defines the XPointer type, but R4 doesn't.
+ R4 also doesn't define a version number, but R5 does. */
+#if (XlibSpecificationRelease < 5)
+# define XPointer char *
+#endif
+
+DECLARE_CONSOLE_TYPE (x);
+
+struct x_device
+{
+ /* The X connection of this device. */
+ Display *display;
+
+ /* Xt application info. */
+ Widget Xt_app_shell;
+
+ /* Cache of GC's for frame's on this device. */
+ struct gc_cache *gc_cache;
+
+ /* Selected visual, depth and colormap for this device */
+ Visual *visual;
+ int depth;
+ Colormap device_cmap;
+
+ /* Used by x_bevel_modeline in redisplay-x.c */
+ Pixmap gray_pixmap;
+
+ /* Atoms associated with this device. */
+ /* allocated in Xatoms_of_xfns in xfns.c */
+ Atom Xatom_WM_PROTOCOLS;
+ Atom Xatom_WM_DELETE_WINDOW;
+ Atom Xatom_WM_SAVE_YOURSELF;
+ Atom Xatom_WM_TAKE_FOCUS;
+ Atom Xatom_WM_STATE;
+
+ /* allocated in Xatoms_of_xselect in xselect.c */
+ Atom Xatom_CLIPBOARD;
+ Atom Xatom_TIMESTAMP;
+ Atom Xatom_TEXT;
+ Atom Xatom_DELETE;
+ Atom Xatom_MULTIPLE;
+ Atom Xatom_INCR;
+ Atom Xatom_EMACS_TMP;
+ Atom Xatom_TARGETS;
+ Atom Xatom_NULL;
+ Atom Xatom_ATOM_PAIR;
+ Atom Xatom_COMPOUND_TEXT;
+
+ /* allocated in Xatoms_of_objects_x in objects-x.c */
+ Atom Xatom_FOUNDRY;
+ Atom Xatom_FAMILY_NAME;
+ Atom Xatom_WEIGHT_NAME;
+ Atom Xatom_SLANT;
+ Atom Xatom_SETWIDTH_NAME;
+ Atom Xatom_ADD_STYLE_NAME;
+ Atom Xatom_PIXEL_SIZE;
+ Atom Xatom_POINT_SIZE;
+ Atom Xatom_RESOLUTION_X;
+ Atom Xatom_RESOLUTION_Y;
+ Atom Xatom_SPACING;
+ Atom Xatom_AVERAGE_WIDTH;
+ Atom Xatom_CHARSET_REGISTRY;
+ Atom Xatom_CHARSET_ENCODING;
+
+ /* The following items are all used exclusively in event-Xt.c. */
+ int MetaMask, HyperMask, SuperMask, AltMask, ModeMask;
+ KeySym lock_interpretation;
+
+ XModifierKeymap *x_modifier_keymap;
+
+ KeySym *x_keysym_map;
+ int x_keysym_map_min_code;
+ int x_keysym_map_max_code;
+ int x_keysym_map_keysyms_per_code;
+ Lisp_Object x_keysym_map_hashtable;
+
+ /* frame that holds the WM_COMMAND property; there should be exactly
+ one of these per device. */
+ Lisp_Object WM_COMMAND_frame;
+
+ /* #### It's not clear that there is much distinction anymore
+ between mouse_timestamp and global_mouse_timestamp, now that
+ Emacs doesn't see most (all?) events not destined for it. */
+
+ /* The timestamp of the last button or key event used by emacs itself.
+ This is used for asserting selections and input focus. */
+ Time mouse_timestamp;
+
+ /* This is the timestamp the last button or key event whether it was
+ dispatched to emacs or widgets. */
+ Time global_mouse_timestamp;
+
+ /* This is the last known timestamp received from the server. It is
+ maintained by x_event_to_emacs_event and used to patch bogus
+ WM_TAKE_FOCUS messages sent by Mwm. */
+ Time last_server_timestamp;
+
+ /* Used by Xlib to preserve information across calls to
+ XLookupString(), to implement compose processing.
+
+ According to The X Window System, p. 467, "The creation of
+ XComposeStatus structures is implementation dependent;
+ a portable program must pass NULL for this argument."
+ But this means that a portable program cannot implement
+ compose processing! WTF?
+
+ So we just set it to all zeros. */
+
+ /* No X Server ever used this, AFAIK -- mrb */
+ /* XComposeStatus x_compose_status; */
+
+#ifdef HAVE_XIM
+ XIM xim;
+ XIMStyles *xim_styles;
+#endif /* HAVE_XIM */
+
+ /* stuff for sticky modifiers: */
+
+ unsigned int need_to_add_mask, down_mask;
+ KeyCode last_downkey;
+ Time release_time;
+};
+
+#define DEVICE_X_DATA(d) DEVICE_TYPE_DATA (d, x)
+
+#define FRAME_X_DISPLAY(f) (DEVICE_X_DISPLAY (XDEVICE (f->device)))
+#define DEVICE_X_DISPLAY(d) (DEVICE_X_DATA (d)->display)
+#define DEVICE_X_VISUAL(d) (DEVICE_X_DATA (d)->visual)
+#define DEVICE_X_DEPTH(d) (DEVICE_X_DATA (d)->depth)
+#define DEVICE_X_COLORMAP(d) (DEVICE_X_DATA (d)->device_cmap)
+#define DEVICE_XT_APP_SHELL(d) (DEVICE_X_DATA (d)->Xt_app_shell)
+#define DEVICE_X_GC_CACHE(d) (DEVICE_X_DATA (d)->gc_cache)
+#define DEVICE_X_GRAY_PIXMAP(d) (DEVICE_X_DATA (d)->gray_pixmap)
+#define DEVICE_X_WM_COMMAND_FRAME(d) (DEVICE_X_DATA (d)->WM_COMMAND_frame)
+#define DEVICE_X_MOUSE_TIMESTAMP(d) (DEVICE_X_DATA (d)->mouse_timestamp)
+#define DEVICE_X_GLOBAL_MOUSE_TIMESTAMP(d) (DEVICE_X_DATA (d)->global_mouse_timestamp)
+#define DEVICE_X_LAST_SERVER_TIMESTAMP(d) (DEVICE_X_DATA (d)->last_server_timestamp)
+#define DEVICE_X_KEYSYM_MAP_HASHTABLE(d) (DEVICE_X_DATA (d)->x_keysym_map_hashtable)
+/* #define DEVICE_X_X_COMPOSE_STATUS(d) (DEVICE_X_DATA (d)->x_compose_status) */
+#ifdef HAVE_XIM
+#define DEVICE_X_XIM(d) (DEVICE_X_DATA (d)->xim)
+#define DEVICE_X_XIM_STYLES(d) (DEVICE_X_DATA (d)->xim_styles)
+#define DEVICE_X_FONTSET(d) (DEVICE_X_DATA (d)->fontset)
+#endif /* HAVE_XIM */
+
+/* allocated in Xatoms_of_xfns in xfns.c */
+#define DEVICE_XATOM_WM_PROTOCOLS(d) (DEVICE_X_DATA (d)->Xatom_WM_PROTOCOLS)
+#define DEVICE_XATOM_WM_DELETE_WINDOW(d) (DEVICE_X_DATA (d)->Xatom_WM_DELETE_WINDOW)
+#define DEVICE_XATOM_WM_SAVE_YOURSELF(d) (DEVICE_X_DATA (d)->Xatom_WM_SAVE_YOURSELF)
+#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 */
+#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)
+#define DEVICE_XATOM_DELETE(d) (DEVICE_X_DATA (d)->Xatom_DELETE)
+#define DEVICE_XATOM_MULTIPLE(d) (DEVICE_X_DATA (d)->Xatom_MULTIPLE)
+#define DEVICE_XATOM_INCR(d) (DEVICE_X_DATA (d)->Xatom_INCR)
+#define DEVICE_XATOM_EMACS_TMP(d) (DEVICE_X_DATA (d)->Xatom_EMACS_TMP)
+#define DEVICE_XATOM_TARGETS(d) (DEVICE_X_DATA (d)->Xatom_TARGETS)
+#define DEVICE_XATOM_NULL(d) (DEVICE_X_DATA (d)->Xatom_NULL)
+#define DEVICE_XATOM_ATOM_PAIR(d) (DEVICE_X_DATA (d)->Xatom_ATOM_PAIR)
+#define DEVICE_XATOM_COMPOUND_TEXT(d) (DEVICE_X_DATA (d)->Xatom_COMPOUND_TEXT)
+
+/* allocated in Xatoms_of_objects_x in objects-x.c */
+#define DEVICE_XATOM_FOUNDRY(d) (DEVICE_X_DATA (d)->Xatom_FOUNDRY)
+#define DEVICE_XATOM_FAMILY_NAME(d) (DEVICE_X_DATA (d)->Xatom_FAMILY_NAME)
+#define DEVICE_XATOM_WEIGHT_NAME(d) (DEVICE_X_DATA (d)->Xatom_WEIGHT_NAME)
+#define DEVICE_XATOM_SLANT(d) (DEVICE_X_DATA (d)->Xatom_SLANT)
+#define DEVICE_XATOM_SETWIDTH_NAME(d) (DEVICE_X_DATA (d)->Xatom_SETWIDTH_NAME)
+#define DEVICE_XATOM_ADD_STYLE_NAME(d) (DEVICE_X_DATA (d)->Xatom_ADD_STYLE_NAME)
+#define DEVICE_XATOM_PIXEL_SIZE(d) (DEVICE_X_DATA (d)->Xatom_PIXEL_SIZE)
+#define DEVICE_XATOM_POINT_SIZE(d) (DEVICE_X_DATA (d)->Xatom_POINT_SIZE)
+#define DEVICE_XATOM_RESOLUTION_X(d) (DEVICE_X_DATA (d)->Xatom_RESOLUTION_X)
+#define DEVICE_XATOM_RESOLUTION_Y(d) (DEVICE_X_DATA (d)->Xatom_RESOLUTION_Y)
+#define DEVICE_XATOM_SPACING(d) (DEVICE_X_DATA (d)->Xatom_SPACING)
+#define DEVICE_XATOM_AVERAGE_WIDTH(d) (DEVICE_X_DATA (d)->Xatom_AVERAGE_WIDTH)
+#define DEVICE_XATOM_CHARSET_REGISTRY(d) (DEVICE_X_DATA (d)->Xatom_CHARSET_REGISTRY)
+#define DEVICE_XATOM_CHARSET_ENCODING(d) (DEVICE_X_DATA (d)->Xatom_CHARSET_ENCODING)
+
+#define Xt_SET_VALUE(widget, resource, value) do { \
+ Arg al; \
+ XtSetArg (al, resource, value); \
+ XtSetValues (widget, &al, 1); \
+} while (0)
+
+#define Xt_GET_VALUE(widget, resource, location) do { \
+ Arg al; \
+ XtSetArg (al, resource, location); \
+ XtGetValues (widget, &al, 1); \
+} while (0)
+
+/* The maximum number of widgets that can be displayed above the text
+ area at one time. Currently no more than 3 will ever actually be
+ displayed (menubar, psheet, debugger panel). */
+#define MAX_CONCURRENT_TOP_WIDGETS 8
+
+struct x_frame
+{
+ /* The widget of this frame. This is an EmacsShell or an
+ ExternalShell. */
+ Widget widget;
+
+ /* The parent of the EmacsFrame, the menubar, and the scrollbars.
+ This is an EmacsManager. */
+ Widget container;
+
+ /* The widget of the menubar, of whatever widget class it happens to be. */
+ Widget menubar_widget;
+
+ /* The widget of the edit portion of this frame; this is an EmacsFrame,
+ and the window of this widget is what the redisplay code draws on. */
+ Widget edit_widget;
+
+ /* Lists the widgets above the text area, in the proper order.
+ Used by the EmacsManager. */
+ Widget top_widgets[MAX_CONCURRENT_TOP_WIDGETS];
+ int num_top_widgets;
+
+ /*************************** Miscellaneous **************************/
+
+ /* The icon pixmaps; these are Lisp_Image_Instance objects, or Qnil. */
+ Lisp_Object icon_pixmap;
+ Lisp_Object icon_pixmap_mask;
+
+#ifdef HAVE_TOOLBARS
+ int old_toolbar_size[4];
+
+ /* We don't provide a mechanism for changing these after they are
+ initialized so we might as well keep pointers to them and avoid
+ lots of expensive calls to gc_cache_lookup. */
+ GC toolbar_top_shadow_gc;
+ GC toolbar_bottom_shadow_gc;
+ GC toolbar_blank_background_gc;
+ GC toolbar_pixmap_background_gc;
+#endif /* HAVE_TOOLBARS */
+
+ /* geometry string that ought to be freed. */
+ char *geom_free_me_please;
+
+#ifdef HAVE_XIM
+ XPoint xic_spot; /* Spot Location cache */
+#ifdef XIM_XLIB
+ XIC xic;
+ /* Could get these at any time by asking xic, but... */
+ XIMStyle xic_style; /* XIM Style cache */
+#endif /* XIM_XLIB */
+#endif /* HAVE_XIM */
+
+ /* 1 if the frame is completely visible on the display, 0 otherwise.
+ if 0 the frame may have been iconified or may be totally
+ or partially hidden by another X window */
+ unsigned int totally_visible_p :1;
+
+ /* NB: Both of the following flags are derivable from the 'shell'
+ field above, but it's easier if we also have them separately here. */
+
+ /* Are we a top-level frame? This means that our shell is a
+ TopLevelShell, and we should do certain things to interact with
+ the window manager. */
+ unsigned int top_level_frame_p :1;
+
+#ifdef EXTERNAL_WIDGET
+ /* Are we using somebody else's window for our shell window? This
+ means that our shell is an ExternalShell. If this flag is set, then
+ `top_level_frame_p' will never be set. */
+ unsigned int external_window_p :1;
+#endif /* EXTERNAL_WIDGET */
+};
+
+#define FRAME_X_DATA(f) FRAME_TYPE_DATA (f, x)
+
+#define FRAME_X_SHELL_WIDGET(f) (FRAME_X_DATA (f)->widget)
+#define FRAME_X_CONTAINER_WIDGET(f) (FRAME_X_DATA (f)->container)
+#define FRAME_X_MENUBAR_WIDGET(f) (FRAME_X_DATA (f)->menubar_widget)
+#define FRAME_X_TEXT_WIDGET(f) (FRAME_X_DATA (f)->edit_widget)
+#define FRAME_X_TOP_WIDGETS(f) (FRAME_X_DATA (f)->top_widgets)
+#define FRAME_X_NUM_TOP_WIDGETS(f) (FRAME_X_DATA (f)->num_top_widgets)
+
+#define FRAME_X_ICON_PIXMAP(f) (FRAME_X_DATA (f)->icon_pixmap)
+#define FRAME_X_ICON_PIXMAP_MASK(f) (FRAME_X_DATA (f)->icon_pixmap_mask)
+
+#ifdef HAVE_TOOLBARS
+#define FRAME_X_OLD_TOOLBAR_SIZE(f, pos) (FRAME_X_DATA (f)->old_toolbar_size[pos])
+
+#define FRAME_X_TOOLBAR_TOP_SHADOW_GC(f) (FRAME_X_DATA (f)->toolbar_top_shadow_gc)
+#define FRAME_X_TOOLBAR_BOTTOM_SHADOW_GC(f) (FRAME_X_DATA (f)->toolbar_bottom_shadow_gc)
+#define FRAME_X_TOOLBAR_BLANK_BACKGROUND_GC(f) (FRAME_X_DATA (f)->toolbar_blank_background_gc)
+#define FRAME_X_TOOLBAR_PIXMAP_BACKGROUND_GC(f) (FRAME_X_DATA (f)->toolbar_pixmap_background_gc)
+#endif /* HAVE_TOOLBARS */
+
+#define FRAME_X_GEOM_FREE_ME_PLEASE(f) (FRAME_X_DATA (f)->geom_free_me_please)
+
+#define FRAME_X_TOTALLY_VISIBLE_P(f) (FRAME_X_DATA (f)->totally_visible_p)
+#define FRAME_X_TOP_LEVEL_FRAME_P(f) (FRAME_X_DATA (f)->top_level_frame_p)
+
+#ifdef EXTERNAL_WIDGET
+#define FRAME_X_EXTERNAL_WINDOW_P(f) (FRAME_X_DATA (f)->external_window_p)
+#endif
+
+#ifdef HAVE_XIM
+#define FRAME_X_XIC_SPOT(f) (FRAME_X_DATA (f)->xic_spot)
+#ifdef XIM_XLIB
+#define FRAME_X_XIC(f) (FRAME_X_DATA (f)->xic)
+#define FRAME_X_XIC_STYLE(f) (FRAME_X_DATA (f)->xic_style)
+#endif /* XIM_XLIB */
+#endif /* HAVE_XIM */
+
+/* Variables associated with the X display frame this emacs is using. */
+extern XtAppContext Xt_app_con;
+
+extern Lisp_Object Vx_gc_pointer_shape;
+extern Lisp_Object Vx_scrollbar_pointer_shape;
+extern Lisp_Object Qx_error;
+
+extern struct console_type *x_console_type;
+extern Lisp_Object Vdefault_x_device;
+
+/* Number of pixels below each line. */
+extern int x_interline_space;
+
+extern int x_selection_timeout;
+
+struct frame *x_any_window_to_frame (struct device *d, Window);
+struct frame *x_any_widget_or_parent_to_frame (struct device *d,
+ Widget widget);
+struct frame *decode_x_frame (Lisp_Object);
+struct frame *x_window_to_frame (struct device *d, Window);
+struct device *get_device_from_display (Display *dpy);
+struct device *decode_x_device (Lisp_Object);
+
+void x_handle_selection_notify (XSelectionEvent *event);
+void x_handle_selection_request (XSelectionRequestEvent *event);
+void x_handle_selection_clear (XSelectionClearEvent *event);
+void x_handle_property_notify (XPropertyEvent *event);
+
+void Xatoms_of_xselect (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);
+int x_error_handler (Display *disp, XErrorEvent *event);
+void expect_x_error (Display *dpy);
+int x_error_occurred_p (Display *dpy);
+int signal_if_x_error (Display *dpy, int resumable_p);
+int x_IO_error_handler (Display *disp);
+
+void x_redraw_exposed_area (struct frame *f, int x, int y,
+ int width, int height);
+void x_output_string (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);
+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);
+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);
+void x_generate_shadow_pixels (struct frame *f,
+ unsigned long *top_shadow,
+ unsigned long *bottom_shadow,
+ unsigned long background,
+ unsigned long core_background);
+
+int x_initialize_frame_menubar (struct frame *f);
+void x_init_modifier_mapping (struct device *d);
+
+#define X_ERROR_OCCURRED(dpy, body) \
+ (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))
+
+void Initialize_Locale (void);
+
+#ifdef HAVE_XIM
+
+/* X Input Method `methods' */
+void XIM_init_device (struct device *d);
+void XIM_init_frame (struct frame *f);
+void XIM_SetSpotLocation (struct frame *f, int x, int y);
+void XIM_SetGeometry (struct frame *f);
+void XIM_focus_event (struct frame *f, int in_p);
+
+#ifdef XIM_XLIB
+/* XtTypeConverter */
+Boolean EmacsXtCvtStringToXIMStyles (
+ Display *dpy,
+ XrmValuePtr args,
+ Cardinal *num_args,
+ XrmValuePtr from,
+ XrmValuePtr to_in_out,
+ XtPointer *converter_data);
+
+/* XtDestructor */
+void EmacsFreeXIMStyles (
+ XtAppContext app,
+ XrmValuePtr to,
+ XtPointer converter_data,
+ XrmValuePtr args,
+ Cardinal *num_args);
+
+#ifdef DEBUG_XEMACS
+void describe_Window (Window win);
+void describe_XFontSet (XFontSet font_set);
+void describe_XIM (XIM im);
+void describe_XIMStyle (XIMStyle style);
+void describe_XIMStyles (XIMStyles *styles);
+void describe_XIC (XIC ic);
+void describe_event_mask (unsigned long mask);
+void describe_XRectangle (char *name, XRectangle *rect);
+void describe_Status (Status status);
+#endif /* DEBUG_XEMACS */
+#endif /* XIM_XLIB */
+#endif /* HAVE_XIM */
+
+extern int in_resource_setting;
+extern int in_specifier_change_function;
+
+extern Lisp_Object Vx_initial_argv_list; /* #### ugh! */
+
+#endif /* HAVE_X_WINDOWS */
+#endif /* _XEMACS_DEVICE_X_H_ */
--- /dev/null
+/* Define console object for XEmacs.
+ Copyright (C) 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. */
+
+/* Written by Ben Wing. */
+
+#ifndef _XEMACS_CONSOLE_H_
+#define _XEMACS_CONSOLE_H_
+
+/* Devices and consoles are similar entities. The idea is that
+ a console represents a physical keyboard/mouse/other-input-source
+ while a device represents a display where frames appear on.
+ In the X world, a console is a "Display" while a device is a
+ "Screen". Implementationally, it can sometimes get confusing:
+ under X, multiple devices on a single console are different
+ "Display" connections to what is in reality the same Display on
+ the same server. Because of this, input comes from the device
+ and not from the console. This is OK because events are basically
+ always tagged to a particular X window (i.e. frame),
+ which exists on only one screen; therefore the event won't be
+ reported multiple times even if there are multiple devices on
+ the same physical display. This is an implementational detail
+ specific to X consoles (e.g. under NeXTstep or Windows, this
+ could be different, and input would come directly from the console).
+*/
+
+
+/* GCC does not like forward enum declaration. This needs to be
+ defined here. What a disgust! */
+
+enum device_metrics
+{
+ DM_color_default, DM_color_select, DM_color_balloon, DM_color_3d_face,
+ DM_color_3d_light, DM_color_3d_dark, DM_color_menu, DM_color_menu_highlight,
+ DM_color_menu_button, DM_color_menu_disabled, DM_color_toolbar,
+ DM_color_scrollbar, DM_color_desktop, DM_color_workspace, DM_font_default,
+ 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
+};
+
+struct console_methods
+{
+ 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));
+ int (*initially_selected_for_input_method) (struct console *);
+ void (*delete_console_method) (struct console *);
+ Lisp_Object (*semi_canonicalize_console_connection_method)
+ (Lisp_Object connection, Error_behavior errb);
+ Lisp_Object (*semi_canonicalize_device_connection_method)
+ (Lisp_Object connection, Error_behavior errb);
+ Lisp_Object (*canonicalize_console_connection_method)
+ (Lisp_Object connection, Error_behavior errb);
+ Lisp_Object (*canonicalize_device_connection_method)
+ (Lisp_Object connection, Error_behavior errb);
+ Lisp_Object (*device_to_console_connection_method)
+ (Lisp_Object connection, Error_behavior errb);
+
+ /* device methods */
+ 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 (*asynch_device_change_method) (void);
+ Lisp_Object (*device_system_metrics_method) (struct device *, enum device_metrics);
+ unsigned int (*device_implementation_flags_method) ();
+
+ /* frame methods */
+ Lisp_Object *device_specific_frame_props;
+ void (*init_frame_1_method) (struct frame *, Lisp_Object properties);
+ void (*init_frame_2_method) (struct frame *, Lisp_Object properties);
+ 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 (*delete_frame_method) (struct frame *);
+ void (*focus_on_frame_method) (struct frame *);
+ void (*raise_frame_method) (struct frame *);
+ void (*lower_frame_method) (struct frame *);
+ int (*get_mouse_position_method) (struct device *d, Lisp_Object *frame,
+ int *x, int *y);
+ void (*set_mouse_position_method) (struct window *w, int x, int y);
+ void (*make_frame_visible_method) (struct frame *f);
+ void (*make_frame_invisible_method) (struct frame *f);
+ void (*iconify_frame_method) (struct frame *f);
+ Lisp_Object (*frame_property_method) (struct frame *f, Lisp_Object prop);
+ int (*internal_frame_property_p_method) (struct frame *f,
+ Lisp_Object prop);
+ Lisp_Object (*frame_properties_method) (struct frame *f);
+ void (*set_frame_properties_method) (struct frame *f, Lisp_Object plist);
+ void (*set_frame_size_method) (struct frame *f, int width, int height);
+ void (*set_frame_position_method) (struct frame *f, int xoff, int yoff);
+ int (*frame_visible_p_method) (struct frame *f);
+ int (*frame_totally_visible_p_method) (struct frame *f);
+ int (*frame_iconified_p_method) (struct frame *f);
+ void (*set_title_from_bufbyte_method) (struct frame *f, Bufbyte *title);
+ void (*set_icon_name_from_bufbyte_method) (struct frame *f, Bufbyte *title);
+ void (*set_frame_pointer_method) (struct frame *f);
+ void (*set_frame_icon_method) (struct frame *f);
+ void (*popup_menu_method) (Lisp_Object menu, Lisp_Object event);
+ 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);
+
+ /* 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);
+ void (*output_display_block_method) (struct window *, struct display_line *,
+ int, int, int, int, int, int, int);
+ int (*divider_height_method) (void);
+ int (*eol_cursor_width_method) (void);
+ void (*output_vertical_divider_method) (struct window *, int);
+ void (*clear_to_window_end_method) (struct window *, int, int);
+ void (*clear_region_method) (Lisp_Object, face_index, int, int, int, int);
+ void (*clear_frame_method) (struct frame *);
+ void (*output_begin_method) (struct device *);
+ void (*output_end_method) (struct device *);
+ int (*flash_method) (struct device *);
+ void (*ring_bell_method) (struct device *, int volume, int pitch,
+ int duration);
+ void (*frame_redraw_cursor_method) (struct frame *f);
+ void (*set_final_cursor_coords_method) (struct frame *, int, int);
+
+ /* color methods */
+ int (*initialize_color_instance_method) (struct 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 *,
+ 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 *,
+ int depth);
+ unsigned long (*color_instance_hash_method) (struct Lisp_Color_Instance *,
+ int depth);
+ Lisp_Object (*color_instance_rgb_components_method)
+ (struct 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 *,
+ 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 *,
+ Lisp_Object printcharfun,
+ int escapeflag);
+ void (*finalize_font_instance_method) (struct Lisp_Font_Instance *);
+ Lisp_Object (*font_instance_truename_method) (struct Lisp_Font_Instance *,
+ Error_behavior errb);
+ Lisp_Object (*font_instance_properties_method) (struct Lisp_Font_Instance *);
+ Lisp_Object (*list_fonts_method) (Lisp_Object pattern,
+ Lisp_Object device);
+ Lisp_Object (*find_charset_font_method) (Lisp_Object device,
+ Lisp_Object font,
+ Lisp_Object charset);
+ int (*font_spec_matches_charset_method) (struct device *d,
+ Lisp_Object charset,
+ 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 *,
+ Lisp_Object printcharfun,
+ int escapeflag);
+ void (*finalize_image_instance_method) (struct Lisp_Image_Instance *);
+ int (*image_instance_equal_method) (struct Lisp_Image_Instance *,
+ struct Lisp_Image_Instance *,
+ int depth);
+ unsigned long (*image_instance_hash_method) (struct Lisp_Image_Instance *,
+ int depth);
+ void (*init_image_instance_from_eimage_method) (struct Lisp_Image_Instance *ii,
+ int width, int height,
+ unsigned char *eimage,
+ int dest_mask,
+ Lisp_Object instantiator,
+ Lisp_Object domain);
+ Lisp_Object (*locate_pixmap_file_method) (Lisp_Object file_method);
+ int (*colorize_image_instance_method) (Lisp_Object image_instance,
+ Lisp_Object fg, Lisp_Object bg);
+#ifdef HAVE_XPM
+ /* which is more tacky - this or #defines in glyphs.c? */
+ void (*xpm_instantiate_method)(Lisp_Object image_instance,
+ Lisp_Object instantiator,
+ Lisp_Object pointer_fg,
+ Lisp_Object pointer_bg,
+ int dest_mask, Lisp_Object domain);
+#endif
+#ifdef HAVE_WINDOW_SYSTEM
+ /* which is more tacky - this or #defines in glyphs.c? */
+ void (*xbm_instantiate_method)(Lisp_Object image_instance,
+ Lisp_Object instantiator,
+ Lisp_Object pointer_fg,
+ Lisp_Object pointer_bg,
+ int dest_mask, Lisp_Object domain);
+#endif
+ Lisp_Object image_conversion_list;
+
+#ifdef HAVE_TOOLBARS
+ /* toolbar methods */
+ void (*output_frame_toolbars_method) (struct frame *);
+ void (*initialize_frame_toolbars_method) (struct frame *);
+ void (*free_frame_toolbars_method) (struct frame *);
+ void (*output_toolbar_button_method) (struct frame *, Lisp_Object);
+ void (*redraw_frame_toolbars_method) (struct frame *);
+ void (*redraw_exposed_toolbars_method) (struct frame *f, int x, int y,
+ int width, int height);
+#endif
+
+#ifdef HAVE_SCROLLBARS
+ /* scrollbar methods */
+ int (*inhibit_scrollbar_slider_size_change_method) (void);
+ void (*free_scrollbar_instance_method) (struct scrollbar_instance *);
+ void (*release_scrollbar_instance_method) (struct scrollbar_instance *);
+ void (*create_scrollbar_instance_method) (struct frame *, int,
+ struct scrollbar_instance *);
+ void (*update_scrollbar_instance_values_method) (struct window *,
+ struct scrollbar_instance *,
+ int, int, int, int, int,
+ int, int, int, int, int);
+ void (*update_scrollbar_instance_status_method) (struct window *, int, int,
+ struct
+ scrollbar_instance *);
+ void (*scrollbar_pointer_changed_in_window_method) (struct window *w);
+#ifdef MEMORY_USAGE_STATS
+ int (*compute_scrollbar_instance_usage_method) (struct device *,
+ struct scrollbar_instance *,
+ struct overhead_stats *);
+#endif
+#endif /* HAVE_SCROLLBARS */
+
+#ifdef HAVE_MENUBARS
+ /* menubar methods */
+ void (*update_frame_menubars_method) (struct frame *);
+ void (*free_frame_menubars_method) (struct frame *);
+#endif
+
+#ifdef HAVE_DIALOGS
+ /* dialog methods */
+ void (*popup_dialog_box_method) (struct frame *, Lisp_Object dbox_desc);
+#endif
+};
+
+/*
+ * Constants returned by device_implementation_flags_method
+ */
+/* Set when device uses pixel-based geometry */
+#define XDEVIMPF_PIXEL_GEOMETRY 0x00000001L
+
+
+#define CONSOLE_TYPE_NAME(c) ((c)->conmeths->name)
+#define CONSOLE_TYPE(c) ((c)->conmeths->symbol)
+#define CONMETH_TYPE(meths) ((meths)->symbol)
+
+/******** Accessing / calling a console method *********/
+
+#define HAS_CONTYPE_METH_P(meth, m) ((meth)->m##_method)
+#define CONTYPE_METH(meth, m, args) (((meth)->m##_method) args)
+
+/* Call a void-returning console method, if it exists */
+#define MAYBE_CONTYPE_METH(meth, m, args) do { \
+ struct console_methods *_maybe_contype_meth_meth = (meth); \
+ if (HAS_CONTYPE_METH_P (_maybe_contype_meth_meth, m)) \
+ CONTYPE_METH (_maybe_contype_meth_meth, m, args); \
+} while (0)
+
+/* Call a console method, if it exists; otherwise return
+ the specified value - meth is multiply evaluated. */
+#define CONTYPE_METH_OR_GIVEN(meth, m, args, given) \
+ (HAS_CONTYPE_METH_P (meth, m) ? \
+ CONTYPE_METH (meth, m, args) : (given))
+
+/* Call an int-returning console method, if it exists; otherwise
+ return 0 */
+#define MAYBE_INT_CONTYPE_METH(meth, m, args) \
+ CONTYPE_METH_OR_GIVEN (meth, m, args, 0)
+
+/* Call an Lisp-Object-returning console method, if it exists;
+ otherwise return Qnil */
+#define MAYBE_LISP_CONTYPE_METH(meth, m, args) \
+ CONTYPE_METH_OR_GIVEN (meth, m, args, Qnil)
+
+/******** Same functions, operating on a console instead of a
+ struct console_methods ********/
+
+#define HAS_CONMETH_P(c, m) HAS_CONTYPE_METH_P ((c)->conmeths, m)
+#define CONMETH(c, m, args) CONTYPE_METH ((c)->conmeths, m, args)
+#define MAYBE_CONMETH(c, m, args) MAYBE_CONTYPE_METH ((c)->conmeths, m, args)
+#define CONMETH_OR_GIVEN(c, m, args, given) \
+ CONTYPE_METH_OR_GIVEN((c)->conmeths, m, args, given)
+#define MAYBE_INT_CONMETH(c, m, args) \
+ MAYBE_INT_CONTYPE_METH ((c)->conmeths, m, args)
+#define MAYBE_LISP_CONMETH(c, m, args) \
+ MAYBE_LISP_CONTYPE_METH ((c)->conmeths, m, args)
+
+/******** Defining new console types ********/
+
+typedef struct console_type_entry console_type_entry;
+struct console_type_entry
+{
+ Lisp_Object symbol;
+ struct console_methods *meths;
+};
+
+#define DECLARE_CONSOLE_TYPE(type) \
+extern struct console_methods * type##_console_methods
+
+#define DEFINE_CONSOLE_TYPE(type) \
+struct console_methods * type##_console_methods
+
+#define INITIALIZE_CONSOLE_TYPE(type, obj_name, pred_sym) do { \
+ 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); \
+ 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); \
+} 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)
+
+struct console
+{
+ struct lcrecord_header header;
+
+ /* Description of this console's methods. */
+ struct console_methods *conmeths;
+
+ /* A structure of auxiliary data specific to the console type.
+ struct x_console is used for X window frames; defined in console-x.h
+ struct tty_console is used to TTY's; defined in console-tty.h */
+ void *console_data;
+
+ /* Character that causes a quit. Normally C-g.
+ #### Should be possible for this not to be ASCII. */
+ int quit_char;
+
+ /* ----- begin partially-completed console localization of
+ event loop ---- */
+
+ int local_var_flags;
+
+#define MARKED_SLOT(x) Lisp_Object x
+#include "conslots.h"
+#undef MARKED_SLOT
+
+ /* Where to store the next keystroke of the macro.
+ Index into con->kbd_macro_builder. */
+ int kbd_macro_ptr;
+
+ /* The finalized section of the macro starts at kbd_macro_buffer and
+ ends before this. This is not the same as kbd_macro_pointer, because
+ we advance this to kbd_macro_pointer when a key's command is complete.
+ This way, the keystrokes for "end-kbd-macro" are not included in the
+ macro. */
+ int kbd_macro_end;
+
+ /* ----- end partially-completed console localization of event loop ---- */
+
+ unsigned int input_enabled :1;
+};
+
+DECLARE_LRECORD (console, struct console);
+#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)
+
+#define CHECK_LIVE_CONSOLE(x) do { \
+ CHECK_CONSOLE (x); \
+ if (! CONSOLE_LIVE_P (XCONSOLE (x))) \
+ dead_wrong_type_argument (Qconsole_live_p, (x)); \
+} while (0)
+#define CONCHECK_LIVE_CONSOLE(x) do { \
+ CONCHECK_CONSOLE (x); \
+ if (! CONSOLE_LIVE_P (XCONSOLE (x))) \
+ x = wrong_type_argument (Qconsole_live_p, (x)); \
+} while (0)
+
+#define CONSOLE_TYPE_P(con, type) EQ (CONSOLE_TYPE (con), Q##type)
+
+#ifdef ERROR_CHECK_TYPECHECK
+INLINE struct console *
+error_check_console_type (struct console *con, Lisp_Object sym);
+INLINE struct console *
+error_check_console_type (struct console *con, Lisp_Object sym)
+{
+ assert (EQ (CONSOLE_TYPE (con), sym));
+ return con;
+}
+# define CONSOLE_TYPE_DATA(con, type) \
+ (*(struct type##_console **) \
+ &(error_check_console_type (con, Q##type))->console_data)
+#else
+# define CONSOLE_TYPE_DATA(con, type) \
+ (*(struct type##_console **) &((con)->console_data))
+#endif
+
+#define CHECK_CONSOLE_TYPE(x, type) do { \
+ CHECK_CONSOLE (x); \
+ if (! CONSOLE_TYPE_P (XCONSOLE (x), type)) \
+ dead_wrong_type_argument \
+ (type##_console_methods->predicate_symbol, x); \
+} while (0)
+#define CONCHECK_CONSOLE_TYPE(x, type) do { \
+ CONCHECK_CONSOLE (x); \
+ if (!(CONSOLEP (x) && \
+ CONSOLE_TYPE_P (XCONSOLE (x), type))) \
+ x = wrong_type_argument \
+ (type##_console_methods->predicate_symbol, x); \
+} while (0)
+
+/* #### These should be in the console-*.h files but there are
+ too many places where the abstraction is broken. Need to
+ fix. */
+
+#ifdef HAVE_X_WINDOWS
+#define CONSOLE_TYPESYM_X_P(typesym) EQ (typesym, Qx)
+#else
+#define CONSOLE_TYPESYM_X_P(typesym) 0
+#endif
+#ifdef HAVE_TTY
+#define CONSOLE_TYPESYM_TTY_P(typesym) EQ (typesym, Qtty)
+#else
+#define CONSOLE_TYPESYM_TTY_P(typesym) 0
+#endif
+#ifdef HAVE_MS_WINDOWS
+#define CONSOLE_TYPESYM_MSWINDOWS_P(typesym) EQ (typesym, Qmswindows)
+#else
+#define CONSOLE_TYPESYM_MSWINDOWS_P(typesym) 0
+#endif
+#define CONSOLE_TYPESYM_STREAM_P(typesym) EQ (typesym, Qstream)
+
+#define CONSOLE_TYPESYM_WIN_P(typesym) \
+ (CONSOLE_TYPESYM_X_P (typesym) || CONSOLE_TYPESYM_MSWINDOWS_P (typesym))
+
+#define CONSOLE_X_P(con) CONSOLE_TYPESYM_X_P (CONSOLE_TYPE (con))
+#define CHECK_X_CONSOLE(z) CHECK_CONSOLE_TYPE (z, x)
+#define CONCHECK_X_CONSOLE(z) CONCHECK_CONSOLE_TYPE (z, x)
+
+#define CONSOLE_TTY_P(con) CONSOLE_TYPESYM_TTY_P (CONSOLE_TYPE (con))
+#define CHECK_TTY_CONSOLE(z) CHECK_CONSOLE_TYPE (z, tty)
+#define CONCHECK_TTY_CONSOLE(z) CONCHECK_CONSOLE_TYPE (z, tty)
+
+#define CONSOLE_MSWINDOWS_P(con) CONSOLE_TYPESYM_MSWINDOWS_P (CONSOLE_TYPE (con))
+#define CHECK_MSWINDOWS_CONSOLE(z) CHECK_CONSOLE_TYPE (z, mswindows)
+#define CONCHECK_MSWINDOWS_CONSOLE(z) CONCHECK_CONSOLE_TYPE (z, mswindows)
+
+#define CONSOLE_STREAM_P(con) CONSOLE_TYPESYM_STREAM_P (CONSOLE_TYPE (con))
+#define CHECK_STREAM_CONSOLE(z) CHECK_CONSOLE_TYPE (z, stream)
+#define CONCHECK_STREAM_CONSOLE(z) CONCHECK_CONSOLE_TYPE (z, stream)
+
+#define CONSOLE_WIN_P(con) CONSOLE_TYPESYM_WIN_P (CONSOLE_TYPE (con))
+
+EXFUN (Fconsole_disable_input, 1);
+EXFUN (Fdelete_console, 2);
+EXFUN (Fselect_console, 1);
+EXFUN (Fselected_console, 0);
+
+extern Lisp_Object Qcreate_console_hook, Qdelete_console_hook;
+extern Lisp_Object Vconsole_defaults, Vconsole_type_list, Vselected_console;
+
+/* This structure marks which slots in a console have corresponding
+ default values in console_defaults.
+ Each such slot has a nonzero value in this structure.
+ The value has only one nonzero bit.
+
+ When a console has its own local value for a slot,
+ the bit for that slot (found in the same slot in this structure)
+ is turned on in the console's local_var_flags slot.
+
+ If a slot in this structure is zero, then even though there may
+ be a DEFVAR_CONSOLE_LOCAL for the slot, there is no default value for it;
+ and the corresponding slot in console_defaults is not used. */
+
+extern struct console console_local_flags;
+
+int valid_console_type_p (Lisp_Object type);
+
+#define CONSOLE_LIVE_P(con) (!EQ (CONSOLE_TYPE (con), Qdead))
+
+#define CONSOLE_NAME(con) ((con)->name)
+#define CONSOLE_CONNECTION(con) ((con)->connection)
+#define CONSOLE_CANON_CONNECTION(con) ((con)->canon_connection)
+#define CONSOLE_FUNCTION_KEY_MAP(con) ((con)->function_key_map)
+#define CONSOLE_DEVICE_LIST(con) ((con)->device_list)
+#define CONSOLE_SELECTED_DEVICE(con) ((con)->selected_device)
+#define CONSOLE_SELECTED_FRAME(con) \
+ DEVICE_SELECTED_FRAME (XDEVICE ((con)->selected_device))
+#define CONSOLE_LAST_NONMINIBUF_FRAME(con) NON_LVALUE ((con)->_last_nonminibuf_frame)
+#define CONSOLE_QUIT_CHAR(con) ((con)->quit_char)
+
+#define CDFW_CONSOLE(obj) \
+ (WINDOWP (obj) ? WINDOW_CONSOLE (XWINDOW (obj)) \
+ : (FRAMEP (obj) ? FRAME_CONSOLE (XFRAME (obj)) \
+ : (DEVICEP (obj) ? DEVICE_CONSOLE (XDEVICE (obj)) \
+ : (CONSOLEP (obj) ? obj \
+ : Qnil))))
+
+#define CONSOLE_LOOP(concons) LIST_LOOP (concons, Vconsole_list)
+#define CONSOLE_DEVICE_LOOP(devcons, con) \
+ LIST_LOOP (devcons, CONSOLE_DEVICE_LIST (con))
+
+DECLARE_CONSOLE_TYPE (dead);
+extern console_type_entry_dynarr *the_console_type_entry_dynarr;
+
+Lisp_Object create_console (Lisp_Object name, Lisp_Object type,
+ Lisp_Object connection, Lisp_Object props);
+void select_console_1 (Lisp_Object);
+struct console *decode_console (Lisp_Object);
+Lisp_Object make_console (struct console *c);
+void add_entry_to_console_type_list (Lisp_Object symbol,
+ struct console_methods *type);
+struct console_methods *decode_console_type (Lisp_Object type,
+ Error_behavior errb);
+void delete_console_internal (struct console *con, int force,
+ int from_kill_emacs, int from_io_error);
+void io_error_delete_console (Lisp_Object console);
+void set_console_last_nonminibuf_frame (struct console *con,
+ Lisp_Object frame);
+
+#endif /* _XEMACS_CONSOLE_H_ */
--- /dev/null
+/* Primitive operations on Lisp data types for XEmacs Lisp interpreter.
+ Copyright (C) 1985, 1986, 1988, 1992, 1993, 1994, 1995
+ 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: Mule 2.0, FSF 19.30. Some of FSF's data.c is in
+ XEmacs' symbols.c. */
+
+/* This file has been Mule-ized. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "bytecode.h"
+#include "syssignal.h"
+
+#ifdef LISP_FLOAT_TYPE
+/* Need to define a differentiating symbol -- see sysfloat.h */
+# define THIS_FILENAME data_c
+# include "sysfloat.h"
+#endif /* LISP_FLOAT_TYPE */
+
+Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
+Lisp_Object Qerror_conditions, Qerror_message;
+Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range;
+Lisp_Object Qvoid_variable, Qcyclic_variable_indirection;
+Lisp_Object Qvoid_function, Qcyclic_function_indirection;
+Lisp_Object Qsetting_constant, Qinvalid_read_syntax;
+Lisp_Object Qmalformed_list, Qmalformed_property_list;
+Lisp_Object Qcircular_list, Qcircular_property_list;
+Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
+Lisp_Object Qio_error, Qend_of_file;
+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 Qlistp, Qtrue_list_p, Qweak_listp;
+Lisp_Object Qconsp, Qsubrp, Qcompiled_functionp;
+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;
+
+#ifdef LISP_FLOAT_TYPE
+Lisp_Object Qfloatp;
+#endif
+
+#ifdef DEBUG_XEMACS
+
+int debug_issue_ebola_notices;
+
+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 (((CHARP (obj1) && INTP (obj2)) || (CHARP (obj2) && INTP (obj1)))
+ && (debug_issue_ebola_notices >= 2
+ || XCHAR_OR_INT (obj1) == XCHAR_OR_INT (obj2)))
+ {
+ stderr_out("Comparison between integer and character is constant nil (");
+ Fprinc (obj1, Qexternal_debugging_output);
+ stderr_out (" and ");
+ Fprinc (obj2, Qexternal_debugging_output);
+ stderr_out (")\n");
+ debug_short_backtrace (debug_ebola_backtrace_length);
+ }
+ return EQ (obj1, obj2);
+}
+
+#endif /* DEBUG_XEMACS */
+
+
+\f
+Lisp_Object
+wrong_type_argument (Lisp_Object predicate, Lisp_Object value)
+{
+ /* This function can GC */
+ REGISTER Lisp_Object tem;
+ do
+ {
+ value = Fsignal (Qwrong_type_argument, list2 (predicate, value));
+ tem = call1 (predicate, value);
+ }
+ while (NILP (tem));
+ return value;
+}
+
+DOESNT_RETURN
+dead_wrong_type_argument (Lisp_Object predicate, Lisp_Object value)
+{
+ signal_error (Qwrong_type_argument, list2 (predicate, value));
+}
+
+DEFUN ("wrong-type-argument", Fwrong_type_argument, 2, 2, 0, /*
+Signal an error until the correct type value is given by the user.
+This function loops, signalling a continuable `wrong-type-argument' error
+with PREDICATE and VALUE as the data associated with the error and then
+calling PREDICATE on the returned value, until the value gotten satisfies
+PREDICATE. At that point, the gotten value is returned.
+*/
+ (predicate, value))
+{
+ return wrong_type_argument (predicate, value);
+}
+
+DOESNT_RETURN
+pure_write_error (Lisp_Object obj)
+{
+ signal_simple_error ("Attempt to modify read-only object", obj);
+}
+
+DOESNT_RETURN
+args_out_of_range (Lisp_Object a1, Lisp_Object a2)
+{
+ signal_error (Qargs_out_of_range, list2 (a1, a2));
+}
+
+DOESNT_RETURN
+args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3)
+{
+ signal_error (Qargs_out_of_range, list3 (a1, a2, a3));
+}
+
+void
+check_int_range (int val, int min, int max)
+{
+ if (val < min || val > max)
+ args_out_of_range_3 (make_int (val), make_int (min), make_int (max));
+}
+
+/* On some machines, XINT needs a temporary location.
+ Here it is, in case it is needed. */
+
+EMACS_INT sign_extend_temp;
+
+/* 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
+sign_extend_lisp_int (EMACS_INT num)
+{
+ if (num & (1L << (VALBITS - 1)))
+ return num | ((-1L) << VALBITS);
+ else
+ return num & ((1L << VALBITS) - 1);
+}
+
+\f
+/* Data type predicates */
+
+DEFUN ("eq", Feq, 2, 2, 0, /*
+Return t if the two args are the same Lisp object.
+*/
+ (obj1, obj2))
+{
+ return EQ_WITH_EBOLA_NOTICE (obj1, obj2) ? Qt : Qnil;
+}
+
+DEFUN ("old-eq", Fold_eq, 2, 2, 0, /*
+Return t if the two args are (in most cases) the same Lisp object.
+
+Special kludge: A character is considered `old-eq' to its equivalent integer
+even though they are not the same object and are in fact of different
+types. This is ABSOLUTELY AND UTTERLY HORRENDOUS but is necessary to
+preserve byte-code compatibility with v19. This kludge is known as the
+\"char-int confoundance disease\" and appears in a number of other
+functions with `old-foo' equivalents.
+
+Do not use this function!
+*/
+ (obj1, obj2))
+{
+ /* #### blasphemy */
+ return HACKEQ_UNSAFE (obj1, obj2) ? Qt : Qnil;
+}
+
+DEFUN ("null", Fnull, 1, 1, 0, /*
+Return t if OBJECT is nil.
+*/
+ (object))
+{
+ return NILP (object) ? Qt : Qnil;
+}
+
+DEFUN ("consp", Fconsp, 1, 1, 0, /*
+Return t if OBJECT is a cons cell.
+*/
+ (object))
+{
+ return CONSP (object) ? Qt : Qnil;
+}
+
+DEFUN ("atom", Fatom, 1, 1, 0, /*
+Return t if OBJECT is not a cons cell. Atoms include nil.
+*/
+ (object))
+{
+ return CONSP (object) ? Qnil : Qt;
+}
+
+DEFUN ("listp", Flistp, 1, 1, 0, /*
+Return t if OBJECT is a list. Lists includes nil.
+*/
+ (object))
+{
+ return LISTP (object) ? Qt : Qnil;
+}
+
+DEFUN ("nlistp", Fnlistp, 1, 1, 0, /*
+Return t if OBJECT is not a list. Lists include nil.
+*/
+ (object))
+{
+ return LISTP (object) ? Qnil : Qt;
+}
+
+DEFUN ("true-list-p", Ftrue_list_p, 1, 1, 0, /*
+Return t if OBJECT is a non-dotted, i.e. nil-terminated, list.
+*/
+ (object))
+{
+ return TRUE_LIST_P (object) ? Qt : Qnil;
+}
+\f
+DEFUN ("symbolp", Fsymbolp, 1, 1, 0, /*
+Return t if OBJECT is a symbol.
+*/
+ (object))
+{
+ return SYMBOLP (object) ? Qt : Qnil;
+}
+
+DEFUN ("keywordp", Fkeywordp, 1, 1, 0, /*
+Return t if OBJECT is a keyword.
+*/
+ (object))
+{
+ return KEYWORDP (object) ? Qt : Qnil;
+}
+
+DEFUN ("vectorp", Fvectorp, 1, 1, 0, /*
+REturn t if OBJECT is a vector.
+*/
+ (object))
+{
+ return VECTORP (object) ? Qt : Qnil;
+}
+
+DEFUN ("bit-vector-p", Fbit_vector_p, 1, 1, 0, /*
+Return t if OBJECT is a bit vector.
+*/
+ (object))
+{
+ return BIT_VECTORP (object) ? Qt : Qnil;
+}
+
+DEFUN ("stringp", Fstringp, 1, 1, 0, /*
+Return t if OBJECT is a string.
+*/
+ (object))
+{
+ return STRINGP (object) ? Qt : Qnil;
+}
+
+DEFUN ("arrayp", Farrayp, 1, 1, 0, /*
+Return t if OBJECT is an array (string, vector, or bit vector).
+*/
+ (object))
+{
+ return (VECTORP (object) ||
+ STRINGP (object) ||
+ BIT_VECTORP (object))
+ ? Qt : Qnil;
+}
+
+DEFUN ("sequencep", Fsequencep, 1, 1, 0, /*
+Return t if OBJECT is a sequence (list or array).
+*/
+ (object))
+{
+ return (CONSP (object) ||
+ NILP (object) ||
+ VECTORP (object) ||
+ STRINGP (object) ||
+ BIT_VECTORP (object))
+ ? Qt : Qnil;
+}
+
+DEFUN ("markerp", Fmarkerp, 1, 1, 0, /*
+Return t if OBJECT is a marker (editor pointer).
+*/
+ (object))
+{
+ return MARKERP (object) ? Qt : Qnil;
+}
+
+DEFUN ("subrp", Fsubrp, 1, 1, 0, /*
+Return t if OBJECT is a built-in function.
+*/
+ (object))
+{
+ return SUBRP (object) ? Qt : Qnil;
+}
+
+DEFUN ("subr-min-args", Fsubr_min_args, 1, 1, 0, /*
+Return minimum number of args built-in function SUBR may be called with.
+*/
+ (subr))
+{
+ CHECK_SUBR (subr);
+ return make_int (XSUBR (subr)->min_args);
+}
+
+DEFUN ("subr-max-args", Fsubr_max_args, 1, 1, 0, /*
+Return maximum number of args built-in function SUBR may be called with,
+or nil if it takes an arbitrary number of arguments or is a special form.
+*/
+ (subr))
+{
+ int nargs;
+ CHECK_SUBR (subr);
+ nargs = XSUBR (subr)->max_args;
+ if (nargs == MANY || nargs == UNEVALLED)
+ return Qnil;
+ else
+ return make_int (nargs);
+}
+
+DEFUN ("subr-interactive", Fsubr_interactive, 1, 1, 0, /*
+Return the interactive spec of the subr object, or nil.
+If non-nil, the return value will be a list whose first element is
+`interactive' and whose second element is the interactive spec.
+*/
+ (subr))
+{
+ CONST char *prompt;
+ CHECK_SUBR (subr);
+ prompt = XSUBR (subr)->prompt;
+ return prompt ? list2 (Qinteractive, build_string (prompt)) : Qnil;
+}
+
+DEFUN ("compiled-function-p", Fcompiled_function_p, 1, 1, 0, /*
+Return t if OBJECT is a byte-compiled function object.
+*/
+ (object))
+{
+ return COMPILED_FUNCTIONP (object) ? Qt : Qnil;
+}
+
+\f
+DEFUN ("characterp", Fcharacterp, 1, 1, 0, /*
+Return t if OBJECT is a character.
+Unlike in XEmacs v19 and FSF Emacs, a character is its own primitive type.
+Any character can be converted into an equivalent integer using
+`char-int'. To convert the other way, use `int-char'; however,
+only some integers can be converted into characters. Such an integer
+is called a `char-int'; see `char-int-p'.
+
+Some functions that work on integers (e.g. the comparison functions
+<, <=, =, /=, etc. and the arithmetic functions +, -, *, etc.)
+accept characters and implicitly convert them into integers. In
+general, functions that work on characters also accept char-ints and
+implicitly convert them into characters. WARNING: Neither of these
+behaviors is very desirable, and they are maintained for backward
+compatibility with old E-Lisp programs that confounded characters and
+integers willy-nilly. These behaviors may change in the future; therefore,
+do not rely on them. Instead, use the character-specific functions such
+as `char='.
+*/
+ (object))
+{
+ return CHARP (object) ? Qt : Qnil;
+}
+
+DEFUN ("char-to-int", Fchar_to_int, 1, 1, 0, /*
+Convert a character into an equivalent integer.
+The resulting integer will always be non-negative. The integers in
+the range 0 - 255 map to characters as follows:
+
+0 - 31 Control set 0
+32 - 127 ASCII
+128 - 159 Control set 1
+160 - 255 Right half of ISO-8859-1
+
+If support for Mule does not exist, these are the only valid character
+values. When 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.
+*/
+ (ch))
+{
+ CHECK_CHAR (ch);
+ return make_int (XCHAR (ch));
+}
+
+DEFUN ("int-to-char", Fint_to_char, 1, 1, 0, /*
+Convert an integer into the equivalent character.
+Not all integers correspond to valid characters; use `char-int-p' to
+determine whether this is the case. If the integer cannot be converted,
+nil is returned.
+*/
+ (integer))
+{
+ CHECK_INT (integer);
+ if (CHAR_INTP (integer))
+ return make_char (XINT (integer));
+ else
+ return Qnil;
+}
+
+DEFUN ("char-int-p", Fchar_int_p, 1, 1, 0, /*
+Return t if OBJECT is an integer that can be converted into a character.
+See `char-int'.
+*/
+ (object))
+{
+ return CHAR_INTP (object) ? Qt : Qnil;
+}
+
+DEFUN ("char-or-char-int-p", Fchar_or_char_int_p, 1, 1, 0, /*
+Return t if OBJECT is a character or an integer that can be converted into one.
+*/
+ (object))
+{
+ return CHAR_OR_CHAR_INTP (object) ? Qt : Qnil;
+}
+
+DEFUN ("char-or-string-p", Fchar_or_string_p, 1, 1, 0, /*
+Return t if OBJECT is a character (or a char-int) or a string.
+It is semi-hateful that we allow a char-int here, as it goes against
+the name of this function, but it makes the most sense considering the
+other steps we take to maintain compatibility with the old character/integer
+confoundedness in older versions of E-Lisp.
+*/
+ (object))
+{
+ return CHAR_OR_CHAR_INTP (object) || STRINGP (object) ? Qt : Qnil;
+}
+\f
+DEFUN ("integerp", Fintegerp, 1, 1, 0, /*
+Return t if OBJECT is an integer.
+*/
+ (object))
+{
+ return INTP (object) ? Qt : Qnil;
+}
+
+DEFUN ("integer-or-marker-p", Finteger_or_marker_p, 1, 1, 0, /*
+Return t if OBJECT is an integer or a marker (editor pointer).
+*/
+ (object))
+{
+ return INTP (object) || MARKERP (object) ? Qt : Qnil;
+}
+
+DEFUN ("integer-or-char-p", Finteger_or_char_p, 1, 1, 0, /*
+Return t if OBJECT is an integer or a character.
+*/
+ (object))
+{
+ return INTP (object) || CHARP (object) ? Qt : Qnil;
+}
+
+DEFUN ("integer-char-or-marker-p", Finteger_char_or_marker_p, 1, 1, 0, /*
+Return t if OBJECT is an integer, character or a marker (editor pointer).
+*/
+ (object))
+{
+ return INTP (object) || CHARP (object) || MARKERP (object) ? Qt : Qnil;
+}
+
+DEFUN ("natnump", Fnatnump, 1, 1, 0, /*
+Return t if OBJECT is a nonnegative integer.
+*/
+ (object))
+{
+ return NATNUMP (object) ? Qt : Qnil;
+}
+
+DEFUN ("bitp", Fbitp, 1, 1, 0, /*
+Return t if OBJECT is a bit (0 or 1).
+*/
+ (object))
+{
+ return BITP (object) ? Qt : Qnil;
+}
+
+DEFUN ("numberp", Fnumberp, 1, 1, 0, /*
+Return t if OBJECT is a number (floating point or integer).
+*/
+ (object))
+{
+ return INT_OR_FLOATP (object) ? Qt : Qnil;
+}
+
+DEFUN ("number-or-marker-p", Fnumber_or_marker_p, 1, 1, 0, /*
+Return t if OBJECT is a number or a marker.
+*/
+ (object))
+{
+ return INT_OR_FLOATP (object) || MARKERP (object) ? Qt : Qnil;
+}
+
+DEFUN ("number-char-or-marker-p", Fnumber_char_or_marker_p, 1, 1, 0, /*
+Return t if OBJECT is a number, character or a marker.
+*/
+ (object))
+{
+ return (INT_OR_FLOATP (object) ||
+ CHARP (object) ||
+ MARKERP (object))
+ ? Qt : Qnil;
+}
+
+#ifdef LISP_FLOAT_TYPE
+DEFUN ("floatp", Ffloatp, 1, 1, 0, /*
+Return t if OBJECT is a floating point number.
+*/
+ (object))
+{
+ return FLOATP (object) ? Qt : Qnil;
+}
+#endif /* LISP_FLOAT_TYPE */
+
+DEFUN ("type-of", Ftype_of, 1, 1, 0, /*
+Return a symbol representing the type of OBJECT.
+*/
+ (object))
+{
+ if (CONSP (object)) return Qcons;
+ if (SYMBOLP (object)) return Qsymbol;
+ if (KEYWORDP (object)) return Qkeyword;
+ if (INTP (object)) return Qinteger;
+ if (CHARP (object)) return Qcharacter;
+ if (STRINGP (object)) return Qstring;
+ if (VECTORP (object)) return Qvector;
+
+ assert (LRECORDP (object));
+ return intern (XRECORD_LHEADER_IMPLEMENTATION (object)->name);
+}
+
+\f
+/* Extract and set components of lists */
+
+DEFUN ("car", Fcar, 1, 1, 0, /*
+Return the car of LIST. If arg is nil, return nil.
+Error if arg is not nil and not a cons cell. See also `car-safe'.
+*/
+ (list))
+{
+ while (1)
+ {
+ if (CONSP (list))
+ return XCAR (list);
+ else if (NILP (list))
+ return Qnil;
+ else
+ list = wrong_type_argument (Qlistp, list);
+ }
+}
+
+DEFUN ("car-safe", Fcar_safe, 1, 1, 0, /*
+Return the car of OBJECT if it is a cons cell, or else nil.
+*/
+ (object))
+{
+ return CONSP (object) ? XCAR (object) : Qnil;
+}
+
+DEFUN ("cdr", Fcdr, 1, 1, 0, /*
+Return the cdr of LIST. If arg is nil, return nil.
+Error if arg is not nil and not a cons cell. See also `cdr-safe'.
+*/
+ (list))
+{
+ while (1)
+ {
+ if (CONSP (list))
+ return XCDR (list);
+ else if (NILP (list))
+ return Qnil;
+ else
+ list = wrong_type_argument (Qlistp, list);
+ }
+}
+
+DEFUN ("cdr-safe", Fcdr_safe, 1, 1, 0, /*
+Return the cdr of OBJECT if it is a cons cell, else nil.
+*/
+ (object))
+{
+ return CONSP (object) ? XCDR (object) : Qnil;
+}
+
+DEFUN ("setcar", Fsetcar, 2, 2, 0, /*
+Set the car of CONSCELL to be NEWCAR. Return NEWCAR.
+*/
+ (conscell, newcar))
+{
+ if (!CONSP (conscell))
+ conscell = wrong_type_argument (Qconsp, conscell);
+
+ CHECK_IMPURE (conscell);
+ XCAR (conscell) = newcar;
+ return newcar;
+}
+
+DEFUN ("setcdr", Fsetcdr, 2, 2, 0, /*
+Set the cdr of CONSCELL to be NEWCDR. Return NEWCDR.
+*/
+ (conscell, newcdr))
+{
+ if (!CONSP (conscell))
+ conscell = wrong_type_argument (Qconsp, conscell);
+
+ CHECK_IMPURE (conscell);
+ XCDR (conscell) = newcdr;
+ return newcdr;
+}
+\f
+/* Find the function at the end of a chain of symbol function indirections. */
+
+/* If OBJECT is a symbol, find the end of its function chain and
+ return the value found there. If OBJECT is not a symbol, just
+ return it. If there is a cycle in the function chain, signal a
+ cyclic-function-indirection error.
+
+ This is like Findirect_function, except that it doesn't signal an
+ error if the chain ends up unbound. */
+Lisp_Object
+indirect_function (Lisp_Object object, int errorp)
+{
+ Lisp_Object tortoise = object;
+ Lisp_Object hare = object;
+
+ for (;;)
+ {
+ if (!SYMBOLP (hare) || UNBOUNDP (hare))
+ break;
+ hare = XSYMBOL (hare)->function;
+ if (!SYMBOLP (hare) || UNBOUNDP (hare))
+ break;
+ hare = XSYMBOL (hare)->function;
+
+ tortoise = XSYMBOL (tortoise)->function;
+
+ if (EQ (hare, tortoise))
+ return Fsignal (Qcyclic_function_indirection, list1 (object));
+ }
+
+ if (UNBOUNDP (hare) && errorp)
+ return Fsignal (Qvoid_function, list1 (object));
+ return hare;
+}
+
+DEFUN ("indirect-function", Findirect_function, 1, 1, 0, /*
+Return the function at the end of OBJECT's function chain.
+If OBJECT is a symbol, follow all function indirections and return
+the final function binding.
+If OBJECT is not a symbol, just return it.
+Signal a void-function error if the final symbol is unbound.
+Signal a cyclic-function-indirection error if there is a loop in the
+function chain of symbols.
+*/
+ (object))
+{
+ return indirect_function (object, 1);
+}
+\f
+/* Extract and set vector and string elements */
+
+DEFUN ("aref", Faref, 2, 2, 0, /*
+Return the element of ARRAY at index INDEX.
+ARRAY may be a vector, bit vector, string, or byte-code object.
+IDX starts at 0.
+*/
+ (array, idx))
+{
+ int idxval;
+
+ retry:
+ CHECK_INT_COERCE_CHAR (idx); /* yuck! */
+ idxval = XINT (idx);
+ if (idxval < 0)
+ {
+ lose:
+ args_out_of_range (array, idx);
+ }
+ if (VECTORP (array))
+ {
+ if (idxval >= XVECTOR_LENGTH (array)) goto lose;
+ return XVECTOR_DATA (array)[idxval];
+ }
+ else if (BIT_VECTORP (array))
+ {
+ if (idxval >= bit_vector_length (XBIT_VECTOR (array))) goto lose;
+ return make_int (bit_vector_bit (XBIT_VECTOR (array), idxval));
+ }
+ else if (STRINGP (array))
+ {
+ if (idxval >= XSTRING_CHAR_LENGTH (array)) goto lose;
+ return make_char (string_char (XSTRING (array), idxval));
+ }
+#ifdef LOSING_BYTECODE
+ else if (COMPILED_FUNCTIONP (array))
+ {
+ /* Weird, gross compatibility kludge */
+ return Felt (array, idx);
+ }
+#endif
+ else
+ {
+ check_losing_bytecode ("aref", array);
+ array = wrong_type_argument (Qarrayp, array);
+ goto retry;
+ }
+}
+
+DEFUN ("aset", Faset, 3, 3, 0, /*
+Store into the element of ARRAY at index IDX the value NEWVAL.
+ARRAY may be a vector, bit vector, or string. IDX starts at 0.
+*/
+ (array, idx, newval))
+{
+ int idxval;
+
+ CHECK_INT_COERCE_CHAR (idx); /* yuck! */
+ if (!VECTORP (array) && !BIT_VECTORP (array) && !STRINGP (array))
+ array = wrong_type_argument (Qarrayp, array);
+
+ idxval = XINT (idx);
+ if (idxval < 0)
+ {
+ lose:
+ args_out_of_range (array, idx);
+ }
+ CHECK_IMPURE (array);
+
+ if (VECTORP (array))
+ {
+ if (idxval >= XVECTOR_LENGTH (array)) goto lose;
+ XVECTOR_DATA (array)[idxval] = newval;
+ }
+ else if (BIT_VECTORP (array))
+ {
+ if (idxval >= bit_vector_length (XBIT_VECTOR (array))) goto lose;
+ CHECK_BIT (newval);
+ set_bit_vector_bit (XBIT_VECTOR (array), idxval, !ZEROP (newval));
+ }
+ else /* string */
+ {
+ CHECK_CHAR_COERCE_INT (newval);
+ if (idxval >= XSTRING_CHAR_LENGTH (array)) goto lose;
+ set_string_char (XSTRING (array), idxval, XCHAR (newval));
+ bump_string_modiff (array);
+ }
+
+ return newval;
+}
+
+\f
+/**********************************************************************/
+/* Compiled-function objects */
+/**********************************************************************/
+
+/* The compiled_function->doc_and_interactive slot uses the minimal
+ number of conses, based on compiled_function->flags; it may take
+ any of the following forms:
+
+ doc
+ interactive
+ domain
+ (doc . interactive)
+ (doc . domain)
+ (interactive . domain)
+ (doc . (interactive . domain))
+ */
+
+/* Caller must check flags.interactivep first */
+Lisp_Object
+compiled_function_interactive (struct Lisp_Compiled_Function *b)
+{
+ assert (b->flags.interactivep);
+ if (b->flags.documentationp && b->flags.domainp)
+ return XCAR (XCDR (b->doc_and_interactive));
+ else if (b->flags.documentationp)
+ return XCDR (b->doc_and_interactive);
+ else if (b->flags.domainp)
+ return XCAR (b->doc_and_interactive);
+
+ /* if all else fails... */
+ return b->doc_and_interactive;
+}
+
+/* Caller need not check flags.documentationp first */
+Lisp_Object
+compiled_function_documentation (struct Lisp_Compiled_Function *b)
+{
+ if (! b->flags.documentationp)
+ return Qnil;
+ else if (b->flags.interactivep && b->flags.domainp)
+ return XCAR (b->doc_and_interactive);
+ else if (b->flags.interactivep)
+ return XCAR (b->doc_and_interactive);
+ else if (b->flags.domainp)
+ return XCAR (b->doc_and_interactive);
+ else
+ return b->doc_and_interactive;
+}
+
+/* Caller need not check flags.domainp first */
+Lisp_Object
+compiled_function_domain (struct Lisp_Compiled_Function *b)
+{
+ if (! b->flags.domainp)
+ return Qnil;
+ else if (b->flags.documentationp && b->flags.interactivep)
+ return XCDR (XCDR (b->doc_and_interactive));
+ else if (b->flags.documentationp)
+ return XCDR (b->doc_and_interactive);
+ else if (b->flags.interactivep)
+ return XCDR (b->doc_and_interactive);
+ else
+ return b->doc_and_interactive;
+}
+
+#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+
+Lisp_Object
+compiled_function_annotation (struct Lisp_Compiled_Function *b)
+{
+ return b->annotated;
+}
+
+#endif
+
+/* used only by Snarf-documentation; there must be doc already. */
+void
+set_compiled_function_documentation (struct Lisp_Compiled_Function *b,
+ Lisp_Object new)
+{
+ assert (b->flags.documentationp);
+ assert (INTP (new) || STRINGP (new));
+
+ if (b->flags.interactivep && b->flags.domainp)
+ XCAR (b->doc_and_interactive) = new;
+ else if (b->flags.interactivep)
+ XCAR (b->doc_and_interactive) = new;
+ else if (b->flags.domainp)
+ XCAR (b->doc_and_interactive) = new;
+ else
+ b->doc_and_interactive = new;
+}
+
+DEFUN ("compiled-function-instructions", Fcompiled_function_instructions, 1, 1, 0, /*
+Return the byte-opcode string of the compiled-function object.
+*/
+ (function))
+{
+ CHECK_COMPILED_FUNCTION (function);
+ return XCOMPILED_FUNCTION (function)->bytecodes;
+}
+
+DEFUN ("compiled-function-constants", Fcompiled_function_constants, 1, 1, 0, /*
+Return the constants vector of the compiled-function object.
+*/
+ (function))
+{
+ CHECK_COMPILED_FUNCTION (function);
+ return XCOMPILED_FUNCTION (function)->constants;
+}
+
+DEFUN ("compiled-function-stack-depth", Fcompiled_function_stack_depth, 1, 1, 0, /*
+Return the max stack depth of the compiled-function object.
+*/
+ (function))
+{
+ CHECK_COMPILED_FUNCTION (function);
+ return make_int (XCOMPILED_FUNCTION (function)->maxdepth);
+}
+
+DEFUN ("compiled-function-arglist", Fcompiled_function_arglist, 1, 1, 0, /*
+Return the argument list of the compiled-function object.
+*/
+ (function))
+{
+ CHECK_COMPILED_FUNCTION (function);
+ return XCOMPILED_FUNCTION (function)->arglist;
+}
+
+DEFUN ("compiled-function-interactive", Fcompiled_function_interactive, 1, 1, 0, /*
+Return the interactive spec of the compiled-function object, or nil.
+If non-nil, the return value will be a list whose first element is
+`interactive' and whose second element is the interactive spec.
+*/
+ (function))
+{
+ CHECK_COMPILED_FUNCTION (function);
+ return XCOMPILED_FUNCTION (function)->flags.interactivep
+ ? list2 (Qinteractive,
+ compiled_function_interactive (XCOMPILED_FUNCTION (function)))
+ : Qnil;
+}
+
+DEFUN ("compiled-function-doc-string", Fcompiled_function_doc_string, 1, 1, 0, /*
+Return the doc string of the compiled-function object, if available.
+Functions that had their doc strings snarfed into the DOC file will have
+an integer returned instead of a string.
+*/
+ (function))
+{
+ CHECK_COMPILED_FUNCTION (function);
+ return compiled_function_documentation (XCOMPILED_FUNCTION (function));
+}
+
+#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+
+/* Remove the `xx' if you wish to restore this feature */
+xxDEFUN ("compiled-function-annotation", Fcompiled_function_annotation, 1, 1, 0, /*
+Return the annotation of the compiled-function object, or nil.
+The annotation is a piece of information indicating where this
+compiled-function object came from. Generally this will be
+a symbol naming a function; or a string naming a file, if the
+compiled-function object was not defined in a function; or nil,
+if the compiled-function object was not created as a result of
+a `load'.
+*/
+ (function))
+{
+ CHECK_COMPILED_FUNCTION (function);
+ return compiled_function_annotation (XCOMPILED_FUNCTION (function));
+}
+
+#endif /* COMPILED_FUNCTION_ANNOTATION_HACK */
+
+DEFUN ("compiled-function-domain", Fcompiled_function_domain, 1, 1, 0, /*
+Return the domain of the compiled-function object, or nil.
+This is only meaningful if I18N3 was enabled when emacs was compiled.
+*/
+ (function))
+{
+ CHECK_COMPILED_FUNCTION (function);
+ return XCOMPILED_FUNCTION (function)->flags.domainp
+ ? compiled_function_domain (XCOMPILED_FUNCTION (function))
+ : Qnil;
+}
+
+\f
+/**********************************************************************/
+/* Arithmetic functions */
+/**********************************************************************/
+
+Lisp_Object
+arithcompare (Lisp_Object num1, Lisp_Object num2,
+ enum arith_comparison comparison)
+{
+ CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (num1);
+ CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (num2);
+
+#ifdef LISP_FLOAT_TYPE
+ if (FLOATP (num1) || FLOATP (num2))
+ {
+ double f1 = FLOATP (num1) ? float_data (XFLOAT (num1)) : XINT (num1);
+ double f2 = FLOATP (num2) ? float_data (XFLOAT (num2)) : XINT (num2);
+
+ switch (comparison)
+ {
+ case arith_equal: return f1 == f2 ? Qt : Qnil;
+ case arith_notequal: return f1 != f2 ? Qt : Qnil;
+ case arith_less: return f1 < f2 ? Qt : Qnil;
+ case arith_less_or_equal: return f1 <= f2 ? Qt : Qnil;
+ case arith_grtr: return f1 > f2 ? Qt : Qnil;
+ case arith_grtr_or_equal: return f1 >= f2 ? Qt : Qnil;
+ }
+ }
+#endif /* LISP_FLOAT_TYPE */
+
+ switch (comparison)
+ {
+ case arith_equal: return XINT (num1) == XINT (num2) ? Qt : Qnil;
+ case arith_notequal: return XINT (num1) != XINT (num2) ? Qt : Qnil;
+ case arith_less: return XINT (num1) < XINT (num2) ? Qt : Qnil;
+ case arith_less_or_equal: return XINT (num1) <= XINT (num2) ? Qt : Qnil;
+ case arith_grtr: return XINT (num1) > XINT (num2) ? Qt : Qnil;
+ case arith_grtr_or_equal: return XINT (num1) >= XINT (num2) ? Qt : Qnil;
+ }
+
+ abort ();
+ return Qnil; /* suppress compiler warning */
+}
+
+static Lisp_Object
+arithcompare_many (enum arith_comparison comparison,
+ int nargs, Lisp_Object *args)
+{
+ for (; --nargs > 0; args++)
+ if (NILP (arithcompare (*args, *(args + 1), comparison)))
+ return Qnil;
+
+ return Qt;
+}
+
+DEFUN ("=", Feqlsign, 1, MANY, 0, /*
+Return t if all the arguments are numerically equal.
+The arguments may be numbers, characters or markers.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ return arithcompare_many (arith_equal, nargs, args);
+}
+
+DEFUN ("<", Flss, 1, MANY, 0, /*
+Return t if the sequence of arguments is monotonically increasing.
+The arguments may be numbers, characters or markers.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ return arithcompare_many (arith_less, nargs, args);
+}
+
+DEFUN (">", Fgtr, 1, MANY, 0, /*
+Return t if the sequence of arguments is monotonically decreasing.
+The arguments may be numbers, characters or markers.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ return arithcompare_many (arith_grtr, nargs, args);
+}
+
+DEFUN ("<=", Fleq, 1, MANY, 0, /*
+Return t if the sequence of arguments is monotonically nondecreasing.
+The arguments may be numbers, characters or markers.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ return arithcompare_many (arith_less_or_equal, nargs, args);
+}
+
+DEFUN (">=", Fgeq, 1, MANY, 0, /*
+Return t if the sequence of arguments is monotonically nonincreasing.
+The arguments may be numbers, characters or markers.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ return arithcompare_many (arith_grtr_or_equal, nargs, args);
+}
+
+DEFUN ("/=", Fneq, 1, MANY, 0, /*
+Return t if no two arguments are numerically equal.
+The arguments may be numbers, characters or markers.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ return arithcompare_many (arith_notequal, nargs, args);
+}
+
+DEFUN ("zerop", Fzerop, 1, 1, 0, /*
+Return t if NUMBER is zero.
+*/
+ (number))
+{
+ CHECK_INT_OR_FLOAT (number);
+
+#ifdef LISP_FLOAT_TYPE
+ if (FLOATP (number))
+ return float_data (XFLOAT (number)) == 0.0 ? Qt : Qnil;
+#endif /* LISP_FLOAT_TYPE */
+
+ return EQ (number, Qzero) ? Qt : Qnil;
+}
+\f
+/* Convert between a 32-bit value and a cons of two 16-bit values.
+ This is used to pass 32-bit integers to and from the user.
+ Use time_to_lisp() and lisp_to_time() for time values.
+
+ If you're thinking of using this to store a pointer into a Lisp Object
+ for internal purposes (such as when calling record_unwind_protect()),
+ try using make_opaque_ptr()/get_opaque_ptr() instead. */
+Lisp_Object
+word_to_lisp (unsigned int item)
+{
+ return Fcons (make_int (item >> 16), make_int (item & 0xffff));
+}
+
+unsigned int
+lisp_to_word (Lisp_Object item)
+{
+ if (INTP (item))
+ return XINT (item);
+ else
+ {
+ Lisp_Object top = Fcar (item);
+ Lisp_Object bot = Fcdr (item);
+ CHECK_INT (top);
+ CHECK_INT (bot);
+ return (XINT (top) << 16) | (XINT (bot) & 0xffff);
+ }
+}
+
+\f
+DEFUN ("number-to-string", Fnumber_to_string, 1, 1, 0, /*
+Convert NUM to a string by printing it in decimal.
+Uses a minus sign if negative.
+NUM may be an integer or a floating point number.
+*/
+ (num))
+{
+ char buffer[VALBITS];
+
+ CHECK_INT_OR_FLOAT (num);
+
+#ifdef LISP_FLOAT_TYPE
+ if (FLOATP (num))
+ {
+ char pigbuf[350]; /* see comments in float_to_string */
+
+ float_to_string (pigbuf, float_data (XFLOAT (num)));
+ return build_string (pigbuf);
+ }
+#endif /* LISP_FLOAT_TYPE */
+
+ long_to_string (buffer, XINT (num));
+ return build_string (buffer);
+}
+
+static int
+digit_to_number (int character, int base)
+{
+ /* Assumes ASCII */
+ int digit = ((character >= '0' && character <= '9') ? character - '0' :
+ (character >= 'a' && character <= 'z') ? character - 'a' + 10 :
+ (character >= 'A' && character <= 'Z') ? character - 'A' + 10 :
+ -1);
+
+ return digit >= base ? -1 : digit;
+}
+
+DEFUN ("string-to-number", Fstring_to_number, 1, 2, 0, /*
+Convert STRING to a number by parsing it as a decimal number.
+This parses both integers and floating point numbers.
+It ignores leading spaces and tabs.
+
+If BASE, interpret STRING as a number in that base. If BASE isn't
+present, base 10 is used. BASE must be between 2 and 16 (inclusive).
+Floating point numbers always use base 10.
+*/
+ (string, base))
+{
+ char *p;
+ int b;
+
+ CHECK_STRING (string);
+
+ if (NILP (base))
+ b = 10;
+ else
+ {
+ CHECK_INT (base);
+ b = XINT (base);
+ check_int_range (b, 2, 16);
+ }
+
+ p = (char *) XSTRING_DATA (string);
+
+ /* Skip any whitespace at the front of the number. Some versions of
+ atoi do this anyway, so we might as well make Emacs lisp consistent. */
+ while (*p == ' ' || *p == '\t')
+ p++;
+
+#ifdef LISP_FLOAT_TYPE
+ if (isfloat_string (p))
+ return make_float (atof (p));
+#endif /* LISP_FLOAT_TYPE */
+
+ if (b == 10)
+ {
+ /* Use the system-provided functions for base 10. */
+#if SIZEOF_EMACS_INT == SIZEOF_INT
+ return make_int (atoi (p));
+#elif SIZEOF_EMACS_INT == SIZEOF_LONG
+ return make_int (atol (p));
+#elif SIZEOF_EMACS_INT == SIZEOF_LONG_LONG
+ return make_int (atoll (p));
+#endif
+ }
+ else
+ {
+ int digit, negative = 1;
+ EMACS_INT v = 0;
+
+ if (*p == '-')
+ {
+ negative = -1;
+ p++;
+ }
+ else if (*p == '+')
+ p++;
+ while (1)
+ {
+ digit = digit_to_number (*p++, b);
+ if (digit < 0)
+ break;
+ v = v * b + digit;
+ }
+ return make_int (negative * v);
+ }
+}
+\f
+enum arithop
+ { Aadd, Asub, Amult, Adiv, Alogand, Alogior, Alogxor, Amax, Amin };
+
+
+#ifdef LISP_FLOAT_TYPE
+static Lisp_Object
+float_arith_driver (double accum, int argnum, enum arithop code, int nargs,
+ Lisp_Object *args)
+{
+ REGISTER Lisp_Object val;
+ double next;
+
+ for (; argnum < nargs; argnum++)
+ {
+ /* using args[argnum] as argument to CHECK_INT_OR_FLOAT_... */
+ val = args[argnum];
+ CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (val);
+
+ if (FLOATP (val))
+ {
+ next = float_data (XFLOAT (val));
+ }
+ else
+ {
+ args[argnum] = val; /* runs into a compiler bug. */
+ next = XINT (args[argnum]);
+ }
+ switch (code)
+ {
+ case Aadd:
+ accum += next;
+ break;
+ case Asub:
+ if (!argnum && nargs != 1)
+ next = - next;
+ accum -= next;
+ break;
+ case Amult:
+ accum *= next;
+ break;
+ case Adiv:
+ if (!argnum)
+ accum = next;
+ else
+ {
+ if (next == 0)
+ Fsignal (Qarith_error, Qnil);
+ accum /= next;
+ }
+ break;
+ case Alogand:
+ case Alogior:
+ case Alogxor:
+ return wrong_type_argument (Qinteger_char_or_marker_p, val);
+ case Amax:
+ if (!argnum || isnan (next) || next > accum)
+ accum = next;
+ break;
+ case Amin:
+ if (!argnum || isnan (next) || next < accum)
+ accum = next;
+ break;
+ }
+ }
+
+ return make_float (accum);
+}
+#endif /* LISP_FLOAT_TYPE */
+
+static Lisp_Object
+arith_driver (enum arithop code, int nargs, Lisp_Object *args)
+{
+ Lisp_Object val;
+ REGISTER int argnum;
+ REGISTER EMACS_INT accum = 0;
+ REGISTER EMACS_INT next;
+
+ switch (code)
+ {
+ case Alogior:
+ case Alogxor:
+ case Aadd:
+ case Asub:
+ accum = 0; break;
+ case Amult:
+ accum = 1; break;
+ case Alogand:
+ accum = -1; break;
+ case Adiv:
+ case Amax:
+ case Amin:
+ accum = 0; break;
+ default:
+ abort ();
+ }
+
+ for (argnum = 0; argnum < nargs; argnum++)
+ {
+ /* using args[argnum] as argument to CHECK_INT_OR_FLOAT_... */
+ val = args[argnum];
+ CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (val);
+
+#ifdef LISP_FLOAT_TYPE
+ if (FLOATP (val)) /* time to do serious math */
+ return float_arith_driver ((double) accum, argnum, code,
+ nargs, args);
+#endif /* LISP_FLOAT_TYPE */
+ args[argnum] = val; /* runs into a compiler bug. */
+ next = XINT (args[argnum]);
+ switch (code)
+ {
+ case Aadd: accum += next; break;
+ case Asub:
+ if (!argnum && nargs != 1)
+ next = - next;
+ accum -= next;
+ break;
+ case Amult: accum *= next; break;
+ case Adiv:
+ if (!argnum) accum = next;
+ else
+ {
+ if (next == 0)
+ Fsignal (Qarith_error, Qnil);
+ accum /= next;
+ }
+ break;
+ case Alogand: accum &= next; break;
+ case Alogior: accum |= next; break;
+ case Alogxor: accum ^= next; break;
+ case Amax: if (!argnum || next > accum) accum = next; break;
+ case Amin: if (!argnum || next < accum) accum = next; break;
+ }
+ }
+
+ XSETINT (val, accum);
+ return val;
+}
+
+DEFUN ("+", Fplus, 0, MANY, 0, /*
+Return sum of any number of arguments.
+The arguments should all be numbers, characters or markers.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ return arith_driver (Aadd, nargs, args);
+}
+
+DEFUN ("-", Fminus, 0, MANY, 0, /*
+Negate number or subtract numbers, characters or markers.
+With one arg, negates it. With more than one arg,
+subtracts all but the first from the first.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ return arith_driver (Asub, nargs, args);
+}
+
+DEFUN ("*", Ftimes, 0, MANY, 0, /*
+Return product of any number of arguments.
+The arguments should all be numbers, characters or markers.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ return arith_driver (Amult, nargs, args);
+}
+
+DEFUN ("/", Fquo, 2, MANY, 0, /*
+Return first argument divided by all the remaining arguments.
+The arguments must be numbers, characters or markers.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ return arith_driver (Adiv, nargs, args);
+}
+
+DEFUN ("%", Frem, 2, 2, 0, /*
+Return remainder of first arg divided by second.
+Both must be integers, characters or markers.
+*/
+ (num1, num2))
+{
+ CHECK_INT_COERCE_CHAR_OR_MARKER (num1);
+ CHECK_INT_COERCE_CHAR_OR_MARKER (num2);
+
+ if (ZEROP (num2))
+ Fsignal (Qarith_error, Qnil);
+
+ return make_int (XINT (num1) % XINT (num2));
+}
+
+/* Note, ANSI *requires* the presence of the fmod() library routine.
+ If your system doesn't have it, complain to your vendor, because
+ that is a bug. */
+
+#ifndef HAVE_FMOD
+double
+fmod (double f1, double f2)
+{
+ if (f2 < 0.0)
+ f2 = -f2;
+ return f1 - f2 * floor (f1/f2);
+}
+#endif /* ! HAVE_FMOD */
+
+
+DEFUN ("mod", Fmod, 2, 2, 0, /*
+Return X modulo Y.
+The result falls between zero (inclusive) and Y (exclusive).
+Both X and Y must be numbers, characters or markers.
+If either argument is a float, a float will be returned.
+*/
+ (x, y))
+{
+ EMACS_INT i1, i2;
+
+#ifdef LISP_FLOAT_TYPE
+ CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (x);
+ CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (y);
+
+ if (FLOATP (x) || FLOATP (y))
+ {
+ double f1, f2;
+
+ f1 = ((FLOATP (x)) ? float_data (XFLOAT (x)) : XINT (x));
+ f2 = ((FLOATP (y)) ? float_data (XFLOAT (y)) : XINT (y));
+ if (f2 == 0)
+ Fsignal (Qarith_error, Qnil);
+
+ f1 = fmod (f1, f2);
+
+ /* If the "remainder" comes out with the wrong sign, fix it. */
+ if (f2 < 0 ? f1 > 0 : f1 < 0)
+ f1 += f2;
+ return make_float (f1);
+ }
+#else /* not LISP_FLOAT_TYPE */
+ CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (x);
+ CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (y);
+#endif /* not LISP_FLOAT_TYPE */
+
+ i1 = XINT (x);
+ i2 = XINT (y);
+
+ if (i2 == 0)
+ Fsignal (Qarith_error, Qnil);
+
+ i1 %= i2;
+
+ /* If the "remainder" comes out with the wrong sign, fix it. */
+ if (i2 < 0 ? i1 > 0 : i1 < 0)
+ i1 += i2;
+
+ return make_int (i1);
+}
+
+
+DEFUN ("max", Fmax, 1, MANY, 0, /*
+Return largest of all the arguments.
+All arguments must be numbers, characters or markers.
+The value is always a number; markers and characters are converted
+to numbers.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ return arith_driver (Amax, nargs, args);
+}
+
+DEFUN ("min", Fmin, 1, MANY, 0, /*
+Return smallest of all the arguments.
+All arguments must be numbers, characters or markers.
+The value is always a number; markers and characters are converted
+to numbers.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ return arith_driver (Amin, nargs, args);
+}
+
+DEFUN ("logand", Flogand, 0, MANY, 0, /*
+Return bitwise-and of all the arguments.
+Arguments may be integers, or markers or characters converted to integers.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ return arith_driver (Alogand, nargs, args);
+}
+
+DEFUN ("logior", Flogior, 0, MANY, 0, /*
+Return bitwise-or of all the arguments.
+Arguments may be integers, or markers or characters converted to integers.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ return arith_driver (Alogior, nargs, args);
+}
+
+DEFUN ("logxor", Flogxor, 0, MANY, 0, /*
+Return bitwise-exclusive-or of all the arguments.
+Arguments may be integers, or markers or characters converted to integers.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ return arith_driver (Alogxor, nargs, args);
+}
+
+DEFUN ("ash", Fash, 2, 2, 0, /*
+Return VALUE with its bits shifted left by COUNT.
+If COUNT is negative, shifting is actually to the right.
+In this case, the sign bit is duplicated.
+*/
+ (value, count))
+{
+ CHECK_INT_COERCE_CHAR (value);
+ CHECK_INT (count);
+
+ return make_int (XINT (count) > 0 ?
+ XINT (value) << XINT (count) :
+ XINT (value) >> -XINT (count));
+}
+
+DEFUN ("lsh", Flsh, 2, 2, 0, /*
+Return VALUE with its bits shifted left by COUNT.
+If COUNT is negative, shifting is actually to the right.
+In this case, zeros are shifted in on the left.
+*/
+ (value, count))
+{
+ CHECK_INT_COERCE_CHAR (value);
+ CHECK_INT (count);
+
+ return make_int (XINT (count) > 0 ?
+ XUINT (value) << XINT (count) :
+ XUINT (value) >> -XINT (count));
+}
+
+DEFUN ("1+", Fadd1, 1, 1, 0, /*
+Return NUMBER plus one. NUMBER may be a number or a marker.
+Markers and characters are converted to integers.
+*/
+ (number))
+{
+ CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (number);
+
+#ifdef LISP_FLOAT_TYPE
+ if (FLOATP (number))
+ return make_float (1.0 + float_data (XFLOAT (number)));
+#endif /* LISP_FLOAT_TYPE */
+
+ return make_int (XINT (number) + 1);
+}
+
+DEFUN ("1-", Fsub1, 1, 1, 0, /*
+Return NUMBER minus one. NUMBER may be a number or a marker.
+Markers and characters are converted to integers.
+*/
+ (number))
+{
+ CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (number);
+
+#ifdef LISP_FLOAT_TYPE
+ if (FLOATP (number))
+ return make_float (-1.0 + (float_data (XFLOAT (number))));
+#endif /* LISP_FLOAT_TYPE */
+
+ return make_int (XINT (number) - 1);
+}
+
+DEFUN ("lognot", Flognot, 1, 1, 0, /*
+Return the bitwise complement of NUMBER. NUMBER must be an integer.
+*/
+ (number))
+{
+ CHECK_INT (number);
+ return make_int (~XINT (number));
+}
+
+\f
+/************************************************************************/
+/* weak lists */
+/************************************************************************/
+
+/* A weak list is like a normal list except that elements automatically
+ disappear when no longer in use, i.e. when no longer GC-protected.
+ The basic idea is that we don't mark the elements during GC, but
+ wait for them to be marked elsewhere. If they're not marked, we
+ remove them. This is analogous to weak hashtables; see the explanation
+ there for more info. */
+
+static Lisp_Object Vall_weak_lists; /* Gemarke es nicht!!! */
+
+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))
+{
+ return Qnil; /* nichts ist gemarkt */
+}
+
+static void
+print_weak_list (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+ if (print_readably)
+ error ("printing unreadable object #<weak-list>");
+
+ write_c_string ("#<weak-list ", printcharfun);
+ print_internal (encode_weak_list_type (XWEAK_LIST (obj)->type),
+ printcharfun, 0);
+ write_c_string (" ", printcharfun);
+ print_internal (XWEAK_LIST (obj)->list, printcharfun, escapeflag);
+ write_c_string (">", printcharfun);
+}
+
+static int
+weak_list_equal (Lisp_Object o1, Lisp_Object o2, int depth)
+{
+ struct weak_list *w1 = XWEAK_LIST (o1);
+ struct weak_list *w2 = XWEAK_LIST (o2);
+
+ return ((w1->type == w2->type) &&
+ internal_equal (w1->list, w2->list, depth + 1));
+}
+
+static unsigned long
+weak_list_hash (Lisp_Object obj, int depth)
+{
+ struct weak_list *w = XWEAK_LIST (obj);
+
+ return HASH2 ((unsigned long) w->type,
+ internal_hash (w->list, depth + 1));
+}
+
+Lisp_Object
+make_weak_list (enum weak_list_type type)
+{
+ Lisp_Object result;
+ struct weak_list *wl =
+ alloc_lcrecord_type (struct weak_list, lrecord_weak_list);
+
+ wl->list = Qnil;
+ wl->type = type;
+ XSETWEAK_LIST (result, wl);
+ wl->next_weak = Vall_weak_lists;
+ Vall_weak_lists = result;
+ return result;
+}
+
+DEFINE_LRECORD_IMPLEMENTATION ("weak-list", weak_list,
+ mark_weak_list, print_weak_list,
+ 0, weak_list_equal, weak_list_hash,
+ struct weak_list);
+/*
+ -- we do not mark the list elements (either the elements themselves
+ or the cons cells that hold them) in the normal marking phase.
+ -- at the end of marking, we go through all weak lists that are
+ marked, and mark the cons cells that hold all marked
+ objects, and possibly parts of the objects themselves.
+ (See alloc.c, "after-mark".)
+ -- after that, we prune away all the cons cells that are not marked.
+
+ WARNING WARNING WARNING WARNING WARNING:
+
+ The code in the following two functions is *unbelievably* tricky.
+ Don't mess with it. You'll be sorry.
+
+ Linked lists just majorly suck, d'ya know?
+*/
+
+int
+finish_marking_weak_lists (int (*obj_marked_p) (Lisp_Object),
+ void (*markobj) (Lisp_Object))
+{
+ Lisp_Object rest;
+ int did_mark = 0;
+
+ for (rest = Vall_weak_lists;
+ !GC_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)))
+ /* The weak list is probably garbage. Ignore it. */
+ continue;
+
+ for (rest2 = XWEAK_LIST (rest)->list;
+ /* 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);
+ rest2 = XCDR (rest2))
+ {
+ Lisp_Object elem;
+ /* If the element is "marked" (meaning depends on the type
+ of weak list), we need to mark the cons containing the
+ element, and maybe the element itself (if only some part
+ was already marked). */
+ int need_to_mark_cons = 0;
+ int need_to_mark_elem = 0;
+
+ /* If a cons is already marked, then its car is already marked
+ (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))
+ break;
+
+ elem = XCAR (rest2);
+
+ switch (type)
+ {
+ case WEAK_LIST_SIMPLE:
+ if ((*obj_marked_p) (elem))
+ need_to_mark_cons = 1;
+ break;
+
+ case WEAK_LIST_ASSOC:
+ if (!GC_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)))
+ {
+ need_to_mark_cons = 1;
+ /* We still need to mark elem, because it's
+ probably not marked. */
+ need_to_mark_elem = 1;
+ }
+ break;
+
+ case WEAK_LIST_KEY_ASSOC:
+ if (!GC_CONSP (elem))
+ {
+ /* just leave bogus elements there */
+ need_to_mark_cons = 1;
+ need_to_mark_elem = 1;
+ }
+ else if ((*obj_marked_p) (XCAR (elem)))
+ {
+ need_to_mark_cons = 1;
+ /* We still need to mark elem and XCDR (elem);
+ marking elem does both */
+ need_to_mark_elem = 1;
+ }
+ break;
+
+ case WEAK_LIST_VALUE_ASSOC:
+ if (!GC_CONSP (elem))
+ {
+ /* just leave bogus elements there */
+ need_to_mark_cons = 1;
+ need_to_mark_elem = 1;
+ }
+ else if ((*obj_marked_p) (XCDR (elem)))
+ {
+ need_to_mark_cons = 1;
+ /* We still need to mark elem and XCAR (elem);
+ marking elem does both */
+ need_to_mark_elem = 1;
+ }
+ break;
+
+ default:
+ abort ();
+ }
+
+ if (need_to_mark_elem && ! (*obj_marked_p) (elem))
+ {
+ (*markobj) (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
+ 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))
+ {
+ MARK_CONS (ptr);
+ did_mark = 1;
+ }
+ }
+ }
+
+ /* 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))
+ {
+ (markobj) (rest2);
+ did_mark = 1;
+ }
+ }
+
+ return did_mark;
+}
+
+void
+prune_weak_lists (int (*obj_marked_p) (Lisp_Object))
+{
+ Lisp_Object rest, prev = Qnil;
+
+ for (rest = Vall_weak_lists;
+ !GC_NILP (rest);
+ rest = XWEAK_LIST (rest)->next_weak)
+ {
+ if (! ((*obj_marked_p) (rest)))
+ {
+ /* This weak list itself is garbage. Remove it from the list. */
+ if (GC_NILP (prev))
+ Vall_weak_lists = XWEAK_LIST (rest)->next_weak;
+ else
+ XWEAK_LIST (prev)->next_weak =
+ XWEAK_LIST (rest)->next_weak;
+ }
+ else
+ {
+ Lisp_Object rest2, prev2 = Qnil;
+ Lisp_Object tortoise;
+ int go_tortoise = 0;
+
+ for (rest2 = XWEAK_LIST (rest)->list, tortoise = rest2;
+ /* 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);)
+ {
+ /* It suffices to check the cons for marking,
+ regardless of the type of weak list:
+
+ -- if the cons is pointed to somewhere else,
+ then it should stay around and will be marked.
+ -- otherwise, if it should stay around, it will
+ have been marked in finish_marking_weak_lists().
+ -- otherwise, it's not marked and should disappear.
+ */
+ if (!(*obj_marked_p) (rest2))
+ {
+ /* bye bye :-( */
+ if (GC_NILP (prev2))
+ XWEAK_LIST (rest)->list = XCDR (rest2);
+ else
+ XCDR (prev2) = XCDR (rest2);
+ rest2 = XCDR (rest2);
+ /* Ouch. Circularity checking is even trickier
+ than I thought. When we cut out a link
+ like this, we can't advance the turtle or
+ it'll catch up to us. Imagine that we're
+ standing on floor tiles and moving forward --
+ what we just did here is as if the floor
+ tile under us just disappeared and all the
+ ones ahead of us slid one tile towards us.
+ In other words, we didn't move at all;
+ if the tortoise was one step behind us
+ previously, it still is, and therefore
+ it must not move. */
+ }
+ else
+ {
+ prev2 = rest2;
+
+ /* Implementing circularity checking is trickier here
+ than in other places because we have to guarantee
+ that we've processed all elements before exiting
+ due to a circularity. (In most places, an error
+ is issued upon encountering a circularity, so it
+ doesn't really matter if all elements are processed.)
+ The idea is that we process along with the hare
+ rather than the tortoise. If at any point in
+ our forward process we encounter the tortoise,
+ we must have already visited the spot, so we exit.
+ (If we process with the tortoise, we can fail to
+ process cases where a cons points to itself, or
+ where cons A points to cons B, which points to
+ cons A.) */
+
+ rest2 = XCDR (rest2);
+ if (go_tortoise)
+ tortoise = XCDR (tortoise);
+ go_tortoise = !go_tortoise;
+ if (GC_EQ (rest2, tortoise))
+ break;
+ }
+ }
+
+ prev = rest;
+ }
+ }
+}
+
+static enum weak_list_type
+decode_weak_list_type (Lisp_Object symbol)
+{
+ CHECK_SYMBOL (symbol);
+ if (EQ (symbol, Qsimple)) return WEAK_LIST_SIMPLE;
+ if (EQ (symbol, Qassoc)) return WEAK_LIST_ASSOC;
+ if (EQ (symbol, Qold_assoc)) return WEAK_LIST_ASSOC; /* EBOLA ALERT! */
+ if (EQ (symbol, Qkey_assoc)) return WEAK_LIST_KEY_ASSOC;
+ if (EQ (symbol, Qvalue_assoc)) return WEAK_LIST_VALUE_ASSOC;
+
+ signal_simple_error ("Invalid weak list type", symbol);
+ return WEAK_LIST_SIMPLE; /* not reached */
+}
+
+static Lisp_Object
+encode_weak_list_type (enum weak_list_type type)
+{
+ switch (type)
+ {
+ case WEAK_LIST_SIMPLE: return Qsimple;
+ case WEAK_LIST_ASSOC: return Qassoc;
+ case WEAK_LIST_KEY_ASSOC: return Qkey_assoc;
+ case WEAK_LIST_VALUE_ASSOC: return Qvalue_assoc;
+ default:
+ abort ();
+ }
+
+ return Qnil; /* not reached */
+}
+
+DEFUN ("weak-list-p", Fweak_list_p, 1, 1, 0, /*
+Return non-nil if OBJECT is a weak list.
+*/
+ (object))
+{
+ return WEAK_LISTP (object) ? Qt : Qnil;
+}
+
+DEFUN ("make-weak-list", Fmake_weak_list, 0, 1, 0, /*
+Return a new weak list object of type TYPE.
+A weak list object is an object that contains a list. This list behaves
+like any other list except that its elements do not count towards
+garbage collection -- if the only pointer to an object in inside a weak
+list (other than pointers in similar objects such as weak hash tables),
+the object is garbage collected and automatically removed from the list.
+This is used internally, for example, to manage the list holding 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.
+
+Optional argument TYPE specifies the type of the weak list, and defaults
+to `simple'. Recognized types are
+
+`simple' Objects in the list disappear if not pointed to.
+`assoc' Objects in the list disappear if they are conses
+ and either the car or the cdr of the cons is not
+ pointed to.
+`key-assoc' Objects in the list disappear if they are conses
+ and the car is not pointed to.
+`value-assoc' Objects in the list disappear if they are conses
+ and the cdr is not pointed to.
+*/
+ (type))
+{
+ if (NILP (type))
+ type = Qsimple;
+
+ return make_weak_list (decode_weak_list_type (type));
+}
+
+DEFUN ("weak-list-type", Fweak_list_type, 1, 1, 0, /*
+Return the type of the given weak-list object.
+*/
+ (weak))
+{
+ CHECK_WEAK_LIST (weak);
+ return encode_weak_list_type (XWEAK_LIST (weak)->type);
+}
+
+DEFUN ("weak-list-list", Fweak_list_list, 1, 1, 0, /*
+Return the list contained in a weak-list object.
+*/
+ (weak))
+{
+ CHECK_WEAK_LIST (weak);
+ return XWEAK_LIST_LIST (weak);
+}
+
+DEFUN ("set-weak-list-list", Fset_weak_list_list, 2, 2, 0, /*
+Change the list contained in a weak-list object.
+*/
+ (weak, new_list))
+{
+ CHECK_WEAK_LIST (weak);
+ XWEAK_LIST_LIST (weak) = new_list;
+ return new_list;
+}
+
+\f
+/************************************************************************/
+/* initialization */
+/************************************************************************/
+
+static SIGTYPE
+arith_error (int signo)
+{
+ EMACS_REESTABLISH_SIGNAL (signo, arith_error);
+ EMACS_UNBLOCK_SIGNAL (signo);
+ signal_error (Qarith_error, Qnil);
+}
+
+void
+init_data_very_early (void)
+{
+ /* Don't do this if just dumping out.
+ We don't want to call `signal' in this case
+ so that we don't have trouble with dumping
+ signal-delivering routines in an inconsistent state. */
+#ifndef CANNOT_DUMP
+ if (!initialized)
+ return;
+#endif /* CANNOT_DUMP */
+ signal (SIGFPE, arith_error);
+#ifdef uts
+ signal (SIGEMT, arith_error);
+#endif /* uts */
+}
+
+void
+init_errors_once_early (void)
+{
+ defsymbol (&Qerror_conditions, "error-conditions");
+ defsymbol (&Qerror_message, "error-message");
+
+ /* We declare the errors here because some other deferrors depend
+ on some of the errors below. */
+
+ /* ERROR is used as a signaler for random errors for which nothing
+ else is right */
+
+ deferror (&Qerror, "error", "error", Qnil);
+ deferror (&Qquit, "quit", "Quit", Qnil);
+
+ deferror (&Qwrong_type_argument, "wrong-type-argument",
+ "Wrong type argument", Qerror);
+ deferror (&Qargs_out_of_range, "args-out-of-range", "Args out of range",
+ Qerror);
+ deferror (&Qvoid_function, "void-function",
+ "Symbol's function definition is void", Qerror);
+ deferror (&Qcyclic_function_indirection, "cyclic-function-indirection",
+ "Symbol's chain of function indirections contains a loop", Qerror);
+ deferror (&Qvoid_variable, "void-variable",
+ "Symbol's value as variable is void", Qerror);
+ deferror (&Qcyclic_variable_indirection, "cyclic-variable-indirection",
+ "Symbol's chain of variable indirections contains a loop", Qerror);
+ deferror (&Qsetting_constant, "setting-constant",
+ "Attempt to set a constant symbol", Qerror);
+ deferror (&Qinvalid_read_syntax, "invalid-read-syntax",
+ "Invalid read syntax", Qerror);
+ deferror (&Qmalformed_list, "malformed-list",
+ "Malformed list", Qerror);
+ deferror (&Qmalformed_property_list, "malformed-property-list",
+ "Malformed property list", Qerror);
+ deferror (&Qcircular_list, "circular-list",
+ "Circular list", Qerror);
+ deferror (&Qcircular_property_list, "circular-property-list",
+ "Circular property list", Qerror);
+ deferror (&Qinvalid_function, "invalid-function", "Invalid function",
+ Qerror);
+ deferror (&Qwrong_number_of_arguments, "wrong-number-of-arguments",
+ "Wrong number of arguments", Qerror);
+ deferror (&Qno_catch, "no-catch", "No catch for tag",
+ Qerror);
+ deferror (&Qbeginning_of_buffer, "beginning-of-buffer",
+ "Beginning of buffer", Qerror);
+ deferror (&Qend_of_buffer, "end-of-buffer", "End of buffer", Qerror);
+ deferror (&Qbuffer_read_only, "buffer-read-only", "Buffer is read-only",
+ Qerror);
+
+ deferror (&Qio_error, "io-error", "IO Error", Qerror);
+ deferror (&Qend_of_file, "end-of-file", "End of stream", Qio_error);
+
+ deferror (&Qarith_error, "arith-error", "Arithmetic error", Qerror);
+ deferror (&Qrange_error, "range-error", "Arithmetic range error",
+ Qarith_error);
+ deferror (&Qdomain_error, "domain-error", "Arithmetic domain error",
+ Qarith_error);
+ deferror (&Qsingularity_error, "singularity-error",
+ "Arithmetic singularity error", Qdomain_error);
+ deferror (&Qoverflow_error, "overflow-error",
+ "Arithmetic overflow error", Qdomain_error);
+ deferror (&Qunderflow_error, "underflow-error",
+ "Arithmetic underflow error", Qdomain_error);
+}
+
+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");
+ defsymbol (&Qstringp, "stringp");
+ defsymbol (&Qarrayp, "arrayp");
+ defsymbol (&Qsequencep, "sequencep");
+ defsymbol (&Qbufferp, "bufferp");
+ defsymbol (&Qbitp, "bitp");
+ defsymbol (&Qbit_vectorp, "bit-vector-p");
+ defsymbol (&Qvectorp, "vectorp");
+ defsymbol (&Qcompiled_functionp, "compiled-function-p");
+ defsymbol (&Qchar_or_string_p, "char-or-string-p");
+ defsymbol (&Qmarkerp, "markerp");
+ defsymbol (&Qinteger_or_marker_p, "integer-or-marker-p");
+ 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");
+
+#ifdef LISP_FLOAT_TYPE
+ defsymbol (&Qfloatp, "floatp");
+#endif /* LISP_FLOAT_TYPE */
+
+ DEFSUBR (Fwrong_type_argument);
+
+ DEFSUBR (Feq);
+ DEFSUBR (Fold_eq);
+ DEFSUBR (Fnull);
+ DEFSUBR (Flistp);
+ DEFSUBR (Fnlistp);
+ DEFSUBR (Ftrue_list_p);
+ DEFSUBR (Fconsp);
+ DEFSUBR (Fatom);
+ DEFSUBR (Fchar_or_string_p);
+ DEFSUBR (Fcharacterp);
+ DEFSUBR (Fchar_int_p);
+ DEFSUBR (Fchar_to_int);
+ DEFSUBR (Fint_to_char);
+ DEFSUBR (Fchar_or_char_int_p);
+ DEFSUBR (Fintegerp);
+ DEFSUBR (Finteger_or_marker_p);
+ DEFSUBR (Finteger_or_char_p);
+ DEFSUBR (Finteger_char_or_marker_p);
+ DEFSUBR (Fnumberp);
+ DEFSUBR (Fnumber_or_marker_p);
+ DEFSUBR (Fnumber_char_or_marker_p);
+#ifdef LISP_FLOAT_TYPE
+ DEFSUBR (Ffloatp);
+#endif /* LISP_FLOAT_TYPE */
+ DEFSUBR (Fnatnump);
+ DEFSUBR (Fsymbolp);
+ DEFSUBR (Fkeywordp);
+ DEFSUBR (Fstringp);
+ DEFSUBR (Fvectorp);
+ DEFSUBR (Fbitp);
+ DEFSUBR (Fbit_vector_p);
+ DEFSUBR (Farrayp);
+ DEFSUBR (Fsequencep);
+ DEFSUBR (Fmarkerp);
+ DEFSUBR (Fsubrp);
+ DEFSUBR (Fsubr_min_args);
+ DEFSUBR (Fsubr_max_args);
+ DEFSUBR (Fsubr_interactive);
+ DEFSUBR (Fcompiled_function_p);
+ DEFSUBR (Ftype_of);
+ DEFSUBR (Fcar);
+ DEFSUBR (Fcdr);
+ DEFSUBR (Fcar_safe);
+ DEFSUBR (Fcdr_safe);
+ DEFSUBR (Fsetcar);
+ DEFSUBR (Fsetcdr);
+ DEFSUBR (Findirect_function);
+ DEFSUBR (Faref);
+ DEFSUBR (Faset);
+
+ DEFSUBR (Fcompiled_function_instructions);
+ DEFSUBR (Fcompiled_function_constants);
+ DEFSUBR (Fcompiled_function_stack_depth);
+ DEFSUBR (Fcompiled_function_arglist);
+ DEFSUBR (Fcompiled_function_interactive);
+ DEFSUBR (Fcompiled_function_doc_string);
+ DEFSUBR (Fcompiled_function_domain);
+#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+ DEFSUBR (Fcompiled_function_annotation);
+#endif
+
+ DEFSUBR (Fnumber_to_string);
+ DEFSUBR (Fstring_to_number);
+ DEFSUBR (Feqlsign);
+ DEFSUBR (Flss);
+ DEFSUBR (Fgtr);
+ DEFSUBR (Fleq);
+ DEFSUBR (Fgeq);
+ DEFSUBR (Fneq);
+ DEFSUBR (Fzerop);
+ DEFSUBR (Fplus);
+ DEFSUBR (Fminus);
+ DEFSUBR (Ftimes);
+ DEFSUBR (Fquo);
+ DEFSUBR (Frem);
+ DEFSUBR (Fmod);
+ DEFSUBR (Fmax);
+ DEFSUBR (Fmin);
+ DEFSUBR (Flogand);
+ DEFSUBR (Flogior);
+ DEFSUBR (Flogxor);
+ DEFSUBR (Flsh);
+ DEFSUBR (Fash);
+ DEFSUBR (Fadd1);
+ DEFSUBR (Fsub1);
+ DEFSUBR (Flognot);
+
+ DEFSUBR (Fweak_list_p);
+ DEFSUBR (Fmake_weak_list);
+ DEFSUBR (Fweak_list_type);
+ DEFSUBR (Fweak_list_list);
+ DEFSUBR (Fset_weak_list_list);
+}
+
+void
+vars_of_data (void)
+{
+ /* This must not be staticpro'd */
+ Vall_weak_lists = Qnil;
+
+#ifdef DEBUG_XEMACS
+ DEFVAR_INT ("debug-issue-ebola-notices", &debug_issue_ebola_notices /*
+If non-nil, 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 a int and a char with the same value are being compared,
+it will issue a notice on stderr to this effect, along with a backtrace.
+In such situations, the result would be different in XEmacs 19 versus
+XEmacs 20, and you probably don't want this.
+
+Note that in order to see these notices, you have to byte compile your
+code under XEmacs 20 -- any code byte-compiled under XEmacs 19 will
+have its chars and ints all confounded in the byte code, making it
+impossible to accurately determine Ebola infection.
+*/ );
+
+ debug_issue_ebola_notices = 2; /* #### temporary hack */
+
+ DEFVAR_INT ("debug-ebola-backtrace-length",
+ &debug_ebola_backtrace_length /*
+Length (in stack frames) of short backtrace printed out in Ebola notices.
+See `debug-issue-ebola-notices'.
+*/ );
+ debug_ebola_backtrace_length = 32;
+
+#endif /* DEBUG_XEMACS */
+}
--- /dev/null
+/* Database access routines
+ Copyright (C) 1996, William M. Perry
+
+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 Bill Perry */
+/* Substantially rewritten by Martin Buchholz */
+/* db 2.x support added by Andreas Jaeger */
+
+#include <config.h>
+#include "lisp.h"
+#include "sysfile.h"
+#include <errno.h>
+
+#ifndef HAVE_DATABASE
+#error HAVE_DATABASE not defined!!
+#endif
+
+#include "database.h" /* Our include file */
+
+#ifdef HAVE_BERKELEY_DB
+/* Work around Berkeley DB's use of int types which are defined
+ slightly differently in the not quite yet standard <inttypes.h>.
+ See db.h for details of why we're resorting to this... */
+/* glibc 2.1 doesn't have this problem with DB 2.x */
+#if !(defined __GLIBC__ && __GLIBC_MINOR__ >= 1)
+#ifdef HAVE_INTTYPES_H
+#define __BIT_TYPES_DEFINED__
+#include <inttypes.h>
+typedef uint8_t u_int8_t;
+typedef uint16_t u_int16_t;
+typedef uint32_t u_int32_t;
+#ifdef WE_DONT_NEED_QUADS
+typedef uint64_t u_int64_t;
+#endif /* WE_DONT_NEED_QUADS */
+#endif /* HAVE_INTTYPES_H */
+#endif /* !(defined __GLIBC__ && __GLIBC_MINOR__ >= 1) */
+#include DB_H_PATH /* Berkeley db's header file */
+#ifndef DB_VERSION_MAJOR
+# define DB_VERSION_MAJOR 1
+#endif /* DB_VERSION_MAJOR */
+Lisp_Object Qberkeley_db;
+Lisp_Object Qhash, Qbtree, Qrecno, Qunknown;
+#endif /* HAVE_BERKELEY_DB */
+
+#ifdef HAVE_DBM
+#include <ndbm.h>
+Lisp_Object Qdbm;
+#endif /* HAVE_DBM */
+
+Lisp_Object Qdatabasep;
+
+typedef enum { DB_DBM, DB_BERKELEY, DB_IS_UNKNOWN } XEMACS_DB_TYPE;
+
+struct Lisp_Database;
+
+typedef struct
+{
+ Lisp_Object (*get_subtype) (struct Lisp_Database *);
+ Lisp_Object (*get_type) (struct Lisp_Database *);
+ Lisp_Object (*get) (struct Lisp_Database *, Lisp_Object);
+ int (*put) (struct Lisp_Database *, Lisp_Object, Lisp_Object, Lisp_Object);
+ int (*rem) (struct Lisp_Database *, Lisp_Object);
+ void (*map) (struct Lisp_Database *, Lisp_Object);
+ void (*close) (struct Lisp_Database *);
+ Lisp_Object (*last_error) (struct Lisp_Database *);
+} DB_FUNCS;
+
+struct Lisp_Database
+{
+ struct lcrecord_header header;
+ Lisp_Object fname;
+ XEMACS_DB_TYPE type;
+ int mode;
+ int access_;
+ int dberrno;
+ int live_p;
+#ifdef HAVE_DBM
+ DBM *dbm_handle;
+#endif
+#ifdef HAVE_BERKELEY_DB
+ DB *db_handle;
+#endif
+ DB_FUNCS *funcs;
+#ifdef MULE
+ Lisp_Object coding_system;
+#endif
+};
+
+#define XDATABASE(x) XRECORD (x, database, struct 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)
+
+#define CHECK_LIVE_DATABASE(db) do { \
+ CHECK_DATABASE (db); \
+ if (!DATABASE_LIVE_P (XDATABASE(db))) \
+ signal_simple_error ("Attempting to access closed database", db); \
+} while (0)
+
+
+static struct Lisp_Database *
+allocate_database (void)
+{
+ struct Lisp_Database *db =
+ alloc_lcrecord_type (struct Lisp_Database, lrecord_database);
+
+ db->fname = Qnil;
+ db->live_p = 0;
+#ifdef HAVE_BERKELEY_DB
+ db->db_handle = NULL;
+#endif
+#ifdef HAVE_DBM
+ db->dbm_handle = NULL;
+#endif
+ db->access_ = 0;
+ db->mode = 0;
+ db->dberrno = 0;
+ db->type = DB_IS_UNKNOWN;
+#ifdef MULE
+ db->coding_system = Fget_coding_system (Qbinary);
+#endif
+ return db;
+}
+
+static Lisp_Object
+mark_database (Lisp_Object obj, void (*markobj) (Lisp_Object))
+{
+ struct Lisp_Database *db = XDATABASE (obj);
+
+ ((markobj) (db->fname));
+ return Qnil;
+}
+
+static void
+print_database (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+ char buf[64];
+ struct Lisp_Database *db = XDATABASE (obj);
+
+ if (print_readably)
+ error ("printing unreadable object #<database 0x%x>", db->header.uid);
+
+ write_c_string ("#<database \"", printcharfun);
+ print_internal (db->fname, printcharfun, 0);
+ sprintf (buf, "\" (%s/%s/%s) 0x%x>",
+ (char *) string_data (XSYMBOL (db->funcs->get_type (db))->name),
+ (char *) string_data (XSYMBOL (db->funcs->get_subtype (db))->name),
+ (!DATABASE_LIVE_P (db) ? "closed" :
+ (db->access_ & O_WRONLY) ? "writeonly" :
+ (db->access_ & O_RDWR) ? "readwrite" : "readonly"),
+ db->header.uid);
+ write_c_string (buf, printcharfun);
+}
+
+static void
+finalize_database (void *header, int for_disksave)
+{
+ struct Lisp_Database *db = (struct Lisp_Database *) header;
+
+ if (for_disksave)
+ {
+ Lisp_Object obj;
+ XSETOBJ (obj, Lisp_Type_Record, (void *) db);
+
+ signal_simple_error
+ ("Can't dump an emacs containing database objects", obj);
+ }
+ db->funcs->close (db);
+}
+
+DEFINE_LRECORD_IMPLEMENTATION ("database", database,
+ mark_database, print_database,
+ finalize_database, 0, 0,
+ struct Lisp_Database);
+
+DEFUN ("close-database", Fclose_database, 1, 1, 0, /*
+Close database DATABASE.
+*/
+ (database))
+{
+ struct Lisp_Database *db;
+ CHECK_LIVE_DATABASE (database);
+ db = XDATABASE (database);
+ db->funcs->close (db);
+ db->live_p = 0;
+ return Qnil;
+}
+
+DEFUN ("database-type", Fdatabase_type, 1, 1, 0, /*
+Return the type of database DATABASE.
+*/
+ (database))
+{
+ CHECK_DATABASE (database);
+
+ return XDATABASE (database)->funcs->get_type (XDATABASE (database));
+}
+
+DEFUN ("database-subtype", Fdatabase_subtype, 1, 1, 0, /*
+Return the subtype of database DATABASE, if any.
+*/
+ (database))
+{
+ CHECK_DATABASE (database);
+
+ return XDATABASE (database)->funcs->get_subtype (XDATABASE (database));
+}
+
+DEFUN ("database-live-p", Fdatabase_live_p, 1, 1, 0, /*
+Return t if OBJ is an active database.
+*/
+ (obj))
+{
+ return DATABASEP (obj) && DATABASE_LIVE_P (XDATABASE (obj)) ? Qt : Qnil;
+}
+
+DEFUN ("database-file-name", Fdatabase_file_name, 1, 1, 0, /*
+Return the filename associated with the database DATABASE.
+*/
+ (database))
+{
+ CHECK_DATABASE (database);
+
+ return XDATABASE (database)->fname;
+}
+
+DEFUN ("databasep", Fdatabasep, 1, 1, 0, /*
+Return t if OBJ is a database.
+*/
+ (obj))
+{
+ return DATABASEP (obj) ? Qt : Qnil;
+}
+
+#ifdef HAVE_DBM
+static void
+dbm_map (struct Lisp_Database *db, Lisp_Object func)
+{
+ datum keydatum, valdatum;
+ Lisp_Object key, val;
+
+ for (keydatum = dbm_firstkey (db->dbm_handle);
+ keydatum.dptr != NULL;
+ keydatum = dbm_nextkey (db->dbm_handle))
+ {
+ valdatum = dbm_fetch (db->dbm_handle, keydatum);
+ key = make_string ((unsigned char *) keydatum.dptr, keydatum.dsize);
+ val = make_string ((unsigned char *) valdatum.dptr, valdatum.dsize);
+ call2 (func, key, val);
+ }
+}
+
+static Lisp_Object
+dbm_get (struct Lisp_Database *db, Lisp_Object key)
+{
+ datum keydatum, valdatum;
+
+ keydatum.dptr = (char *) XSTRING_DATA (key);
+ keydatum.dsize = XSTRING_LENGTH (key);
+ valdatum = dbm_fetch (db->dbm_handle, keydatum);
+
+ return (valdatum.dptr
+ ? make_string ((unsigned char *) valdatum.dptr, valdatum.dsize)
+ : Qnil);
+}
+
+static int
+dbm_put (struct Lisp_Database *db,
+ Lisp_Object key, Lisp_Object val, Lisp_Object replace)
+{
+ datum keydatum, valdatum;
+
+ valdatum.dptr = (char *) XSTRING_DATA (val);
+ valdatum.dsize = XSTRING_LENGTH (val);
+ keydatum.dptr = (char *) XSTRING_DATA (key);
+ keydatum.dsize = XSTRING_LENGTH (key);
+
+ return !dbm_store (db->dbm_handle, keydatum, valdatum,
+ NILP (replace) ? DBM_INSERT : DBM_REPLACE);
+}
+
+static int
+dbm_remove (struct Lisp_Database *db, Lisp_Object key)
+{
+ datum keydatum;
+
+ keydatum.dptr = (char *) XSTRING_DATA (key);
+ keydatum.dsize = XSTRING_LENGTH (key);
+
+ return dbm_delete (db->dbm_handle, keydatum);
+}
+
+static Lisp_Object
+dbm_type (struct Lisp_Database *db)
+{
+ return Qdbm;
+}
+
+static Lisp_Object
+dbm_subtype (struct Lisp_Database *db)
+{
+ return Qnil;
+}
+
+static Lisp_Object
+dbm_lasterr (struct Lisp_Database *db)
+{
+ return lisp_strerror (db->dberrno);
+}
+
+static void
+dbm_closeit (struct Lisp_Database *db)
+{
+ if (db->dbm_handle)
+ {
+ dbm_close (db->dbm_handle);
+ db->dbm_handle = NULL;
+ }
+}
+
+static DB_FUNCS ndbm_func_block =
+{
+ dbm_subtype,
+ dbm_type,
+ dbm_get,
+ dbm_put,
+ dbm_remove,
+ dbm_map,
+ dbm_closeit,
+ dbm_lasterr
+};
+#endif /* HAVE_DBM */
+
+#ifdef HAVE_BERKELEY_DB
+static Lisp_Object
+berkdb_type (struct Lisp_Database *db)
+{
+ return Qberkeley_db;
+}
+
+static Lisp_Object
+berkdb_subtype (struct Lisp_Database *db)
+{
+ if (!db->db_handle)
+ return Qnil;
+
+ switch (db->db_handle->type)
+ {
+ case DB_BTREE: return Qbtree;
+ case DB_HASH: return Qhash;
+ case DB_RECNO: return Qrecno;
+ default: return Qunknown;
+ }
+}
+
+static Lisp_Object
+berkdb_lasterr (struct Lisp_Database *db)
+{
+ return lisp_strerror (db->dberrno);
+}
+
+static Lisp_Object
+berkdb_get (struct Lisp_Database *db, Lisp_Object key)
+{
+ /* #### Needs mule-izing */
+ DBT keydatum, valdatum;
+ int status = 0;
+
+#if DB_VERSION_MAJOR == 2
+ /* Always initialize keydatum, valdatum. */
+ xzero (keydatum);
+ xzero (valdatum);
+#endif /* DV_VERSION_MAJOR = 2 */
+
+ keydatum.data = XSTRING_DATA (key);
+ keydatum.size = XSTRING_LENGTH (key);
+
+#if DB_VERSION_MAJOR == 1
+ status = db->db_handle->get (db->db_handle, &keydatum, &valdatum, 0);
+#else
+ status = db->db_handle->get (db->db_handle, NULL, &keydatum, &valdatum, 0);
+#endif /* DB_VERSION_MAJOR */
+
+ if (!status)
+ return make_string ((Bufbyte *) valdatum.data, valdatum.size);
+
+#if DB_VERSION_MAJOR == 1
+ db->dberrno = (status == 1) ? -1 : errno;
+#else
+ db->dberrno = (status < 0) ? -1 : errno;
+#endif /* DB_VERSION_MAJOR */
+
+ return Qnil;
+}
+
+static int
+berkdb_put (struct Lisp_Database *db,
+ Lisp_Object key,
+ Lisp_Object val,
+ Lisp_Object replace)
+{
+ DBT keydatum, valdatum;
+ int status = 0;
+
+#if DB_VERSION_MAJOR == 2
+ /* Always initalize keydatum, valdatum. */
+ xzero (keydatum);
+ xzero (valdatum);
+#endif /* DV_VERSION_MAJOR = 2 */
+
+ keydatum.data = XSTRING_DATA (key);
+ keydatum.size = XSTRING_LENGTH (key);
+ valdatum.data = XSTRING_DATA (val);
+ valdatum.size = XSTRING_LENGTH (val);
+#if DB_VERSION_MAJOR == 1
+ status = db->db_handle->put (db->db_handle, &keydatum, &valdatum,
+ NILP (replace) ? R_NOOVERWRITE : 0);
+ db->dberrno = (status == 1) ? -1 : errno;
+#else
+ status = db->db_handle->put (db->db_handle, NULL, &keydatum, &valdatum,
+ NILP (replace) ? DB_NOOVERWRITE : 0);
+ db->dberrno = (status < 0) ? -1 : errno;
+#endif/* DV_VERSION_MAJOR = 2 */
+
+ return status;
+}
+
+static int
+berkdb_remove (struct Lisp_Database *db, Lisp_Object key)
+{
+ DBT keydatum;
+ int status;
+
+#if DB_VERSION_MAJOR == 2
+ /* Always initialize keydatum. */
+ xzero (keydatum);
+#endif /* DV_VERSION_MAJOR = 2 */
+
+ keydatum.data = XSTRING_DATA (key);
+ keydatum.size = XSTRING_LENGTH (key);
+
+#if DB_VERSION_MAJOR == 1
+ status = db->db_handle->del (db->db_handle, &keydatum, 0);
+#else
+ status = db->db_handle->del (db->db_handle, NULL, &keydatum, 0);
+#endif /* DB_VERSION_MAJOR */
+
+ if (!status)
+ return 0;
+
+#if DB_VERSION_MAJOR == 1
+ db->dberrno = (status == 1) ? -1 : errno;
+#else
+ db->dberrno = (status < 0) ? -1 : errno;
+#endif /* DB_VERSION_MAJOR */
+
+ return 1;
+}
+
+static void
+berkdb_map (struct Lisp_Database *db, Lisp_Object func)
+{
+ DBT keydatum, valdatum;
+ Lisp_Object key, val;
+ DB *dbp = db->db_handle;
+ int status;
+
+#if DB_VERSION_MAJOR == 1
+ for (status = dbp->seq (dbp, &keydatum, &valdatum, R_FIRST);
+ status == 0;
+ status = dbp->seq (dbp, &keydatum, &valdatum, R_NEXT))
+ {
+ /* ### Needs mule-izing */
+ key = make_string ((Bufbyte *) keydatum.data, keydatum.size);
+ val = make_string ((Bufbyte *) valdatum.data, valdatum.size);
+ call2 (func, key, val);
+ }
+#else
+ DBC *dbcp;
+ /* Initialize the key/data pair so the flags aren't set. */
+ xzero (keydatum);
+ xzero (valdatum);
+
+ status = dbp->cursor (dbp, NULL, &dbcp);
+ for (status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_FIRST);
+ status == 0;
+ status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_NEXT))
+ {
+ /* ### Needs mule-izing */
+ key = make_string ((Bufbyte *) keydatum.data, keydatum.size);
+ val = make_string ((Bufbyte *) valdatum.data, valdatum.size);
+ call2 (func, key, val);
+ }
+ dbcp->c_close (dbcp);
+#endif /* DB_VERSION_MAJOR */
+}
+
+static void
+berkdb_close (struct Lisp_Database *db)
+{
+ if (db->db_handle)
+ {
+#if DB_VERSION_MAJOR == 1
+ db->db_handle->sync (db->db_handle, 0);
+ db->db_handle->close (db->db_handle);
+#else
+ db->db_handle->sync (db->db_handle, 0);
+ db->db_handle->close (db->db_handle, 0);
+#endif /* DB_VERSION_MAJOR */
+ db->db_handle = NULL;
+ }
+}
+
+static DB_FUNCS berk_func_block =
+{
+ berkdb_subtype,
+ berkdb_type,
+ berkdb_get,
+ berkdb_put,
+ berkdb_remove,
+ berkdb_map,
+ berkdb_close,
+ berkdb_lasterr
+};
+#endif /* HAVE_BERKELEY_DB */
+
+DEFUN ("database-last-error", Fdatabase_last_error, 0, 1, 0, /*
+Return the last error associated with DATABASE.
+*/
+ (database))
+{
+ if (NILP (database))
+ return lisp_strerror (errno);
+
+ CHECK_DATABASE (database);
+
+ return XDATABASE (database)->funcs->last_error (XDATABASE (database));
+}
+
+DEFUN ("open-database", Fopen_database, 1, 5, 0, /*
+Return a new database object opened on FILE.
+Optional arguments TYPE and SUBTYPE specify the database type.
+Optional argument ACCESS specifies the access rights, which may be any
+combination of 'r' 'w' and '+', for read, write, and creation flags.
+Optional argument MODE gives the permissions to use when opening FILE,
+and defaults to 0755.
+*/
+ (file, type, subtype, access_, mode))
+{
+ /* This function can GC */
+ int modemask;
+ int accessmask = 0;
+ struct Lisp_Database *db = NULL;
+ char *filename;
+ struct gcpro gcpro1, gcpro2;
+
+ CHECK_STRING (file);
+ GCPRO2 (file, access_);
+ file = Fexpand_file_name (file, Qnil);
+ UNGCPRO;
+ filename = (char *) XSTRING_DATA (file);
+
+ if (NILP (access_))
+ {
+ accessmask = O_RDWR | O_CREAT;
+ }
+ else
+ {
+ char *acc;
+ CHECK_STRING (access_);
+ acc = (char *) XSTRING_DATA (access_);
+
+ if (strchr (acc, '+'))
+ accessmask |= O_CREAT;
+
+ {
+ char *rp = strchr (acc, 'r');
+ char *wp = strchr (acc, 'w');
+ if (rp && wp) accessmask |= O_RDWR;
+ else if (wp) accessmask |= O_WRONLY;
+ else accessmask |= O_RDONLY;
+ }
+ }
+
+ if (NILP (mode))
+ {
+ modemask = 0755; /* rwxr-xr-x */
+ }
+ else
+ {
+ CHECK_INT (mode);
+ modemask = XINT (mode);
+ }
+
+#ifdef HAVE_DBM
+ if (NILP (type) || EQ (type, Qdbm))
+ {
+ DBM *dbase = dbm_open (filename, accessmask, modemask);
+ if (!dbase)
+ return Qnil;
+
+ db = allocate_database ();
+ db->dbm_handle = dbase;
+ db->type = DB_DBM;
+ db->funcs = &ndbm_func_block;
+ goto db_done;
+ }
+#endif /* HAVE_DBM */
+
+#ifdef HAVE_BERKELEY_DB
+ if (NILP (type) || EQ (type, Qberkeley_db))
+ {
+ DBTYPE real_subtype;
+ DB *dbase;
+#if DB_VERSION_MAJOR != 1
+ int status;
+#endif
+
+ if (EQ (subtype, Qhash) || NILP (subtype))
+ real_subtype = DB_HASH;
+ else if (EQ (subtype, Qbtree))
+ real_subtype = DB_BTREE;
+ else if (EQ (subtype, Qrecno))
+ real_subtype = DB_RECNO;
+ else
+ signal_simple_error ("Unsupported subtype", subtype);
+
+#if DB_VERSION_MAJOR == 1
+ dbase = dbopen (filename, accessmask, modemask, real_subtype, NULL);
+ if (!dbase)
+ return Qnil;
+#else
+ /* Berkeley DB Version 2 has only the accessmask DB_CREATE and DB_RDONLY,
+ other flags shouldn't be set */
+ if (NILP (access_))
+ accessmask = DB_CREATE;
+ else
+ {
+ char *acc;
+ CHECK_STRING (access_);
+ acc = (char *) XSTRING_DATA (access_);
+ accessmask = 0;
+
+ if (strchr (acc, '+'))
+ accessmask |= DB_CREATE;
+
+ if (strchr (acc, 'r') && !strchr (acc, 'w'))
+ accessmask |= DB_RDONLY;
+ }
+ status = db_open (filename, real_subtype, accessmask,
+ modemask, NULL , NULL, &dbase);
+ if (status)
+ return Qnil;
+#endif /* DB_VERSION_MAJOR */
+
+ db = allocate_database ();
+ db->db_handle = dbase;
+ db->type = DB_BERKELEY;
+ db->funcs = &berk_func_block;
+ goto db_done;
+ }
+#endif /* HAVE_BERKELEY_DB */
+
+ signal_simple_error ("Unsupported database type", type);
+ return Qnil;
+
+ db_done:
+ db->live_p = 1;
+ db->fname = file;
+ db->mode = modemask;
+ db->access_ = accessmask;
+
+ {
+ Lisp_Object retval;
+ XSETDATABASE (retval, db);
+ return retval;
+ }
+}
+
+DEFUN ("put-database", Fput_database, 3, 4, 0, /*
+Store KEY and VALUE in DATABASE.
+If optional fourth arg REPLACE is non-nil,
+replace any existing entry in the database.
+*/
+ (key, value, database, replace))
+{
+ CHECK_LIVE_DATABASE (database);
+ CHECK_STRING (key);
+ CHECK_STRING (value);
+ {
+ struct Lisp_Database *db = XDATABASE (database);
+ int status = db->funcs->put (db, key, value, replace);
+ return status ? Qt : Qnil;
+ }
+}
+
+DEFUN ("remove-database", Fremove_database, 2, 2, 0, /*
+Remove KEY from DATABASE.
+*/
+ (key, database))
+{
+ CHECK_LIVE_DATABASE (database);
+ CHECK_STRING (key);
+ {
+ struct Lisp_Database *db = XDATABASE (database);
+ int status = db->funcs->rem (db, key);
+ return status ? Qt : Qnil;
+ }
+}
+
+DEFUN ("get-database", Fget_database, 2, 3, 0, /*
+Return value for KEY in DATABASE.
+If there is no corresponding value, return DEFAULT (defaults to nil).
+*/
+ (key, database, default_))
+{
+ CHECK_LIVE_DATABASE (database);
+ CHECK_STRING (key);
+ {
+ struct Lisp_Database *db = XDATABASE (database);
+ Lisp_Object retval = db->funcs->get (db, key);
+ return NILP (retval) ? default_ : retval;
+ }
+}
+
+DEFUN ("map-database", Fmapdatabase, 2, 2, 0, /*
+Map FUNCTION over entries in DATABASE, calling it with two args,
+each key and value in the database.
+*/
+ (function, database))
+{
+ CHECK_LIVE_DATABASE (database);
+
+ XDATABASE (database)->funcs->map (XDATABASE (database), function);
+
+ return Qnil;
+}
+
+void
+syms_of_database (void)
+{
+ defsymbol (&Qdatabasep, "databasep");
+#ifdef HAVE_DBM
+ defsymbol (&Qdbm, "dbm");
+#endif
+#ifdef HAVE_BERKELEY_DB
+ defsymbol (&Qberkeley_db, "berkeley-db");
+ defsymbol (&Qhash, "hash");
+ defsymbol (&Qbtree, "btree");
+ defsymbol (&Qrecno, "recno");
+ defsymbol (&Qunknown, "unknown");
+#endif
+
+ DEFSUBR (Fopen_database);
+ DEFSUBR (Fdatabasep);
+ DEFSUBR (Fmapdatabase);
+ DEFSUBR (Fput_database);
+ DEFSUBR (Fget_database);
+ DEFSUBR (Fremove_database);
+ DEFSUBR (Fdatabase_type);
+ DEFSUBR (Fdatabase_subtype);
+ DEFSUBR (Fdatabase_last_error);
+ DEFSUBR (Fdatabase_live_p);
+ DEFSUBR (Fdatabase_file_name);
+ DEFSUBR (Fclose_database);
+}
+
+void
+vars_of_database (void)
+{
+#ifdef HAVE_DBM
+ Fprovide (Qdbm);
+#endif
+#ifdef HAVE_BERKELEY_DB
+ Fprovide (Qberkeley_db);
+#endif
+}
--- /dev/null
+/* Header file for database functions
+ 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. */
+
+/* This file is only necessary to get INLINE handling correct.
+ See inline.c */
+
+#ifndef _XEMACS_DATABASE_H
+#define _XEMACS_DATABASE_H
+
+DECLARE_LRECORD (database, struct Lisp_Database);
+
+#endif
--- /dev/null
+## This file automatically generated by make-src-depend. Do not modify.
+
+#ifdef USE_UNION_TYPE
+LISP_UNION_H=lisp-union.h
+#else
+LISP_UNION_H=lisp-disunion.h
+#endif
+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 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 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
+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) conslots.h console-msw.h console.h device.h dragdrop.h events-mod.h events.h frame.h frameslots.h lisp-disunion.h lisp-union.h lrecord.h lstream.h menubar-msw.h mule-charset.h process.h redisplay.h scrollbar-msw.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h sysproc.h systime.h syswait.h toolbar.h
+frame-msw.o: $(LISP_H) buffer.h bufslots.h conslots.h console-msw.h console.h device.h events.h faces.h frame.h frameslots.h glyphs-msw.h glyphs.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 faces.h file-coding.h frame.h frameslots.h glyphs-msw.h glyphs.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 scrollbar.h specifier.h symeval.h symsinit.h sysfile.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 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 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 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
+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
+balloon-x.o: $(LISP_H) balloon_help.h conslots.h console-x.h console.h device.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h xintrinsic.h
+console-x.o: $(LISP_H) conslots.h console-x.h console.h lisp-disunion.h lisp-union.h lrecord.h process.h redisplay.h symeval.h symsinit.h xintrinsic.h
+device-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h conslots.h console-x.h console.h device.h events.h faces.h frame.h frameslots.h glyphs-x.h glyphs.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 EmacsManager.h EmacsShell.h buffer.h bufslots.h commands.h conslots.h console-x.h console.h device.h events.h frame.h frameslots.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 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 imgproc.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h objects-x.h objects.h opaque.h scrollbar.h specifier.h symeval.h symsinit.h sysfile.h toolbar.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 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
+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 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 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 EmacsManager.h EmacsShell.h buffer.h bufslots.h commands.h conslots.h console-x.h console.h device.h events.h frame.h frameslots.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 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 EmacsManager.h conslots.h console-x.h console.h device.h frame.h frameslots.h glyphs-x.h glyphs.h gui-x.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
+toolbar-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h EmacsManager.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 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 xgccache.h xintrinsic.h xintrinsicp.h xmprimitivep.h
+#endif
+#ifdef HAVE_DATABASE
+database.o: $(LISP_H) database.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h sysfile.h
+#endif
+#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-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
+#endif
+#ifdef EXTERNAL_WIDGET
+ExternalClient-Xlib.o: extw-Xlib.h
+ExternalClient.o: ExternalClient.h ExternalClientP.h config.h extw-Xlib.h extw-Xt.h xintrinsicp.h
+ExternalShell.o: ExternalShell.h ExternalShellP.h config.h extw-Xlib.h extw-Xt.h xintrinsic.h xintrinsicp.h
+extw-Xlib.o: config.h extw-Xlib.h
+extw-Xt.o: config.h extw-Xlib.h extw-Xt.h
+#endif
+EmacsFrame.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h EmacsManager.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 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 xmu.h
+EmacsManager.o: EmacsManager.h EmacsManagerP.h config.h xintrinsicp.h xmmanagerp.h
+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 lisp-disunion.h lisp-union.h lrecord.h mule-charset.h puresize.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 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
+bytecode.o: $(LISP_H) buffer.h bufslots.h chartab.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.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 paths.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
+casefiddle.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
+casetab.o: $(LISP_H) buffer.h bufslots.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h symeval.h symsinit.h
+chartab.o: $(LISP_H) buffer.h bufslots.h chartab.h commands.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h syntax.h
+cm.o: $(LISP_H) conslots.h console-tty.h console.h device.h frame.h frameslots.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h syssignal.h systty.h toolbar.h
+cmdloop.o: $(LISP_H) buffer.h bufslots.h commands.h conslots.h console.h device.h events.h frame.h frameslots.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
+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 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 gpmevent.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 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
+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 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 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
+dialog.o: $(LISP_H) conslots.h console.h device.h frame.h frameslots.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
+dll.o: $(LISP_H) buffer.h bufslots.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h sysdll.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 commands.h conslots.h console.h device.h events.h extents.h frame.h frameslots.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
+eldap.o: $(LISP_H) eldap.h lisp-disunion.h lisp-union.h lrecord.h opaque.h symeval.h symsinit.h sysdep.h
+elhash.o: $(LISP_H) bytecode.h elhash.h hash.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 symeval.h symsinit.h sysdep.h sysdll.h sysfile.h syssignal.h systime.h systty.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 commands.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 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 gui-x.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 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
+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 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 hash.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 hash.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
+fileio.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h events.h file-coding.h frame.h frameslots.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 commands.h conslots.h console.h device.h events.h extents.h frame.h frameslots.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.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 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 sysdep.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
+glyphs-eimage.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h file-coding.h frame.h frameslots.h glyphs.h imgproc.h insdel.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
+glyphs.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h elhash.h faces.h frame.h frameslots.h glyphs.h insdel.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
+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
+gui.o: $(LISP_H) bytecode.h gui.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h
+hash.o: $(LISP_H) elhash.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 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 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 lisp-disunion.h lisp-union.h lrecord.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 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 commands.h conslots.h console.h device.h elhash.h events-mod.h events.h frame.h frameslots.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 insdel.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
+lread.o: $(LISP_H) buffer.h bufslots.h bytecode.h commands.h file-coding.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h opaque.h paths.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 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
+malloc.o: config.h getpagesize.h
+marker.o: $(LISP_H) buffer.h bufslots.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h
+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 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 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
+nas.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.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
+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
+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 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 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
+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 commands.h conslots.h console.h device.h events.h file-coding.h frame.h frameslots.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 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 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 sysdep.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 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 debug.h device.h faces.h frame.h frameslots.h glyphs.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.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 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 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
+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 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 commands.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h regex.h symeval.h symsinit.h syntax.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 lisp-disunion.h lisp-union.h lrecord.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 commands.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 conslots.h console.h device.h frame.h frameslots.h glyphs.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 window.h winslots.h
+strcat.o: config.h
+strcmp.o: config.h
+strcpy.o: config.h
+strftime.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h
+sunOS-fix.o: config.h
+sunplay.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h sysdep.h syssignal.h
+sunpro.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h
+symbols.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h elhash.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h
+syntax.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
+sysdep.o: $(LISP_H) buffer.h bufslots.h conslots.h console-stream.h console-tty.h console.h device.h events.h frame.h frameslots.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h ndir.h ntheap.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysdir.h sysfile.h syssignal.h systime.h systty.h syswait.h toolbar.h window.h winslots.h
+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
+toolbar.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h frame.h frameslots.h glyphs.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
+undo.o: $(LISP_H) buffer.h bufslots.h extents.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h
+unexaix.o: $(LISP_H) getpagesize.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h
+unexalpha.o: config.h
+unexapollo.o: config.h
+unexconvex.o: config.h getpagesize.h
+unexcw.o: config.h sysfile.h
+unexec.o: $(LISP_H) getpagesize.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h
+unexelf.o: config.h
+unexelfsgi.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h
+unexenix.o: config.h
+unexfreebsd.o: config.h
+unexhp9k3.o: config.h sysdep.h
+unexhp9k800.o: config.h
+unexmips.o: config.h getpagesize.h
+unexnt.o: ntheap.h
+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 insdel.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 faces.h frame.h frameslots.h glyphs.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 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
--- /dev/null
+/* Output like sprintf to a buffer of specified size.
+ Also takes args differently: pass one pointer to an array of strings
+ in addition to the format string which is separate.
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Rewritten by mly to use varargs.h.
+ Rewritten from scratch by Ben Wing (February 1995) for Mule; expanded
+ to full printf spec.
+
+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: Rewritten. Not in FSF. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "lstream.h"
+
+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";
+
+typedef struct printf_spec printf_spec;
+struct printf_spec
+{
+ int argnum; /* which argument does this spec want? This is one-based:
+ The first argument given is numbered 1, the second
+ is 2, etc. This is to handle %##$x-type specs. */
+ int minwidth;
+ int precision;
+ unsigned int minus_flag:1;
+ unsigned int plus_flag:1;
+ unsigned int space_flag:1;
+ unsigned int number_flag:1;
+ unsigned int zero_flag:1;
+ unsigned int h_flag:1;
+ unsigned int l_flag:1;
+ unsigned int forwarding_precision:1;
+ char converter; /* converter character or 0 for dummy marker
+ indicating literal text at the end of the
+ specification */
+ Bytecount text_before; /* position of the first character of the
+ block of literal text before this spec */
+ Bytecount text_before_len; /* length of that text */
+};
+
+typedef union printf_arg printf_arg;
+union printf_arg
+{
+ int i;
+ unsigned int ui;
+ long l;
+ unsigned long ul;
+ double d;
+ Bufbyte *bp;
+};
+
+/* We maintain a list of all the % specs in the specification,
+ along with the offset and length of the block of literal text
+ before each spec. In addition, we have a "dummy" spec that
+ represents all the literal text at the end of the specification.
+ Its converter is 0. */
+
+typedef struct
+{
+ Dynarr_declare (struct printf_spec);
+} printf_spec_dynarr;
+
+typedef struct
+{
+ Dynarr_declare (union printf_arg);
+} printf_arg_dynarr;
+
+/* Append STRING (of length LEN) to STREAM. MINLEN is the minimum field
+ width. If MINUS_FLAG is set, left-justify the string in its field;
+ otherwise, right-justify. If ZERO_FLAG is set, pad with 0's; otherwise
+ pad with spaces. If MAXLEN is non-negative, the string is first
+ truncated to that many character.
+
+ Note that MINLEN and MAXLEN are Charcounts but LEN is a Bytecount. */
+
+static void
+doprnt_1 (Lisp_Object stream, CONST Bufbyte *string, Bytecount len,
+ Charcount minlen, Charcount maxlen, int minus_flag, int zero_flag)
+{
+ Charcount cclen;
+ Bufbyte pad;
+ Lstream *lstr = XLSTREAM (stream);
+
+ cclen = bytecount_to_charcount (string, len);
+
+ if (zero_flag)
+ pad = '0';
+ else
+ pad = ' ';
+
+ /* Padding at beginning to right-justify ... */
+ if (minlen > cclen && !minus_flag)
+ {
+ int to_add = minlen - cclen;
+ while (to_add > 0)
+ {
+ Lstream_putc (lstr, pad);
+ to_add--;
+ }
+ }
+
+ if (maxlen >= 0)
+ len = charcount_to_bytecount (string, min (maxlen, cclen));
+ Lstream_write (lstr, string, len);
+
+ /* Padding at end to left-justify ... */
+ if (minlen > cclen && minus_flag)
+ {
+ int to_add = minlen - cclen;
+ while (to_add > 0)
+ {
+ Lstream_putc (lstr, pad);
+ to_add--;
+ }
+ }
+}
+
+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;
+
+ *returned_num = -1;
+ while (start != end && isdigit (*start))
+ {
+ if ((size_t) (arg_ptr - arg_convert) >= sizeof (arg_convert) - 1)
+ error ("Format converter number too large");
+ *arg_ptr++ = *start++;
+ }
+ *arg_ptr = '\0';
+ if (arg_convert != arg_ptr)
+ *returned_num = atoi ((char *) arg_convert);
+ return start;
+}
+
+#define NEXT_ASCII_BYTE(ch) \
+ do { \
+ if (fmt == fmt_end) \
+ error ("Premature end of format string"); \
+ ch = *fmt; \
+ if (ch >= 0200) \
+ error ("Non-ASCII character in format converter spec"); \
+ fmt++; \
+ } while (0)
+
+#define RESOLVE_FLAG_CONFLICTS(spec) \
+ do { \
+ if (spec.space_flag && spec.plus_flag) \
+ spec.space_flag = 0; \
+ if (spec.zero_flag && spec.space_flag) \
+ spec.zero_flag = 0; \
+ } while (0)
+
+static printf_spec_dynarr *
+parse_doprnt_spec (CONST Bufbyte *format, Bytecount 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;
+ Bufbyte ch;
+
+ xzero (spec);
+ if (fmt == fmt_end)
+ return specs;
+ text_end = (Bufbyte *) memchr (fmt, '%', fmt_end - fmt);
+ if (!text_end)
+ text_end = fmt_end;
+ spec.text_before = fmt - format;
+ spec.text_before_len = text_end - fmt;
+ fmt = text_end;
+ if (fmt != fmt_end)
+ {
+ fmt++; /* skip over % */
+
+ /* A % is special -- no arg number. According to ANSI specs,
+ field width does not apply to %% conversion. */
+ if (fmt != fmt_end && *fmt == '%')
+ {
+ spec.converter = '%';
+ Dynarr_add (specs, spec);
+ fmt++;
+ continue;
+ }
+
+ /* Is there a field number specifier? */
+ {
+ CONST Bufbyte *ptr;
+ int fieldspec;
+
+ ptr = parse_off_posnum (fmt, fmt_end, &fieldspec);
+ if (fieldspec > 0 && ptr != fmt_end && *ptr == '$')
+ {
+ /* There is a format specifier */
+ prev_argnum = fieldspec;
+ fmt = ptr + 1;
+ }
+ else
+ prev_argnum++;
+ spec.argnum = prev_argnum;
+ }
+
+ /* Parse off any flags */
+ NEXT_ASCII_BYTE (ch);
+ while (strchr (valid_flags, ch))
+ {
+ switch (ch)
+ {
+ case '-': spec.minus_flag = 1; break;
+ case '+': spec.plus_flag = 1; break;
+ case ' ': spec.space_flag = 1; break;
+ case '#': spec.number_flag = 1; break;
+ case '0': spec.zero_flag = 1; break;
+ default: abort ();
+ }
+ NEXT_ASCII_BYTE (ch);
+ }
+
+ /* Parse off the minimum field width */
+ fmt--; /* back up */
+
+ /*
+ * * means the field width was passed as an argument.
+ * Mark the current spec as one that forwards its
+ * field width and flags to the next spec in the array.
+ * Then create a new spec and continue with the parsing.
+ */
+ if (fmt != fmt_end && *fmt == '*')
+ {
+ spec.converter = '*';
+ RESOLVE_FLAG_CONFLICTS(spec);
+ Dynarr_add (specs, spec);
+ xzero (spec);
+ spec.argnum = ++prev_argnum;
+ fmt++;
+ }
+ else
+ {
+ fmt = parse_off_posnum (fmt, fmt_end, &spec.minwidth);
+ if (spec.minwidth == -1)
+ spec.minwidth = 0;
+ }
+
+ /* Parse off any precision specified */
+ NEXT_ASCII_BYTE (ch);
+ if (ch == '.')
+ {
+ /*
+ * * means the precision was passed as an argument.
+ * Mark the current spec as one that forwards its
+ * fieldwidth, flags and precision to the next spec in
+ * the array. Then create a new spec and continue
+ * with the parse.
+ */
+ if (fmt != fmt_end && *fmt == '*')
+ {
+ spec.converter = '*';
+ spec.forwarding_precision = 1;
+ RESOLVE_FLAG_CONFLICTS(spec);
+ Dynarr_add (specs, spec);
+ xzero (spec);
+ spec.argnum = ++prev_argnum;
+ fmt++;
+ }
+ else
+ {
+ fmt = parse_off_posnum (fmt, fmt_end, &spec.precision);
+ if (spec.precision == -1)
+ spec.precision = 0;
+ }
+ NEXT_ASCII_BYTE (ch);
+ }
+ else
+ /* No precision specified */
+ spec.precision = -1;
+
+ /* Parse off h or l flag */
+ if (ch == 'h' || ch == 'l')
+ {
+ if (ch == 'h')
+ spec.h_flag = 1;
+ else
+ spec.l_flag = 1;
+ NEXT_ASCII_BYTE (ch);
+ }
+
+ if (!strchr (valid_converters, ch))
+ error ("Invalid converter character %c", ch);
+ spec.converter = ch;
+ }
+
+ RESOLVE_FLAG_CONFLICTS(spec);
+ Dynarr_add (specs, spec);
+ }
+
+ RETURN_NOT_REACHED(specs) /* suppress compiler warning */
+}
+
+static int
+get_args_needed (printf_spec_dynarr *specs)
+{
+ int args_needed = 0;
+ REGISTER int i;
+
+ /* Figure out how many args are needed. This may be less than
+ the number of specs because a spec could be %% or could be
+ missing (literal text at end of format string) or there
+ could be specs where the field number is explicitly given.
+ We just look for the maximum argument number that's referenced. */
+
+ for (i = 0; i < Dynarr_length (specs); i++)
+ {
+ char ch = Dynarr_at (specs, i).converter;
+ if (ch && ch != '%')
+ {
+ int argnum = Dynarr_at (specs, i).argnum;
+ if (argnum > args_needed)
+ args_needed = argnum;
+ }
+ }
+
+ return args_needed;
+}
+
+static printf_arg_dynarr *
+get_doprnt_args (printf_spec_dynarr *specs, va_list vargs)
+{
+ printf_arg_dynarr *args = Dynarr_new (printf_arg);
+ union printf_arg arg;
+ REGISTER int i;
+ int args_needed = get_args_needed (specs);
+
+ xzero (arg);
+ for (i = 1; i <= args_needed; i++)
+ {
+ int j;
+ char ch;
+ struct printf_spec *spec = 0;
+
+ for (j = 0; j < Dynarr_length (specs); j++)
+ {
+ spec = Dynarr_atp (specs, j);
+ if (spec->argnum == i)
+ break;
+ }
+
+ if (j == Dynarr_length (specs))
+ error ("No conversion spec for argument %d", i);
+
+ ch = spec->converter;
+
+ /* int even if ch == 'c': "the type used in va_arg is supposed to
+ match the actual type **after default promotions**." */
+
+ if (strchr (int_converters, ch))
+ {
+ if (spec->h_flag)
+ arg.i = va_arg (vargs, short);
+ else if (spec->l_flag)
+ arg.l = va_arg (vargs, long);
+ else
+ arg.i = va_arg (vargs, int);
+ }
+ else if (strchr (unsigned_int_converters, ch))
+ {
+ if (spec->h_flag)
+ arg.ui = va_arg (vargs, unsigned short);
+ else if (spec->l_flag)
+ arg.ul = va_arg (vargs, unsigned long);
+ else
+ arg.ui = va_arg (vargs, unsigned int);
+ }
+ else if (strchr (double_converters, ch))
+ arg.d = va_arg (vargs, double);
+ else if (strchr (string_converters, ch))
+ arg.bp = va_arg (vargs, Bufbyte *);
+ else abort ();
+
+ Dynarr_add (args, arg);
+ }
+
+ return args;
+}
+
+/* Generate output from a format-spec FORMAT, of length FORMAT_LENGTH.
+ Output goes in BUFFER, which has room for BUFSIZE bytes.
+ If the output does not fit, truncate it to fit.
+ Returns the number of bytes stored into BUFFER.
+ LARGS or VARGS points to the arguments, and NARGS says how many.
+ if LARGS is non-zero, it should be a pointer to NARGS worth of
+ Lisp arguments. Otherwise, VARGS should be a va_list referring
+ to the arguments. */
+
+static Bytecount
+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)
+{
+ printf_spec_dynarr *specs = 0;
+ printf_arg_dynarr *args = 0;
+ REGISTER int i;
+ int init_byte_count = Lstream_byte_count (XLSTREAM (stream));
+
+ if (!NILP (format_reloc))
+ {
+ format_nonreloc = XSTRING_DATA (format_reloc);
+ format_length = XSTRING_LENGTH (format_reloc);
+ }
+ if (format_length < 0)
+ format_length = (Bytecount) strlen ((CONST char *) format_nonreloc);
+
+ specs = parse_doprnt_spec (format_nonreloc, format_length);
+ if (largs)
+ {
+ /* allow too many args for string, but not too few */
+ if (nargs < get_args_needed (specs))
+ signal_error (Qwrong_number_of_arguments,
+ list3 (Qformat,
+ make_int (nargs),
+ !NILP (format_reloc) ? format_reloc :
+ make_string (format_nonreloc, format_length)));
+ }
+ else
+ {
+ args = get_doprnt_args (specs, vargs);
+ }
+
+ for (i = 0; i < Dynarr_length (specs); i++)
+ {
+ struct printf_spec *spec = Dynarr_atp (specs, i);
+ char ch;
+
+ /* Copy the text before */
+ if (!NILP (format_reloc)) /* refetch in case of GC below */
+ format_nonreloc = XSTRING_DATA (format_reloc);
+ doprnt_1 (stream, format_nonreloc + spec->text_before,
+ spec->text_before_len, 0, -1, 0, 0);
+
+ ch = spec->converter;
+
+ if (!ch)
+ continue;
+
+ if (ch == '%')
+ {
+ doprnt_1 (stream, (Bufbyte *) &ch, 1, 0, -1, 0, 0);
+ continue;
+ }
+
+ /* The char '*' as converter means the field width, precision
+ was specified as an argument. Extract the data and forward
+ it to the next spec, to which it will apply. */
+ if (ch == '*')
+ {
+ struct printf_spec *nextspec = Dynarr_atp (specs, i + 1);
+ Lisp_Object obj = largs[spec->argnum - 1];
+
+ if (INTP (obj))
+ {
+ if (spec->forwarding_precision)
+ {
+ nextspec->precision = XINT (obj);
+ nextspec->minwidth = spec->minwidth;
+ }
+ else
+ {
+ nextspec->minwidth = XINT (obj);
+ if (XINT(obj) < 0)
+ {
+ spec->minus_flag = 1;
+ nextspec->minwidth = - nextspec->minwidth;
+ }
+ }
+ nextspec->minus_flag = spec->minus_flag;
+ nextspec->plus_flag = spec->plus_flag;
+ nextspec->space_flag = spec->space_flag;
+ nextspec->number_flag = spec->number_flag;
+ nextspec->zero_flag = spec->zero_flag;
+ }
+ continue;
+ }
+
+ if (largs && (spec->argnum < 1 || spec->argnum > nargs))
+ error ("Invalid repositioning argument %d", spec->argnum);
+
+ else if (ch == 'S' || ch == 's')
+ {
+ Bufbyte *string;
+ Bytecount string_len;
+
+ if (!largs)
+ {
+ string = Dynarr_at (args, spec->argnum - 1).bp;
+ /* error() can be called with null string arguments.
+ E.g., in fileio.c, the return value of strerror()
+ is never checked. We'll print (null), like some
+ printf implementations do. Would it be better (and safe)
+ to signal an error instead? Or should we just use the
+ empty string? -dkindred@cs.cmu.edu 8/1997
+ */
+ if (!string)
+ string = (Bufbyte *) "(null)";
+ string_len = strlen ((char *) string);
+ }
+ else
+ {
+ Lisp_Object obj = largs[spec->argnum - 1];
+ struct Lisp_String *ls;
+
+ if (ch == 'S')
+ {
+ /* For `S', prin1 the argument and then treat like
+ a string. */
+ ls = XSTRING (Fprin1_to_string (obj, Qnil));
+ }
+ else if (STRINGP (obj))
+ ls = XSTRING (obj);
+ else if (SYMBOLP (obj))
+ ls = XSYMBOL (obj)->name;
+ else
+ {
+ /* convert to string using princ. */
+ ls = XSTRING (Fprin1_to_string (obj, Qt));
+ }
+ string = string_data (ls);
+ string_len = string_length (ls);
+ }
+
+ doprnt_1 (stream, string, string_len, spec->minwidth,
+ spec->precision, spec->minus_flag, spec->zero_flag);
+ }
+
+ else
+ {
+ /* Must be a number. */
+ union printf_arg arg;
+
+ if (!largs)
+ {
+ arg = Dynarr_at (args, spec->argnum - 1);
+ }
+ else
+ {
+ Lisp_Object obj = largs[spec->argnum - 1];
+ if (CHARP (obj))
+ CHECK_INT_COERCE_CHAR (obj);
+ if (!INT_OR_FLOATP (obj))
+ {
+ error ("format specifier %%%c doesn't match argument type",
+ ch);
+ }
+ else if (strchr (double_converters, ch))
+ arg.d = XFLOATINT (obj);
+ else
+ {
+ int val;
+
+ if (FLOATP (obj))
+ val = XINT (Ftruncate (obj));
+ else
+ val = XINT (obj);
+ if (strchr (unsigned_int_converters, ch))
+ {
+ if (spec->l_flag)
+ arg.ul = (unsigned long) val;
+ else
+ arg.ui = (unsigned int) val;
+ }
+ else
+ {
+ if (spec->l_flag)
+ arg.l = (long) val;
+ else
+ arg.i = val;
+ }
+ }
+ }
+
+
+ if (ch == 'c')
+ {
+ Emchar a;
+ Bytecount charlen;
+ Bufbyte charbuf[MAX_EMCHAR_LEN];
+
+ if (spec->l_flag)
+ a = (Emchar) arg.l;
+ else
+ a = (Emchar) arg.i;
+
+ if (!valid_char_p (a))
+ error ("invalid character value %d to %%c spec", a);
+
+ charlen = set_charptr_emchar (charbuf, a);
+ doprnt_1 (stream, charbuf, charlen, spec->minwidth,
+ -1, spec->minus_flag, spec->zero_flag);
+ }
+
+ else
+ {
+ char text_to_print[500];
+ char constructed_spec[100];
+
+ /* Partially reconstruct the spec and use sprintf() to
+ format the string. */
+
+ /* Make sure nothing stupid happens */
+ /* DO NOT REMOVE THE (int) CAST! Incorrect results will
+ follow! */
+ spec->precision = min (spec->precision,
+ (int) (sizeof (text_to_print) - 50));
+
+ constructed_spec[0] = 0;
+ strcat (constructed_spec, "%");
+ if (spec->plus_flag)
+ strcat (constructed_spec, "+");
+ if (spec->space_flag)
+ strcat (constructed_spec, " ");
+ if (spec->number_flag)
+ strcat (constructed_spec, "#");
+ if (spec->precision >= 0)
+ {
+ strcat (constructed_spec, ".");
+ long_to_string (constructed_spec + strlen (constructed_spec),
+ spec->precision);
+ }
+ sprintf (constructed_spec + strlen (constructed_spec), "%c", ch);
+
+ /* sprintf the mofo */
+ /* we have to use separate calls to sprintf(), rather than
+ a single big conditional, because of the different types
+ of the arguments */
+ if (strchr (double_converters, ch))
+ sprintf (text_to_print, constructed_spec, arg.d);
+ else if (strchr (unsigned_int_converters, ch))
+ {
+ if (spec->l_flag)
+ sprintf (text_to_print, constructed_spec, arg.ul);
+ else
+ sprintf (text_to_print, constructed_spec, arg.ui);
+ }
+ else
+ {
+ if (spec->l_flag)
+ sprintf (text_to_print, constructed_spec, arg.l);
+ else
+ sprintf (text_to_print, constructed_spec, arg.i);
+ }
+
+ doprnt_1 (stream, (Bufbyte *) text_to_print,
+ strlen (text_to_print),
+ spec->minwidth, -1, spec->minus_flag, spec->zero_flag);
+ }
+ }
+ }
+
+ /* #### will not get freed if error */
+ if (specs)
+ Dynarr_free (specs);
+ if (args)
+ Dynarr_free (args);
+ return Lstream_byte_count (XLSTREAM (stream)) - init_byte_count;
+}
+
+/* You really don't want to know why this is necessary... */
+static Bytecount
+emacs_doprnt_2 (Lisp_Object stream, CONST Bufbyte *format_nonreloc,
+ Lisp_Object format_reloc, Bytecount format_length, int nargs,
+ CONST Lisp_Object *largs, ...)
+{
+ va_list vargs;
+ Bytecount val;
+ va_start (vargs, largs);
+ val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
+ format_length, nargs, largs, vargs);
+ va_end (vargs);
+ return val;
+}
+
+/*********************** external entry points ***********************/
+
+#ifdef I18N3
+ /* A note about I18N3 translating: the format string should get
+ translated, but not under all circumstances. When the format
+ string is a Lisp string, what should happen is that Fformat()
+ should format the untranslated args[0] and return that, and also
+ call Fgettext() on args[0] and, if that is different, format it
+ and store it in the `string-translatable' property of
+ the returned string. See Fgettext(). */
+#endif
+
+/* Send formatted output to STREAM. The format string comes from
+ either FORMAT_NONRELOC (of length FORMAT_LENGTH; -1 means use
+ strlen() to determine the length) or from FORMAT_RELOC, which
+ should be a Lisp string. Return the number of bytes written
+ to the stream.
+
+ DO NOT pass the data from a Lisp string as the FORMAT_NONRELOC
+ parameter, because this function can cause GC. */
+
+Bytecount
+emacs_doprnt_c (Lisp_Object stream, CONST Bufbyte *format_nonreloc,
+ Lisp_Object format_reloc, Bytecount format_length,
+ ...)
+{
+ int val;
+ va_list vargs;
+
+ va_start (vargs, format_length);
+ val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
+ format_length, 0, 0, vargs);
+ va_end (vargs);
+ return val;
+}
+
+/* Like emacs_doprnt_c but the args come in va_list format. */
+
+Bytecount
+emacs_doprnt_va (Lisp_Object stream, CONST Bufbyte *format_nonreloc,
+ Lisp_Object format_reloc, Bytecount format_length,
+ va_list vargs)
+{
+ return emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
+ format_length, 0, 0, vargs);
+}
+
+/* Like emacs_doprnt_c but the args are Lisp objects instead of
+ C arguments. This causes somewhat different behavior from
+ the above two functions (which should act like printf).
+ See `format' for a description of this behavior. */
+
+Bytecount
+emacs_doprnt_lisp (Lisp_Object stream, CONST Bufbyte *format_nonreloc,
+ Lisp_Object format_reloc, Bytecount format_length,
+ int nargs, CONST Lisp_Object *largs)
+{
+ return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
+ format_length, nargs, largs);
+}
+
+/* Like the previous function but takes a variable number of arguments. */
+
+Bytecount
+emacs_doprnt_lisp_2 (Lisp_Object stream, CONST Bufbyte *format_nonreloc,
+ Lisp_Object format_reloc, Bytecount format_length,
+ int nargs, ...)
+{
+ va_list vargs;
+ int i;
+ Lisp_Object *foo = alloca_array (Lisp_Object, nargs);
+
+ va_start (vargs, nargs);
+ for (i = 0; i < nargs; i++)
+ foo[i] = va_arg (vargs, Lisp_Object);
+ va_end (vargs);
+
+ return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
+ format_length, nargs, foo);
+}
+
+/* The following four functions work like the above three but
+ return their output as a Lisp string instead of sending it
+ to a stream. */
+
+Lisp_Object
+emacs_doprnt_string_c (CONST Bufbyte *format_nonreloc,
+ Lisp_Object format_reloc, Bytecount format_length,
+ ...)
+{
+ va_list vargs;
+ Lisp_Object obj;
+ Lisp_Object stream = make_resizing_buffer_output_stream ();
+ struct gcpro gcpro1;
+
+ GCPRO1 (stream);
+ va_start (vargs, format_length);
+ emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
+ format_length, 0, 0, vargs);
+ va_end (vargs);
+ Lstream_flush (XLSTREAM (stream));
+ obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
+ Lstream_byte_count (XLSTREAM (stream)));
+ UNGCPRO;
+ Lstream_delete (XLSTREAM (stream));
+ return obj;
+}
+
+Lisp_Object
+emacs_doprnt_string_va (CONST Bufbyte *format_nonreloc,
+ Lisp_Object format_reloc, Bytecount format_length,
+ va_list vargs)
+{
+ /* I'm fairly sure that this function cannot actually GC.
+ That can only happen when the arguments to emacs_doprnt_1() are
+ Lisp objects rather than C args. */
+ Lisp_Object obj;
+ Lisp_Object stream = make_resizing_buffer_output_stream ();
+ struct gcpro gcpro1;
+
+ GCPRO1 (stream);
+ emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
+ format_length, 0, 0, vargs);
+ Lstream_flush (XLSTREAM (stream));
+ obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
+ Lstream_byte_count (XLSTREAM (stream)));
+ UNGCPRO;
+ Lstream_delete (XLSTREAM (stream));
+ return obj;
+}
+
+Lisp_Object
+emacs_doprnt_string_lisp (CONST Bufbyte *format_nonreloc,
+ Lisp_Object format_reloc, Bytecount format_length,
+ int nargs, CONST Lisp_Object *largs)
+{
+ Lisp_Object obj;
+ Lisp_Object stream = make_resizing_buffer_output_stream ();
+ struct gcpro gcpro1;
+
+ GCPRO1 (stream);
+ emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
+ format_length, nargs, largs);
+ Lstream_flush (XLSTREAM (stream));
+ obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
+ Lstream_byte_count (XLSTREAM (stream)));
+ UNGCPRO;
+ Lstream_delete (XLSTREAM (stream));
+ return obj;
+}
+
+Lisp_Object
+emacs_doprnt_string_lisp_2 (CONST Bufbyte *format_nonreloc,
+ Lisp_Object format_reloc, Bytecount format_length,
+ int nargs, ...)
+{
+ Lisp_Object obj;
+ Lisp_Object stream = make_resizing_buffer_output_stream ();
+ struct gcpro gcpro1;
+ va_list vargs;
+ int i;
+ Lisp_Object *foo = alloca_array (Lisp_Object, nargs);
+
+ va_start (vargs, nargs);
+ for (i = 0; i < nargs; i++)
+ foo[i] = va_arg (vargs, Lisp_Object);
+ va_end (vargs);
+
+ GCPRO1 (stream);
+ emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
+ format_length, nargs, foo);
+ Lstream_flush (XLSTREAM (stream));
+ obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
+ Lstream_byte_count (XLSTREAM (stream)));
+ UNGCPRO;
+ Lstream_delete (XLSTREAM (stream));
+ return obj;
+}
--- /dev/null
+/* XEmacs -- Fully extensible Emacs, running on Unix and other platforms.
+ Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994
+ 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.0, FSF 19.28. */
+
+/* Note: It is necessary to specify <config.h> and not "config.h" in
+ order for the --srcdir type of compilation to work properly.
+ Otherwise the config.h from the srcdir, rather than the one from
+ the build dir, will be used. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "backtrace.h" /* run-emacs-from-temacs needs this */
+#include "buffer.h"
+#include "commands.h"
+#include "console.h"
+#include "process.h"
+#include "sysdep.h"
+
+#include <setjmp.h>
+#include "syssignal.h" /* Always include before systty.h */
+#include "systty.h"
+#include "sysfile.h"
+#include "systime.h"
+
+#ifdef HAVE_SHLIB
+#include "sysdll.h"
+#endif
+
+#if defined (HAVE_LOCALE_H) && \
+ (defined (I18N2) || defined (I18N3) || defined (I18N4))
+#include <locale.h>
+#endif
+
+#ifdef TOOLTALK
+#include TT_C_H_PATH
+#endif
+
+#ifdef APOLLO
+#ifndef APOLLO_SR10
+#include <default_acl.h>
+#endif
+#endif
+
+#if defined (WINDOWSNT)
+#include <windows.h>
+#endif
+
+/* For PATH_EXEC */
+#include <paths.h>
+
+#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 *);
+#endif /* not SYSTEM_MALLOC && not DOUG_LEA_MALLOC */
+
+/* Command line args from shell, as list of strings */
+Lisp_Object Vcommand_line_args;
+
+/* Set nonzero after XEmacs has started up the first time.
+ Prevents reinitialization of the Lisp world and keymaps
+ on subsequent starts. */
+int initialized;
+
+#ifdef DOUG_LEA_MALLOC
+# include <malloc.h>
+/* Preserves a pointer to the memory allocated that copies that
+ static data inside glibc's malloc. */
+static void *malloc_state_ptr;
+#endif /* DOUG_LEA_MALLOC */
+
+# ifdef REL_ALLOC
+void r_alloc_reinit (void);
+# endif
+
+/* Variable whose value is symbol giving operating system type. */
+Lisp_Object Vsystem_type;
+
+/* Variable whose value is string giving configuration built for. */
+Lisp_Object Vsystem_configuration;
+
+/* Variable whose value is string containing the configuration options
+ XEmacs was built with. */
+Lisp_Object Vsystem_configuration_options;
+
+/* Version numbers and strings */
+Lisp_Object Vemacs_major_version;
+Lisp_Object Vemacs_minor_version;
+Lisp_Object Vemacs_beta_version;
+Lisp_Object Vxemacs_codename;
+#ifdef INFODOCK
+Lisp_Object Vinfodock_major_version;
+Lisp_Object Vinfodock_minor_version;
+Lisp_Object Vinfodock_build_version;
+#endif
+
+/* The path under which XEmacs was invoked. */
+Lisp_Object Vinvocation_path;
+
+/* The name under which XEmacs was invoked, with any leading directory
+ names discarded. */
+Lisp_Object Vinvocation_name;
+
+/* The directory name from which XEmacs was invoked. */
+Lisp_Object Vinvocation_directory;
+
+#if 0 /* FSFmacs */
+/* The directory name in which to find subdirs such as lisp and etc.
+ nil means get them only from PATH_LOADSEARCH. */
+Lisp_Object Vinstallation_directory;
+#endif
+
+Lisp_Object Vemacs_program_name, Vemacs_program_version;
+Lisp_Object Vexec_path;
+Lisp_Object Vexec_directory, Vconfigure_exec_directory;
+Lisp_Object Vlisp_directory, Vconfigure_lisp_directory;
+Lisp_Object Vconfigure_package_path;
+Lisp_Object Vdata_directory, Vconfigure_data_directory;
+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 Vsite_directory, Vconfigure_site_directory;
+Lisp_Object Vconfigure_info_path;
+Lisp_Object Vinternal_error_checking;
+Lisp_Object Vpath_separator;
+
+/* The default base directory XEmacs is installed under. */
+Lisp_Object Vconfigure_exec_prefix_directory, Vconfigure_prefix_directory;
+
+/* If nonzero, set XEmacs to run at this priority. This is also used
+ in child_setup and sys_suspend to make sure subshells run at normal
+ priority. */
+int emacs_priority;
+
+/* If non-zero a filter or a sentinel is running. Tested to save the match
+ data on the first attempt to change it inside asynchronous code. */
+int running_asynch_code;
+
+/* If non-zero, a window-system was specified on the command line. */
+int display_arg;
+
+/* 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;
+
+/* If non-zero, then the early error handler will only print the error
+ message and exit. */
+int suppress_early_error_handler_backtrace;
+
+/* An address near the bottom of the stack.
+ Tells GC how to save a copy of the stack. */
+char *stack_bottom;
+
+#ifdef USG_SHARED_LIBRARIES
+/* If nonzero, this is the place to put the end of the writable segment
+ at startup. */
+
+uintptr_t bss_end = 0;
+#endif
+
+/* Number of bytes of writable memory we can expect to be able to get */
+unsigned int lim_data;
+
+/* Nonzero means running XEmacs without interactive terminal. */
+
+int noninteractive;
+
+/* Value of Lisp variable `noninteractive'.
+ Normally same as C variable `noninteractive'
+ but nothing terrible happens if user sets this one. */
+
+int noninteractive1;
+
+/* Nonzero means don't perform site-lisp searches at startup */
+int inhibit_site_lisp;
+
+/* Nonzero means don't respect early packages at startup */
+int inhibit_early_packages;
+
+/* Nonzero means don't load package autoloads at startup */
+int inhibit_autoloads;
+
+/* Nonzero means print debug information about path searching */
+int debug_paths;
+
+/* Save argv and argc. */
+char **initial_argv;
+int initial_argc;
+
+static void sort_args (int argc, char **argv);
+
+extern int always_gc; /* hack */
+
+Lisp_Object Qkill_emacs_hook;
+Lisp_Object Qsave_buffers_kill_emacs;
+
+\f
+/* Signal code for the fatal signal that was received */
+static int fatal_error_code;
+
+/* Nonzero if handling a fatal error already */
+static int fatal_error_in_progress;
+
+static void shut_down_emacs (int sig, Lisp_Object stuff);
+
+/* Handle bus errors, illegal instruction, etc. */
+SIGTYPE
+fatal_error_signal (int sig)
+{
+ fatal_error_code = sig;
+ signal (sig, SIG_DFL);
+ /* Unblock the signal so that if the same signal gets sent in the
+ code below, we avoid a deadlock. */
+ EMACS_UNBLOCK_SIGNAL (fatal_error_code);
+
+ /* If fatal error occurs in code below, avoid infinite recursion. */
+ if (! fatal_error_in_progress)
+ {
+ fatal_error_in_progress = dont_check_for_quit = 1;
+ shut_down_emacs (sig, Qnil);
+ stderr_out ("\nLisp backtrace follows:\n\n");
+ Fbacktrace (Qexternal_debugging_output, Qt);
+# 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";
+ if (access (pstack, X_OK) == 0)
+ {
+ char buf[100];
+ stderr_out ("\nC backtrace follows:\n"
+ "(A real debugger may provide better information)\n\n");
+ sprintf (buf, "%s %d >&2", pstack, (int)getpid());
+ system (buf);
+ }
+ }
+# endif
+ }
+ /* Signal the same code; this time it will really be fatal. */
+ kill (getpid (), fatal_error_code);
+ SIGRETURN;
+}
+\f
+
+DOESNT_RETURN
+fatal (CONST char *fmt, ...)
+{
+ va_list args;
+ va_start (args, fmt);
+
+ fprintf (stderr, "\nXEmacs: ");
+ vfprintf (stderr, GETTEXT (fmt), args);
+ fprintf (stderr, "\n");
+
+ va_end (args);
+ fflush (stderr);
+ exit (1);
+}
+
+/* #### The following two functions should be replaced with
+ calls to emacs_doprnt_*() functions, with STREAM set to send out
+ to stdout or stderr. This is the only way to ensure that
+ I18N3 works properly (many implementations of the *printf()
+ functions, including the ones included in glibc, do not implement
+ the %###$ argument-positioning syntax). */
+
+/* exactly equivalent to fprintf (stderr, fmt, ...) except that it calls
+ GETTEXT on the format string. */
+
+int
+stderr_out (CONST char *fmt, ...)
+{
+ int retval;
+ va_list args;
+ va_start (args, fmt);
+
+ retval = vfprintf (stderr, GETTEXT (fmt), args);
+
+ va_end (args);
+ /* fflush (stderr); */
+ return retval;
+}
+
+/* exactly equivalent to fprintf (stdout, fmt, ...) except that it calls
+ GETTEXT on the format string. */
+
+int
+stdout_out (CONST char *fmt, ...)
+{
+ int retval;
+ va_list args;
+ va_start (args, fmt);
+
+ retval = vfprintf (stdout, GETTEXT (fmt), args);
+
+ va_end (args);
+ return retval;
+}
+
+#ifdef SIGDANGER
+
+/* Handler for SIGDANGER. */
+SIGTYPE
+memory_warning_signal (int sig)
+{
+ /* #### bad bad bad; this function shouldn't do anything except
+ set a flag, or weird corruption could happen. */
+ signal (sig, memory_warning_signal);
+
+ malloc_warning
+ (GETTEXT ("Operating system warns that virtual memory is running low.\n"));
+
+ /* It might be unsafe to call do_auto_save now. */
+ force_auto_save_soon ();
+}
+#endif /* SIGDANGER */
+\f
+/* Code for dealing with Lisp access to the Unix command line */
+
+static Lisp_Object
+make_arg_list_1 (int argc, char **argv, int skip_args)
+{
+ Lisp_Object result = Qnil;
+ REGISTER int i;
+
+ for (i = argc - 1; i >= 0; i--)
+ {
+ if (i == 0 || i > skip_args)
+ {
+#ifdef WINDOWSNT
+ if (i == 0)
+ {
+ /* 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);
+#if defined(HAVE_SHLIB)
+ (void)dll_init(full_exe_path);
+#endif
+ }
+ else
+#endif
+ result = Fcons (build_ext_string (argv [i], FORMAT_FILENAME), result);
+ }
+ }
+ return result;
+}
+
+Lisp_Object
+make_arg_list (int argc, char **argv)
+{
+ return make_arg_list_1 (argc, argv, 0);
+}
+
+/* Calling functions are also responsible for calling free_argc_argv
+ when they are done with the generated list. */
+void
+make_argc_argv (Lisp_Object argv_list, int *argc, char ***argv)
+{
+ Lisp_Object next;
+ int n = XINT (Flength (argv_list));
+ REGISTER int i;
+ *argv = (char**) xmalloc ((n+1) * sizeof (char*));
+
+ for (i = 0, next = argv_list; i < n; i++, next = XCDR (next))
+ {
+ CONST char *temp;
+ CHECK_STRING (XCAR (next));
+
+ GET_C_STRING_EXT_DATA_ALLOCA (XCAR (next), FORMAT_OS, temp);
+ (*argv) [i] = xstrdup (temp);
+ }
+ (*argv) [n] = 0;
+ *argc = i;
+}
+
+void
+free_argc_argv (char **argv)
+{
+ int elt = 0;
+
+ while (argv[elt])
+ {
+ xfree (argv[elt]);
+ elt++;
+ }
+ xfree (argv);
+}
+
+static void
+init_cmdargs (int argc, char **argv, int skip_args)
+{
+ initial_argv = argv;
+ initial_argc = argc;
+
+ Vcommand_line_args = make_arg_list_1 (argc, argv, skip_args);
+}
+
+DEFUN ("invocation-name", Finvocation_name, 0, 0, 0, /*
+Return the program name that was used to run XEmacs.
+Any directory names are omitted.
+*/
+ ())
+{
+ return Fcopy_sequence (Vinvocation_name);
+}
+
+DEFUN ("invocation-directory", Finvocation_directory, 0, 0, 0, /*
+Return the directory name in which the Emacs executable was located.
+*/
+ ())
+{
+ return Fcopy_sequence (Vinvocation_directory);
+}
+
+\f
+#ifdef I18N4
+ /* #### - don't know why I18N4 on SunOS/JLE
+ can't deal with this. It's a potential
+ bug that needs to be looked at. */
+# undef RUN_TIME_REMAP
+#endif
+
+#if defined (MULE) && defined (MSDOS) && defined (EMX)
+/* Setup all of files be input/output'ed with binary translation mdoe. */
+asm (" .text");
+asm ("L_setbinmode:");
+asm (" movl $1, __fmode_bin");
+asm (" ret");
+asm (" .stabs \"___CTOR_LIST__\", 23, 0, 0, L_setbinmode");
+#endif
+
+/* Test whether the next argument in ARGV matches SSTR or a prefix of
+ LSTR (at least MINLEN characters). If so, then if VALPTR is non-null
+ (the argument is supposed to have a value) store in *VALPTR either
+ the next argument or the portion of this one after the equal sign.
+ ARGV is read starting at position *SKIPPTR; this index is advanced
+ by the number of arguments used.
+
+ Too bad we can't just use getopt for all of this, but we don't have
+ enough information to do it right. */
+
+static int
+argmatch (char **argv, int argc, char *sstr, char *lstr,
+ int minlen, char **valptr, int *skipptr)
+{
+ char *p = NULL;
+ int arglen;
+ char *arg;
+
+ /* Don't access argv[argc]; give up in advance. */
+ if (argc <= *skipptr + 1)
+ return 0;
+
+ arg = argv[*skipptr+1];
+ if (arg == NULL)
+ return 0;
+ if (strcmp (arg, sstr) == 0)
+ {
+ if (valptr != NULL)
+ {
+ *valptr = argv[*skipptr+2];
+ *skipptr += 2;
+ }
+ else
+ *skipptr += 1;
+ return 1;
+ }
+ arglen = (valptr != NULL && (p = strchr (arg, '=')) != NULL
+ ? p - arg : strlen (arg));
+ if (lstr == 0 || arglen < minlen || strncmp (arg, lstr, arglen) != 0)
+ return 0;
+ else if (valptr == NULL)
+ {
+ *skipptr += 1;
+ return 1;
+ }
+ else if (p != NULL)
+ {
+ *valptr = p+1;
+ *skipptr += 1;
+ return 1;
+ }
+ else if (argv[*skipptr+2] != NULL)
+ {
+ *valptr = argv[*skipptr+2];
+ *skipptr += 2;
+ return 1;
+ }
+ else
+ {
+ return 0;
+ }
+}
+
+/* Make stack traces always identify version + configuration */
+#define main_1 STACK_TRACE_EYE_CATCHER
+
+static DOESNT_RETURN
+main_1 (int argc, char **argv, char **envp, int restart)
+{
+ char stack_bottom_variable;
+ int skip_args = 0;
+ Lisp_Object load_me;
+ int inhibit_window_system;
+#ifdef NeXT
+ extern int malloc_cookie;
+#endif
+
+#if !defined(SYSTEM_MALLOC) && !defined(HAVE_LIBMCHECK)
+ /* 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, */
+ /* don't touch them. -slb */
+ __malloc_hook = NULL;
+ __realloc_hook = NULL;
+ __free_hook = NULL;
+#endif /* not SYSTEM_MALLOC */
+
+ noninteractive = 0;
+
+#ifdef NeXT
+ /* 19-Jun-1995 -baw
+ * NeXT secret magic, ripped from Emacs-for-NS by Carl Edman
+ * <cedman@princeton.edu>. Note that even Carl doesn't know what this
+ * does; it was provided by NeXT, and it presumable makes NS's mallocator
+ * work with dumping. But malloc_jumpstart() and malloc_freezedry() in
+ * unexnext.c are both completely undocumented, even in NS header files!
+ * But hey, it solves all NS related memory problems, so who's
+ * complaining? */
+ if (initialized && malloc_jumpstart (malloc_cookie) != 0)
+ fprintf (stderr, "malloc jumpstart failed!\n");
+#endif /* NeXT */
+
+ /*
+#if defined (GNU_MALLOC) && \
+ defined (ERROR_CHECK_MALLOC) && \
+ !defined (HAVE_LIBMCHECK)
+ */
+#if defined(LOSING_GCC_DESTRUCTOR_FREE_BUG)
+ /* Prior to XEmacs 21, this was `#if 0'ed out. */
+ /* I'm enabling this because it is the only reliable way I've found to */
+ /* prevent a very annoying problem where GCC will attempt to free(3) */
+ /* memory at exit() and cause a coredump. */
+ init_free_hook ();
+#endif
+
+ sort_args (argc, argv);
+
+ /* Map in shared memory, if we are using that. */
+#ifdef HAVE_SHM
+ if (argmatch (argv, argc, "-nl", "--no-shared-memory", 6, NULL, &skip_args))
+ {
+ map_in_data (0);
+ /* The shared memory was just restored, which clobbered this. */
+ skip_args = 1;
+ }
+ else
+ {
+ map_in_data (1);
+ /* The shared memory was just restored, which clobbered this. */
+ skip_args = 0;
+ }
+#endif /* HAVE_SHM */
+
+#if (defined (MSDOS) && defined (EMX)) || defined (WIN32) || defined (_SCO_DS)
+ environ = envp;
+#endif
+
+ /* Record (approximately) where the stack begins. */
+ stack_bottom = &stack_bottom_variable;
+
+#ifdef USG_SHARED_LIBRARIES
+ if (bss_end)
+ brk ((void *) bss_end);
+#endif
+
+ 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 ();
+#endif
+
+#ifdef HAVE_SOCKS
+ if (initialized)
+ SOCKSinit (argv[0]);
+#endif /* HAVE_SOCKS */
+
+#ifndef SYSTEM_MALLOC
+ if (!initialized)
+ /* Arrange to get warning messages as memory fills up. */
+ memory_warnings (0, malloc_warning);
+#endif /* not SYSTEM_MALLOC */
+
+#ifdef MSDOS
+ /* We do all file input/output as binary files. When we need to translate
+ newlines, we do that manually. */
+ _fmode = O_BINARY;
+ (stdin) ->_flag &= ~_IOTEXT;
+ (stdout)->_flag &= ~_IOTEXT;
+ (stderr)->_flag &= ~_IOTEXT;
+#endif /* MSDOS */
+
+#ifdef SET_EMACS_PRIORITY
+ if (emacs_priority != 0)
+ nice (-emacs_priority);
+ setuid (getuid ());
+#endif /* SET_EMACS_PRIORITY */
+
+#ifdef EXTRA_INITIALIZE
+ EXTRA_INITIALIZE;
+#endif
+
+#ifdef HAVE_WINDOW_SYSTEM
+ inhibit_window_system = 0;
+#else
+ inhibit_window_system = 1;
+#endif
+
+ /* Handle the -t switch, which specifies filename to use as terminal */
+ {
+ char *term;
+ if (argmatch (argv, argc, "-t", "--terminal", 4, &term, &skip_args))
+ {
+ close (0);
+ close (1);
+ if (open (term, O_RDWR | OPEN_BINARY, 2) < 0)
+ fatal ("%s: %s", term, strerror (errno));
+ dup (0);
+ if (! isatty (0))
+ fatal ("%s: not a tty", term);
+
+#if 0
+ stderr_out ("Using %s", ttyname (0));
+#endif
+ stderr_out ("Using %s", term);
+ inhibit_window_system = 1; /* -t => -nw */
+ }
+ }
+
+ /* Handle -nw switch */
+ if (argmatch (argv, argc, "-nw", "--no-windows", 6, NULL, &skip_args))
+ inhibit_window_system = 1;
+
+ /* Handle the -batch switch, which means don't do interactive display. */
+ if (argmatch (argv, argc, "-batch", "--batch", 5, NULL, &skip_args))
+ {
+#if 0 /* I don't think this is correct. */
+ inhibit_autoloads = 1;
+#endif
+ noninteractive = 1;
+ }
+
+ if (argmatch (argv, argc, "-debug-paths", "--debug-paths",
+ 11, NULL, &skip_args))
+ debug_paths = 1;
+
+ /* Partially handle -no-autoloads, -no-early-packages and -vanilla. Packages */
+ /* are searched prior to the rest of the command line being parsed in */
+ /* startup.el */
+ if (argmatch (argv, argc, "-no-early-packages", "--no-early-packages",
+ 6, NULL, &skip_args))
+ {
+ inhibit_early_packages = 1;
+ skip_args--;
+ }
+ if (argmatch (argv, argc, "-vanilla", "--vanilla",
+ 7, NULL, &skip_args))
+ {
+ inhibit_early_packages = 1;
+ skip_args--;
+ }
+
+ if (argmatch (argv, argc, "-no-autoloads", "--no-autoloads",
+ 7, NULL, &skip_args))
+ {
+ /* Inhibit everything */
+ inhibit_autoloads = 1;
+ skip_args--;
+ }
+
+ if (argmatch (argv, argc, "-debug-paths", "--debug-paths",
+ 6, NULL, &skip_args))
+ {
+ debug_paths = 1;
+ skip_args--;
+ }
+
+
+ /* Partially handle the -version and -help switches: they imply -batch,
+ but are not removed from the list. */
+ if (argmatch (argv, argc, "-help", "--help", 3, NULL, &skip_args))
+ noninteractive = 1, skip_args--;
+
+ if (argmatch (argv, argc, "-version", "--version", 3, NULL, &skip_args) ||
+ argmatch (argv, argc, "-V", 0, 2, NULL, &skip_args))
+ noninteractive = 1, skip_args--;
+
+ /* Now, figure out which type of console is our first console. */
+
+ display_arg = 0;
+
+ if (noninteractive)
+ display_use = "stream";
+ else
+ display_use = "tty";
+
+#ifndef HAVE_TTY
+ if (inhibit_window_system)
+ fatal ("Sorry, this XEmacs was not compiled with TTY support");
+#endif
+
+#ifdef HAVE_WINDOW_SYSTEM
+ /* Stupid kludge to catch command-line display spec. We can't
+ handle this argument entirely in window-system-dependent code
+ because we don't even know which window-system-dependent code
+ to run until we've recognized this argument. */
+ if (!inhibit_window_system && !noninteractive)
+ {
+#ifdef HAVE_X_WINDOWS
+ char *dpy = 0;
+ int count_before = skip_args;
+
+ if (argmatch (argv, argc, "-d", "--display", 3, &dpy, &skip_args) ||
+ argmatch (argv, argc, "-display", 0, 3, &dpy, &skip_args))
+ {
+ display_arg = 1;
+ display_use = "x";
+ }
+ /* If we have the form --display=NAME,
+ convert it into -d name.
+ This requires inserting a new element into argv. */
+ if (dpy != 0 && skip_args - count_before == 1)
+ {
+ char **new = (char **) xmalloc (sizeof (char *) * (argc + 2));
+ int j;
+
+ for (j = 0; j < count_before + 1; j++)
+ new[j] = argv[j];
+ new[count_before + 1] = "-d";
+ new[count_before + 2] = dpy;
+ for (j = count_before + 2; j <argc; j++)
+ new[j + 1] = argv[j];
+ argv = new;
+ argc++;
+ }
+ /* Change --display to -d, when its arg is separate. */
+ else if (dpy != 0 && skip_args > count_before
+ && argv[count_before + 1][1] == '-')
+ argv[count_before + 1] = "-d";
+
+ /* Don't actually discard this arg. */
+ skip_args = count_before;
+
+ /* If there is a non-empty environment var DISPLAY, set
+ `display_use', but not `display_arg', which is only to be set
+ if the display was specified on the command line. */
+ if ((dpy = getenv ("DISPLAY")) && dpy[0])
+ display_use = "x";
+
+#endif /* HAVE_X_WINDOWS */
+#ifdef HAVE_MS_WINDOWS
+ if (strcmp(display_use, "x") != 0)
+ display_use = "mswindows";
+#endif /* HAVE_MS_WINDOWS */
+ }
+#endif /* HAVE_WINDOW_SYSTEM */
+
+ noninteractive1 = noninteractive;
+
+ /****** Now initialize everything *******/
+
+ /* First, do really basic environment initialization -- catching signals
+ and the like. These functions have no dependence on any part of
+ the Lisp engine and need to be done both at dump time and at run time. */
+
+ init_signals_very_early ();
+ init_data_very_early (); /* Catch math errors. */
+#ifdef LISP_FLOAT_TYPE
+ init_floatfns_very_early (); /* Catch floating-point math errors. */
+#endif
+ init_process_times_very_early (); /* Initialize our process timers.
+ As early as possible, of course,
+ so we can be fairly accurate. */
+ init_intl_very_early (); /* set up the locale and domain for gettext and
+ such. */
+
+ /* Now initialize the Lisp engine and the like. Done only during
+ dumping. No dependence on anything that may be in the user's
+ environment when the dumped XEmacs is run.
+
+ We try to do things in an order that minimizes the non-obvious
+ dependencies between functions. */
+
+ if (!initialized)
+ {
+ /* Initialize things so that new Lisp objects
+ can be created and objects can be staticpro'd.
+ Must be basically the very first thing done
+ because pretty much all of the initialization
+ routines below create new objects. */
+ init_alloc_once_early ();
+
+ /* Initialize Qnil, Qt, Qunbound, and the
+ obarray. After this, symbols can be
+ interned. This depends on init_alloc_once(). */
+ init_symbols_once_early ();
+
+ /* Declare the basic symbols pertaining to errors,
+ So that deferror() can be called. */
+ init_errors_once_early ();
+
+ /* Make sure that opaque pointers can be created. */
+ init_opaque_once_early ();
+
+ /* Now declare all the symbols and define all the Lisp primitives.
+
+ The *only* thing that the syms_of_*() functions are allowed to do
+ is call one of the following three functions:
+
+ defsymbol()
+ defsubr() (i.e. DEFSUBR)
+ deferror()
+ defkeyword()
+
+ Order does not matter in these functions.
+ */
+
+ syms_of_abbrev ();
+ syms_of_alloc ();
+#ifdef HAVE_X_WINDOWS
+ syms_of_balloon_x ();
+#endif
+ syms_of_buffer ();
+ syms_of_bytecode ();
+ syms_of_callint ();
+ syms_of_callproc ();
+ syms_of_casefiddle ();
+ syms_of_casetab ();
+ syms_of_chartab ();
+ syms_of_cmdloop ();
+ syms_of_cmds ();
+ syms_of_console ();
+ syms_of_data ();
+#ifdef DEBUG_XEMACS
+ syms_of_debug ();
+#endif /* DEBUG_XEMACS */
+ syms_of_device ();
+#ifdef HAVE_DIALOGS
+ syms_of_dialog ();
+#endif
+ syms_of_dired ();
+#ifdef HAVE_SHLIB
+ syms_of_dll ();
+#endif
+ syms_of_doc ();
+ syms_of_editfns ();
+ syms_of_elhash ();
+ syms_of_emacs ();
+ syms_of_eval ();
+#ifdef HAVE_DRAGNDROP
+ syms_of_dragdrop ();
+#endif
+ syms_of_event_stream ();
+ syms_of_events ();
+ syms_of_extents ();
+ syms_of_faces ();
+ syms_of_fileio ();
+#ifdef CLASH_DETECTION
+ syms_of_filelock ();
+#endif /* CLASH_DETECTION */
+ syms_of_floatfns ();
+ syms_of_fns ();
+ syms_of_font_lock ();
+ syms_of_frame ();
+ syms_of_general ();
+ syms_of_glyphs ();
+ syms_of_glyphs_eimage ();
+#if defined (HAVE_MENUBARS) || defined (HAVE_SCROLLBARS) || defined (HAVE_DIALOGS) || defined (HAVE_TOOLBARS)
+ syms_of_gui ();
+#endif
+ syms_of_indent ();
+ syms_of_intl ();
+ syms_of_keymap ();
+ syms_of_lread ();
+ syms_of_macros ();
+ syms_of_marker ();
+ syms_of_md5 ();
+#ifdef HAVE_DATABASE
+ syms_of_database ();
+#endif
+#ifdef HAVE_MENUBARS
+ syms_of_menubar ();
+#endif
+ syms_of_minibuf ();
+ syms_of_objects ();
+ syms_of_print ();
+#if !defined (NO_SUBPROCESSES)
+ syms_of_process ();
+#ifdef HAVE_WIN32_PROCESSES
+ syms_of_process_nt ();
+#endif
+#endif
+ syms_of_profile ();
+#if defined (HAVE_MMAP) && defined (REL_ALLOC) && !defined(DOUG_LEA_MALLOC)
+ syms_of_ralloc ();
+#endif /* HAVE_MMAP && REL_ALLOC */
+ syms_of_rangetab ();
+ syms_of_redisplay ();
+ syms_of_search ();
+ syms_of_signal ();
+ syms_of_sound ();
+ syms_of_specifier ();
+ syms_of_symbols ();
+ syms_of_syntax ();
+#ifdef HAVE_SCROLLBARS
+ syms_of_scrollbar ();
+#endif
+#ifdef HAVE_TOOLBARS
+ syms_of_toolbar ();
+#endif
+ syms_of_undo ();
+ syms_of_widget ();
+ syms_of_window ();
+
+#ifdef HAVE_TTY
+ syms_of_console_tty ();
+ syms_of_device_tty ();
+ syms_of_objects_tty ();
+#endif
+#ifdef HAVE_X_WINDOWS
+ syms_of_device_x ();
+#ifdef HAVE_DIALOGS
+ syms_of_dialog_x ();
+#endif
+ syms_of_event_Xt ();
+ syms_of_frame_x ();
+ syms_of_glyphs_x ();
+ syms_of_objects_x ();
+#ifdef HAVE_MENUBARS
+ syms_of_menubar_x ();
+#endif
+ syms_of_xselect ();
+#if defined (HAVE_MENUBARS) || defined (HAVE_SCROLLBARS) || defined (HAVE_DIALOGS) || defined (HAVE_TOOLBARS)
+ syms_of_gui_x ();
+#endif
+#endif /* HAVE_X_WINDOWS */
+
+#ifdef HAVE_MS_WINDOWS
+ syms_of_console_mswindows ();
+ syms_of_device_mswindows ();
+ syms_of_event_mswindows ();
+ syms_of_frame_mswindows ();
+ syms_of_objects_mswindows ();
+ syms_of_select_mswindows ();
+ syms_of_glyphs_mswindows ();
+#ifdef HAVE_MENUBARS
+ syms_of_menubar_mswindows ();
+#endif
+#ifdef HAVE_SCROLLBARS
+ syms_of_scrollbar_mswindows ();
+#endif
+#ifdef HAVE_MSW_C_DIRED
+ syms_of_dired_mswindows ();
+#endif
+#endif /* HAVE_MS_WINDOWS */
+
+#ifdef MULE
+ syms_of_mule ();
+ syms_of_mule_ccl ();
+ syms_of_mule_charset ();
+#endif
+#ifdef FILE_CODING
+ syms_of_mule_coding ();
+#endif
+#ifdef MULE
+#ifdef HAVE_WNN
+ syms_of_mule_wnn ();
+#endif
+#ifdef HAVE_CANNA
+ syms_of_mule_canna ();
+#endif /* HAVE_CANNA */
+#endif /* MULE */
+
+#ifdef SYMS_SYSTEM
+ SYMS_SYSTEM;
+#endif
+
+#ifdef SYMS_MACHINE
+ SYMS_MACHINE;
+#endif
+
+#ifdef EMACS_BTL
+ syms_of_btl ();
+#endif
+
+ /*
+#if defined (GNU_MALLOC) && \
+ defined (ERROR_CHECK_MALLOC) && \
+ !defined (HAVE_LIBMCHECK)
+ */
+ /* Prior to XEmacs 21, this was `#if 0'ed out. -slb */
+#if defined (LOSING_GCC_DESTRUCTOR_FREE_BUG)
+ syms_of_free_hook ();
+#endif
+
+#ifdef TOOLTALK
+ syms_of_tooltalk ();
+#endif
+
+#ifdef SUNPRO
+ syms_of_sunpro ();
+#endif
+
+#ifdef HAVE_LDAP
+ syms_of_eldap ();
+#endif
+
+ /* Now create the subtypes for the types that have them.
+ We do this before the vars_*() because more symbols
+ may get initialized here. */
+
+ /* Now initialize the console types and associated symbols.
+ Other than the first function below, the functions may
+ make exactly the following function/macro calls:
+
+ INITIALIZE_CONSOLE_TYPE()
+ CONSOLE_HAS_METHOD()
+
+ For any given console type, the former macro must be called
+ before the any calls to the latter macro. */
+
+ console_type_create ();
+
+ console_type_create_stream ();
+
+#ifdef HAVE_TTY
+ console_type_create_tty ();
+ console_type_create_device_tty ();
+ console_type_create_frame_tty ();
+ console_type_create_objects_tty ();
+ console_type_create_redisplay_tty ();
+#endif
+
+#ifdef HAVE_X_WINDOWS
+ console_type_create_x ();
+ console_type_create_device_x ();
+ console_type_create_frame_x ();
+ console_type_create_glyphs_x ();
+#ifdef HAVE_MENUBARS
+ console_type_create_menubar_x ();
+#endif
+ console_type_create_objects_x ();
+ console_type_create_redisplay_x ();
+#ifdef HAVE_SCROLLBARS
+ console_type_create_scrollbar_x ();
+#endif
+#ifdef HAVE_TOOLBARS
+ console_type_create_toolbar_x ();
+#endif
+#ifdef HAVE_DIALOGS
+ console_type_create_dialog_x ();
+#endif
+#endif /* HAVE_X_WINDOWS */
+
+#ifdef HAVE_MS_WINDOWS
+ console_type_create_mswindows ();
+ console_type_create_device_mswindows ();
+ console_type_create_frame_mswindows ();
+ console_type_create_objects_mswindows ();
+ console_type_create_redisplay_mswindows ();
+ console_type_create_glyphs_mswindows ();
+# ifdef HAVE_SCROLLBARS
+ console_type_create_scrollbar_mswindows ();
+# endif
+#ifdef HAVE_MENUBARS
+ console_type_create_menubar_mswindows ();
+#endif
+#ifdef HAVE_TOOLBARS
+ console_type_create_toolbar_mswindows ();
+#endif
+#ifdef HAVE_DIALOGS
+ console_type_create_dialog_mswindows ();
+#endif
+#endif
+
+ /* Now initialize the specifier types and associated symbols.
+ Other than the first function below, the functions may
+ make exactly the following function/macro calls:
+
+ INITIALIZE_SPECIFIER_TYPE()
+ SPECIFIER_HAS_METHOD()
+
+ For any given specifier type, the former macro must be called
+ before the any calls to the latter macro. */
+
+ specifier_type_create ();
+
+ specifier_type_create_image ();
+ specifier_type_create_objects ();
+#ifdef HAVE_TOOLBARS
+ specifier_type_create_toolbar ();
+#endif
+
+ /* Now initialize the structure types and associated symbols.
+ Other than the first function below, the functions may
+ make exactly the following function/macro calls:
+
+ define_structure_type()
+ define_structure_type_keyword()
+
+ */
+
+ structure_type_create ();
+
+ structure_type_create_chartab ();
+ structure_type_create_faces ();
+ structure_type_create_rangetab ();
+ structure_type_create_hashtable ();
+
+ /* Now initialize the image instantiator formats and associated symbols.
+ Other than the first function below, the functions may
+ make exactly the following function/macro calls:
+
+ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT()
+ IIFORMAT_HAS_METHOD()
+ IIFORMAT_VALID_KEYWORD()
+
+ For any given image instantiator format, the first macro must be
+ called before the any calls to the other macros. */
+
+ image_instantiator_format_create ();
+ image_instantiator_format_create_glyphs_eimage ();
+#ifdef HAVE_X_WINDOWS
+ image_instantiator_format_create_glyphs_x ();
+#endif /* HAVE_X_WINDOWS */
+#ifdef HAVE_MS_WINDOWS
+ image_instantiator_format_create_glyphs_mswindows ();
+#endif /* HAVE_MSWINDOWS_WINDOWS */
+
+ /* Now initialize the lstream types and associated symbols.
+ Other than the first function below, the functions may
+ make exactly the following function/macro calls:
+
+ LSTREAM_HAS_METHOD()
+
+ */
+
+ lstream_type_create ();
+#ifdef FILE_CODING
+ lstream_type_create_mule_coding ();
+#endif
+#if defined (HAVE_MS_WINDOWS) && !defined(HAVE_MSG_SELECT)
+ lstream_type_create_mswindows_selectable ();
+#endif
+
+ /* Initialize processes implementation.
+ The functions may make exactly the following function/macro calls:
+
+ PROCESS_HAS_METHOD()
+ */
+#ifdef HAVE_UNIX_PROCESSES
+ process_type_create_unix ();
+#endif
+#ifdef HAVE_WIN32_PROCESSES
+ process_type_create_nt ();
+#endif
+
+ /* Now initialize most variables.
+
+ These functions may do exactly the following:
+
+ DEFVAR_INT()
+ DEFVAR_LISP()
+ DEFVAR_BOOL()
+ DEFER_GETTEXT()
+ Dynarr_*()
+ Blocktype_*()
+ staticpro()
+ Fprovide(symbol)
+ intern()
+ pure_put()
+ xmalloc()
+ defsymbol(), if it's absolutely necessary and you're sure that
+ the symbol isn't referenced anywhere else in the initialization
+ code
+ Fset() on a symbol that is unbound
+ assigning a symbol or constant value to a variable
+ using a global variable that has been initialized
+ earlier on in the same function
+
+ Any of the object-creating functions on alloc.c: e.g.
+
+ make_pure_*()
+ Fpurecopy()
+ make_string()
+ build_string()
+ make_vector()
+ make_int()
+ make_extent()
+ alloc_lcrecord()
+ Fcons()
+ listN()
+ make_opaque_ptr()
+ make_opaque_long()
+
+ perhaps a few others.
+ */
+
+ /* Now allow Fprovide() statements to be made. */
+ init_provide_once ();
+
+ 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_cmdloop ();
+ vars_of_cmds ();
+ vars_of_console ();
+ vars_of_data ();
+#ifdef DEBUG_XEMACS
+ vars_of_debug ();
+#endif
+ vars_of_console_stream ();
+ vars_of_device ();
+#ifdef HAVE_DIALOGS
+ vars_of_dialog ();
+#endif
+ vars_of_dired ();
+ vars_of_doc ();
+#ifdef HAVE_DRAGNDROP
+ vars_of_dragdrop ();
+#endif
+ vars_of_editfns ();
+ vars_of_elhash ();
+ vars_of_emacs ();
+ vars_of_eval ();
+ vars_of_event_stream ();
+ vars_of_events ();
+ vars_of_extents ();
+ vars_of_faces ();
+ vars_of_fileio ();
+#ifdef CLASH_DETECTION
+ vars_of_filelock ();
+#endif
+ vars_of_floatfns ();
+ vars_of_font_lock ();
+ vars_of_frame ();
+ vars_of_glyphs ();
+ vars_of_glyphs_eimage ();
+#if defined (HAVE_MENUBARS) || defined (HAVE_SCROLLBARS) || defined (HAVE_DIALOGS) || defined (HAVE_TOOLBARS)
+ vars_of_gui ();
+#endif
+ vars_of_indent ();
+ vars_of_insdel ();
+ vars_of_intl ();
+#ifdef HAVE_XIM
+#ifdef XIM_MOTIF
+ vars_of_input_method_motif ();
+#else /* XIM_XLIB */
+ vars_of_input_method_xlib ();
+#endif
+#endif /* HAVE_XIM */
+ vars_of_keymap ();
+ vars_of_lread ();
+ vars_of_lstream ();
+ vars_of_macros ();
+ vars_of_md5 ();
+#ifdef HAVE_DATABASE
+ vars_of_database ();
+#endif
+#ifdef HAVE_MENUBARS
+ vars_of_menubar ();
+#endif
+ vars_of_minibuf ();
+ vars_of_objects ();
+ vars_of_print ();
+
+#ifndef NO_SUBPROCESSES
+ vars_of_process ();
+#ifdef HAVE_UNIX_PROCESSES
+ vars_of_process_unix ();
+#endif
+#ifdef HAVE_WIN32_PROCESSES
+ vars_of_process_nt ();
+#endif
+#endif
+
+ vars_of_profile ();
+#if defined (HAVE_MMAP) && defined (REL_ALLOC) && !defined(DOUG_LEA_MALLOC)
+ vars_of_ralloc ();
+#endif /* HAVE_MMAP && REL_ALLOC */
+ vars_of_redisplay ();
+#ifdef HAVE_SCROLLBARS
+ vars_of_scrollbar ();
+#endif
+ vars_of_search ();
+ vars_of_sound ();
+ vars_of_specifier ();
+ vars_of_symbols ();
+ vars_of_syntax ();
+#ifdef HAVE_TOOLBARS
+ vars_of_toolbar ();
+#endif
+ vars_of_undo ();
+ vars_of_window ();
+
+#ifdef HAVE_TTY
+ vars_of_console_tty ();
+ vars_of_event_tty ();
+ vars_of_frame_tty ();
+ vars_of_objects_tty ();
+#endif
+
+#ifdef HAVE_X_WINDOWS
+ vars_of_device_x ();
+#ifdef HAVE_DIALOGS
+ vars_of_dialog_x ();
+#endif
+ vars_of_event_Xt ();
+ vars_of_frame_x ();
+ vars_of_glyphs_x ();
+#ifdef HAVE_MENUBARS
+ vars_of_menubar_x ();
+#endif
+ vars_of_objects_x ();
+ vars_of_xselect ();
+#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
+
+#ifdef HAVE_MS_WINDOWS
+ vars_of_device_mswindows ();
+ vars_of_console_mswindows ();
+ vars_of_event_mswindows ();
+ vars_of_frame_mswindows ();
+ vars_of_objects_mswindows ();
+ vars_of_select_mswindows ();
+ vars_of_glyphs_mswindows ();
+#ifdef HAVE_SCROLLBARS
+ vars_of_scrollbar_mswindows ();
+#endif
+#ifdef HAVE_MENUBARS
+ vars_of_menubar_mswindows ();
+#endif
+#ifdef HAVE_MSW_C_DIRED
+ vars_of_dired_mswindows ();
+#endif
+#ifdef HAVE_DIALOGS
+ vars_of_dialog_mswindows ();
+#endif
+#endif /* HAVE_MS_WINDOWS */
+
+#ifdef MULE
+ vars_of_mule ();
+ vars_of_mule_charset ();
+#endif
+#ifdef FILE_CODING
+ vars_of_mule_coding ();
+#endif
+#ifdef MULE
+#ifdef HAVE_WNN
+ vars_of_mule_wnn ();
+#endif
+#ifdef HAVE_CANNA
+ vars_of_mule_canna ();
+#endif /* HAVE_CANNA */
+#endif /* MULE */
+
+#ifdef TOOLTALK
+ vars_of_tooltalk ();
+#endif
+
+#ifdef SUNPRO
+ vars_of_sunpro ();
+#endif
+
+#ifdef HAVE_LDAP
+ vars_of_eldap ();
+#endif
+
+ /* Now initialize any specifier variables. We do this later
+ because it has some dependence on the vars initialized
+ above.
+
+ These functions should *only* initialize specifier variables,
+ and may make use of the following functions/macros in addition
+ to the ones listed above:
+
+ DEFVAR_SPECIFIER()
+ Fmake_specifier()
+ set_specifier_fallback()
+ set_specifier_caching()
+ */
+
+ specifier_vars_of_glyphs ();
+#ifdef HAVE_MENUBARS
+ specifier_vars_of_menubar ();
+#endif
+ specifier_vars_of_redisplay ();
+#ifdef HAVE_SCROLLBARS
+ specifier_vars_of_scrollbar ();
+#endif
+#ifdef HAVE_TOOLBARS
+ specifier_vars_of_toolbar ();
+#endif
+ specifier_vars_of_window ();
+
+ /* Now comes all the rest of the variables that couldn't
+ be handled above. There may be dependencies on variables
+ initialized above, and dependencies between one complex_vars_()
+ function and another. */
+
+ /* Calls Fmake_range_table(). */
+ complex_vars_of_regex ();
+ /* Calls Fmake_range_table(). */
+ complex_vars_of_search ();
+
+ /* Calls make_lisp_hashtable(). */
+ complex_vars_of_extents ();
+
+ /* Depends on hashtables and specifiers. */
+ complex_vars_of_faces ();
+
+#ifdef MULE
+ /* These two depend on hashtables and various variables declared
+ earlier. The second may also depend on the first. */
+ complex_vars_of_mule_charset ();
+#endif
+#if defined(FILE_CODING)
+ complex_vars_of_mule_coding ();
+#endif
+
+ /* This calls allocate_glyph(), which creates specifiers
+ and also relies on a variable (Vthe_nothing_vector) initialized
+ above. It also calls make_ext_string(), which under Mule
+ could require that the charsets be initialized. */
+ complex_vars_of_glyphs ();
+
+ /* These rely on the glyphs just created in the previous function,
+ and call Fadd_spec_to_specifier(), which relies on various
+ variables initialized above. */
+#ifdef HAVE_X_WINDOWS
+ complex_vars_of_glyphs_x ();
+#endif
+#ifdef HAVE_MS_WINDOWS
+ complex_vars_of_glyphs_mswindows ();
+#endif
+
+ /* This calls Fmake_glyph_internal(). */
+ complex_vars_of_alloc ();
+
+ /* This calls Fmake_glyph_internal(). */
+#ifdef HAVE_MENUBARS
+ complex_vars_of_menubar ();
+#endif
+
+ /* This calls Fmake_glyph_internal(). */
+#ifdef HAVE_SCROLLBARS
+ complex_vars_of_scrollbar ();
+#endif
+
+ /* This calls allocate_glyph(). */
+ complex_vars_of_frame ();
+
+ /* This calls Fcopy_category_table() under Mule, which calls who
+ knows what. */
+ complex_vars_of_chartab ();
+
+ /* This calls set_string_char(), which (under Mule) depends on the
+ charsets being initialized. */
+ complex_vars_of_casetab ();
+
+ /* This calls Fcopy_syntax_table(), which relies on char tables. */
+ complex_vars_of_syntax ();
+
+ /* This initializes buffer-local variables, sets things up so
+ that buffers can be created, and creates a couple of basic
+ buffers. This depends on Vstandard_syntax_table and
+ Vstandard_category_table (initialized in the previous
+ functions), as well as a whole horde of variables that may
+ have been initialized above. */
+ complex_vars_of_buffer ();
+
+ /* This initializes console-local variables. */
+ complex_vars_of_console ();
+
+ /* This creates a couple more buffers, and depends on the
+ previous function. */
+ complex_vars_of_minibuf ();
+
+ /* These two might call Ffile_name_as_directory(), which
+ might depend on all sorts of things; I'm not sure. */
+ complex_vars_of_emacs ();
+
+#ifdef CLASH_DETECTION
+ complex_vars_of_filelock ();
+#endif /* CLASH_DETECTION */
+
+ /* This creates a couple of basic keymaps and depends on Lisp
+ hashtables and Ffset() (both of which depend on some variables
+ initialized in the vars_of_*() section) and possibly other
+ stuff. */
+ complex_vars_of_keymap ();
+ /* Calls Fmake_hashtable() and creates a keymap */
+ complex_vars_of_event_stream ();
+
+ if (always_gc) /* purification debugging hack */
+ garbage_collect_1 ();
+ }
+
+ /* CONGRATULATIONS!!! We have successfully initialized the Lisp
+ engine. */
+
+ if (initialized)
+ {
+ /* Stuff that needs to be reset at run time. Order below should
+ not matter. */
+ reinit_alloc ();
+ reinit_eval ();
+#ifdef MULE_REGEXP
+ reinit_mule_category ();
+#endif
+ }
+
+ /* Now do further initialization/setup of stuff that is not needed by the
+ syms_of_() routines. This involves stuff that only is enabled in
+ an interactive run (redisplay, user input, etc.) and stuff that is
+ not needed until we start loading Lisp code (the reader). A lot
+ of this stuff involves querying the current environment and needs
+ to be done both at dump time and at run time. */
+
+ init_initial_directory(); /* get the directory to use for the
+ "*scratch*" buffer, etc. */
+
+#ifdef WINDOWSNT
+ /*
+ * For Win32, call init_environment() now, so that environment/registry
+ * variables will be properly entered into Vprocess_envonment.
+ */
+ init_environment();
+#endif
+
+ init_callproc (); /* Set up the process environment (so that egetenv
+ works), the basic directory variables
+ (exec-directory and so on), and stuff
+ related to subprocesses. This should be
+ first because many of the functions below
+ call egetenv() to get environment variables. */
+ init_lread (); /* Set up the Lisp reader. */
+#ifdef MSDOS
+ /* Call early 'cause init_environment needs it. */
+ init_dosfns ();
+ /* Set defaults for several environment variables. */
+ init_environment (argc, argv, skip_args);
+#endif
+ init_cmdargs (argc, argv, skip_args); /* Create list Vcommand_line_args */
+ init_buffer (); /* Set default directory of *scratch* buffer */
+
+#ifdef WINDOWSNT
+ init_ntproc();
+#endif
+
+ init_redisplay (); /* Determine terminal type.
+ init_sys_modes uses results */
+ 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 */
+ init_xemacs_process (); /* set up for calling subprocesses */
+#ifdef SUNPRO
+ init_sunpro (); /* Set up Sunpro usage tracking */
+#endif
+#if defined (HAVE_NATIVE_SOUND) && defined (hp9000s800)
+ init_hpplay ();
+#endif
+#ifdef HAVE_TTY
+ init_device_tty ();
+#endif
+ init_console_stream (); /* Create the first console */
+
+ /* try to get the actual pathname of the exec file we are running */
+ if (!restart)
+ {
+ Vinvocation_name = Fcar (Vcommand_line_args);
+ if (XSTRING_DATA(Vinvocation_name)[0] == '-')
+ {
+ /* XEmacs as a login shell, oh goody! */
+ Vinvocation_name = build_string(getenv("SHELL"));
+ }
+ Vinvocation_directory = Vinvocation_name;
+
+ if (!NILP (Ffile_name_directory (Vinvocation_name)))
+ {
+ /* invocation-name includes a directory component -- presumably it
+ is relative to cwd, not $PATH */
+ Vinvocation_directory = Fexpand_file_name (Vinvocation_name,
+ Qnil);
+ Vinvocation_path = Qnil;
+ }
+ else
+ {
+ Vinvocation_path = decode_env_path ("PATH", NULL);
+ locate_file (Vinvocation_path, Vinvocation_name, EXEC_SUFFIXES,
+ &Vinvocation_directory, X_OK);
+ }
+
+ if (NILP (Vinvocation_directory))
+ Vinvocation_directory = Vinvocation_name;
+
+ Vinvocation_name = Ffile_name_nondirectory (Vinvocation_directory);
+ Vinvocation_directory = Ffile_name_directory (Vinvocation_directory);
+ }
+
+#if defined(HAVE_SHLIB) && !defined(WINDOWSNT)
+ /* This is Unix only. MS Windows NT has a library call that does
+ The Right Thing on that system. Rumor has it, this must be
+ called for GNU dld in temacs and xemacs. */
+ {
+ char *buf = (char *)alloca (XSTRING_LENGTH (Vinvocation_directory)
+ + XSTRING_LENGTH (Vinvocation_name)
+ + 2);
+ sprintf (buf, "%s/%s", XSTRING_DATA(Vinvocation_directory),
+ XSTRING_DATA(Vinvocation_name));
+
+ /* All we can do is cry if an error happens, so ignore it. */
+ (void)dll_init(buf);
+ }
+#endif
+
+#if defined (LOCALTIME_CACHE) && defined (HAVE_TZSET)
+ /* sun's localtime() has a bug. it caches the value of the time
+ zone rather than looking it up every time. Since localtime() is
+ called to bolt the undumping time into the undumped emacs, this
+ results in localtime() ignoring the TZ environment variable.
+ This flushes the new TZ value into localtime(). */
+ tzset ();
+#endif /* LOCALTIME_CACHE and TZSET */
+
+ load_me = Qnil;
+ if (!initialized)
+ {
+ /* Handle -l loadup-and-dump, args passed by Makefile. */
+ if (argc > 2 + skip_args && !strcmp (argv[1 + skip_args], "-l"))
+ load_me = build_string (argv[2 + skip_args]);
+#if 0 /* CANNOT_DUMP - this can never be right in XEmacs --andyp */
+ /* Unless next switch is -nl, load "loadup.el" first thing. */
+ if (!(argc > 1 + skip_args && !strcmp (argv[1 + skip_args], "-nl")))
+ load_me = build_string ("loadup.el");
+#endif /* CANNOT_DUMP */
+ }
+
+#ifdef QUANTIFY
+ if (initialized)
+ quantify_start_recording_data ();
+#endif /* QUANTIFY */
+
+ initialized = 1;
+
+ /* This never returns. */
+ initial_command_loop (load_me);
+ /* NOTREACHED */
+}
+
+\f
+/* Sort the args so we can find the most important ones
+ at the beginning of argv. */
+
+/* First, here's a table of all the standard options. */
+
+struct standard_args
+{
+ CONST char * CONST name;
+ CONST char * CONST longname;
+ int priority;
+ int nargs;
+};
+
+static struct standard_args standard_args[] =
+{
+ /* Handled by main_1 above: */
+ { "-nl", "--no-shared-memory", 100, 0 },
+ { "-t", "--terminal", 95, 1 },
+ { "-nw", "--no-windows", 90, 0 },
+ { "-batch", "--batch", 85, 0 },
+ { "-debug-paths", "--debug-paths", 82, 0 },
+ { "-help", "--help", 80, 0 },
+ { "-version", "--version", 75, 0 },
+ { "-V", 0, 75, 0 },
+ { "-d", "--display", 80, 1 },
+ { "-display", 0, 80, 1 },
+ { "-NXHost", 0, 79, 0 },
+ { "-MachLaunch", 0, 79, 0},
+
+ /* Handled by command-line-early in startup.el: */
+ { "-q", "--no-init-file", 50, 0 },
+ { "-unmapped", 0, 50, 0 },
+ { "-no-init-file", 0, 50, 0 },
+ { "-vanilla", "--vanilla", 50, 0 },
+ { "-no-autoloads", "--no-autoloads", 50, 0 },
+ { "-no-site-file", "--no-site-file", 40, 0 },
+ { "-no-early-packages", "--no-early-packages", 35, 0 },
+ { "-u", "--user", 30, 1 },
+ { "-user", 0, 30, 1 },
+ { "-debug-init", "--debug-init", 20, 0 },
+ { "-debug-paths", "--debug-paths", 20, 0 },
+
+ /* Xt options: */
+ { "-i", "--icon-type", 15, 0 },
+ { "-itype", 0, 15, 0 },
+ { "-iconic", "--iconic", 15, 0 },
+ { "-bg", "--background-color", 10, 1 },
+ { "-background", 0, 10, 1 },
+ { "-fg", "--foreground-color", 10, 1 },
+ { "-foreground", 0, 10, 1 },
+ { "-bd", "--border-color", 10, 1 },
+ { "-bw", "--border-width", 10, 1 },
+ { "-ib", "--internal-border", 10, 1 },
+ { "-ms", "--mouse-color", 10, 1 },
+ { "-cr", "--cursor-color", 10, 1 },
+ { "-fn", "--font", 10, 1 },
+ { "-font", 0, 10, 1 },
+ { "-g", "--geometry", 10, 1 },
+ { "-geometry", 0, 10, 1 },
+ { "-T", "--title", 10, 1 },
+ { "-title", 0, 10, 1 },
+ { "-name", "--name", 10, 1 },
+ { "-xrm", "--xrm", 10, 1 },
+ { "-r", "--reverse-video", 5, 0 },
+ { "-rv", 0, 5, 0 },
+ { "-reverse", 0, 5, 0 },
+ { "-hb", "--horizontal-scroll-bars", 5, 0 },
+ { "-vb", "--vertical-scroll-bars", 5, 0 },
+
+ /* These have the same priority as ordinary file name args,
+ so they are not reordered with respect to those. */
+ { "-L", "--directory", 0, 1 },
+ { "-directory", 0, 0, 1 },
+ { "-l", "--load", 0, 1 },
+ { "-load", 0, 0, 1 },
+ { "-f", "--funcall", 0, 1 },
+ { "-funcall", 0, 0, 1 },
+ { "-eval", "--eval", 0, 1 },
+ { "-insert", "--insert", 0, 1 },
+ /* This should be processed after ordinary file name args and the like. */
+ { "-kill", "--kill", -10, 0 },
+};
+
+/* Reorder the elements of ARGV (assumed to have ARGC elements)
+ so that the highest priority ones come first.
+ Do not change the order of elements of equal priority.
+ If an option takes an argument, keep it and its argument together. */
+
+static void
+sort_args (int argc, char **argv)
+{
+ char **new = xnew_array (char *, argc);
+ /* For each element of argv,
+ the corresponding element of options is:
+ 0 for an option that takes no arguments,
+ 1 for an option that takes one argument, etc.
+ -1 for an ordinary non-option argument. */
+ int *options = xnew_array (int, argc);
+ int *priority = xnew_array (int, argc);
+ int to = 1;
+ int from;
+ int i;
+ int end_of_options_p = 0;
+
+ /* Categorize all the options,
+ and figure out which argv elts are option arguments. */
+ for (from = 1; from < argc; from++)
+ {
+ options[from] = -1;
+ priority[from] = 0;
+ /* Pseudo options "--" and "run-temacs" indicate end of options */
+ if (!strcmp (argv[from], "--") ||
+ !strcmp (argv[from], "run-temacs"))
+ end_of_options_p = 1;
+ if (!end_of_options_p && argv[from][0] == '-')
+ {
+ int match, thislen;
+ char *equals;
+
+ /* Look for a match with a known old-fashioned option. */
+ for (i = 0; i < countof (standard_args); i++)
+ if (!strcmp (argv[from], standard_args[i].name))
+ {
+ options[from] = standard_args[i].nargs;
+ priority[from] = standard_args[i].priority;
+ if (from + standard_args[i].nargs >= argc)
+ fatal ("Option `%s' requires an argument\n", argv[from]);
+ from += standard_args[i].nargs;
+ goto done;
+ }
+
+ /* Look for a match with a known long option.
+ MATCH is -1 if no match so far, -2 if two or more matches so far,
+ >= 0 (the table index of the match) if just one match so far. */
+ if (argv[from][1] == '-')
+ {
+ match = -1;
+ thislen = strlen (argv[from]);
+ equals = strchr (argv[from], '=');
+ if (equals != 0)
+ thislen = equals - argv[from];
+
+ for (i = 0; i < countof (standard_args); i++)
+ if (standard_args[i].longname
+ && !strncmp (argv[from], standard_args[i].longname,
+ thislen))
+ {
+ if (match == -1)
+ match = i;
+ else
+ match = -2;
+ }
+
+ /* If we found exactly one match, use that. */
+ if (match >= 0)
+ {
+ options[from] = standard_args[match].nargs;
+ priority[from] = standard_args[match].priority;
+ /* If --OPTION=VALUE syntax is used,
+ this option uses just one argv element. */
+ if (equals != 0)
+ options[from] = 0;
+ if (from + options[from] >= argc)
+ fatal ("Option `%s' requires an argument\n", argv[from]);
+ from += options[from];
+ }
+ }
+ done: ;
+ }
+ }
+
+ /* Copy the arguments, in order of decreasing priority, to NEW. */
+ new[0] = argv[0];
+ while (to < argc)
+ {
+ int best = -1;
+ int best_priority = -9999;
+
+ /* Find the highest priority remaining option.
+ If several have equal priority, take the first of them. */
+ for (from = 1; from < argc; from++)
+ {
+ if (argv[from] != 0 && priority[from] > best_priority)
+ {
+ best_priority = priority[from];
+ best = from;
+ }
+ /* Skip option arguments--they are tied to the options. */
+ if (options[from] > 0)
+ from += options[from];
+ }
+
+ if (best < 0)
+ abort ();
+
+ /* Copy the highest priority remaining option, with its args, to NEW. */
+ new[to++] = argv[best];
+ for (i = 0; i < options[best]; i++)
+ new[to++] = argv[best + i + 1];
+
+ /* Clear out this option in ARGV. */
+ argv[best] = 0;
+ for (i = 0; i < options[best]; i++)
+ argv[best + i + 1] = 0;
+ }
+
+ memcpy (argv, new, sizeof (char *) * argc);
+}
+
+static JMP_BUF run_temacs_catch;
+
+static int run_temacs_argc;
+static char **run_temacs_argv;
+static char *run_temacs_args;
+static size_t run_temacs_argv_size;
+static size_t run_temacs_args_size;
+
+DEFUN ("running-temacs-p", Frunning_temacs_p, 0, 0, 0, /*
+True if running temacs. This means we are in the dumping stage.
+This is false during normal execution of the `xemacs' program, and
+becomes false once `run-emacs-from-temacs' is run.
+*/
+ ())
+{
+ return run_temacs_argc >= 0 ? Qt : Qnil;
+}
+
+DEFUN ("run-emacs-from-temacs", Frun_emacs_from_temacs, 0, MANY, 0, /*
+Do not call this. It will reinitialize your XEmacs. You'll be sorry.
+*/
+/* If this function is called from startup.el, it will be possible to run
+ temacs as an editor using 'temacs -batch -l loadup.el run-temacs', instead
+ of having to dump an emacs and then run that (when debugging emacs itself,
+ this can be much faster)). [Actually, the speed difference isn't that
+ much as long as your filesystem is local, and you don't end up with
+ a dumped version in case you want to rerun it. This function is most
+ useful when used as part of the `make all-elc' command. --ben]
+ This will "restart" emacs with the specified command-line arguments.
+ */
+ (int nargs, Lisp_Object *args))
+{
+ int ac;
+ 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);
+ int *wampum_all_len = alloca_array (int, nargs);
+
+ assert (!gc_in_progress);
+
+ if (run_temacs_argc < 0)
+ error ("I've lost my temacs-hood.");
+
+ /* 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);
+ 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]);
+ 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 *);
+
+ memcpy (run_temacs_args, wampum, namesize);
+ run_temacs_argv [0] = run_temacs_args;
+ for (ac = 0; ac < nargs; ac++)
+ {
+ memcpy (run_temacs_args + namesize,
+ wampum_all[ac], wampum_all_len[ac]);
+ run_temacs_argv [ac + 1] = run_temacs_args + namesize;
+ namesize += wampum_all_len[ac];
+ }
+ run_temacs_argv [nargs + 1] = 0;
+ catchlist = NULL; /* Important! Otherwise free_cons() calls in
+ condition_case_unwind() may lead to GC death. */
+ unbind_to (0, Qnil); /* this closes loadup.el */
+ purify_flag = 0;
+ run_temacs_argc = nargs + 1;
+#ifdef REPORT_PURE_USAGE
+ report_pure_usage (1, 0);
+#else
+ report_pure_usage (0, 0);
+#endif
+ LONGJMP (run_temacs_catch, 1);
+ return Qnil; /* not reached; warning suppression */
+}
+
+/* ARGSUSED */
+int
+main (int argc, char **argv, char **envp)
+{
+ int volatile vol_argc = argc;
+ char ** volatile vol_argv = argv;
+ char ** volatile vol_envp = envp;
+ /* This is hairy. We need to compute where the XEmacs binary was invoked */
+ /* from because temacs initialization requires it to find the lisp */
+ /* directories. The code that recomputes the path is guarded by the */
+ /* restarted flag. There are three possible paths I've found so far */
+ /* through this: */
+ /* temacs -- When running temacs for basic build stuff, the first main_1 */
+ /* will be the only one invoked. It must compute the path else there */
+ /* will be a very ugly bomb in startup.el (can't find obvious location */
+ /* for doc-directory data-directory, etc.). */
+ /* temacs w/ run-temacs on the command line -- This is run to bytecompile */
+ /* all the out of date dumped lisp. It will execute both of the main_1 */
+ /* calls and the second one must not touch the first computation because */
+ /* argc/argv are hosed the second time through. */
+ /* xemacs -- Only the second main_1 is executed. The invocation path must */
+ /* computed but this only matters when running in place or when running */
+ /* as a login shell. */
+ /* As a bonus for straightening this out, XEmacs can now be run in place */
+ /* as a login shell. This never used to work. */
+ /* As another bonus, we can now guarantee that */
+ /* (concat invocation-directory invocation-name) contains the filename */
+ /* of the XEmacs binary we are running. This can now be used in a */
+ /* definite test for out of date dumped files. -slb */
+ int restarted = 0;
+#ifdef QUANTIFY
+ quantify_stop_recording_data ();
+ quantify_clear_data ();
+#endif /* QUANTIFY */
+
+ suppress_early_error_handler_backtrace = 0;
+ lim_data = 0; /* force reinitialization of this variable */
+
+ /* Lisp_Object must fit in a word; check VALBITS and GCTYPEBITS */
+ assert (sizeof (Lisp_Object) == sizeof (void *));
+
+#ifdef LINUX_SBRK_BUG
+ sbrk (1);
+#endif
+
+ if (!initialized)
+ {
+#ifdef DOUG_LEA_MALLOC
+ mallopt (M_MMAP_MAX, 0);
+#endif
+ run_temacs_argc = 0;
+ if (! SETJMP (run_temacs_catch))
+ {
+ main_1 (vol_argc, vol_argv, vol_envp, 0);
+ }
+ /* run-emacs-from-temacs called */
+ restarted = 1;
+ vol_argc = run_temacs_argc;
+ vol_argv = run_temacs_argv;
+#ifdef _SCO_DS
+ /* This makes absolutely no sense to anyone involved. There are
+ several people using this stuff. We've compared versions on
+ everything we can think of. We can find no difference.
+ However, on both my systems environ is a plain old global
+ variable initialized to zero. _environ is the one that
+ contains pointers to the actual environment.
+
+ Since we can't figure out the difference (and we're hours
+ away from a release), this takes a very cowardly approach and
+ is bracketed with both a system specific preprocessor test
+ and a runtime "do you have this problem" test
+
+ 06/20/96 robertl@dgii.com */
+ {
+ extern char *_environ;
+ if ((unsigned) environ == 0)
+ environ=_environ;
+ }
+#endif /* _SCO_DS */
+ vol_envp = environ;
+ }
+#ifdef RUN_TIME_REMAP
+ else
+ /* obviously no-one uses this because where it was before initalized was
+ *always* true */
+ run_time_remap (argv[0]);
+#endif
+
+#ifdef DOUG_LEA_MALLOC
+ if (initialized && (malloc_state_ptr != NULL))
+ {
+ int rc = malloc_set_state (malloc_state_ptr);
+ if (rc != 0)
+ {
+ fprintf (stderr, "malloc_set_state failed, rc = %d\n", rc);
+ abort ();
+ }
+#if 0
+ free (malloc_state_ptr);
+#endif
+ /* mmap works in glibc-2.1, glibc-2.0 (Non-Mule only) and Linux libc5 */
+#if (defined(__GLIBC__) && __GLIBC_MINOR__ >= 1) || \
+ defined(_NO_MALLOC_WARNING_) || \
+ (defined(__GLIBC__) && __GLIBC_MINOR__ < 1 && !defined(MULE)) || \
+ defined(DEBUG_DOUG_LEA_MALLOC)
+ mallopt (M_MMAP_MAX, 64);
+#endif
+#ifdef REL_ALLOC
+ r_alloc_reinit ();
+#endif
+ }
+#endif /* DOUG_LEA_MALLOC */
+
+ run_temacs_argc = -1;
+
+ main_1 (vol_argc, vol_argv, vol_envp, restarted);
+ return 0; /* unreached */
+}
+
+\f
+/* Dumping apparently isn't supported by versions of GCC >= 2.8. */
+/* The following needs conditionalization on whether either XEmacs or */
+/* various system shared libraries have been built and linked with */
+/* GCC >= 2.8. -slb */
+#if defined(GNU_MALLOC)
+static void
+voodoo_free_hook(void *mem)
+{
+ /* Disable all calls to free() when XEmacs is exiting and it doesn't */
+ /* matter. */
+ __free_hook = voodoo_free_hook;
+}
+#endif
+
+DEFUN ("kill-emacs", Fkill_emacs, 0, 1, "P", /*
+Exit the XEmacs job and kill it. Ask for confirmation, without argument.
+If ARG is an integer, return ARG as the exit program code.
+If ARG is a string, stuff it as keyboard input.
+
+The value of `kill-emacs-hook', if not void,
+is a list of functions (of no args),
+all of which are called before XEmacs is actually killed.
+*/
+ (arg))
+{
+ /* This function can GC */
+ struct gcpro gcpro1;
+
+ GCPRO1 (arg);
+
+ if (feof (stdin))
+ arg = Qt;
+
+ if (!preparing_for_armageddon && !noninteractive)
+ run_hook (Qkill_emacs_hook);
+
+ /* make sure no quitting from now on!! */
+ dont_check_for_quit = 1;
+ Vinhibit_quit = Qt;
+
+ if (!preparing_for_armageddon)
+ {
+ Lisp_Object concons, nextcons;
+
+ /* Normally, go ahead and delete all the consoles now.
+ Some unmentionably lame window systems (MS Wwwww...... eek,
+ I can't even say it) don't properly clean up after themselves,
+ and even for those that do, it might be cleaner this way.
+ If we're going down, however, we don't do this (might
+ be too dangerous), and if we get a crash somewhere within
+ this loop, we'll still autosave and won't try this again. */
+
+ LIST_LOOP_DELETING(concons, nextcons, Vconsole_list)
+ {
+ /* There is very little point in deleting the stream console.
+ It uses stdio, which should flush any buffered output and
+ something can only go wrong. -slb */
+ /* I changed my mind. There's a stupid hack in close to add
+ a trailing newline. */
+ /*if (!CONSOLE_STREAM_P (XCONSOLE (XCAR (concons))))*/
+ delete_console_internal (XCONSOLE (XCAR (concons)), 1, 1, 0);
+ }
+ }
+
+ UNGCPRO;
+
+ shut_down_emacs (0, ((STRINGP (arg)) ? arg : Qnil));
+
+#if defined(GNU_MALLOC)
+ __free_hook = voodoo_free_hook;
+#endif
+
+ exit ((INTP (arg)) ? XINT (arg) : 0);
+ /* NOTREACHED */
+ return Qnil; /* I'm sick of the compiler warning */
+}
+
+/* Perform an orderly shutdown of XEmacs. Autosave any modified
+ buffers, kill any child processes, clean up the terminal modes (if
+ we're in the foreground), and other stuff like that. Don't perform
+ any redisplay; this may be called when XEmacs is shutting down in
+ the background, or after its X connection has died.
+
+ If SIG is a signal number, print a message for it.
+
+ This is called by fatal signal handlers, X protocol error handlers,
+ and Fkill_emacs. */
+static void
+shut_down_emacs (int sig, Lisp_Object stuff)
+{
+ /* This function can GC */
+ /* Prevent running of hooks and other non-essential stuff
+ from now on. */
+ preparing_for_armageddon = 1;
+
+ /* In case frames or windows are screwed up, avoid assertion
+ failures here */
+ Vinhibit_quit = Qt;
+
+#ifdef QUANTIFY
+ quantify_stop_recording_data ();
+#endif /* QUANTIFY */
+
+#if 0
+ /* This is absolutely the most important thing to do, so make sure
+ we do it now, before anything else. We might have crashed and
+ be in a weird inconsistent state, and potentially anything could
+ set off another protection fault and cause us to bail out
+ immediately. */
+ /* I'm not removing the code entirely, yet. We have run up against
+ a spate of problems in diagnosing crashes due to crashes within
+ crashes. It has very definitely been determined that code called
+ during auto-saving cannot work if XEmacs crashed inside of GC.
+ We already auto-save on an itimer so there cannot be too much
+ unsaved stuff around, and if we get better crash reports we might
+ be able to get more problems fixed so I'm disabling this. -slb */
+ Fdo_auto_save (Qt, Qnil); /* do this before anything hazardous */
+#endif
+
+ fflush (stdout);
+ reset_all_consoles ();
+ if (sig && sig != SIGTERM)
+ {
+ stderr_out ("\nFatal error (%d).\n", sig);
+ stderr_out
+ ("Your files have been auto-saved.\n"
+ "Use `M-x recover-session' to recover them.\n"
+ "\n"
+#ifdef INFODOCK
+ "Please report this bug by selecting `Report-Bug' in the InfoDock\n"
+ "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"
+ "As a last resort send ordinary email to `crashes@xemacs.org'.\n"
+#endif
+ "*MAKE SURE* to include the information in the command\n"
+ "M-x describe-installation.\n"
+ "\n"
+ "If at all possible, *please* try to obtain a C stack backtrace;\n"
+ "it will help us immensely in determining what went wrong.\n"
+ "To do this, locate the core file that was produced as a result\n"
+ "of this crash (it's usually called `core' and is located in the\n"
+ "directory in which you started the editor, or maybe in your home\n"
+ "directory), and type\n"
+ "\n"
+ " gdb ");
+ {
+ 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))
+ name = (char *) XSTRING_DATA (Vinvocation_name);
+ else
+ name = "xemacs";
+ if (GC_STRINGP (Vinvocation_directory))
+ dir = (char *) XSTRING_DATA (Vinvocation_directory);
+ if (!dir || dir[0] != '/')
+ stderr_out ("`which %s`", name);
+ else if (dir[strlen (dir) - 1] != '/')
+ stderr_out ("%s/%s", dir, name);
+ else
+ stderr_out ("%s%s", dir, name);
+ }
+ stderr_out
+ (" core\n\n"
+ "then type `where' when the debugger prompt comes up.\n"
+ "(If you don't have GDB on your system, you might have DBX,\n"
+ "or XDB, or SDB. A similar procedure should work for all of\n"
+ "these. Ask your system administrator if you need more help.)\n");
+ }
+
+ stuff_buffered_input (stuff);
+
+ kill_buffer_processes (Qnil);
+
+#ifdef CLASH_DETECTION
+ unlock_all_files ();
+#endif
+
+#ifdef TOOLTALK
+ tt_session_quit (tt_default_session ());
+#if 0
+ /* The following crashes when built on X11R5 and run on X11R6 */
+ tt_close ();
+#endif
+#endif /* TOOLTALK */
+
+}
+
+\f
+#ifndef CANNOT_DUMP
+/* Nothing like this can be implemented on an Apollo.
+ What a loss! */
+
+extern char my_edata[];
+
+#ifdef HAVE_SHM
+
+DEFUN ("dump-emacs-data", Fdump_emacs_data, 1, 1, 0, /*
+Dump current state of XEmacs into data file FILENAME.
+This function exists on systems that use HAVE_SHM.
+*/
+ (intoname))
+{
+ /* This function can GC */
+ int opurify;
+ struct gcpro gcpro1;
+ GCPRO1 (intoname);
+
+ CHECK_STRING (intoname);
+ intoname = Fexpand_file_name (intoname, Qnil);
+
+ opurify = purify_flag;
+ purify_flag = 0;
+
+ fflush (stderr);
+ fflush (stdout);
+
+ disksave_object_finalization ();
+ release_breathing_space ();
+
+ /* Tell malloc where start of impure now is */
+ /* Also arrange for warnings when nearly out of space. */
+#ifndef SYSTEM_MALLOC
+ memory_warnings (my_edata, malloc_warning);
+#endif
+ UNGCPRO;
+ map_out_data (XSTRING_DATA (intoname));
+
+ purify_flag = opurify;
+
+ return Qnil;
+}
+
+#else /* not HAVE_SHM */
+extern void disable_free_hook (void);
+
+DEFUN ("dump-emacs", Fdump_emacs, 2, 2, 0, /*
+Dump current state of XEmacs into executable file FILENAME.
+Take symbols from SYMFILE (presumably the file you executed to run XEmacs).
+This is used in the file `loadup.el' when building XEmacs.
+
+Remember to set `command-line-processed' to nil before dumping
+if you want the dumped XEmacs to process its command line
+and announce itself normally when it is run.
+*/
+ (intoname, symname))
+{
+ /* This function can GC */
+ struct gcpro gcpro1, gcpro2;
+ int opurify;
+
+ GCPRO2 (intoname, symname);
+
+#ifdef FREE_CHECKING
+ Freally_free (Qnil);
+
+ /* When we're dumping, we can't use the debugging free() */
+ disable_free_hook ();
+#endif
+#if 1 /* martin */
+#endif
+
+ CHECK_STRING (intoname);
+ intoname = Fexpand_file_name (intoname, Qnil);
+ if (!NILP (symname))
+ {
+ CHECK_STRING (symname);
+ if (XSTRING_LENGTH (symname) > 0)
+ symname = Fexpand_file_name (symname, Qnil);
+ else
+ symname = Qnil;
+ }
+
+ opurify = purify_flag;
+ purify_flag = 0;
+
+#ifdef DEBUG_XEMACS
+ report_pure_usage (1, 1);
+#else
+ report_pure_usage (0, 1);
+#endif
+
+ fflush (stderr);
+ fflush (stdout);
+
+ disksave_object_finalization ();
+ release_breathing_space ();
+
+ /* Tell malloc where start of impure now is */
+ /* Also arrange for warnings when nearly out of space. */
+#ifndef SYSTEM_MALLOC
+ memory_warnings (my_edata, malloc_warning);
+#endif
+
+ UNGCPRO;
+
+#if defined (MSDOS) && defined (EMX)
+ {
+ int fd = open ((char *) XSTRING_DATA (intoname),
+ O_WRONLY|O_CREAT|O_TRUNC, S_IREAD|S_IWRITE);
+ if (!fd) {
+ error ("Failure operating on %s", XSTRING_DATA (intoname));
+ } else {
+ _core (fd);
+ close (fd);
+ }
+ }
+#else /* not MSDOS and EMX */
+ {
+ char *intoname_ext;
+ char *symname_ext;
+
+ GET_C_STRING_FILENAME_DATA_ALLOCA (intoname, intoname_ext);
+ if (STRINGP (symname))
+ GET_C_STRING_FILENAME_DATA_ALLOCA (symname, symname_ext);
+ else
+ symname_ext = 0;
+
+ garbage_collect_1 ();
+#ifdef DOUG_LEA_MALLOC
+ malloc_state_ptr = malloc_get_state ();
+#endif
+ /* here we break our rule that the filename conversion should
+ be performed at the actual time that the system call is made.
+ It's a whole lot easier to do the conversion here than to
+ modify all the unexec routines to ensure that filename
+ conversion is applied everywhere. Don't worry about memory
+ leakage because this call only happens once. */
+ unexec (intoname_ext, symname_ext, (uintptr_t) my_edata, 0, 0);
+#ifdef DOUG_LEA_MALLOC
+ free (malloc_state_ptr);
+#endif
+ }
+#endif /* not MSDOS and EMX */
+
+ purify_flag = opurify;
+
+ return Qnil;
+}
+
+#endif /* not HAVE_SHM */
+
+#endif /* not CANNOT_DUMP */
+\f
+#ifndef SEPCHAR
+#define SEPCHAR ':'
+#endif
+
+/* 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,
+ Emchar sepchar)
+{
+ Lisp_Object result = Qnil;
+ CONST Bufbyte *end = string + size;
+
+ while (1)
+ {
+ CONST Bufbyte *p = string;
+ while (p < end)
+ {
+ if (charptr_emchar (p) == sepchar)
+ break;
+ INC_CHARPTR (p);
+ }
+ result = Fcons (make_string (string, p - string), result);
+ if (p < end)
+ {
+ string = p;
+ INC_CHARPTR (string); /* skip sepchar */
+ }
+ else
+ break;
+ }
+ return Fnreverse (result);
+}
+
+/* The same as the above, except PATH is an external C string (it is
+ converted as FORMAT_FILENAME), and sepchar is hardcoded to SEPCHAR
+ (':' or whatever). */
+Lisp_Object
+decode_path (CONST char *path)
+{
+ int len;
+ Bufbyte *newpath;
+ if (!path)
+ return Qnil;
+
+ GET_C_CHARPTR_INT_FILENAME_DATA_ALLOCA (path, newpath);
+
+ len = strlen (newpath);
+ /* #### 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)
+ return Qnil;
+
+ return split_string_by_emchar_1 (newpath, (Bytecount)len, SEPCHAR);
+}
+
+Lisp_Object
+decode_env_path (CONST char *evarname, CONST char *default_)
+{
+ CONST char *path = 0;
+ if (evarname)
+ path = egetenv (evarname);
+ if (!path)
+ path = default_;
+ return decode_path (path);
+}
+
+/* Ben thinks this function should not exist or be exported to Lisp.
+ We use it to define split-path-string in subr.el (not!). */
+
+DEFUN ("split-string-by-char", Fsplit_string_by_char, 1, 2, 0, /*
+Split STRING into a list of substrings originally separated by SEPCHAR.
+*/
+ (string, sepchar))
+{
+ CHECK_STRING (string);
+ CHECK_CHAR (sepchar);
+ return split_string_by_emchar_1 (XSTRING_DATA (string),
+ XSTRING_LENGTH (string),
+ XCHAR (sepchar));
+}
+
+/* #### This was supposed to be in subr.el, but is used VERY early in
+ the bootstrap process, so it goes here. Damn. */
+
+DEFUN ("split-path", Fsplit_path, 1, 1, 0, /*
+Explode a search path into a list of strings.
+The path components are separated with the characters specified
+with `path-separator'.
+*/
+ (path))
+{
+ CHECK_STRING (path);
+
+ while (!STRINGP (Vpath_separator)
+ || (XSTRING_CHAR_LENGTH (Vpath_separator) != 1))
+ Vpath_separator = signal_simple_continuable_error
+ ("`path-separator' should be set to a single-character string",
+ Vpath_separator);
+
+ return (split_string_by_emchar_1
+ (XSTRING_DATA (path), XSTRING_LENGTH (path),
+ charptr_emchar (XSTRING_DATA (Vpath_separator))));
+}
+\f
+DEFUN ("noninteractive", Fnoninteractive, 0, 0, 0, /*
+Non-nil return value means XEmacs is running without interactive terminal.
+*/
+ ())
+{
+ return noninteractive ? Qt : Qnil;
+}
+
+/* This flag is useful to define if you're under a debugger; this way, you
+ can put a breakpoint of assert_failed() and debug multiple problems
+ in one session without having to recompile. */
+/* #define ASSERTIONS_DONT_ABORT */
+
+#ifdef USE_ASSERTIONS
+/* 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)
+{
+ stderr_out ("Fatal error: assertion failed, file %s, line %d, %s\n",
+ file, line, expr);
+#undef abort /* avoid infinite #define loop... */
+#if defined (WINDOWSNT) && defined (DEBUG_XEMACS)
+ DebugBreak ();
+#elif !defined (ASSERTIONS_DONT_ABORT)
+ abort ();
+#endif
+}
+#endif /* USE_ASSERTIONS */
+
+#ifdef QUANTIFY
+DEFUN ("quantify-start-recording-data", Fquantify_start_recording_data,
+ 0, 0, 0, /*
+Start recording Quantify data.
+*/
+ ())
+{
+ quantify_start_recording_data ();
+ return Qnil;
+}
+
+DEFUN ("quantify-stop-recording-data", Fquantify_stop_recording_data,
+ 0, 0, 0, /*
+Stop recording Quantify data.
+*/
+ ())
+{
+ quantify_stop_recording_data ();
+ return Qnil;
+}
+
+DEFUN ("quantify-clear-data", Fquantify_clear_data, 0, 0, 0, /*
+Clear all Quantify data.
+*/
+ ())
+{
+ quantify_clear_data ();
+ return Qnil;
+}
+#endif /* QUANTIFY */
+
+void
+syms_of_emacs (void)
+{
+#ifndef CANNOT_DUMP
+#ifdef HAVE_SHM
+ DEFSUBR (Fdump_emacs_data);
+#else
+ DEFSUBR (Fdump_emacs);
+#endif
+#endif /* !CANNOT_DUMP */
+
+ DEFSUBR (Frun_emacs_from_temacs);
+ DEFSUBR (Frunning_temacs_p);
+ DEFSUBR (Finvocation_name);
+ DEFSUBR (Finvocation_directory);
+ DEFSUBR (Fkill_emacs);
+ DEFSUBR (Fnoninteractive);
+
+#ifdef QUANTIFY
+ DEFSUBR (Fquantify_start_recording_data);
+ DEFSUBR (Fquantify_stop_recording_data);
+ DEFSUBR (Fquantify_clear_data);
+#endif /* QUANTIFY */
+
+ DEFSUBR (Fsplit_string_by_char);
+ DEFSUBR (Fsplit_path); /* #### */
+
+ defsymbol (&Qkill_emacs_hook, "kill-emacs-hook");
+ defsymbol (&Qsave_buffers_kill_emacs, "save-buffers-kill-emacs");
+}
+
+void
+vars_of_emacs (void)
+{
+ DEFVAR_BOOL ("suppress-early-error-handler-backtrace",
+ &suppress_early_error_handler_backtrace /*
+Non-nil means early error handler shouldn't print a backtrace.
+*/ );
+
+ DEFVAR_LISP ("command-line-args", &Vcommand_line_args /*
+Args passed by shell to XEmacs, as a list of strings.
+*/ );
+
+ DEFVAR_LISP ("invocation-name", &Vinvocation_name /*
+The program name that was used to run XEmacs.
+Any directory names are omitted.
+*/ );
+
+ DEFVAR_LISP ("invocation-directory", &Vinvocation_directory /*
+The directory in which the XEmacs executable was found, to run it.
+The value is simply the program name if that directory's name is not known.
+*/ );
+
+ DEFVAR_LISP ("invocation-path", &Vinvocation_path /*
+The path in which the XEmacs executable was found, to run it.
+The value is simply the value of environment variable PATH on startup
+if XEmacs was found there.
+*/ );
+
+#if 0 /* FSFmacs */
+ xxDEFVAR_LISP ("installation-directory", &Vinstallation_directory,
+ "A directory within which to look for the `lib-src' and `etc' directories.\n"
+"This is non-nil when we can't find those directories in their standard\n"
+"installed locations, but we can find them\n"
+"near where the XEmacs executable was found.");
+#endif
+
+ DEFVAR_LISP ("system-type", &Vsystem_type /*
+Symbol indicating type of operating system you are using.
+*/ );
+ Vsystem_type = intern (SYSTEM_TYPE);
+ Fprovide (intern(SYSTEM_TYPE));
+
+#ifndef EMACS_CONFIGURATION
+# define EMACS_CONFIGURATION "UNKNOWN"
+#endif
+ DEFVAR_LISP ("system-configuration", &Vsystem_configuration /*
+String naming the configuration XEmacs was built for.
+*/ );
+ Vsystem_configuration = Fpurecopy (build_string (EMACS_CONFIGURATION));
+
+#ifndef EMACS_CONFIG_OPTIONS
+# define EMACS_CONFIG_OPTIONS "UNKNOWN"
+#endif
+ 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));
+
+ DEFVAR_LISP ("emacs-major-version", &Vemacs_major_version /*
+Major version number of this version of Emacs, as an integer.
+Warning: this variable did not exist in Emacs versions earlier than:
+ FSF Emacs: 19.23
+ XEmacs: 19.10
+*/ );
+ Vemacs_major_version = make_int (EMACS_MAJOR_VERSION);
+
+ DEFVAR_LISP ("emacs-minor-version", &Vemacs_minor_version /*
+Minor version number of this version of Emacs, as an integer.
+Warning: this variable did not exist in Emacs versions earlier than:
+ FSF Emacs: 19.23
+ XEmacs: 19.10
+*/ );
+ Vemacs_minor_version = make_int (EMACS_MINOR_VERSION);
+
+ 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
+earlier than 20.3.
+*/ );
+#ifdef EMACS_BETA_VERSION
+ Vemacs_beta_version = make_int (EMACS_BETA_VERSION);
+#else
+ Vemacs_beta_version = Qnil;
+#endif
+
+#ifdef INFODOCK
+ DEFVAR_LISP ("infodock-major-version", &Vinfodock_major_version /*
+Major version number of this InfoDock release.
+*/ );
+ Vinfodock_major_version = make_int (INFODOCK_MAJOR_VERSION);
+
+ DEFVAR_LISP ("infodock-minor-version", &Vinfodock_minor_version /*
+Minor version number of this InfoDock release.
+*/ );
+ Vinfodock_minor_version = make_int (INFODOCK_MINOR_VERSION);
+
+ DEFVAR_LISP ("infodock-build-version", &Vinfodock_build_version /*
+Build version of this InfoDock release.
+*/ );
+ Vinfodock_build_version = make_int (INFODOCK_BUILD_VERSION);
+#endif
+
+ DEFVAR_LISP ("xemacs-codename", &Vxemacs_codename /*
+Codename of this version of Emacs (a string).
+*/ );
+#ifndef XEMACS_CODENAME
+#define XEMACS_CODENAME "Noname"
+#endif
+ Vxemacs_codename = Fpurecopy (build_string (XEMACS_CODENAME));
+
+ DEFVAR_BOOL ("noninteractive", &noninteractive1 /*
+Non-nil means XEmacs is running without interactive terminal.
+*/ );
+
+ DEFVAR_BOOL ("inhibit-early-packages", &inhibit_early_packages /*
+Set to non-nil when the early packages should not be respected at startup.
+*/ );
+
+ DEFVAR_BOOL ("inhibit-autoloads", &inhibit_autoloads /*
+Set to non-nil when autoloads should not be loaded at startup.
+*/ );
+
+ DEFVAR_BOOL ("debug-paths", &debug_paths /*
+Set to non-nil when debug information about paths should be printed.
+*/ );
+
+ DEFVAR_BOOL ("inhibit-site-lisp", &inhibit_site_lisp /*
+Set to non-nil when the site-lisp should not be searched at startup.
+*/ );
+#ifdef INHIBIT_SITE_LISP
+ inhibit_site_lisp = 1;
+#endif
+
+ DEFVAR_INT ("emacs-priority", &emacs_priority /*
+Priority for XEmacs to run at.
+This value is effective only if set before XEmacs is dumped,
+and only if the XEmacs executable is installed with setuid to permit
+it to change priority. (XEmacs sets its uid back to the real uid.)
+Currently, you need to define SET_EMACS_PRIORITY in `config.h'
+before you compile XEmacs, to enable the code for this feature.
+*/ );
+ emacs_priority = 0;
+
+ DEFVAR_CONST_LISP ("internal-error-checking", &Vinternal_error_checking /*
+Internal error checking built-in into this instance of XEmacs.
+This is a list of symbols, initialized at build-time. Legal symbols
+are:
+
+extents - check extents prior to each extent change;
+typecheck - check types strictly, aborting in case of error;
+malloc - check operation of malloc;
+gc - check garbage collection;
+bufpos - check buffer positions.
+*/ );
+ Vinternal_error_checking = Qnil;
+#ifdef ERROR_CHECK_EXTENTS
+ Vinternal_error_checking = Fcons (intern ("extents"),
+ Vinternal_error_checking);
+#endif
+#ifdef ERROR_CHECK_TYPECHECK
+ Vinternal_error_checking = Fcons (intern ("typecheck"),
+ Vinternal_error_checking);
+#endif
+#ifdef ERROR_CHECK_MALLOC
+ Vinternal_error_checking = Fcons (intern ("malloc"),
+ Vinternal_error_checking);
+#endif
+#ifdef ERROR_CHECK_GC
+ Vinternal_error_checking = Fcons (intern ("gc"),
+ Vinternal_error_checking);
+#endif
+#ifdef ERROR_CHECK_BUFPOS
+ Vinternal_error_checking = Fcons (intern ("bufpos"),
+ Vinternal_error_checking);
+#endif
+ Vinternal_error_checking = Fpurecopy (Vinternal_error_checking);
+
+ DEFVAR_LISP ("path-separator", &Vpath_separator /*
+The directory separator in search paths, as a string.
+*/ );
+ {
+ char c = SEPCHAR;
+ Vpath_separator = make_string ((Bufbyte *)&c, 1);
+ }
+}
+
+void
+complex_vars_of_emacs (void)
+{
+ /* This is all related to path searching. */
+
+ DEFVAR_LISP ("emacs-program-name", &Vemacs_program_name /*
+*Name of the Emacs variant.
+For example, this may be \"xemacs\" or \"infodock\".
+This is mainly meant for use in path searching.
+*/ );
+ Vemacs_program_name = build_string ((char *) PATH_PROGNAME);
+
+ DEFVAR_LISP ("emacs-program-version", &Vemacs_program_version /*
+*Version of the Emacs variant.
+This typically has the form XX.XX[-bXX].
+This is mainly meant for use in path searching.
+*/ );
+ Vemacs_program_version = build_string ((char *) PATH_VERSION);
+
+ DEFVAR_LISP ("exec-path", &Vexec_path /*
+*List of directories to search programs to run in subprocesses.
+Each element is a string (directory name) or nil (try default directory).
+*/ );
+ Vexec_path = Qnil;
+
+ DEFVAR_LISP ("exec-directory", &Vexec_directory /*
+*Directory of architecture-dependent files that come with XEmacs,
+especially executable programs intended for XEmacs to invoke.
+*/ );
+ Vexec_directory = Qnil;
+
+ DEFVAR_LISP ("configure-exec-directory", &Vconfigure_exec_directory /*
+For internal use by the build procedure only.
+configure's idea of what EXEC-DIRECTORY will be.
+*/ );
+#ifdef PATH_EXEC
+ Vconfigure_exec_directory = Ffile_name_as_directory
+ (build_string ((char *) PATH_EXEC));
+#else
+ Vconfigure_exec_directory = Qnil;
+#endif
+
+ DEFVAR_LISP ("lisp-directory", &Vlisp_directory /*
+*Directory of core Lisp files that come with XEmacs.
+*/ );
+ Vlisp_directory = Qnil;
+
+ DEFVAR_LISP ("configure-lisp-directory", &Vconfigure_lisp_directory /*
+For internal use by the build procedure only.
+configure's idea of what LISP-DIRECTORY will be.
+*/ );
+#ifdef PATH_LOADSEARCH
+ Vconfigure_lisp_directory = Ffile_name_as_directory
+ (build_string ((char *) PATH_LOADSEARCH));
+#else
+ Vconfigure_lisp_directory = Qnil;
+#endif
+
+ DEFVAR_LISP ("configure-package-path", &Vconfigure_package_path /*
+For internal use by the build procedure only.
+configure's idea of what the package path will be.
+*/ );
+#ifdef PATH_PACKAGEPATH
+ Vconfigure_package_path = decode_path (PATH_PACKAGEPATH);
+#else
+ Vconfigure_package_path = Qnil;
+#endif
+
+ DEFVAR_LISP ("data-directory", &Vdata_directory /*
+*Directory of architecture-independent files that come with XEmacs,
+intended for XEmacs to use.
+Use of this variable in new code is almost never correct. See the
+function `locate-data-directory' and the variable `data-directory-list'.
+*/ );
+ Vdata_directory = Qnil;
+
+ DEFVAR_LISP ("configure-data-directory", &Vconfigure_data_directory /*
+For internal use by the build procedure only.
+configure's idea of what DATA-DIRECTORY will be.
+*/ );
+#ifdef PATH_DATA
+ Vconfigure_data_directory = Ffile_name_as_directory
+ (build_string ((char *) PATH_DATA));
+#else
+ Vconfigure_data_directory = Qnil;
+#endif
+
+ DEFVAR_LISP ("data-directory-list", &Vdata_directory_list /*
+*List of directories of architecture-independent files that come with XEmacs
+or were installed as packages, and are intended for XEmacs to use.
+*/ );
+ Vdata_directory_list = Qnil;
+
+#ifdef CLASH_DETECTION
+ DEFVAR_LISP ("configure-lock-directory", &Vconfigure_lock_directory /*
+For internal use by the build procedure only.
+configure's idea of what LOCK-DIRECTORY will be.
+*/ );
+#ifdef PATH_LOCK
+ Vconfigure_lock_directory = Ffile_name_as_directory
+ (build_string ((char *) PATH_LOCK));
+#else
+ Vconfigure_lock_directory = Qnil;
+#endif
+#endif /* CLASH_DETECTION */
+
+ DEFVAR_LISP ("site-directory", &Vsite_directory /*
+*Directory of site-specific Lisp files that come with XEmacs.
+*/ );
+ Vsite_directory = Qnil;
+
+ DEFVAR_LISP ("configure-site-directory", &Vconfigure_site_directory /*
+For internal use by the build procedure only.
+configure's idea of what SITE-DIRECTORY will be.
+*/ );
+#ifdef PATH_SITE
+ Vconfigure_site_directory = Ffile_name_as_directory
+ (build_string ((char *) PATH_SITE));
+#else
+ Vconfigure_site_directory = Qnil;
+#endif
+
+ DEFVAR_LISP ("doc-directory", &Vdoc_directory /*
+*Directory containing the DOC file that comes with XEmacs.
+This is usually the same as exec-directory.
+*/ );
+ Vdoc_directory = Qnil;
+
+ DEFVAR_LISP ("configure-doc-directory", &Vconfigure_doc_directory /*
+For internal use by the build procedure only.
+configure's idea of what DOC-DIRECTORY will be.
+*/ );
+#ifdef PATH_DOC
+ Vconfigure_doc_directory = Ffile_name_as_directory
+ (build_string ((char *) PATH_DOC));
+#else
+ Vconfigure_doc_directory = Qnil;
+#endif
+
+ DEFVAR_LISP ("configure-exec-prefix-directory", &Vconfigure_exec_prefix_directory /*
+For internal use by the build procedure only.
+configure's idea of what EXEC-PREFIX-DIRECTORY will be.
+*/ );
+#ifdef PATH_EXEC_PREFIX
+ Vconfigure_exec_prefix_directory = Ffile_name_as_directory
+ (build_string ((char *) PATH_EXEC_PREFIX));
+#else
+ Vconfigure_exec_prefix_directory = Qnil;
+#endif
+
+ DEFVAR_LISP ("configure-prefix-directory", &Vconfigure_prefix_directory /*
+For internal use by the build procedure only.
+configure's idea of what PREFIX-DIRECTORY will be.
+*/ );
+#ifdef PATH_PREFIX
+ Vconfigure_prefix_directory = Ffile_name_as_directory
+ (build_string ((char *) PATH_PREFIX));
+#else
+ Vconfigure_prefix_directory = Qnil;
+#endif
+
+ DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory /*
+For internal use by the build procedure only.
+This is the name of the directory in which the build procedure installed
+Emacs's info files; the default value for Info-default-directory-list
+includes this.
+*/ );
+#ifdef PATH_INFO
+ Vconfigure_info_directory =
+ Ffile_name_as_directory (build_string (PATH_INFO));
+#else
+ Vconfigure_info_directory = Qnil;
+#endif
+
+ DEFVAR_LISP ("configure-info-path", &Vconfigure_info_path /*
+The configured initial path for info documentation.
+*/ );
+#ifdef PATH_INFOPATH
+ Vconfigure_info_path = decode_path (PATH_INFOPATH);
+#else
+ Vconfigure_info_path = Qnil;
+#endif
+}
+
+#ifdef __sgi
+/* 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
+ * cores on us when re-started from the dumped executable.
+ * This will have to go for 21.1 -- OG.
+ */
+void __sti__iflPNGFile_c___()
+{
+}
+
+#endif
--- /dev/null
+/* "Face" primitives
+ Copyright (C) 1994 Free Software Foundation, Inc.
+ Copyright (C) 1995 Board of Trustees, University of Illinois.
+ Copyright (C) 1995, 1996 Ben Wing.
+ 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: Not in FSF. */
+
+/* Written by Chuck Thompson and Ben Wing,
+ based loosely on old face code by Jamie Zawinski. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "device.h"
+#include "elhash.h"
+#include "extents.h"
+#include "faces.h"
+#include "frame.h"
+#include "glyphs.h"
+#include "hash.h"
+#include "objects.h"
+#include "specifier.h"
+#include "window.h"
+
+Lisp_Object Qfacep;
+Lisp_Object Qforeground, Qbackground, Qdisplay_table;
+Lisp_Object Qbackground_pixmap, Qunderline, Qdim;
+Lisp_Object Qblinking, Qstrikethru;
+
+Lisp_Object Qinit_face_from_resources;
+Lisp_Object Qinit_frame_faces;
+Lisp_Object Qinit_device_faces;
+Lisp_Object Qinit_global_faces;
+
+/* These faces are used directly internally. We use these variables
+ to be able to reference them directly and save the overhead of
+ calling Ffind_face. */
+Lisp_Object Vdefault_face, Vmodeline_face, Vgui_element_face;
+Lisp_Object Vleft_margin_face, Vright_margin_face, Vtext_cursor_face;
+Lisp_Object Vpointer_face, Vvertical_divider_face, Vtoolbar_face;
+
+/* Qdefault, Qhighlight defined in general.c */
+Lisp_Object Qmodeline, Qgui_element, Qleft_margin, Qright_margin, Qtext_cursor;
+Lisp_Object 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
+ temporary faces. Permanent faces are kept in a regular hash table,
+ temporary faces in a weak hash table. */
+Lisp_Object Vpermanent_faces_cache;
+Lisp_Object Vtemporary_faces_cache;
+
+Lisp_Object Vbuilt_in_face_specifiers;
+
+\f
+
+static Lisp_Object
+mark_face (Lisp_Object obj, void (*markobj) (Lisp_Object))
+{
+ struct Lisp_Face *face = XFACE (obj);
+
+ ((markobj) (face->name));
+ ((markobj) (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));
+
+ ((markobj) (face->charsets_warned_about));
+
+ return face->plist;
+}
+
+static void
+print_face (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+ struct Lisp_Face *face = XFACE (obj);
+
+ if (print_readably)
+ {
+ write_c_string ("#s(face name ", printcharfun);
+ print_internal (face->name, printcharfun, 1);
+ write_c_string (")", printcharfun);
+ }
+ else
+ {
+ write_c_string ("#<face ", printcharfun);
+ print_internal (face->name, printcharfun, 1);
+ if (!NILP (face->doc_string))
+ {
+ write_c_string (" ", printcharfun);
+ print_internal (face->doc_string, printcharfun, 1);
+ }
+ write_c_string (">", printcharfun);
+ }
+}
+
+/* Faces are equal if all of their display attributes are equal. We
+ don't compare names or doc-strings, because that would make equal
+ be eq.
+
+ This isn't concerned with "unspecified" attributes, that's what
+ #'face-differs-from-default-p is for. */
+static int
+face_equal (Lisp_Object o1, Lisp_Object o2, int depth)
+{
+ struct Lisp_Face *f1 = XFACE (o1);
+ struct Lisp_Face *f2 = XFACE (o2);
+
+ depth++;
+
+ return
+ (internal_equal (f1->foreground, f2->foreground, depth) &&
+ internal_equal (f1->background, f2->background, depth) &&
+ internal_equal (f1->font, f2->font, depth) &&
+ internal_equal (f1->display_table, f2->display_table, depth) &&
+ internal_equal (f1->background_pixmap, f2->background_pixmap, depth) &&
+ internal_equal (f1->underline, f2->underline, depth) &&
+ internal_equal (f1->strikethru, f2->strikethru, depth) &&
+ internal_equal (f1->highlight, f2->highlight, depth) &&
+ internal_equal (f1->dim, f2->dim, depth) &&
+ internal_equal (f1->blinking, f2->blinking, depth) &&
+ internal_equal (f1->reverse, f2->reverse, depth) &&
+
+ ! plists_differ (f1->plist, f2->plist, 0, 0, depth + 1));
+}
+
+static unsigned long
+face_hash (Lisp_Object obj, int depth)
+{
+ struct Lisp_Face *f = XFACE (obj);
+
+ depth++;
+
+ /* No need to hash all of the elements; that would take too long.
+ Just hash the most common ones. */
+ return HASH3 (internal_hash (f->foreground, depth),
+ internal_hash (f->background, depth),
+ internal_hash (f->font, depth));
+}
+
+static Lisp_Object
+face_getprop (Lisp_Object obj, Lisp_Object prop)
+{
+ struct 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 :
+ 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);
+
+ if (EQ (prop, Qforeground) ||
+ EQ (prop, Qbackground) ||
+ EQ (prop, Qfont) ||
+ EQ (prop, Qdisplay_table) ||
+ EQ (prop, Qbackground_pixmap) ||
+ EQ (prop, Qunderline) ||
+ EQ (prop, Qstrikethru) ||
+ EQ (prop, Qhighlight) ||
+ EQ (prop, Qdim) ||
+ EQ (prop, Qblinking) ||
+ EQ (prop, Qreverse))
+ return 0;
+
+ if (EQ (prop, Qdoc_string))
+ {
+ if (!NILP (value))
+ CHECK_STRING (value);
+ f->doc_string = value;
+ return 1;
+ }
+
+ external_plist_put (&f->plist, prop, value, 0, ERROR_ME);
+ return 1;
+}
+
+static int
+face_remprop (Lisp_Object obj, Lisp_Object prop)
+{
+ struct Lisp_Face *f = XFACE (obj);
+
+ if (EQ (prop, Qforeground) ||
+ EQ (prop, Qbackground) ||
+ EQ (prop, Qfont) ||
+ EQ (prop, Qdisplay_table) ||
+ EQ (prop, Qbackground_pixmap) ||
+ EQ (prop, Qunderline) ||
+ EQ (prop, Qstrikethru) ||
+ EQ (prop, Qhighlight) ||
+ EQ (prop, Qdim) ||
+ EQ (prop, Qblinking) ||
+ EQ (prop, Qreverse))
+ return -1;
+
+ if (EQ (prop, Qdoc_string))
+ {
+ f->doc_string = Qnil;
+ return 1;
+ }
+
+ return external_remprop (&f->plist, prop, 0, ERROR_ME);
+}
+
+static Lisp_Object
+face_plist (Lisp_Object obj)
+{
+ struct Lisp_Face *face = XFACE (obj);
+ Lisp_Object result = face->plist;
+
+ result = cons3 (Qreverse, face->reverse, result);
+ result = cons3 (Qblinking, face->blinking, result);
+ result = cons3 (Qdim, face->dim, result);
+ result = cons3 (Qhighlight, face->highlight, result);
+ result = cons3 (Qstrikethru, face->strikethru, result);
+ result = cons3 (Qunderline, face->underline, result);
+ result = cons3 (Qbackground_pixmap, face->background_pixmap, result);
+ result = cons3 (Qdisplay_table, face->display_table, result);
+ result = cons3 (Qfont, face->font, result);
+ result = cons3 (Qbackground, face->background, result);
+ result = cons3 (Qforeground, face->foreground, result);
+
+ return result;
+}
+
+DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("face", face,
+ mark_face, print_face, 0, face_equal,
+ face_hash, face_getprop,
+ face_putprop, face_remprop,
+ face_plist, struct Lisp_Face);
+\f
+/************************************************************************/
+/* face read syntax */
+/************************************************************************/
+
+static int
+face_name_validate (Lisp_Object keyword, Lisp_Object value,
+ Error_behavior errb)
+{
+ if (ERRB_EQ (errb, ERROR_ME))
+ {
+ CHECK_SYMBOL (value);
+ return 1;
+ }
+
+ return SYMBOLP (value);
+}
+
+static int
+face_validate (Lisp_Object data, Error_behavior errb)
+{
+ int name_seen = 0;
+ Lisp_Object valw = Qnil;
+
+ data = Fcdr (data); /* skip over Qface */
+ while (!NILP (data))
+ {
+ Lisp_Object keyw = Fcar (data);
+
+ data = Fcdr (data);
+ valw = Fcar (data);
+ data = Fcdr (data);
+ if (EQ (keyw, Qname))
+ name_seen = 1;
+ else
+ abort ();
+ }
+
+ if (!name_seen)
+ {
+ maybe_error (Qface, errb, "No face name given");
+ return 0;
+ }
+
+ if (NILP (Ffind_face (valw)))
+ {
+ maybe_signal_simple_error ("No such face", valw, Qface, errb);
+ return 0;
+ }
+
+ return 1;
+}
+
+static Lisp_Object
+face_instantiate (Lisp_Object data)
+{
+ return Fget_face (Fcar (Fcdr (data)));
+}
+
+\f
+/****************************************************************************
+ * utility functions *
+ ****************************************************************************/
+
+static void
+reset_face (struct Lisp_Face *f)
+{
+ f->name = Qnil;
+ f->doc_string = Qnil;
+ f->dirty = 0;
+ f->foreground = Qnil;
+ f->background = Qnil;
+ f->font = Qnil;
+ f->display_table = Qnil;
+ f->background_pixmap = Qnil;
+ f->underline = Qnil;
+ f->strikethru = Qnil;
+ f->highlight = Qnil;
+ f->dim = Qnil;
+ f->blinking = Qnil;
+ f->reverse = Qnil;
+ f->plist = Qnil;
+ f->charsets_warned_about = Qnil;
+}
+
+static struct Lisp_Face *
+allocate_face (void)
+{
+ struct Lisp_Face *result =
+ alloc_lcrecord_type (struct Lisp_Face, lrecord_face);
+
+ reset_face (result);
+ return result;
+}
+
+\f
+/* We store the faces in hash tables with the names as the key and the
+ actual face object as the value. Occasionally we need to use them
+ in a list format. These routines provide us with that. */
+struct face_list_closure
+{
+ Lisp_Object *face_list;
+};
+
+static int
+add_face_to_list_mapper (CONST void *hash_key, void *hash_contents,
+ void *face_list_closure)
+{
+ /* This function can GC */
+ Lisp_Object key, contents;
+ Lisp_Object *face_list;
+ struct face_list_closure *fcl =
+ (struct face_list_closure *) face_list_closure;
+ CVOID_TO_LISP (key, hash_key);
+ VOID_TO_LISP (contents, hash_contents);
+ face_list = fcl->face_list;
+
+ *face_list = Fcons (XFACE (contents)->name, *face_list);
+ return 0;
+}
+
+static Lisp_Object
+faces_list_internal (Lisp_Object list)
+{
+ Lisp_Object face_list = Qnil;
+ struct gcpro gcpro1;
+ struct face_list_closure face_list_closure;
+
+ GCPRO1 (face_list);
+ face_list_closure.face_list = &face_list;
+ elisp_maphash (add_face_to_list_mapper, list, &face_list_closure);
+ UNGCPRO;
+
+ return face_list;
+}
+
+static Lisp_Object
+permanent_faces_list (void)
+{
+ return faces_list_internal (Vpermanent_faces_cache);
+}
+
+static Lisp_Object
+temporary_faces_list (void)
+{
+ return faces_list_internal (Vtemporary_faces_cache);
+}
+
+\f
+static int
+mark_face_as_clean_mapper (CONST void *hash_key, void *hash_contents,
+ void *flag_closure)
+{
+ /* This function can GC */
+ Lisp_Object key, contents;
+ int *flag = (int *) flag_closure;
+ CVOID_TO_LISP (key, hash_key);
+ VOID_TO_LISP (contents, hash_contents);
+ XFACE (contents)->dirty = *flag;
+ return 0;
+}
+
+static void
+mark_all_faces_internal (int flag)
+{
+ elisp_maphash (mark_face_as_clean_mapper, Vpermanent_faces_cache, &flag);
+ elisp_maphash (mark_face_as_clean_mapper, Vtemporary_faces_cache, &flag);
+}
+
+void
+mark_all_faces_as_clean (void)
+{
+ mark_all_faces_internal (0);
+}
+
+/* Currently unused (see the comment in face_property_was_changed()). */
+#if 0
+/* #### OBSOLETE ME, PLEASE. Maybe. Maybe this is just as good as
+ any other solution. */
+struct face_inheritance_closure
+{
+ Lisp_Object face;
+ Lisp_Object property;
+};
+
+static void
+update_inheritance_mapper_internal (Lisp_Object cur_face,
+ Lisp_Object inh_face,
+ Lisp_Object property)
+{
+ /* #### fix this function */
+ Lisp_Object elt = Qnil;
+ struct gcpro gcpro1;
+
+ GCPRO1 (elt);
+
+ for (elt = FACE_PROPERTY_SPEC_LIST (cur_face, property, Qall);
+ !NILP (elt);
+ elt = XCDR (elt))
+ {
+ Lisp_Object values = XCDR (XCAR (elt));
+
+ for (; !NILP (values); values = XCDR (values))
+ {
+ Lisp_Object value = XCDR (XCAR (values));
+ if (VECTORP (value) && XVECTOR_LENGTH (value))
+ {
+ if (EQ (Ffind_face (XVECTOR_DATA (value)[0]), inh_face))
+ Fset_specifier_dirty_flag
+ (FACE_PROPERTY_SPECIFIER (inh_face, property));
+ }
+ }
+ }
+
+ UNGCPRO;
+}
+
+static int
+update_face_inheritance_mapper (CONST void *hash_key, void *hash_contents,
+ void *face_inheritance_closure)
+{
+ Lisp_Object key, contents;
+ struct face_inheritance_closure *fcl =
+ (struct face_inheritance_closure *) face_inheritance_closure;
+
+ CVOID_TO_LISP (key, hash_key);
+ VOID_TO_LISP (contents, hash_contents);
+
+ if (EQ (fcl->property, Qfont))
+ {
+ update_inheritance_mapper_internal (contents, fcl->face, Qfont);
+ }
+ else if (EQ (fcl->property, Qforeground) ||
+ EQ (fcl->property, Qbackground))
+ {
+ update_inheritance_mapper_internal (contents, fcl->face, Qforeground);
+ update_inheritance_mapper_internal (contents, fcl->face, Qbackground);
+ }
+ else if (EQ (fcl->property, Qunderline) ||
+ EQ (fcl->property, Qstrikethru) ||
+ EQ (fcl->property, Qhighlight) ||
+ EQ (fcl->property, Qdim) ||
+ EQ (fcl->property, Qblinking) ||
+ EQ (fcl->property, Qreverse))
+ {
+ update_inheritance_mapper_internal (contents, fcl->face, Qunderline);
+ update_inheritance_mapper_internal (contents, fcl->face, Qstrikethru);
+ update_inheritance_mapper_internal (contents, fcl->face, Qhighlight);
+ update_inheritance_mapper_internal (contents, fcl->face, Qdim);
+ update_inheritance_mapper_internal (contents, fcl->face, Qblinking);
+ update_inheritance_mapper_internal (contents, fcl->face, Qreverse);
+ }
+ return 0;
+}
+
+static void
+update_faces_inheritance (Lisp_Object face, Lisp_Object property)
+{
+ struct face_inheritance_closure face_inheritance_closure;
+ struct gcpro gcpro1, gcpro2;
+
+ GCPRO2 (face, property);
+ face_inheritance_closure.face = face;
+ face_inheritance_closure.property = property;
+
+ elisp_maphash (update_face_inheritance_mapper, Vpermanent_faces_cache,
+ &face_inheritance_closure);
+ elisp_maphash (update_face_inheritance_mapper, Vtemporary_faces_cache,
+ &face_inheritance_closure);
+
+ UNGCPRO;
+}
+#endif /* 0 */
+
+Lisp_Object
+face_property_matching_instance (Lisp_Object face, Lisp_Object property,
+ Lisp_Object charset, Lisp_Object domain,
+ Error_behavior errb, int no_fallback,
+ Lisp_Object depth)
+{
+ Lisp_Object retval =
+ specifier_instance_no_quit (Fget (face, property, Qnil), charset,
+ domain, errb, no_fallback, depth);
+
+ if (UNBOUNDP (retval) && !no_fallback)
+ {
+ if (EQ (property, Qfont))
+ {
+ if (NILP (memq_no_quit (charset,
+ XFACE (face)->charsets_warned_about)))
+ {
+#ifdef MULE
+ if (! UNBOUNDP (charset))
+ warn_when_safe
+ (Qfont, Qwarning,
+ "Unable to instantiate font for face %s, charset %s",
+ string_data (symbol_name
+ (XSYMBOL (XFACE (face)->name))),
+ string_data (symbol_name
+ (XSYMBOL (XCHARSET_NAME (charset)))));
+ else
+#endif
+ warn_when_safe (Qfont, Qwarning,
+ "Unable to instantiate font for face %s",
+ string_data (symbol_name
+ (XSYMBOL (XFACE (face)->name))));
+ XFACE (face)->charsets_warned_about =
+ Fcons (charset, XFACE (face)->charsets_warned_about);
+ }
+ retval = Vthe_null_font_instance;
+ }
+ }
+
+ return retval;
+}
+
+\f
+DEFUN ("facep", Ffacep, 1, 1, 0, /*
+Return non-nil if OBJECT is a face.
+*/
+ (object))
+{
+ return FACEP (object) ? Qt : Qnil;
+}
+
+DEFUN ("find-face", Ffind_face, 1, 1, 0, /*
+Retrieve the face of the given name.
+If FACE-OR-NAME is a face object, it is simply returned.
+Otherwise, FACE-OR-NAME should be a symbol. If there is no such face,
+nil is returned. Otherwise the associated face object is returned.
+*/
+ (face_or_name))
+{
+ Lisp_Object retval;
+
+ if (FACEP (face_or_name))
+ return face_or_name;
+ CHECK_SYMBOL (face_or_name);
+
+ /* Check if the name represents a permanent face. */
+ retval = Fgethash (face_or_name, Vpermanent_faces_cache, Qnil);
+ if (!NILP (retval))
+ return retval;
+
+ /* Check if the name represents a temporary face. */
+ return Fgethash (face_or_name, Vtemporary_faces_cache, Qnil);
+}
+
+DEFUN ("get-face", Fget_face, 1, 1, 0, /*
+Retrieve the face of the given name.
+Same as `find-face' except an error is signalled if there is no such
+face instead of returning nil.
+*/
+ (name))
+{
+ Lisp_Object face = Ffind_face (name);
+
+ if (NILP (face))
+ signal_simple_error ("No such face", name);
+ return face;
+}
+
+DEFUN ("face-name", Fface_name, 1, 1, 0, /*
+Return the name of the given face.
+*/
+ (face))
+{
+ return XFACE (Fget_face (face))->name;
+}
+
+DEFUN ("built-in-face-specifiers", Fbuilt_in_face_specifiers, 0, 0, 0, /*
+Return a list of all built-in face specifier properties.
+Don't modify this list!
+*/
+ ())
+{
+ return Vbuilt_in_face_specifiers;
+}
+
+/* These values are retrieved so often that we make a special
+ function.
+*/
+
+void
+default_face_font_info (Lisp_Object domain, int *ascent, int *descent,
+ int *height, int *width, int *proportional_p)
+{
+ Lisp_Object font_instance;
+
+ if (noninteractive)
+ {
+ if (ascent)
+ *ascent = 1;
+ if (descent)
+ *descent = 0;
+ if (height)
+ *height = 1;
+ if (width)
+ *width = 1;
+ if (proportional_p)
+ *proportional_p = 0;
+ return;
+ }
+
+ /* We use ASCII here. This is probably reasonable because the
+ people calling this function are using the resulting values to
+ come up with overall sizes for windows and frames. */
+ if (WINDOWP (domain))
+ {
+ struct face_cachel *cachel;
+ struct window *w = XWINDOW (domain);
+
+ /* #### It's possible for this function to get called when the
+ face cachels have not been initialized. I don't know why. */
+ if (!Dynarr_length (w->face_cachels))
+ reset_face_cachels (w);
+ cachel = WINDOW_FACE_CACHEL (w, DEFAULT_INDEX);
+ font_instance = FACE_CACHEL_FONT (cachel, Vcharset_ascii);
+ }
+ else
+ {
+ font_instance = FACE_FONT (Vdefault_face, domain, Vcharset_ascii);
+ }
+
+ if (height)
+ *height = XFONT_INSTANCE (font_instance)->height;
+ if (width)
+ *width = XFONT_INSTANCE (font_instance)->width;
+ if (ascent)
+ *ascent = XFONT_INSTANCE (font_instance)->ascent;
+ if (descent)
+ *descent = XFONT_INSTANCE (font_instance)->descent;
+ if (proportional_p)
+ *proportional_p = XFONT_INSTANCE (font_instance)->proportional_p;
+}
+
+void
+default_face_height_and_width (Lisp_Object domain,
+ int *height, int *width)
+{
+ default_face_font_info (domain, 0, 0, height, width, 0);
+}
+
+void
+default_face_height_and_width_1 (Lisp_Object domain,
+ int *height, int *width)
+{
+ if (window_system_pixelated_geometry (domain))
+ {
+ if (height)
+ *height = 1;
+ if (width)
+ *width = 1;
+ }
+ else
+ default_face_height_and_width (domain, height, width);
+}
+
+DEFUN ("face-list", Fface_list, 0, 1, 0, /*
+Return a list of the names of all defined faces.
+If TEMPORARY is nil, only the permanent faces are included.
+If it is t, only the temporary faces are included. If it is any
+other non-nil value both permanent and temporary are included.
+*/
+ (temporary))
+{
+ Lisp_Object face_list = Qnil;
+
+ /* Added the permanent faces, if requested. */
+ if (NILP (temporary) || !EQ (Qt, temporary))
+ face_list = permanent_faces_list ();
+
+ if (!NILP (temporary))
+ {
+ struct gcpro gcpro1;
+ GCPRO1 (face_list);
+ face_list = nconc2 (face_list, temporary_faces_list ());
+ UNGCPRO;
+ }
+
+ return face_list;
+}
+
+DEFUN ("make-face", Fmake_face, 1, 3, 0, /*
+Define and return a new FACE described by DOC-STRING.
+You can modify the font, color, etc of a face with the set-face-* functions.
+If the face already exists, it is unmodified.
+If TEMPORARY is non-nil, this face will cease to exist if not in use.
+*/
+ (name, doc_string, temporary))
+{
+ /* This function can GC if initialized is non-zero */
+ struct Lisp_Face *f;
+ Lisp_Object face;
+
+ CHECK_SYMBOL (name);
+ if (!NILP (doc_string))
+ CHECK_STRING (doc_string);
+
+ face = Ffind_face (name);
+ if (!NILP (face))
+ return face;
+
+ f = allocate_face ();
+ XSETFACE (face, f);
+
+ f->name = name;
+ f->doc_string = doc_string;
+ f->foreground = Fmake_specifier (Qcolor);
+ set_color_attached_to (f->foreground, face, Qforeground);
+ f->background = Fmake_specifier (Qcolor);
+ set_color_attached_to (f->background, face, Qbackground);
+ f->font = Fmake_specifier (Qfont);
+ set_font_attached_to (f->font, face, Qfont);
+ f->background_pixmap = Fmake_specifier (Qimage);
+ set_image_attached_to (f->background_pixmap, face, Qbackground_pixmap);
+ f->display_table = Fmake_specifier (Qdisplay_table);
+ f->underline = Fmake_specifier (Qface_boolean);
+ set_face_boolean_attached_to (f->underline, face, Qunderline);
+ f->strikethru = Fmake_specifier (Qface_boolean);
+ set_face_boolean_attached_to (f->strikethru, face, Qstrikethru);
+ f->highlight = Fmake_specifier (Qface_boolean);
+ set_face_boolean_attached_to (f->highlight, face, Qhighlight);
+ f->dim = Fmake_specifier (Qface_boolean);
+ set_face_boolean_attached_to (f->dim, face, Qdim);
+ f->blinking = Fmake_specifier (Qface_boolean);
+ set_face_boolean_attached_to (f->blinking, face, Qblinking);
+ f->reverse = Fmake_specifier (Qface_boolean);
+ set_face_boolean_attached_to (f->reverse, face, Qreverse);
+ if (!NILP (Vdefault_face))
+ {
+ /* If the default face has already been created, set it as
+ the default fallback specifier for all the specifiers we
+ just created. This implements the standard "all faces
+ inherit from default" behavior. */
+ set_specifier_fallback (f->foreground,
+ Fget (Vdefault_face, Qforeground, Qunbound));
+ set_specifier_fallback (f->background,
+ Fget (Vdefault_face, Qbackground, Qunbound));
+ set_specifier_fallback (f->font,
+ Fget (Vdefault_face, Qfont, Qunbound));
+ set_specifier_fallback (f->background_pixmap,
+ Fget (Vdefault_face, Qbackground_pixmap,
+ Qunbound));
+ set_specifier_fallback (f->display_table,
+ Fget (Vdefault_face, Qdisplay_table, Qunbound));
+ set_specifier_fallback (f->underline,
+ Fget (Vdefault_face, Qunderline, Qunbound));
+ set_specifier_fallback (f->strikethru,
+ Fget (Vdefault_face, Qstrikethru, Qunbound));
+ set_specifier_fallback (f->highlight,
+ Fget (Vdefault_face, Qhighlight, Qunbound));
+ set_specifier_fallback (f->dim,
+ Fget (Vdefault_face, Qdim, Qunbound));
+ set_specifier_fallback (f->blinking,
+ Fget (Vdefault_face, Qblinking, Qunbound));
+ set_specifier_fallback (f->reverse,
+ Fget (Vdefault_face, Qreverse, Qunbound));
+ }
+
+ /* Add the face to the appropriate list. */
+ if (NILP (temporary))
+ Fputhash (name, face, Vpermanent_faces_cache);
+ else
+ Fputhash (name, face, Vtemporary_faces_cache);
+
+ /* Note that it's OK if we dump faces.
+ When we start up again when we're not noninteractive,
+ `init-global-faces' is called and it resources all
+ existing faces. */
+ if (initialized && !noninteractive)
+ {
+ struct gcpro gcpro1, gcpro2;
+
+ GCPRO2 (name, face);
+ call1 (Qinit_face_from_resources, name);
+ UNGCPRO;
+ }
+
+ return face;
+}
+
+\f
+/*****************************************************************************
+ initialization code
+ ****************************************************************************/
+
+void
+init_global_faces (struct device *d)
+{
+ /* When making the initial terminal device, there is no Lisp code
+ loaded, so we can't do this. */
+ if (initialized && !noninteractive)
+ {
+ call_critical_lisp_code (d, Qinit_global_faces, Qnil);
+ }
+}
+
+void
+init_device_faces (struct device *d)
+{
+ /* This function can call lisp */
+
+ /* When making the initial terminal device, there is no Lisp code
+ loaded, so we can't do this. */
+ if (initialized)
+ {
+ Lisp_Object tdevice;
+ XSETDEVICE (tdevice, d);
+ call_critical_lisp_code (d, Qinit_device_faces, tdevice);
+ }
+}
+
+void
+init_frame_faces (struct frame *frm)
+{
+ /* When making the initial terminal device, there is no Lisp code
+ loaded, so we can't do this. */
+ if (initialized)
+ {
+ Lisp_Object tframe;
+ XSETFRAME (tframe, frm);
+
+ /* DO NOT change the selected frame here. If the debugger goes off
+ it will try and display on the frame being created, but it is not
+ ready for that yet and a horrible death will occur. Any random
+ code depending on the selected-frame as an implicit arg should be
+ tracked down and shot. For the benefit of the one known,
+ xpm-color-symbols, make-frame sets the variable
+ Vframe_being_created to the frame it is making and sets it to nil
+ when done. Internal functions that this could trigger which are
+ currently depending on selected-frame should use this instead. It
+ is not currently visible at the lisp level. */
+ call_critical_lisp_code (XDEVICE (FRAME_DEVICE (frm)),
+ Qinit_frame_faces, tframe);
+ }
+}
+
+\f
+/****************************************************************************
+ * face cache element functions *
+ ****************************************************************************/
+
+/*
+
+#### Here is a description of how the face cache elements ought
+to be redone. It is *NOT* how they work currently:
+
+However, when I started to go about implementing this, I realized
+that there are all sorts of subtle problems with cache coherency
+that are coming up. As it turns out, these problems don't
+manifest themselves now due to the brute-force "kill 'em all"
+approach to cache invalidation when faces change; but if this
+is ever made smarter, these problems are going to come up, and
+some of them are very non-obvious.
+
+I'm thinking of redoing the cache code a bit to avoid these
+coherency problems. The bulk of the problems will arise because
+the current display structures have simple indices into the
+face cache, but the cache can be changed at various times,
+which could make the current display structures incorrect.
+I guess the dirty and updated flags are an attempt to fix
+this, but this approach doesn't really work.
+
+Here's an approach that should keep things clean and unconfused:
+
+1) Imagine a "virtual face cache" that can grow arbitrarily
+ big and for which the only thing allowed is to add new
+ elements. Existing elements cannot be removed or changed.
+ This way, any pointers in the existing redisplay structure
+ into the cache never get screwed up. (This is important
+ because even if a cache element is out of date, if there's
+ a pointer to it then its contents still accurately describe
+ the way the text currently looks on the screen.)
+2) Each element in the virtual cache either describes exactly
+ one face, or describes the merger of a number of faces
+ by some process. In order to simplify things, for mergers
+ we do not record which faces or ordering was used, but
+ simply that this cache element is the result of merging.
+ Unlike the current implementation, it's important that a
+ single cache element not be used to both describe a
+ single face and describe a merger, even if all the property
+ values are the same.
+3) Each cache element can be clean or dirty. "Dirty" means
+ that the face that the element points to has been changed;
+ this gets set at the time the face is changed. This
+ way, when looking up a value in the cache, you can determine
+ whether it's out of date or not. For merged faces it
+ does not matter -- we don't record the faces or priority
+ used to create the merger, so it's impossible to look up
+ one of these faces. We have to recompute it each time.
+ Luckily, this is fine -- doing the merge is much
+ less expensive than recomputing the properties of a
+ single face.
+4) For each cache element, we keep a hash value. (In order
+ to hash the boolean properties, we convert each of them
+ into a different large prime number so that the hashing works
+ well.) This allows us, when comparing runes, to properly
+ determine whether the face for that rune has changed.
+ This will be especially important for TTY's, where there
+ aren't that many faces and minimizing redraw is very
+ important.
+5) We can't actually keep an infinite cache, but that doesn't
+ really matter that much. The only elements we care about
+ are those that are used by either the current or desired
+ display structs. Therefore, we keep a per-window
+ redisplay iteration number, and mark each element with
+ that number as we use it. Just after outputting the
+ window and synching the redisplay structs, we go through
+ the cache and invalidate all elements that are not clean
+ elements referring to a particular face and that do not
+ have an iteration number equal to the current one. We
+ keep them in a chain, and use them to allocate new
+ elements when possible instead of increasing the Dynarr.
+
+ */
+
+/* mark for GC a dynarr of face cachels. */
+
+void
+mark_face_cachels (face_cachel_dynarr *elements,
+ void (*markobj) (Lisp_Object))
+{
+ int elt;
+
+ if (!elements)
+ return;
+
+ for (elt = 0; elt < Dynarr_length (elements); elt++)
+ {
+ struct face_cachel *cachel = Dynarr_atp (elements, elt);
+
+ {
+ int i;
+
+ for (i = 0; i < NUM_LEADING_BYTES; i++)
+ if (!NILP (cachel->font[i]) && !UNBOUNDP (cachel->font[i]))
+ ((markobj) (cachel->font[i]));
+ }
+ ((markobj) (cachel->face));
+ ((markobj) (cachel->foreground));
+ ((markobj) (cachel->background));
+ ((markobj) (cachel->display_table));
+ ((markobj) (cachel->background_pixmap));
+ }
+}
+
+/* ensure that the given cachel contains an updated font value for
+ the given charset. Return the updated font value. */
+
+Lisp_Object
+ensure_face_cachel_contains_charset (struct face_cachel *cachel,
+ Lisp_Object domain, Lisp_Object charset)
+{
+ Lisp_Object new_val;
+ Lisp_Object face = cachel->face;
+ int bound = 1;
+ int offs = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
+
+ if (!UNBOUNDP (cachel->font[offs])
+ && cachel->font_updated[offs])
+ return cachel->font[offs];
+
+ if (UNBOUNDP (face))
+ {
+ /* a merged face. */
+ int i;
+ struct window *w = XWINDOW (domain);
+
+ new_val = Qunbound;
+ cachel->font_specified[offs] = 0;
+ for (i = 0; i < cachel->nfaces; i++)
+ {
+ struct face_cachel *oth;
+
+ oth = Dynarr_atp (w->face_cachels,
+ FACE_CACHEL_FINDEX_UNSAFE (cachel, i));
+ /* Tout le monde aime la recursion */
+ ensure_face_cachel_contains_charset (oth, domain, charset);
+
+ if (oth->font_specified[offs])
+ {
+ new_val = oth->font[offs];
+ cachel->font_specified[offs] = 1;
+ break;
+ }
+ }
+
+ if (!cachel->font_specified[offs])
+ /* need to do the default face. */
+ {
+ struct face_cachel *oth =
+ Dynarr_atp (w->face_cachels, DEFAULT_INDEX);
+ ensure_face_cachel_contains_charset (oth, domain, charset);
+
+ new_val = oth->font[offs];
+ }
+
+ if (!UNBOUNDP (cachel->font[offs]) && !EQ (cachel->font[offs], new_val))
+ cachel->dirty = 1;
+ cachel->font_updated[offs] = 1;
+ cachel->font[offs] = new_val;
+ return new_val;
+ }
+
+ new_val = face_property_matching_instance (face, Qfont, charset, domain,
+ /* #### look into ERROR_ME_NOT */
+ ERROR_ME_NOT, 1, Qzero);
+ if (UNBOUNDP (new_val))
+ {
+ bound = 0;
+ new_val = face_property_matching_instance (face, Qfont,
+ charset, domain,
+ /* #### look into
+ ERROR_ME_NOT */
+ ERROR_ME_NOT, 0, Qzero);
+ }
+ if (!UNBOUNDP (cachel->font[offs]) && !EQ (new_val, cachel->font[offs]))
+ cachel->dirty = 1;
+ cachel->font_updated[offs] = 1;
+ cachel->font[offs] = new_val;
+ cachel->font_specified[offs] = (bound || EQ (face, Vdefault_face));
+ return new_val;
+}
+
+/* Ensure that the given cachel contains updated fonts for all
+ the charsets specified. */
+
+void
+ensure_face_cachel_complete (struct face_cachel *cachel,
+ Lisp_Object domain, unsigned char *charsets)
+{
+ int i;
+
+ for (i = 0; i < NUM_LEADING_BYTES; i++)
+ if (charsets[i])
+ {
+ Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i + MIN_LEADING_BYTE);
+ assert (CHARSETP (charset));
+ ensure_face_cachel_contains_charset (cachel, domain, charset);
+ }
+}
+
+void
+face_cachel_charset_font_metric_info (struct face_cachel *cachel,
+ unsigned char *charsets,
+ struct font_metric_info *fm)
+{
+ int i;
+
+ fm->width = 1;
+ fm->height = fm->ascent = 1;
+ fm->descent = 0;
+ fm->proportional_p = 0;
+
+ for (i = 0; i < NUM_LEADING_BYTES; i++)
+ {
+ if (charsets[i])
+ {
+ 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);
+
+ assert (CHARSETP (charset));
+ assert (FONT_INSTANCEP (font_instance));
+
+ if (fm->ascent < (int) fi->ascent) fm->ascent = (int) fi->ascent;
+ if (fm->descent < (int) fi->descent) fm->descent = (int) fi->descent;
+ fm->height = fm->ascent + fm->descent;
+ if (fi->proportional_p)
+ fm->proportional_p = 1;
+ if (EQ (charset, Vcharset_ascii))
+ fm->width = fi->width;
+ }
+ }
+}
+
+/* Called when the updated flag has been cleared on a cachel. */
+
+void
+update_face_cachel_data (struct face_cachel *cachel,
+ Lisp_Object domain,
+ Lisp_Object face)
+{
+ if (XFACE (face)->dirty || UNBOUNDP (cachel->face))
+ {
+ int default_face = EQ (face, Vdefault_face);
+ cachel->face = face;
+
+ /* We normally only set the _specified flags if the value was
+ actually bound. The exception is for the default face where
+ we always set it since it is the ultimate fallback. */
+
+#define FROB(field) \
+ do { \
+ Lisp_Object new_val = \
+ FACE_PROPERTY_INSTANCE (face, Q##field, domain, 1, Qzero); \
+ int bound = 1; \
+ if (UNBOUNDP (new_val)) \
+ { \
+ bound = 0; \
+ new_val = FACE_PROPERTY_INSTANCE (face, Q##field, domain, 0, Qzero); \
+ } \
+ if (!EQ (new_val, cachel->field)) \
+ { \
+ cachel->field = new_val; \
+ cachel->dirty = 1; \
+ } \
+ cachel->field##_specified = (bound || default_face); \
+ } while (0)
+
+ FROB (foreground);
+ FROB (background);
+ FROB (display_table);
+ FROB (background_pixmap);
+
+ /*
+ * A face's background pixmap will override the face's
+ * background color. But the background pixmap of the
+ * default face should not override the background color of
+ * a face if the background color has been specified or
+ * inherited.
+ *
+ * To accomplish this we remove the background pixmap of the
+ * cachel and mark it as having been specified so that cachel
+ * merging won't override it later.
+ */
+ if (! default_face
+ && cachel->background_specified
+ && ! cachel->background_pixmap_specified)
+ {
+ cachel->background_pixmap = Qunbound;
+ cachel->background_pixmap_specified = 1;
+ }
+
+#undef FROB
+
+ ensure_face_cachel_contains_charset (cachel, domain, Vcharset_ascii);
+
+#define FROB(field) \
+ do { \
+ Lisp_Object new_val = \
+ FACE_PROPERTY_INSTANCE (face, Q##field, domain, 1, Qzero); \
+ int bound = 1; \
+ unsigned int new_val_int; \
+ if (UNBOUNDP (new_val)) \
+ { \
+ bound = 0; \
+ new_val = FACE_PROPERTY_INSTANCE (face, Q##field, domain, 0, Qzero); \
+ } \
+ new_val_int = EQ (new_val, Qt); \
+ if (cachel->field != new_val_int) \
+ { \
+ cachel->field = new_val_int; \
+ cachel->dirty = 1; \
+ } \
+ cachel->field##_specified = bound; \
+ } while (0)
+
+ FROB (underline);
+ FROB (strikethru);
+ FROB (highlight);
+ FROB (dim);
+ FROB (reverse);
+ FROB (blinking);
+#undef FROB
+ }
+
+ cachel->updated = 1;
+}
+
+/* Merge the cachel identified by FINDEX in window W into the given
+ cachel. */
+
+static void
+merge_face_cachel_data (struct window *w, face_index findex,
+ struct face_cachel *cachel)
+{
+#define FINDEX_FIELD(field) \
+ Dynarr_atp (w->face_cachels, findex)->field
+
+#define FROB(field) \
+ do { \
+ if (!cachel->field##_specified && FINDEX_FIELD (field##_specified)) \
+ { \
+ cachel->field = FINDEX_FIELD (field); \
+ cachel->field##_specified = 1; \
+ cachel->dirty = 1; \
+ } \
+ } while (0)
+
+ FROB (foreground);
+ FROB (background);
+ FROB (display_table);
+ FROB (background_pixmap);
+ FROB (underline);
+ FROB (strikethru);
+ FROB (highlight);
+ FROB (dim);
+ FROB (reverse);
+ FROB (blinking);
+ /* And do ASCII, of course. */
+ {
+ int offs = LEADING_BYTE_ASCII - MIN_LEADING_BYTE;
+
+ if (!cachel->font_specified[offs] && FINDEX_FIELD (font_specified[offs]))
+ {
+ cachel->font[offs] = FINDEX_FIELD (font[offs]);
+ cachel->font_specified[offs] = 1;
+ cachel->dirty = 1;
+ }
+ }
+
+#undef FROB
+#undef FINDEX_FIELD
+
+ cachel->updated = 1;
+}
+
+/* Initialize a cachel. */
+
+void
+reset_face_cachel (struct face_cachel *cachel)
+{
+ xzero (*cachel);
+ cachel->face = Qunbound;
+ cachel->nfaces = 0;
+ cachel->merged_faces = 0;
+ cachel->foreground = Qunbound;
+ cachel->background = Qunbound;
+ {
+ int i;
+
+ for (i = 0; i < NUM_LEADING_BYTES; i++)
+ cachel->font[i] = Qunbound;
+ }
+ cachel->display_table = Qunbound;
+ cachel->background_pixmap = Qunbound;
+}
+
+/* Add a cachel for the given face to the given window's cache. */
+
+static void
+add_face_cachel (struct window *w, Lisp_Object face)
+{
+ struct face_cachel new_cachel;
+ Lisp_Object window;
+
+ reset_face_cachel (&new_cachel);
+ XSETWINDOW (window, w);
+ update_face_cachel_data (&new_cachel, window, face);
+ Dynarr_add (w->face_cachels, new_cachel);
+}
+
+/* Retrieve the index to a cachel for window W that corresponds to
+ the specified face. If necessary, add a new element to the
+ cache. */
+
+face_index
+get_builtin_face_cache_index (struct window *w, Lisp_Object face)
+{
+ int elt;
+
+ if (noninteractive)
+ return 0;
+
+ for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++)
+ {
+ struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, elt);
+
+ if (EQ (cachel->face, face))
+ {
+ Lisp_Object window;
+ XSETWINDOW (window, w);
+ if (!cachel->updated)
+ update_face_cachel_data (cachel, window, face);
+ return elt;
+ }
+ }
+
+ /* If we didn't find the face, add it and then return its index. */
+ add_face_cachel (w, face);
+ return elt;
+}
+
+void
+reset_face_cachels (struct window *w)
+{
+ /* #### Not initialized in batch mode for the stream device. */
+ if (w->face_cachels)
+ {
+ int i;
+
+ for (i = 0; i < Dynarr_length (w->face_cachels); i++)
+ {
+ struct face_cachel *cachel = Dynarr_atp (w->face_cachels, i);
+ if (cachel->merged_faces)
+ Dynarr_free (cachel->merged_faces);
+ }
+ Dynarr_reset (w->face_cachels);
+ get_builtin_face_cache_index (w, Vdefault_face);
+ get_builtin_face_cache_index (w, Vmodeline_face);
+ XFRAME (w->frame)->window_face_cache_reset = 1;
+ }
+}
+
+void
+mark_face_cachels_as_clean (struct window *w)
+{
+ int elt;
+
+ for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++)
+ Dynarr_atp (w->face_cachels, elt)->dirty = 0;
+}
+
+void
+mark_face_cachels_as_not_updated (struct window *w)
+{
+ int elt;
+
+ for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++)
+ {
+ struct face_cachel *cachel = Dynarr_atp (w->face_cachels, elt);
+ int i;
+
+ cachel->updated = 0;
+ for (i = 0; i < NUM_LEADING_BYTES; i++)
+ cachel->font_updated[i] = 0;
+ }
+}
+
+#ifdef MEMORY_USAGE_STATS
+
+int
+compute_face_cachel_usage (face_cachel_dynarr *face_cachels,
+ struct overhead_stats *ovstats)
+{
+ int total = 0;
+
+ if (face_cachels)
+ {
+ int i;
+
+ total += Dynarr_memory_usage (face_cachels, ovstats);
+ for (i = 0; i < Dynarr_length (face_cachels); i++)
+ {
+ int_dynarr *merged = Dynarr_at (face_cachels, i).merged_faces;
+ if (merged)
+ total += Dynarr_memory_usage (merged, ovstats);
+ }
+ }
+
+ return total;
+}
+
+#endif /* MEMORY_USAGE_STATS */
+
+\f
+/*****************************************************************************
+ * merged face functions *
+ *****************************************************************************/
+
+/* Compare two merged face cachels to determine whether we have to add
+ a new entry to the face cache.
+
+ Note that we do not compare the attributes, but just the faces the
+ cachels are based on. If they are the same, then the cachels certainly
+ ought to have the same attributes, except in the case where fonts
+ for different charsets have been determined in the two -- and in that
+ case this difference is fine. */
+
+static int
+compare_merged_face_cachels (struct face_cachel *cachel1,
+ struct face_cachel *cachel2)
+{
+ int i;
+
+ if (!EQ (cachel1->face, cachel2->face)
+ || cachel1->nfaces != cachel2->nfaces)
+ return 0;
+
+ for (i = 0; i < cachel1->nfaces; i++)
+ if (FACE_CACHEL_FINDEX_UNSAFE (cachel1, i)
+ != FACE_CACHEL_FINDEX_UNSAFE (cachel2, i))
+ return 0;
+
+ return 1;
+}
+
+/* Retrieve the index to a cachel for window W that corresponds to
+ the specified cachel. If necessary, add a new element to the
+ cache. This is similar to get_builtin_face_cache_index() but
+ is intended for merged cachels rather than for cachels representing
+ just a face.
+
+ Note that a merged cachel for just one face is not the same as
+ the simple cachel for that face, because it is also merged with
+ the default face. */
+
+static face_index
+get_merged_face_cache_index (struct window *w,
+ struct face_cachel *merged_cachel)
+{
+ int elt;
+ int cache_size = Dynarr_length (w->face_cachels);
+
+ for (elt = 0; elt < cache_size; elt++)
+ {
+ struct face_cachel *cachel =
+ Dynarr_atp (w->face_cachels, elt);
+
+ if (compare_merged_face_cachels (cachel, merged_cachel))
+ return elt;
+ }
+
+ /* We didn't find it so add this instance to the cache. */
+ merged_cachel->updated = 1;
+ merged_cachel->dirty = 1;
+ Dynarr_add (w->face_cachels, *merged_cachel);
+ return cache_size;
+}
+
+face_index
+get_extent_fragment_face_cache_index (struct window *w,
+ struct extent_fragment *ef)
+{
+ struct face_cachel cachel;
+ int len = Dynarr_length (ef->extents);
+ face_index findex = 0;
+ Lisp_Object window;
+ XSETWINDOW (window, w);
+
+ /* Optimize the default case. */
+ if (len == 0)
+ return DEFAULT_INDEX;
+ else
+ {
+ int i;
+
+ /* Merge the faces of the extents together in order. */
+
+ reset_face_cachel (&cachel);
+
+ for (i = len - 1; i >= 0; i--)
+ {
+ EXTENT current = Dynarr_at (ef->extents, i);
+ int has_findex = 0;
+ Lisp_Object face = extent_face (current);
+
+ if (FACEP (face))
+ {
+ findex = get_builtin_face_cache_index (w, face);
+ has_findex = 1;
+ merge_face_cachel_data (w, findex, &cachel);
+ }
+ /* remember, we're called from within redisplay
+ so we can't error. */
+ else while (CONSP (face))
+ {
+ Lisp_Object one_face = XCAR (face);
+ if (FACEP (one_face))
+ {
+ findex = get_builtin_face_cache_index (w, one_face);
+ merge_face_cachel_data (w, findex, &cachel);
+
+ /* code duplication here but there's no clean
+ way to avoid it. */
+ if (cachel.nfaces >= NUM_STATIC_CACHEL_FACES)
+ {
+ if (!cachel.merged_faces)
+ cachel.merged_faces = Dynarr_new (int);
+ Dynarr_add (cachel.merged_faces, findex);
+ }
+ else
+ cachel.merged_faces_static[cachel.nfaces] = findex;
+ cachel.nfaces++;
+ }
+ face = XCDR (face);
+ }
+
+ if (has_findex)
+ {
+ if (cachel.nfaces >= NUM_STATIC_CACHEL_FACES)
+ {
+ if (!cachel.merged_faces)
+ cachel.merged_faces = Dynarr_new (int);
+ Dynarr_add (cachel.merged_faces, findex);
+ }
+ else
+ cachel.merged_faces_static[cachel.nfaces] = findex;
+ cachel.nfaces++;
+ }
+ }
+
+ /* Now finally merge in the default face. */
+ findex = get_builtin_face_cache_index (w, Vdefault_face);
+ merge_face_cachel_data (w, findex, &cachel);
+
+ return get_merged_face_cache_index (w, &cachel);
+ }
+}
+
+\f
+/*****************************************************************************
+ interface functions
+ ****************************************************************************/
+
+static void
+update_EmacsFrame (Lisp_Object frame, Lisp_Object name)
+{
+ struct frame *frm = XFRAME (frame);
+
+ if (EQ (name, Qfont))
+ MARK_FRAME_SIZE_SLIPPED (frm);
+
+ MAYBE_FRAMEMETH (frm, update_frame_external_traits, (frm, name));
+}
+
+static void
+update_EmacsFrames (Lisp_Object locale, Lisp_Object name)
+{
+ if (FRAMEP (locale))
+ {
+ update_EmacsFrame (locale, name);
+ }
+ else if (DEVICEP (locale))
+ {
+ Lisp_Object frmcons;
+
+ DEVICE_FRAME_LOOP (frmcons, XDEVICE (locale))
+ update_EmacsFrame (XCAR (frmcons), name);
+ }
+ else if (EQ (locale, Qglobal) || EQ (locale, Qfallback))
+ {
+ Lisp_Object frmcons, devcons, concons;
+
+ FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
+ update_EmacsFrame (XCAR (frmcons), name);
+ }
+}
+
+void
+update_frame_face_values (struct frame *f)
+{
+ Lisp_Object frm;
+
+ XSETFRAME (frm, f);
+ update_EmacsFrame (frm, Qforeground);
+ update_EmacsFrame (frm, Qbackground);
+ update_EmacsFrame (frm, Qfont);
+}
+
+void
+face_property_was_changed (Lisp_Object face, Lisp_Object property,
+ Lisp_Object locale)
+{
+ int default_face = EQ (face, Vdefault_face);
+
+ /* If the locale could affect the frame value, then call
+ update_EmacsFrames just in case. */
+ if (default_face &&
+ (EQ (property, Qforeground) ||
+ EQ (property, Qbackground) ||
+ EQ (property, Qfont)))
+ update_EmacsFrames (locale, property);
+
+ if (WINDOWP (locale))
+ {
+ struct frame *f = XFRAME (XWINDOW (locale)->frame);
+ MARK_FRAME_FACES_CHANGED (f);
+ }
+ else if (FRAMEP (locale))
+ {
+ struct frame *f = XFRAME (locale);
+ MARK_FRAME_FACES_CHANGED (f);
+ }
+ else if (DEVICEP (locale))
+ {
+ struct device *d = XDEVICE (locale);
+ MARK_DEVICE_FRAMES_FACES_CHANGED (d);
+ }
+ else
+ {
+ Lisp_Object devcons, concons;
+
+ DEVICE_LOOP_NO_BREAK (devcons, concons)
+ MARK_DEVICE_FRAMES_FACES_CHANGED (XDEVICE (XCAR (devcons)));
+ }
+
+ /*
+ * This call to update_faces_inheritance isn't needed and makes
+ * creating and modifying faces _very_ slow. The point of
+ * update_face_inheritances is to find all faces that inherit
+ * directly from this face property and set the specifier "dirty"
+ * flag on the corresponding specifier. This forces recaching of
+ * cached specifier values in frame and window struct slots. But
+ * currently no face properties are cached in frame and window
+ * struct slots, so calling this function does nothing useful!
+ *
+ * Further, since update_faces_inheritance maps over the whole
+ * face table every time it is called, it gets terribly slow when
+ * there are many faces. Creating 500 faces on a 50Mhz 486 took
+ * 433 seconds when update_faces_inheritance was called. With the
+ * call commented out, creating those same 500 faces took 0.72
+ * seconds.
+ */
+ /* update_faces_inheritance (face, property);*/
+ XFACE (face)->dirty = 1;
+}
+
+DEFUN ("copy-face", Fcopy_face, 2, 6, 0, /*
+Define and return a new face which is a copy of an existing one,
+or makes an already-existing face be exactly like another.
+LOCALE, TAG-SET, EXACT-P, and HOW-TO-ADD are as in `copy-specifier'.
+*/
+ (old_face, new_name, locale, tag_set, exact_p, how_to_add))
+{
+ struct Lisp_Face *fold, *fnew;
+ Lisp_Object new_face = Qnil;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+
+ old_face = Fget_face (old_face);
+
+ /* We GCPRO old_face because it might be temporary, and GCing could
+ occur in various places below. */
+ GCPRO4 (tag_set, locale, old_face, new_face);
+ /* check validity of how_to_add now. */
+ decode_how_to_add_specification (how_to_add);
+ /* and of tag_set. */
+ tag_set = decode_specifier_tag_set (tag_set);
+ /* and of locale. */
+ locale = decode_locale_list (locale);
+
+ new_face = Ffind_face (new_name);
+ if (NILP (new_face))
+ {
+ Lisp_Object temp;
+
+ CHECK_SYMBOL (new_name);
+
+ /* Create the new face with the same status as the old face. */
+ temp = (NILP (Fgethash (old_face, Vtemporary_faces_cache, Qnil))
+ ? Qnil
+ : Qt);
+
+ new_face = Fmake_face (new_name, Qnil, temp);
+ }
+
+ fold = XFACE (old_face);
+ fnew = XFACE (new_face);
+
+#define COPY_PROPERTY(property) \
+ Fcopy_specifier (fold->property, fnew->property, \
+ locale, tag_set, exact_p, how_to_add);
+
+ COPY_PROPERTY (foreground);
+ COPY_PROPERTY (background);
+ COPY_PROPERTY (font);
+ COPY_PROPERTY (display_table);
+ COPY_PROPERTY (background_pixmap);
+ COPY_PROPERTY (underline);
+ COPY_PROPERTY (strikethru);
+ COPY_PROPERTY (highlight);
+ COPY_PROPERTY (dim);
+ COPY_PROPERTY (blinking);
+ COPY_PROPERTY (reverse);
+#undef COPY_PROPERTY
+ /* #### should it copy the individual specifiers, if they exist? */
+ fnew->plist = Fcopy_sequence (fold->plist);
+
+ UNGCPRO;
+
+ return new_name;
+}
+
+\f
+void
+syms_of_faces (void)
+{
+ /* Qdefault 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");
+
+ DEFSUBR (Ffacep);
+ DEFSUBR (Ffind_face);
+ DEFSUBR (Fget_face);
+ DEFSUBR (Fface_name);
+ DEFSUBR (Fbuilt_in_face_specifiers);
+ DEFSUBR (Fface_list);
+ DEFSUBR (Fmake_face);
+ DEFSUBR (Fcopy_face);
+
+ defsymbol (&Qfacep, "facep");
+ defsymbol (&Qforeground, "foreground");
+ defsymbol (&Qbackground, "background");
+ /* Qfont defined in general.c */
+ defsymbol (&Qdisplay_table, "display-table");
+ defsymbol (&Qbackground_pixmap, "background-pixmap");
+ defsymbol (&Qunderline, "underline");
+ defsymbol (&Qstrikethru, "strikethru");
+ /* Qhighlight, Qreverse defined in general.c */
+ defsymbol (&Qdim, "dim");
+ defsymbol (&Qblinking, "blinking");
+
+ defsymbol (&Qinit_face_from_resources, "init-face-from-resources");
+ defsymbol (&Qinit_global_faces, "init-global-faces");
+ defsymbol (&Qinit_device_faces, "init-device-faces");
+ defsymbol (&Qinit_frame_faces, "init-frame-faces");
+}
+
+void
+structure_type_create_faces (void)
+{
+ struct structure_type *st;
+
+ st = define_structure_type (Qface, face_validate, face_instantiate);
+
+ define_structure_type_keyword (st, Qname, face_name_validate);
+}
+
+void
+vars_of_faces (void)
+{
+ staticpro (&Vpermanent_faces_cache);
+ Vpermanent_faces_cache = Qnil;
+ staticpro (&Vtemporary_faces_cache);
+ Vtemporary_faces_cache = Qnil;
+
+ staticpro (&Vdefault_face);
+ Vdefault_face = Qnil;
+ staticpro (&Vgui_element_face);
+ Vgui_element_face = Qnil;
+ staticpro (&Vmodeline_face);
+ Vmodeline_face = Qnil;
+ staticpro (&Vtoolbar_face);
+ Vtoolbar_face = Qnil;
+
+ staticpro (&Vvertical_divider_face);
+ Vvertical_divider_face = Qnil;
+ staticpro (&Vleft_margin_face);
+ Vleft_margin_face = Qnil;
+ staticpro (&Vright_margin_face);
+ Vright_margin_face = Qnil;
+ staticpro (&Vtext_cursor_face);
+ Vtext_cursor_face = Qnil;
+ staticpro (&Vpointer_face);
+ Vpointer_face = Qnil;
+
+ {
+ Lisp_Object syms[20];
+ int n = 0;
+
+ syms[n++] = Qforeground;
+ syms[n++] = Qbackground;
+ syms[n++] = Qfont;
+ syms[n++] = Qdisplay_table;
+ syms[n++] = Qbackground_pixmap;
+ syms[n++] = Qunderline;
+ syms[n++] = Qstrikethru;
+ syms[n++] = Qhighlight;
+ syms[n++] = Qdim;
+ syms[n++] = Qblinking;
+ syms[n++] = Qreverse;
+
+ Vbuilt_in_face_specifiers = pure_list (n, syms);
+ staticpro (&Vbuilt_in_face_specifiers);
+ }
+}
+
+void
+complex_vars_of_faces (void)
+{
+ Vpermanent_faces_cache = make_lisp_hashtable (10, HASHTABLE_NONWEAK,
+ HASHTABLE_EQ);
+ Vtemporary_faces_cache = make_lisp_hashtable (0, HASHTABLE_WEAK,
+ HASHTABLE_EQ);
+
+ /* Create the default face now so we know what it is immediately. */
+
+ Vdefault_face = Qnil; /* so that Fmake_face() doesn't set up a bogus
+ default value */
+ Vdefault_face = Fmake_face (Qdefault, build_string ("default face"),
+ Qnil);
+
+ /* Provide some last-resort fallbacks to avoid utter fuckage if
+ someone provides invalid values for the global specifications. */
+
+ {
+ Lisp_Object fg_fb = Qnil, bg_fb = Qnil;
+
+#ifdef HAVE_X_WINDOWS
+ fg_fb = acons (list1 (Qx), build_string ("black"), fg_fb);
+ bg_fb = acons (list1 (Qx), build_string ("white"), bg_fb);
+#endif
+#ifdef HAVE_TTY
+ fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb);
+ bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb);
+#endif
+#ifdef HAVE_MS_WINDOWS
+ fg_fb = acons (list1 (Qmswindows), build_string ("black"), fg_fb);
+ bg_fb = acons (list1 (Qmswindows), build_string ("white"), bg_fb);
+#endif
+ set_specifier_fallback (Fget (Vdefault_face, Qforeground, Qnil), fg_fb);
+ set_specifier_fallback (Fget (Vdefault_face, Qbackground, Qnil), bg_fb);
+ }
+
+ /* #### We may want to have different fallback values if NeXTstep
+ support is compiled in. */
+ {
+ Lisp_Object inst_list = Qnil;
+#ifdef HAVE_X_WINDOWS
+ /* The same gory list from x-faces.el.
+ (#### Perhaps we should remove the stuff from x-faces.el
+ and only depend on this stuff here? That should work.)
+ */
+ CONST char *fonts[] =
+ {
+ "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*",
+ "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*",
+ "-*-courier-*-r-*-*-*-120-*-*-*-*-iso8859-*",
+ "-*-*-medium-r-*-*-*-120-*-*-m-*-iso8859-*",
+ "-*-*-medium-r-*-*-*-120-*-*-c-*-iso8859-*",
+ "-*-*-*-r-*-*-*-120-*-*-m-*-iso8859-*",
+ "-*-*-*-r-*-*-*-120-*-*-c-*-iso8859-*",
+ "-*-*-*-r-*-*-*-120-*-*-*-*-iso8859-*",
+ "-*-*-medium-r-*-*-*-120-*-*-m-*-*-*",
+ "-*-*-medium-r-*-*-*-120-*-*-c-*-*-*",
+ "-*-*-*-r-*-*-*-120-*-*-m-*-*-*",
+ "-*-*-*-r-*-*-*-120-*-*-c-*-*-*",
+ "-*-*-*-r-*-*-*-120-*-*-*-*-*-*",
+ "-*-*-*-*-*-*-*-120-*-*-*-*-*-*",
+ "*"
+ };
+ CONST char **fontptr;
+
+ for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts; fontptr--)
+ inst_list = Fcons (Fcons (list1 (Qx), build_string (*fontptr)),
+ inst_list);
+#endif /* HAVE_X_WINDOWS */
+
+#ifdef HAVE_TTY
+ inst_list = Fcons (Fcons (list1 (Qtty), build_string ("normal")),
+ inst_list);
+#endif /* HAVE_TTY */
+#ifdef HAVE_MS_WINDOWS
+ inst_list = Fcons (Fcons (list1 (Qmswindows), build_string ("Courier New")),
+ inst_list);
+#endif /* HAVE_MS_WINDOWS */
+ set_specifier_fallback (Fget (Vdefault_face, Qfont, Qnil), inst_list);
+ }
+
+ set_specifier_fallback (Fget (Vdefault_face, Qunderline, Qnil),
+ list1 (Fcons (Qnil, Qnil)));
+ set_specifier_fallback (Fget (Vdefault_face, Qstrikethru, Qnil),
+ list1 (Fcons (Qnil, Qnil)));
+ set_specifier_fallback (Fget (Vdefault_face, Qhighlight, Qnil),
+ list1 (Fcons (Qnil, Qnil)));
+ set_specifier_fallback (Fget (Vdefault_face, Qdim, Qnil),
+ list1 (Fcons (Qnil, Qnil)));
+ set_specifier_fallback (Fget (Vdefault_face, Qblinking, Qnil),
+ list1 (Fcons (Qnil, Qnil)));
+ set_specifier_fallback (Fget (Vdefault_face, Qreverse, Qnil),
+ list1 (Fcons (Qnil, Qnil)));
+
+ /* gui-element is the parent face of all gui elements such as
+ modeline, vertical divider and toolbar. */
+ Vgui_element_face = Fmake_face (Qgui_element,
+ build_string ("gui element face"),
+ Qnil);
+
+ /* Provide some last-resort fallbacks for gui-element face which
+ mustn't default to default. */
+ {
+ Lisp_Object fg_fb = Qnil, bg_fb = Qnil;
+
+#ifdef HAVE_X_WINDOWS
+ fg_fb = acons (list1 (Qx), build_string ("black"), fg_fb);
+ bg_fb = acons (list1 (Qx), build_string ("Gray80"), bg_fb);
+#endif
+#ifdef HAVE_TTY
+ fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb);
+ bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb);
+#endif
+#ifdef HAVE_MS_WINDOWS
+ fg_fb = acons (list1 (Qmswindows), build_string ("black"), fg_fb);
+ bg_fb = acons (list1 (Qmswindows), build_string ("Gray75"), bg_fb);
+#endif
+ set_specifier_fallback (Fget (Vgui_element_face, Qforeground, Qnil), fg_fb);
+ set_specifier_fallback (Fget (Vgui_element_face, Qbackground, Qnil), bg_fb);
+ }
+
+ /* Now create the other faces that redisplay needs to refer to
+ directly. We could create them in Lisp but it's simpler this
+ way since we need to get them anyway. */
+
+ /* modeline is gui element. */
+ Vmodeline_face = Fmake_face (Qmodeline, build_string ("modeline face"),
+ Qnil);
+
+ set_specifier_fallback (Fget (Vmodeline_face, Qforeground, Qunbound),
+ Fget (Vgui_element_face, Qforeground, Qunbound));
+ set_specifier_fallback (Fget (Vmodeline_face, Qbackground, Qunbound),
+ Fget (Vgui_element_face, Qbackground, Qunbound));
+ set_specifier_fallback (Fget (Vmodeline_face, Qbackground_pixmap, Qnil),
+ Fget (Vgui_element_face, Qbackground_pixmap,
+ Qunbound));
+
+ /* toolbar is another gui element */
+ Vtoolbar_face = Fmake_face (Qtoolbar,
+ build_string ("toolbar face"),
+ Qnil);
+ set_specifier_fallback (Fget (Vtoolbar_face, Qforeground, Qunbound),
+ Fget (Vgui_element_face, Qforeground, Qunbound));
+ set_specifier_fallback (Fget (Vtoolbar_face, Qbackground, Qunbound),
+ Fget (Vgui_element_face, Qbackground, Qunbound));
+ set_specifier_fallback (Fget (Vtoolbar_face, Qbackground_pixmap, Qnil),
+ Fget (Vgui_element_face, Qbackground_pixmap,
+ Qunbound));
+
+ /* vertical divider is another gui element */
+ Vvertical_divider_face = Fmake_face (Qvertical_divider,
+ build_string ("vertical divider face"),
+ Qnil);
+
+ set_specifier_fallback (Fget (Vvertical_divider_face, Qforeground, Qunbound),
+ Fget (Vgui_element_face, Qforeground, Qunbound));
+ set_specifier_fallback (Fget (Vvertical_divider_face, Qbackground, Qunbound),
+ Fget (Vgui_element_face, Qbackground, Qunbound));
+ set_specifier_fallback (Fget (Vvertical_divider_face, Qbackground_pixmap,
+ Qunbound),
+ Fget (Vgui_element_face, Qbackground_pixmap,
+ Qunbound));
+
+ Vleft_margin_face = Fmake_face (Qleft_margin,
+ build_string ("left margin face"),
+ Qnil);
+ Vright_margin_face = Fmake_face (Qright_margin,
+ build_string ("right margin face"),
+ Qnil);
+ Vtext_cursor_face = Fmake_face (Qtext_cursor,
+ build_string ("face for text cursor"),
+ Qnil);
+ Vpointer_face =
+ Fmake_face (Qpointer,
+ build_string
+ ("face for foreground/background colors of mouse pointer"),
+ Qnil);
+}
--- /dev/null
+/* Face data structures.
+ Copyright (C) 1995 Board of Trustees, University of Illinois.
+ Copyright (C) 1995 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 _XEMACS_FACES_H_
+#define _XEMACS_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
+ properties. */
+
+struct Lisp_Face
+{
+ struct lcrecord_header header;
+
+ Lisp_Object name;
+ Lisp_Object doc_string;
+ unsigned int dirty :1; /* Set whenever a face property is changed on
+ a face. */
+
+ Lisp_Object foreground;
+ Lisp_Object background;
+ Lisp_Object font;
+
+ Lisp_Object display_table;
+ Lisp_Object background_pixmap;
+
+ Lisp_Object underline;
+ Lisp_Object strikethru;
+ Lisp_Object highlight;
+ Lisp_Object dim;
+ Lisp_Object blinking;
+ Lisp_Object reverse;
+
+ Lisp_Object plist;
+
+ Lisp_Object charsets_warned_about;
+};
+
+/*
+
+ A face cache element caches the results of instantiating the
+ properties of a face in a particular window. (Instantiation can
+ take a long time so this is very important.) Each window contains
+ an array of face cache elements (called the "face cache"), one for
+ each face that has been seen in the window so far.
+
+ Some tricky stuff is done to make sure the face cache does not
+ become inconsistent:
+
+ 1) Switching buffers in a window clears the face cache for that
+ window, because this can change the way any property is
+ instantiated in the window.
+ 2) Setting a face property causes that face to be marked as
+ dirty. This causes various stuff to happen to make sure
+ the appropriate face cache elements are invalidated.
+ (#### Actually this doesn't work quite right, and errs
+ too much on the side of invalidating unnecessary stuff.)
+
+ There are also face cache elements for "merged faces", which are the
+ result of merging all the faces that overlap a particular buffer
+ position. The merging is always done in the context of a particular
+ domain (specifically, a window), and the face cache element is
+ specific to a particular window. (Face cache elements are contained
+ in an array that is attached to each struct_window.) The reason that
+ the merging takes place in the context of a particular window has
+ to do with the way the merging works:
+
+ 1) All extents overlying the buffer position are sorted by descending
+ priority.
+ 2) The property of a particular merged face comes from the highest-
+ priority face that specifies a value for that particular property.
+ 3) The way to determine whether a face specifies a value for a
+ particular property is to instantiate that face's property in
+ the window in question with the no-fallback option set, to
+ see if we got anything.
+
+ For Mule, things get a bit trickier because there can be multiple
+ fonts per face/window combination -- the charset is an argument
+ to specifier-instance.
+
+ We have two possible data structure representations:
+
+ 1) Keep the original "one font per face cache element" representation
+ and use a different face cache element for each charset.
+ 2) Allow multiple fonts to be in a single face cache element.
+
+ I've chosen to use (2) -- the data structure gets more complicated
+ but the algorithms for maintaining face cache elements end up
+ simpler.
+ */
+
+#define NUM_STATIC_CACHEL_FACES 4
+
+typedef struct face_cachel face_cachel;
+struct face_cachel
+{
+ /* There are two kinds of cachels; those created from a single face
+ and those created by merging more than one face. In the former
+ case, the FACE element specifies the face used. In the latter
+ case, the MERGED_FACES_STATIC and MERGED_FACES elements specify
+ the faces used for merging by giving the indices of the
+ corresponding single-face cachels.
+
+ Formerly we didn't bother to keep track of the faces used for
+ merging. We do know because we need to do so because there is no
+ other way to properly handle multiple charsets for Mule in the
+ presence of display tables short of always computing the values
+ for all charsets, which is very expensive. Instead, we use a
+ lazy scheme where we only compute the font for a particular charset
+ when it is needed. (The exception is the font for the ASCII charset.
+ We always compute it, just like the other attributes, because
+ many places in the C code refer to the font of the ASCII charset
+ and expect it to always be there.)
+
+ We store the first four faces in a static array, and use a
+ Dynarr for the rest. This has the advantage that the space used
+ is small but the Dynarr will almost never be created, so we
+ won't spend much time in malloc()/free().
+
+ The order of the faces here is decreasing extent priority. */
+ Lisp_Object face;
+ int merged_faces_static[NUM_STATIC_CACHEL_FACES];
+ int_dynarr *merged_faces;
+ int nfaces;
+
+ /* The values stored here are computed by calling specifier_instance()
+ on the appropriate specifiers. This means that we will have either
+ a value computed from the face itself or a value computed from the
+ default face. We need to distinguish the two so that merging works
+ properly -- a value that comes from the default face is treated
+ as "unspecified" during merging and is overridden by lower-priority
+ faces. This is what the _specified flags below are for. */
+
+ Lisp_Object foreground;
+ Lisp_Object background;
+ /* There are currently 128 possible charsets under Mule. For the
+ moment we just take the easy way out and allocate space for each
+ of them. This avoids messing with Dynarrs.
+
+ #### We should look into this and probably clean it up
+ to use Dynarrs. This may be a big space hog as is. */
+ Lisp_Object font[NUM_LEADING_BYTES];
+
+ Lisp_Object display_table;
+ Lisp_Object background_pixmap;
+
+ unsigned int underline :1;
+ unsigned int strikethru :1;
+ unsigned int highlight :1;
+ unsigned int dim :1;
+ unsigned int blinking :1;
+ unsigned int reverse :1;
+
+ /* Used when merging to tell if the above field represents an actual
+ value of this face or a fallback value. */
+ /* #### Of course we should use a bit array or something. */
+ unsigned char font_specified[NUM_LEADING_BYTES];
+ unsigned int foreground_specified :1;
+ unsigned int background_specified :1;
+ unsigned int display_table_specified :1;
+ unsigned int background_pixmap_specified :1;
+
+ unsigned int strikethru_specified :1;
+ unsigned int underline_specified :1;
+ unsigned int highlight_specified :1;
+ unsigned int dim_specified :1;
+ unsigned int blinking_specified :1;
+ unsigned int reverse_specified :1;
+
+ /* The updated flag is set after we calculate the values for the
+ face cachel and cleared whenever a face changes, to indicate
+ that the values stored here might be wrong. The next time
+ we go to access the values, we recompute them; if any values
+ change, we set the DIRTY flag, which tells the output routines
+ that a face value has in fact changed and the sections of text
+ using this face need to be redrawn.
+
+ It is trickier with fonts because we don't automatically
+ recompute the fonts but do it only when it is necessary.
+ (The ASCII font is an exception, of course; see above).
+
+ In the case of fonts, we maintain a separate updated flag
+ for each font. Whenever we need to access the font for
+ a particular charset, we recalculate it if either its
+ value is Qunbound (meaning it's never been computed at all)
+ or the updated flag is not set. We set the dirty flag if
+ the value is not the same as before and the previous value
+ was not Qunbound.
+
+ #### Note that we don't yet deal with the case of the new
+ value being Qunbound, as could happen if no fonts of the
+ right sort are available on the system. In this case, the
+ whole program will just crash. For the moment, this is
+ OK (for debugging purposes) but we should fix this by
+ storing a "blank font" if the instantation fails. */
+ unsigned int dirty :1;
+ unsigned int updated :1;
+ /* #### Of course we should use a bit array or something. */
+ unsigned char font_updated[NUM_LEADING_BYTES];
+};
+
+DECLARE_LRECORD (face, struct Lisp_Face);
+#define XFACE(x) XRECORD (x, face, struct 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,
+ Lisp_Object domain,
+ Lisp_Object charset);
+void ensure_face_cachel_complete (struct face_cachel *cachel,
+ Lisp_Object domain,
+ unsigned char *charsets);
+void update_face_cachel_data (struct face_cachel *cachel,
+ Lisp_Object domain,
+ Lisp_Object face);
+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_as_clean (struct window *w);
+void mark_face_cachels_as_not_updated (struct window *w);
+void reset_face_cachel (struct face_cachel *inst);
+void reset_face_cachels (struct window *w);
+face_index get_builtin_face_cache_index (struct window *w,
+ Lisp_Object face);
+#ifdef MEMORY_USAGE_STATS
+int compute_face_cachel_usage (face_cachel_dynarr *face_cachels,
+ struct overhead_stats *ovstats);
+#endif /* MEMORY_USAGE_STATS */
+
+EXFUN (Fface_name, 1);
+EXFUN (Ffind_face, 1);
+EXFUN (Fget_face, 1);
+
+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 Vtoolbar_face, Vgui_element_face;
+
+void mark_all_faces_as_clean (void);
+void init_frame_faces (struct frame *f);
+void init_device_faces (struct device *d);
+void init_global_faces (struct device *d);
+face_index get_extent_fragment_face_cache_index (struct window *w,
+ struct extent_fragment *ef);
+void update_frame_face_values (struct frame *f);
+void face_property_was_changed (Lisp_Object face, Lisp_Object property,
+ Lisp_Object locale);
+void default_face_font_info (Lisp_Object domain, int *ascent,
+ int *descent, int *height, int *width,
+ int *proportional_p);
+void default_face_height_and_width (Lisp_Object domain,
+ int *height, int *width);
+void default_face_height_and_width_1 (Lisp_Object domain,
+ int *height, int *width);
+
+#define FACE_CACHEL_FONT(cachel, charset) \
+ (cachel->font[XCHARSET_LEADING_BYTE (charset) - 128])
+
+#define WINDOW_FACE_CACHEL(window, index) \
+ Dynarr_atp ((window)->face_cachels, index)
+
+#define FACE_CACHEL_FINDEX_UNSAFE(cachel, offset) \
+ ((offset) < NUM_STATIC_CACHEL_FACES \
+ ? (cachel)->merged_faces_static[offset] \
+ : Dynarr_at ((cachel)->merged_faces, (offset) - NUM_STATIC_CACHEL_FACES))
+
+#define WINDOW_FACE_CACHEL_FACE(window, index) \
+ (WINDOW_FACE_CACHEL (window, index)->face)
+#define WINDOW_FACE_CACHEL_FOREGROUND(window, index) \
+ (WINDOW_FACE_CACHEL (window, index)->foreground)
+#define WINDOW_FACE_CACHEL_BACKGROUND(window, index) \
+ (WINDOW_FACE_CACHEL (window, index)->background)
+/* #### This can be referenced by various functions,
+ but face_cachels isn't initialized for the stream device.
+ Since it doesn't need the value we just return nil here to avoid
+ blowing up in multiple places. */
+#define WINDOW_FACE_CACHEL_FONT(window, index, charset) \
+ ((window)->face_cachels \
+ ? FACE_CACHEL_FONT (WINDOW_FACE_CACHEL (window, index), charset) \
+ : Qnil)
+#define WINDOW_FACE_CACHEL_DISPLAY_TABLE(window, index) \
+ (WINDOW_FACE_CACHEL (window, index)->display_table)
+#define WINDOW_FACE_CACHEL_BACKGROUND_PIXMAP(window, index) \
+ (WINDOW_FACE_CACHEL (window, index)->background_pixmap)
+#define WINDOW_FACE_CACHEL_DIRTY(window, index) \
+ (WINDOW_FACE_CACHEL (window, index)->dirty)
+#define WINDOW_FACE_CACHEL_UNDERLINE_P(window, index) \
+ (WINDOW_FACE_CACHEL (window, index)->underline)
+#define WINDOW_FACE_CACHEL_HIGHLIGHT_P(window, index) \
+ (WINDOW_FACE_CACHEL (window, index)->highlight)
+#define WINDOW_FACE_CACHEL_DIM_P(window, index) \
+ (WINDOW_FACE_CACHEL (window, index)->dim)
+#define WINDOW_FACE_CACHEL_BLINKING_P(window, index) \
+ (WINDOW_FACE_CACHEL (window, index)->blinking)
+#define WINDOW_FACE_CACHEL_REVERSE_P(window, index) \
+ (WINDOW_FACE_CACHEL (window, index)->reverse)
+
+#define FACE_PROPERTY_SPECIFIER(face, property) Fget (face, property, Qnil)
+
+#define FACE_PROPERTY_INSTANCE_1(face, property, domain, errb, no_fallback, depth) \
+ specifier_instance (FACE_PROPERTY_SPECIFIER (face, property), Qunbound, \
+ domain, errb, 1, no_fallback, depth)
+
+#define FACE_PROPERTY_INSTANCE(face, property, domain, no_fallback, depth) \
+ FACE_PROPERTY_INSTANCE_1 (face, property, domain, ERROR_ME_NOT, \
+ no_fallback, depth)
+
+Lisp_Object face_property_matching_instance (Lisp_Object face,
+ Lisp_Object property,
+ Lisp_Object charset,
+ Lisp_Object domain,
+ Error_behavior errb,
+ int no_fallback,
+ Lisp_Object depth);
+
+#define FACE_PROPERTY_SPEC_LIST(face, property, locale) \
+ Fspecifier_spec_list (FACE_PROPERTY_SPECIFIER (face, property), \
+ locale, Qnil, Qnil)
+#define SET_FACE_PROPERTY(face, property, locale, value, tag, how_to_add) \
+ Fadd_spec_to_specifier (FACE_PROPERTY_SPECIFIER (face, property), \
+ locale, value, tag, how_to_add)
+
+#define FACE_FOREGROUND(face, domain) \
+ FACE_PROPERTY_INSTANCE (face, Qforeground, domain, 0, Qzero)
+#define FACE_BACKGROUND(face, domain) \
+ FACE_PROPERTY_INSTANCE (face, Qbackground, domain, 0, Qzero)
+#define FACE_FONT(face, domain, charset) \
+ face_property_matching_instance (face, Qfont, charset, domain, \
+ ERROR_ME_NOT, 0, Qzero)
+#define FACE_DISPLAY_TABLE(face, domain) \
+ FACE_PROPERTY_INSTANCE (face, Qdisplay_table, domain, 0, Qzero)
+#define FACE_BACKGROUND_PIXMAP(face, domain) \
+ 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_HIGHLIGHT_P(face, domain) \
+ (!NILP (FACE_PROPERTY_INSTANCE (face, Qhighlight, domain, 0, Qzero)))
+#define FACE_DIM_P(face, domain) \
+ (!NILP (FACE_PROPERTY_INSTANCE (face, Qdim, domain, 0, Qzero)))
+#define FACE_BLINKING_P(face, domain) \
+ (!NILP (FACE_PROPERTY_INSTANCE (face, Qblinking, domain, 0, Qzero)))
+#define FACE_REVERSE_P(face, domain) \
+ (!NILP (FACE_PROPERTY_INSTANCE (face, Qreverse, domain, 0, Qzero)))
+
+#endif /* _XEMACS_FACES_H_ */
--- /dev/null
+/* 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>. */
+
+#include <config.h>
+#include "lisp.h"
+#include "buffer.h"
+#include "elhash.h"
+#include "insdel.h"
+#include "lstream.h"
+#ifdef MULE
+#include "mule-ccl.h"
+#endif
+#include "file-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 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;
+
+#ifdef MULE
+Lisp_Object Qbig5, Qshift_jis;
+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 Qno_iso6429;
+Lisp_Object Qinput_charset_conversion, Qoutput_charset_conversion;
+Lisp_Object Qctext, Qescape_quoted;
+Lisp_Object Qshort, Qno_ascii_eol, Qno_ascii_cntl, Qseven, Qlock_shift;
+#endif
+Lisp_Object Qencode, Qdecode;
+
+Lisp_Object Vcoding_system_hashtable;
+
+int enable_multibyte_characters;
+
+#ifdef MULE
+/* 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;
+};
+#endif /* MULE */
+EXFUN (Fcopy_coding_system, 2);
+#ifdef MULE
+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);
+#endif /* MULE */
+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
+};
+
+\f
+/************************************************************************/
+/* Coding system functions */
+/************************************************************************/
+
+static Lisp_Object mark_coding_system (Lisp_Object, void (*) (Lisp_Object));
+static void print_coding_system (Lisp_Object, Lisp_Object, int);
+static void finalize_coding_system (void *header, int for_disksave);
+
+DEFINE_LRECORD_IMPLEMENTATION ("coding-system", coding_system,
+ mark_coding_system, print_coding_system,
+ finalize_coding_system,
+ 0, 0, struct Lisp_Coding_System);
+
+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))
+ {
+#ifdef MULE
+ 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;
+#endif /* MULE */
+ 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))
+ {
+#ifdef MULE
+ 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;
+#endif /* MULE */
+ default:
+ break;
+ }
+ }
+}
+
+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)
+ {
+ case EOL_LF: return Qlf;
+ case EOL_CRLF: return Qcrlf;
+ case EOL_CR: return Qcr;
+ case EOL_AUTODETECT: return Qnil;
+ default: abort (); return Qnil; /* not reached */
+ }
+}
+
+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);
+ int mlen = -1;
+ char *codesys_mnemonic=0;
+
+ 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);
+
+ if (STRINGP (CODING_SYSTEM_MNEMONIC (codesys)))
+ {
+ mlen = XSTRING_LENGTH (CODING_SYSTEM_MNEMONIC (codesys));
+ codesys_mnemonic = (char *) alloca (mlen + 7);
+ memcpy (codesys_mnemonic,
+ XSTRING_DATA (CODING_SYSTEM_MNEMONIC (codesys)), mlen);
+ }
+
+#define DEFINE_SUB_CODESYS(op_sys, op_sys_abbr, Type) do { \
+ strcpy (codesys_name + len, "-" op_sys); \
+ if (mlen != -1) \
+ strcpy (codesys_mnemonic + mlen, op_sys_abbr); \
+ 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; \
+ if (mlen != -1) \
+ XCODING_SYSTEM_MNEMONIC(sub_codesys_obj) = \
+ build_string (codesys_mnemonic); \
+ CODING_SYSTEM_##Type (codesys) = sub_codesys_obj; \
+} while (0)
+
+ DEFINE_SUB_CODESYS("unix", "", EOL_LF);
+ DEFINE_SUB_CODESYS("dos", ":T", EOL_CRLF);
+ DEFINE_SUB_CODESYS("mac", ":t", 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 (CODING_SYSTEMP (coding_system_or_name))
+ return coding_system_or_name;
+
+ if (NILP (coding_system_or_name))
+ coding_system_or_name = Qbinary;
+ else
+ CHECK_SYMBOL (coding_system_or_name);
+
+ return Fgethash (coding_system_or_name, Vcoding_system_hashtable, 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_hashtable,
+ &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;
+ CODING_SYSTEM_MNEMONIC (codesys) = Qnil;
+#ifdef MULE
+ 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;
+ }
+#endif /* MULE */
+ CODING_SYSTEM_NAME (codesys) = name;
+
+ return codesys;
+}
+
+#ifdef MULE
+/* 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;
+
+ if (!load_here)
+ return Qnil;
+ for (i = 0, result = Qnil; 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);
+}
+
+#endif /* MULE */
+
+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; }
+#ifdef MULE
+ 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; }
+#endif
+ 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;
+#ifdef MULE
+ 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);
+ }
+#endif /* MULE */
+ 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_hashtable);
+ 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_hashtable);
+ }
+
+ {
+ 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));
+}
+
+\f
+/************************************************************************/
+/* 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;
+#ifdef MULE
+ case CODESYS_SHIFT_JIS: return Qshift_jis;
+ case CODESYS_ISO2022: return Qiso2022;
+ case CODESYS_BIG5: return Qbig5;
+ case CODESYS_CCL: return Qccl;
+#endif
+ case CODESYS_NO_CONVERSION: return Qno_conversion;
+#ifdef DEBUG_XEMACS
+ case CODESYS_INTERNAL: return Qinternal;
+#endif
+ default:
+ abort ();
+ }
+
+ return Qnil; /* not reached */
+}
+
+#ifdef MULE
+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));
+}
+#endif /* MULE */
+
+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;
+#ifdef MULE
+ 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;
+#endif /* MULE */
+ 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);
+#ifdef MULE
+ 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 ();
+ }
+#endif /* MULE */
+ else
+ abort ();
+
+ return Qnil; /* not reached */
+}
+
+\f
+/************************************************************************/
+/* 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;
+}
+
+\f
+/************************************************************************/
+/* Detecting the encoding of data */
+/************************************************************************/
+
+struct detection_state
+{
+ enum eol_type eol_type;
+ int seen_non_ascii;
+ int mask;
+#ifdef MULE
+ 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;
+#endif
+ 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;
+#ifdef MULE
+ st->shift_jis.mask = ~0;
+ st->big5.mask = ~0;
+ st->iso2022.mask = ~0;
+#endif
+ break;
+ }
+ }
+ }
+
+ if (!n)
+ return 0;
+#ifdef MULE
+ 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;
+#endif
+ {
+ 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;
+#ifdef MULE
+ mask = postprocess_iso2022_mask (mask);
+#endif
+ /* 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;
+#ifdef MULE
+ decst.mask = postprocess_iso2022_mask (decst.mask);
+#endif
+ 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;
+}
+
+\f
+/************************************************************************/
+/* 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;
+#ifdef MULE
+ /* 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;
+#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 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)
+{
+#ifdef MULE
+ 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));
+ }
+#endif /* MULE */
+ 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);
+#ifdef MULE
+ if (str->iso2022.composite_chars)
+ Dynarr_free (str->iso2022.composite_chars);
+#endif
+ 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;
+#ifdef MULE
+ 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;
+#endif /* MULE */
+ 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;
+}
+
+\f
+/************************************************************************/
+/* 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;
+#ifdef MULE
+ /* 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;
+#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 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)
+{
+#ifdef MULE
+ 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;
+ }
+#endif /* MULE */
+
+ 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;
+#ifdef MULE
+ 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;
+#endif /* MULE */
+ 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);
+ }
+}
+
+#ifdef MULE
+\f
+/************************************************************************/
+/* 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;
+}
+
+\f
+/************************************************************************/
+/* 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 devided 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;
+}
+
+\f
+/************************************************************************/
+/* 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! */
+}
+#endif /* MULE */
+\f
+/************************************************************************/
+/* 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);
+}
+
+\f
+/************************************************************************/
+/* Simple internal/external functions */
+/************************************************************************/
+
+static Extbyte_dynarr *conversion_out_dynarr;
+static Bufbyte_dynarr *conversion_in_dynarr;
+
+/* Determine coding system from coding format */
+
+#define FILE_NAME_CODING_SYSTEM \
+ ((NILP (Vfile_name_coding_system) || \
+ (EQ ((Vfile_name_coding_system), Qbinary))) ? \
+ Qnil : Fget_coding_system (Vfile_name_coding_system))
+
+/* #### not correct for all values of `fmt'! */
+#ifdef MULE
+#define FMT_CODING_SYSTEM(fmt) \
+ (((fmt) == FORMAT_FILENAME) ? FILE_NAME_CODING_SYSTEM : \
+ ((fmt) == FORMAT_CTEXT ) ? Fget_coding_system (Qctext) : \
+ ((fmt) == FORMAT_TERMINAL) ? FILE_NAME_CODING_SYSTEM : \
+ Qnil)
+#else
+#define FMT_CODING_SYSTEM(fmt) \
+ (((fmt) == FORMAT_FILENAME) ? FILE_NAME_CODING_SYSTEM : \
+ ((fmt) == FORMAT_TERMINAL) ? FILE_NAME_CODING_SYSTEM : \
+ Qnil)
+#endif
+
+Extbyte *
+convert_to_external_format (CONST Bufbyte *ptr,
+ Bytecount len,
+ Extcount *len_out,
+ enum external_data_format fmt)
+{
+ Lisp_Object coding_system = FMT_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 = FMT_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);
+}
+
+\f
+/************************************************************************/
+/* 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);
+#ifdef MULE
+ DEFSUBR (Fcoding_system_charset);
+#endif
+ 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);
+#ifdef MULE
+ DEFSUBR (Fdecode_shift_jis_char);
+ DEFSUBR (Fencode_shift_jis_char);
+ DEFSUBR (Fdecode_big5_char);
+ DEFSUBR (Fencode_big5_char);
+#endif /* MULE */
+ defsymbol (&Qcoding_system_p, "coding-system-p");
+ defsymbol (&Qno_conversion, "no-conversion");
+#ifdef MULE
+ defsymbol (&Qbig5, "big5");
+ defsymbol (&Qshift_jis, "shift-jis");
+ defsymbol (&Qccl, "ccl");
+ defsymbol (&Qiso2022, "iso2022");
+#endif /* MULE */
+ 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");
+#ifdef MULE
+ 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 (&Qno_iso6429, "no-iso6429");
+ defsymbol (&Qinput_charset_conversion, "input-charset-conversion");
+ defsymbol (&Qoutput_charset_conversion, "output-charset-conversion");
+
+ 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 (&Qescape_quoted, "escape-quoted");
+#endif /* MULE */
+ defsymbol (&Qencode, "encode");
+ 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],
+ "big5");
+ 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");
+#endif /* MULE */
+ 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;
+ }
+
+ Fprovide (intern ("file-coding"));
+
+ 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_hashtable);
+ Vcoding_system_hashtable = make_lisp_hashtable (50, HASHTABLE_NONWEAK,
+ HASHTABLE_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);
+#ifdef MULE
+ 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);
+#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);
+
+ /* Need this for bootstrapping */
+ coding_category_system[CODING_CATEGORY_NO_CONVERSION] =
+ Fget_coding_system (Qno_conversion);
+}
--- /dev/null
+/* 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. */
+#ifdef MULE
+ 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. */
+#endif
+ 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
+};
+
+#ifdef MULE
+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;
+#endif
+
+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;
+#ifdef MULE
+ 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;
+#endif
+};
+
+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)
+
+#ifdef MULE
+#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)
+#endif /* MULE */
+
+#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))
+
+#ifdef MULE
+#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))
+#endif /* MULE */
+
+EXFUN (Fcoding_category_list, 0);
+EXFUN (Fcoding_category_system, 1);
+EXFUN (Fcoding_priority_list, 0);
+EXFUN (Fcoding_system_charset, 2);
+EXFUN (Fcoding_system_doc_string, 1);
+EXFUN (Fcoding_system_list, 0);
+EXFUN (Fcoding_system_name, 1);
+EXFUN (Fcoding_system_p, 1);
+EXFUN (Fcoding_system_property, 2);
+EXFUN (Fcoding_system_type, 1);
+EXFUN (Fcopy_coding_system, 2);
+EXFUN (Fdecode_big5_char, 1);
+EXFUN (Fdecode_coding_region, 4);
+EXFUN (Fdecode_shift_jis_char, 1);
+EXFUN (Fdetect_coding_region, 3);
+EXFUN (Fencode_big5_char, 1);
+EXFUN (Fencode_coding_region, 4);
+EXFUN (Fencode_shift_jis_char, 1);
+EXFUN (Ffind_coding_system, 1);
+EXFUN (Fget_coding_system, 1);
+EXFUN (Fmake_coding_system, 4);
+EXFUN (Fset_coding_category_system, 2);
+EXFUN (Fset_coding_priority_list, 1);
+EXFUN (Fsubsidiary_coding_system, 2);
+
+extern Lisp_Object Qbig5, Qbuffer_file_coding_system, 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 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 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;
+extern Lisp_Object Vcoding_system_for_write, Vcoding_system_hashtable;
+extern Lisp_Object Vfile_name_coding_system, Vkeyboard_coding_system;
+extern Lisp_Object Vterminal_coding_system;
+
+/* 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. */
+#ifdef MULE
+#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 */
+#endif /* MULE */
+
+/* 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
+{
+#ifdef MULE
+ 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,
+#endif /* MULE */
+ CODING_CATEGORY_NO_CONVERSION
+};
+
+#define CODING_CATEGORY_LAST CODING_CATEGORY_NO_CONVERSION
+
+#ifdef MULE
+#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)
+#endif
+#define CODING_CATEGORY_NO_CONVERSION_MASK \
+ (1 << CODING_CATEGORY_NO_CONVERSION)
+#define CODING_CATEGORY_NOT_FINISHED_MASK \
+ (1 << 30)
+
+#ifdef MULE
+/* 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)
+#endif /* MULE */
+
+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);
+
+
+#ifndef MULE
+#define MIN_LEADING_BYTE 0x80
+/* These need special treatment in a string and/or character */
+#define LEADING_BYTE_COMPOSITE 0x80 /* for a composite character */
+#define LEADING_BYTE_CONTROL_1 0x8F /* represent normal 80-9F */
+#define LEADING_BYTE_LATIN_ISO8859_1 0x81 /* Right half of ISO 8859-1 */
+#define BYTE_C1_P(c) ((unsigned int) ((unsigned int) (c) - 0x80) < 0x20)
+#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_ */
+
--- /dev/null
+/* Random utility Lisp functions.
+ Copyright (C) 1985, 86, 87, 93, 94, 95 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: Mule 2.0, FSF 19.30. */
+
+/* This file has been Mule-ized. */
+
+/* Note: FSF 19.30 has bool vectors. We have bit vectors. */
+
+/* Hacked on for Mule by Ben Wing, December 1994, January 1995. */
+
+#include <config.h>
+
+/* Note on some machines this defines `vector' as a typedef,
+ so make sure we don't use that name in this file. */
+#undef vector
+#define vector *****
+
+#include "lisp.h"
+
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+#include <errno.h>
+
+#include "buffer.h"
+#include "bytecode.h"
+#include "commands.h"
+#include "device.h"
+#include "events.h"
+#include "extents.h"
+#include "frame.h"
+#include "systime.h"
+
+/* NOTE: This symbol is also used in lread.c */
+#define FEATUREP_SYNTAX
+
+Lisp_Object Qstring_lessp;
+Lisp_Object Qidentity;
+
+static int internal_old_equal (Lisp_Object, Lisp_Object, int);
+
+static Lisp_Object
+mark_bit_vector (Lisp_Object obj, void (*markobj) (Lisp_Object))
+{
+ return Qnil;
+}
+
+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;
+
+ if (INTP (Vprint_length))
+ last = min (len, XINT (Vprint_length));
+ write_c_string ("#*", printcharfun);
+ for (i = 0; i < last; i++)
+ {
+ if (bit_vector_bit (v, i))
+ write_c_string ("1", printcharfun);
+ else
+ write_c_string ("0", printcharfun);
+ }
+
+ if (last != len)
+ write_c_string ("...", printcharfun);
+}
+
+static int
+bit_vector_equal (Lisp_Object o1, Lisp_Object o2, int depth)
+{
+ struct Lisp_Bit_Vector *v1 = XBIT_VECTOR (o1);
+ struct Lisp_Bit_Vector *v2 = XBIT_VECTOR (o2);
+
+ return ((bit_vector_length (v1) == bit_vector_length (v2)) &&
+ !memcmp (v1->bits, v2->bits,
+ BIT_VECTOR_LONG_STORAGE (bit_vector_length (v1)) *
+ sizeof (long)));
+}
+
+static unsigned long
+bit_vector_hash (Lisp_Object obj, int depth)
+{
+ struct 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);
+\f
+DEFUN ("identity", Fidentity, 1, 1, 0, /*
+Return the argument unchanged.
+*/
+ (arg))
+{
+ return arg;
+}
+
+extern long get_random (void);
+extern void seed_random (long arg);
+
+DEFUN ("random", Frandom, 0, 1, 0, /*
+Return a pseudo-random number.
+All integers representable in Lisp are equally likely.
+ On most systems, this is 28 bits' worth.
+With positive integer argument N, return random number in interval [0,N).
+With argument t, set the random number seed from the current time and pid.
+*/
+ (limit))
+{
+ EMACS_INT val;
+ unsigned long denominator;
+
+ if (EQ (limit, Qt))
+ seed_random (getpid () + time (NULL));
+ if (NATNUMP (limit) && !ZEROP (limit))
+ {
+ /* Try to take our random number from the higher bits of VAL,
+ not the lower, since (says Gentzel) the low bits of `random'
+ are less random than the higher ones. We do this by using the
+ quotient rather than the remainder. At the high end of the RNG
+ it's possible to get a quotient larger than limit; discarding
+ these values eliminates the bias that would otherwise appear
+ when using a large limit. */
+ denominator = ((unsigned long)1 << VALBITS) / XINT (limit);
+ do
+ val = get_random () / denominator;
+ while (val >= XINT (limit));
+ }
+ else
+ val = get_random ();
+
+ return make_int (val);
+}
+\f
+/* Random data-structure functions */
+
+#ifdef LOSING_BYTECODE
+
+/* #### Delete this shit */
+
+/* Charcount is a misnomer here as we might be dealing with the
+ length of a vector or list, but emphasizes that we're not dealing
+ with Bytecounts in strings */
+static Charcount
+length_with_bytecode_hack (Lisp_Object seq)
+{
+ if (!COMPILED_FUNCTIONP (seq))
+ return XINT (Flength (seq));
+ else
+ {
+ struct Lisp_Compiled_Function *b = XCOMPILED_FUNCTION (seq);
+
+ return (b->flags.interactivep ? COMPILED_INTERACTIVE :
+ b->flags.domainp ? COMPILED_DOMAIN :
+ COMPILED_DOC_STRING)
+ + 1;
+ }
+}
+
+#endif /* LOSING_BYTECODE */
+
+void
+check_losing_bytecode (CONST char *function, Lisp_Object seq)
+{
+ if (COMPILED_FUNCTIONP (seq))
+ error_with_frob
+ (seq,
+ "As of 20.3, `%s' no longer works with compiled-function objects",
+ function);
+}
+
+DEFUN ("length", Flength, 1, 1, 0, /*
+Return the length of vector, bit vector, list or string SEQUENCE.
+*/
+ (sequence))
+{
+ retry:
+ if (STRINGP (sequence))
+ return make_int (XSTRING_CHAR_LENGTH (sequence));
+ else if (CONSP (sequence))
+ {
+ Lisp_Object tail;
+ int i = 0;
+
+ EXTERNAL_LIST_LOOP (tail, sequence)
+ {
+ QUIT;
+ i++;
+ }
+
+ return make_int (i);
+ }
+ else if (VECTORP (sequence))
+ return make_int (XVECTOR_LENGTH (sequence));
+ else if (NILP (sequence))
+ return Qzero;
+ else if (BIT_VECTORP (sequence))
+ return make_int (bit_vector_length (XBIT_VECTOR (sequence)));
+ else
+ {
+ check_losing_bytecode ("length", sequence);
+ sequence = wrong_type_argument (Qsequencep, sequence);
+ goto retry;
+ }
+}
+
+/* This does not check for quits. That is safe
+ since it must terminate. */
+
+DEFUN ("safe-length", Fsafe_length, 1, 1, 0, /*
+Return the length of a list, but avoid error or infinite loop.
+This function never gets an error. If LIST is not really a list,
+it returns 0. If LIST is circular, it returns a finite value
+which is at least the number of distinct elements.
+*/
+ (list))
+{
+ Lisp_Object halftail = list; /* Used to detect circular lists. */
+ Lisp_Object tail;
+ int len = 0;
+
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
+ {
+ if (EQ (tail, halftail) && len != 0)
+ break;
+ len++;
+ if ((len & 1) == 0)
+ halftail = XCDR (halftail);
+ }
+
+ return make_int (len);
+}
+
+/*** string functions. ***/
+
+DEFUN ("string-equal", Fstring_equal, 2, 2, 0, /*
+Return t if two strings have identical contents.
+Case is significant. Text properties are ignored.
+\(Under XEmacs, `equal' also ignores text properties and extents in
+strings, but this is not the case under FSF Emacs 19. In FSF Emacs 20
+`equal' is the same as in XEmacs, in that respect.)
+Symbols are also allowed; their print names are used instead.
+*/
+ (s1, s2))
+{
+ Bytecount len;
+ struct Lisp_String *p1, *p2;
+
+ if (SYMBOLP (s1))
+ p1 = XSYMBOL (s1)->name;
+ else
+ {
+ CHECK_STRING (s1);
+ p1 = XSTRING (s1);
+ }
+
+ if (SYMBOLP (s2))
+ p2 = XSYMBOL (s2)->name;
+ else
+ {
+ CHECK_STRING (s2);
+ p2 = XSTRING (s2);
+ }
+
+ return (((len = string_length (p1)) == string_length (p2)) &&
+ !memcmp (string_data (p1), string_data (p2), len)) ? Qt : Qnil;
+}
+
+
+DEFUN ("string-lessp", Fstring_lessp, 2, 2, 0, /*
+Return t if first arg string is less than second in lexicographic order.
+If I18N2 support (but not Mule support) was compiled in, ordering is
+determined by the locale. (Case is significant for the default C locale.)
+In all other cases, comparison is simply done on a character-by-
+character basis using the numeric value of a character. (Note that
+this may not produce particularly meaningful results under Mule if
+characters from different charsets are being compared.)
+
+Symbols are also allowed; their print names are used instead.
+
+The reason that the I18N2 locale-specific collation is not used under
+Mule is that the locale model of internationalization does not handle
+multiple charsets and thus has no hope of working properly under Mule.
+What we really should do is create a collation table over all built-in
+charsets. This is extremely difficult to do from scratch, however.
+
+Unicode is a good first step towards solving this problem. In fact,
+it is quite likely that a collation table exists (or will exist) for
+Unicode. When Unicode support is added to XEmacs/Mule, this problem
+may be solved.
+*/
+ (s1, s2))
+{
+ struct Lisp_String *p1, *p2;
+ Charcount end, len2;
+ int i;
+
+ if (SYMBOLP (s1))
+ p1 = XSYMBOL (s1)->name;
+ else
+ {
+ CHECK_STRING (s1);
+ p1 = XSTRING (s1);
+ }
+
+ if (SYMBOLP (s2))
+ p2 = XSYMBOL (s2)->name;
+ else
+ {
+ CHECK_STRING (s2);
+ p2 = XSTRING (s2);
+ }
+
+ end = string_char_length (p1);
+ len2 = string_char_length (p2);
+ if (end > len2)
+ end = len2;
+
+#if defined (I18N2) && !defined (MULE)
+ /* There is no hope of this working under Mule. Even if we converted
+ the data into an external format so that strcoll() processed it
+ 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;
+ }
+#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;
+ }
+#endif /* not I18N2, or MULE */
+ /* Can't do i < len2 because then comparison between "foo" and "foo^@"
+ won't work right in I18N2 case */
+ return end < len2 ? Qt : Qnil;
+}
+
+DEFUN ("string-modified-tick", Fstring_modified_tick, 1, 1, 0, /*
+Return STRING's tick counter, incremented for each change to the string.
+Each string has a tick counter which is incremented each time the contents
+of the string are changed (e.g. with `aset'). It wraps around occasionally.
+*/
+ (string))
+{
+ struct Lisp_String *s;
+
+ CHECK_STRING (string);
+ s = XSTRING (string);
+ if (CONSP (s->plist) && INTP (XCAR (s->plist)))
+ return XCAR (s->plist);
+ else
+ return Qzero;
+}
+
+void
+bump_string_modiff (Lisp_Object str)
+{
+ struct Lisp_String *s = XSTRING (str);
+ Lisp_Object *ptr = &s->plist;
+
+#ifdef I18N3
+ /* #### remove the `string-translatable' property from the string,
+ if there is one. */
+#endif
+ /* skip over extent info if it's there */
+ if (CONSP (*ptr) && EXTENT_INFOP (XCAR (*ptr)))
+ ptr = &XCDR (*ptr);
+ if (CONSP (*ptr) && INTP (XCAR (*ptr)))
+ XSETINT (XCAR (*ptr), 1+XINT (XCAR (*ptr)));
+ else
+ *ptr = Fcons (make_int (1), *ptr);
+}
+
+\f
+enum concat_target_type { c_cons, c_string, c_vector, c_bit_vector };
+static Lisp_Object concat (int nargs, Lisp_Object *args,
+ enum concat_target_type target_type,
+ int last_special);
+
+Lisp_Object
+concat2 (Lisp_Object s1, Lisp_Object s2)
+{
+ Lisp_Object args[2];
+ args[0] = s1;
+ args[1] = s2;
+ return concat (2, args, c_string, 0);
+}
+
+Lisp_Object
+concat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3)
+{
+ Lisp_Object args[3];
+ args[0] = s1;
+ args[1] = s2;
+ args[2] = s3;
+ return concat (3, args, c_string, 0);
+}
+
+Lisp_Object
+vconcat2 (Lisp_Object s1, Lisp_Object s2)
+{
+ Lisp_Object args[2];
+ args[0] = s1;
+ args[1] = s2;
+ return concat (2, args, c_vector, 0);
+}
+
+Lisp_Object
+vconcat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3)
+{
+ Lisp_Object args[3];
+ args[0] = s1;
+ args[1] = s2;
+ args[2] = s3;
+ return concat (3, args, c_vector, 0);
+}
+
+DEFUN ("append", Fappend, 0, MANY, 0, /*
+Concatenate all the arguments and make the result a list.
+The result is a list whose elements are the elements of all the arguments.
+Each argument may be a list, vector, bit vector, or string.
+The last argument is not copied, just used as the tail of the new list.
+Also see: `nconc'.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ return concat (nargs, args, c_cons, 1);
+}
+
+DEFUN ("concat", Fconcat, 0, MANY, 0, /*
+Concatenate all the arguments and make the result a string.
+The result is a string whose elements are the elements of all the arguments.
+Each argument may be a string or a list or vector of characters.
+
+As of XEmacs 21.0, this function does NOT accept individual integers
+as arguments. Old code that relies on, for example, (concat "foo" 50)
+returning "foo50" will fail. To fix such code, either apply
+`int-to-string' to the integer argument, or use `format'.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ return concat (nargs, args, c_string, 0);
+}
+
+DEFUN ("vconcat", Fvconcat, 0, MANY, 0, /*
+Concatenate all the arguments and make the result a vector.
+The result is a vector whose elements are the elements of all the arguments.
+Each argument may be a list, vector, bit vector, or string.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ return concat (nargs, args, c_vector, 0);
+}
+
+DEFUN ("bvconcat", Fbvconcat, 0, MANY, 0, /*
+Concatenate all the arguments and make the result a bit vector.
+The result is a bit vector whose elements are the elements of all the
+arguments. Each argument may be a list, vector, bit vector, or string.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ return concat (nargs, args, c_bit_vector, 0);
+}
+
+DEFUN ("copy-sequence", Fcopy_sequence, 1, 1, 0, /*
+Return a copy of a list, vector, bit vector or string.
+The elements of a list or vector are not copied; they are shared
+with the original.
+*/
+ (arg))
+{
+ again:
+ if (NILP (arg)) return arg;
+ /* We handle conses separately because concat() is big and hairy and
+ doesn't handle (copy-sequence '(a b . c)) and it's easier to redo this
+ than to fix concat() without worrying about breaking other things.
+ */
+ if (CONSP (arg))
+ {
+ Lisp_Object head = Fcons (XCAR (arg), XCDR (arg));
+ Lisp_Object tail = head;
+
+ for (arg = XCDR (arg); CONSP (arg); arg = XCDR (arg))
+ {
+ XCDR (tail) = Fcons (XCAR (arg), XCDR (arg));
+ tail = XCDR (tail);
+ QUIT;
+ }
+ return head;
+ }
+ if (STRINGP (arg)) return concat (1, &arg, c_string, 0);
+ if (VECTORP (arg)) return concat (1, &arg, c_vector, 0);
+ if (BIT_VECTORP (arg)) return concat (1, &arg, c_bit_vector, 0);
+
+ check_losing_bytecode ("copy-sequence", arg);
+ arg = wrong_type_argument (Qsequencep, arg);
+ goto again;
+}
+
+struct merge_string_extents_struct
+{
+ Lisp_Object string;
+ Bytecount entry_offset;
+ Bytecount entry_length;
+};
+
+static Lisp_Object
+concat (int nargs, Lisp_Object *args,
+ enum concat_target_type target_type,
+ int last_special)
+{
+ Lisp_Object val;
+ Lisp_Object tail = Qnil;
+ int toindex;
+ int argnum;
+ Lisp_Object last_tail;
+ Lisp_Object prev;
+ struct merge_string_extents_struct *args_mse = 0;
+ Bufbyte *string_result = 0;
+ Bufbyte *string_result_ptr = 0;
+ struct gcpro gcpro1;
+
+ /* The modus operandi in Emacs is "caller gc-protects args".
+ However, concat is called many times in Emacs on freshly
+ created stuff. So we help those callers out by protecting
+ the args ourselves to save them a lot of temporary-variable
+ grief. */
+
+ GCPRO1 (args[0]);
+ gcpro1.nvars = nargs;
+
+#ifdef I18N3
+ /* #### if the result is a string and any of the strings have a string
+ for the `string-translatable' property, then concat should also
+ concat the args but use the `string-translatable' strings, and store
+ the result in the returned string's `string-translatable' property. */
+#endif
+ if (target_type == c_string)
+ args_mse = alloca_array (struct merge_string_extents_struct, nargs);
+
+ /* In append, the last arg isn't treated like the others */
+ if (last_special && nargs > 0)
+ {
+ nargs--;
+ last_tail = args[nargs];
+ }
+ else
+ last_tail = Qnil;
+
+ /* Check and coerce the arguments. */
+ for (argnum = 0; argnum < nargs; argnum++)
+ {
+ Lisp_Object seq = args[argnum];
+ if (LISTP (seq))
+ ;
+ else if (VECTORP (seq) || STRINGP (seq) || BIT_VECTORP (seq))
+ ;
+#ifdef LOSING_BYTECODE
+ else if (COMPILED_FUNCTIONP (seq))
+ /* Urk! We allow this, for "compatibility"... */
+ ;
+#endif
+#if 0 /* removed for XEmacs 21 */
+ else if (INTP (seq))
+ /* This is too revolting to think about but maintains
+ compatibility with FSF (and lots and lots of old code). */
+ args[argnum] = Fnumber_to_string (seq);
+#endif
+ else
+ {
+ check_losing_bytecode ("concat", seq);
+ args[argnum] = wrong_type_argument (Qsequencep, seq);
+ }
+
+ if (args_mse)
+ {
+ if (STRINGP (seq))
+ args_mse[argnum].string = seq;
+ else
+ args_mse[argnum].string = Qnil;
+ }
+ }
+
+ {
+ /* Charcount is a misnomer here as we might be dealing with the
+ length of a vector or list, but emphasizes that we're not dealing
+ with Bytecounts in strings */
+ Charcount total_length;
+
+ for (argnum = 0, total_length = 0; argnum < nargs; argnum++)
+ {
+#ifdef LOSING_BYTECODE
+ Charcount thislen = length_with_bytecode_hack (args[argnum]);
+#else
+ Charcount thislen = XINT (Flength (args[argnum]));
+#endif
+ total_length += thislen;
+ }
+
+ switch (target_type)
+ {
+ case c_cons:
+ if (total_length == 0)
+ /* In append, if all but last arg are nil, return last arg */
+ RETURN_UNGCPRO (last_tail);
+ val = Fmake_list (make_int (total_length), Qnil);
+ break;
+ case c_vector:
+ val = make_vector (total_length, Qnil);
+ break;
+ case c_bit_vector:
+ val = make_bit_vector (total_length, Qzero);
+ break;
+ case c_string:
+ /* We don't make the string yet because we don't know the
+ actual number of bytes. This loop was formerly written
+ to call Fmake_string() here and then call set_string_char()
+ for each char. This seems logical enough but is waaaaaaaay
+ slow -- set_string_char() has to scan the whole string up
+ to the place where the substitution is called for in order
+ to find the place to change, and may have to do some
+ realloc()ing in order to make the char fit properly.
+ O(N^2) yuckage. */
+ val = Qnil;
+ string_result = (Bufbyte *) alloca (total_length * MAX_EMCHAR_LEN);
+ string_result_ptr = string_result;
+ break;
+ default:
+ abort ();
+ }
+ }
+
+
+ if (CONSP (val))
+ tail = val, toindex = -1; /* -1 in toindex is flag we are
+ making a list */
+ else
+ toindex = 0;
+
+ prev = Qnil;
+
+ for (argnum = 0; argnum < nargs; argnum++)
+ {
+ Charcount thisleni = 0;
+ Charcount thisindex = 0;
+ Lisp_Object seq = args[argnum];
+ Bufbyte *string_source_ptr = 0;
+ Bufbyte *string_prev_result_ptr = string_result_ptr;
+
+ if (!CONSP (seq))
+ {
+#ifdef LOSING_BYTECODE
+ thisleni = length_with_bytecode_hack (seq);
+#else
+ thisleni = XINT (Flength (seq));
+#endif
+ }
+ if (STRINGP (seq))
+ string_source_ptr = XSTRING_DATA (seq);
+
+ while (1)
+ {
+ Lisp_Object elt;
+
+ /* We've come to the end of this arg, so exit. */
+ if (NILP (seq))
+ break;
+
+ /* Fetch next element of `seq' arg into `elt' */
+ if (CONSP (seq))
+ {
+ elt = XCAR (seq);
+ seq = XCDR (seq);
+ }
+ else
+ {
+ if (thisindex >= thisleni)
+ break;
+
+ if (STRINGP (seq))
+ {
+ elt = make_char (charptr_emchar (string_source_ptr));
+ INC_CHARPTR (string_source_ptr);
+ }
+ else if (VECTORP (seq))
+ elt = XVECTOR_DATA (seq)[thisindex];
+ else if (BIT_VECTORP (seq))
+ elt = make_int (bit_vector_bit (XBIT_VECTOR (seq),
+ thisindex));
+ else
+ elt = Felt (seq, make_int (thisindex));
+ thisindex++;
+ }
+
+ /* Store into result */
+ if (toindex < 0)
+ {
+ /* toindex negative means we are making a list */
+ XCAR (tail) = elt;
+ prev = tail;
+ tail = XCDR (tail);
+ }
+ else if (VECTORP (val))
+ XVECTOR_DATA (val)[toindex++] = elt;
+ else if (BIT_VECTORP (val))
+ {
+ CHECK_BIT (elt);
+ set_bit_vector_bit (XBIT_VECTOR (val), toindex++, XINT (elt));
+ }
+ else
+ {
+ CHECK_CHAR_COERCE_INT (elt);
+ string_result_ptr += set_charptr_emchar (string_result_ptr,
+ XCHAR (elt));
+ }
+ }
+ if (args_mse)
+ {
+ args_mse[argnum].entry_offset =
+ string_prev_result_ptr - string_result;
+ args_mse[argnum].entry_length =
+ string_result_ptr - string_prev_result_ptr;
+ }
+ }
+
+ /* Now we finally make the string. */
+ if (target_type == c_string)
+ {
+ val = make_string (string_result, string_result_ptr - string_result);
+ for (argnum = 0; argnum < nargs; argnum++)
+ {
+ if (STRINGP (args_mse[argnum].string))
+ copy_string_extents (val, args_mse[argnum].string,
+ args_mse[argnum].entry_offset, 0,
+ args_mse[argnum].entry_length);
+ }
+ }
+
+ if (!NILP (prev))
+ XCDR (prev) = last_tail;
+
+ RETURN_UNGCPRO (val);
+}
+\f
+DEFUN ("copy-alist", Fcopy_alist, 1, 1, 0, /*
+Return a copy of ALIST.
+This is an alist which represents the same mapping from objects to objects,
+but does not share the alist structure with ALIST.
+The objects mapped (cars and cdrs of elements of the alist)
+are shared, however.
+Elements of ALIST that are not conses are also shared.
+*/
+ (alist))
+{
+ Lisp_Object tail;
+
+ if (NILP (alist))
+ return alist;
+ CHECK_CONS (alist);
+
+ alist = concat (1, &alist, c_cons, 0);
+ for (tail = alist; CONSP (tail); tail = XCDR (tail))
+ {
+ Lisp_Object car = XCAR (tail);
+
+ if (CONSP (car))
+ XCAR (tail) = Fcons (XCAR (car), XCDR (car));
+ }
+ return alist;
+}
+
+DEFUN ("copy-tree", Fcopy_tree, 1, 2, 0, /*
+Return a copy of a list and substructures.
+The argument is copied, and any lists contained within it are copied
+recursively. Circularities and shared substructures are not preserved.
+Second arg VECP causes vectors to be copied, too. Strings and bit vectors
+are not copied.
+*/
+ (arg, vecp))
+{
+ if (CONSP (arg))
+ {
+ Lisp_Object rest;
+ rest = arg = Fcopy_sequence (arg);
+ while (CONSP (rest))
+ {
+ Lisp_Object elt = XCAR (rest);
+ QUIT;
+ if (CONSP (elt) || VECTORP (elt))
+ XCAR (rest) = Fcopy_tree (elt, vecp);
+ if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */
+ XCDR (rest) = Fcopy_tree (XCDR (rest), vecp);
+ rest = XCDR (rest);
+ }
+ }
+ else if (VECTORP (arg) && ! NILP (vecp))
+ {
+ int i = XVECTOR_LENGTH (arg);
+ int j;
+ arg = Fcopy_sequence (arg);
+ for (j = 0; j < i; j++)
+ {
+ Lisp_Object elt = XVECTOR_DATA (arg) [j];
+ QUIT;
+ if (CONSP (elt) || VECTORP (elt))
+ XVECTOR_DATA (arg) [j] = Fcopy_tree (elt, vecp);
+ }
+ }
+ return arg;
+}
+
+DEFUN ("substring", Fsubstring, 2, 3, 0, /*
+Return a substring of STRING, starting at index FROM and ending before TO.
+TO may be nil or omitted; then the substring runs to the end of STRING.
+If FROM or TO is negative, it counts from the end.
+Relevant parts of the string-extent-data are copied in the new string.
+*/
+ (string, from, to))
+{
+ Charcount ccfr, ccto;
+ Bytecount bfr, bto;
+ Lisp_Object val;
+
+ CHECK_STRING (string);
+ /* Historically, FROM could not be omitted. Whatever ... */
+ CHECK_INT (from);
+ 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);
+ /* Copy any applicable extent information into the new string: */
+ copy_string_extents (val, string, 0, bfr, bto - bfr);
+ 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.
+*/
+ (seq, from, to))
+{
+ 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;
+ else
+ {
+ CHECK_INT (to);
+ t = XINT (to);
+ if (t < 0)
+ t = len + t;
+ }
+
+ if (!(0 <= f && f <= t && t <= len))
+ args_out_of_range_3 (seq, make_int (f), make_int (t));
+
+ if (VECTORP (seq))
+ {
+ Lisp_Object result = make_vector (t - f, Qnil);
+ int i;
+ Lisp_Object *in_elts = XVECTOR_DATA (seq);
+ Lisp_Object *out_elts = XVECTOR_DATA (result);
+
+ for (i = f; i < t; i++)
+ out_elts[i - f] = in_elts[i];
+ return result;
+ }
+
+ if (LISTP (seq))
+ {
+ Lisp_Object result = Qnil;
+ int i;
+
+ seq = Fnthcdr (make_int (f), seq);
+
+ for (i = f; i < t; i++)
+ {
+ result = Fcons (Fcar (seq), result);
+ seq = Fcdr (seq);
+ }
+
+ 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;
+ }
+}
+
+\f
+DEFUN ("nthcdr", Fnthcdr, 2, 2, 0, /*
+Take cdr N times on LIST, and return the result.
+*/
+ (n, list))
+{
+ REGISTER int i;
+ REGISTER Lisp_Object tail = list;
+ CHECK_NATNUM (n);
+ for (i = XINT (n); i; i--)
+ {
+ if (CONSP (tail))
+ tail = XCDR (tail);
+ else if (NILP (tail))
+ return Qnil;
+ else
+ {
+ tail = wrong_type_argument (Qlistp, tail);
+ i++;
+ }
+ }
+ return tail;
+}
+
+DEFUN ("nth", Fnth, 2, 2, 0, /*
+Return the Nth element of LIST.
+N counts from zero. If LIST is not that long, nil is returned.
+*/
+ (n, list))
+{
+ return Fcar (Fnthcdr (n, list));
+}
+
+DEFUN ("elt", Felt, 2, 2, 0, /*
+Return element of SEQUENCE at index N.
+*/
+ (sequence, n))
+{
+ retry:
+ CHECK_INT_COERCE_CHAR (n); /* yuck! */
+ if (LISTP (sequence))
+ {
+ Lisp_Object tem = Fnthcdr (n, sequence);
+ /* #### Utterly, completely, fucking disgusting.
+ * #### The whole point of "elt" is that it operates on
+ * #### sequences, and does error- (bounds-) checking.
+ */
+ if (CONSP (tem))
+ return XCAR (tem);
+ else
+#if 1
+ /* This is The Way It Has Always Been. */
+ return Qnil;
+#else
+ /* This is The Way Mly and Cltl2 say It Should Be. */
+ args_out_of_range (sequence, n);
+#endif
+ }
+ else if (STRINGP (sequence)
+ || VECTORP (sequence)
+ || BIT_VECTORP (sequence))
+ return Faref (sequence, n);
+#ifdef LOSING_BYTECODE
+ else if (COMPILED_FUNCTIONP (sequence))
+ {
+ int idx = XINT (n);
+ if (idx < 0)
+ {
+ lose:
+ args_out_of_range (sequence, n);
+ }
+ /* Utter perversity */
+ {
+ struct Lisp_Compiled_Function *b = XCOMPILED_FUNCTION (sequence);
+ switch (idx)
+ {
+ case COMPILED_ARGLIST:
+ return b->arglist;
+ case COMPILED_BYTECODE:
+ return b->bytecodes;
+ case COMPILED_CONSTANTS:
+ return b->constants;
+ case COMPILED_STACK_DEPTH:
+ return make_int (b->maxdepth);
+ case COMPILED_DOC_STRING:
+ return compiled_function_documentation (b);
+ case COMPILED_DOMAIN:
+ return compiled_function_domain (b);
+ case COMPILED_INTERACTIVE:
+ if (b->flags.interactivep)
+ return compiled_function_interactive (b);
+ /* if we return nil, can't tell interactive with no args
+ from noninteractive. */
+ goto lose;
+ default:
+ goto lose;
+ }
+ }
+ }
+#endif /* LOSING_BYTECODE */
+ else
+ {
+ check_losing_bytecode ("elt", sequence);
+ sequence = wrong_type_argument (Qsequencep, sequence);
+ goto retry;
+ }
+}
+
+DEFUN ("member", Fmember, 2, 2, 0, /*
+Return non-nil if ELT is an element of LIST. Comparison done with `equal'.
+The value is actually the tail of LIST whose car is ELT.
+*/
+ (elt, list))
+{
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
+ {
+ CONCHECK_CONS (tail);
+ if (internal_equal (elt, XCAR (tail), 0))
+ return tail;
+ QUIT;
+ }
+ return Qnil;
+}
+
+DEFUN ("old-member", Fold_member, 2, 2, 0, /*
+Return non-nil if ELT is an element of LIST. Comparison done with `old-equal'.
+The value is actually the tail of LIST whose car is ELT.
+This function is provided only for byte-code compatibility with v19.
+Do not use it.
+*/
+ (elt, list))
+{
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
+ {
+ CONCHECK_CONS (tail);
+ if (internal_old_equal (elt, XCAR (tail), 0))
+ return tail;
+ QUIT;
+ }
+ return Qnil;
+}
+
+DEFUN ("memq", Fmemq, 2, 2, 0, /*
+Return non-nil if ELT is an element of LIST. Comparison done with `eq'.
+The value is actually the tail of LIST whose car is ELT.
+*/
+ (elt, list))
+{
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
+ {
+ REGISTER Lisp_Object tem;
+ CONCHECK_CONS (tail);
+ if (tem = XCAR (tail), EQ_WITH_EBOLA_NOTICE (elt, tem))
+ return tail;
+ QUIT;
+ }
+ return Qnil;
+}
+
+DEFUN ("old-memq", Fold_memq, 2, 2, 0, /*
+Return non-nil if ELT is an element of LIST. Comparison done with `old-eq'.
+The value is actually the tail of LIST whose car is ELT.
+This function is provided only for byte-code compatibility with v19.
+Do not use it.
+*/
+ (elt, list))
+{
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
+ {
+ REGISTER Lisp_Object tem;
+ CONCHECK_CONS (tail);
+ if (tem = XCAR (tail), HACKEQ_UNSAFE (elt, tem))
+ return tail;
+ QUIT;
+ }
+ return Qnil;
+}
+
+Lisp_Object
+memq_no_quit (Lisp_Object elt, Lisp_Object list)
+{
+ REGISTER Lisp_Object tail;
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
+ {
+ REGISTER Lisp_Object tem;
+ if (tem = XCAR (tail), EQ_WITH_EBOLA_NOTICE (elt, tem))
+ return tail;
+ }
+ return Qnil;
+}
+
+DEFUN ("assoc", Fassoc, 2, 2, 0, /*
+Return non-nil if KEY is `equal' to the car of an element of LIST.
+The value is actually the element of LIST whose car equals KEY.
+*/
+ (key, list))
+{
+ /* This function can GC. */
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
+ {
+ REGISTER Lisp_Object elt;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && internal_equal (XCAR (elt), key, 0))
+ return elt;
+ QUIT;
+ }
+ return Qnil;
+}
+
+DEFUN ("old-assoc", Fold_assoc, 2, 2, 0, /*
+Return non-nil if KEY is `old-equal' to the car of an element of LIST.
+The value is actually the element of LIST whose car equals KEY.
+*/
+ (key, list))
+{
+ /* This function can GC. */
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
+ {
+ REGISTER Lisp_Object elt;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && internal_old_equal (XCAR (elt), key, 0))
+ return elt;
+ QUIT;
+ }
+ return Qnil;
+}
+
+Lisp_Object
+assoc_no_quit (Lisp_Object key, Lisp_Object list)
+{
+ int speccount = specpdl_depth ();
+ specbind (Qinhibit_quit, Qt);
+ return unbind_to (speccount, Fassoc (key, list));
+}
+
+DEFUN ("assq", Fassq, 2, 2, 0, /*
+Return non-nil if KEY is `eq' to the car of an element of LIST.
+The value is actually the element of LIST whose car is KEY.
+Elements of LIST that are not conses are ignored.
+*/
+ (key, list))
+{
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
+ {
+ REGISTER Lisp_Object elt, tem;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && (tem = XCAR (elt), EQ_WITH_EBOLA_NOTICE (key, tem)))
+ return elt;
+ QUIT;
+ }
+ return Qnil;
+}
+
+DEFUN ("old-assq", Fold_assq, 2, 2, 0, /*
+Return non-nil if KEY is `old-eq' to the car of an element of LIST.
+The value is actually the element of LIST whose car is KEY.
+Elements of LIST that are not conses are ignored.
+This function is provided only for byte-code compatibility with v19.
+Do not use it.
+*/
+ (key, list))
+{
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
+ {
+ REGISTER Lisp_Object elt, tem;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && (tem = XCAR (elt), HACKEQ_UNSAFE (key, tem)))
+ return elt;
+ QUIT;
+ }
+ return Qnil;
+}
+
+/* Like Fassq but never report an error and do not allow quits.
+ Use only on lists known never to be circular. */
+
+Lisp_Object
+assq_no_quit (Lisp_Object key, Lisp_Object list)
+{
+ /* This cannot GC. */
+ REGISTER Lisp_Object tail;
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
+ {
+ REGISTER Lisp_Object tem, elt;
+ elt = XCAR (tail);
+ if (CONSP (elt) && (tem = XCAR (elt), EQ_WITH_EBOLA_NOTICE (key, tem)))
+ return elt;
+ }
+ return Qnil;
+}
+
+DEFUN ("rassoc", Frassoc, 2, 2, 0, /*
+Return non-nil if KEY is `equal' to the cdr of an element of LIST.
+The value is actually the element of LIST whose cdr equals KEY.
+*/
+ (key, list))
+{
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
+ {
+ REGISTER Lisp_Object elt;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && internal_equal (XCDR (elt), key, 0))
+ return elt;
+ QUIT;
+ }
+ return Qnil;
+}
+
+DEFUN ("old-rassoc", Fold_rassoc, 2, 2, 0, /*
+Return non-nil if KEY is `old-equal' to the cdr of an element of LIST.
+The value is actually the element of LIST whose cdr equals KEY.
+*/
+ (key, list))
+{
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
+ {
+ REGISTER Lisp_Object elt;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && internal_old_equal (XCDR (elt), key, 0))
+ return elt;
+ QUIT;
+ }
+ return Qnil;
+}
+
+DEFUN ("rassq", Frassq, 2, 2, 0, /*
+Return non-nil if KEY is `eq' to the cdr of an element of LIST.
+The value is actually the element of LIST whose cdr is KEY.
+*/
+ (key, list))
+{
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
+ {
+ REGISTER Lisp_Object elt, tem;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && (tem = XCDR (elt), EQ_WITH_EBOLA_NOTICE (key, tem)))
+ return elt;
+ QUIT;
+ }
+ return Qnil;
+}
+
+DEFUN ("old-rassq", Fold_rassq, 2, 2, 0, /*
+Return non-nil if KEY is `old-eq' to the cdr of an element of LIST.
+The value is actually the element of LIST whose cdr is KEY.
+*/
+ (key, list))
+{
+ REGISTER Lisp_Object tail;
+ LIST_LOOP (tail, list)
+ {
+ REGISTER Lisp_Object elt, tem;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && (tem = XCDR (elt), HACKEQ_UNSAFE (key, tem)))
+ return elt;
+ QUIT;
+ }
+ return Qnil;
+}
+
+Lisp_Object
+rassq_no_quit (Lisp_Object key, Lisp_Object list)
+{
+ REGISTER Lisp_Object tail;
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
+ {
+ REGISTER Lisp_Object elt, tem;
+ elt = XCAR (tail);
+ if (CONSP (elt) && (tem = XCDR (elt), EQ_WITH_EBOLA_NOTICE (key, tem)))
+ return elt;
+ }
+ return Qnil;
+}
+
+\f
+DEFUN ("delete", Fdelete, 2, 2, 0, /*
+Delete by side effect any occurrences of ELT as a member of LIST.
+The modified LIST is returned. Comparison is done with `equal'.
+If the first member of LIST is ELT, there is no way to remove it by side
+effect; therefore, write `(setq foo (delete element foo))' to be sure
+of changing the value of `foo'.
+Also see: `remove'.
+*/
+ (elt, list))
+{
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+
+ while (!NILP (tail))
+ {
+ CONCHECK_CONS (tail);
+ if (internal_equal (elt, XCAR (tail), 0))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ QUIT;
+ }
+ return list;
+}
+
+DEFUN ("old-delete", Fold_delete, 2, 2, 0, /*
+Delete by side effect any occurrences of ELT as a member of LIST.
+The modified LIST is returned. Comparison is done with `old-equal'.
+If the first member of LIST is ELT, there is no way to remove it by side
+effect; therefore, write `(setq foo (old-delete element foo))' to be sure
+of changing the value of `foo'.
+*/
+ (elt, list))
+{
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+
+ while (!NILP (tail))
+ {
+ CONCHECK_CONS (tail);
+ if (internal_old_equal (elt, XCAR (tail), 0))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ QUIT;
+ }
+ return list;
+}
+
+DEFUN ("delq", Fdelq, 2, 2, 0, /*
+Delete by side effect any occurrences of ELT as a member of LIST.
+The modified LIST is returned. Comparison is done with `eq'.
+If the first member of LIST is ELT, there is no way to remove it by side
+effect; therefore, write `(setq foo (delq element foo))' to be sure of
+changing the value of `foo'.
+*/
+ (elt, list))
+{
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+
+ while (!NILP (tail))
+ {
+ REGISTER Lisp_Object tem;
+ CONCHECK_CONS (tail);
+ if (tem = XCAR (tail), EQ_WITH_EBOLA_NOTICE (elt, tem))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ QUIT;
+ }
+ return list;
+}
+
+DEFUN ("old-delq", Fold_delq, 2, 2, 0, /*
+Delete by side effect any occurrences of ELT as a member of LIST.
+The modified LIST is returned. Comparison is done with `old-eq'.
+If the first member of LIST is ELT, there is no way to remove it by side
+effect; therefore, write `(setq foo (old-delq element foo))' to be sure of
+changing the value of `foo'.
+*/
+ (elt, list))
+{
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+
+ while (!NILP (tail))
+ {
+ REGISTER Lisp_Object tem;
+ CONCHECK_CONS (tail);
+ if (tem = XCAR (tail), HACKEQ_UNSAFE (elt, tem))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ QUIT;
+ }
+ return list;
+}
+
+/* no quit, no errors; be careful */
+
+Lisp_Object
+delq_no_quit (Lisp_Object elt, Lisp_Object list)
+{
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+
+ while (CONSP (tail))
+ {
+ REGISTER Lisp_Object tem;
+ if (tem = XCAR (tail), EQ_WITH_EBOLA_NOTICE (elt, tem))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ }
+ return list;
+}
+
+/* Be VERY careful with this. This is like delq_no_quit() but
+ also calls free_cons() on the removed conses. You must be SURE
+ that no pointers to the freed conses remain around (e.g.
+ someone else is pointing to part of the list). This function
+ is useful on internal lists that are used frequently and where
+ the actual list doesn't escape beyond known code bounds. */
+
+Lisp_Object
+delq_no_quit_and_free_cons (Lisp_Object elt, Lisp_Object list)
+{
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+ struct Lisp_Cons *cons_to_free = NULL;
+
+ while (CONSP (tail))
+ {
+ REGISTER Lisp_Object tem;
+ if (tem = XCAR (tail), EQ_WITH_EBOLA_NOTICE (elt, tem))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ cons_to_free = XCONS (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ if (cons_to_free)
+ {
+ free_cons (cons_to_free);
+ cons_to_free = NULL;
+ }
+ }
+ return list;
+}
+
+DEFUN ("remassoc", Fremassoc, 2, 2, 0, /*
+Delete by side effect any elements of LIST whose car is `equal' to KEY.
+The modified LIST is returned. If the first member of LIST has a car
+that is `equal' to KEY, there is no way to remove it by side effect;
+therefore, write `(setq foo (remassoc key foo))' to be sure of changing
+the value of `foo'.
+*/
+ (key, list))
+{
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+
+ while (!NILP (tail))
+ {
+ REGISTER Lisp_Object elt;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && internal_equal (key, XCAR (elt), 0))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ QUIT;
+ }
+ return list;
+}
+
+Lisp_Object
+remassoc_no_quit (Lisp_Object key, Lisp_Object list)
+{
+ int speccount = specpdl_depth ();
+ specbind (Qinhibit_quit, Qt);
+ return unbind_to (speccount, Fremassoc (key, list));
+}
+
+DEFUN ("remassq", Fremassq, 2, 2, 0, /*
+Delete by side effect any elements of LIST whose car is `eq' to KEY.
+The modified LIST is returned. If the first member of LIST has a car
+that is `eq' to KEY, there is no way to remove it by side effect;
+therefore, write `(setq foo (remassq key foo))' to be sure of changing
+the value of `foo'.
+*/
+ (key, list))
+{
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+
+ while (!NILP (tail))
+ {
+ REGISTER Lisp_Object elt, tem;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && (tem = XCAR (elt), EQ_WITH_EBOLA_NOTICE (key, tem)))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ QUIT;
+ }
+ return list;
+}
+
+/* no quit, no errors; be careful */
+
+Lisp_Object
+remassq_no_quit (Lisp_Object key, Lisp_Object list)
+{
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+
+ while (CONSP (tail))
+ {
+ REGISTER Lisp_Object elt, tem;
+ elt = XCAR (tail);
+ if (CONSP (elt) && (tem = XCAR (elt), EQ_WITH_EBOLA_NOTICE (key, tem)))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ }
+ return list;
+}
+
+DEFUN ("remrassoc", Fremrassoc, 2, 2, 0, /*
+Delete by side effect any elements of LIST whose cdr is `equal' to VALUE.
+The modified LIST is returned. If the first member of LIST has a car
+that is `equal' to VALUE, there is no way to remove it by side effect;
+therefore, write `(setq foo (remrassoc value foo))' to be sure of changing
+the value of `foo'.
+*/
+ (value, list))
+{
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+
+ while (!NILP (tail))
+ {
+ REGISTER Lisp_Object elt;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && internal_equal (value, XCDR (elt), 0))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ QUIT;
+ }
+ return list;
+}
+
+DEFUN ("remrassq", Fremrassq, 2, 2, 0, /*
+Delete by side effect any elements of LIST whose cdr is `eq' to VALUE.
+The modified LIST is returned. If the first member of LIST has a car
+that is `eq' to VALUE, there is no way to remove it by side effect;
+therefore, write `(setq foo (remrassq value foo))' to be sure of changing
+the value of `foo'.
+*/
+ (value, list))
+{
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+
+ while (!NILP (tail))
+ {
+ REGISTER Lisp_Object elt, tem;
+ CONCHECK_CONS (tail);
+ elt = XCAR (tail);
+ if (CONSP (elt) && (tem = XCAR (elt), EQ_WITH_EBOLA_NOTICE (value, tem)))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ QUIT;
+ }
+ return list;
+}
+
+/* no quit, no errors; be careful */
+
+Lisp_Object
+remrassq_no_quit (Lisp_Object value, Lisp_Object list)
+{
+ REGISTER Lisp_Object tail = list;
+ REGISTER Lisp_Object prev = Qnil;
+
+ while (CONSP (tail))
+ {
+ REGISTER Lisp_Object elt, tem;
+ elt = XCAR (tail);
+ if (CONSP (elt) && (tem = XCAR (elt), EQ_WITH_EBOLA_NOTICE (value, tem)))
+ {
+ if (NILP (prev))
+ list = XCDR (tail);
+ else
+ XCDR (prev) = XCDR (tail);
+ }
+ else
+ prev = tail;
+ tail = XCDR (tail);
+ }
+ return list;
+}
+
+DEFUN ("nreverse", Fnreverse, 1, 1, 0, /*
+Reverse LIST by destructively modifying cdr pointers.
+Return the beginning of the reversed list.
+Also see: `reverse'.
+*/
+ (list))
+{
+ struct gcpro gcpro1, gcpro2;
+ REGISTER Lisp_Object prev = Qnil;
+ REGISTER Lisp_Object tail = list;
+
+ /* We gcpro our args; see `nconc' */
+ GCPRO2 (prev, tail);
+ while (!NILP (tail))
+ {
+ REGISTER Lisp_Object next;
+ QUIT;
+ CONCHECK_CONS (tail);
+ next = XCDR (tail);
+ XCDR (tail) = prev;
+ prev = tail;
+ tail = next;
+ }
+ UNGCPRO;
+ return prev;
+}
+
+DEFUN ("reverse", Freverse, 1, 1, 0, /*
+Reverse LIST, copying. Return the beginning of the reversed list.
+See also the function `nreverse', which is used more often.
+*/
+ (list))
+{
+ REGISTER Lisp_Object tail;
+ Lisp_Object new = Qnil;
+
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
+ {
+ new = Fcons (XCAR (tail), new);
+ QUIT;
+ }
+ if (!NILP (tail))
+ dead_wrong_type_argument (Qlistp, tail);
+ return new;
+}
+\f
+static Lisp_Object list_merge (Lisp_Object org_l1, Lisp_Object org_l2,
+ Lisp_Object lisp_arg,
+ int (*pred_fn) (Lisp_Object, Lisp_Object,
+ Lisp_Object lisp_arg));
+
+Lisp_Object
+list_sort (Lisp_Object list,
+ Lisp_Object lisp_arg,
+ int (*pred_fn) (Lisp_Object, Lisp_Object,
+ Lisp_Object lisp_arg))
+{
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ Lisp_Object back, tem;
+ Lisp_Object front = list;
+ Lisp_Object len = Flength (list);
+ int length = XINT (len);
+
+ if (length < 2)
+ return list;
+
+ XSETINT (len, (length / 2) - 1);
+ tem = Fnthcdr (len, list);
+ back = Fcdr (tem);
+ Fsetcdr (tem, Qnil);
+
+ GCPRO3 (front, back, lisp_arg);
+ front = list_sort (front, lisp_arg, pred_fn);
+ back = list_sort (back, lisp_arg, pred_fn);
+ UNGCPRO;
+ return list_merge (front, back, lisp_arg, pred_fn);
+}
+
+\f
+static int
+merge_pred_function (Lisp_Object obj1, Lisp_Object obj2,
+ Lisp_Object pred)
+{
+ Lisp_Object tmp;
+
+ /* prevents the GC from happening in call2 */
+ int speccount = specpdl_depth ();
+/* Emacs' GC doesn't actually relocate pointers, so this probably
+ isn't strictly necessary */
+ record_unwind_protect (restore_gc_inhibit,
+ make_int (gc_currently_forbidden));
+ gc_currently_forbidden = 1;
+ tmp = call2 (pred, obj1, obj2);
+ unbind_to (speccount, Qnil);
+
+ if (NILP (tmp))
+ return -1;
+ else
+ return 1;
+}
+
+DEFUN ("sort", Fsort, 2, 2, 0, /*
+Sort LIST, stably, comparing elements using PREDICATE.
+Returns the sorted list. LIST is modified by side effects.
+PREDICATE is called with two elements of LIST, and should return T
+if the first element is "less" than the second.
+*/
+ (list, pred))
+{
+ return list_sort (list, pred, merge_pred_function);
+}
+
+Lisp_Object
+merge (Lisp_Object org_l1, Lisp_Object org_l2,
+ Lisp_Object pred)
+{
+ return list_merge (org_l1, org_l2, pred, merge_pred_function);
+}
+
+
+static Lisp_Object
+list_merge (Lisp_Object org_l1, Lisp_Object org_l2,
+ Lisp_Object lisp_arg,
+ int (*pred_fn) (Lisp_Object, Lisp_Object, Lisp_Object lisp_arg))
+{
+ Lisp_Object value;
+ Lisp_Object tail;
+ Lisp_Object tem;
+ Lisp_Object l1, l2;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+
+ l1 = org_l1;
+ l2 = org_l2;
+ tail = Qnil;
+ value = Qnil;
+
+ /* It is sufficient to protect org_l1 and org_l2.
+ When l1 and l2 are updated, we copy the new values
+ back into the org_ vars. */
+
+ GCPRO4 (org_l1, org_l2, lisp_arg, value);
+
+ while (1)
+ {
+ if (NILP (l1))
+ {
+ UNGCPRO;
+ if (NILP (tail))
+ return l2;
+ Fsetcdr (tail, l2);
+ return value;
+ }
+ if (NILP (l2))
+ {
+ UNGCPRO;
+ if (NILP (tail))
+ return l1;
+ Fsetcdr (tail, l1);
+ return value;
+ }
+
+ if (((*pred_fn) (Fcar (l2), Fcar (l1), lisp_arg)) < 0)
+ {
+ tem = l1;
+ l1 = Fcdr (l1);
+ org_l1 = l1;
+ }
+ else
+ {
+ tem = l2;
+ l2 = Fcdr (l2);
+ org_l2 = l2;
+ }
+ if (NILP (tail))
+ value = tem;
+ else
+ Fsetcdr (tail, tem);
+ tail = tem;
+ }
+}
+
+\f
+/************************************************************************/
+/* property-list functions */
+/************************************************************************/
+
+/* For properties of text, we need to do order-insensitive comparison of
+ plists. That is, we need to compare two plists such that they are the
+ same if they have the same set of keys, and equivalent values.
+ So (a 1 b 2) would be equal to (b 2 a 1).
+
+ NIL_MEANS_NOT_PRESENT is as in `plists-eq' etc.
+ LAXP means use `equal' for comparisons.
+ */
+int
+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 la, lb, m, i, fill;
+ Lisp_Object *keys, *vals;
+ char *flags;
+ Lisp_Object rest;
+
+ if (NILP (a) && NILP (b))
+ return 0;
+
+ Fcheck_valid_plist (a);
+ Fcheck_valid_plist (b);
+
+ la = XINT (Flength (a));
+ lb = XINT (Flength (b));
+ m = (la > lb ? la : lb);
+ fill = 0;
+ keys = alloca_array (Lisp_Object, m);
+ vals = alloca_array (Lisp_Object, m);
+ flags = alloca_array (char, m);
+
+ /* First extract the pairs from A. */
+ for (rest = a; !NILP (rest); rest = XCDR (XCDR (rest)))
+ {
+ Lisp_Object k = XCAR (rest);
+ Lisp_Object v = XCAR (XCDR (rest));
+ /* Maybe be Ebolified. */
+ if (nil_means_not_present && NILP (v)) continue;
+ keys [fill] = k;
+ vals [fill] = v;
+ flags[fill] = 0;
+ fill++;
+ }
+ /* Now iterate over B, and stop if we find something that's not in A,
+ or that doesn't match. As we match, mark them. */
+ for (rest = b; !NILP (rest); rest = XCDR (XCDR (rest)))
+ {
+ Lisp_Object k = XCAR (rest);
+ Lisp_Object v = XCAR (XCDR (rest));
+ /* Maybe be Ebolified. */
+ if (nil_means_not_present && NILP (v)) continue;
+ for (i = 0; i < fill; i++)
+ {
+ 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)))
+ /* a property in B has a different value than in A */
+ goto MISMATCH;
+ flags [i] = 1;
+ break;
+ }
+ }
+ if (i == fill)
+ /* there are some properties in B that are not in A */
+ goto MISMATCH;
+ }
+ /* Now check to see that all the properties in A were also in B */
+ for (i = 0; i < fill; i++)
+ if (flags [i] == 0)
+ goto MISMATCH;
+
+ /* Ok. */
+ return 0;
+
+ MISMATCH:
+ return 1;
+}
+
+DEFUN ("plists-eq", Fplists_eq, 2, 3, 0, /*
+Return non-nil if property lists A and B are `eq'.
+A property list is an alternating list of keywords and values.
+ This function does order-insensitive comparisons of the property lists:
+ For example, the property lists '(a 1 b 2) and '(b 2 a 1) are equal.
+ Comparison between values is done using `eq'. See also `plists-equal'.
+If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with
+ a nil value is ignored. This feature is a virus that has infected
+ old Lisp implementations, but should not be used except for backward
+ compatibility.
+*/
+ (a, b, nil_means_not_present))
+{
+ return (plists_differ (a, b, !NILP (nil_means_not_present), 0, -1)
+ ? Qnil : Qt);
+}
+
+DEFUN ("plists-equal", Fplists_equal, 2, 3, 0, /*
+Return non-nil if property lists A and B are `equal'.
+A property list is an alternating list of keywords and values. This
+ function does order-insensitive comparisons of the property lists: For
+ example, the property lists '(a 1 b 2) and '(b 2 a 1) are equal.
+ Comparison between values is done using `equal'. See also `plists-eq'.
+If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with
+ a nil value is ignored. This feature is a virus that has infected
+ old Lisp implementations, but should not be used except for backward
+ compatibility.
+*/
+ (a, b, nil_means_not_present))
+{
+ return (plists_differ (a, b, !NILP (nil_means_not_present), 0, 1)
+ ? Qnil : Qt);
+}
+
+
+DEFUN ("lax-plists-eq", Flax_plists_eq, 2, 3, 0, /*
+Return non-nil if lax property lists A and B are `eq'.
+A property list is an alternating list of keywords and values.
+ This function does order-insensitive comparisons of the property lists:
+ For example, the property lists '(a 1 b 2) and '(b 2 a 1) are equal.
+ Comparison between values is done using `eq'. See also `plists-equal'.
+A lax property list is like a regular one except that comparisons between
+ keywords is done using `equal' instead of `eq'.
+If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with
+ a nil value is ignored. This feature is a virus that has infected
+ old Lisp implementations, but should not be used except for backward
+ compatibility.
+*/
+ (a, b, nil_means_not_present))
+{
+ return (plists_differ (a, b, !NILP (nil_means_not_present), 1, -1)
+ ? Qnil : Qt);
+}
+
+DEFUN ("lax-plists-equal", Flax_plists_equal, 2, 3, 0, /*
+Return non-nil if lax property lists A and B are `equal'.
+A property list is an alternating list of keywords and values. This
+ function does order-insensitive comparisons of the property lists: For
+ example, the property lists '(a 1 b 2) and '(b 2 a 1) are equal.
+ Comparison between values is done using `equal'. See also `plists-eq'.
+A lax property list is like a regular one except that comparisons between
+ keywords is done using `equal' instead of `eq'.
+If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with
+ a nil value is ignored. This feature is a virus that has infected
+ old Lisp implementations, but should not be used except for backward
+ compatibility.
+*/
+ (a, b, nil_means_not_present))
+{
+ return (plists_differ (a, b, !NILP (nil_means_not_present), 1, 1)
+ ? Qnil : Qt);
+}
+
+/* Return the value associated with key PROPERTY in property list PLIST.
+ Return nil if key not found. This function is used for internal
+ property lists that cannot be directly manipulated by the user.
+ */
+
+Lisp_Object
+internal_plist_get (Lisp_Object plist, Lisp_Object property)
+{
+ Lisp_Object tail = plist;
+
+ for (; !NILP (tail); tail = XCDR (XCDR (tail)))
+ {
+ struct Lisp_Cons *c = XCONS (tail);
+ if (EQ (c->car, property))
+ return XCAR (c->cdr);
+ }
+
+ return Qunbound;
+}
+
+/* Set PLIST's value for PROPERTY to VALUE. Analogous to
+ internal_plist_get(). */
+
+void
+internal_plist_put (Lisp_Object *plist, Lisp_Object property,
+ Lisp_Object value)
+{
+ Lisp_Object tail;
+
+ for (tail = *plist; !NILP (tail); tail = XCDR (XCDR (tail)))
+ {
+ if (EQ (XCAR (tail), property))
+ {
+ XCAR (XCDR (tail)) = value;
+ return;
+ }
+ }
+
+ *plist = Fcons (property, Fcons (value, *plist));
+}
+
+int
+internal_remprop (Lisp_Object *plist, Lisp_Object property)
+{
+ Lisp_Object tail = *plist;
+
+ if (NILP (tail))
+ return 0;
+
+ if (EQ (XCAR (tail), property))
+ {
+ *plist = XCDR (XCDR (tail));
+ return 1;
+ }
+
+ for (tail = XCDR (tail); !NILP (XCDR (tail));
+ tail = XCDR (XCDR (tail)))
+ {
+ struct Lisp_Cons *c = XCONS (tail);
+ if (EQ (XCAR (c->cdr), property))
+ {
+ c->cdr = XCDR (XCDR (c->cdr));
+ return 1;
+ }
+ }
+
+ return 0;
+}
+
+/* Called on a malformed property list. BADPLACE should be some
+ place where truncating will form a good list -- i.e. we shouldn't
+ result in a list with an odd length. */
+
+static Lisp_Object
+bad_bad_bunny (Lisp_Object *plist, Lisp_Object *badplace, Error_behavior errb)
+{
+ if (ERRB_EQ (errb, ERROR_ME))
+ return Fsignal (Qmalformed_property_list, list2 (*plist, *badplace));
+ else
+ {
+ if (ERRB_EQ (errb, ERROR_ME_WARN))
+ {
+ warn_when_safe_lispobj
+ (Qlist, Qwarning,
+ list2 (build_string
+ ("Malformed property list -- list has been truncated"),
+ *plist));
+ *badplace = Qnil;
+ }
+ return Qunbound;
+ }
+}
+
+/* Called on a circular property list. BADPLACE should be some place
+ where truncating will result in an even-length list, as above.
+ If doesn't particularly matter where we truncate -- anywhere we
+ truncate along the entire list will break the circularity, because
+ it will create a terminus and the list currently doesn't have one.
+*/
+
+static Lisp_Object
+bad_bad_turtle (Lisp_Object *plist, Lisp_Object *badplace, Error_behavior errb)
+{
+ if (ERRB_EQ (errb, ERROR_ME))
+ /* #### Eek, this will probably result in another error
+ when PLIST is printed out */
+ return Fsignal (Qcircular_property_list, list1 (*plist));
+ else
+ {
+ if (ERRB_EQ (errb, ERROR_ME_WARN))
+ {
+ warn_when_safe_lispobj
+ (Qlist, Qwarning,
+ list2 (build_string
+ ("Circular property list -- list has been truncated"),
+ *plist));
+ *badplace = Qnil;
+ }
+ return Qunbound;
+ }
+}
+
+/* Advance the tortoise pointer by two (one iteration of a property-list
+ loop) and the hare pointer by four and verify that no malformations
+ or circularities exist. If so, return zero and store a value into
+ RETVAL that should be returned by the calling function. Otherwise,
+ return 1. See external_plist_get().
+ */
+
+static int
+advance_plist_pointers (Lisp_Object *plist,
+ Lisp_Object **tortoise, Lisp_Object **hare,
+ Error_behavior errb, Lisp_Object *retval)
+{
+ int i;
+ Lisp_Object *tortsave = *tortoise;
+
+ /* Note that our "fixing" may be more brutal than necessary,
+ but it's the user's own problem, not ours. if they went in and
+ manually fucked up a plist. */
+
+ for (i = 0; i < 2; i++)
+ {
+ /* This is a standard iteration of a defensive-loop-checking
+ loop. We just do it twice because we want to advance past
+ both the property and its value.
+
+ If the pointer indirection is confusing you, remember that
+ one level of indirection on the hare and tortoise pointers
+ is only due to pass-by-reference for this function. The other
+ level is so that the plist can be fixed in place. */
+
+ /* When we reach the end of a well-formed plist, **HARE is
+ nil. In that case, we don't do anything at all except
+ advance TORTOISE by one. Otherwise, we advance HARE
+ by two (making sure it's OK to do so), then advance
+ TORTOISE by one (it will always be OK to do so because
+ the HARE is always ahead of the TORTOISE and will have
+ already verified the path), then make sure TORTOISE and
+ HARE don't contain the same non-nil object -- if the
+ TORTOISE and the HARE ever meet, then obviously we're
+ in a circularity, and if we're in a circularity, then
+ the TORTOISE and the HARE can't cross paths without
+ meeting, since the HARE only gains one step over the
+ TORTOISE per iteration. */
+
+ if (!NILP (**hare))
+ {
+ Lisp_Object *haresave = *hare;
+ if (!CONSP (**hare))
+ {
+ *retval = bad_bad_bunny (plist, haresave, errb);
+ return 0;
+ }
+ *hare = &XCDR (**hare);
+ /* In a non-plist, we'd check here for a nil value for
+ **HARE, which is OK (it just means the list has an
+ odd number of elements). In a plist, it's not OK
+ for the list to have an odd number of elements. */
+ if (!CONSP (**hare))
+ {
+ *retval = bad_bad_bunny (plist, haresave, errb);
+ return 0;
+ }
+ *hare = &XCDR (**hare);
+ }
+
+ *tortoise = &XCDR (**tortoise);
+ if (!NILP (**hare) && EQ (**tortoise, **hare))
+ {
+ *retval = bad_bad_turtle (plist, tortsave, errb);
+ return 0;
+ }
+ }
+
+ return 1;
+}
+
+/* Return the value of PROPERTY from PLIST, or Qunbound if
+ property is not on the list.
+
+ PLIST is a Lisp-accessible property list, meaning that it
+ has to be checked for malformations and circularities.
+
+ If ERRB is ERROR_ME, an error will be signalled. Otherwise, the
+ function will never signal an error; and if ERRB is ERROR_ME_WARN,
+ on finding a malformation or a circularity, it issues a warning and
+ attempts to silently fix the problem.
+
+ A pointer to PLIST is passed in so that PLIST can be successfully
+ "fixed" even if the error is at the beginning of the plist. */
+
+Lisp_Object
+external_plist_get (Lisp_Object *plist, Lisp_Object property,
+ int laxp, Error_behavior errb)
+{
+ Lisp_Object *tortoise = plist;
+ Lisp_Object *hare = plist;
+
+ while (!NILP (*tortoise))
+ {
+ Lisp_Object *tortsave = tortoise;
+ Lisp_Object retval;
+
+ /* We do the standard tortoise/hare march. We isolate the
+ grungy stuff to do this in advance_plist_pointers(), though.
+ To us, all this function does is advance the tortoise
+ pointer by two and the hare pointer by four and make sure
+ everything's OK. We first advance the pointers and then
+ check if a property matched; this ensures that our
+ check for a matching property is safe. */
+
+ if (!advance_plist_pointers (plist, &tortoise, &hare, errb, &retval))
+ return retval;
+
+ if (!laxp ? EQ (XCAR (*tortsave), property)
+ : internal_equal (XCAR (*tortsave), property, 0))
+ return XCAR (XCDR (*tortsave));
+ }
+
+ return Qunbound;
+}
+
+/* Set PLIST's value for PROPERTY to VALUE, given a possibly
+ malformed or circular plist. Analogous to external_plist_get(). */
+
+void
+external_plist_put (Lisp_Object *plist, Lisp_Object property,
+ Lisp_Object value, int laxp, Error_behavior errb)
+{
+ Lisp_Object *tortoise = plist;
+ Lisp_Object *hare = plist;
+
+ while (!NILP (*tortoise))
+ {
+ Lisp_Object *tortsave = tortoise;
+ Lisp_Object retval;
+
+ /* See above */
+ if (!advance_plist_pointers (plist, &tortoise, &hare, errb, &retval))
+ return;
+
+ if (!laxp ? EQ (XCAR (*tortsave), property)
+ : internal_equal (XCAR (*tortsave), property, 0))
+ {
+ XCAR (XCDR (*tortsave)) = value;
+ return;
+ }
+ }
+
+ *plist = Fcons (property, Fcons (value, *plist));
+}
+
+int
+external_remprop (Lisp_Object *plist, Lisp_Object property,
+ int laxp, Error_behavior errb)
+{
+ Lisp_Object *tortoise = plist;
+ Lisp_Object *hare = plist;
+
+ while (!NILP (*tortoise))
+ {
+ Lisp_Object *tortsave = tortoise;
+ Lisp_Object retval;
+
+ /* See above */
+ if (!advance_plist_pointers (plist, &tortoise, &hare, errb, &retval))
+ return 0;
+
+ if (!laxp ? EQ (XCAR (*tortsave), property)
+ : internal_equal (XCAR (*tortsave), property, 0))
+ {
+ /* Now you see why it's so convenient to have that level
+ of indirection. */
+ *tortsave = XCDR (XCDR (*tortsave));
+ return 1;
+ }
+ }
+
+ return 0;
+}
+
+DEFUN ("plist-get", Fplist_get, 2, 3, 0, /*
+Extract a value from a property list.
+PLIST is a property list, which is a list of the form
+\(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value
+corresponding to the given PROP, or DEFAULT if PROP is not
+one of the properties on the list.
+*/
+ (plist, prop, default_))
+{
+ Lisp_Object val = external_plist_get (&plist, prop, 0, ERROR_ME);
+ if (UNBOUNDP (val))
+ return default_;
+ return val;
+}
+
+DEFUN ("plist-put", Fplist_put, 3, 3, 0, /*
+Change value in PLIST of PROP to VAL.
+PLIST is a property list, which is a list of the form \(PROP1 VALUE1
+PROP2 VALUE2 ...). PROP is usually a symbol and VAL is any object.
+If PROP is already a property on the list, its value is set to VAL,
+otherwise the new PROP VAL pair is added. The new plist is returned;
+use `(setq x (plist-put x prop val))' to be sure to use the new value.
+The PLIST is modified by side effects.
+*/
+ (plist, prop, val))
+{
+ external_plist_put (&plist, prop, val, 0, ERROR_ME);
+ return plist;
+}
+
+DEFUN ("plist-remprop", Fplist_remprop, 2, 2, 0, /*
+Remove from PLIST the property PROP and its value.
+PLIST is a property list, which is a list of the form \(PROP1 VALUE1
+PROP2 VALUE2 ...). PROP is usually a symbol. The new plist is
+returned; use `(setq x (plist-remprop x prop val))' to be sure to use
+the new value. The PLIST is modified by side effects.
+*/
+ (plist, prop))
+{
+ external_remprop (&plist, prop, 0, ERROR_ME);
+ return plist;
+}
+
+DEFUN ("plist-member", Fplist_member, 2, 2, 0, /*
+Return t if PROP has a value specified in PLIST.
+*/
+ (plist, prop))
+{
+ return UNBOUNDP (Fplist_get (plist, prop, Qunbound)) ? Qnil : Qt;
+}
+
+DEFUN ("check-valid-plist", Fcheck_valid_plist, 1, 1, 0, /*
+Given a plist, signal an error if there is anything wrong with it.
+This means that it's a malformed or circular plist.
+*/
+ (plist))
+{
+ Lisp_Object *tortoise;
+ Lisp_Object *hare;
+
+ start_over:
+ tortoise = &plist;
+ hare = &plist;
+ while (!NILP (*tortoise))
+ {
+ Lisp_Object retval;
+
+ /* See above */
+ if (!advance_plist_pointers (&plist, &tortoise, &hare, ERROR_ME,
+ &retval))
+ goto start_over;
+ }
+
+ return Qnil;
+}
+
+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.
+*/
+ (plist))
+{
+ Lisp_Object *tortoise;
+ Lisp_Object *hare;
+
+ tortoise = &plist;
+ hare = &plist;
+ while (!NILP (*tortoise))
+ {
+ Lisp_Object retval;
+
+ /* See above */
+ if (!advance_plist_pointers (&plist, &tortoise, &hare, ERROR_ME_NOT,
+ &retval))
+ return Qnil;
+ }
+
+ return Qt;
+}
+
+DEFUN ("canonicalize-plist", Fcanonicalize_plist, 1, 2, 0, /*
+Destructively remove any duplicate entries from a plist.
+In such cases, the first entry applies.
+
+If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with
+ a nil value is removed. This feature is a virus that has infected
+ old Lisp implementations, but should not be used except for backward
+ compatibility.
+
+The new plist is returned. If NIL-MEANS-NOT-PRESENT is given, the
+ return value may not be EQ to the passed-in value, so make sure to
+ `setq' the value back into where it came from.
+*/
+ (plist, nil_means_not_present))
+{
+ Lisp_Object head = plist;
+
+ Fcheck_valid_plist (plist);
+
+ while (!NILP (plist))
+ {
+ Lisp_Object prop = Fcar (plist);
+ Lisp_Object next = Fcdr (plist);
+
+ CHECK_CONS (next); /* just make doubly sure we catch any errors */
+ if (!NILP (nil_means_not_present) && NILP (Fcar (next)))
+ {
+ if (EQ (head, plist))
+ head = Fcdr (next);
+ plist = Fcdr (next);
+ continue;
+ }
+ /* external_remprop returns 1 if it removed any property.
+ We have to loop till it didn't remove anything, in case
+ the property occurs many times. */
+ while (external_remprop (&XCDR (next), prop, 0, ERROR_ME));
+ plist = Fcdr (next);
+ }
+
+ return head;
+}
+
+DEFUN ("lax-plist-get", Flax_plist_get, 2, 3, 0, /*
+Extract a value from a lax property list.
+
+LAX-PLIST is a lax property list, which is a list of the form \(PROP1
+VALUE1 PROP2 VALUE2...), where comparions between properties is done
+using `equal' instead of `eq'. This function returns the value
+corresponding to the given PROP, or DEFAULT if PROP is not one of the
+properties on the list.
+*/
+ (lax_plist, prop, default_))
+{
+ Lisp_Object val = external_plist_get (&lax_plist, prop, 1, ERROR_ME);
+ if (UNBOUNDP (val))
+ return default_;
+ return val;
+}
+
+DEFUN ("lax-plist-put", Flax_plist_put, 3, 3, 0, /*
+Change value in LAX-PLIST of PROP to VAL.
+LAX-PLIST is a lax property list, which is a list of the form \(PROP1
+VALUE1 PROP2 VALUE2...), where comparions between properties is done
+using `equal' instead of `eq'. PROP is usually a symbol and VAL is
+any object. If PROP is already a property on the list, its value is
+set to VAL, otherwise the new PROP VAL pair is added. The new plist
+is returned; use `(setq x (lax-plist-put x prop val))' to be sure to
+use the new value. The LAX-PLIST is modified by side effects.
+*/
+ (lax_plist, prop, val))
+{
+ external_plist_put (&lax_plist, prop, val, 1, ERROR_ME);
+ return lax_plist;
+}
+
+DEFUN ("lax-plist-remprop", Flax_plist_remprop, 2, 2, 0, /*
+Remove from LAX-PLIST the property PROP and its value.
+LAX-PLIST is a lax property list, which is a list of the form \(PROP1
+VALUE1 PROP2 VALUE2...), where comparions between properties is done
+using `equal' instead of `eq'. PROP is usually a symbol. The new
+plist is returned; use `(setq x (lax-plist-remprop x prop val))' to be
+sure to use the new value. The LAX-PLIST is modified by side effects.
+*/
+ (lax_plist, prop))
+{
+ external_remprop (&lax_plist, prop, 1, ERROR_ME);
+ return lax_plist;
+}
+
+DEFUN ("lax-plist-member", Flax_plist_member, 2, 2, 0, /*
+Return t if PROP has a value specified in LAX-PLIST.
+LAX-PLIST is a lax property list, which is a list of the form \(PROP1
+VALUE1 PROP2 VALUE2...), where comparions between properties is done
+using `equal' instead of `eq'.
+*/
+ (lax_plist, prop))
+{
+ return UNBOUNDP (Flax_plist_get (lax_plist, prop, Qunbound)) ? Qnil : Qt;
+}
+
+DEFUN ("canonicalize-lax-plist", Fcanonicalize_lax_plist, 1, 2, 0, /*
+Destructively remove any duplicate entries from a lax plist.
+In such cases, the first entry applies.
+
+If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with
+ a nil value is removed. This feature is a virus that has infected
+ old Lisp implementations, but should not be used except for backward
+ compatibility.
+
+The new plist is returned. If NIL-MEANS-NOT-PRESENT is given, the
+ return value may not be EQ to the passed-in value, so make sure to
+ `setq' the value back into where it came from.
+*/
+ (lax_plist, nil_means_not_present))
+{
+ Lisp_Object head = lax_plist;
+
+ Fcheck_valid_plist (lax_plist);
+
+ while (!NILP (lax_plist))
+ {
+ Lisp_Object prop = Fcar (lax_plist);
+ Lisp_Object next = Fcdr (lax_plist);
+
+ CHECK_CONS (next); /* just make doubly sure we catch any errors */
+ if (!NILP (nil_means_not_present) && NILP (Fcar (next)))
+ {
+ if (EQ (head, lax_plist))
+ head = Fcdr (next);
+ lax_plist = Fcdr (next);
+ continue;
+ }
+ /* external_remprop returns 1 if it removed any property.
+ We have to loop till it didn't remove anything, in case
+ the property occurs many times. */
+ while (external_remprop (&XCDR (next), prop, 1, ERROR_ME));
+ lax_plist = Fcdr (next);
+ }
+
+ return head;
+}
+
+/* In C because the frame props stuff uses it */
+
+DEFUN ("destructive-alist-to-plist", Fdestructive_alist_to_plist, 1, 1, 0, /*
+Convert association list ALIST into the equivalent property-list form.
+The plist is returned. This converts from
+
+\((a . 1) (b . 2) (c . 3))
+
+into
+
+\(a 1 b 2 c 3)
+
+The original alist is destroyed in the process of constructing the plist.
+See also `alist-to-plist'.
+*/
+ (alist))
+{
+ Lisp_Object head = alist;
+ while (!NILP (alist))
+ {
+ /* remember the alist element. */
+ Lisp_Object el = Fcar (alist);
+
+ Fsetcar (alist, Fcar (el));
+ Fsetcar (el, Fcdr (el));
+ Fsetcdr (el, Fcdr (alist));
+ Fsetcdr (alist, el);
+ alist = Fcdr (Fcdr (alist));
+ }
+
+ 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)'.
+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'.
+*/
+ (object, propname, default_))
+{
+ Lisp_Object val;
+
+ /* 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))
+ val = symbol_getprop (object, propname, default_);
+ else if (STRINGP (object))
+ val = string_getprop (XSTRING (object), propname, default_);
+ else if (LRECORDP (object))
+ {
+ CONST struct lrecord_implementation
+ *imp = XRECORD_LHEADER_IMPLEMENTATION (object);
+ if (imp->getprop)
+ {
+ val = (imp->getprop) (object, propname);
+ if (UNBOUNDP (val))
+ val = default_;
+ }
+ else
+ goto noprops;
+ }
+ else
+ {
+ noprops:
+ signal_simple_error ("Object type has no properties", object);
+ }
+
+ return 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.
+
+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))
+{
+ 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))
+ {
+ 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;
+ }
+ else
+ {
+ noprops:
+ 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'.
+*/
+ (object, propname))
+{
+ 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))
+ {
+ 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;
+ }
+ else
+ {
+ noprops:
+ signal_simple_error ("Object type has no removable properties", object);
+ }
+
+ return retval ? 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.)
+*/
+ (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);
+ }
+ else
+ signal_simple_error ("Object type has no properties", object);
+
+ return Qnil;
+}
+
+\f
+int
+internal_equal (Lisp_Object o1, Lisp_Object o2, int depth)
+{
+ if (depth > 200)
+ error ("Stack overflow in equal");
+#ifndef LRECORD_CONS
+ do_cdr:
+#endif
+ QUIT;
+ if (EQ_WITH_EBOLA_NOTICE (o1, o2))
+ return 1;
+ /* Note that (equal 20 20.0) should be nil */
+ else if (XTYPE (o1) != XTYPE (o2))
+ return 0;
+#ifndef LRECORD_CONS
+ else if (CONSP (o1))
+ {
+ if (!internal_equal (XCAR (o1), XCAR (o2), depth + 1))
+ return 0;
+ o1 = XCDR (o1);
+ o2 = XCDR (o2);
+ goto do_cdr;
+ }
+#endif
+#ifndef LRECORD_VECTOR
+ else if (VECTORP (o1))
+ {
+ Lisp_Object *v1 = XVECTOR_DATA (o1);
+ Lisp_Object *v2 = XVECTOR_DATA (o2);
+ int len = XVECTOR_LENGTH (o1);
+ if (len != XVECTOR_LENGTH (o2))
+ return 0;
+ while (len--)
+ if (!internal_equal (*v1++, *v2++, depth + 1))
+ return 0;
+ return 1;
+ }
+#endif
+#ifndef LRECORD_STRING
+ else if (STRINGP (o1))
+ {
+ Bytecount len;
+ return (((len = XSTRING_LENGTH (o1)) == XSTRING_LENGTH (o2)) &&
+ !memcmp (XSTRING_DATA (o1), XSTRING_DATA (o2), len));
+ }
+#endif
+ else if (LRECORDP (o1))
+ {
+ CONST struct lrecord_implementation
+ *imp1 = XRECORD_LHEADER_IMPLEMENTATION (o1),
+ *imp2 = XRECORD_LHEADER_IMPLEMENTATION (o2);
+ if (imp1 != imp2)
+ return 0;
+ else if (imp1->equal == 0)
+ /* EQ-ness of the objects was noticed above */
+ return 0;
+ else
+ return (imp1->equal) (o1, o2, depth);
+ }
+
+ return 0;
+}
+
+/* Note that we may be calling sub-objects that will use
+ internal_equal() (instead of internal_old_equal()). Oh well.
+ We will get an Ebola note if there's any possibility of confusion,
+ but that seems unlikely. */
+
+static int
+internal_old_equal (Lisp_Object o1, Lisp_Object o2, int depth)
+{
+ if (depth > 200)
+ error ("Stack overflow in equal");
+#ifndef LRECORD_CONS
+ do_cdr:
+#endif
+ QUIT;
+ if (HACKEQ_UNSAFE (o1, o2))
+ return 1;
+ /* Note that (equal 20 20.0) should be nil */
+ else if (XTYPE (o1) != XTYPE (o2))
+ return 0;
+#ifndef LRECORD_CONS
+ else if (CONSP (o1))
+ {
+ if (!internal_old_equal (XCAR (o1), XCAR (o2), depth + 1))
+ return 0;
+ o1 = XCDR (o1);
+ o2 = XCDR (o2);
+ goto do_cdr;
+ }
+#endif
+#ifndef LRECORD_VECTOR
+ else if (VECTORP (o1))
+ {
+ int indice;
+ int len = XVECTOR_LENGTH (o1);
+ if (len != XVECTOR_LENGTH (o2))
+ return 0;
+ for (indice = 0; indice < len; indice++)
+ {
+ if (!internal_old_equal (XVECTOR_DATA (o1) [indice],
+ XVECTOR_DATA (o2) [indice],
+ depth + 1))
+ return 0;
+ }
+ return 1;
+ }
+#endif
+#ifndef LRECORD_STRING
+ else if (STRINGP (o1))
+ {
+ Bytecount len = XSTRING_LENGTH (o1);
+ if (len != XSTRING_LENGTH (o2))
+ return 0;
+ if (memcmp (XSTRING_DATA (o1), XSTRING_DATA (o2), len))
+ return 0;
+ return 1;
+ }
+#endif
+ else if (LRECORDP (o1))
+ {
+ CONST struct lrecord_implementation
+ *imp1 = XRECORD_LHEADER_IMPLEMENTATION (o1),
+ *imp2 = XRECORD_LHEADER_IMPLEMENTATION (o2);
+ if (imp1 != imp2)
+ return 0;
+ else if (imp1->equal == 0)
+ /* EQ-ness of the objects was noticed above */
+ return 0;
+ else
+ return (imp1->equal) (o1, o2, depth);
+ }
+
+ return 0;
+}
+
+DEFUN ("equal", Fequal, 2, 2, 0, /*
+Return t if two Lisp objects have similar structure and contents.
+They must have the same data type.
+Conses are compared by comparing the cars and the cdrs.
+Vectors and strings are compared element by element.
+Numbers are compared by value. Symbols must match exactly.
+*/
+ (o1, o2))
+{
+ return internal_equal (o1, o2, 0) ? Qt : Qnil;
+}
+
+DEFUN ("old-equal", Fold_equal, 2, 2, 0, /*
+Return t if two Lisp objects have similar structure and contents.
+They must have the same data type.
+\(Note, however, that an exception is made for characters and integers;
+this is known as the "char-int confoundance disease." See `eq' and
+`old-eq'.)
+This function is provided only for byte-code compatibility with v19.
+Do not use it.
+*/
+ (o1, o2))
+{
+ return internal_old_equal (o1, o2, 0) ? Qt : Qnil;
+}
+
+\f
+DEFUN ("fillarray", Ffillarray, 2, 2, 0, /*
+Store each element of ARRAY with ITEM.
+ARRAY is a vector, bit vector, or string.
+*/
+ (array, item))
+{
+ retry:
+ if (STRINGP (array))
+ {
+ Emchar charval;
+ struct Lisp_String *s = XSTRING (array);
+ Charcount len = string_char_length (s);
+ Charcount i;
+ CHECK_CHAR_COERCE_INT (item);
+ CHECK_IMPURE (array);
+ charval = XCHAR (item);
+ for (i = 0; i < len; i++)
+ set_string_char (s, i, charval);
+ bump_string_modiff (array);
+ }
+ else if (VECTORP (array))
+ {
+ Lisp_Object *p = XVECTOR_DATA (array);
+ int len = XVECTOR_LENGTH (array);
+ CHECK_IMPURE (array);
+ while (len--)
+ *p++ = item;
+ }
+ else if (BIT_VECTORP (array))
+ {
+ struct Lisp_Bit_Vector *v = XBIT_VECTOR (array);
+ int len = bit_vector_length (v);
+ int bit;
+ CHECK_BIT (item);
+ CHECK_IMPURE (array);
+ bit = XINT (item);
+ while (len--)
+ set_bit_vector_bit (v, len, bit);
+ }
+ else
+ {
+ array = wrong_type_argument (Qarrayp, array);
+ goto retry;
+ }
+ return array;
+}
+
+Lisp_Object
+nconc2 (Lisp_Object s1, Lisp_Object s2)
+{
+ Lisp_Object args[2];
+ args[0] = s1;
+ args[1] = s2;
+ return Fnconc (2, args);
+}
+
+DEFUN ("nconc", Fnconc, 0, MANY, 0, /*
+Concatenate any number of lists by altering them.
+Only the last argument is not altered, and need not be a list.
+Also see: `append'.
+If the first argument is nil, there is no way to modify it by side
+effect; therefore, write `(setq foo (nconc foo list))' to be sure of
+changing the value of `foo'.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ int argnum = 0;
+ struct gcpro gcpro1;
+
+ /* The modus operandi in Emacs is "caller gc-protects args".
+ However, nconc (particularly nconc2 ()) is called many times
+ in Emacs on freshly created stuff (e.g. you see the idiom
+ nconc2 (Fcopy_sequence (foo), bar) a lot). So we help those
+ callers out by protecting the args ourselves to save them
+ a lot of temporary-variable grief. */
+
+ GCPRO1 (args[0]);
+ gcpro1.nvars = nargs;
+
+ while (argnum < nargs)
+ {
+ Lisp_Object val = args[argnum];
+ if (CONSP (val))
+ {
+ /* Found the first cons, which will be our return value. */
+ Lisp_Object last = val;
+
+ for (argnum++; argnum < nargs; argnum++)
+ {
+ Lisp_Object next = args[argnum];
+ redo:
+ if (CONSP (next) || argnum == nargs -1)
+ {
+ /* (setcdr (last val) next) */
+ while (CONSP (XCDR (last)))
+ {
+ last = XCDR (last);
+ QUIT;
+ }
+ XCDR (last) = next;
+ }
+ else if (NILP (next))
+ {
+ continue;
+ }
+ else
+ {
+ next = wrong_type_argument (next, Qlistp);
+ goto redo;
+ }
+ }
+ RETURN_UNGCPRO (val);
+ }
+ else if (NILP (val))
+ argnum++;
+ else if (argnum == nargs - 1) /* last arg? */
+ RETURN_UNGCPRO (val);
+ else
+ args[argnum] = wrong_type_argument (val, Qlistp);
+ }
+ RETURN_UNGCPRO (Qnil); /* No non-nil args provided. */
+}
+
+\f
+/* 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.
+
+ If VALS is a null pointer, do not accumulate the results. */
+
+static void
+mapcar1 (int leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
+{
+ Lisp_Object tail;
+ Lisp_Object dummy = Qnil;
+ int i;
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ Lisp_Object result;
+
+ GCPRO3 (dummy, fn, seq);
+
+ if (vals)
+ {
+ /* Don't let vals contain any garbage when GC happens. */
+ for (i = 0; i < leni; i++)
+ vals[i] = Qnil;
+ gcpro1.var = vals;
+ gcpro1.nvars = leni;
+ }
+
+ /* We need not explicitly protect `tail' because it is used only on
+ lists, and 1) lists are not relocated and 2) the list is marked
+ via `seq' so will not be freed */
+
+ if (VECTORP (seq))
+ {
+ for (i = 0; i < leni; i++)
+ {
+ dummy = XVECTOR_DATA (seq)[i];
+ result = call1 (fn, dummy);
+ if (vals)
+ vals[i] = result;
+ }
+ }
+ else if (BIT_VECTORP (seq))
+ {
+ struct Lisp_Bit_Vector *v = XBIT_VECTOR (seq);
+ for (i = 0; i < leni; i++)
+ {
+ XSETINT (dummy, bit_vector_bit (v, i));
+ result = call1 (fn, dummy);
+ if (vals)
+ vals[i] = result;
+ }
+ }
+ else if (STRINGP (seq))
+ {
+ for (i = 0; i < leni; i++)
+ {
+ result = call1 (fn, make_char (string_char (XSTRING (seq), i)));
+ if (vals)
+ vals[i] = result;
+ }
+ }
+ else /* Must be a list, since Flength did not get an error */
+ {
+ tail = seq;
+ for (i = 0; i < leni; i++)
+ {
+ result = call1 (fn, Fcar (tail));
+ if (vals)
+ vals[i] = result;
+ tail = Fcdr (tail);
+ }
+ }
+
+ 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.
+*/
+ (fn, seq, sep))
+{
+ int len = XINT (Flength (seq));
+ Lisp_Object *args;
+ int i;
+ struct gcpro gcpro1;
+ int nargs = len + len - 1;
+
+ if (nargs < 0) return build_string ("");
+
+ args = alloca_array (Lisp_Object, nargs);
+
+ GCPRO1 (sep);
+ mapcar1 (len, args, fn, seq);
+ UNGCPRO;
+
+ for (i = len - 1; i >= 0; i--)
+ args[i + i] = args[i];
+
+ for (i = 1; i < nargs; i += 2)
+ args[i] = sep;
+
+ 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.
+SEQUENCE may be a list, a vector, a bit vector, or a string.
+*/
+ (fn, seq))
+{
+ int len = XINT (Flength (seq));
+ Lisp_Object *args = alloca_array (Lisp_Object, len);
+
+ mapcar1 (len, args, fn, seq);
+
+ return Flist (len, args);
+}
+
+DEFUN ("mapvector", Fmapvector, 2, 2, 0, /*
+Apply FUNCTION to each element of SEQUENCE, making 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.
+*/
+ (fn, seq))
+{
+ int len = XINT (Flength (seq));
+ /* Ideally, this should call make_vector_internal, because we don't
+ need initialization. */
+ Lisp_Object result = make_vector (len, Qnil);
+ struct gcpro gcpro1;
+
+ GCPRO1 (result);
+ mapcar1 (len, XVECTOR_DATA (result), fn, seq);
+ UNGCPRO;
+
+ return result;
+}
+
+DEFUN ("mapc", Fmapc, 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.
+*/
+ (fn, seq))
+{
+ mapcar1 (XINT (Flength (seq)), 0, fn, seq);
+
+ return seq;
+}
+
+\f
+/* #### this function doesn't belong in this file! */
+
+DEFUN ("load-average", Fload_average, 0, 1, 0, /*
+Return list of 1 minute, 5 minute and 15 minute load averages.
+Each of the three load averages is multiplied by 100,
+then converted to integer.
+
+When USE-FLOATS is non-nil, floats will be used instead of integers.
+These floats are not multiplied by 100.
+
+If the 5-minute or 15-minute load averages are not available, return a
+shortened list, containing only those averages which are available.
+
+On some systems, this won't work due to permissions on /dev/kmem,
+in which case you can't use this.
+*/
+ (use_floats))
+{
+ double load_ave[3];
+ int loads = getloadavg (load_ave, countof (load_ave));
+ Lisp_Object ret = Qnil;
+
+ if (loads == -2)
+ error ("load-average not implemented for this operating system");
+ else if (loads < 0)
+ signal_simple_error ("Could not get load-average",
+ lisp_strerror (errno));
+
+ while (loads-- > 0)
+ {
+ Lisp_Object load = (NILP (use_floats) ?
+ make_int ((int) (100.0 * load_ave[loads]))
+ : make_float (load_ave[loads]));
+ ret = Fcons (load, ret);
+ }
+ return ret;
+}
+
+\f
+Lisp_Object Vfeatures;
+
+DEFUN ("featurep", Ffeaturep, 1, 1, 0, /*
+Return non-nil if feature FEXP is present in this Emacs.
+Use this to conditionalize execution of lisp code based on the
+ presence or absence of emacs or environment extensions.
+FEXP can be a symbol, a number, or a list.
+If it is a symbol, that symbol is looked up in the `features' variable,
+ and non-nil will be returned if found.
+If it is a number, the function will return non-nil if this Emacs
+ has an equal or greater version number than FEXP.
+If it is a list whose car is the symbol `and', it will return
+ non-nil if all the features in its cdr are non-nil.
+If it is a list whose car is the symbol `or', it will return non-nil
+ if any of the features in its cdr are non-nil.
+If it is a list whose car is the symbol `not', it will return
+ non-nil if the feature is not present.
+
+Examples:
+
+ (featurep 'xemacs)
+ => ; Non-nil on XEmacs.
+
+ (featurep '(and xemacs gnus))
+ => ; Non-nil on XEmacs with Gnus loaded.
+
+ (featurep '(or tty-frames (and emacs 19.30)))
+ => ; Non-nil if this Emacs supports TTY frames.
+
+ (featurep '(or (and xemacs 19.15) (and emacs 19.34)))
+ => ; Non-nil on XEmacs 19.15 and later, or FSF Emacs 19.34 and later.
+
+NOTE: The advanced arguments of this function (anything other than a
+symbol) are not yet supported by FSF Emacs. If you feel they are useful
+for supporting multiple Emacs variants, lobby Richard Stallman at
+<bug-gnu-emacs@prep.ai.mit.edu>.
+*/
+ (fexp))
+{
+#ifndef FEATUREP_SYNTAX
+ CHECK_SYMBOL (fexp);
+ return NILP (Fmemq (fexp, Vfeatures)) ? Qnil : Qt;
+#else /* FEATUREP_SYNTAX */
+ static double featurep_emacs_version;
+
+ /* Brute force translation from Erik Naggum's lisp function. */
+ if (SYMBOLP (fexp))
+ {
+ /* Original definition */
+ return NILP (Fmemq (fexp, Vfeatures)) ? Qnil : Qt;
+ }
+ else if (INTP (fexp) || FLOATP (fexp))
+ {
+ double d = extract_float (fexp);
+
+ if (featurep_emacs_version == 0.0)
+ {
+ featurep_emacs_version = XINT (Vemacs_major_version) +
+ (XINT (Vemacs_minor_version) / 100.0);
+ }
+ return featurep_emacs_version >= d ? Qt : Qnil;
+ }
+ else if (CONSP (fexp))
+ {
+ Lisp_Object tem = XCAR (fexp);
+ if (EQ (tem, Qnot))
+ {
+ Lisp_Object negate;
+
+ tem = XCDR (fexp);
+ negate = Fcar (tem);
+ if (!NILP (tem))
+ return NILP (call1 (Qfeaturep, negate)) ? Qt : Qnil;
+ else
+ return Fsignal (Qinvalid_read_syntax, list1 (tem));
+ }
+ else if (EQ (tem, Qand))
+ {
+ tem = XCDR (fexp);
+ /* Use Fcar/Fcdr for error-checking. */
+ while (!NILP (tem) && !NILP (call1 (Qfeaturep, Fcar (tem))))
+ {
+ tem = Fcdr (tem);
+ }
+ return NILP (tem) ? Qt : Qnil;
+ }
+ else if (EQ (tem, Qor))
+ {
+ tem = XCDR (fexp);
+ /* Use Fcar/Fcdr for error-checking. */
+ while (!NILP (tem) && NILP (call1 (Qfeaturep, Fcar (tem))))
+ {
+ tem = Fcdr (tem);
+ }
+ return NILP (tem) ? Qnil : Qt;
+ }
+ else
+ {
+ return Fsignal (Qinvalid_read_syntax, list1 (XCDR (fexp)));
+ }
+ }
+ else
+ {
+ return Fsignal (Qinvalid_read_syntax, list1 (fexp));
+ }
+}
+#endif /* FEATUREP_SYNTAX */
+
+DEFUN ("provide", Fprovide, 1, 1, 0, /*
+Announce that FEATURE is a feature of the current Emacs.
+This function updates the value of the variable `features'.
+*/
+ (feature))
+{
+ Lisp_Object tem;
+ CHECK_SYMBOL (feature);
+ if (!NILP (Vautoload_queue))
+ Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue);
+ tem = Fmemq (feature, Vfeatures);
+ if (NILP (tem))
+ Vfeatures = Fcons (feature, Vfeatures);
+ LOADHIST_ATTACH (Fcons (Qprovide, feature));
+ return feature;
+}
+
+DEFUN ("require", Frequire, 1, 2, 0, /*
+If feature FEATURE is not loaded, load it from FILENAME.
+If FEATURE is not a member of the list `features', then the feature
+is not loaded; so load the file FILENAME.
+If FILENAME is omitted, the printname of FEATURE is used as the file name.
+*/
+ (feature, file_name))
+{
+ Lisp_Object tem;
+ CHECK_SYMBOL (feature);
+ tem = Fmemq (feature, Vfeatures);
+ LOADHIST_ATTACH (Fcons (Qrequire, feature));
+ if (!NILP (tem))
+ return feature;
+ else
+ {
+ int speccount = specpdl_depth ();
+
+ /* Value saved here is to be restored into Vautoload_queue */
+ record_unwind_protect (un_autoload, Vautoload_queue);
+ Vautoload_queue = Qt;
+
+ call4 (Qload, NILP (file_name) ? Fsymbol_name (feature) : file_name,
+ Qnil, Qt, Qnil);
+
+ tem = Fmemq (feature, Vfeatures);
+ if (NILP (tem))
+ error ("Required feature %s was not provided",
+ string_data (XSYMBOL (feature)->name));
+
+ /* Once loading finishes, don't undo it. */
+ Vautoload_queue = Qt;
+ return unbind_to (speccount, feature);
+ }
+}
+
+\f
+Lisp_Object Qyes_or_no_p;
+
+void
+syms_of_fns (void)
+{
+ defsymbol (&Qstring_lessp, "string-lessp");
+ defsymbol (&Qidentity, "identity");
+ defsymbol (&Qyes_or_no_p, "yes-or-no-p");
+
+ DEFSUBR (Fidentity);
+ DEFSUBR (Frandom);
+ DEFSUBR (Flength);
+ DEFSUBR (Fsafe_length);
+ DEFSUBR (Fstring_equal);
+ DEFSUBR (Fstring_lessp);
+ DEFSUBR (Fstring_modified_tick);
+ DEFSUBR (Fappend);
+ DEFSUBR (Fconcat);
+ DEFSUBR (Fvconcat);
+ DEFSUBR (Fbvconcat);
+ DEFSUBR (Fcopy_sequence);
+ DEFSUBR (Fcopy_alist);
+ DEFSUBR (Fcopy_tree);
+ DEFSUBR (Fsubstring);
+ DEFSUBR (Fsubseq);
+ DEFSUBR (Fnthcdr);
+ DEFSUBR (Fnth);
+ DEFSUBR (Felt);
+ DEFSUBR (Fmember);
+ DEFSUBR (Fold_member);
+ DEFSUBR (Fmemq);
+ DEFSUBR (Fold_memq);
+ DEFSUBR (Fassoc);
+ DEFSUBR (Fold_assoc);
+ DEFSUBR (Fassq);
+ DEFSUBR (Fold_assq);
+ DEFSUBR (Frassoc);
+ DEFSUBR (Fold_rassoc);
+ DEFSUBR (Frassq);
+ DEFSUBR (Fold_rassq);
+ DEFSUBR (Fdelete);
+ DEFSUBR (Fold_delete);
+ DEFSUBR (Fdelq);
+ DEFSUBR (Fold_delq);
+ DEFSUBR (Fremassoc);
+ DEFSUBR (Fremassq);
+ DEFSUBR (Fremrassoc);
+ DEFSUBR (Fremrassq);
+ DEFSUBR (Fnreverse);
+ DEFSUBR (Freverse);
+ DEFSUBR (Fsort);
+ DEFSUBR (Fplists_eq);
+ DEFSUBR (Fplists_equal);
+ DEFSUBR (Flax_plists_eq);
+ DEFSUBR (Flax_plists_equal);
+ DEFSUBR (Fplist_get);
+ DEFSUBR (Fplist_put);
+ DEFSUBR (Fplist_remprop);
+ DEFSUBR (Fplist_member);
+ DEFSUBR (Fcheck_valid_plist);
+ DEFSUBR (Fvalid_plist_p);
+ DEFSUBR (Fcanonicalize_plist);
+ DEFSUBR (Flax_plist_get);
+ DEFSUBR (Flax_plist_put);
+ DEFSUBR (Flax_plist_remprop);
+ DEFSUBR (Flax_plist_member);
+ DEFSUBR (Fcanonicalize_lax_plist);
+ DEFSUBR (Fdestructive_alist_to_plist);
+ DEFSUBR (Fget);
+ DEFSUBR (Fput);
+ DEFSUBR (Fremprop);
+ DEFSUBR (Fobject_plist);
+ DEFSUBR (Fequal);
+ DEFSUBR (Fold_equal);
+ DEFSUBR (Ffillarray);
+ DEFSUBR (Fnconc);
+ DEFSUBR (Fmapcar);
+ DEFSUBR (Fmapvector);
+ DEFSUBR (Fmapc);
+ DEFSUBR (Fmapconcat);
+ DEFSUBR (Fload_average);
+ DEFSUBR (Ffeaturep);
+ DEFSUBR (Frequire);
+ DEFSUBR (Fprovide);
+}
+
+void
+init_provide_once (void)
+{
+ DEFVAR_LISP ("features", &Vfeatures /*
+A list of symbols which are the features of the executing emacs.
+Used by `featurep' and `require', and altered by `provide'.
+*/ );
+ Vfeatures = Qnil;
+}
--- /dev/null
+/* Routines to compute the current syntactic context, for font-lock mode.
+ Copyright (C) 1992, 1993, 1994 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: Not in FSF. */
+
+/* This code computes the syntactic context of the current point, that is,
+ whether point is within a comment, a string, what have you. It does
+ this by picking a point "known" to be outside of any syntactic constructs
+ and moving forward, examining the syntax of each character.
+
+ Two caches are used: one caches the last point computed, and the other
+ caches the last point at the beginning of a line. This makes there
+ be little penalty for moving left-to-right on a line a character at a
+ time; makes starting over on a line be cheap; and makes random-accessing
+ within a line relatively cheap.
+
+ When we move to a different line farther down in the file (but within the
+ current top-level form) we simply continue computing forward. If we move
+ backward more than a line, or move beyond the end of the current tlf, or
+ switch buffers, then we call `beginning-of-defun' and start over from
+ there.
+
+ #### We should really rewrite this to keep extents over the buffer
+ that hold the current syntactic information. This would be a big win.
+ This way there would be no guessing or incorrect results.
+ */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "insdel.h"
+#include "syntax.h"
+
+Lisp_Object Qcomment;
+Lisp_Object Qblock_comment;
+Lisp_Object Qbeginning_of_defun;
+
+enum syntactic_context
+{
+ context_none,
+ context_string,
+ context_comment,
+ context_block_comment
+};
+
+enum block_comment_context
+{
+ ccontext_none,
+ ccontext_start1,
+ ccontext_start2,
+ ccontext_end1
+};
+
+enum comment_style
+{
+ comment_style_none,
+ comment_style_a,
+ comment_style_b
+};
+
+struct context_cache
+{
+ Bufpos start_point; /* beginning of defun */
+ Bufpos cur_point; /* cache location */
+ Bufpos end_point; /* end of defun */
+ struct buffer *buffer; /* does this need to be staticpro'd? */
+ enum syntactic_context context; /* single-char-syntax state */
+ enum block_comment_context ccontext; /* block-comment state */
+ enum comment_style style; /* which comment group */
+ Emchar scontext; /* active string delimiter */
+ int depth; /* depth in parens */
+ int backslash_p; /* just read a backslash */
+ int needs_its_head_reexamined; /* we're apparently outside of
+ a top level form, and far away
+ from it. This is a bad situation
+ because it will lead to constant
+ slowness as we keep going way
+ back to that form and moving
+ forward again. In this case,
+ we try to compute a "pseudo-
+ top-level-form" where the
+ depth is 0 and the context
+ is none at both ends. */
+};
+
+/* We have two caches; one for the current point and one for
+ the beginning of line. We used to rely on the caller to
+ tell us when to invalidate them, but now we do it ourselves;
+ it lets us be smarter. */
+
+static struct context_cache context_cache;
+
+static struct context_cache bol_context_cache;
+
+int font_lock_debug;
+
+#define reset_context_cache(cc) memset (cc, 0, sizeof (struct context_cache))
+
+/* This function is called from signal_after_change() to tell us when
+ textual changes are made so we can flush our caches when necessary.
+
+ We make the following somewhat heuristic assumptions:
+
+ (remember that current_point is always >= start_point, but may be
+ less than or greater than end_point (we might not be inside any
+ top-level form)).
+
+ 1) Textual changes before the beginning of the current top-level form
+ don't affect anything; all we need to do is offset the caches
+ appropriately.
+ 2) Textual changes right at the beginning of the current
+ top-level form messes things up and requires that we flush
+ the caches.
+ 3) Textual changes after the beginning of the current top-level form
+ and before one or both or the caches invalidates the corresponding
+ cache(s).
+ 4) Textual changes after the caches and before the end of the
+ current top-level form don't affect anything; all we need to do is
+ offset the caches appropriately.
+ 5) Textual changes right at the end of the current top-level form
+ necessitate recomputing that end value.
+ 6) Textual changes after the end of the current top-level form
+ are ignored. */
+
+
+void
+font_lock_maybe_update_syntactic_caches (struct buffer *buf, Bufpos start,
+ Bufpos orig_end, Bufpos new_end)
+{
+ /* Note: either both context_cache and bol_context_cache are valid and
+ point to the same buffer, or both are invalid. If we have to
+ invalidate just context_cache, we recopy it from bol_context_cache.
+ */
+ if (context_cache.buffer != buf)
+ /* caches don't apply */
+ return;
+ /* NOTE: The order of the if statements below is important. If you
+ change them around unthinkingly, you will probably break something. */
+ if (orig_end <= context_cache.start_point - 1)
+ {
+ /* case 1: before the beginning of the current top-level form */
+ Charcount diff = new_end - orig_end;
+ if (font_lock_debug)
+ stderr_out ("font-lock; Case 1\n");
+ context_cache.start_point += diff;
+ context_cache.cur_point += diff;
+ context_cache.end_point += diff;
+ bol_context_cache.start_point += diff;
+ bol_context_cache.cur_point += diff;
+ bol_context_cache.end_point += diff;
+ }
+ else if (start <= context_cache.start_point)
+ {
+ if (font_lock_debug)
+ stderr_out ("font-lock; Case 2\n");
+ /* case 2: right at the current top-level form (paren that starts
+ top level form got deleted or moved away from the newline it
+ was touching) */
+ reset_context_cache (&context_cache);
+ reset_context_cache (&bol_context_cache);
+ }
+ /* OK, now we know that the start is after the beginning of the
+ current top-level form. */
+ else if (start < bol_context_cache.cur_point)
+ {
+ if (font_lock_debug)
+ stderr_out ("font-lock; Case 3 (1)\n");
+ /* case 3: after the beginning of the current top-level form
+ and before both of the caches */
+ reset_context_cache (&context_cache);
+ reset_context_cache (&bol_context_cache);
+ }
+ else if (start < context_cache.cur_point)
+ {
+ if (font_lock_debug)
+ stderr_out ("font-lock; Case 3 (2)\n");
+ /* case 3: but only need to invalidate one cache */
+ context_cache = bol_context_cache;
+ }
+ /* OK, now we know that the start is after the caches. */
+ else if (start >= context_cache.end_point)
+ {
+ if (font_lock_debug)
+ stderr_out ("font-lock; Case 6\n");
+ /* case 6: after the end of the current top-level form
+ and after the caches. */
+ }
+ else if (orig_end <= context_cache.end_point - 2)
+ {
+ /* case 4: after the caches and before the end of the
+ current top-level form */
+ Charcount diff = new_end - orig_end;
+ if (font_lock_debug)
+ stderr_out ("font-lock; Case 4\n");
+ context_cache.end_point += diff;
+ bol_context_cache.end_point += diff;
+ }
+ else
+ {
+ if (font_lock_debug)
+ stderr_out ("font-lock; Case 5\n");
+ /* case 5: right at the end of the current top-level form */
+ context_cache.end_point = context_cache.start_point - 1;
+ bol_context_cache.end_point = context_cache.start_point - 1;
+ }
+}
+
+/* This function is called from Fkill_buffer(). */
+
+void
+font_lock_buffer_was_killed (struct buffer *buf)
+{
+ if (context_cache.buffer == buf)
+ {
+ reset_context_cache (&context_cache);
+ reset_context_cache (&bol_context_cache);
+ }
+}
+
+static Bufpos
+beginning_of_defun (struct buffer *buf, Bufpos pt)
+{
+ /* This function can GC */
+ Bufpos opt = BUF_PT (buf);
+ if (pt == BUF_BEGV (buf))
+ return pt;
+ BUF_SET_PT (buf, pt);
+ /* There used to be some kludginess to call c++-beginning-of-defun
+ if we're in C++ mode. There's no point in this any more;
+ we're using cc-mode. If you really want to get the old c++
+ mode working, fix it rather than the C code. */
+ call0_in_buffer (buf, Qbeginning_of_defun);
+ pt = BUF_PT (buf);
+ BUF_SET_PT (buf, opt);
+ return pt;
+}
+
+static Bufpos
+end_of_defun (struct buffer *buf, Bufpos pt)
+{
+ Lisp_Object retval = scan_lists (buf, pt, 1, 0, 0, 1);
+ if (NILP (retval))
+ return BUF_ZV (buf);
+ else
+ return XINT (retval);
+}
+
+/* Set up context_cache for attempting to determine the syntactic context
+ in buffer BUF at point PT. */
+
+static void
+setup_context_cache (struct buffer *buf, Bufpos pt)
+{
+ int recomputed_start_point = 0;
+ /* This function can GC */
+ if (context_cache.buffer != buf || pt < context_cache.start_point)
+ {
+ start_over:
+ if (font_lock_debug)
+ stderr_out ("reset context cache\n");
+ /* OK, completely invalid. */
+ reset_context_cache (&context_cache);
+ reset_context_cache (&bol_context_cache);
+ }
+ if (!context_cache.buffer)
+ {
+ /* Need to recompute the start point. */
+ if (font_lock_debug)
+ stderr_out ("recompute start\n");
+ context_cache.start_point = beginning_of_defun (buf, pt);
+ recomputed_start_point = 1;
+ bol_context_cache.start_point = context_cache.start_point;
+ bol_context_cache.buffer = context_cache.buffer = buf;
+ }
+ if (context_cache.end_point < context_cache.start_point)
+ {
+ /* Need to recompute the end point. */
+ if (font_lock_debug)
+ stderr_out ("recompute end\n");
+ context_cache.end_point = end_of_defun (buf, context_cache.start_point);
+ bol_context_cache.end_point = context_cache.end_point;
+ }
+ if (bol_context_cache.cur_point == 0 ||
+ pt < bol_context_cache.cur_point)
+ {
+ if (font_lock_debug)
+ stderr_out ("reset to start\n");
+ if (pt > context_cache.end_point
+ /* 3000 is some arbitrary delta but seems reasonable;
+ about the size of a reasonable function */
+ && pt - context_cache.end_point > 3000)
+ /* If we're far past the end of the top level form,
+ don't trust it; recompute it. */
+ {
+ /* But don't get in an infinite loop doing this.
+ If we're really far past the end of the top level
+ form, try to compute a pseudo-top-level form. */
+ if (recomputed_start_point)
+ context_cache.needs_its_head_reexamined = 1;
+ else
+ /* force recomputation */
+ goto start_over;
+ }
+ /* Go to the nearest end of the top-level form that's before
+ us. */
+ if (pt > context_cache.end_point)
+ pt = context_cache.end_point;
+ else
+ pt = context_cache.start_point;
+ /* Reset current point to start of buffer. */
+ context_cache.cur_point = pt;
+ context_cache.context = context_none;
+ context_cache.ccontext = ccontext_none;
+ context_cache.style = comment_style_none;
+ context_cache.scontext = '\000';
+ context_cache.depth = 0;
+ context_cache.backslash_p = ((pt > 1) &&
+ (BUF_FETCH_CHAR (buf, pt - 1) == '\\'));
+ /* Note that the BOL context cache may not be at the beginning
+ of the line, but that should be OK, nobody's checking. */
+ bol_context_cache = context_cache;
+ return;
+ }
+ else if (pt < context_cache.cur_point)
+ {
+ if (font_lock_debug)
+ stderr_out ("reset to bol\n");
+ /* bol cache is OK but current_cache is not. */
+ context_cache = bol_context_cache;
+ return;
+ }
+ else if (pt <= context_cache.end_point)
+ {
+ if (font_lock_debug)
+ stderr_out ("everything is OK\n");
+ /* in same top-level form. */
+ return;
+ }
+ {
+ /* OK, we're past the end of the top-level form. */
+ Bufpos maxpt = max (context_cache.end_point, context_cache.cur_point);
+#if 0
+ int shortage;
+#endif
+
+ if (font_lock_debug)
+ stderr_out ("past end\n");
+ if (pt <= maxpt)
+ /* OK, fine. */
+ return;
+#if 0
+ /* This appears to cause huge slowdowns in files like
+ emacsfns.h, which have no top-level forms.
+
+ In any case, it's not really necessary that we know for
+ sure the top-level form we're in; if we're in a form
+ but the form we have recorded is the previous one,
+ it will be OK. */
+
+ scan_buffer (buf, '\n', maxpt, pt, 1, &shortage, 1);
+ if (!shortage)
+ /* If there was a newline in the region past the known universe,
+ we might be inside another top-level form, so start over.
+ Otherwise, we're outside of any top-level forms and we know
+ the one directly before us, so it's OK. */
+ goto start_over;
+#endif
+ }
+}
+
+#define SYNTAX_START_STYLE(table, c1, c2) \
+ (SYNTAX_STYLES_MATCH_START_P (table, c1, c2, SYNTAX_COMMENT_STYLE_A) ? \
+ comment_style_a : \
+ SYNTAX_STYLES_MATCH_START_P (table, c1, c2, SYNTAX_COMMENT_STYLE_B) ? \
+ comment_style_b : \
+ comment_style_none)
+
+#define SYNTAX_END_STYLE(table, c1, c2) \
+ (SYNTAX_STYLES_MATCH_END_P (table, c1, c2, SYNTAX_COMMENT_STYLE_A) ? \
+ comment_style_a : \
+ SYNTAX_STYLES_MATCH_END_P (table, c1, c2, SYNTAX_COMMENT_STYLE_B) ? \
+ comment_style_b : \
+ comment_style_none)
+
+#define SINGLE_SYNTAX_STYLE(table, c) \
+ (SYNTAX_STYLES_MATCH_1CHAR_P (table, c, SYNTAX_COMMENT_STYLE_A) ? \
+ comment_style_a : \
+ SYNTAX_STYLES_MATCH_1CHAR_P (table, c, SYNTAX_COMMENT_STYLE_B) ? \
+ comment_style_b : \
+ comment_style_none)
+
+/* Set up context_cache for position PT in BUF. */
+
+static void
+find_context (struct buffer *buf, Bufpos pt)
+{
+ /* This function can GC */
+ struct Lisp_Char_Table *mirrortab =
+ XCHAR_TABLE (buf->mirror_syntax_table);
+ Lisp_Object syntaxtab = buf->syntax_table;
+ Emchar prev_c, c;
+ Bufpos target = pt;
+ setup_context_cache (buf, pt);
+ pt = context_cache.cur_point;
+
+ if (pt > BUF_BEGV (buf))
+ c = BUF_FETCH_CHAR (buf, pt - 1);
+ else
+ c = '\n'; /* to get bol_context_cache at point-min */
+
+ for (; pt < target; pt++, context_cache.cur_point = pt)
+ {
+ if (context_cache.needs_its_head_reexamined)
+ {
+ if (context_cache.depth == 0
+ && context_cache.context == context_none)
+ {
+ /* We've found an anchor spot.
+ Try to put the start of defun within 6000 chars of
+ the target, and the end of defun as close as possible.
+ 6000 is also arbitrary but tries to strike a balance
+ between two conflicting pulls when dealing with a
+ file that has lots of stuff sitting outside of a top-
+ level form:
+
+ a) If you move past the start of defun, you will
+ have to recompute defun, which in this case
+ means that start of defun goes all the way back
+ to the beginning of the file; so you want
+ to set start of defun a ways back from the
+ current point.
+ b) If you move a line backwards but within start of
+ defun, you have to move back to start of defun;
+ so you don't want start of defun too far from
+ the current point.
+ */
+ if (target - context_cache.start_point > 6000)
+ context_cache.start_point = pt;
+ context_cache.end_point = pt;
+ bol_context_cache = context_cache;
+ }
+ }
+
+ prev_c = c;
+ c = BUF_FETCH_CHAR (buf, pt);
+
+ if (prev_c == '\n')
+ bol_context_cache = context_cache;
+
+ if (context_cache.backslash_p)
+ {
+ context_cache.backslash_p = 0;
+ continue;
+ }
+
+ switch (SYNTAX (mirrortab, c))
+ {
+ case Sescape:
+ context_cache.backslash_p = 1;
+ break;
+
+ case Sopen:
+ if (context_cache.context == context_none)
+ context_cache.depth++;
+ break;
+
+ case Sclose:
+ if (context_cache.context == context_none)
+ context_cache.depth--;
+ break;
+
+ case Scomment:
+ if (context_cache.context == context_none)
+ {
+ context_cache.context = context_comment;
+ context_cache.ccontext = ccontext_none;
+ context_cache.style = SINGLE_SYNTAX_STYLE (mirrortab, c);
+ if (context_cache.style == comment_style_none) abort ();
+ }
+ break;
+
+ case Sendcomment:
+ if (context_cache.style != SINGLE_SYNTAX_STYLE (mirrortab, c))
+ ;
+ else if (context_cache.context == context_comment)
+ {
+ context_cache.context = context_none;
+ context_cache.style = comment_style_none;
+ }
+ else if (context_cache.context == context_block_comment &&
+ (context_cache.ccontext == ccontext_start2 ||
+ context_cache.ccontext == ccontext_end1))
+ {
+ context_cache.context = context_none;
+ context_cache.ccontext = ccontext_none;
+ context_cache.style = comment_style_none;
+ }
+ break;
+
+ case Sstring:
+ {
+ if (context_cache.context == context_string &&
+ context_cache.scontext == c)
+ {
+ context_cache.context = context_none;
+ context_cache.scontext = '\000';
+ }
+ else if (context_cache.context == context_none)
+ {
+ Lisp_Object stringtermobj = syntax_match (syntaxtab, c);
+ Emchar stringterm;
+
+ if (CHARP (stringtermobj))
+ stringterm = XCHAR (stringtermobj);
+ else
+ stringterm = c;
+ context_cache.context = context_string;
+ context_cache.scontext = stringterm;
+ context_cache.ccontext = ccontext_none;
+ }
+ break;
+ }
+ default:
+ ;
+ }
+
+ /* That takes care of the characters with manifest syntax.
+ Now we've got to hack multi-char sequences that start
+ and end block comments.
+ */
+ if ((SYNTAX_COMMENT_BITS (mirrortab, c) &
+ SYNTAX_SECOND_CHAR_START) &&
+ context_cache.context == context_none &&
+ context_cache.ccontext == ccontext_start1 &&
+ SYNTAX_START_P (mirrortab, prev_c, c) /* the two chars match */
+ )
+ {
+ context_cache.ccontext = ccontext_start2;
+ context_cache.style = SYNTAX_START_STYLE (mirrortab, prev_c, c);
+ if (context_cache.style == comment_style_none) abort ();
+ }
+ else if ((SYNTAX_COMMENT_BITS (mirrortab, c) &
+ SYNTAX_FIRST_CHAR_START) &&
+ context_cache.context == context_none &&
+ (context_cache.ccontext == ccontext_none ||
+ context_cache.ccontext == ccontext_start1))
+ {
+ context_cache.ccontext = ccontext_start1;
+ context_cache.style = comment_style_none; /* should be this already*/
+ }
+ else if ((SYNTAX_COMMENT_BITS (mirrortab, c) &
+ SYNTAX_SECOND_CHAR_END) &&
+ context_cache.context == context_block_comment &&
+ context_cache.ccontext == ccontext_end1 &&
+ SYNTAX_END_P (mirrortab, prev_c, c) &&
+ /* the two chars match */
+ context_cache.style ==
+ SYNTAX_END_STYLE (mirrortab, prev_c, c)
+ )
+ {
+ context_cache.context = context_none;
+ context_cache.ccontext = ccontext_none;
+ context_cache.style = comment_style_none;
+ }
+ else if ((SYNTAX_COMMENT_BITS (mirrortab, c) &
+ SYNTAX_FIRST_CHAR_END) &&
+ context_cache.context == context_block_comment &&
+ (context_cache.style ==
+ SYNTAX_END_STYLE (mirrortab, c,
+ BUF_FETCH_CHAR (buf, pt+1))) &&
+ (context_cache.ccontext == ccontext_start2 ||
+ context_cache.ccontext == ccontext_end1))
+ /* #### is it right to check for end1 here?? */
+ {
+ if (context_cache.style == comment_style_none) abort ();
+ context_cache.ccontext = ccontext_end1;
+ }
+
+ else if (context_cache.ccontext == ccontext_start1)
+ {
+ if (context_cache.context != context_none) abort ();
+ context_cache.ccontext = ccontext_none;
+ }
+ else if (context_cache.ccontext == ccontext_end1)
+ {
+ if (context_cache.context != context_block_comment) abort ();
+ context_cache.context = context_none;
+ context_cache.ccontext = ccontext_start2;
+ }
+
+ if (context_cache.ccontext == ccontext_start2 &&
+ context_cache.context == context_none)
+ {
+ context_cache.context = context_block_comment;
+ if (context_cache.style == comment_style_none) abort ();
+ }
+ else if (context_cache.ccontext == ccontext_none &&
+ context_cache.context == context_block_comment)
+ {
+ context_cache.context = context_none;
+ }
+ }
+
+ context_cache.needs_its_head_reexamined = 0;
+}
+
+static Lisp_Object
+context_to_symbol (enum syntactic_context context)
+{
+ switch (context)
+ {
+ case context_none: return Qnil;
+ case context_string: return Qstring;
+ case context_comment: return Qcomment;
+ case context_block_comment: return Qblock_comment;
+ default: abort (); return Qnil; /* suppress compiler warning */
+ }
+}
+
+DEFUN ("buffer-syntactic-context", Fbuffer_syntactic_context, 0, 1, 0, /*
+Return the syntactic context of BUFFER at point.
+If BUFFER is nil or omitted, the current buffer is assumed.
+The returned value is one of the following symbols:
+
+ nil ; meaning no special interpretation
+ string ; meaning point is within a string
+ comment ; meaning point is within a line comment
+ block-comment ; meaning point is within a block comment
+
+See also the function `buffer-syntactic-context-depth', which returns
+the current nesting-depth within all parenthesis-syntax delimiters
+and the function `syntactically-sectionize', which will map a function
+over each syntactic context in a region.
+
+WARNING: this may alter match-data.
+*/
+ (buffer))
+{
+ /* This function can GC */
+ struct buffer *buf = decode_buffer (buffer, 0);
+ find_context (buf, BUF_PT (buf));
+ return context_to_symbol (context_cache.context);
+}
+
+DEFUN ("buffer-syntactic-context-depth", Fbuffer_syntactic_context_depth,
+ 0, 1, 0, /*
+Return the depth within all parenthesis-syntax delimiters at point.
+If BUFFER is nil or omitted, the current buffer is assumed.
+WARNING: this may alter match-data.
+*/
+ (buffer))
+{
+ /* This function can GC */
+ struct buffer *buf = decode_buffer (buffer, 0);
+ find_context (buf, BUF_PT (buf));
+ return make_int (context_cache.depth);
+}
+
+
+DEFUN ("syntactically-sectionize", Fsyntactically_sectionize, 3, 4, 0, /*
+Call FUNCTION for each contiguous syntactic context in the region.
+Call the given function with four arguments: the start and end of the
+region, a symbol representing the syntactic context, and the current
+depth (as returned by the functions `buffer-syntactic-context' and
+`buffer-syntactic-context-depth'). When this function is called, the
+current buffer will be set to BUFFER.
+
+WARNING: this may alter match-data.
+*/
+ (function, start, end, buffer))
+{
+ /* This function can GC */
+ Bufpos s, pt, e;
+ int edepth;
+ enum syntactic_context this_context;
+ Lisp_Object extent = Qnil;
+ struct gcpro gcpro1;
+ struct buffer *buf = decode_buffer (buffer, 0);
+
+ get_buffer_range_char (buf, start, end, &s, &e, 0);
+
+ pt = s;
+ find_context (buf, pt);
+
+ GCPRO1 (extent);
+ while (pt < e)
+ {
+ Bufpos estart, eend;
+ /* skip over "blank" areas, and bug out at end-of-buffer. */
+ while (context_cache.context == context_none)
+ {
+ pt++;
+ if (pt >= e) goto DONE_LABEL;
+ find_context (buf, pt);
+ }
+ /* We've found a non-blank area; keep going until we reach its end */
+ this_context = context_cache.context;
+ estart = pt;
+
+ /* Minor kludge: consider the comment-start character(s) a part of
+ the comment.
+ */
+ if (this_context == context_block_comment &&
+ context_cache.ccontext == ccontext_start2)
+ estart -= 2;
+ else if (this_context == context_comment)
+ estart -= 1;
+
+ edepth = context_cache.depth;
+ while (context_cache.context == this_context && pt < e)
+ {
+ pt++;
+ find_context (buf, pt);
+ }
+
+ eend = pt;
+
+ /* Minor kludge: consider the character which terminated the comment
+ a part of the comment.
+ */
+ if ((this_context == context_block_comment ||
+ this_context == context_comment)
+ && pt < e)
+ eend++;
+
+ if (estart == eend)
+ continue;
+ /* Make sure not to pass in values that are outside the
+ actual bounds of this function. */
+ call4_in_buffer (buf, function, make_int (max (s, estart)),
+ make_int (eend == e ? e : eend - 1),
+ context_to_symbol (this_context),
+ make_int (edepth));
+ }
+ DONE_LABEL:
+ UNGCPRO;
+ return Qnil;
+}
+
+void
+syms_of_font_lock (void)
+{
+ defsymbol (&Qcomment, "comment");
+ defsymbol (&Qblock_comment, "block-comment");
+ defsymbol (&Qbeginning_of_defun, "beginning-of-defun");
+
+ DEFSUBR (Fbuffer_syntactic_context);
+ DEFSUBR (Fbuffer_syntactic_context_depth);
+ DEFSUBR (Fsyntactically_sectionize);
+}
+
+void
+vars_of_font_lock (void)
+{
+ xzero (context_cache);
+ xzero (bol_context_cache);
+}
--- /dev/null
+/* Generic frame functions.
+ Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+ Copyright (C) 1995, 1996 Ben Wing.
+ 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: FSF 19.30. */
+
+/* This file has been Mule-ized. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h" /* for Vbuffer_alist */
+#include "console.h"
+#include "events.h"
+#include "extents.h"
+#include "faces.h"
+#include "frame.h"
+#include "glyphs.h"
+#include "menubar.h"
+#include "redisplay.h"
+#include "scrollbar.h"
+#include "window.h"
+
+#include <errno.h>
+#include "sysdep.h"
+
+Lisp_Object Vselect_frame_hook, Qselect_frame_hook;
+Lisp_Object Vdeselect_frame_hook, Qdeselect_frame_hook;
+Lisp_Object Vcreate_frame_hook, Qcreate_frame_hook;
+Lisp_Object Vdelete_frame_hook, Qdelete_frame_hook;
+Lisp_Object Vmouse_enter_frame_hook, Qmouse_enter_frame_hook;
+Lisp_Object Vmouse_leave_frame_hook, Qmouse_leave_frame_hook;
+Lisp_Object Vmap_frame_hook, Qmap_frame_hook;
+Lisp_Object Vunmap_frame_hook, Qunmap_frame_hook;
+int allow_deletion_of_last_visible_frame;
+Lisp_Object Vadjust_frame_function;
+Lisp_Object Vmouse_motion_handler;
+Lisp_Object Vsynchronize_minibuffers;
+Lisp_Object Qsynchronize_minibuffers;
+Lisp_Object Qbuffer_predicate;
+Lisp_Object Qmake_initial_minibuffer_frame;
+Lisp_Object Qcustom_initialize_frame;
+
+/* We declare all these frame properties here even though many of them
+ are currently only used in frame-x.c, because we should generalize
+ them. */
+
+Lisp_Object Qminibuffer;
+Lisp_Object Qunsplittable;
+Lisp_Object Qinternal_border_width;
+Lisp_Object Qtop_toolbar_shadow_color;
+Lisp_Object Qbottom_toolbar_shadow_color;
+Lisp_Object Qbackground_toolbar_color;
+Lisp_Object Qtop_toolbar_shadow_pixmap;
+Lisp_Object Qbottom_toolbar_shadow_pixmap;
+Lisp_Object Qtoolbar_shadow_thickness;
+Lisp_Object Qscrollbar_placement;
+Lisp_Object Qinter_line_space;
+Lisp_Object Qvisual_bell;
+Lisp_Object Qbell_volume;
+Lisp_Object Qpointer_background;
+Lisp_Object Qpointer_color;
+Lisp_Object Qtext_pointer;
+Lisp_Object Qspace_pointer;
+Lisp_Object Qmodeline_pointer;
+Lisp_Object Qgc_pointer;
+Lisp_Object Qinitially_unmapped;
+Lisp_Object Quse_backing_store;
+Lisp_Object Qborder_color;
+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;
+Lisp_Object Qframe_icon_title_format, Vframe_icon_title_format;
+
+Lisp_Object Vdefault_frame_name;
+Lisp_Object Vdefault_frame_plist;
+
+Lisp_Object Vframe_icon_glyph;
+
+Lisp_Object Qhidden;
+
+Lisp_Object Qvisible, Qiconic, Qinvisible, Qvisible_iconic, Qinvisible_iconic;
+Lisp_Object Qnomini, Qvisible_nomini, Qiconic_nomini, Qinvisible_nomini;
+Lisp_Object Qvisible_iconic_nomini, Qinvisible_iconic_nomini;
+
+Lisp_Object Qset_specifier, Qset_glyph_image, Qset_face_property;
+Lisp_Object Qface_property_instance;
+
+Lisp_Object Qframe_property_alias;
+
+/* If this is non-nil, it is the frame that make-frame is currently
+ creating. We can't set the current frame to this in case the
+ debugger goes off because it would try and display to it. However,
+ there are some places which need to reference it which have no
+ other way of getting it if it isn't the selected frame. */
+Lisp_Object Vframe_being_created;
+Lisp_Object Qframe_being_created;
+
+static void store_minibuf_frame_prop (struct frame *f, Lisp_Object val);
+
+EXFUN (Fset_frame_properties, 2);
+
+\f
+static Lisp_Object
+mark_frame (Lisp_Object obj, void (*markobj) (Lisp_Object))
+{
+ struct frame *f = XFRAME (obj);
+
+#define MARKED_SLOT(x) ((markobj) (f->x));
+#include "frameslots.h"
+
+ if (FRAME_LIVE_P (f)) /* device is nil for a dead frame */
+ MAYBE_FRAMEMETH (f, mark_frame, (f, markobj));
+
+ return Qnil;
+}
+
+static void
+print_frame (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+ struct frame *frm = XFRAME (obj);
+ char buf[200];
+
+ if (print_readably)
+ error ("printing unreadable object #<frame %s 0x%x>",
+ XSTRING_DATA (frm->name), frm->header.uid);
+
+ sprintf (buf, "#<%s-frame ", !FRAME_LIVE_P (frm) ? "dead" :
+ FRAME_TYPE_NAME (frm));
+ write_c_string (buf, printcharfun);
+ print_internal (frm->name, printcharfun, 1);
+ sprintf (buf, " 0x%x>", frm->header.uid);
+ write_c_string (buf, printcharfun);
+}
+
+DEFINE_LRECORD_IMPLEMENTATION ("frame", frame,
+ mark_frame, print_frame, 0, 0, 0,
+ struct frame);
+\f
+static void
+nuke_all_frame_slots (struct frame *f)
+{
+#define MARKED_SLOT(x) f->x = Qnil;
+#include "frameslots.h"
+}
+
+/* Allocate a new frame object and set all its fields to reasonable
+ values. The root window is created but the minibuffer will be done
+ later. */
+
+static struct frame *
+allocate_frame_core (Lisp_Object device)
+{
+ /* This function can GC */
+ Lisp_Object frame;
+ Lisp_Object root_window;
+ struct frame *f = alloc_lcrecord_type (struct frame, lrecord_frame);
+
+ zero_lcrecord (f);
+ nuke_all_frame_slots (f);
+ XSETFRAME (frame, f);
+
+ f->device = device;
+ f->framemeths = XDEVICE (device)->devmeths;
+ f->buffer_alist = Fcopy_sequence (Vbuffer_alist);
+
+ root_window = allocate_window ();
+ XWINDOW (root_window)->frame = frame;
+
+ /* 10 is arbitrary,
+ just so that there is "something there."
+ Correct size will be set up later with change_frame_size. */
+
+ f->width = 10;
+ f->height = 10;
+
+ XWINDOW (root_window)->pixel_width = 10;
+ XWINDOW (root_window)->pixel_height = 9;
+
+ /* The size of the minibuffer window is now set in x_create_frame
+ in xfns.c. */
+
+ f->root_window = root_window;
+ f->selected_window = root_window;
+ f->last_nonminibuf_window = root_window;
+
+ /* Choose a buffer for the frame's root window. */
+ XWINDOW (root_window)->buffer = Qt;
+ {
+ Lisp_Object buf;
+
+ buf = Fcurrent_buffer ();
+ /* If buf is a 'hidden' buffer (i.e. one whose name starts with
+ 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);
+ }
+
+ return f;
+}
+
+static void
+setup_normal_frame (struct frame *f)
+{
+ Lisp_Object mini_window;
+ Lisp_Object frame;
+
+ XSETFRAME (frame, f);
+
+ mini_window = allocate_window ();
+ XWINDOW (f->root_window)->next = mini_window;
+ XWINDOW (mini_window)->prev = f->root_window;
+ XWINDOW (mini_window)->mini_p = Qt;
+ XWINDOW (mini_window)->frame = frame;
+ f->minibuffer_window = mini_window;
+ f->has_minibuffer = 1;
+
+ XWINDOW (mini_window)->buffer = Qt;
+ Fset_window_buffer (mini_window, Vminibuffer_zero);
+}
+
+/* Make a frame using a separate minibuffer window on another frame.
+ MINI_WINDOW is the minibuffer window to use. nil means use the
+ default-minibuffer-frame. */
+
+static void
+setup_frame_without_minibuffer (struct frame *f, Lisp_Object mini_window)
+{
+ /* This function can GC */
+ Lisp_Object device = f->device;
+
+ if (!NILP (mini_window))
+ CHECK_LIVE_WINDOW (mini_window);
+
+ if (!NILP (mini_window)
+ && !EQ (DEVICE_CONSOLE (XDEVICE (device)),
+ FRAME_CONSOLE (XFRAME (XWINDOW (mini_window)->frame))))
+ error ("frame and minibuffer must be on the same console");
+
+ if (NILP (mini_window))
+ {
+ struct console *con = XCONSOLE (FRAME_CONSOLE (f));
+ /* Use default-minibuffer-frame if possible. */
+ if (!FRAMEP (con->default_minibuffer_frame)
+ || ! FRAME_LIVE_P (XFRAME (con->default_minibuffer_frame)))
+ {
+ /* If there's no minibuffer frame to use, create one. */
+ con->default_minibuffer_frame
+ = call1 (Qmake_initial_minibuffer_frame, device);
+ }
+ mini_window = XFRAME (con->default_minibuffer_frame)->minibuffer_window;
+ }
+
+ /* Install the chosen minibuffer window, with proper buffer. */
+ store_minibuf_frame_prop (f, mini_window);
+ Fset_window_buffer (mini_window, Vminibuffer_zero);
+}
+
+/* Make a frame containing only a minibuffer window. */
+
+static void
+setup_minibuffer_frame (struct frame *f)
+{
+ /* This function can GC */
+ /* First make a frame containing just a root window, no minibuffer. */
+ Lisp_Object mini_window;
+ Lisp_Object frame;
+
+ XSETFRAME (frame, f);
+
+ f->no_split = 1;
+ f->has_minibuffer = 1;
+
+ /* Now label the root window as also being the minibuffer.
+ Avoid infinite looping on the window chain by marking next pointer
+ as nil. */
+
+ mini_window = f->minibuffer_window = f->root_window;
+ XWINDOW (mini_window)->mini_p = Qt;
+ XWINDOW (mini_window)->next = Qnil;
+ XWINDOW (mini_window)->prev = Qnil;
+ XWINDOW (mini_window)->frame = frame;
+
+ /* Put the proper buffer in that window. */
+
+ Fset_window_buffer (mini_window, Vminibuffer_zero);
+}
+
+static Lisp_Object
+make_sure_its_a_fresh_plist (Lisp_Object foolist)
+{
+ if (CONSP (Fcar (foolist)))
+ {
+ /* looks like an alist to me. */
+ foolist = Fcopy_alist (foolist);
+ foolist = Fdestructive_alist_to_plist (foolist);
+ }
+ else
+ foolist = Fcopy_sequence (foolist);
+
+ return foolist;
+}
+
+DEFUN ("make-frame", Fmake_frame, 0, 2, "", /*
+Create and return a new frame, displaying the current buffer.
+Runs the functions listed in `create-frame-hook' after frame creation.
+
+Optional argument PROPS is a property list (a list of alternating
+keyword-value specifications) of properties for the new frame.
+\(An alist is accepted for backward compatibility but should not
+be passed in.)
+
+See `set-frame-properties', `default-x-frame-plist', and
+`default-tty-frame-plist' for the specially-recognized properties.
+*/
+ (props, device))
+{
+ struct frame *f;
+ struct device *d;
+ Lisp_Object frame = Qnil, name = Qnil, minibuf;
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ int speccount = specpdl_depth ();
+ int first_frame_on_device = 0;
+ int first_frame_on_console = 0;
+
+ d = decode_device (device);
+ XSETDEVICE (device, d);
+
+ /* PROPS and NAME may be freshly-created, so make sure to GCPRO. */
+ GCPRO3 (frame, props, name);
+
+ props = make_sure_its_a_fresh_plist (props);
+ if (DEVICE_SPECIFIC_FRAME_PROPS (d))
+ /* Put the device-specific props before the more general ones so
+ that they override them. */
+ props = nconc2 (props,
+ make_sure_its_a_fresh_plist
+ (*DEVICE_SPECIFIC_FRAME_PROPS (d)));
+ props = nconc2 (props, make_sure_its_a_fresh_plist (Vdefault_frame_plist));
+ Fcanonicalize_lax_plist (props, Qnil);
+
+ name = Flax_plist_get (props, Qname, Qnil);
+ if (!NILP (name))
+ CHECK_STRING (name);
+ else if (STRINGP (Vdefault_frame_name))
+ name = Vdefault_frame_name;
+ else
+ name = build_string ("emacs");
+
+ if (!NILP (Fstring_match (make_string ((CONST Bufbyte *) "\\.", 2), name,
+ Qnil, Qnil)))
+ signal_simple_error (". not allowed in frame names", name);
+
+ f = allocate_frame_core (device);
+ XSETFRAME (frame, f);
+
+ specbind (Qframe_being_created, name);
+ f->name = name;
+
+ FRAMEMETH (f, init_frame_1, (f, props));
+
+ minibuf = Flax_plist_get (props, Qminibuffer, Qunbound);
+ if (UNBOUNDP (minibuf))
+ {
+ /* If minibuf is unspecified, then look for a minibuffer X resource. */
+ /* #### Not implemented any more. We need to fix things up so
+ that we search out all X resources and append them to the end of
+ props, above. This is the only way in general to assure
+ coherent behavior for all frame properties/resources/etc. */
+ }
+ else
+ props = Flax_plist_remprop (props, Qminibuffer);
+
+ if (EQ (minibuf, Qnone) || NILP (minibuf))
+ setup_frame_without_minibuffer (f, Qnil);
+ else if (EQ (minibuf, Qonly))
+ setup_minibuffer_frame (f);
+ else if (WINDOWP (minibuf))
+ setup_frame_without_minibuffer (f, minibuf);
+ else if (EQ (minibuf, Qt) || UNBOUNDP (minibuf))
+ setup_normal_frame (f);
+ else
+ signal_simple_error ("Invalid value for `minibuffer'", minibuf);
+
+ update_frame_window_mirror (f);
+
+ if (initialized)
+ {
+ if (!NILP (f->minibuffer_window))
+ reset_face_cachels (XWINDOW (f->minibuffer_window));
+ reset_face_cachels (XWINDOW (f->root_window));
+ }
+
+ /* If no frames on this device formerly existed, say this is the
+ first frame. It kind of assumes that frameless devices don't
+ exist, but it shouldn't be too harmful. */
+ if (NILP (DEVICE_FRAME_LIST (d)))
+ first_frame_on_device = 1;
+
+ /* This *must* go before the init_*() methods. Those functions
+ call Lisp code, and if any of them causes a warning to be displayed
+ and the *Warnings* buffer to be created, it won't get added to
+ the frame-specific version of the buffer-alist unless the frame
+ is accessible from the device. */
+
+#if 0
+ DEVICE_FRAME_LIST (d) = nconc2 (DEVICE_FRAME_LIST (d), Fcons (frame, Qnil));
+#endif
+ DEVICE_FRAME_LIST (d) = Fcons (frame, DEVICE_FRAME_LIST (d));
+ RESET_CHANGED_SET_FLAGS;
+
+ /* Now make sure that the initial cached values are set correctly.
+ Do this after the init_frame method is called because that may
+ do things (e.g. create widgets) that are necessary for the
+ specifier value-changed methods to work OK. */
+ recompute_all_cached_specifiers_in_frame (f);
+
+ if (!DEVICE_STREAM_P (d))
+ {
+ init_frame_faces (f);
+
+#ifdef HAVE_SCROLLBARS
+ /* Finish up resourcing the scrollbars. */
+ init_frame_scrollbars (f);
+#endif
+
+#ifdef HAVE_TOOLBARS
+ /* Create the initial toolbars. We have to do this after the frame
+ methods are called because it may potentially call some things itself
+ which depend on the normal frame methods having initialized
+ things. */
+ init_frame_toolbars (f);
+#endif
+
+ reset_face_cachels (XWINDOW (FRAME_SELECTED_WINDOW (f)));
+ reset_glyph_cachels (XWINDOW (FRAME_SELECTED_WINDOW (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));
+
+ /* Hallelujah, praise the lord. */
+ f->init_finished = 1;
+
+ /* If this is the first frame on the device, make it the selected one. */
+ if (first_frame_on_device && NILP (DEVICE_SELECTED_FRAME (d)))
+ set_device_selected_frame (d, frame);
+
+ /* If at startup or if the current console is a stream console
+ (usually also at startup), make this console the selected one
+ so that messages show up on it. */
+ if (NILP (Fselected_console ()) ||
+ CONSOLE_STREAM_P (XCONSOLE (Fselected_console ())))
+ Fselect_console (DEVICE_CONSOLE (d));
+
+ first_frame_on_console =
+ (first_frame_on_device &&
+ XINT (Flength (CONSOLE_DEVICE_LIST (XCONSOLE (DEVICE_CONSOLE (d)))))
+ == 1);
+
+ /* #### all this calling of frame methods at various odd times
+ is somewhat of a mess. It's necessary to do it this way due
+ to strange console-type-specific things that need to be done. */
+ MAYBE_FRAMEMETH (f, after_init_frame, (f, first_frame_on_device,
+ first_frame_on_console));
+
+ if (first_frame_on_device)
+ {
+ if (first_frame_on_console)
+ va_run_hook_with_args (Qcreate_console_hook, 1, DEVICE_CONSOLE (d));
+ va_run_hook_with_args (Qcreate_device_hook, 1, device);
+ }
+ va_run_hook_with_args (Qcreate_frame_hook, 1, frame);
+
+ /* Initialize custom-specific stuff. */
+ if (!UNBOUNDP (symbol_function (XSYMBOL (Qcustom_initialize_frame))))
+ call1 (Qcustom_initialize_frame, frame);
+
+ unbind_to (speccount, Qnil);
+
+ UNGCPRO;
+ return frame;
+}
+
+\f
+/* this function should be used in most cases when a Lisp function is passed
+ a FRAME argument. Use this unless you don't accept nil == current frame
+ (in which case, do a CHECK_LIVE_FRAME() and then an XFRAME()) or you
+ allow dead frames. Note that very few functions should accept dead
+ frames. It could be argued that functions should just do nothing when
+ given a dead frame, but the presence of a dead frame usually indicates
+ an oversight in the Lisp code that could potentially lead to strange
+ results and so it is better to catch the error early.
+
+ If you only accept X frames, use decode_x_frame(), which does what this
+ function does but also makes sure the frame is an X frame. */
+
+struct frame *
+decode_frame (Lisp_Object frame)
+{
+ if (NILP (frame))
+ return selected_frame ();
+
+ CHECK_LIVE_FRAME (frame);
+ return XFRAME (frame);
+}
+
+struct frame *
+decode_frame_or_selected (Lisp_Object cdf)
+{
+ if (CONSOLEP (cdf))
+ cdf = CONSOLE_SELECTED_DEVICE (decode_console (cdf));
+ if (DEVICEP (cdf))
+ cdf = DEVICE_SELECTED_FRAME (decode_device (cdf));
+ return decode_frame (cdf);
+}
+
+Lisp_Object
+make_frame (struct frame *f)
+{
+ Lisp_Object frame;
+ XSETFRAME (frame, f);
+ return frame;
+}
+
+\f
+/*
+ * window size changes are held up during critical regions. Afterwards,
+ * we want to deal with any delayed changes.
+ */
+void
+hold_frame_size_changes (void)
+{
+ in_display = 1;
+}
+
+void
+unhold_one_frame_size_changes (struct frame *f)
+{
+ in_display = 0;
+
+ if (f->size_change_pending)
+ change_frame_size (f, f->new_height, f->new_width, 0);
+}
+
+void
+unhold_frame_size_changes (void)
+{
+ Lisp_Object frmcons, devcons, concons;
+
+ FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
+ unhold_one_frame_size_changes (XFRAME (XCAR (frmcons)));
+}
+
+void
+invalidate_vertical_divider_cache_in_frame (struct frame *f)
+{
+ /* Invalidate cached value of needs_vertical_divider_p in
+ every and all windows */
+ map_windows (f, invalidate_vertical_divider_cache_in_window, 0);
+}
+\f
+/*
+ * Frame size may change due to changes in scrollbars, toolbars,
+ * default font etc. These changes are applied early in redisplay
+ * frame.
+ */
+void
+adjust_frame_size (struct frame *f)
+{
+ int keep_char_size = 0;
+ Lisp_Object frame;
+ XSETFRAME (frame, f);
+
+ if (!f->size_slipped)
+ return;
+
+ /* Don't adjust tty frames. #### May break when TTY have menubars.
+ Then, write an Vadjust_frame_function which will return t for TTY
+ frames. Another solution is frame_size_fixed_p method for TTYs,
+ which always returned yes it's fixed.
+ */
+ if (!FRAME_WIN_P (f))
+ {
+ CLEAR_FRAME_SIZE_SLIPPED (f);
+ return;
+ }
+
+ /* frame_size_fixed_p tells that frame size cannot currently
+ be changed change due to external conditions */
+ if (!FRAMEMETH_OR_GIVEN (f, frame_size_fixed_p, (f), 0))
+ {
+ if (NILP (Vadjust_frame_function))
+ keep_char_size = 1;
+ else if (EQ (Vadjust_frame_function, Qt))
+ keep_char_size = 0;
+ else
+ keep_char_size =
+ NILP (call1_trapping_errors ("Error in adjust-frame-function",
+ Vadjust_frame_function, frame));
+
+ if (keep_char_size)
+ Fset_frame_size (frame, make_int (FRAME_CHARWIDTH(f)),
+ make_int (FRAME_CHARHEIGHT(f)), Qnil);
+ }
+
+ if (!keep_char_size)
+ {
+ int height, width;
+ pixel_to_char_size (f, FRAME_PIXWIDTH(f), FRAME_PIXHEIGHT(f),
+ &width, &height);
+ change_frame_size (f, height, width, 0);
+ CLEAR_FRAME_SIZE_SLIPPED (f);
+ }
+}
+
+/*
+ * This is a "specifier changed in frame" handler for various specifiers
+ * changing which causes frame size adjustment
+ */
+void
+frame_size_slipped (Lisp_Object specifier, struct frame *f,
+ Lisp_Object oldval)
+{
+ MARK_FRAME_SIZE_SLIPPED(f);
+}
+\f
+DEFUN ("framep", Fframep, 1, 1, 0, /*
+Return non-nil if OBJECT is a frame.
+Also see `frame-live-p'.
+Note that FSF Emacs kludgily returns a value indicating what type of
+frame this is. Use the cleaner function `frame-type' for that.
+*/
+ (object))
+{
+ return FRAMEP (object) ? Qt : Qnil;
+}
+
+DEFUN ("frame-live-p", Fframe_live_p, 1, 1, 0, /*
+Return non-nil if OBJECT is a frame which has not been deleted.
+*/
+ (object))
+{
+ return FRAMEP (object) && FRAME_LIVE_P (XFRAME (object)) ? Qt : Qnil;
+}
+
+\f
+DEFUN ("focus-frame", Ffocus_frame, 1, 1, 0, /*
+Select FRAME and give it the window system focus.
+This function is not affected by the value of `focus-follows-mouse'.
+*/
+ (frame))
+{
+ CHECK_LIVE_FRAME (frame);
+
+ MAYBE_DEVMETH (XDEVICE (FRAME_DEVICE (XFRAME (frame))), focus_on_frame,
+ (XFRAME (frame)));
+ /* FRAME will be selected by the time we receive the next event.
+ However, it is better to select it explicitly now, in case the
+ Lisp code depends on frame being selected. */
+ Fselect_frame (frame);
+ return Qnil;
+}
+
+/* Called from Fselect_window() */
+void
+select_frame_1 (Lisp_Object frame)
+{
+ struct frame *f = XFRAME (frame);
+ Lisp_Object old_selected_frame = Fselected_frame (Qnil);
+
+ if (EQ (frame, old_selected_frame))
+ return;
+
+ /* now select the frame's device */
+ set_device_selected_frame (XDEVICE (FRAME_DEVICE (f)), frame);
+ select_device_1 (FRAME_DEVICE (f));
+
+ update_frame_window_mirror (f);
+}
+
+DEFUN ("select-frame", Fselect_frame, 1, 1, 0, /*
+Select the frame FRAME.
+Subsequent editing commands apply to its selected window.
+The selection of FRAME lasts until the next time the user does
+something to select a different frame, or until the next time this
+function is called.
+
+Note that this does not actually cause the window-system focus to be
+set to this frame, or the `select-frame-hook' or `deselect-frame-hook'
+to be run, until the next time that XEmacs is waiting for an event.
+
+Also note that when focus-follows-mouse is non-nil, the frame
+selection is temporary and is reverted when the current command
+terminates, much like the buffer selected by `set-buffer'. In order
+to effect a permanent focus change, use `focus-frame'.
+*/
+ (frame))
+{
+ CHECK_LIVE_FRAME (frame);
+
+ /* select the frame's selected window. This will call
+ selected_frame_1(). */
+ Fselect_window (FRAME_SELECTED_WINDOW (XFRAME (frame)), Qnil);
+
+ /* Nothing should be depending on the return value of this function.
+ But, of course, there is stuff out there which is. */
+ return frame;
+}
+
+/* use this to retrieve the currently selected frame. You should use
+ this in preference to Fselected_frame (Qnil) unless you are prepared
+ to handle the possibility of there being no selected frame (this
+ happens at some points during startup). */
+
+struct frame *
+selected_frame (void)
+{
+ Lisp_Object device = Fselected_device (Qnil);
+ Lisp_Object frame = DEVICE_SELECTED_FRAME (XDEVICE (device));
+ if (NILP (frame))
+ signal_simple_error ("No frames exist on device", device);
+ return XFRAME (frame);
+}
+
+/* use this instead of XFRAME (DEVICE_SELECTED_FRAME (d)) to catch
+ the possibility of there being no frames on the device (just created).
+ There is no point doing this inside of redisplay because errors
+ cause an abort(), indicating a flaw in the logic, and error_check_frame()
+ will catch this just as well. */
+
+struct frame *
+device_selected_frame (struct device *d)
+{
+ Lisp_Object frame = DEVICE_SELECTED_FRAME (d);
+ if (NILP (frame))
+ {
+ Lisp_Object device;
+ XSETDEVICE (device, d);
+ signal_simple_error ("No frames exist on device", device);
+ }
+ return XFRAME (frame);
+}
+
+#if 0 /* FSFmacs */
+
+xxDEFUN ("handle-switch-frame", Fhandle_switch_frame, 1, 2, "e", /*
+Handle a switch-frame event EVENT.
+Switch-frame events are usually bound to this function.
+A switch-frame event tells Emacs that the window manager has requested
+that the user's events be directed to the frame mentioned in the event.
+This function selects the selected window of the frame of EVENT.
+
+If EVENT is frame object, handle it as if it were a switch-frame event
+to that frame.
+*/
+ (frame, no_enter))
+{
+ /* Preserve prefix arg that the command loop just cleared. */
+ XCONSOLE (Vselected_console)->prefix_arg = Vcurrent_prefix_arg;
+#if 0 /* unclean! */
+ run_hook (Qmouse_leave_buffer_hook);
+#endif
+ return do_switch_frame (frame, no_enter, 0);
+}
+
+/* A load of garbage. */
+xxDEFUN ("ignore-event", Fignore_event, 0, 0, "", /*
+Do nothing, but preserve any prefix argument already specified.
+This is a suitable binding for iconify-frame and make-frame-visible.
+*/
+ ())
+{
+ struct console *c = XCONSOLE (Vselected_console);
+
+ c->prefix_arg = Vcurrent_prefix_arg;
+ return Qnil;
+}
+
+#endif /* 0 */
+
+DEFUN ("selected-frame", Fselected_frame, 0, 1, 0, /*
+Return the frame that is now selected on device DEVICE.
+If DEVICE is not specified, the selected device will be used.
+If no frames exist on the device, nil is returned.
+*/
+ (device))
+{
+ if (NILP (device) && NILP (Fselected_device (Qnil)))
+ return Qnil; /* happens early in temacs */
+ return DEVICE_SELECTED_FRAME (decode_device (device));
+}
+
+Lisp_Object
+frame_first_window (struct frame *f)
+{
+ Lisp_Object w = f->root_window;
+
+ while (1)
+ {
+ if (! NILP (XWINDOW (w)->hchild))
+ w = XWINDOW (w)->hchild;
+ else if (! NILP (XWINDOW (w)->vchild))
+ w = XWINDOW (w)->vchild;
+ else
+ break;
+ }
+
+ return w;
+}
+
+DEFUN ("active-minibuffer-window", Factive_minibuffer_window, 0, 0, 0, /*
+Return the currently active minibuffer window, or nil if none.
+*/
+ ())
+{
+ return minibuf_level ? minibuf_window : Qnil;
+}
+
+DEFUN ("last-nonminibuf-frame", Flast_nonminibuf_frame, 0, 1, 0, /*
+Return the most-recently-selected non-minibuffer-only frame on CONSOLE.
+This will always be the same as (selected-frame device) unless the
+selected frame is a minibuffer-only frame.
+CONSOLE defaults to the selected console if omitted.
+*/
+ (console))
+{
+ Lisp_Object result;
+
+ XSETCONSOLE (console, decode_console (console));
+ /* Just in case the machinations in delete_frame_internal() resulted
+ in the last-nonminibuf-frame getting out of sync, make sure and
+ return the selected frame if it's acceptable. */
+ result = Fselected_frame (CONSOLE_SELECTED_DEVICE (XCONSOLE (console)));
+ if (!NILP (result) && !FRAME_MINIBUF_ONLY_P (XFRAME (result)))
+ return result;
+ return CONSOLE_LAST_NONMINIBUF_FRAME (XCONSOLE (console));
+}
+
+DEFUN ("frame-root-window", Fframe_root_window, 0, 1, 0, /*
+Return the root-window of FRAME.
+If omitted, FRAME defaults to the currently selected frame.
+*/
+ (frame))
+{
+ struct frame *f = decode_frame (frame);
+ return FRAME_ROOT_WINDOW (f);
+}
+
+DEFUN ("frame-selected-window", Fframe_selected_window, 0, 1, 0, /*
+Return the selected window of frame object FRAME.
+If omitted, FRAME defaults to the currently selected frame.
+*/
+ (frame))
+{
+ struct frame *f = decode_frame (frame);
+ return FRAME_SELECTED_WINDOW (f);
+}
+
+void
+set_frame_selected_window (struct frame *f, Lisp_Object window)
+{
+ assert (XFRAME (WINDOW_FRAME (XWINDOW (window))) == f);
+ f->selected_window = window;
+ if (!MINI_WINDOW_P (XWINDOW (window)) || FRAME_MINIBUF_ONLY_P (f))
+ {
+#ifdef HAVE_TOOLBARS
+ if (!EQ (f->last_nonminibuf_window, window))
+ MARK_TOOLBAR_CHANGED;
+#endif
+ f->last_nonminibuf_window = window;
+ }
+}
+
+DEFUN ("set-frame-selected-window", Fset_frame_selected_window, 2, 2, 0, /*
+Set the selected window of frame object FRAME to WINDOW.
+If FRAME is nil, the selected frame is used.
+If FRAME is the selected frame, this makes WINDOW the selected window.
+*/
+ (frame, window))
+{
+ XSETFRAME (frame, decode_frame (frame));
+ CHECK_LIVE_WINDOW (window);
+
+ if (! EQ (frame, WINDOW_FRAME (XWINDOW (window))))
+ error ("In `set-frame-selected-window', WINDOW is not on FRAME");
+
+ if (XFRAME (frame) == selected_frame ())
+ return Fselect_window (window, Qnil);
+
+ set_frame_selected_window (XFRAME (frame), window);
+ return window;
+}
+
+\f
+DEFUN ("frame-device", Fframe_device, 0, 1, 0, /*
+Return the device that FRAME is on.
+If omitted, FRAME defaults to the currently selected frame.
+*/
+ (frame))
+{
+ return FRAME_DEVICE (decode_frame (frame));
+}
+
+int
+is_surrogate_for_selected_frame (struct frame *f)
+{
+ struct device *d = XDEVICE (f->device);
+ struct frame *dsf = device_selected_frame (d);
+
+ /* Can't be a surrogate for ourselves. */
+ if (f == dsf)
+ return 0;
+
+ if (!FRAME_HAS_MINIBUF_P (dsf) &&
+ f == XFRAME (WINDOW_FRAME (XWINDOW (FRAME_MINIBUF_WINDOW (dsf)))))
+ return 1;
+ else
+ return 0;
+}
+
+static int
+frame_matches_frametype (Lisp_Object frame, Lisp_Object type)
+{
+ struct frame *f = XFRAME (frame);
+
+ if (WINDOWP (type))
+ {
+ CHECK_LIVE_WINDOW (type);
+
+ if (EQ (FRAME_MINIBUF_WINDOW (f), type)
+ /* Check that F either is, or has forwarded
+ its focus to, TYPE's frame. */
+ && (EQ (WINDOW_FRAME (XWINDOW (type)), frame)
+ || EQ (WINDOW_FRAME (XWINDOW (type)),
+ FRAME_FOCUS_FRAME (f))))
+ return 1;
+ else
+ return 0;
+ }
+
+#if 0 /* FSFmacs */
+ if (EQ (type, Qvisible) || EQ (type, Qiconic) || EQ (type, Qvisible_iconic)
+ || EQ (type, Qvisible_nomini) || EQ (type, Qiconic_nomini)
+ || EQ (type, Qvisible_iconic_nomini))
+ FRAME_SAMPLE_VISIBILITY (f);
+#endif
+
+ if (NILP (type))
+ type = Qnomini;
+ if (ZEROP (type))
+ type = Qvisible_iconic;
+
+ if (EQ (type, Qvisible))
+ return FRAME_VISIBLE_P (f);
+ if (EQ (type, Qiconic))
+ return FRAME_ICONIFIED_P (f);
+ if (EQ (type, Qinvisible))
+ return !FRAME_VISIBLE_P (f) && !FRAME_ICONIFIED_P (f);
+ if (EQ (type, Qvisible_iconic))
+ return FRAME_VISIBLE_P (f) || FRAME_ICONIFIED_P (f);
+ if (EQ (type, Qinvisible_iconic))
+ return !FRAME_VISIBLE_P (f);
+
+ if (EQ (type, Qnomini))
+ return !FRAME_MINIBUF_ONLY_P (f);
+ if (EQ (type, Qvisible_nomini))
+ return FRAME_VISIBLE_P (f) && !FRAME_MINIBUF_ONLY_P (f);
+ if (EQ (type, Qiconic_nomini))
+ return FRAME_ICONIFIED_P (f) && !FRAME_MINIBUF_ONLY_P (f);
+ if (EQ (type, Qinvisible_nomini))
+ return !FRAME_VISIBLE_P (f) && !FRAME_ICONIFIED_P (f) &&
+ !FRAME_MINIBUF_ONLY_P (f);
+ if (EQ (type, Qvisible_iconic_nomini))
+ return ((FRAME_VISIBLE_P (f) || FRAME_ICONIFIED_P (f))
+ && !FRAME_MINIBUF_ONLY_P (f));
+ if (EQ (type, Qinvisible_iconic_nomini))
+ return !FRAME_VISIBLE_P (f) && !FRAME_MINIBUF_ONLY_P (f);
+
+ return 1;
+}
+
+int
+device_matches_console_spec (Lisp_Object frame, Lisp_Object device,
+ Lisp_Object console)
+{
+ if (EQ (console, Qwindow_system))
+ return DEVICE_WIN_P (XDEVICE (device));
+ if (NILP (console))
+ console = (DEVICE_CONSOLE (XDEVICE (FRAME_DEVICE (XFRAME (frame)))));
+ if (DEVICEP (console))
+ return EQ (device, console);
+ if (CONSOLEP (console))
+ return EQ (DEVICE_CONSOLE (XDEVICE (device)), console);
+ if (valid_console_type_p (console))
+ return EQ (DEVICE_TYPE (XDEVICE (device)), console);
+ return 1;
+}
+
+/* Return the next frame in the frame list after FRAME.
+ FRAMETYPE and CONSOLE control which frames and devices
+ are considered; see `next-frame'. */
+
+static Lisp_Object
+next_frame_internal (Lisp_Object frame, Lisp_Object frametype,
+ Lisp_Object console, int called_from_delete_device)
+{
+ int passed = 0;
+ int started_over = 0;
+
+ /* If this frame is dead, it won't be in frame_list, and we'll loop
+ forever. Forestall that. */
+ CHECK_LIVE_FRAME (frame);
+
+ while (1)
+ {
+ Lisp_Object devcons, concons;
+
+ DEVICE_LOOP_NO_BREAK (devcons, concons)
+ {
+ Lisp_Object device = XCAR (devcons);
+ Lisp_Object frmcons;
+
+ if (!device_matches_console_spec (frame, device, console))
+ continue;
+
+ DEVICE_FRAME_LOOP (frmcons, XDEVICE (device))
+ {
+ Lisp_Object f = XCAR (frmcons);
+ if (passed)
+ {
+ /* #### Doing this here is bad and is now
+ unnecessary. The real bug was that f->iconified
+ was never, ever updated unless a user explicitly
+ called frame-iconified-p. That has now been
+ fixed. With this change removed all of the other
+ changes made to support this routine having the
+ called_from_delete_device arg could be removed.
+ But it is too close to release to do that now. */
+#if 0
+ /* Make sure the visibility and iconified flags are
+ up-to-date unless we're being deleted. */
+ if (!called_from_delete_device)
+ {
+ Fframe_iconified_p (f);
+ Fframe_visible_p (f);
+ }
+#endif
+
+ /* Decide whether this frame is eligible to be returned. */
+
+ /* If we've looped all the way around without finding any
+ eligible frames, return the original frame. */
+ if (EQ (f, frame))
+ return f;
+
+ if (frame_matches_frametype (f, frametype))
+ return f;
+ }
+
+ if (EQ (frame, f))
+ passed++;
+ }
+ }
+ /* We hit the end of the list, and need to start over again. */
+ if (started_over)
+ return Qnil;
+ started_over++;
+ }
+}
+
+Lisp_Object
+next_frame (Lisp_Object frame, Lisp_Object frametype, Lisp_Object console)
+{
+ return next_frame_internal (frame, frametype, console, 0);
+}
+
+/* Return the previous frame in the frame list before FRAME.
+ FRAMETYPE and CONSOLE control which frames and devices
+ are considered; see `next-frame'. */
+
+Lisp_Object
+prev_frame (Lisp_Object frame, Lisp_Object frametype, Lisp_Object console)
+{
+ Lisp_Object devcons, concons;
+ Lisp_Object prev;
+
+ /* If this frame is dead, it won't be in frame_list, and we'll loop
+ forever. Forestall that. */
+ CHECK_LIVE_FRAME (frame);
+
+ prev = Qnil;
+ DEVICE_LOOP_NO_BREAK (devcons, concons)
+ {
+ Lisp_Object device = XCAR (devcons);
+ Lisp_Object frmcons;
+
+ if (!device_matches_console_spec (frame, device, console))
+ continue;
+
+ DEVICE_FRAME_LOOP (frmcons, XDEVICE (device))
+ {
+ Lisp_Object f = XCAR (frmcons);
+
+ if (EQ (frame, f) && !NILP (prev))
+ return prev;
+
+ /* Decide whether this frame is eligible to be returned,
+ according to frametype. */
+
+ if (frame_matches_frametype (f, frametype))
+ prev = f;
+
+ }
+ }
+
+ /* We've scanned the entire list. */
+ if (NILP (prev))
+ /* We went through the whole frame list without finding a single
+ acceptable frame. Return the original frame. */
+ return frame;
+ else
+ /* There were no acceptable frames in the list before FRAME; otherwise,
+ we would have returned directly from the loop. Since PREV is the last
+ acceptable frame in the list, return it. */
+ return prev;
+}
+
+DEFUN ("next-frame", Fnext_frame, 0, 3, 0, /*
+Return the next frame of the right type in the frame list after FRAME.
+FRAMETYPE controls which frames are eligible to be returned; all
+others will be skipped. Note that if there is only one eligible
+frame, then `next-frame' called repeatedly will always return
+the same frame, and if there is no eligible frame, then FRAME is
+returned.
+
+Possible values for FRAMETYPE are
+
+'visible Consider only frames that are visible.
+'iconic Consider only frames that are iconic.
+'invisible Consider only frames that are invisible
+ (this is different from iconic).
+'visible-iconic Consider frames that are visible or iconic.
+'invisible-iconic Consider frames that are invisible or iconic.
+'nomini Consider all frames except minibuffer-only ones.
+'visible-nomini Like `visible' but omits minibuffer-only frames.
+'iconic-nomini Like `iconic' but omits minibuffer-only frames.
+'invisible-nomini Like `invisible' but omits minibuffer-only frames.
+'visible-iconic-nomini Like `visible-iconic' but omits minibuffer-only
+ frames.
+'invisible-iconic-nomini Like `invisible-iconic' but omits minibuffer-only
+ frames.
+any other value Consider all frames.
+
+If FRAMETYPE is omitted, 'nomini is used. A FRAMETYPE of 0 (a number)
+is treated like 'iconic, for backwards compatibility.
+
+If FRAMETYPE is a window, include only its own frame and any frame now
+using that window as the minibuffer.
+
+Optional third argument CONSOLE controls which consoles or devices the
+returned frame may be on. If CONSOLE is a console, return frames only
+on that console. If CONSOLE is a device, return frames only on that
+device. If CONSOLE is a console type, return frames only on consoles
+of that type. If CONSOLE is 'window-system, return any frames on any
+window-system consoles. If CONSOLE is nil or omitted, return frames only
+on the FRAME's console. Otherwise, all frames are considered.
+*/
+ (frame, frametype, console))
+{
+ XSETFRAME (frame, decode_frame (frame));
+
+ return next_frame (frame, frametype, console);
+}
+
+DEFUN ("previous-frame", Fprevious_frame, 0, 3, 0, /*
+Return the next frame of the right type in the frame list after FRAME.
+FRAMETYPE controls which frames are eligible to be returned; all
+others will be skipped. Note that if there is only one eligible
+frame, then `previous-frame' called repeatedly will always return
+the same frame, and if there is no eligible frame, then FRAME is
+returned.
+
+See `next-frame' for an explanation of the FRAMETYPE and CONSOLE
+arguments.
+*/
+ (frame, frametype, console))
+{
+ XSETFRAME (frame, decode_frame (frame));
+
+ return prev_frame (frame, frametype, console);
+}
+
+/* Return any frame for which PREDICATE is non-zero, or return Qnil
+ if there aren't any. */
+
+Lisp_Object
+find_some_frame (int (*predicate) (Lisp_Object, void *),
+ void *closure)
+{
+ Lisp_Object framecons, devcons, concons;
+
+ FRAME_LOOP_NO_BREAK (framecons, devcons, concons)
+ {
+ Lisp_Object frame = XCAR (framecons);
+
+ if ((predicate) (frame, closure))
+ return frame;
+ }
+
+ return Qnil;
+}
+
+\f
+
+/* extern void free_line_insertion_deletion_costs (struct frame *f); */
+
+/* Return 1 if it is ok to delete frame F;
+ 0 if all frames aside from F are invisible.
+ (Exception: if F is a stream frame, it's OK to delete if
+ any other frames exist.) */
+
+static int
+other_visible_frames_internal (struct frame *f, int called_from_delete_device)
+{
+ Lisp_Object frame;
+
+ XSETFRAME (frame, f);
+ if (FRAME_STREAM_P (f))
+ return !EQ (frame, next_frame_internal (frame, Qt, Qt,
+ called_from_delete_device));
+ return !EQ (frame, next_frame_internal (frame, Qvisible_iconic_nomini, Qt,
+ called_from_delete_device));
+}
+
+int
+other_visible_frames (struct frame *f)
+{
+ return other_visible_frames_internal (f, 0);
+}
+
+/* Delete frame F.
+
+ If FORCE is non-zero, allow deletion of the only frame.
+
+ If CALLED_FROM_DELETE_DEVICE is non-zero, then, if
+ deleting the last frame on a device, just delete it,
+ instead of calling `delete-device'.
+
+ If FROM_IO_ERROR is non-zero, then the frame is gone due
+ to an I/O error. This affects what happens if we exit
+ (we do an emergency exit instead of `save-buffers-kill-emacs'.)
+*/
+
+void
+delete_frame_internal (struct frame *f, int force,
+ int called_from_delete_device,
+ int from_io_error)
+{
+ /* This function can GC */
+ int minibuffer_selected;
+ struct device *d;
+ struct console *con;
+ Lisp_Object frame;
+ Lisp_Object device;
+ Lisp_Object console;
+ struct gcpro gcpro1;
+
+ /* OK to delete an already deleted frame. */
+ if (! FRAME_LIVE_P (f))
+ return;
+
+ XSETFRAME (frame, f);
+ GCPRO1 (frame);
+
+ device = FRAME_DEVICE (f);
+ d = XDEVICE (device);
+ console = DEVICE_CONSOLE (d);
+ con = XCONSOLE (console);
+
+ if (!called_from_delete_device)
+ {
+ /* If we're deleting the only non-minibuffer frame on the
+ device, delete the device. */
+ if (EQ (frame, next_frame (frame, Qnomini, FRAME_DEVICE (f))))
+ {
+ delete_device_internal (d, force, 0, from_io_error);
+ UNGCPRO;
+ return;
+ }
+ }
+
+ /* In FSF, delete-frame will not normally allow you to delete the
+ last visible frame. This was too annoying, so we changed it to the
+ only frame. However, this would let people shoot themselves by
+ deleting all frames which were either visible or iconified and thus
+ losing any way of communicating with the still running XEmacs process.
+ So we put it back. */
+ if (!force && !allow_deletion_of_last_visible_frame &&
+ !other_visible_frames_internal (f, called_from_delete_device))
+ error ("Attempt to delete the sole visible or iconified frame");
+
+ /* Does this frame have a minibuffer, and is it the surrogate
+ minibuffer for any other frame? */
+ if (FRAME_HAS_MINIBUF_P (f))
+ {
+ Lisp_Object frmcons, devcons, concons;
+
+ FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
+ {
+ Lisp_Object this = XCAR (frmcons);
+
+ if (! EQ (this, frame)
+ && EQ (frame, (WINDOW_FRAME
+ (XWINDOW
+ (FRAME_MINIBUF_WINDOW (XFRAME (this)))))))
+ {
+ /* We've found another frame whose minibuffer is on
+ this frame. */
+ signal_simple_error
+ ("Attempt to delete a surrogate minibuffer frame", frame);
+ }
+ }
+ }
+
+ /* Test for popup frames hanging around. */
+ /* Deletion of a parent frame with popups is deadly. */
+ {
+ Lisp_Object frmcons, devcons, concons;
+
+ FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
+ {
+ Lisp_Object this = XCAR (frmcons);
+
+
+ if (! EQ (this, frame))
+ {
+ struct device *devcons_d = XDEVICE (XCAR (devcons));
+ if (EQ (frame, DEVMETH_OR_GIVEN (devcons_d, get_frame_parent,
+ (XFRAME (this)),
+ Qnil)))
+ /* We've found a popup frame whose parent is this frame. */
+ signal_simple_error
+ ("Attempt to delete a frame with live popups", frame);
+ }
+ }
+ }
+
+ /* Before here, we haven't made any dangerous changes (just checked for
+ error conditions). Now run the delete-frame-hook. Remember that
+ user code there could do any number of dangerous things, including
+ signalling an error. */
+
+ va_run_hook_with_args (Qdelete_frame_hook, 1, frame);
+
+ if (!FRAME_LIVE_P (f)) /* Make sure the delete-frame-hook didn't */
+ { /* go ahead and delete anything. */
+ UNGCPRO;
+ return;
+ }
+
+ /* Call the delete-device-hook and delete-console-hook now if
+ appropriate, before we do any dangerous things -- they too could
+ signal an error. */
+ if (XINT (Flength (DEVICE_FRAME_LIST (d))) == 1)
+ {
+ va_run_hook_with_args (Qdelete_device_hook, 1, device);
+ if (!FRAME_LIVE_P (f)) /* Make sure the delete-device-hook didn't */
+ { /* go ahead and delete anything. */
+ UNGCPRO;
+ return;
+ }
+
+ if (XINT (Flength (CONSOLE_DEVICE_LIST (con))) == 1)
+ {
+ va_run_hook_with_args (Qdelete_console_hook, 1, console);
+ if (!FRAME_LIVE_P (f)) /* Make sure the delete-console-hook didn't */
+ { /* go ahead and delete anything. */
+ UNGCPRO;
+ return;
+ }
+ }
+ }
+
+ minibuffer_selected = EQ (minibuf_window, Fselected_window (Qnil));
+
+ /* If we were focused on this frame, then we're not any more.
+ Assume that we lost the focus; that way, the call to
+ Fselect_frame() below won't end up making us explicitly
+ focus on another frame, which is generally undesirable in
+ a point-to-type world. If our mouse ends up sitting over
+ another frame, we will receive a FocusIn event and end up
+ making that frame the selected frame.
+
+ #### This may not be an ideal solution in a click-to-type
+ world (in that case, we might want to explicitly choose
+ another frame to have the focus, rather than relying on
+ the WM, which might focus on a frame in a different app
+ or focus on nothing at all). But there's no easy way
+ to detect which focus model we're running on, and the
+ alternative is more heinous. */
+
+ if (EQ (frame, DEVICE_FRAME_WITH_FOCUS_REAL (d)))
+ DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil;
+ if (EQ (frame, DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)))
+ DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = Qnil;
+ if (EQ (frame, DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d)))
+ DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = Qnil;
+
+ /* Don't allow the deleted frame to remain selected.
+ Note that in the former scheme of things, this would
+ have caused us to regain the focus. This no longer
+ applies (see above); I think the new behavior is more
+ logical. If someone disagrees, it can always be
+ changed (or a new user variable can be introduced, ugh.) */
+ if (EQ (frame, DEVICE_SELECTED_FRAME (d)))
+ {
+ Lisp_Object next;
+
+ /* If this is a popup frame, select its parent if possible.
+ Otherwise, find another visible frame; if none, just take any frame.
+ First try the same device, then the same console. */
+
+ next = DEVMETH_OR_GIVEN (d, get_frame_parent, (f), Qnil);
+ if (NILP (next) || EQ (next, frame) || ! FRAME_LIVE_P (XFRAME (next)))
+ next = next_frame_internal (frame, Qvisible, device,
+ called_from_delete_device);
+ if (NILP (next) || EQ (next, frame))
+ next = next_frame_internal (frame, Qvisible, console,
+ called_from_delete_device);
+ if (NILP (next) || EQ (next, frame))
+ next = next_frame_internal (frame, Qvisible, Qt,
+ called_from_delete_device);
+ if (NILP (next) || EQ (next, frame))
+ next = next_frame_internal (frame, Qt, device,
+ called_from_delete_device);
+ if (NILP (next) || EQ (next, frame))
+ next = next_frame_internal (frame, Qt, console,
+ called_from_delete_device);
+ if (NILP (next) || EQ (next, frame))
+ next = next_frame_internal (frame, Qt, Qt, called_from_delete_device);
+
+ /* if we haven't found another frame at this point
+ then there aren't any. */
+ if (NILP (next) || EQ (next, frame))
+ ;
+ else
+ {
+ int did_select = 0;
+ /* if this is the global selected frame, select another one. */
+ if (EQ (frame, Fselected_frame (Qnil)))
+ {
+ Fselect_frame (next);
+ did_select = 1;
+ }
+ /*
+ * If the new frame we just selected is on a different
+ * device then we still need to change DEVICE_SELECTED_FRAME(d)
+ * to a live frame, if there are any left on this device.
+ */
+ if (!EQ (device, FRAME_DEVICE(XFRAME(next))))
+ {
+ Lisp_Object next_f =
+ next_frame_internal (frame, Qt, device,
+ called_from_delete_device);
+ if (NILP (next_f) || EQ (next_f, frame))
+ ;
+ else
+ set_device_selected_frame (d, next_f);
+ }
+ else if (! did_select)
+ set_device_selected_frame (d, next);
+
+ }
+ }
+
+ /* Don't allow minibuf_window to remain on a deleted frame. */
+ if (EQ (f->minibuffer_window, minibuf_window))
+ {
+ struct frame *sel_frame = selected_frame ();
+ Fset_window_buffer (sel_frame->minibuffer_window,
+ XWINDOW (minibuf_window)->buffer);
+ minibuf_window = sel_frame->minibuffer_window;
+
+ /* If the dying minibuffer window was selected,
+ select the new one. */
+ if (minibuffer_selected)
+ Fselect_window (minibuf_window, Qnil);
+ }
+
+ /* After this point, no errors must be allowed to occur. */
+
+#ifdef HAVE_MENUBARS
+ free_frame_menubars (f);
+#endif
+#ifdef HAVE_SCROLLBARS
+ free_frame_scrollbars (f);
+#endif
+#ifdef HAVE_TOOLBARS
+ free_frame_toolbars (f);
+#endif
+
+ /* This must be done before the window and window_mirror structures
+ are freed. The scrollbar information is attached to them. */
+ MAYBE_FRAMEMETH (f, delete_frame, (f));
+
+ /* Mark all the windows that used to be on FRAME as deleted, and then
+ remove the reference to them. */
+ delete_all_subwindows (XWINDOW (f->root_window));
+ f->root_window = Qnil;
+
+ /* Remove the frame now from the list. This way, any events generated
+ on this frame by the maneuvers below will disperse themselves. */
+
+ /* This used to be Fdelq(), but that will cause a seg fault if the
+ QUIT checker happens to get invoked, because the frame list is in
+ an inconsistent state. */
+ d->frame_list = delq_no_quit (frame, d->frame_list);
+ RESET_CHANGED_SET_FLAGS;
+
+ f->dead = 1;
+ f->visible = 0;
+
+ free_window_mirror (f->root_mirror);
+/* free_line_insertion_deletion_costs (f); */
+
+ /* If we've deleted the last non-minibuf frame, then try to find
+ another one. */
+ if (EQ (frame, CONSOLE_LAST_NONMINIBUF_FRAME (con)))
+ {
+ Lisp_Object frmcons, devcons;
+
+ set_console_last_nonminibuf_frame (con, Qnil);
+
+ CONSOLE_FRAME_LOOP_NO_BREAK (frmcons, devcons, con)
+ {
+ Lisp_Object ecran = XCAR (frmcons);
+ if (!FRAME_MINIBUF_ONLY_P (XFRAME (ecran)))
+ {
+ set_console_last_nonminibuf_frame (con, ecran);
+ goto double_break_1;
+ }
+ }
+ }
+ double_break_1:
+
+#if 0
+ /* The following test is degenerate FALSE */
+ if (called_from_delete_device < 0)
+ /* then we're being called from delete-console, and we shouldn't
+ try to find another default-minibuffer frame for the console.
+ */
+ con->default_minibuffer_frame = Qnil;
+#endif
+
+ /* If we've deleted this console's default_minibuffer_frame, try to
+ find another one. Prefer minibuffer-only frames, but also notice
+ frames with other windows. */
+ if (EQ (frame, con->default_minibuffer_frame))
+ {
+ Lisp_Object frmcons, devcons;
+ /* The last frame we saw with a minibuffer, minibuffer-only or not. */
+ Lisp_Object frame_with_minibuf;
+ /* Some frame we found on the same console, or nil if there are none. */
+ Lisp_Object frame_on_same_console;
+
+ frame_on_same_console = Qnil;
+ frame_with_minibuf = Qnil;
+
+ set_console_last_nonminibuf_frame (con, Qnil);
+
+ CONSOLE_FRAME_LOOP_NO_BREAK (frmcons, devcons, con)
+ {
+ Lisp_Object this;
+ struct frame *f1;
+
+ this = XCAR (frmcons);
+ f1 = XFRAME (this);
+
+ /* Consider only frames on the same console
+ and only those with minibuffers. */
+ if (FRAME_HAS_MINIBUF_P (f1))
+ {
+ frame_with_minibuf = this;
+ if (FRAME_MINIBUF_ONLY_P (f1))
+ goto double_break_2;
+ }
+
+ frame_on_same_console = this;
+ }
+ double_break_2:
+
+ if (!NILP (frame_on_same_console))
+ {
+ /* We know that there must be some frame with a minibuffer out
+ there. If this were not true, all of the frames present
+ would have to be minibuffer-less, which implies that at some
+ point their minibuffer frames must have been deleted, but
+ that is prohibited at the top; you can't delete surrogate
+ minibuffer frames. */
+ if (NILP (frame_with_minibuf))
+ abort ();
+
+ con->default_minibuffer_frame = frame_with_minibuf;
+ }
+ else
+ /* No frames left on this console--say no minibuffer either. */
+ con->default_minibuffer_frame = Qnil;
+ }
+
+ nuke_all_frame_slots (f); /* nobody should be accessing the device
+ or anything else any more, and making
+ them Qnil allows for better GC'ing
+ in case a pointer to the dead frame
+ continues to hang around. */
+ f->framemeths = dead_console_methods;
+ UNGCPRO;
+}
+
+void
+io_error_delete_frame (Lisp_Object frame)
+{
+ delete_frame_internal (XFRAME (frame), 1, 0, 1);
+}
+
+DEFUN ("delete-frame", Fdelete_frame, 0, 2, "", /*
+Delete FRAME, permanently eliminating it from use.
+If omitted, FRAME defaults to the selected frame.
+A frame may not be deleted if its minibuffer is used by other frames.
+Normally, you cannot delete the last non-minibuffer-only frame (you must
+use `save-buffers-kill-emacs' or `kill-emacs'). However, if optional
+second argument FORCE is non-nil, you can delete the last frame. (This
+will automatically call `save-buffers-kill-emacs'.)
+*/
+ (frame, force))
+{
+ /* This function can GC */
+ struct frame *f;
+
+ if (NILP (frame))
+ {
+ f = selected_frame ();
+ XSETFRAME (frame, f);
+ }
+ else
+ {
+ CHECK_FRAME (frame);
+ f = XFRAME (frame);
+ }
+
+ delete_frame_internal (f, !NILP (force), 0, 0);
+ return Qnil;
+}
+
+\f
+/* Return mouse position in character cell units. */
+
+static int
+mouse_pixel_position_1 (struct device *d, Lisp_Object *frame,
+ int *x, int *y)
+{
+ switch (DEVMETH_OR_GIVEN (d, get_mouse_position, (d, frame, x, y), -1))
+ {
+ case 1:
+ return 1;
+
+ case 0:
+ *frame = Qnil;
+ break;
+
+ case -1:
+ *frame = DEVICE_SELECTED_FRAME (d);
+ break;
+
+ default:
+ abort (); /* method is incorrectly written */
+ }
+
+ return 0;
+}
+
+DEFUN ("mouse-pixel-position", Fmouse_pixel_position, 0, 1, 0, /*
+Return a list (WINDOW X . Y) giving the current mouse window and position.
+The position is given in pixel units, where (0, 0) is the upper-left corner.
+
+When the cursor is not over a window, the return value is a list (nil nil).
+
+DEVICE specifies the device on which to read the mouse position, and
+defaults to the selected device. If the device is a mouseless terminal
+or Emacs hasn't been programmed to read its mouse position, it returns
+the device's selected window for WINDOW and nil for X and Y.
+*/
+ (device))
+{
+ struct device *d = decode_device (device);
+ Lisp_Object frame;
+ Lisp_Object window = Qnil;
+ Lisp_Object x = Qnil;
+ Lisp_Object y = Qnil;
+ int intx, inty;
+
+ if (mouse_pixel_position_1 (d, &frame, &intx, &inty) > 0)
+ {
+ struct window *w =
+ find_window_by_pixel_pos (intx, inty, XFRAME (frame)->root_window);
+ if (w)
+ {
+ XSETWINDOW (window, w);
+
+ /* Adjust the position to be relative to the window. */
+ intx -= w->pixel_left;
+ inty -= w->pixel_top;
+ XSETINT (x, intx);
+ XSETINT (y, inty);
+ }
+ }
+ else if (FRAMEP (frame))
+ window = FRAME_SELECTED_WINDOW (XFRAME (frame));
+
+ return Fcons (window, Fcons (x, y));
+}
+
+DEFUN ("mouse-position", Fmouse_position, 0, 1, 0, /*
+Return a list (WINDOW X . Y) giving the current mouse window and position.
+The position is of a character under cursor, where (0, 0) is the upper-left
+corner of the window.
+
+When the cursor is not over a character, or not over a window, the return
+value is a list (nil nil).
+
+DEVICE specifies the device on which to read the mouse position, and
+defaults to the selected device. If the device is a mouseless terminal
+or Emacs hasn't been programmed to read its mouse position, it returns
+the device's selected window for WINDOW and nil for X and Y.
+*/
+ (device))
+{
+ struct device *d = decode_device (device);
+ struct window *w;
+ Lisp_Object frame, window = Qnil, lisp_x = Qnil, lisp_y = Qnil;
+ int x, y, obj_x, obj_y;
+ Bufpos bufpos, closest;
+ Charcount modeline_closest;
+ Lisp_Object obj1, obj2;
+
+ if (mouse_pixel_position_1 (d, &frame, &x, &y) > 0)
+ {
+ int res = pixel_to_glyph_translation (XFRAME (frame), x, y, &x, &y,
+ &obj_x, &obj_y, &w, &bufpos,
+ &closest, &modeline_closest,
+ &obj1, &obj2);
+ if (res == OVER_TEXT)
+ {
+ lisp_x = make_int (x);
+ lisp_y = make_int (y);
+ XSETWINDOW (window, w);
+ }
+ }
+ else if (FRAMEP (frame))
+ window = FRAME_SELECTED_WINDOW (XFRAME (frame));
+
+ return Fcons (window, Fcons (lisp_x, lisp_y));
+}
+
+DEFUN ("mouse-position-as-motion-event", Fmouse_position_as_motion_event, 0, 1, 0, /*
+Return the current mouse position as a motion event.
+This allows you to call the standard event functions such as
+`event-over-toolbar-p' to determine where the mouse is.
+
+DEVICE specifies the device on which to read the mouse position, and
+defaults to the selected device. If the mouse position can't be determined
+\(e.g. DEVICE is a TTY device), nil is returned instead of an event.
+*/
+ (device))
+{
+ struct device *d = decode_device (device);
+ Lisp_Object frame;
+ int intx, inty;
+
+ if (mouse_pixel_position_1 (d, &frame, &intx, &inty))
+ {
+ Lisp_Object event = Fmake_event (Qnil, Qnil);
+ XEVENT (event)->event_type = pointer_motion_event;
+ XEVENT (event)->channel = frame;
+ XEVENT (event)->event.motion.x = intx;
+ XEVENT (event)->event.motion.y = inty;
+ return event;
+ }
+ else
+ return Qnil;
+}
+
+DEFUN ("set-mouse-position", Fset_mouse_position, 3, 3, 0, /*
+Move the mouse pointer to the center of character cell (X,Y) in WINDOW.
+Note, this is a no-op for an X frame that is not visible.
+If you have just created a frame, you must wait for it to become visible
+before calling this function on it, like this.
+ (while (not (frame-visible-p frame)) (sleep-for .5))
+Note also: Warping the mouse is contrary to the ICCCM, so be very sure
+ that the behavior won't end up being obnoxious!
+*/
+ (window, x, y))
+{
+ struct window *w;
+ int pix_x, pix_y;
+
+ CHECK_WINDOW (window);
+ CHECK_INT (x);
+ CHECK_INT (y);
+
+ /* Warping the mouse will cause EnterNotify and Focus events under X. */
+ w = XWINDOW (window);
+ glyph_to_pixel_translation (w, XINT (x), XINT (y), &pix_x, &pix_y);
+
+ MAYBE_FRAMEMETH (XFRAME (w->frame), set_mouse_position, (w, pix_x, pix_y));
+
+ return Qnil;
+}
+
+DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position, 3, 3, 0, /*
+Move the mouse pointer to pixel position (X,Y) in WINDOW.
+Note, this is a no-op for an X frame that is not visible.
+If you have just created a frame, you must wait for it to become visible
+before calling this function on it, like this.
+ (while (not (frame-visible-p frame)) (sleep-for .5))
+*/
+ (window, x, y))
+{
+ struct window *w;
+
+ CHECK_WINDOW (window);
+ CHECK_INT (x);
+ CHECK_INT (y);
+
+ /* Warping the mouse will cause EnterNotify and Focus events under X. */
+ w = XWINDOW (window);
+ FRAMEMETH (XFRAME (w->frame), set_mouse_position, (w, XINT (x), XINT (y)));
+
+ return Qnil;
+}
+\f
+DEFUN ("make-frame-visible", Fmake_frame_visible, 0, 1, 0, /*
+Make the frame FRAME visible (assuming it is an X-window).
+If omitted, FRAME defaults to the currently selected frame.
+Also raises the frame so that nothing obscures it.
+*/
+ (frame))
+{
+ struct frame *f = decode_frame (frame);
+
+ MAYBE_FRAMEMETH (f, make_frame_visible, (f));
+ return frame;
+}
+
+DEFUN ("make-frame-invisible", Fmake_frame_invisible, 0, 2, 0, /*
+Unconditionally removes frame from the display (assuming it is an X-window).
+If omitted, FRAME defaults to the currently selected frame.
+If what you want to do is iconify the frame (if the window manager uses
+icons) then you should call `iconify-frame' instead.
+Normally you may not make FRAME invisible if all other frames are invisible
+and uniconified, but if the second optional argument FORCE is non-nil,
+you may do so.
+*/
+ (frame, force))
+{
+ struct frame *f, *sel_frame;
+ struct device *d;
+
+ f = decode_frame (frame);
+ d = XDEVICE (FRAME_DEVICE (f));
+ sel_frame = XFRAME (DEVICE_SELECTED_FRAME (d));
+
+ if (NILP (force) && !other_visible_frames (f))
+ error ("Attempt to make invisible the sole visible or iconified frame");
+
+ /* Don't allow minibuf_window to remain on a deleted frame. */
+ if (EQ (f->minibuffer_window, minibuf_window))
+ {
+ Fset_window_buffer (sel_frame->minibuffer_window,
+ XWINDOW (minibuf_window)->buffer);
+ minibuf_window = sel_frame->minibuffer_window;
+ }
+
+ MAYBE_FRAMEMETH (f, make_frame_invisible, (f));
+
+ return Qnil;
+}
+
+DEFUN ("iconify-frame", Ficonify_frame, 0, 1, "", /*
+Make the frame FRAME into an icon, if the window manager supports icons.
+If omitted, FRAME defaults to the currently selected frame.
+*/
+ (frame))
+{
+ struct frame *f, *sel_frame;
+ struct device *d;
+
+ f = decode_frame (frame);
+ d = XDEVICE (FRAME_DEVICE (f));
+ sel_frame = XFRAME (DEVICE_SELECTED_FRAME (d));
+
+ /* Don't allow minibuf_window to remain on a deleted frame. */
+ if (EQ (f->minibuffer_window, minibuf_window))
+ {
+ Fset_window_buffer (sel_frame->minibuffer_window,
+ XWINDOW (minibuf_window)->buffer);
+ minibuf_window = sel_frame->minibuffer_window;
+ }
+
+ MAYBE_FRAMEMETH (f, iconify_frame, (f));
+
+ return Qnil;
+}
+
+DEFUN ("deiconify-frame", Fdeiconify_frame, 0, 1, 0, /*
+Open (de-iconify) the iconified frame FRAME.
+Under X, this is currently the same as `make-frame-visible'.
+If omitted, FRAME defaults to the currently selected frame.
+Also raises the frame so that nothing obscures it.
+*/
+ (frame))
+{
+ return Fmake_frame_visible (frame);
+}
+
+/* FSF returns 'icon for iconized frames. What a crock! */
+
+DEFUN ("frame-visible-p", Fframe_visible_p, 0, 1, 0, /*
+Return non NIL if FRAME is now "visible" (actually in use for display).
+A frame that is not visible is not updated, and, if it works through a
+window system, may not show at all.
+N.B. Under X "visible" means Mapped. It the window is mapped but not
+actually visible on screen then frame_visible returns 'hidden.
+*/
+ (frame))
+{
+ struct frame *f = decode_frame (frame);
+ int visible = FRAMEMETH_OR_GIVEN (f, frame_visible_p, (f), f->visible);
+ return visible ? ( visible > 0 ? Qt : Qhidden ) : Qnil;
+}
+
+DEFUN ("frame-totally-visible-p", Fframe_totally_visible_p, 0, 1, 0, /*
+Return t if frame is not obscured by any other window system windows.
+Always returns t for tty frames.
+*/
+ (frame))
+{
+ struct frame *f = decode_frame (frame);
+ return (FRAMEMETH_OR_GIVEN (f, frame_totally_visible_p, (f), f->visible)
+ ? Qt : Qnil);
+}
+
+DEFUN ("frame-iconified-p", Fframe_iconified_p, 0, 1, 0, /*
+Return t if FRAME is iconified.
+Not all window managers use icons; some merely unmap the window, so this
+function is not the inverse of `frame-visible-p'. It is possible for a
+frame to not be visible and not be iconified either. However, if the
+frame is iconified, it will not be visible.
+*/
+ (frame))
+{
+ struct frame *f = decode_frame (frame);
+ if (f->visible)
+ return Qnil;
+ f->iconified = FRAMEMETH_OR_GIVEN (f, frame_iconified_p, (f), 0);
+ return f->iconified ? Qt : Qnil;
+}
+
+DEFUN ("visible-frame-list", Fvisible_frame_list, 0, 1, 0, /*
+Return a list of all frames now "visible" (being updated).
+If DEVICE is specified only frames on that device will be returned.
+Note that under virtual window managers not all these frame are necessarily
+really updated.
+*/
+ (device))
+{
+ Lisp_Object devcons, concons;
+ struct frame *f;
+ Lisp_Object value;
+
+ value = Qnil;
+
+ DEVICE_LOOP_NO_BREAK (devcons, concons)
+ {
+ assert (DEVICEP (XCAR (devcons)));
+
+ if (NILP (device) || EQ (device, XCAR (devcons)))
+ {
+ Lisp_Object frmcons;
+
+ DEVICE_FRAME_LOOP (frmcons, XDEVICE (XCAR (devcons)))
+ {
+ Lisp_Object frame = XCAR (frmcons);
+ f = XFRAME (frame);
+ if (FRAME_VISIBLE_P(f))
+ value = Fcons (frame, value);
+ }
+ }
+ }
+
+ return value;
+}
+
+\f
+DEFUN ("raise-frame", Fraise_frame, 0, 1, "", /*
+Bring FRAME to the front, so it occludes any frames it overlaps.
+If omitted, FRAME defaults to the currently selected frame.
+If FRAME is invisible, make it visible.
+If Emacs is displaying on an ordinary terminal or some other device which
+doesn't support multiple overlapping frames, this function does nothing.
+*/
+ (frame))
+{
+ struct frame *f = decode_frame (frame);
+
+ /* Do like the documentation says. */
+ Fmake_frame_visible (frame);
+ MAYBE_FRAMEMETH (f, raise_frame, (f));
+ return Qnil;
+}
+
+DEFUN ("lower-frame", Flower_frame, 0, 1, "", /*
+Send FRAME to the back, so it is occluded by any frames that overlap it.
+If omitted, FRAME defaults to the currently selected frame.
+If Emacs is displaying on an ordinary terminal or some other device which
+doesn't support multiple overlapping frames, this function does nothing.
+*/
+ (frame))
+{
+ struct frame *f = decode_frame (frame);
+
+ MAYBE_FRAMEMETH (f, lower_frame, (f));
+ return Qnil;
+}
+
+/* Ben thinks there is no need for `redirect-frame-focus' or `frame-focus',
+ crockish FSFmacs functions. See summary on focus in event-stream.c. */
+
+\f
+/***************************************************************************/
+/* frame properties */
+/***************************************************************************/
+
+static void internal_set_frame_size (struct frame *f, int cols, int rows,
+ int pretend);
+
+static void
+store_minibuf_frame_prop (struct frame *f, Lisp_Object val)
+{
+ Lisp_Object frame;
+ XSETFRAME (frame, f);
+
+ if (WINDOWP (val))
+ {
+ if (! MINI_WINDOW_P (XWINDOW (val)))
+ signal_simple_error
+ ("Surrogate minibuffer windows must be minibuffer windows",
+ val);
+
+ if (FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
+ signal_simple_error
+ ("Can't change the surrogate minibuffer of a frame with its own minibuffer", frame);
+
+ /* Install the chosen minibuffer window, with proper buffer. */
+ f->minibuffer_window = val;
+ }
+ else if (EQ (val, Qt))
+ {
+ if (FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f))
+ signal_simple_error
+ ("Frame already has its own minibuffer", frame);
+ else
+ {
+ setup_normal_frame (f);
+ f->mirror_dirty = 1;
+
+ update_frame_window_mirror (f);
+ internal_set_frame_size (f, f->width, f->height, 1);
+ }
+ }
+}
+
+#if 0
+
+/* possible code if you want to have symbols such as `default-background'
+ map to setting the background of `default', etc. */
+
+static int
+dissect_as_face_setting (Lisp_Object sym, Lisp_Object *face_out,
+ Lisp_Object *face_prop_out)
+{
+ Lisp_Object list = Vbuilt_in_face_specifiers;
+ struct Lisp_String *s;
+
+ if (!SYMBOLP (sym))
+ return 0;
+
+ s = symbol_name (XSYMBOL (sym));
+
+ while (!NILP (list))
+ {
+ Lisp_Object prop = Fcar (list);
+ struct Lisp_String *prop_name;
+
+ if (!SYMBOLP (prop))
+ continue;
+ prop_name = symbol_name (XSYMBOL (prop));
+ if (string_length (s) > string_length (prop_name) + 1
+ && !memcmp (string_data (prop_name),
+ string_data (s) + string_length (s)
+ - string_length (prop_name),
+ string_length (prop_name))
+ && string_data (s)[string_length (s) - string_length (prop_name)
+ - 1] == '-')
+ {
+ Lisp_Object face =
+ Ffind_face (make_string (string_data (s),
+ string_length (s)
+ - string_length (prop_name)
+ - 1));
+ if (!NILP (face))
+ {
+ *face_out = face;
+ *face_prop_out = prop;
+ return 1;
+ }
+ }
+
+ list = Fcdr (list);
+ }
+
+ return 0;
+}
+
+#endif /* 0 */
+
+static Lisp_Object
+get_property_alias (Lisp_Object prop)
+{
+ while (1)
+ {
+ Lisp_Object alias = Qnil;
+
+ if (SYMBOLP (prop))
+ alias = Fget (prop, Qframe_property_alias, Qnil);
+ if (NILP (alias))
+ break;
+ prop = alias;
+ QUIT;
+ }
+
+ return prop;
+}
+
+/* #### Using this to modify the internal border width has no effect
+ because the change isn't propagated to the windows. Are there
+ other properties which this claims to handle, but doesn't?
+
+ But of course. This stuff needs more work, but it's a lot closer
+ to sanity now than before with the horrible frame-params stuff. */
+
+DEFUN ("set-frame-properties", Fset_frame_properties, 2, 2, 0, /*
+Change some properties of a frame.
+PLIST is a property list.
+You can also change frame properties individually using `set-frame-property',
+but it may be more efficient to change many properties at once.
+
+Frame properties can be retrieved using `frame-property' or `frame-properties'.
+
+The following symbols etc. have predefined meanings:
+
+ name Name of the frame. Used with X resources.
+ Unchangeable after creation.
+
+ height Height of the frame, in lines.
+
+ width Width of the frame, in characters.
+
+ minibuffer Gives the minibuffer behavior for this frame. Either
+ t (frame has its own minibuffer), `only' (frame is
+ a minibuffer-only frame), or a window (frame uses that
+ window, which is on another frame, as the minibuffer).
+
+ unsplittable If non-nil, frame cannot be split by `display-buffer'.
+
+ current-display-table, menubar-visible-p, left-margin-width,
+ right-margin-width, minimum-line-ascent, minimum-line-descent,
+ use-left-overflow, use-right-overflow, scrollbar-width, scrollbar-height,
+ default-toolbar, top-toolbar, bottom-toolbar, left-toolbar, right-toolbar,
+ default-toolbar-height, default-toolbar-width, top-toolbar-height,
+ bottom-toolbar-height, left-toolbar-width, right-toolbar-width,
+ default-toolbar-visible-p, top-toolbar-visible-p, bottom-toolbar-visible-p,
+ left-toolbar-visible-p, right-toolbar-visible-p, toolbar-buttons-captioned-p,
+ top-toolbar-border-width, bottom-toolbar-border-width,
+ left-toolbar-border-width, right-toolbar-border-width,
+ modeline-shadow-thickness, has-modeline-p
+ [Giving the name of any built-in specifier variable is
+ equivalent to calling `set-specifier' on the specifier,
+ with a locale of FRAME. Giving the name to `frame-property'
+ calls `specifier-instance' on the specifier.]
+
+ text-pointer-glyph, nontext-pointer-glyph, modeline-pointer-glyph,
+ selection-pointer-glyph, busy-pointer-glyph, toolbar-pointer-glyph,
+ menubar-pointer-glyph, scrollbar-pointer-glyph, gc-pointer-glyph,
+ octal-escape-glyph, control-arrow-glyph, invisible-text-glyph,
+ hscroll-glyph, truncation-glyph, continuation-glyph
+ [Giving the name of any glyph variable is equivalent to
+ calling `set-glyph-image' on the glyph, with a locale
+ of FRAME. Giving the name to `frame-property' calls
+ `glyph-image-instance' on the glyph.]
+
+ [default foreground], [default background], [default font],
+ [modeline foreground], [modeline background], [modeline font],
+ etc.
+ [Giving a vector of a face and a property is equivalent
+ to calling `set-face-property' on the face and property,
+ with a locale of FRAME. Giving the vector to
+ `frame-property' calls `face-property-instance' on the
+ face and property.]
+
+Finally, if a frame property symbol has the property `frame-property-alias'
+on it, then the value will be used in place of that symbol when looking
+up and setting frame property values. This allows you to alias one
+frame property name to another.
+
+See the variables `default-x-frame-plist', `default-tty-frame-plist'
+and `default-mswindows-frame-plist' for a description of the properties
+recognized for particular types of frames.
+*/
+ (frame, plist))
+{
+ struct frame *f = decode_frame (frame);
+ Lisp_Object tail;
+ Lisp_Object *tailp;
+ struct gcpro gcpro1, gcpro2;
+
+ XSETFRAME (frame, f);
+ GCPRO2 (frame, plist);
+ Fcheck_valid_plist (plist);
+ plist = Fcopy_sequence (plist);
+ Fcanonicalize_lax_plist (plist, Qnil);
+ for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail)))
+ {
+ Lisp_Object prop = Fcar (tail);
+ Lisp_Object val = Fcar (Fcdr (tail));
+
+ prop = get_property_alias (prop);
+
+#if 0
+ /* mly wants this, but it's not reasonable to change the name of a
+ frame after it has been created, because the old name was used
+ for resource lookup. */
+ if (EQ (prop, Qname))
+ {
+ CHECK_STRING (val);
+ f->name = val;
+ }
+#endif /* 0 */
+ if (EQ (prop, Qminibuffer))
+ store_minibuf_frame_prop (f, val);
+ if (EQ (prop, Qunsplittable))
+ f->no_split = !NILP (val);
+ if (EQ (prop, Qbuffer_predicate))
+ f->buffer_predicate = val;
+ if (SYMBOLP (prop) && EQ (Fbuilt_in_variable_type (prop),
+ Qconst_specifier))
+ call3 (Qset_specifier, Fsymbol_value (prop), val, frame);
+ if (SYMBOLP (prop) && !NILP (Fget (prop, Qconst_glyph_variable, Qnil)))
+ call3 (Qset_glyph_image, Fsymbol_value (prop), val, frame);
+ if (VECTORP (prop) && XVECTOR_LENGTH (prop) == 2)
+ {
+ Lisp_Object face_prop = XVECTOR_DATA (prop)[1];
+ CHECK_SYMBOL (face_prop);
+ call4 (Qset_face_property,
+ Fget_face (XVECTOR_DATA (prop)[0]),
+ face_prop, val, frame);
+ }
+ }
+
+ MAYBE_FRAMEMETH (f, set_frame_properties, (f, plist));
+ for (tailp = &plist; !NILP (*tailp);)
+ {
+ Lisp_Object *next_tailp;
+ Lisp_Object next;
+ Lisp_Object prop;
+
+ next = Fcdr (*tailp);
+ CHECK_CONS (next);
+ next_tailp = &XCDR (next);
+ prop = Fcar (*tailp);
+
+ prop = get_property_alias (prop);
+
+ if (EQ (prop, Qminibuffer)
+ || EQ (prop, Qunsplittable)
+ || EQ (prop, Qbuffer_predicate)
+ || EQ (prop, Qheight)
+ || EQ (prop, Qwidth)
+ || (SYMBOLP (prop) && EQ (Fbuilt_in_variable_type (prop),
+ Qconst_specifier))
+ || (SYMBOLP (prop) && !NILP (Fget (prop, Qconst_glyph_variable,
+ Qnil)))
+ || (VECTORP (prop) && XVECTOR_LENGTH (prop) == 2)
+ || FRAMEMETH_OR_GIVEN (f, internal_frame_property_p, (f, prop), 0))
+ *tailp = *next_tailp;
+ tailp = next_tailp;
+ }
+
+ f->plist = nconc2 (plist, f->plist);
+ Fcanonicalize_lax_plist (f->plist, Qnil);
+ UNGCPRO;
+ return Qnil;
+}
+
+DEFUN ("frame-property", Fframe_property, 2, 3, 0, /*
+Return FRAME's value for property PROPERTY.
+See `set-frame-properties' for the built-in property names.
+*/
+ (frame, property, default_))
+{
+ struct frame *f = decode_frame (frame);
+ Lisp_Object value;
+
+ XSETFRAME (frame, f);
+
+ property = get_property_alias (property);
+
+ if (EQ (Qname, property)) return f->name;
+
+ if (EQ (Qheight, property) || EQ (Qwidth, property))
+ {
+ if (window_system_pixelated_geometry (frame))
+ {
+ int width, height;
+ pixel_to_real_char_size (f, FRAME_PIXWIDTH (f), FRAME_PIXHEIGHT (f),
+ &width, &height);
+ return make_int (EQ (Qheight, property) ? height: width);
+ }
+ else
+ return make_int (EQ (Qheight, property) ?
+ FRAME_HEIGHT (f) :
+ FRAME_WIDTH (f));
+ }
+
+ /* NOTE: FSF returns Qnil instead of Qt for FRAME_HAS_MINIBUF_P.
+ This is over-the-top bogosity, because it's inconsistent with
+ the semantics of `minibuffer' when passed to `make-frame'.
+ Returning Qt makes things consistent. */
+ if (EQ (Qminibuffer, property))
+ return (FRAME_MINIBUF_ONLY_P (f) ? Qonly :
+ FRAME_HAS_MINIBUF_P (f) ? Qt :
+ FRAME_MINIBUF_WINDOW (f));
+ if (EQ (Qunsplittable, property))
+ return FRAME_NO_SPLIT_P (f) ? Qt : Qnil;
+ if (EQ (Qbuffer_predicate, property))
+ return f->buffer_predicate;
+
+ if (SYMBOLP (property))
+ {
+ if (EQ (Fbuilt_in_variable_type (property), Qconst_specifier))
+ return Fspecifier_instance (Fsymbol_value (property),
+ frame, default_, Qnil);
+ if (!NILP (Fget (property, Qconst_glyph_variable, Qnil)))
+ {
+ Lisp_Object glyph = Fsymbol_value (property);
+ CHECK_GLYPH (glyph);
+ return Fspecifier_instance (XGLYPH_IMAGE (glyph),
+ frame, default_, Qnil);
+ }
+ }
+
+ if (VECTORP (property) && XVECTOR_LENGTH (property) == 2)
+ {
+ Lisp_Object face_prop = XVECTOR_DATA (property)[1];
+ CHECK_SYMBOL (face_prop);
+ return call3 (Qface_property_instance,
+ Fget_face (XVECTOR_DATA (property)[0]),
+ face_prop, frame);
+ }
+
+ if (HAS_FRAMEMETH_P (f, frame_property))
+ if (!UNBOUNDP (value = FRAMEMETH (f, frame_property, (f, property))))
+ return value;
+
+ if (!UNBOUNDP (value = external_plist_get (&f->plist, property, 1, ERROR_ME)))
+ return value;
+
+ return default_;
+}
+
+DEFUN ("frame-properties", Fframe_properties, 0, 1, 0, /*
+Return a property list of the properties of FRAME.
+Do not modify this list; use `set-frame-property' instead.
+*/
+ (frame))
+{
+ struct frame *f = decode_frame (frame);
+ Lisp_Object result = Qnil;
+ struct gcpro gcpro1;
+
+ GCPRO1 (result);
+
+ XSETFRAME (frame, f);
+
+ /* #### for the moment (since old code uses `frame-parameters'),
+ we call `copy-sequence' on f->plist. That allows frame-parameters
+ to destructively convert the plist into an alist, which is more
+ efficient than doing it non-destructively. At some point we
+ should remove the call to copy-sequence. */
+ result = Fcopy_sequence (f->plist);
+
+ /* #### should we be adding all the specifiers and glyphs?
+ That would entail having a list of them all. */
+ if (HAS_FRAMEMETH_P (f, frame_properties))
+ result = nconc2 (FRAMEMETH (f, frame_properties, (f)), result);
+
+ if (!NILP (f->buffer_predicate))
+ result = cons3 (Qbuffer_predicate, f->buffer_predicate, result);
+
+ if (FRAME_NO_SPLIT_P (f))
+ result = cons3 (Qunsplittable, Qt, result);
+
+ /* NOTE: FSF returns Qnil instead of Qt for FRAME_HAS_MINIBUF_P.
+ This is over-the-top bogosity, because it's inconsistent with
+ the semantics of `minibuffer' when passed to `make-frame'.
+ Returning Qt makes things consistent. */
+ result = cons3 (Qminibuffer,
+ (FRAME_MINIBUF_ONLY_P (f) ? Qonly :
+ FRAME_HAS_MINIBUF_P (f) ? Qt :
+ FRAME_MINIBUF_WINDOW (f)),
+ result);
+ {
+ int width, height;
+
+ if (window_system_pixelated_geometry (frame))
+ {
+ pixel_to_real_char_size (f, FRAME_PIXWIDTH (f), FRAME_PIXHEIGHT (f),
+ &width, &height);
+ }
+ else
+ {
+ height = FRAME_HEIGHT (f);
+ width = FRAME_WIDTH (f);
+ }
+ result = cons3 (Qwidth , make_int (width), result);
+ result = cons3 (Qheight, make_int (height), result);
+ }
+
+ result = cons3 (Qname, f->name, result);
+
+ UNGCPRO;
+ return result;
+}
+
+\f
+DEFUN ("frame-pixel-height", Fframe_pixel_height, 0, 1, 0, /*
+Return the height in pixels of FRAME.
+*/
+ (frame))
+{
+ return make_int (decode_frame (frame)->pixheight);
+}
+
+DEFUN ("frame-pixel-width", Fframe_pixel_width, 0, 1, 0, /*
+Return the width in pixels of FRAME.
+*/
+ (frame))
+{
+ return make_int (decode_frame (frame)->pixwidth);
+}
+
+DEFUN ("frame-name", Fframe_name, 0, 1, 0, /*
+Return the name of FRAME (defaulting to the selected frame).
+This is not the same as the `title' of the frame.
+*/
+ (frame))
+{
+ return decode_frame (frame)->name;
+}
+
+DEFUN ("frame-modified-tick", Fframe_modified_tick, 0, 1, 0, /*
+Return FRAME's tick counter, incremented for each change to the frame.
+Each frame has a tick counter which is incremented each time the frame
+is resized, a window is resized, added, or deleted, a face is changed,
+`set-window-buffer' or `select-window' is called on a window in the
+frame, the window-start of a window in the frame has changed, or
+anything else interesting has happened. It wraps around occasionally.
+No argument or nil as argument means use selected frame as FRAME.
+*/
+ (frame))
+{
+ return make_int (decode_frame (frame)->modiff);
+}
+
+static void
+internal_set_frame_size (struct frame *f, int cols, int rows, int pretend)
+{
+ /* An explicit size change cancels any pending frame size adjustment */
+ CLEAR_FRAME_SIZE_SLIPPED(f);
+
+ if (pretend || !HAS_FRAMEMETH_P (f, set_frame_size))
+ change_frame_size (f, rows, cols, 0);
+ else
+ FRAMEMETH (f, set_frame_size, (f, cols, rows));
+}
+
+DEFUN ("set-frame-height", Fset_frame_height, 2, 3, 0, /*
+Specify that the frame FRAME has LINES lines.
+Optional third arg non-nil means that redisplay should use LINES lines
+but that the idea of the actual height of the frame should not be changed.
+*/
+ (frame, rows, pretend))
+{
+ struct frame *f = decode_frame (frame);
+ int height, width;
+ XSETFRAME (frame, f);
+ CHECK_INT (rows);
+
+ if (window_system_pixelated_geometry (frame))
+ {
+ char_to_real_pixel_size (f, 0, XINT (rows), 0, &height);
+ width = FRAME_PIXWIDTH (f);
+ }
+ else
+ {
+ height = XINT (rows);
+ width = FRAME_WIDTH (f);
+ }
+
+ internal_set_frame_size (f, width, height, !NILP (pretend));
+ return frame;
+}
+
+DEFUN ("set-frame-width", Fset_frame_width, 2, 3, 0, /*
+Specify that the frame FRAME has COLS columns.
+Optional third arg non-nil means that redisplay should use COLS columns
+but that the idea of the actual width of the frame should not be changed.
+*/
+ (frame, cols, pretend))
+{
+ struct frame *f = decode_frame (frame);
+ int width, height;
+ XSETFRAME (frame, f);
+ CHECK_INT (cols);
+
+ if (window_system_pixelated_geometry (frame))
+ {
+ char_to_real_pixel_size (f, XINT (cols), 0, &width, 0);
+ height = FRAME_PIXHEIGHT (f);
+ }
+ else
+ {
+ width = XINT (cols);
+ height = FRAME_HEIGHT (f);
+ }
+
+ internal_set_frame_size (f, width, height, !NILP (pretend));
+ return frame;
+}
+
+DEFUN ("set-frame-size", Fset_frame_size, 3, 4, 0, /*
+Set the size of FRAME to COLS by ROWS.
+Optional fourth arg non-nil means that redisplay should use COLS by ROWS
+but that the idea of the actual size of the frame should not be changed.
+*/
+ (frame, cols, rows, pretend))
+{
+ struct frame *f = decode_frame (frame);
+ int height, width;
+ XSETFRAME (frame, f);
+ CHECK_INT (cols);
+ CHECK_INT (rows);
+
+ if (window_system_pixelated_geometry (frame))
+ char_to_real_pixel_size (f, XINT (cols), XINT (rows), &width, &height);
+ else
+ {
+ height = XINT (rows);
+ width = XINT (cols);
+ }
+
+ internal_set_frame_size (f, width, height, !NILP (pretend));
+ return frame;
+}
+
+DEFUN ("set-frame-position", Fset_frame_position, 3, 3, 0, /*
+Set position of FRAME in pixels to XOFFSET by YOFFSET.
+This is actually the position of the upper left corner of the frame.
+Negative values for XOFFSET or YOFFSET are interpreted relative to
+the rightmost or bottommost possible position (that stays within the screen).
+*/
+ (frame, xoffset, yoffset))
+{
+ struct frame *f = decode_frame (frame);
+ CHECK_INT (xoffset);
+ CHECK_INT (yoffset);
+
+ MAYBE_FRAMEMETH (f, set_frame_position, (f, XINT (xoffset), XINT (yoffset)));
+
+ return Qt;
+}
+
+\f
+
+/* Frame size conversion functions moved here from EmacsFrame.c
+ because they're generic and really don't belong in that file.
+ Function get_default_char_pixel_size() removed because it's
+ exactly the same as default_face_height_and_width(). */
+static void
+frame_conversion_internal (struct frame *f, int pixel_to_char,
+ int *pixel_width, int *pixel_height,
+ int *char_width, int *char_height,
+ int real_face)
+{
+ int cpw;
+ int cph;
+ int egw;
+ int obw, obh, bdr;
+ Lisp_Object frame, window;
+
+ XSETFRAME (frame, f);
+ if (real_face)
+ default_face_height_and_width (frame, &cph, &cpw);
+ else
+ default_face_height_and_width_1 (frame, &cph, &cpw);
+
+ 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 (egw, cpw);
+ bdr = 2 * f->internal_border_width;
+ obw = FRAME_SCROLLBAR_WIDTH (f) + FRAME_THEORETICAL_LEFT_TOOLBAR_WIDTH (f) +
+ FRAME_THEORETICAL_RIGHT_TOOLBAR_WIDTH (f) +
+ 2 * FRAME_THEORETICAL_LEFT_TOOLBAR_BORDER_WIDTH (f) +
+ 2 * FRAME_THEORETICAL_RIGHT_TOOLBAR_BORDER_WIDTH (f);
+ obh = FRAME_SCROLLBAR_HEIGHT (f) + FRAME_THEORETICAL_TOP_TOOLBAR_HEIGHT (f) +
+ FRAME_THEORETICAL_BOTTOM_TOOLBAR_HEIGHT (f) +
+ 2 * FRAME_THEORETICAL_TOP_TOOLBAR_BORDER_WIDTH (f) +
+ 2 * FRAME_THEORETICAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f);
+
+ if (pixel_to_char)
+ {
+ if (char_width)
+ *char_width = 1 + ((*pixel_width - egw) - bdr - obw) / cpw;
+ if (char_height)
+ *char_height = (*pixel_height - bdr - obh) / cph;
+ }
+ else
+ {
+ if (pixel_width)
+ *pixel_width = (*char_width - 1) * cpw + egw + bdr + obw;
+ if (pixel_height)
+ *pixel_height = *char_height * cph + bdr + obh;
+ }
+}
+
+/* This takes the size in pixels of the text area, and returns the number
+ of characters that will fit there, taking into account the internal
+ border width, and the pixel width of the line terminator glyphs (which
+ always count as one "character" wide, even if they are not the same size
+ as the default character size of the default font). The frame scrollbar
+ width and left and right toolbar widths are also subtracted out of the
+ available width. The frame scrollbar height and top and bottom toolbar
+ heights are subtracted out of the available height.
+
+ Therefore the result is not necessarily a multiple of anything in
+ particular. */
+void
+pixel_to_char_size (struct frame *f, int pixel_width, int pixel_height,
+ int *char_width, int *char_height)
+{
+ frame_conversion_internal (f, 1, &pixel_width, &pixel_height, char_width,
+ char_height, 0);
+}
+
+/* Given a character size, this returns the minimum number of pixels
+ necessary to display that many characters, taking into account the
+ internal border width, scrollbar height and width, toolbar heights and
+ widths and the size of the line terminator glyphs (assuming the line
+ terminators take up exactly one character position).
+
+ Therefore the result is not necessarily a multiple of anything in
+ particular. */
+void
+char_to_pixel_size (struct frame *f, int char_width, int char_height,
+ int *pixel_width, int *pixel_height)
+{
+ frame_conversion_internal (f, 0, pixel_width, pixel_height, &char_width,
+ &char_height, 0);
+}
+
+/* Given a pixel size, rounds DOWN to the smallest size in pixels necessary
+ to display the same number of characters as are displayable now.
+ */
+void
+round_size_to_char (struct frame *f, int in_width, int in_height,
+ int *out_width, int *out_height)
+{
+ int char_width;
+ int char_height;
+ pixel_to_char_size (f, in_width, in_height, &char_width, &char_height);
+ char_to_pixel_size (f, char_width, char_height, out_width, out_height);
+}
+
+/* Versions of the above which always account for real font metrics.
+ */
+void
+pixel_to_real_char_size (struct frame *f, int pixel_width, int pixel_height,
+ int *char_width, int *char_height)
+{
+ frame_conversion_internal (f, 1, &pixel_width, &pixel_height, char_width,
+ char_height, 1);
+}
+
+void
+char_to_real_pixel_size (struct frame *f, int char_width, int char_height,
+ int *pixel_width, int *pixel_height)
+{
+ frame_conversion_internal (f, 0, pixel_width, pixel_height, &char_width,
+ &char_height, 1);
+}
+
+void
+round_size_to_real_char (struct frame *f, int in_width, int in_height,
+ int *out_width, int *out_height)
+{
+ int char_width;
+ int char_height;
+ pixel_to_real_char_size (f, in_width, in_height, &char_width, &char_height);
+ char_to_real_pixel_size (f, char_width, char_height, out_width, out_height);
+}
+
+/* Change the frame height and/or width. Values may be given as zero to
+ indicate no change is to take place. */
+static void
+change_frame_size_1 (struct frame *f, int newheight, int newwidth)
+{
+ Lisp_Object frame;
+ int new_pixheight, new_pixwidth;
+ int font_height, real_font_height, font_width;
+
+ /* #### Chuck -- shouldn't we be checking to see if the frame
+ is being "changed" to its existing size, and do nothing if so? */
+ /* No, because it would hose toolbar updates. The toolbar
+ update code relies on this function to cause window `top' and
+ `left' coordinates to be recomputed even though no frame size
+ change occurs. --kyle */
+ if (in_display)
+ abort ();
+
+ XSETFRAME (frame, f);
+
+ default_face_height_and_width (frame, &real_font_height, 0);
+ default_face_height_and_width_1 (frame, &font_height, &font_width);
+
+ /* This size-change overrides any pending one for this frame. */
+ FRAME_NEW_HEIGHT (f) = 0;
+ FRAME_NEW_WIDTH (f) = 0;
+
+ new_pixheight = newheight * font_height;
+ new_pixwidth = (newwidth - 1) * font_width;
+
+ /* #### dependency on FRAME_WIN_P should be removed. */
+ if (FRAME_WIN_P (f))
+ {
+ new_pixheight += FRAME_SCROLLBAR_HEIGHT (f);
+ new_pixwidth += FRAME_SCROLLBAR_WIDTH (f);
+ }
+
+ /* when frame_conversion_internal() calculated the number of rows/cols
+ in the frame, the theoretical toolbar sizes were subtracted out.
+ The caluclations below adjust for real toolbar height/width in
+ frame, which may be different from frame spec, taking the above
+ fact into account */
+ new_pixheight +=
+ + FRAME_THEORETICAL_TOP_TOOLBAR_HEIGHT (f)
+ + 2 * FRAME_THEORETICAL_TOP_TOOLBAR_BORDER_WIDTH (f)
+ - FRAME_REAL_TOP_TOOLBAR_HEIGHT (f)
+ - 2 * FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f);
+
+ new_pixheight +=
+ + FRAME_THEORETICAL_BOTTOM_TOOLBAR_HEIGHT (f)
+ + 2 * FRAME_THEORETICAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f)
+ - FRAME_REAL_BOTTOM_TOOLBAR_HEIGHT (f)
+ - 2 * FRAME_REAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f);
+
+ new_pixwidth +=
+ + FRAME_THEORETICAL_LEFT_TOOLBAR_WIDTH (f)
+ + 2 * FRAME_THEORETICAL_LEFT_TOOLBAR_BORDER_WIDTH (f)
+ - FRAME_REAL_LEFT_TOOLBAR_WIDTH (f)
+ - 2 * FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f);
+
+ new_pixwidth +=
+ + FRAME_THEORETICAL_RIGHT_TOOLBAR_WIDTH (f)
+ + 2 * FRAME_THEORETICAL_RIGHT_TOOLBAR_BORDER_WIDTH (f)
+ - FRAME_REAL_RIGHT_TOOLBAR_WIDTH (f)
+ - 2 * FRAME_REAL_RIGHT_TOOLBAR_BORDER_WIDTH (f);
+
+ /* Adjust the width for the end glyph which may be a different width
+ than the default character width. */
+ {
+ int adjustment, trunc_width, cont_width;
+
+ trunc_width = glyph_width (Vtruncation_glyph, Vdefault_face, 0,
+ FRAME_SELECTED_WINDOW (f));
+ cont_width = glyph_width (Vcontinuation_glyph, Vdefault_face, 0,
+ FRAME_SELECTED_WINDOW (f));
+ adjustment = max (trunc_width, cont_width);
+ adjustment = max (adjustment, font_width);
+
+ new_pixwidth += adjustment;
+ }
+
+ /* If we don't have valid values, exit. */
+ if (!new_pixheight && !new_pixwidth)
+ return;
+
+ if (new_pixheight)
+ {
+ XWINDOW (FRAME_ROOT_WINDOW (f))->pixel_top = FRAME_TOP_BORDER_END (f);
+
+ if (FRAME_HAS_MINIBUF_P (f)
+ && ! FRAME_MINIBUF_ONLY_P (f))
+ /* Frame has both root and minibuffer. */
+ {
+ /*
+ * Leave the minibuffer height the same if the frame has
+ * been initialized, and the minibuffer height is tall
+ * enough to display at least one line of text in the default
+ * font, and the old minibuffer height is a multiple of the
+ * default font height. This should cause the minibuffer
+ * height to be recomputed on font changes but not for
+ * other frame size changes, which seems reasonable.
+ */
+ int old_minibuf_height =
+ XWINDOW(FRAME_MINIBUF_WINDOW(f))->pixel_height;
+ int minibuf_height =
+ f->init_finished && (old_minibuf_height % real_font_height) == 0 ?
+ max(old_minibuf_height, real_font_height) :
+ real_font_height;
+ set_window_pixheight (FRAME_ROOT_WINDOW (f),
+ /* - font_height for minibuffer */
+ new_pixheight - minibuf_height, 0);
+
+ XWINDOW (FRAME_MINIBUF_WINDOW (f))->pixel_top =
+ new_pixheight - minibuf_height + FRAME_TOP_BORDER_END (f);
+
+ set_window_pixheight (FRAME_MINIBUF_WINDOW (f), minibuf_height, 0);
+ }
+ else
+ /* Frame has just one top-level window. */
+ set_window_pixheight (FRAME_ROOT_WINDOW (f), new_pixheight, 0);
+
+ FRAME_HEIGHT (f) = newheight;
+ if (FRAME_TTY_P (f))
+ f->pixheight = newheight;
+ }
+
+ if (new_pixwidth)
+ {
+ XWINDOW (FRAME_ROOT_WINDOW (f))->pixel_left = FRAME_LEFT_BORDER_END (f);
+ set_window_pixwidth (FRAME_ROOT_WINDOW (f), new_pixwidth, 0);
+
+ if (FRAME_HAS_MINIBUF_P (f))
+ {
+ XWINDOW (FRAME_MINIBUF_WINDOW (f))->pixel_left =
+ FRAME_LEFT_BORDER_END (f);
+ set_window_pixwidth (FRAME_MINIBUF_WINDOW (f), new_pixwidth, 0);
+ }
+
+ FRAME_WIDTH (f) = newwidth;
+ if (FRAME_TTY_P (f))
+ f->pixwidth = newwidth;
+ }
+
+ if (window_system_pixelated_geometry (frame))
+ pixel_to_real_char_size (f, FRAME_PIXWIDTH (f), FRAME_PIXHEIGHT (f),
+ &FRAME_CHARWIDTH (f), &FRAME_CHARHEIGHT (f));
+ else
+ {
+ FRAME_CHARWIDTH (f) = FRAME_WIDTH (f);
+ FRAME_CHARHEIGHT (f) = FRAME_HEIGHT (f);
+ }
+
+ MARK_FRAME_TOOLBARS_CHANGED (f);
+ MARK_FRAME_CHANGED (f);
+ f->echo_area_garbaged = 1;
+}
+
+void
+change_frame_size (struct frame *f, int newheight, int newwidth, int delay)
+{
+ /* sometimes we get passed a size that's too small (esp. when a
+ client widget gets resized, since we have no control over this).
+ So deal. */
+ check_frame_size (f, &newheight, &newwidth);
+
+ if (delay || in_display || gc_in_progress)
+ {
+ MARK_FRAME_SIZE_CHANGED (f);
+ f->new_width = newwidth;
+ f->new_height = newheight;
+ return;
+ }
+
+ f->size_change_pending = 0;
+ /* For TTY frames, it's like one, like all ...
+ Can't have two TTY frames of different sizes on the same device. */
+ if (FRAME_TTY_P (f))
+ {
+ Lisp_Object frmcons;
+
+ DEVICE_FRAME_LOOP (frmcons, XDEVICE (FRAME_DEVICE (f)))
+ change_frame_size_1 (XFRAME (XCAR (frmcons)), newheight, newwidth);
+ }
+ else
+ change_frame_size_1 (f, newheight, newwidth);
+}
+
+\f
+void
+update_frame_title (struct frame *f)
+{
+ struct window *w = XWINDOW (FRAME_SELECTED_WINDOW (f));
+ Lisp_Object title_format;
+ Lisp_Object icon_format;
+ Bufbyte *title;
+
+ /* We don't change the title for the minibuffer unless the frame
+ only has a minibuffer. */
+ if (MINI_WINDOW_P (w) && !FRAME_MINIBUF_ONLY_P (f))
+ return;
+
+ /* And we don't want dead buffers to blow up on us. */
+ if (!BUFFER_LIVE_P (XBUFFER (w->buffer)))
+ return;
+
+ title = NULL;
+ title_format = symbol_value_in_buffer (Qframe_title_format, w->buffer);
+ icon_format = symbol_value_in_buffer (Qframe_icon_title_format, w->buffer);
+
+ if (HAS_FRAMEMETH_P (f, set_title_from_bufbyte))
+ {
+ title = generate_formatted_string (w, title_format, Qnil,
+ DEFAULT_INDEX, CURRENT_DISP);
+ FRAMEMETH (f, set_title_from_bufbyte, (f, title));
+ }
+
+ if (HAS_FRAMEMETH_P (f, set_icon_name_from_bufbyte))
+ {
+ if (!EQ (icon_format, title_format) || !title)
+ {
+ if (title)
+ xfree (title);
+
+ title = generate_formatted_string (w, icon_format, Qnil,
+ DEFAULT_INDEX, CURRENT_DISP);
+ }
+ FRAMEMETH (f, set_icon_name_from_bufbyte, (f, title));
+ }
+
+ if (title)
+ xfree (title);
+}
+
+\f
+DEFUN ("set-frame-pointer", Fset_frame_pointer, 2, 2, 0, /*
+Set the mouse pointer of FRAME to the given pointer image instance.
+You should not call this function directly. Instead, set one of
+the variables `text-pointer-glyph', `nontext-pointer-glyph',
+`modeline-pointer-glyph', `selection-pointer-glyph',
+`busy-pointer-glyph', or `toolbar-pointer-glyph'.
+*/
+ (frame, image_instance))
+{
+ struct frame *f = decode_frame (frame);
+ CHECK_POINTER_IMAGE_INSTANCE (image_instance);
+ if (!EQ (f->pointer, image_instance))
+ {
+ f->pointer = image_instance;
+ MAYBE_FRAMEMETH (f, set_frame_pointer, (f));
+ }
+ return Qnil;
+}
+
+\f
+void
+update_frame_icon (struct frame *f)
+{
+ if (f->icon_changed || f->windows_changed)
+ {
+ Lisp_Object frame;
+ Lisp_Object new_icon;
+
+ XSETFRAME (frame, f);
+ new_icon = glyph_image_instance (Vframe_icon_glyph, frame,
+ ERROR_ME_WARN, 0);
+ if (!EQ (new_icon, f->icon))
+ {
+ f->icon = new_icon;
+ MAYBE_FRAMEMETH (f, set_frame_icon, (f));
+ }
+ }
+
+ f->icon_changed = 0;
+}
+
+static void
+icon_glyph_changed (Lisp_Object glyph, Lisp_Object property,
+ Lisp_Object locale)
+{
+ MARK_ICON_CHANGED;
+}
+
+\f
+void
+syms_of_frame (void)
+{
+ defsymbol (&Qdelete_frame_hook, "delete-frame-hook");
+ defsymbol (&Qselect_frame_hook, "select-frame-hook");
+ defsymbol (&Qdeselect_frame_hook, "deselect-frame-hook");
+ defsymbol (&Qcreate_frame_hook, "create-frame-hook");
+ defsymbol (&Qcustom_initialize_frame, "custom-initialize-frame");
+ defsymbol (&Qmouse_enter_frame_hook, "mouse-enter-frame-hook");
+ defsymbol (&Qmouse_leave_frame_hook, "mouse-leave-frame-hook");
+ defsymbol (&Qmap_frame_hook, "map-frame-hook");
+ defsymbol (&Qunmap_frame_hook, "unmap-frame-hook");
+
+ 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");
+ defsymbol (&Qframe_being_created, "frame-being-created");
+ defsymbol (&Qmake_initial_minibuffer_frame, "make-initial-minibuffer-frame");
+
+ defsymbol (&Qframe_title_format, "frame-title-format");
+ defsymbol (&Qframe_icon_title_format, "frame-icon-title-format");
+
+ defsymbol (&Qhidden, "hidden");
+ defsymbol (&Qvisible, "visible");
+ defsymbol (&Qiconic, "iconic");
+ defsymbol (&Qinvisible, "invisible");
+ defsymbol (&Qvisible_iconic, "visible-iconic");
+ defsymbol (&Qinvisible_iconic, "invisible-iconic");
+ defsymbol (&Qnomini, "nomini");
+ defsymbol (&Qvisible_nomini, "visible-nomini");
+ defsymbol (&Qiconic_nomini, "iconic-nomini");
+ defsymbol (&Qinvisible_nomini, "invisible-nomini");
+ defsymbol (&Qvisible_iconic_nomini, "visible-iconic-nomini");
+ defsymbol (&Qinvisible_iconic_nomini, "invisible-iconic-nomini");
+
+ defsymbol (&Qminibuffer, "minibuffer");
+ defsymbol (&Qunsplittable, "unsplittable");
+ defsymbol (&Qinternal_border_width, "internal-border-width");
+ defsymbol (&Qtop_toolbar_shadow_color, "top-toolbar-shadow-color");
+ defsymbol (&Qbottom_toolbar_shadow_color, "bottom-toolbar-shadow-color");
+ defsymbol (&Qbackground_toolbar_color, "background-toolbar-color");
+ defsymbol (&Qtop_toolbar_shadow_pixmap, "top-toolbar-shadow-pixmap");
+ defsymbol (&Qbottom_toolbar_shadow_pixmap, "bottom-toolbar-shadow-pixmap");
+ defsymbol (&Qtoolbar_shadow_thickness, "toolbar-shadow-thickness");
+ defsymbol (&Qscrollbar_placement, "scrollbar-placement");
+ defsymbol (&Qinter_line_space, "inter-line-space");
+ /* Qiconic already in this function. */
+ defsymbol (&Qvisual_bell, "visual-bell");
+ defsymbol (&Qbell_volume, "bell-volume");
+ defsymbol (&Qpointer_background, "pointer-background");
+ defsymbol (&Qpointer_color, "pointer-color");
+ defsymbol (&Qtext_pointer, "text-pointer");
+ defsymbol (&Qspace_pointer, "space-pointer");
+ defsymbol (&Qmodeline_pointer, "modeline-pointer");
+ defsymbol (&Qgc_pointer, "gc-pointer");
+ defsymbol (&Qinitially_unmapped, "initially-unmapped");
+ defsymbol (&Quse_backing_store, "use-backing-store");
+ defsymbol (&Qborder_color, "border-color");
+ defsymbol (&Qborder_width, "border-width");
+ /* Qwidth, Qheight, Qleft, Qtop in general.c */
+ defsymbol (&Qset_specifier, "set-specifier");
+ defsymbol (&Qset_glyph_image, "set-glyph-image");
+ defsymbol (&Qset_face_property, "set-face-property");
+ defsymbol (&Qface_property_instance, "face-property-instance");
+ defsymbol (&Qframe_property_alias, "frame-property-alias");
+
+ DEFSUBR (Fmake_frame);
+ DEFSUBR (Fframep);
+ DEFSUBR (Fframe_live_p);
+#if 0 /* FSFmacs */
+ DEFSUBR (Fignore_event);
+#endif
+ DEFSUBR (Ffocus_frame);
+ DEFSUBR (Fselect_frame);
+ DEFSUBR (Fselected_frame);
+ DEFSUBR (Factive_minibuffer_window);
+ DEFSUBR (Flast_nonminibuf_frame);
+ DEFSUBR (Fframe_root_window);
+ DEFSUBR (Fframe_selected_window);
+ DEFSUBR (Fset_frame_selected_window);
+ DEFSUBR (Fframe_device);
+ DEFSUBR (Fnext_frame);
+ DEFSUBR (Fprevious_frame);
+ DEFSUBR (Fdelete_frame);
+ DEFSUBR (Fmouse_position);
+ DEFSUBR (Fmouse_pixel_position);
+ DEFSUBR (Fmouse_position_as_motion_event);
+ DEFSUBR (Fset_mouse_position);
+ DEFSUBR (Fset_mouse_pixel_position);
+ DEFSUBR (Fmake_frame_visible);
+ DEFSUBR (Fmake_frame_invisible);
+ DEFSUBR (Ficonify_frame);
+ DEFSUBR (Fdeiconify_frame);
+ DEFSUBR (Fframe_visible_p);
+ DEFSUBR (Fframe_totally_visible_p);
+ DEFSUBR (Fframe_iconified_p);
+ DEFSUBR (Fvisible_frame_list);
+ DEFSUBR (Fraise_frame);
+ DEFSUBR (Flower_frame);
+ DEFSUBR (Fframe_property);
+ DEFSUBR (Fframe_properties);
+ DEFSUBR (Fset_frame_properties);
+ DEFSUBR (Fframe_pixel_height);
+ DEFSUBR (Fframe_pixel_width);
+ DEFSUBR (Fframe_name);
+ DEFSUBR (Fframe_modified_tick);
+ DEFSUBR (Fset_frame_height);
+ DEFSUBR (Fset_frame_width);
+ DEFSUBR (Fset_frame_size);
+ DEFSUBR (Fset_frame_position);
+ DEFSUBR (Fset_frame_pointer);
+}
+
+void
+vars_of_frame (void)
+{
+ /* */
+ Vframe_being_created = Qnil;
+ staticpro (&Vframe_being_created);
+
+#ifdef HAVE_CDE
+ Fprovide (intern ("cde"));
+#endif
+
+#ifdef HAVE_OFFIX_DND
+ Fprovide (intern ("offix"));
+#endif
+
+#if 0 /* FSFmacs stupidity */
+ xxDEFVAR_LISP ("emacs-iconified", &Vemacs_iconified /*
+Non-nil if all of emacs is iconified and frame updates are not needed.
+*/ );
+ Vemacs_iconified = Qnil;
+#endif
+
+ DEFVAR_LISP ("select-frame-hook", &Vselect_frame_hook /*
+Function or functions to run just after a new frame is given the focus.
+Note that calling `select-frame' does not necessarily set the focus:
+The actual window-system focus will not be changed until the next time
+that XEmacs is waiting for an event, and even then, the window manager
+may refuse the focus-change request.
+*/ );
+ Vselect_frame_hook = Qnil;
+
+ DEFVAR_LISP ("deselect-frame-hook", &Vdeselect_frame_hook /*
+Function or functions to run just before a frame loses the focus.
+See `select-frame-hook'.
+*/ );
+ Vdeselect_frame_hook = Qnil;
+
+ DEFVAR_LISP ("delete-frame-hook", &Vdelete_frame_hook /*
+Function or functions to call when a frame is deleted.
+One argument, the about-to-be-deleted frame.
+*/ );
+ Vdelete_frame_hook = Qnil;
+
+ DEFVAR_LISP ("create-frame-hook", &Vcreate_frame_hook /*
+Function or functions to call when a frame is created.
+One argument, the newly-created frame.
+*/ );
+ Vcreate_frame_hook = Qnil;
+
+ DEFVAR_LISP ("mouse-enter-frame-hook", &Vmouse_enter_frame_hook /*
+Function or functions to call when the mouse enters a frame.
+One argument, the frame.
+Be careful not to make assumptions about the window manager's focus model.
+In most cases, the `deselect-frame-hook' is more appropriate.
+*/ );
+ Vmouse_enter_frame_hook = Qnil;
+
+ DEFVAR_LISP ("mouse-leave-frame-hook", &Vmouse_leave_frame_hook /*
+Function or functions to call when the mouse leaves a frame.
+One argument, the frame.
+Be careful not to make assumptions about the window manager's focus model.
+In most cases, the `select-frame-hook' is more appropriate.
+*/ );
+ Vmouse_leave_frame_hook = Qnil;
+
+ DEFVAR_LISP ("map-frame-hook", &Vmap_frame_hook /*
+Function or functions to call when a frame is mapped.
+One argument, the frame.
+*/ );
+ Vmap_frame_hook = Qnil;
+
+ DEFVAR_LISP ("unmap-frame-hook", &Vunmap_frame_hook /*
+Function or functions to call when a frame is unmapped.
+One argument, the frame.
+*/ );
+ Vunmap_frame_hook = Qnil;
+
+ DEFVAR_BOOL ("allow-deletion-of-last-visible-frame",
+ &allow_deletion_of_last_visible_frame /*
+*Non-nil means to assume the force option to delete-frame.
+*/ );
+ allow_deletion_of_last_visible_frame = 0;
+
+ DEFVAR_LISP ("adjust-frame-function", &Vadjust_frame_function /*
+Function or constant controlling adjustment of frame.
+When scrollbars, toolbars, default font etc. change in frame, the frame
+needs to be adjusted. The adjustment is controlled by this variable.
+Legal values are:
+ nil to keep character frame size unchanged when possible (resize)
+ t to keep pixel size unchanged (never resize)
+ function symbol or lambda form. This function must return boolean
+ value which is treated as above. Function is passed one parameter,
+ the frame being adjusted. It function should not modify or delete
+ the frame.
+*/ );
+ Vadjust_frame_function = Qnil;
+
+ DEFVAR_LISP ("mouse-motion-handler", &Vmouse_motion_handler /*
+Handler for motion events. One arg, the event.
+For most applications, you should use `mode-motion-hook' instead of this.
+*/ );
+ Vmouse_motion_handler = Qnil;
+
+ DEFVAR_LISP ("synchronize-minibuffers",&Vsynchronize_minibuffers /*
+Set to t if all minibuffer windows are to be synchronized.
+This will cause echo area messages to appear in the minibuffers of all
+visible frames.
+*/ );
+ Vsynchronize_minibuffers = Qnil;
+
+ DEFVAR_LISP ("frame-title-format", &Vframe_title_format /*
+Controls the title of the X window corresponding to the selected frame.
+This is the same format as `modeline-format' with the exception that
+%- is ignored.
+*/ );
+ Vframe_title_format = Fpurecopy (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"));
+
+ DEFVAR_LISP ("default-frame-name", &Vdefault_frame_name /*
+The default name to assign to newly-created frames.
+This can be overridden by arguments to `make-frame'.
+This must be a string.
+*/ );
+#ifndef INFODOCK
+ Vdefault_frame_name = Fpurecopy (build_string ("emacs"));
+#else
+ Vdefault_frame_name = Fpurecopy (build_string ("InfoDock"));
+#endif
+
+ DEFVAR_LISP ("default-frame-plist", &Vdefault_frame_plist /*
+Plist of default values for frame creation, other than the first one.
+These may be set in your init file, like this:
+
+ \(setq default-frame-plist '(width 80 height 55))
+
+The properties may be in alist format for backward compatibility
+but you should not rely on this behavior.
+
+These override values given in window system configuration data,
+ including X Windows' defaults database.
+
+Since the first X frame is created before loading your .emacs file,
+you must use the X resource database for that.
+
+For values specific to the first Emacs frame, see `initial-frame-plist'.
+For values specific to the separate minibuffer frame, see
+ `minibuffer-frame-plist'.
+
+See also the variables `default-x-frame-plist' and
+`default-tty-frame-plist', which are like `default-frame-plist'
+except that they apply only to X or tty frames, respectively
+\(whereas `default-frame-plist' applies to all types of frames).
+*/ );
+ Vdefault_frame_plist = Qnil;
+
+ DEFVAR_LISP ("frame-icon-glyph", &Vframe_icon_glyph /*
+Icon glyph used to iconify a frame.
+*/ );
+}
+
+void
+complex_vars_of_frame (void)
+{
+ Vframe_icon_glyph = allocate_glyph (GLYPH_ICON, icon_glyph_changed);
+}
--- /dev/null
+/* EImage-specific Lisp objects.
+ Copyright (C) 1993, 1994, 1998 Free Software Foundation, Inc.
+ Copyright (C) 1995 Board of Trustees, University of Illinois.
+ Copyright (C) 1995 Tinker Systems
+ Copyright (C) 1995, 1996 Ben Wing
+ 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. */
+
+/* Synched up with: Not in FSF. */
+
+/* Original author: Jamie Zawinski for 19.8
+ font-truename stuff added by Jamie Zawinski for 19.10
+ subwindow support added by Chuck Thompson
+ additional XPM support added by Chuck Thompson
+ initial X-Face support added by Stig
+ rewritten/restructured by Ben Wing for 19.12/19.13
+ GIF/JPEG support added by Ben Wing for 19.14
+ PNG support added by Bill Perry for 19.14
+ Improved GIF/JPEG support added by Bill Perry for 19.14
+ Cleanup/simplification of error handling by Ben Wing for 19.14
+ Pointer/icon overhaul, more restructuring by Ben Wing for 19.14
+ GIF support changed to external Gifreader lib by Jareth Hein for 21.0
+ 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
+ Generalization for ms-windows by Andy Piper for 21.0
+ TODO:
+ Convert images.el to C and stick it in here?
+ */
+
+#include <config.h>
+#include "lisp.h"
+#include "lstream.h"
+#include "console.h"
+#include "device.h"
+#include "glyphs.h"
+#include "objects.h"
+
+#include "buffer.h"
+#include "frame.h"
+#include "insdel.h"
+#include "opaque.h"
+
+#include "imgproc.h"
+#include "sysfile.h"
+
+#ifdef HAVE_PNG
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include <png.h>
+#ifdef __cplusplus
+}
+#endif
+#else
+#include <setjmp.h>
+#endif
+#ifdef FILE_CODING
+#include "file-coding.h"
+#endif
+
+#if INTBITS == 32
+# define FOUR_BYTE_TYPE unsigned int
+#elif LONGBITS == 32
+# define FOUR_BYTE_TYPE unsigned long
+#elif SHORTBITS == 32
+# define FOUR_BYTE_TYPE unsigned short
+#else
+#error What kind of strange-ass system are we running on?
+#endif
+
+#ifdef HAVE_TIFF
+DEFINE_IMAGE_INSTANTIATOR_FORMAT (tiff);
+Lisp_Object Qtiff;
+#endif
+
+#ifdef HAVE_JPEG
+DEFINE_IMAGE_INSTANTIATOR_FORMAT (jpeg);
+Lisp_Object Qjpeg;
+#endif
+
+#ifdef HAVE_GIF
+DEFINE_IMAGE_INSTANTIATOR_FORMAT (gif);
+Lisp_Object Qgif;
+#endif
+
+#ifdef HAVE_PNG
+DEFINE_IMAGE_INSTANTIATOR_FORMAT (png);
+Lisp_Object Qpng;
+#endif
+
+\f
+#ifdef HAVE_JPEG
+
+/**********************************************************************
+ * JPEG *
+ **********************************************************************/
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include <jpeglib.h>
+#include <jerror.h>
+#ifdef __cplusplus
+}
+#endif
+
+/*#define USE_TEMP_FILES_FOR_JPEG_IMAGES 1*/
+static void
+jpeg_validate (Lisp_Object instantiator)
+{
+ file_or_data_must_be_present (instantiator);
+}
+
+static Lisp_Object
+jpeg_normalize (Lisp_Object inst, Lisp_Object console_type)
+{
+ return simple_image_type_normalize (inst, console_type, Qjpeg);
+}
+
+static int
+jpeg_possible_dest_types (void)
+{
+ return IMAGE_COLOR_PIXMAP_MASK;
+}
+
+/* To survive the otherwise baffling complexity of making sure
+ everything gets cleaned up in the presence of an error, we
+ use an unwind_protect(). */
+
+struct jpeg_unwind_data
+{
+ /* Stream that we need to close */
+ FILE *instream;
+ /* Object that holds state info for JPEG decoding */
+ struct jpeg_decompress_struct *cinfo_ptr;
+ /* EImage data */
+ unsigned char *eimage;
+};
+
+static Lisp_Object
+jpeg_instantiate_unwind (Lisp_Object unwind_obj)
+{
+ struct jpeg_unwind_data *data =
+ (struct jpeg_unwind_data *) get_opaque_ptr (unwind_obj);
+
+ free_opaque_ptr (unwind_obj);
+ if (data->cinfo_ptr)
+ jpeg_destroy_decompress (data->cinfo_ptr);
+
+ if (data->instream)
+ fclose (data->instream);
+
+ if (data->eimage) xfree (data->eimage);
+
+ return Qnil;
+}
+
+/*
+ * ERROR HANDLING:
+ *
+ * The JPEG library's standard error handler (jerror.c) is divided into
+ * several "methods" which you can override individually. This lets you
+ * adjust the behavior without duplicating a lot of code, which you might
+ * have to update with each future release.
+ *
+ * Our example here shows how to override the "error_exit" method so that
+ * control is returned to the library's caller when a fatal error occurs,
+ * rather than calling exit() as the standard error_exit method does.
+ *
+ * We use C's setjmp/longjmp facility to return control. This means that the
+ * routine which calls the JPEG library must first execute a setjmp() call to
+ * establish the return point. We want the replacement error_exit to do a
+ * longjmp(). But we need to make the setjmp buffer accessible to the
+ * error_exit routine. To do this, we make a private extension of the
+ * standard JPEG error handler object. (If we were using C++, we'd say we
+ * were making a subclass of the regular error handler.)
+ *
+ * Here's the extended error handler struct:
+ */
+
+struct my_jpeg_error_mgr
+{
+ struct jpeg_error_mgr pub; /* "public" fields */
+ jmp_buf setjmp_buffer; /* for return to caller */
+};
+
+#if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
+METHODDEF(void)
+#else
+METHODDEF void
+#endif
+our_init_source (j_decompress_ptr cinfo)
+{
+}
+
+#if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
+METHODDEF(boolean)
+#else
+METHODDEF boolean
+#endif
+our_fill_input_buffer (j_decompress_ptr cinfo)
+{
+ /* Insert a fake EOI marker */
+ struct jpeg_source_mgr *src = cinfo->src;
+ static JOCTET buffer[2];
+
+ buffer[0] = (JOCTET) 0xFF;
+ buffer[1] = (JOCTET) JPEG_EOI;
+
+ src->next_input_byte = buffer;
+ src->bytes_in_buffer = 2;
+ return TRUE;
+}
+
+#if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
+METHODDEF(void)
+#else
+METHODDEF void
+#endif
+our_skip_input_data (j_decompress_ptr cinfo, long num_bytes)
+{
+ struct jpeg_source_mgr *src = NULL;
+
+ src = (struct jpeg_source_mgr *) cinfo->src;
+
+ if (!src)
+ {
+ return;
+ } else if (num_bytes > src->bytes_in_buffer)
+ {
+ ERREXIT(cinfo, JERR_INPUT_EOF);
+ /*NOTREACHED*/
+ }
+
+ src->bytes_in_buffer -= num_bytes;
+ src->next_input_byte += num_bytes;
+}
+
+#if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
+METHODDEF(void)
+#else
+METHODDEF void
+#endif
+our_term_source (j_decompress_ptr cinfo)
+{
+}
+
+typedef struct
+{
+ struct jpeg_source_mgr pub;
+} our_jpeg_source_mgr;
+
+static void
+jpeg_memory_src (j_decompress_ptr cinfo, JOCTET *data, unsigned int len)
+{
+ struct jpeg_source_mgr *src;
+
+ if (cinfo->src == NULL)
+ { /* first time for this JPEG object? */
+ cinfo->src = (struct jpeg_source_mgr *)
+ (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
+ sizeof(our_jpeg_source_mgr));
+ src = (struct jpeg_source_mgr *) cinfo->src;
+ src->next_input_byte = data;
+ }
+ src = (struct jpeg_source_mgr *) cinfo->src;
+ src->init_source = our_init_source;
+ src->fill_input_buffer = our_fill_input_buffer;
+ src->skip_input_data = our_skip_input_data;
+ src->resync_to_restart = jpeg_resync_to_restart; /* use default method */
+ src->term_source = our_term_source;
+ src->bytes_in_buffer = len;
+ src->next_input_byte = data;
+}
+
+#if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
+METHODDEF(void)
+#else
+METHODDEF void
+#endif
+my_jpeg_error_exit (j_common_ptr cinfo)
+{
+ /* cinfo->err really points to a my_error_mgr struct, so coerce pointer */
+ struct my_jpeg_error_mgr *myerr = (struct my_jpeg_error_mgr *) cinfo->err;
+
+ /* Return control to the setjmp point */
+ longjmp (myerr->setjmp_buffer, 1);
+}
+
+#if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61)
+METHODDEF(void)
+#else
+METHODDEF void
+#endif
+my_jpeg_output_message (j_common_ptr cinfo)
+{
+ char buffer[JMSG_LENGTH_MAX];
+
+ /* Create the message */
+ (*cinfo->err->format_message) (cinfo, buffer);
+ warn_when_safe (Qjpeg, Qinfo, "%s", buffer);
+}
+
+/* The code in this routine is based on example.c from the JPEG library
+ source code and from gif_instantiate() */
+static void
+jpeg_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);
+ /* 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. */
+ struct jpeg_unwind_data unwind;
+ int speccount = specpdl_depth ();
+
+ /* This struct contains the JPEG decompression parameters and pointers to
+ * working space (which is allocated as needed by the JPEG library).
+ */
+ struct jpeg_decompress_struct cinfo;
+ /* We use our private extension JPEG error handler.
+ * Note that this struct must live as long as the main JPEG parameter
+ * struct, to avoid dangling-pointer problems.
+ */
+ struct my_jpeg_error_mgr jerr;
+
+ /* Step -1: First record our unwind-protect, which will clean up after
+ any exit, normal or not */
+
+ xzero (unwind);
+ record_unwind_protect (jpeg_instantiate_unwind, make_opaque_ptr (&unwind));
+
+ /* Step 1: allocate and initialize JPEG decompression object */
+
+ /* We set up the normal JPEG error routines, then override error_exit. */
+ cinfo.err = jpeg_std_error (&jerr.pub);
+ jerr.pub.error_exit = my_jpeg_error_exit;
+ jerr.pub.output_message = my_jpeg_output_message;
+
+ /* Establish the setjmp return context for my_error_exit to use. */
+ if (setjmp (jerr.setjmp_buffer))
+ {
+ /* If we get here, the JPEG code has signaled an error.
+ * We need to clean up the JPEG object, close the input file, and return.
+ */
+
+ {
+ Lisp_Object errstring;
+ char buffer[JMSG_LENGTH_MAX];
+
+ /* Create the message */
+ (*cinfo.err->format_message) ((j_common_ptr) &cinfo, buffer);
+ errstring = build_string (buffer);
+
+ signal_image_error_2 ("JPEG decoding error",
+ errstring, instantiator);
+ }
+ }
+
+ /* Now we can initialize the JPEG decompression object. */
+ jpeg_create_decompress (&cinfo);
+ unwind.cinfo_ptr = &cinfo;
+
+ /* Step 2: specify data source (eg, a file) */
+
+ {
+ Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
+ 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);
+ jpeg_memory_src (&cinfo, (JOCTET *) bytes, len);
+ }
+
+ /* Step 3: read file parameters with jpeg_read_header() */
+
+ jpeg_read_header (&cinfo, TRUE);
+ /* We can ignore the return value from jpeg_read_header since
+ * (a) suspension is not possible with the stdio data source, and
+ * (b) we passed TRUE to reject a tables-only JPEG file as an error.
+ * See libjpeg.doc for more info.
+ */
+
+ {
+ int jpeg_gray = 0; /* if we're dealing with a grayscale */
+ /* Step 4: set parameters for decompression. */
+
+ /* Now that we're using EImages, send all data as 24bit color.
+ The backend routine will take care of any necessary reductions.
+ We do have to handle the grayscale case ourselves, however. */
+ if (cinfo.jpeg_color_space == JCS_GRAYSCALE)
+ {
+ cinfo.out_color_space = JCS_GRAYSCALE;
+ jpeg_gray = 1;
+ }
+ else
+ {
+ /* we're relying on the jpeg driver to do any other conversions,
+ or signal an error if the conversion isn't supported. */
+ cinfo.out_color_space = JCS_RGB;
+ }
+
+ /* Step 5: Start decompressor */
+ jpeg_start_decompress (&cinfo);
+
+ /* Step 6: Read in the data and put into EImage format (8bit RGB triples)*/
+
+ unwind.eimage = (unsigned char*) xmalloc (cinfo.output_width * cinfo.output_height * 3);
+ if (!unwind.eimage)
+ signal_image_error("Unable to allocate enough memory for image", instantiator);
+
+ {
+ JSAMPARRAY row_buffer; /* Output row buffer */
+ JSAMPLE *jp;
+ int row_stride; /* physical row width in output buffer */
+ unsigned char *op = unwind.eimage;
+
+ /* We may need to do some setup of our own at this point before reading
+ * the data. After jpeg_start_decompress() we have the correct scaled
+ * output image dimensions available
+ * We need to make an output work buffer of the right size.
+ */
+ /* JSAMPLEs per row in output buffer. */
+ row_stride = cinfo.output_width * cinfo.output_components;
+ /* Make a one-row-high sample array that will go away when done
+ with image */
+ row_buffer = ((*cinfo.mem->alloc_sarray)
+ ((j_common_ptr) &cinfo, JPOOL_IMAGE, row_stride, 1));
+
+ /* Here we use the library's state variable cinfo.output_scanline as the
+ * loop counter, so that we don't have to keep track ourselves.
+ */
+ while (cinfo.output_scanline < cinfo.output_height)
+ {
+ int i;
+
+ /* jpeg_read_scanlines expects an array of pointers to scanlines.
+ * Here the array is only one element long, but you could ask for
+ * more than one scanline at a time if that's more convenient.
+ */
+ (void) jpeg_read_scanlines (&cinfo, row_buffer, 1);
+ jp = row_buffer[0];
+ for (i = 0; i < cinfo.output_width; i++)
+ {
+ int clr;
+ if (jpeg_gray)
+ {
+ unsigned char val;
+#if (BITS_IN_JSAMPLE == 8)
+ val = (unsigned char)*jp++;
+#else /* other option is 12 */
+ val = (unsigned char)(*jp++ >> 4);
+#endif
+ for (clr = 0; clr < 3; clr++) /* copy the same value into RGB */
+ *op++ = val;
+ }
+ else
+ {
+ for (clr = 0; clr < 3; clr++)
+#if (BITS_IN_JSAMPLE == 8)
+ *op++ = (unsigned char)*jp++;
+#else /* other option is 12 */
+ *op++ = (unsigned char)(*jp++ >> 4);
+#endif
+ }
+ }
+ }
+ }
+ }
+
+ /* Step 6.5: Create the pixmap and set up the image instance */
+ /* now instantiate */
+ MAYBE_DEVMETH (XDEVICE (ii->device),
+ init_image_instance_from_eimage,
+ (ii, cinfo.output_width, cinfo.output_height,
+ unwind.eimage, dest_mask,
+ instantiator, domain));
+
+ /* Step 7: Finish decompression */
+
+ jpeg_finish_decompress (&cinfo);
+ /* We can ignore the return value since suspension is not possible
+ * with the stdio data source.
+ */
+
+ /* And we're done! */
+ /* This will clean up everything else. */
+ unbind_to (speccount, Qnil);
+}
+
+#endif /* HAVE_JPEG */
+\f
+#ifdef HAVE_GIF
+/**********************************************************************
+ * GIF *
+ **********************************************************************/
+
+#include <gifrlib.h>
+
+static void
+gif_validate (Lisp_Object instantiator)
+{
+ file_or_data_must_be_present (instantiator);
+}
+
+static Lisp_Object
+gif_normalize (Lisp_Object inst, Lisp_Object console_type)
+{
+ return simple_image_type_normalize (inst, console_type, Qgif);
+}
+
+static int
+gif_possible_dest_types (void)
+{
+ return IMAGE_COLOR_PIXMAP_MASK;
+}
+
+/* To survive the otherwise baffling complexity of making sure
+ everything gets cleaned up in the presence of an error, we
+ use an unwind_protect(). */
+
+struct gif_unwind_data
+{
+ unsigned char *eimage;
+ /* Object that holds the decoded data from a GIF file */
+ GifFileType *giffile;
+};
+
+static Lisp_Object
+gif_instantiate_unwind (Lisp_Object unwind_obj)
+{
+ struct gif_unwind_data *data =
+ (struct gif_unwind_data *) get_opaque_ptr (unwind_obj);
+
+ free_opaque_ptr (unwind_obj);
+ if (data->giffile)
+ {
+ DGifCloseFile (data->giffile);
+ GifFree(data->giffile);
+ }
+ if (data->eimage) xfree(data->eimage);
+
+ return Qnil;
+}
+
+typedef struct gif_memory_storage
+{
+ Extbyte *bytes; /* The data */
+ Extcount len; /* How big is it? */
+ int index; /* Where are we? */
+} gif_memory_storage;
+
+static size_t
+gif_read_from_memory(GifByteType *buf, size_t size, VoidPtr data)
+{
+ gif_memory_storage *mem = (gif_memory_storage*)data;
+
+ if (size > (mem->len - mem->index))
+ return -1;
+ memcpy(buf, mem->bytes + mem->index, size);
+ mem->index = mem->index + size;
+ return size;
+}
+
+static int
+gif_memory_close(VoidPtr data)
+{
+ return 0;
+}
+
+struct gif_error_struct
+{
+ 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)
+{
+ struct gif_error_struct *error_data = (struct gif_error_struct*)error_ptr;
+
+ /* return to setjmp point */
+ error_data->err_str = err_str;
+ longjmp (error_data->setjmp_buffer, 1);
+}
+
+static void
+gif_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);
+ /* 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. */
+ struct gif_unwind_data unwind;
+ int speccount = specpdl_depth ();
+ gif_memory_storage mem_struct;
+ struct gif_error_struct gif_err;
+ Extbyte *bytes;
+ Extcount len;
+ int height = 0;
+ int width = 0;
+
+ xzero (unwind);
+ record_unwind_protect (gif_instantiate_unwind, make_opaque_ptr (&unwind));
+
+ /* 1. Now decode the data. */
+
+ {
+ Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
+
+ assert (!NILP (data));
+
+ if (!(unwind.giffile = GifSetup()))
+ signal_image_error ("Insufficent memory to instantiate GIF image", instantiator);
+
+ /* set up error facilities */
+ if (setjmp(gif_err.setjmp_buffer))
+ {
+ /* An error was signaled. No clean up is needed, as unwind handles that
+ for us. Just pass the error along. */
+ Lisp_Object errstring;
+ errstring = build_string (gif_err.err_str);
+ signal_image_error_2 ("GIF decoding error", errstring, instantiator);
+ }
+ GifSetErrorFunc(unwind.giffile, (Gif_error_func)gif_error_func, (VoidPtr)&gif_err);
+
+ GET_STRING_BINARY_DATA_ALLOCA (data, bytes, len);
+ mem_struct.bytes = bytes;
+ mem_struct.len = len;
+ mem_struct.index = 0;
+ GifSetReadFunc(unwind.giffile, gif_read_from_memory, (VoidPtr)&mem_struct);
+ GifSetCloseFunc(unwind.giffile, gif_memory_close, (VoidPtr)&mem_struct);
+ DGifInitRead(unwind.giffile);
+
+ /* Then slurp the image into memory, decoding along the way.
+ The result is the image in a simple one-byte-per-pixel
+ format (#### the GIF routines only support 8-bit GIFs,
+ it appears). */
+ DGifSlurp (unwind.giffile);
+ }
+
+ /* 3. Now create the EImage */
+ {
+ ColorMapObject *cmo = unwind.giffile->SColorMap;
+ int i, j, row, pass, interlace;
+ unsigned char *eip;
+ /* interlaced gifs have rows in this order:
+ 0, 8, 16, ..., 4, 12, 20, ..., 2, 6, 10, ..., 1, 3, 5, ... */
+ static int InterlacedOffset[] = { 0, 4, 2, 1 };
+ static int InterlacedJumps[] = { 8, 8, 4, 2 };
+
+ height = unwind.giffile->SHeight;
+ width = unwind.giffile->SWidth;
+ unwind.eimage = (unsigned char*) xmalloc (width * height * 3);
+ 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++)
+ {
+ if (interlace && row >= height)
+ row = InterlacedOffset[++pass];
+ eip = unwind.eimage + (row * width * 3);
+ for (j = 0; j < width; j++)
+ {
+ 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;
+ }
+ row += interlace ? InterlacedJumps[pass] : 1;
+ }
+ }
+ /* now instantiate */
+ MAYBE_DEVMETH (XDEVICE (ii->device),
+ init_image_instance_from_eimage,
+ (ii, width, height, unwind.eimage, dest_mask,
+ instantiator, domain));
+
+ unbind_to (speccount, Qnil);
+}
+
+#endif /* HAVE_GIF */
+
+\f
+#ifdef HAVE_PNG
+
+/**********************************************************************
+ * PNG *
+ **********************************************************************/
+static void
+png_validate (Lisp_Object instantiator)
+{
+ file_or_data_must_be_present (instantiator);
+}
+
+static Lisp_Object
+png_normalize (Lisp_Object inst, Lisp_Object console_type)
+{
+ return simple_image_type_normalize (inst, console_type, Qpng);
+}
+
+static int
+png_possible_dest_types (void)
+{
+ return IMAGE_COLOR_PIXMAP_MASK;
+}
+
+struct png_memory_storage
+{
+ CONST Extbyte *bytes; /* The data */
+ Extcount len; /* How big is it? */
+ int index; /* Where are we? */
+};
+
+static void
+png_read_from_memory(png_structp png_ptr, png_bytep data,
+ png_size_t length)
+{
+ struct png_memory_storage *tbr =
+ (struct png_memory_storage *) png_get_io_ptr (png_ptr);
+
+ if (length > (tbr->len - tbr->index))
+ png_error (png_ptr, (png_const_charp) "Read Error");
+ memcpy (data,tbr->bytes + tbr->index,length);
+ tbr->index = tbr->index + length;
+}
+
+struct png_error_struct
+{
+ CONST char *err_str;
+ jmp_buf setjmp_buffer; /* for return to caller */
+};
+
+/* jh 98/03/12 - #### AARRRGH! libpng includes jmp_buf inside its own
+ structure, and there are cases where the size can be different from
+ between inside the libarary, and inside the code! To do an end run
+ around this, use our own error functions, and don't rely on things
+ passed in the png_ptr to them. This is an ugly hack and must
+ go away when the lisp engine is threaded! */
+static struct png_error_struct png_err_stct;
+
+static void
+png_error_func (png_structp png_ptr, png_const_charp msg)
+{
+ png_err_stct.err_str = msg;
+ longjmp (png_err_stct.setjmp_buffer, 1);
+}
+
+static void
+png_warning_func (png_structp png_ptr, png_const_charp msg)
+{
+ warn_when_safe (Qpng, Qinfo, "%s", msg);
+}
+
+struct png_unwind_data
+{
+ FILE *instream;
+ unsigned char *eimage;
+ png_structp png_ptr;
+ png_infop info_ptr;
+};
+
+static Lisp_Object
+png_instantiate_unwind (Lisp_Object unwind_obj)
+{
+ struct png_unwind_data *data =
+ (struct png_unwind_data *) get_opaque_ptr (unwind_obj);
+
+ free_opaque_ptr (unwind_obj);
+ if (data->png_ptr)
+ png_destroy_read_struct (&(data->png_ptr), &(data->info_ptr), (png_infopp)NULL);
+ if (data->instream)
+ fclose (data->instream);
+
+ return Qnil;
+}
+
+static void
+png_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 png_unwind_data unwind;
+ int speccount = specpdl_depth ();
+ int height, width;
+ struct png_memory_storage tbr; /* Data to be read */
+
+ /* PNG variables */
+ png_structp png_ptr;
+ png_infop info_ptr;
+
+ /* Initialize all PNG structures */
+ png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, (void*)&png_err_stct,
+ png_error_func, png_warning_func);
+ if (!png_ptr)
+ signal_image_error ("Error obtaining memory for png_read", instantiator);
+ info_ptr = png_create_info_struct (png_ptr);
+ if (!info_ptr)
+ {
+ png_destroy_read_struct (&png_ptr, (png_infopp)NULL, (png_infopp)NULL);
+ signal_image_error ("Error obtaining memory for png_read", instantiator);
+ }
+
+ xzero (unwind);
+ unwind.png_ptr = png_ptr;
+ unwind.info_ptr = info_ptr;
+
+ record_unwind_protect (png_instantiate_unwind, make_opaque_ptr (&unwind));
+
+ /* This code is a mixture of stuff from Ben's GIF/JPEG stuff from
+ this file, example.c from the libpng 0.81 distribution, and the
+ pngtopnm sources. -WMP-
+ */
+ /* It has been further modified to handle the API changes for 0.96,
+ and is no longer usable for previous versions. jh
+ */
+
+ /* Set the jmp_buf reurn context for png_error ... if this returns !0, then
+ we ran into a problem somewhere, and need to clean up after ourselves. */
+ if (setjmp (png_err_stct.setjmp_buffer))
+ {
+ /* Something blew up: just display the error (cleanup happens in the unwind) */
+ signal_image_error_2 ("Error decoding PNG",
+ build_string(png_err_stct.err_str),
+ instantiator);
+ }
+
+ /* Initialize the IO layer and read in header information */
+ {
+ Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
+ 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);
+ tbr.bytes = bytes;
+ tbr.len = len;
+ tbr.index = 0;
+ png_set_read_fn (png_ptr,(void *) &tbr, png_read_from_memory);
+ }
+
+ png_read_info (png_ptr, info_ptr);
+
+ {
+ int y;
+ unsigned char **row_pointers;
+ height = info_ptr->height;
+ width = info_ptr->width;
+
+ /* Wow, allocate all the memory. Truly, exciting. */
+ unwind.eimage = xnew_array_and_zero (unsigned char, width * height * 3);
+ /* libpng expects that the image buffer passed in contains a
+ picture to draw on top of if the png has any transparencies.
+ This could be a good place to pass that in... */
+
+ row_pointers = xnew_array (png_byte *, height);
+
+ for (y = 0; y < height; y++)
+ row_pointers[y] = unwind.eimage + (width * 3 * y);
+
+ /* Now that we're using EImage, ask for 8bit RGB triples for any type
+ of image*/
+ /* convert palatte images to full RGB */
+ if (info_ptr->color_type == PNG_COLOR_TYPE_PALETTE)
+ png_set_expand (png_ptr);
+ /* send grayscale images to RGB too */
+ if (info_ptr->color_type == PNG_COLOR_TYPE_GRAY ||
+ info_ptr->color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
+ png_set_gray_to_rgb (png_ptr);
+ /* we can't handle alpha values */
+ if (info_ptr->color_type & PNG_COLOR_MASK_ALPHA)
+ png_set_strip_alpha (png_ptr);
+ /* rip out any transparancy layers/colors */
+ if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
+ {
+ png_set_expand (png_ptr);
+ png_set_strip_alpha (png_ptr);
+ }
+ /* tell libpng to strip 16 bit depth files down to 8 bits */
+ if (info_ptr->bit_depth == 16)
+ png_set_strip_16 (png_ptr);
+ /* if the image is < 8 bits, pad it out */
+ if (info_ptr->bit_depth < 8)
+ {
+ if (info_ptr->color_type == PNG_COLOR_TYPE_GRAY)
+ png_set_expand (png_ptr);
+ else
+ png_set_packing (png_ptr);
+ }
+
+#if 1 /* tests? or permanent? */
+ {
+ /* if the png specifies a background chunk, go ahead and
+ use it */
+ png_color_16 my_background, *image_background;
+
+ /* ### how do I get the background of the current frame? */
+ my_background.red = 0x7fff;
+ my_background.green = 0x7fff;
+ my_background.blue = 0x7fff;
+
+ if (png_get_bKGD (png_ptr, info_ptr, &image_background))
+ png_set_background (png_ptr, image_background,
+ PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
+ else
+ png_set_background (png_ptr, &my_background,
+ PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
+ }
+#endif
+ png_read_image (png_ptr, row_pointers);
+ png_read_end (png_ptr, info_ptr);
+
+#ifdef PNG_SHOW_COMMENTS
+ /* ####
+ * I turn this off by default now, because the !%^@#!% comments
+ * show up every time the image is instantiated, which can get
+ * really really annoying. There should be some way to pass this
+ * type of data down into the glyph code, where you can get to it
+ * from lisp anyway. - WMP
+ */
+ {
+ int i;
+
+ for (i = 0 ; i < info_ptr->num_text ; i++)
+ {
+ /* How paranoid do I have to be about no trailing NULLs, and
+ using (int)info_ptr->text[i].text_length, and strncpy and a temp
+ string somewhere? */
+
+ warn_when_safe (Qpng, Qinfo, "%s - %s",
+ info_ptr->text[i].key,
+ info_ptr->text[i].text);
+ }
+ }
+#endif
+
+ xfree (row_pointers);
+ }
+
+ /* now instantiate */
+ MAYBE_DEVMETH (XDEVICE (ii->device),
+ init_image_instance_from_eimage,
+ (ii, width, height, unwind.eimage, dest_mask,
+ instantiator, domain));
+
+ /* This will clean up everything else. */
+ unbind_to (speccount, Qnil);
+}
+
+#endif /* HAVE_PNG */
+
+\f
+#ifdef HAVE_TIFF
+#include "tiffio.h"
+
+/**********************************************************************
+ * TIFF *
+ **********************************************************************/
+static void
+tiff_validate (Lisp_Object instantiator)
+{
+ file_or_data_must_be_present (instantiator);
+}
+
+static Lisp_Object
+tiff_normalize (Lisp_Object inst, Lisp_Object console_type)
+{
+ return simple_image_type_normalize (inst, console_type, Qtiff);
+}
+
+static int
+tiff_possible_dest_types (void)
+{
+ return IMAGE_COLOR_PIXMAP_MASK;
+}
+
+struct tiff_unwind_data
+{
+ unsigned char *eimage;
+ /* Object that holds the decoded data from a TIFF file */
+ TIFF *tiff;
+};
+
+static Lisp_Object
+tiff_instantiate_unwind (Lisp_Object unwind_obj)
+{
+ struct tiff_unwind_data *data =
+ (struct tiff_unwind_data *) get_opaque_ptr (unwind_obj);
+
+ free_opaque_ptr (unwind_obj);
+ if (data->tiff)
+ {
+ TIFFClose(data->tiff);
+ }
+ if (data->eimage)
+ xfree (data->eimage);
+
+ return Qnil;
+}
+
+typedef struct tiff_memory_storage
+{
+ Extbyte *bytes; /* The data */
+ Extcount len; /* How big is it? */
+ int index; /* Where are we? */
+} tiff_memory_storage;
+
+static size_t
+tiff_memory_read(thandle_t data, tdata_t buf, tsize_t size)
+{
+ tiff_memory_storage *mem = (tiff_memory_storage*)data;
+
+ if (size > (mem->len - mem->index))
+ return (size_t) -1;
+ memcpy(buf, mem->bytes + mem->index, size);
+ mem->index = mem->index + size;
+ return size;
+}
+
+static size_t tiff_memory_write(thandle_t data, tdata_t buf, tsize_t size)
+{
+ abort();
+ return 0; /* Shut up warnings. */
+}
+
+static toff_t tiff_memory_seek(thandle_t data, toff_t off, int whence)
+{
+ tiff_memory_storage *mem = (tiff_memory_storage*)data;
+ int newidx;
+ switch(whence) {
+ case SEEK_SET:
+ newidx = off;
+ break;
+ case SEEK_END:
+ newidx = mem->len + off;
+ break;
+ case SEEK_CUR:
+ newidx = mem->index + off;
+ break;
+ default:
+ fprintf(stderr,"Eh? invalid seek mode in tiff_memory_seek\n");
+ return -1;
+ }
+
+ if ((newidx > mem->len) || (newidx < 0))
+ return -1;
+
+ mem->index = newidx;
+ return newidx;
+}
+
+static int
+tiff_memory_close(thandle_t data)
+{
+ return 0;
+}
+
+static int
+tiff_map_noop(thandle_t data, tdata_t* pbase, toff_t* psize)
+{
+ return 0;
+}
+
+static void
+tiff_unmap_noop(thandle_t data, tdata_t pbase, toff_t psize)
+{
+ return;
+}
+
+static toff_t
+tiff_memory_size(thandle_t data)
+{
+ tiff_memory_storage *mem = (tiff_memory_storage*)data;
+ return mem->len;
+}
+
+struct tiff_error_struct
+{
+#if HAVE_VSNPRINTF
+ char err_str[256];
+#else
+ char err_str[1024]; /* return the error string */
+#endif
+ jmp_buf setjmp_buffer; /* for return to caller */
+};
+
+/* jh 98/03/12 - ###This struct for passing data to the error functions
+ is an ugly hack caused by the fact that libtiff (as of v3.4) doesn't
+ have any place to store error func data. This should be rectified
+ before XEmacs gets threads! */
+static struct tiff_error_struct tiff_err_data;
+
+static void
+tiff_error_func(CONST char *module, CONST char *fmt, ...)
+{
+ va_list vargs;
+
+ va_start (vargs, fmt);
+#if HAVE_VSNPRINTF
+ vsnprintf (tiff_err_data.err_str, 255, fmt, vargs);
+#else
+ /* pray this doesn't overflow... */
+ vsprintf (tiff_err_data.err_str, fmt, vargs);
+#endif
+ va_end (vargs);
+ /* return to setjmp point */
+ longjmp (tiff_err_data.setjmp_buffer, 1);
+}
+
+static void
+tiff_warning_func(CONST char *module, CONST char *fmt, ...)
+{
+ va_list vargs;
+#if HAVE_VSNPRINTF
+ char warn_str[256];
+#else
+ char warn_str[1024];
+#endif
+
+ va_start (vargs, fmt);
+#if HAVE_VSNPRINTF
+ vsnprintf (warn_str, 255, fmt, vargs);
+#else
+ vsprintf (warn_str, fmt, vargs);
+#endif
+ va_end (vargs);
+ warn_when_safe (Qtiff, Qinfo, "%s - %s",
+ module, warn_str);
+}
+
+static void
+tiff_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);
+ 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
+ stack frame is still valid. */
+ struct tiff_unwind_data unwind;
+ int speccount = specpdl_depth ();
+ uint32 width, height;
+
+ xzero (unwind);
+ record_unwind_protect (tiff_instantiate_unwind, make_opaque_ptr (&unwind));
+
+ /* set up error facilities */
+ if (setjmp (tiff_err_data.setjmp_buffer))
+ {
+ /* An error was signaled. No clean up is needed, as unwind handles that
+ for us. Just pass the error along. */
+ signal_image_error_2 ("TIFF decoding error",
+ build_string(tiff_err_data.err_str),
+ instantiator);
+ }
+ TIFFSetErrorHandler ((TIFFErrorHandler)tiff_error_func);
+ TIFFSetWarningHandler ((TIFFErrorHandler)tiff_warning_func);
+ {
+ Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
+ Extbyte *bytes;
+ Extcount len;
+
+ uint32 *raster;
+ unsigned char *ep;
+
+ assert (!NILP (data));
+
+ /* #### 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);
+ mem_struct.bytes = bytes;
+ mem_struct.len = len;
+ mem_struct.index = 0;
+
+ unwind.tiff = TIFFClientOpen ("memfile", "r", &mem_struct,
+ (TIFFReadWriteProc)tiff_memory_read,
+ (TIFFReadWriteProc)tiff_memory_write,
+ 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);
+
+ 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.
+ It needs to be reimplimented via scanline reads for both memory
+ compactness. */
+ raster = (uint32*) _TIFFmalloc (width * height * sizeof (uint32));
+ if (raster != NULL)
+ {
+ int i,j;
+ uint32 *rp;
+ ep = unwind.eimage;
+ rp = raster;
+ if (TIFFReadRGBAImage (unwind.tiff, width, height, raster, 0))
+ {
+ for (i = height - 1; i >= 0; i--)
+ {
+ /* This is to get around weirdness in the libtiff library where properly
+ made TIFFs will come out upside down. libtiff bug or jhod-brainlock? */
+ rp = raster + (i * width);
+ for (j = 0; j < width; j++)
+ {
+ *ep++ = (unsigned char)TIFFGetR(*rp);
+ *ep++ = (unsigned char)TIFFGetG(*rp);
+ *ep++ = (unsigned char)TIFFGetB(*rp);
+ rp++;
+ }
+ }
+ }
+ _TIFFfree (raster);
+ } else
+ signal_image_error ("Unable to allocate memory for TIFFReadRGBA", instantiator);
+
+ }
+
+ /* now instantiate */
+ MAYBE_DEVMETH (XDEVICE (ii->device),
+ init_image_instance_from_eimage,
+ (ii, width, height, unwind.eimage, dest_mask,
+ instantiator, domain));
+
+ unbind_to (speccount, Qnil);
+}
+
+#endif /* HAVE_TIFF */
+
+\f
+/************************************************************************/
+/* initialization */
+/************************************************************************/
+
+void
+syms_of_glyphs_eimage (void)
+{
+}
+
+void
+image_instantiator_format_create_glyphs_eimage (void)
+{
+ /* image-instantiator types */
+#ifdef HAVE_JPEG
+ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (jpeg, "jpeg");
+
+ IIFORMAT_HAS_METHOD (jpeg, validate);
+ IIFORMAT_HAS_METHOD (jpeg, normalize);
+ IIFORMAT_HAS_METHOD (jpeg, possible_dest_types);
+ IIFORMAT_HAS_METHOD (jpeg, instantiate);
+
+ IIFORMAT_VALID_KEYWORD (jpeg, Q_data, check_valid_string);
+ IIFORMAT_VALID_KEYWORD (jpeg, Q_file, check_valid_string);
+#endif
+
+#ifdef HAVE_GIF
+ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (gif, "gif");
+
+ IIFORMAT_HAS_METHOD (gif, validate);
+ IIFORMAT_HAS_METHOD (gif, normalize);
+ IIFORMAT_HAS_METHOD (gif, possible_dest_types);
+ IIFORMAT_HAS_METHOD (gif, instantiate);
+
+ IIFORMAT_VALID_KEYWORD (gif, Q_data, check_valid_string);
+ IIFORMAT_VALID_KEYWORD (gif, Q_file, check_valid_string);
+#endif
+
+#ifdef HAVE_PNG
+ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (png, "png");
+
+ IIFORMAT_HAS_METHOD (png, validate);
+ IIFORMAT_HAS_METHOD (png, normalize);
+ IIFORMAT_HAS_METHOD (png, possible_dest_types);
+ IIFORMAT_HAS_METHOD (png, instantiate);
+
+ IIFORMAT_VALID_KEYWORD (png, Q_data, check_valid_string);
+ IIFORMAT_VALID_KEYWORD (png, Q_file, check_valid_string);
+#endif
+
+#ifdef HAVE_TIFF
+ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (tiff, "tiff");
+
+ IIFORMAT_HAS_METHOD (tiff, validate);
+ IIFORMAT_HAS_METHOD (tiff, normalize);
+ IIFORMAT_HAS_METHOD (tiff, possible_dest_types);
+ IIFORMAT_HAS_METHOD (tiff, instantiate);
+
+ IIFORMAT_VALID_KEYWORD (tiff, Q_data, check_valid_string);
+ IIFORMAT_VALID_KEYWORD (tiff, Q_file, check_valid_string);
+#endif
+
+}
+
+void
+vars_of_glyphs_eimage (void)
+{
+#ifdef HAVE_JPEG
+ Fprovide (Qjpeg);
+#endif
+
+#ifdef HAVE_GIF
+ Fprovide (Qgif);
+#endif
+
+#ifdef HAVE_PNG
+ Fprovide (Qpng);
+#endif
+
+#ifdef HAVE_TIFF
+ Fprovide (Qtiff);
+#endif
+
+}
--- /dev/null
+/* Generic glyph/image implementation + display tables
+ Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
+ Copyright (C) 1995 Tinker Systems
+ Copyright (C) 1995, 1996 Ben Wing
+ 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. */
+
+/* Synched up with: Not in FSF. */
+
+/* Written by Ben Wing and Chuck Thompson */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "device.h"
+#include "elhash.h"
+#include "faces.h"
+#include "frame.h"
+#include "insdel.h"
+#include "glyphs.h"
+#include "objects.h"
+#include "redisplay.h"
+#include "window.h"
+
+#ifdef HAVE_XPM
+#include <X11/xpm.h>
+#endif
+
+Lisp_Object Qimage_conversion_error;
+
+Lisp_Object Qglyphp, Qcontrib_p, Qbaseline;
+Lisp_Object Qbuffer_glyph_p, Qpointer_glyph_p, Qicon_glyph_p;
+Lisp_Object Qnothing_image_instance_p, Qtext_image_instance_p;
+Lisp_Object Qmono_pixmap_image_instance_p;
+Lisp_Object Qcolor_pixmap_image_instance_p;
+Lisp_Object Qpointer_image_instance_p;
+Lisp_Object Qsubwindow_image_instance_p;
+Lisp_Object Qconst_glyph_variable;
+Lisp_Object Qmono_pixmap, Qcolor_pixmap, Qsubwindow;
+Lisp_Object Q_file, Q_data, Q_face;
+Lisp_Object Qformatted_string;
+
+Lisp_Object Vcurrent_display_table;
+Lisp_Object Vtruncation_glyph, Vcontinuation_glyph, Voctal_escape_glyph;
+Lisp_Object Vcontrol_arrow_glyph, Vinvisible_text_glyph, Vhscroll_glyph;
+Lisp_Object Vxemacs_logo;
+Lisp_Object Vthe_nothing_vector;
+Lisp_Object Vimage_instantiator_format_list;
+Lisp_Object Vimage_instance_type_list;
+Lisp_Object Vglyph_type_list;
+
+DEFINE_IMAGE_INSTANTIATOR_FORMAT (nothing);
+DEFINE_IMAGE_INSTANTIATOR_FORMAT (inherit);
+DEFINE_IMAGE_INSTANTIATOR_FORMAT (string);
+DEFINE_IMAGE_INSTANTIATOR_FORMAT (formatted_string);
+
+#ifdef HAVE_WINDOW_SYSTEM
+DEFINE_IMAGE_INSTANTIATOR_FORMAT (xbm);
+Lisp_Object Qxbm;
+
+Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y;
+Lisp_Object Q_foreground, Q_background;
+#ifndef BitmapSuccess
+#define BitmapSuccess 0
+#define BitmapOpenFailed 1
+#define BitmapFileInvalid 2
+#define BitmapNoMemory 3
+#endif
+#endif
+
+#ifdef HAVE_XPM
+DEFINE_IMAGE_INSTANTIATOR_FORMAT (xpm);
+Lisp_Object Qxpm;
+Lisp_Object Q_color_symbols;
+#endif
+
+typedef struct image_instantiator_format_entry image_instantiator_format_entry;
+struct image_instantiator_format_entry
+{
+ Lisp_Object symbol;
+ struct image_instantiator_methods *meths;
+};
+
+typedef struct
+{
+ Dynarr_declare (struct image_instantiator_format_entry);
+} image_instantiator_format_entry_dynarr;
+
+image_instantiator_format_entry_dynarr *
+ the_image_instantiator_format_entry_dynarr;
+
+static Lisp_Object allocate_image_instance (Lisp_Object device);
+static void image_validate (Lisp_Object instantiator);
+static void glyph_property_was_changed (Lisp_Object glyph,
+ Lisp_Object property,
+ Lisp_Object locale);
+EXFUN (Fimage_instance_type, 1);
+EXFUN (Fglyph_type, 1);
+
+\f
+/****************************************************************************
+ * Image Instantiators *
+ ****************************************************************************/
+
+static struct image_instantiator_methods *
+decode_image_instantiator_format (Lisp_Object format, Error_behavior errb)
+{
+ int i;
+
+ if (!SYMBOLP (format))
+ {
+ if (ERRB_EQ (errb, ERROR_ME))
+ CHECK_SYMBOL (format);
+ return 0;
+ }
+
+ for (i = 0; i < Dynarr_length (the_image_instantiator_format_entry_dynarr);
+ i++)
+ {
+ if (EQ (format,
+ Dynarr_at (the_image_instantiator_format_entry_dynarr, i).
+ symbol))
+ return Dynarr_at (the_image_instantiator_format_entry_dynarr, i).meths;
+ }
+
+ maybe_signal_simple_error ("Invalid image-instantiator format", format,
+ Qimage, errb);
+
+ return 0;
+}
+
+static int
+valid_image_instantiator_format_p (Lisp_Object format)
+{
+ return (decode_image_instantiator_format (format, ERROR_ME_NOT) != 0);
+}
+
+DEFUN ("valid-image-instantiator-format-p", Fvalid_image_instantiator_format_p,
+ 1, 1, 0, /*
+Given an IMAGE-INSTANTIATOR-FORMAT, return non-nil if it is valid.
+Valid formats are some subset of 'nothing, 'string, 'formatted-string,
+'xpm, 'xbm, 'xface, 'gif, 'jpeg, 'png, 'tiff, 'cursor-font, 'font,
+'autodetect, and 'subwindow, depending on how XEmacs was compiled.
+*/
+ (image_instantiator_format))
+{
+ return valid_image_instantiator_format_p (image_instantiator_format) ?
+ Qt : Qnil;
+}
+
+DEFUN ("image-instantiator-format-list", Fimage_instantiator_format_list,
+ 0, 0, 0, /*
+Return a list of valid image-instantiator formats.
+*/
+ ())
+{
+ return Fcopy_sequence (Vimage_instantiator_format_list);
+}
+
+void
+add_entry_to_image_instantiator_format_list (Lisp_Object symbol,
+ struct
+ image_instantiator_methods *meths)
+{
+ struct image_instantiator_format_entry entry;
+
+ entry.symbol = symbol;
+ entry.meths = meths;
+ Dynarr_add (the_image_instantiator_format_entry_dynarr, entry);
+ Vimage_instantiator_format_list =
+ Fcons (symbol, Vimage_instantiator_format_list);
+}
+
+static Lisp_Object *
+get_image_conversion_list (Lisp_Object console_type)
+{
+ return &decode_console_type (console_type, ERROR_ME)->image_conversion_list;
+}
+
+DEFUN ("set-console-type-image-conversion-list", Fset_console_type_image_conversion_list,
+ 2, 2, 0, /*
+Set the image-conversion-list for consoles of the given TYPE.
+The image-conversion-list specifies how image instantiators that
+are strings should be interpreted. Each element of the list should be
+a list of two elements (a regular expression string and a vector) or
+a list of three elements (the preceding two plus an integer index into
+the vector). The string is converted to the vector associated with the
+first matching regular expression. If a vector index is specified, the
+string itself is substituted into that position in the vector.
+
+Note: The conversion above is applied when the image instantiator is
+added to an image specifier, not when the specifier is actually
+instantiated. Therefore, changing the image-conversion-list only affects
+newly-added instantiators. Existing instantiators in glyphs and image
+specifiers will not be affected.
+*/
+ (console_type, list))
+{
+ Lisp_Object tail;
+ Lisp_Object *imlist = get_image_conversion_list (console_type);
+
+ /* Check the list to make sure that it only has valid entries. */
+
+ EXTERNAL_LIST_LOOP (tail, list)
+ {
+ Lisp_Object mapping = XCAR (tail);
+
+ /* Mapping form should be (STRING VECTOR) or (STRING VECTOR INTEGER) */
+ if (!CONSP (mapping) ||
+ !CONSP (XCDR (mapping)) ||
+ (!NILP (XCDR (XCDR (mapping))) &&
+ (!CONSP (XCDR (XCDR (mapping))) ||
+ !NILP (XCDR (XCDR (XCDR (mapping)))))))
+ signal_simple_error ("Invalid mapping form", mapping);
+ else
+ {
+ Lisp_Object exp = XCAR (mapping);
+ Lisp_Object typevec = XCAR (XCDR (mapping));
+ Lisp_Object pos = Qnil;
+ Lisp_Object newvec;
+ struct gcpro gcpro1;
+
+ CHECK_STRING (exp);
+ CHECK_VECTOR (typevec);
+ if (!NILP (XCDR (XCDR (mapping))))
+ {
+ pos = XCAR (XCDR (XCDR (mapping)));
+ CHECK_INT (pos);
+ if (XINT (pos) < 0 ||
+ XINT (pos) >= XVECTOR_LENGTH (typevec))
+ args_out_of_range_3
+ (pos, Qzero, make_int (XVECTOR_LENGTH (typevec) - 1));
+ }
+
+ newvec = Fcopy_sequence (typevec);
+ if (INTP (pos))
+ XVECTOR_DATA (newvec)[XINT (pos)] = exp;
+ GCPRO1 (newvec);
+ image_validate (newvec);
+ UNGCPRO;
+ }
+ }
+
+ *imlist = Fcopy_tree (list, Qt);
+ return list;
+}
+
+DEFUN ("console-type-image-conversion-list", Fconsole_type_image_conversion_list,
+ 1, 1, 0, /*
+Return the image-conversion-list for devices of the given TYPE.
+The image-conversion-list specifies how to interpret image string
+instantiators for the specified console type. See
+`set-console-type-image-conversion-list' for a description of its syntax.
+*/
+ (console_type))
+{
+ return Fcopy_tree (*get_image_conversion_list (console_type), Qt);
+}
+
+/* Process a string instantiator according to the image-conversion-list for
+ CONSOLE_TYPE. Returns a vector. */
+
+static Lisp_Object
+process_image_string_instantiator (Lisp_Object data,
+ Lisp_Object console_type,
+ int dest_mask)
+{
+ Lisp_Object tail;
+
+ LIST_LOOP (tail, *get_image_conversion_list (console_type))
+ {
+ Lisp_Object mapping = XCAR (tail);
+ Lisp_Object exp = XCAR (mapping);
+ Lisp_Object typevec = XCAR (XCDR (mapping));
+
+ /* if the result is of a type that can't be instantiated
+ (e.g. a string when we're dealing with a pointer glyph),
+ skip it. */
+ if (!(dest_mask &
+ IIFORMAT_METH (decode_image_instantiator_format
+ (XVECTOR_DATA (typevec)[0], ERROR_ME),
+ possible_dest_types, ())))
+ continue;
+ if (fast_string_match (exp, 0, data, 0, -1, 0, ERROR_ME, 0) >= 0)
+ {
+ if (!NILP (XCDR (XCDR (mapping))))
+ {
+ int pos = XINT (XCAR (XCDR (XCDR (mapping))));
+ Lisp_Object newvec = Fcopy_sequence (typevec);
+ XVECTOR_DATA (newvec)[pos] = data;
+ return newvec;
+ }
+ else
+ return typevec;
+ }
+ }
+
+ /* Oh well. */
+ signal_simple_error ("Unable to interpret glyph instantiator",
+ data);
+
+ return Qnil;
+}
+
+Lisp_Object
+find_keyword_in_vector_or_given (Lisp_Object vector, Lisp_Object keyword,
+ Lisp_Object default_)
+{
+ Lisp_Object *elt;
+ int instantiator_len;
+
+ elt = XVECTOR_DATA (vector);
+ instantiator_len = XVECTOR_LENGTH (vector);
+
+ elt++;
+ instantiator_len--;
+
+ while (instantiator_len > 0)
+ {
+ if (EQ (elt[0], keyword))
+ return elt[1];
+ elt += 2;
+ instantiator_len -= 2;
+ }
+
+ return default_;
+}
+
+Lisp_Object
+find_keyword_in_vector (Lisp_Object vector, Lisp_Object keyword)
+{
+ return find_keyword_in_vector_or_given (vector, keyword, Qnil);
+}
+
+void
+check_valid_string (Lisp_Object data)
+{
+ CHECK_STRING (data);
+}
+
+static void
+check_valid_face (Lisp_Object data)
+{
+ Fget_face (data);
+}
+
+void
+check_valid_int (Lisp_Object data)
+{
+ CHECK_INT (data);
+}
+
+void
+file_or_data_must_be_present (Lisp_Object instantiator)
+{
+ if (NILP (find_keyword_in_vector (instantiator, Q_file)) &&
+ NILP (find_keyword_in_vector (instantiator, Q_data)))
+ signal_simple_error ("Must supply either :file or :data",
+ instantiator);
+}
+
+void
+data_must_be_present (Lisp_Object instantiator)
+{
+ if (NILP (find_keyword_in_vector (instantiator, Q_data)))
+ signal_simple_error ("Must supply :data", instantiator);
+}
+
+static void
+face_must_be_present (Lisp_Object instantiator)
+{
+ if (NILP (find_keyword_in_vector (instantiator, Q_face)))
+ signal_simple_error ("Must supply :face", instantiator);
+}
+
+/* utility function useful in retrieving data from a file. */
+
+Lisp_Object
+make_string_from_file (Lisp_Object file)
+{
+ /* This function can call lisp */
+ int count = specpdl_depth ();
+ Lisp_Object temp_buffer;
+ struct gcpro gcpro1;
+ Lisp_Object data;
+
+ specbind (Qinhibit_quit, Qt);
+ record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ temp_buffer = Fget_buffer_create (build_string (" *pixmap conversion*"));
+ GCPRO1 (temp_buffer);
+ set_buffer_internal (XBUFFER (temp_buffer));
+ Ferase_buffer (Qnil);
+ specbind (intern ("format-alist"), Qnil);
+ Finsert_file_contents_internal (file, Qnil, Qnil, Qnil, Qnil, Qnil, Qnil);
+ data = Fbuffer_substring (Qnil, Qnil, Qnil);
+ unbind_to (count, Qnil);
+ UNGCPRO;
+ return data;
+}
+
+/* The following two functions are provided to make it easier for
+ the normalize methods to work with keyword-value vectors.
+ Hash tables are kind of heavyweight for this purpose.
+ (If vectors were resizable, we could avoid this problem;
+ but they're not.) An alternative approach that might be
+ more efficient but require more work is to use a type of
+ assoc-Dynarr and provide primitives for deleting elements out
+ of it. (However, you'd also have to add an unwind-protect
+ to make sure the Dynarr got freed in case of an error in
+ the normalization process.) */
+
+Lisp_Object
+tagged_vector_to_alist (Lisp_Object vector)
+{
+ Lisp_Object *elt = XVECTOR_DATA (vector);
+ int len = XVECTOR_LENGTH (vector);
+ Lisp_Object result = Qnil;
+
+ assert (len & 1);
+ for (len -= 2; len >= 1; len -= 2)
+ result = Fcons (Fcons (elt[len], elt[len+1]), result);
+
+ return result;
+}
+
+Lisp_Object
+alist_to_tagged_vector (Lisp_Object tag, Lisp_Object alist)
+{
+ int len = 1 + 2 * XINT (Flength (alist));
+ Lisp_Object *elt = alloca_array (Lisp_Object, len);
+ int i;
+ Lisp_Object rest;
+
+ i = 0;
+ elt[i++] = tag;
+ LIST_LOOP (rest, alist)
+ {
+ Lisp_Object pair = XCAR (rest);
+ elt[i] = XCAR (pair);
+ elt[i+1] = XCDR (pair);
+ i += 2;
+ }
+
+ return Fvector (len, elt);
+}
+
+static Lisp_Object
+normalize_image_instantiator (Lisp_Object instantiator,
+ Lisp_Object contype,
+ Lisp_Object dest_mask)
+{
+ if (IMAGE_INSTANCEP (instantiator))
+ return instantiator;
+
+ if (STRINGP (instantiator))
+ instantiator = process_image_string_instantiator (instantiator, contype,
+ XINT (dest_mask));
+
+ assert (VECTORP (instantiator));
+ /* We have to always store the actual pixmap data and not the
+ filename even though this is a potential memory pig. We have to
+ do this because it is quite possible that we will need to
+ instantiate a new instance of the pixmap and the file will no
+ longer exist (e.g. w3 pixmaps are almost always from temporary
+ files). */
+ {
+ struct image_instantiator_methods * meths =
+ decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
+ ERROR_ME);
+ return IIFORMAT_METH_OR_GIVEN (meths, normalize,
+ (instantiator, contype),
+ instantiator);
+ }
+}
+
+static Lisp_Object
+instantiate_image_instantiator (Lisp_Object device, Lisp_Object domain,
+ Lisp_Object instantiator,
+ Lisp_Object pointer_fg, Lisp_Object pointer_bg,
+ int dest_mask)
+{
+ Lisp_Object ii = allocate_image_instance (device);
+ struct image_instantiator_methods *meths;
+ struct gcpro gcpro1;
+
+ GCPRO1 (ii);
+ meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
+ ERROR_ME);
+ if (!HAS_IIFORMAT_METH_P (meths, instantiate))
+ signal_simple_error
+ ("Don't know how to instantiate this image instantiator?",
+ instantiator);
+ IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg,
+ pointer_bg, dest_mask, domain));
+ UNGCPRO;
+
+ return ii;
+}
+
+\f
+/****************************************************************************
+ * Image-Instance Object *
+ ****************************************************************************/
+
+Lisp_Object Qimage_instancep;
+
+static Lisp_Object
+mark_image_instance (Lisp_Object obj, void (*markobj) (Lisp_Object))
+{
+ struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
+
+ (markobj) (i->name);
+ switch (IMAGE_INSTANCE_TYPE (i))
+ {
+ case IMAGE_TEXT:
+ (markobj) (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));
+ break;
+ case IMAGE_SUBWINDOW:
+ /* #### implement me */
+ break;
+ default:
+ break;
+ }
+
+ MAYBE_DEVMETH (XDEVICE (i->device), mark_image_instance, (i, markobj));
+
+ return i->device;
+}
+
+static void
+print_image_instance (Lisp_Object obj, Lisp_Object printcharfun,
+ int escapeflag)
+{
+ char buf[100];
+ struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (obj);
+
+ if (print_readably)
+ error ("printing unreadable object #<image-instance 0x%x>",
+ ii->header.uid);
+ write_c_string ("#<image-instance (", printcharfun);
+ print_internal (Fimage_instance_type (obj), printcharfun, 0);
+ write_c_string (") ", printcharfun);
+ if (!NILP (ii->name))
+ {
+ print_internal (ii->name, printcharfun, 1);
+ write_c_string (" ", printcharfun);
+ }
+ write_c_string ("on ", printcharfun);
+ print_internal (ii->device, printcharfun, 0);
+ write_c_string (" ", printcharfun);
+ switch (IMAGE_INSTANCE_TYPE (ii))
+ {
+ case IMAGE_NOTHING:
+ break;
+
+ case IMAGE_TEXT:
+ print_internal (IMAGE_INSTANCE_TEXT_STRING (ii), printcharfun, 1);
+ break;
+
+ case IMAGE_MONO_PIXMAP:
+ case IMAGE_COLOR_PIXMAP:
+ case IMAGE_POINTER:
+ if (STRINGP (IMAGE_INSTANCE_PIXMAP_FILENAME (ii)))
+ {
+ char *s;
+ Lisp_Object filename = IMAGE_INSTANCE_PIXMAP_FILENAME (ii);
+ s = strrchr ((char *) XSTRING_DATA (filename), '/');
+ if (s)
+ print_internal (build_string (s + 1), printcharfun, 1);
+ else
+ print_internal (filename, printcharfun, 1);
+ }
+ if (IMAGE_INSTANCE_PIXMAP_DEPTH (ii) > 1)
+ sprintf (buf, " %dx%dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
+ IMAGE_INSTANCE_PIXMAP_HEIGHT (ii),
+ IMAGE_INSTANCE_PIXMAP_DEPTH (ii));
+ else
+ sprintf (buf, " %dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
+ IMAGE_INSTANCE_PIXMAP_HEIGHT (ii));
+ write_c_string (buf, printcharfun);
+ if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ||
+ !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
+ {
+ write_c_string (" @", printcharfun);
+ if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)))
+ {
+ long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)));
+ write_c_string (buf, printcharfun);
+ }
+ else
+ write_c_string ("??", printcharfun);
+ write_c_string (",", printcharfun);
+ if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
+ {
+ long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)));
+ write_c_string (buf, printcharfun);
+ }
+ else
+ write_c_string ("??", printcharfun);
+ }
+ if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)) ||
+ !NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
+ {
+ write_c_string (" (", printcharfun);
+ if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)))
+ {
+ print_internal
+ (XCOLOR_INSTANCE
+ (IMAGE_INSTANCE_PIXMAP_FG (ii))->name, printcharfun, 0);
+ }
+ write_c_string ("/", printcharfun);
+ if (!NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
+ {
+ print_internal
+ (XCOLOR_INSTANCE
+ (IMAGE_INSTANCE_PIXMAP_BG (ii))->name, printcharfun, 0);
+ }
+ write_c_string (")", printcharfun);
+ }
+ break;
+
+ case IMAGE_SUBWINDOW:
+ /* #### implement me */
+ break;
+
+ default:
+ abort ();
+ }
+
+ MAYBE_DEVMETH (XDEVICE (ii->device), print_image_instance,
+ (ii, printcharfun, escapeflag));
+ sprintf (buf, " 0x%x>", ii->header.uid);
+ write_c_string (buf, printcharfun);
+}
+
+static void
+finalize_image_instance (void *header, int for_disksave)
+{
+ struct Lisp_Image_Instance *i = (struct Lisp_Image_Instance *) header;
+
+ if (IMAGE_INSTANCE_TYPE (i) == IMAGE_NOTHING)
+ /* objects like this exist at dump time, so don't bomb out. */
+ return;
+ if (for_disksave) finalose (i);
+
+ MAYBE_DEVMETH (XDEVICE (i->device), finalize_image_instance, (i));
+}
+
+static int
+image_instance_equal (Lisp_Object o1, Lisp_Object o2, int depth)
+{
+ struct Lisp_Image_Instance *i1 = XIMAGE_INSTANCE (o1);
+ struct Lisp_Image_Instance *i2 = XIMAGE_INSTANCE (o2);
+ 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))
+ return 0;
+ if (!internal_equal (IMAGE_INSTANCE_NAME (i1), IMAGE_INSTANCE_NAME (i2),
+ depth + 1))
+ return 0;
+
+ switch (IMAGE_INSTANCE_TYPE (i1))
+ {
+ case IMAGE_NOTHING:
+ break;
+
+ case IMAGE_TEXT:
+ if (!internal_equal (IMAGE_INSTANCE_TEXT_STRING (i1),
+ IMAGE_INSTANCE_TEXT_STRING (i2),
+ depth + 1))
+ return 0;
+ break;
+
+ 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) ==
+ IMAGE_INSTANCE_PIXMAP_DEPTH (i2) &&
+ EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i1),
+ IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i2)) &&
+ EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i1),
+ IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i2)) &&
+ internal_equal (IMAGE_INSTANCE_PIXMAP_FILENAME (i1),
+ IMAGE_INSTANCE_PIXMAP_FILENAME (i2),
+ depth + 1) &&
+ internal_equal (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i1),
+ IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i2),
+ depth + 1)))
+ return 0;
+ break;
+
+ case IMAGE_SUBWINDOW:
+ /* #### implement me */
+ break;
+
+ default:
+ abort ();
+ }
+
+ return DEVMETH_OR_GIVEN (d1, image_instance_equal, (i1, i2, depth), 1);
+}
+
+static unsigned long
+image_instance_hash (Lisp_Object obj, int depth)
+{
+ struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
+ struct device *d = XDEVICE (i->device);
+ unsigned long hash = (unsigned long) d;
+
+ switch (IMAGE_INSTANCE_TYPE (i))
+ {
+ case IMAGE_NOTHING:
+ break;
+
+ case IMAGE_TEXT:
+ hash = HASH2 (hash, internal_hash (IMAGE_INSTANCE_TEXT_STRING (i),
+ depth + 1));
+ break;
+
+ 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),
+ internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i),
+ depth + 1));
+ break;
+
+ case IMAGE_SUBWINDOW:
+ /* #### implement me */
+ break;
+
+ default:
+ abort ();
+ }
+
+ return HASH2 (hash, DEVMETH_OR_GIVEN (d, image_instance_hash, (i, depth),
+ 0));
+}
+
+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);
+
+static Lisp_Object
+allocate_image_instance (Lisp_Object device)
+{
+ struct Lisp_Image_Instance *lp =
+ alloc_lcrecord_type (struct Lisp_Image_Instance, lrecord_image_instance);
+ Lisp_Object val;
+
+ zero_lcrecord (lp);
+ lp->device = device;
+ lp->type = IMAGE_NOTHING;
+ lp->name = Qnil;
+ XSETIMAGE_INSTANCE (val, lp);
+ return val;
+}
+
+static enum image_instance_type
+decode_image_instance_type (Lisp_Object type, Error_behavior errb)
+{
+ if (ERRB_EQ (errb, ERROR_ME))
+ CHECK_SYMBOL (type);
+
+ if (EQ (type, Qnothing)) return IMAGE_NOTHING;
+ if (EQ (type, Qtext)) return IMAGE_TEXT;
+ if (EQ (type, Qmono_pixmap)) return IMAGE_MONO_PIXMAP;
+ if (EQ (type, Qcolor_pixmap)) return IMAGE_COLOR_PIXMAP;
+ if (EQ (type, Qpointer)) return IMAGE_POINTER;
+ if (EQ (type, Qsubwindow)) return IMAGE_SUBWINDOW;
+
+ maybe_signal_simple_error ("Invalid image-instance type", type,
+ Qimage, errb);
+
+ return IMAGE_UNKNOWN; /* not reached */
+}
+
+static Lisp_Object
+encode_image_instance_type (enum image_instance_type type)
+{
+ switch (type)
+ {
+ case IMAGE_NOTHING: return Qnothing;
+ case IMAGE_TEXT: return Qtext;
+ case IMAGE_MONO_PIXMAP: return Qmono_pixmap;
+ case IMAGE_COLOR_PIXMAP: return Qcolor_pixmap;
+ case IMAGE_POINTER: return Qpointer;
+ case IMAGE_SUBWINDOW: return Qsubwindow;
+ default:
+ abort ();
+ }
+
+ return Qnil; /* not reached */
+}
+
+static int
+image_instance_type_to_mask (enum image_instance_type type)
+{
+ /* 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,
+ so there should be no portability problems here. */
+ return (1 << ((int) (type) - 1));
+}
+
+static int
+decode_image_instance_type_list (Lisp_Object list)
+{
+ Lisp_Object rest;
+ int mask = 0;
+
+ if (NILP (list))
+ return ~0;
+
+ if (!CONSP (list))
+ {
+ enum image_instance_type type =
+ decode_image_instance_type (list, ERROR_ME);
+ return image_instance_type_to_mask (type);
+ }
+
+ EXTERNAL_LIST_LOOP (rest, list)
+ {
+ enum image_instance_type type =
+ decode_image_instance_type (XCAR (rest), ERROR_ME);
+ mask |= image_instance_type_to_mask (type);
+ }
+
+ return mask;
+}
+
+static Lisp_Object
+encode_image_instance_type_list (int mask)
+{
+ int count = 0;
+ Lisp_Object result = Qnil;
+
+ while (mask)
+ {
+ count++;
+ if (mask & 1)
+ result = Fcons (encode_image_instance_type
+ ((enum image_instance_type) count), result);
+ mask >>= 1;
+ }
+
+ return Fnreverse (result);
+}
+
+DOESNT_RETURN
+incompatible_image_types (Lisp_Object instantiator, int given_dest_mask,
+ int desired_dest_mask)
+{
+ signal_error
+ (Qerror,
+ list2
+ (emacs_doprnt_string_lisp_2
+ ((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),
+ encode_image_instance_type_list (given_dest_mask)),
+ instantiator));
+}
+
+static int
+valid_image_instance_type_p (Lisp_Object type)
+{
+ return !NILP (memq_no_quit (type, Vimage_instance_type_list));
+}
+
+DEFUN ("valid-image-instance-type-p", Fvalid_image_instance_type_p, 1, 1, 0, /*
+Given an IMAGE-INSTANCE-TYPE, return non-nil if it is valid.
+Valid types are some subset of 'nothing, 'text, 'mono-pixmap, 'color-pixmap,
+'pointer, and 'subwindow, depending on how XEmacs was compiled.
+*/
+ (image_instance_type))
+{
+ return valid_image_instance_type_p (image_instance_type) ? Qt : Qnil;
+}
+
+DEFUN ("image-instance-type-list", Fimage_instance_type_list, 0, 0, 0, /*
+Return a list of valid image-instance types.
+*/
+ ())
+{
+ return Fcopy_sequence (Vimage_instance_type_list);
+}
+
+Error_behavior
+decode_error_behavior_flag (Lisp_Object no_error)
+{
+ if (NILP (no_error)) return ERROR_ME;
+ else if (EQ (no_error, Qt)) return ERROR_ME_NOT;
+ else return ERROR_ME_WARN;
+}
+
+Lisp_Object
+encode_error_behavior_flag (Error_behavior errb)
+{
+ if (ERRB_EQ (errb, ERROR_ME))
+ return Qnil;
+ else if (ERRB_EQ (errb, ERROR_ME_NOT))
+ return Qt;
+ else
+ {
+ assert (ERRB_EQ (errb, ERROR_ME_WARN));
+ return Qwarning;
+ }
+}
+
+static Lisp_Object
+make_image_instance_1 (Lisp_Object data, Lisp_Object device,
+ Lisp_Object dest_types)
+{
+ Lisp_Object ii;
+ struct gcpro gcpro1;
+ int dest_mask;
+
+ XSETDEVICE (device, decode_device (device));
+ /* instantiate_image_instantiator() will abort if given an
+ image instance ... */
+ if (IMAGE_INSTANCEP (data))
+ signal_simple_error ("image instances not allowed here", data);
+ image_validate (data);
+ dest_mask = decode_image_instance_type_list (dest_types);
+ data = normalize_image_instantiator (data, DEVICE_TYPE (XDEVICE (device)),
+ make_int (dest_mask));
+ GCPRO1 (data);
+ 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);
+ RETURN_UNGCPRO (ii);
+}
+
+DEFUN ("make-image-instance", Fmake_image_instance, 1, 4, 0, /*
+Return a new `image-instance' object.
+
+Image-instance objects encapsulate the way a particular image (pixmap,
+etc.) is displayed on a particular device. In most circumstances, you
+do not need to directly create image instances; use a glyph instead.
+However, it may occasionally be useful to explicitly create image
+instances, if you want more control over the instantiation process.
+
+DATA is an image instantiator, which describes the image; see
+`image-specifier-p' for a description of the allowed values.
+
+DEST-TYPES should be a list of allowed image instance types that can
+be generated. The recognized image instance types are
+
+'nothing
+ Nothing is displayed.
+'text
+ Displayed as text. The foreground and background colors and the
+ font of the text are specified independent of the pixmap. Typically
+ these attributes will come from the face of the surrounding text,
+ unless a face is specified for the glyph in which the image appears.
+'mono-pixmap
+ Displayed as a mono pixmap (a pixmap with only two colors where the
+ foreground and background can be specified independent of the pixmap;
+ typically the pixmap assumes the foreground and background colors of
+ the text around it, unless a face is specified for the glyph in which
+ the image appears).
+'color-pixmap
+ Displayed as a color pixmap.
+'pointer
+ Used as the mouse pointer for a window.
+'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.
+
+The DEST-TYPES list is unordered. If multiple destination types
+are possible for a given instantiator, the "most natural" type
+for the instantiator's format is chosen. (For XBM, the most natural
+types are `mono-pixmap', followed by `color-pixmap', followed by
+`pointer'. For the other normal image formats, the most natural
+types are `color-pixmap', followed by `mono-pixmap', followed by
+`pointer'. For the string and formatted-string formats, the most
+natural types are `text', followed by `mono-pixmap' (not currently
+implemented), followed by `color-pixmap' (not currently implemented).
+The other formats can only be instantiated as one type. (If you
+want to control more specifically the order of the types into which
+an image is instantiated, just call `make-image-instance' repeatedly
+until it succeeds, passing less and less preferred destination types
+each time.
+
+If DEST-TYPES is omitted, all possible types are allowed.
+
+NO-ERROR controls what happens when the image cannot be generated.
+If nil, an error message is generated. If t, no messages are
+generated and this function returns nil. If anything else, a warning
+message is generated and this function returns nil.
+*/
+ (data, device, dest_types, no_error))
+{
+ Error_behavior errb = decode_error_behavior_flag (no_error);
+
+ return call_with_suspended_errors ((lisp_fn_t) make_image_instance_1,
+ Qnil, Qimage, errb,
+ 3, data, device, dest_types);
+}
+
+DEFUN ("image-instance-p", Fimage_instance_p, 1, 1, 0, /*
+Return non-nil if OBJECT is an image instance.
+*/
+ (object))
+{
+ return IMAGE_INSTANCEP (object) ? Qt : Qnil;
+}
+
+DEFUN ("image-instance-type", Fimage_instance_type, 1, 1, 0, /*
+Return the type of the given image instance.
+The return value will be one of 'nothing, 'text, 'mono-pixmap,
+'color-pixmap, 'pointer, or 'subwindow.
+*/
+ (image_instance))
+{
+ CHECK_IMAGE_INSTANCE (image_instance);
+ return encode_image_instance_type (XIMAGE_INSTANCE_TYPE (image_instance));
+}
+
+DEFUN ("image-instance-name", Fimage_instance_name, 1, 1, 0, /*
+Return the name of the given image instance.
+*/
+ (image_instance))
+{
+ CHECK_IMAGE_INSTANCE (image_instance);
+ return XIMAGE_INSTANCE_NAME (image_instance);
+}
+
+DEFUN ("image-instance-string", Fimage_instance_string, 1, 1, 0, /*
+Return the string of the given image instance.
+This will only be non-nil for text image instances.
+*/
+ (image_instance))
+{
+ CHECK_IMAGE_INSTANCE (image_instance);
+ if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_TEXT)
+ return XIMAGE_INSTANCE_TEXT_STRING (image_instance);
+ else
+ return Qnil;
+}
+
+DEFUN ("image-instance-file-name", Fimage_instance_file_name, 1, 1, 0, /*
+Return the file name from which IMAGE-INSTANCE was read, if known.
+*/
+ (image_instance))
+{
+ CHECK_IMAGE_INSTANCE (image_instance);
+
+ switch (XIMAGE_INSTANCE_TYPE (image_instance))
+ {
+ case IMAGE_MONO_PIXMAP:
+ case IMAGE_COLOR_PIXMAP:
+ case IMAGE_POINTER:
+ return XIMAGE_INSTANCE_PIXMAP_FILENAME (image_instance);
+
+ default:
+ return Qnil;
+ }
+}
+
+DEFUN ("image-instance-mask-file-name", Fimage_instance_mask_file_name, 1, 1, 0, /*
+Return the file name from which IMAGE-INSTANCE's mask was read, if known.
+*/
+ (image_instance))
+{
+ CHECK_IMAGE_INSTANCE (image_instance);
+
+ switch (XIMAGE_INSTANCE_TYPE (image_instance))
+ {
+ case IMAGE_MONO_PIXMAP:
+ case IMAGE_COLOR_PIXMAP:
+ case IMAGE_POINTER:
+ return XIMAGE_INSTANCE_PIXMAP_MASK_FILENAME (image_instance);
+
+ default:
+ return Qnil;
+ }
+}
+
+DEFUN ("image-instance-depth", Fimage_instance_depth, 1, 1, 0, /*
+Return the depth of the image instance.
+This is 0 for a bitmap, or a positive integer for a pixmap.
+*/
+ (image_instance))
+{
+ CHECK_IMAGE_INSTANCE (image_instance);
+
+ switch (XIMAGE_INSTANCE_TYPE (image_instance))
+ {
+ case IMAGE_MONO_PIXMAP:
+ case IMAGE_COLOR_PIXMAP:
+ case IMAGE_POINTER:
+ return make_int (XIMAGE_INSTANCE_PIXMAP_DEPTH (image_instance));
+
+ default:
+ return Qnil;
+ }
+}
+
+DEFUN ("image-instance-height", Fimage_instance_height, 1, 1, 0, /*
+Return the height of the image instance, in pixels.
+*/
+ (image_instance))
+{
+ CHECK_IMAGE_INSTANCE (image_instance);
+
+ switch (XIMAGE_INSTANCE_TYPE (image_instance))
+ {
+ case IMAGE_MONO_PIXMAP:
+ case IMAGE_COLOR_PIXMAP:
+ case IMAGE_POINTER:
+ return make_int (XIMAGE_INSTANCE_PIXMAP_HEIGHT (image_instance));
+
+ default:
+ return Qnil;
+ }
+}
+
+DEFUN ("image-instance-width", Fimage_instance_width, 1, 1, 0, /*
+Return the width of the image instance, in pixels.
+*/
+ (image_instance))
+{
+ CHECK_IMAGE_INSTANCE (image_instance);
+
+ switch (XIMAGE_INSTANCE_TYPE (image_instance))
+ {
+ case IMAGE_MONO_PIXMAP:
+ case IMAGE_COLOR_PIXMAP:
+ case IMAGE_POINTER:
+ return make_int (XIMAGE_INSTANCE_PIXMAP_WIDTH (image_instance));
+
+ default:
+ return Qnil;
+ }
+}
+
+DEFUN ("image-instance-hotspot-x", Fimage_instance_hotspot_x, 1, 1, 0, /*
+Return the X coordinate of the image instance's hotspot, if known.
+This is a point relative to the origin of the pixmap. When an image is
+ used as a mouse pointer, the hotspot is the point on the image that sits
+ over the location that the pointer points to. This is, for example, the
+ tip of the arrow or the center of the crosshairs.
+This will always be nil for a non-pointer image instance.
+*/
+ (image_instance))
+{
+ CHECK_IMAGE_INSTANCE (image_instance);
+
+ switch (XIMAGE_INSTANCE_TYPE (image_instance))
+ {
+ case IMAGE_MONO_PIXMAP:
+ case IMAGE_COLOR_PIXMAP:
+ case IMAGE_POINTER:
+ return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_X (image_instance);
+
+ default:
+ return Qnil;
+ }
+}
+
+DEFUN ("image-instance-hotspot-y", Fimage_instance_hotspot_y, 1, 1, 0, /*
+Return the Y coordinate of the image instance's hotspot, if known.
+This is a point relative to the origin of the pixmap. When an image is
+ used as a mouse pointer, the hotspot is the point on the image that sits
+ over the location that the pointer points to. This is, for example, the
+ tip of the arrow or the center of the crosshairs.
+This will always be nil for a non-pointer image instance.
+*/
+ (image_instance))
+{
+ CHECK_IMAGE_INSTANCE (image_instance);
+
+ switch (XIMAGE_INSTANCE_TYPE (image_instance))
+ {
+ case IMAGE_MONO_PIXMAP:
+ case IMAGE_COLOR_PIXMAP:
+ case IMAGE_POINTER:
+ return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (image_instance);
+
+ default:
+ return Qnil;
+ }
+}
+
+DEFUN ("image-instance-foreground", Fimage_instance_foreground, 1, 1, 0, /*
+Return the foreground color of IMAGE-INSTANCE, if applicable.
+This will be a color instance or nil. (It will only be non-nil for
+colorized mono pixmaps and for pointers.)
+*/
+ (image_instance))
+{
+ CHECK_IMAGE_INSTANCE (image_instance);
+
+ switch (XIMAGE_INSTANCE_TYPE (image_instance))
+ {
+ case IMAGE_MONO_PIXMAP:
+ case IMAGE_COLOR_PIXMAP:
+ case IMAGE_POINTER:
+ return XIMAGE_INSTANCE_PIXMAP_FG (image_instance);
+
+ default:
+ return Qnil;
+ }
+}
+
+DEFUN ("image-instance-background", Fimage_instance_background, 1, 1, 0, /*
+Return the background color of IMAGE-INSTANCE, if applicable.
+This will be a color instance or nil. (It will only be non-nil for
+colorized mono pixmaps and for pointers.)
+*/
+ (image_instance))
+{
+ CHECK_IMAGE_INSTANCE (image_instance);
+
+ switch (XIMAGE_INSTANCE_TYPE (image_instance))
+ {
+ case IMAGE_MONO_PIXMAP:
+ case IMAGE_COLOR_PIXMAP:
+ case IMAGE_POINTER:
+ return XIMAGE_INSTANCE_PIXMAP_BG (image_instance);
+
+ default:
+ return Qnil;
+ }
+}
+
+
+DEFUN ("colorize-image-instance", Fcolorize_image_instance, 3, 3, 0, /*
+Make the image instance be displayed in the given colors.
+This function returns a new image instance that is exactly like the
+specified one except that (if possible) the foreground and background
+colors and as specified. Currently, this only does anything if the image
+instance is a mono pixmap; otherwise, the same image instance is returned.
+*/
+ (image_instance, foreground, background))
+{
+ Lisp_Object new;
+ Lisp_Object device;
+
+ CHECK_IMAGE_INSTANCE (image_instance);
+ CHECK_COLOR_INSTANCE (foreground);
+ CHECK_COLOR_INSTANCE (background);
+
+ device = XIMAGE_INSTANCE_DEVICE (image_instance);
+ if (!HAS_DEVMETH_P (XDEVICE (device), colorize_image_instance))
+ return image_instance;
+
+ new = allocate_image_instance (device);
+ 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
+ freed, the other one is not hosed. */
+ if (!DEVMETH (XDEVICE (device), colorize_image_instance, (new, foreground,
+ background)))
+ return image_instance;
+ return new;
+}
+
+\f
+/************************************************************************/
+/* error helpers */
+/************************************************************************/
+DOESNT_RETURN
+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_error (Qimage_conversion_error,
+ list3 (build_translated_string (reason), frob0, frob1));
+}
+
+/****************************************************************************
+ * nothing *
+ ****************************************************************************/
+
+static int
+nothing_possible_dest_types (void)
+{
+ return IMAGE_NOTHING_MASK;
+}
+
+static void
+nothing_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);
+
+ if (dest_mask & IMAGE_NOTHING_MASK)
+ IMAGE_INSTANCE_TYPE (ii) = IMAGE_NOTHING;
+ else
+ incompatible_image_types (instantiator, dest_mask, IMAGE_NOTHING_MASK);
+}
+
+\f
+/****************************************************************************
+ * inherit *
+ ****************************************************************************/
+
+static void
+inherit_validate (Lisp_Object instantiator)
+{
+ face_must_be_present (instantiator);
+}
+
+static Lisp_Object
+inherit_normalize (Lisp_Object inst, Lisp_Object console_type)
+{
+ Lisp_Object face;
+
+ assert (XVECTOR_LENGTH (inst) == 3);
+ face = XVECTOR_DATA (inst)[2];
+ if (!FACEP (face))
+ inst = vector3 (Qinherit, Q_face, Fget_face (face));
+ return inst;
+}
+
+static int
+inherit_possible_dest_types (void)
+{
+ return IMAGE_MONO_PIXMAP_MASK;
+}
+
+static void
+inherit_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
+ Lisp_Object pointer_fg, Lisp_Object pointer_bg,
+ int dest_mask, Lisp_Object domain)
+{
+ /* handled specially in image_instantiate */
+ abort ();
+}
+
+\f
+/****************************************************************************
+ * string *
+ ****************************************************************************/
+
+static void
+string_validate (Lisp_Object instantiator)
+{
+ data_must_be_present (instantiator);
+}
+
+static int
+string_possible_dest_types (void)
+{
+ return IMAGE_TEXT_MASK;
+}
+
+/* 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));
+ 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);
+}
+
+\f
+/****************************************************************************
+ * formatted-string *
+ ****************************************************************************/
+
+static void
+formatted_string_validate (Lisp_Object instantiator)
+{
+ data_must_be_present (instantiator);
+}
+
+static int
+formatted_string_possible_dest_types (void)
+{
+ return IMAGE_TEXT_MASK;
+}
+
+static void
+formatted_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));
+ /* #### 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);
+}
+
+\f
+/************************************************************************/
+/* pixmap file functions */
+/************************************************************************/
+
+/* If INSTANTIATOR refers to inline data, return Qnil.
+ If INSTANTIATOR refers to data in a file, return the full filename
+ if it exists; otherwise, return a cons of (filename).
+
+ FILE_KEYWORD and DATA_KEYWORD are symbols specifying the
+ keywords used to look up the file and inline data,
+ respectively, in the instantiator. Normally these would
+ be Q_file and Q_data, but might be different for mask data. */
+
+Lisp_Object
+potential_pixmap_file_instantiator (Lisp_Object instantiator,
+ Lisp_Object file_keyword,
+ Lisp_Object data_keyword,
+ Lisp_Object console_type)
+{
+ Lisp_Object file;
+ Lisp_Object data;
+
+ assert (VECTORP (instantiator));
+
+ data = find_keyword_in_vector (instantiator, data_keyword);
+ file = find_keyword_in_vector (instantiator, file_keyword);
+
+ if (!NILP (file) && NILP (data))
+ {
+ Lisp_Object retval = MAYBE_LISP_CONTYPE_METH
+ (decode_console_type(console_type, ERROR_ME),
+ locate_pixmap_file, (file));
+
+ if (!NILP (retval))
+ return retval;
+ else
+ return Fcons (file, Qnil); /* should have been file */
+ }
+
+ return Qnil;
+}
+
+Lisp_Object
+simple_image_type_normalize (Lisp_Object inst, Lisp_Object console_type,
+ Lisp_Object image_type_tag)
+{
+ /* This function can call lisp */
+ Lisp_Object file = Qnil;
+ struct gcpro gcpro1, gcpro2;
+ Lisp_Object alist = Qnil;
+
+ GCPRO2 (file, alist);
+
+ /* Now, convert any file data into inline data. At the end of this,
+ `data' will contain the inline data (if any) or Qnil, and `file'
+ will contain the name this data was derived from (if known) or
+ Qnil.
+
+ Note that if we cannot generate any regular inline data, we
+ skip out. */
+
+ file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
+ console_type);
+
+ if (CONSP (file)) /* failure locating filename */
+ signal_double_file_error ("Opening pixmap file",
+ "no such file or directory",
+ Fcar (file));
+
+ if (NILP (file)) /* no conversion necessary */
+ RETURN_UNGCPRO (inst);
+
+ alist = tagged_vector_to_alist (inst);
+
+ {
+ Lisp_Object data = make_string_from_file (file);
+ alist = remassq_no_quit (Q_file, alist);
+ /* there can't be a :data at this point. */
+ alist = Fcons (Fcons (Q_file, file),
+ Fcons (Fcons (Q_data, data), alist));
+ }
+
+ {
+ Lisp_Object result = alist_to_tagged_vector (image_type_tag, alist);
+ free_alist (alist);
+ RETURN_UNGCPRO (result);
+ }
+}
+
+\f
+#ifdef HAVE_WINDOW_SYSTEM
+/**********************************************************************
+ * XBM *
+ **********************************************************************/
+
+/* Check if DATA represents a valid inline XBM spec (i.e. a list
+ of (width height bits), with checking done on the dimensions).
+ If not, signal an error. */
+
+static void
+check_valid_xbm_inline (Lisp_Object data)
+{
+ Lisp_Object width, height, bits;
+
+ if (!CONSP (data) ||
+ !CONSP (XCDR (data)) ||
+ !CONSP (XCDR (XCDR (data))) ||
+ !NILP (XCDR (XCDR (XCDR (data)))))
+ signal_simple_error ("Must be list of 3 elements", data);
+
+ width = XCAR (data);
+ height = XCAR (XCDR (data));
+ bits = XCAR (XCDR (XCDR (data)));
+
+ CHECK_STRING (bits);
+
+ if (!NATNUMP (width))
+ signal_simple_error ("Width must be a natural number", width);
+
+ if (!NATNUMP (height))
+ signal_simple_error ("Height must be a natural number", height);
+
+ if (((XINT (width) * XINT (height)) / 8) > XSTRING_CHAR_LENGTH (bits))
+ signal_simple_error ("data is too short for width and height",
+ vector3 (width, height, bits));
+}
+
+/* Validate method for XBM's. */
+
+static void
+xbm_validate (Lisp_Object instantiator)
+{
+ file_or_data_must_be_present (instantiator);
+}
+
+/* Given a filename that is supposed to contain XBM data, return
+ the inline representation of it as (width height bits). Return
+ the hotspot through XHOT and YHOT, if those pointers are not 0.
+ If there is no hotspot, XHOT and YHOT will contain -1.
+
+ If the function fails:
+
+ -- if OK_IF_DATA_INVALID is set and the data was invalid,
+ return Qt.
+ -- maybe return an error, or return Qnil.
+ */
+
+#ifndef HAVE_X_WINDOWS
+#define XFree(data) free(data)
+#endif
+
+Lisp_Object
+bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot,
+ int ok_if_data_invalid)
+{
+ unsigned int w, h;
+ Extbyte *data;
+ int result;
+ CONST char *filename_ext;
+
+ GET_C_STRING_FILENAME_DATA_ALLOCA (name, filename_ext);
+ result = read_bitmap_data_from_file (filename_ext, &w, &h,
+ &data, xhot, yhot);
+
+ if (result == BitmapSuccess)
+ {
+ Lisp_Object retval;
+ int len = (w + 7) / 8 * h;
+
+ retval = list3 (make_int (w), make_int (h),
+ make_ext_string (data, len, FORMAT_BINARY));
+ XFree ((char *) data);
+ return retval;
+ }
+
+ switch (result)
+ {
+ case BitmapOpenFailed:
+ {
+ /* should never happen */
+ signal_double_file_error ("Opening bitmap file",
+ "no such file or directory",
+ name);
+ }
+ case BitmapFileInvalid:
+ {
+ if (ok_if_data_invalid)
+ return Qt;
+ signal_double_file_error ("Reading bitmap file",
+ "invalid data in file",
+ name);
+ }
+ case BitmapNoMemory:
+ {
+ signal_double_file_error ("Reading bitmap file",
+ "out of memory",
+ name);
+ }
+ default:
+ {
+ signal_double_file_error_2 ("Reading bitmap file",
+ "unknown error code",
+ make_int (result), name);
+ }
+ }
+
+ return Qnil; /* not reached */
+}
+
+Lisp_Object
+xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file,
+ Lisp_Object mask_file, Lisp_Object console_type)
+{
+ /* This is unclean but it's fairly standard -- a number of the
+ bitmaps in /usr/include/X11/bitmaps use it -- so we support
+ it. */
+ if (NILP (mask_file)
+ /* don't override explicitly specified mask data. */
+ && NILP (assq_no_quit (Q_mask_data, alist))
+ && !NILP (file))
+ {
+ mask_file = MAYBE_LISP_CONTYPE_METH
+ (decode_console_type(console_type, ERROR_ME),
+ locate_pixmap_file, (concat2 (file, build_string ("Mask"))));
+ if (NILP (mask_file))
+ mask_file = MAYBE_LISP_CONTYPE_METH
+ (decode_console_type(console_type, ERROR_ME),
+ locate_pixmap_file, (concat2 (file, build_string ("msk"))));
+ }
+
+ if (!NILP (mask_file))
+ {
+ Lisp_Object mask_data =
+ bitmap_to_lisp_data (mask_file, 0, 0, 0);
+ alist = remassq_no_quit (Q_mask_file, alist);
+ /* there can't be a :mask-data at this point. */
+ alist = Fcons (Fcons (Q_mask_file, mask_file),
+ Fcons (Fcons (Q_mask_data, mask_data), alist));
+ }
+
+ return alist;
+}
+
+/* Normalize method for XBM's. */
+
+static Lisp_Object
+xbm_normalize (Lisp_Object inst, Lisp_Object console_type)
+{
+ Lisp_Object file = Qnil, mask_file = Qnil;
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ Lisp_Object alist = Qnil;
+
+ GCPRO3 (file, mask_file, alist);
+
+ /* Now, convert any file data into inline data for both the regular
+ data and the mask data. At the end of this, `data' will contain
+ the inline data (if any) or Qnil, and `file' will contain
+ the name this data was derived from (if known) or Qnil.
+ Likewise for `mask_file' and `mask_data'.
+
+ Note that if we cannot generate any regular inline data, we
+ skip out. */
+
+ file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
+ console_type);
+ mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
+ Q_mask_data, console_type);
+
+ if (CONSP (file)) /* failure locating filename */
+ signal_double_file_error ("Opening bitmap file",
+ "no such file or directory",
+ Fcar (file));
+
+ if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
+ RETURN_UNGCPRO (inst);
+
+ alist = tagged_vector_to_alist (inst);
+
+ if (!NILP (file))
+ {
+ int xhot, yhot;
+ Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0);
+ alist = remassq_no_quit (Q_file, alist);
+ /* there can't be a :data at this point. */
+ alist = Fcons (Fcons (Q_file, file),
+ Fcons (Fcons (Q_data, data), alist));
+
+ if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist)))
+ alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
+ alist);
+ if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist)))
+ alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
+ alist);
+ }
+
+ alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
+
+ {
+ Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
+ free_alist (alist);
+ RETURN_UNGCPRO (result);
+ }
+}
+
+\f
+static int
+xbm_possible_dest_types (void)
+{
+ return
+ IMAGE_MONO_PIXMAP_MASK |
+ IMAGE_COLOR_PIXMAP_MASK |
+ IMAGE_POINTER_MASK;
+}
+
+static void
+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 device= IMAGE_INSTANCE_DEVICE (XIMAGE_INSTANCE (image_instance));
+
+ MAYBE_DEVMETH (XDEVICE (device),
+ xbm_instantiate,
+ (image_instance, instantiator, pointer_fg,
+ pointer_bg, dest_mask, domain));
+}
+
+#endif
+
+\f
+#ifdef HAVE_XPM
+
+/**********************************************************************
+ * XPM *
+ **********************************************************************/
+
+Lisp_Object
+pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid)
+{
+ char **data;
+ int result;
+
+ result = XpmReadFileToData ((char *) XSTRING_DATA (name), &data);
+
+ if (result == XpmSuccess)
+ {
+ Lisp_Object retval = Qnil;
+ struct buffer *old_buffer = current_buffer;
+ Lisp_Object temp_buffer =
+ Fget_buffer_create (build_string (" *pixmap conversion*"));
+ int elt;
+ int height, width, ncolors;
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ int speccount = specpdl_depth ();
+
+ GCPRO3 (name, retval, temp_buffer);
+
+ specbind (Qinhibit_quit, Qt);
+ set_buffer_internal (XBUFFER (temp_buffer));
+ Ferase_buffer (Qnil);
+
+ buffer_insert_c_string (current_buffer, "/* XPM */\r");
+ buffer_insert_c_string (current_buffer, "static char *pixmap[] = {\r");
+
+ sscanf (data[0], "%d %d %d", &height, &width, &ncolors);
+ for (elt = 0; elt <= width + ncolors; elt++)
+ {
+ buffer_insert_c_string (current_buffer, "\"");
+ buffer_insert_c_string (current_buffer, data[elt]);
+
+ if (elt < width + ncolors)
+ buffer_insert_c_string (current_buffer, "\",\r");
+ else
+ buffer_insert_c_string (current_buffer, "\"};\r");
+ }
+
+ retval = Fbuffer_substring (Qnil, Qnil, Qnil);
+ XpmFree (data);
+
+ set_buffer_internal (old_buffer);
+ unbind_to (speccount, Qnil);
+
+ RETURN_UNGCPRO (retval);
+ }
+
+ switch (result)
+ {
+ case XpmFileInvalid:
+ {
+ if (ok_if_data_invalid)
+ return Qt;
+ signal_image_error ("invalid XPM data in file", name);
+ }
+ case XpmNoMemory:
+ {
+ signal_double_file_error ("Reading pixmap file",
+ "out of memory", name);
+ }
+ case XpmOpenFailed:
+ {
+ /* should never happen? */
+ signal_double_file_error ("Opening pixmap file",
+ "no such file or directory", name);
+ }
+ default:
+ {
+ signal_double_file_error_2 ("Parsing pixmap file",
+ "unknown error code",
+ make_int (result), name);
+ break;
+ }
+ }
+
+ return Qnil; /* not reached */
+}
+
+static void
+check_valid_xpm_color_symbols (Lisp_Object data)
+{
+ Lisp_Object rest;
+
+ for (rest = data; !NILP (rest); rest = XCDR (rest))
+ {
+ if (!CONSP (rest) ||
+ !CONSP (XCAR (rest)) ||
+ !STRINGP (XCAR (XCAR (rest))) ||
+ (!STRINGP (XCDR (XCAR (rest))) &&
+ !COLOR_SPECIFIERP (XCDR (XCAR (rest)))))
+ signal_simple_error ("Invalid color symbol alist", data);
+ }
+}
+
+static void
+xpm_validate (Lisp_Object instantiator)
+{
+ file_or_data_must_be_present (instantiator);
+}
+
+Lisp_Object Vxpm_color_symbols;
+
+Lisp_Object
+evaluate_xpm_color_symbols (void)
+{
+ Lisp_Object rest, results = Qnil;
+ struct gcpro gcpro1, gcpro2;
+
+ GCPRO2 (rest, results);
+ for (rest = Vxpm_color_symbols; !NILP (rest); rest = XCDR (rest))
+ {
+ Lisp_Object name, value, cons;
+
+ CHECK_CONS (rest);
+ cons = XCAR (rest);
+ CHECK_CONS (cons);
+ name = XCAR (cons);
+ CHECK_STRING (name);
+ value = XCDR (cons);
+ CHECK_CONS (value);
+ value = XCAR (value);
+ value = Feval (value);
+ if (NILP (value))
+ continue;
+ if (!STRINGP (value) && !COLOR_SPECIFIERP (value))
+ signal_simple_error
+ ("Result from xpm-color-symbols eval must be nil, string, or color",
+ value);
+ results = Fcons (Fcons (name, value), results);
+ }
+ UNGCPRO; /* no more evaluation */
+ return results;
+}
+
+static Lisp_Object
+xpm_normalize (Lisp_Object inst, Lisp_Object console_type)
+{
+ Lisp_Object file = Qnil;
+ Lisp_Object color_symbols;
+ struct gcpro gcpro1, gcpro2;
+ Lisp_Object alist = Qnil;
+
+ GCPRO2 (file, alist);
+
+ /* Now, convert any file data into inline data. At the end of this,
+ `data' will contain the inline data (if any) or Qnil, and
+ `file' will contain the name this data was derived from (if
+ known) or Qnil.
+
+ Note that if we cannot generate any regular inline data, we
+ skip out. */
+
+ file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
+ console_type);
+
+ if (CONSP (file)) /* failure locating filename */
+ signal_double_file_error ("Opening pixmap file",
+ "no such file or directory",
+ Fcar (file));
+
+ color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols,
+ Qunbound);
+
+ if (NILP (file) && !UNBOUNDP (color_symbols))
+ /* no conversion necessary */
+ RETURN_UNGCPRO (inst);
+
+ alist = tagged_vector_to_alist (inst);
+
+ if (!NILP (file))
+ {
+ Lisp_Object data = pixmap_to_lisp_data (file, 0);
+ alist = remassq_no_quit (Q_file, alist);
+ /* there can't be a :data at this point. */
+ alist = Fcons (Fcons (Q_file, file),
+ Fcons (Fcons (Q_data, data), alist));
+ }
+
+ if (UNBOUNDP (color_symbols))
+ {
+ color_symbols = evaluate_xpm_color_symbols ();
+ alist = Fcons (Fcons (Q_color_symbols, color_symbols),
+ alist);
+ }
+
+ {
+ Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
+ free_alist (alist);
+ RETURN_UNGCPRO (result);
+ }
+}
+
+static int
+xpm_possible_dest_types (void)
+{
+ return
+ IMAGE_MONO_PIXMAP_MASK |
+ IMAGE_COLOR_PIXMAP_MASK |
+ IMAGE_POINTER_MASK;
+}
+
+static void
+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 device= IMAGE_INSTANCE_DEVICE (XIMAGE_INSTANCE (image_instance));
+
+ MAYBE_DEVMETH (XDEVICE (device),
+ xpm_instantiate,
+ (image_instance, instantiator, pointer_fg,
+ pointer_bg, dest_mask, domain));
+}
+
+#endif /* HAVE_XPM */
+
+\f
+/****************************************************************************
+ * Image Specifier Object *
+ ****************************************************************************/
+
+DEFINE_SPECIFIER_TYPE (image);
+
+static void
+image_create (Lisp_Object obj)
+{
+ struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
+
+ IMAGE_SPECIFIER_ALLOWED (image) = ~0; /* all are allowed */
+ IMAGE_SPECIFIER_ATTACHEE (image) = Qnil;
+ IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = Qnil;
+}
+
+static void
+image_mark (Lisp_Object obj, void (*markobj) (Lisp_Object))
+{
+ struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
+
+ ((markobj) (IMAGE_SPECIFIER_ATTACHEE (image)));
+ ((markobj) (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image)));
+}
+
+static Lisp_Object
+image_instantiate_cache_result (Lisp_Object locative)
+{
+ /* locative = (instance instantiator . subtable) */
+ Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative)));
+ free_cons (XCONS (XCDR (locative)));
+ free_cons (XCONS (locative));
+ return Qnil;
+}
+
+/* Given a specification for an image, return an instance of
+ the image which matches the given instantiator and which can be
+ displayed in the given domain. */
+
+static Lisp_Object
+image_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
+ Lisp_Object domain, Lisp_Object instantiator,
+ Lisp_Object depth)
+{
+ Lisp_Object device = DFW_DEVICE (domain);
+ struct device *d = XDEVICE (device);
+ int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier);
+ int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER);
+
+ if (IMAGE_INSTANCEP (instantiator))
+ {
+ /* make sure that the image instance's device and type are
+ matching. */
+
+ if (EQ (device, XIMAGE_INSTANCE_DEVICE (instantiator)))
+ {
+ int mask =
+ image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instantiator));
+ if (mask & dest_mask)
+ return instantiator;
+ else
+ signal_simple_error ("Type of image instance not allowed here",
+ instantiator);
+ }
+ else
+ signal_simple_error_2 ("Wrong device for image instance",
+ instantiator, device);
+ }
+ else if (VECTORP (instantiator)
+ && EQ (XVECTOR_DATA (instantiator)[0], Qinherit))
+ {
+ assert (XVECTOR_LENGTH (instantiator) == 3);
+ return (FACE_PROPERTY_INSTANCE
+ (Fget_face (XVECTOR_DATA (instantiator)[2]),
+ Qbackground_pixmap, domain, 0, depth));
+ }
+ else
+ {
+ Lisp_Object instance;
+ Lisp_Object subtable;
+ Lisp_Object ls3 = Qnil;
+ Lisp_Object pointer_fg = Qnil;
+ Lisp_Object pointer_bg = Qnil;
+
+ if (pointerp)
+ {
+ pointer_fg = FACE_FOREGROUND (Vpointer_face, domain);
+ pointer_bg = FACE_BACKGROUND (Vpointer_face, domain);
+ ls3 = list3 (instantiator, pointer_fg, pointer_bg);
+ }
+
+ /* First look in the hash table. */
+ subtable = Fgethash (make_int (dest_mask), d->image_instance_cache,
+ Qunbound);
+ if (UNBOUNDP (subtable))
+ {
+ /* 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
+ but not EQ (that can happen a lot with faces, because their
+ specifiers are copied around); but pixmaps tend not to be
+ in faces.
+
+ However, if the image-instance could be a pointer, we have to
+ use EQUAL because we massaged the instantiator into a cons3
+ also containing the foreground and background of the
+ pointer face.
+ */
+
+ subtable = make_lisp_hashtable (20,
+ pointerp ? HASHTABLE_KEY_CAR_WEAK
+ : HASHTABLE_KEY_WEAK,
+ pointerp ? HASHTABLE_EQUAL
+ : HASHTABLE_EQ);
+ Fputhash (make_int (dest_mask), subtable,
+ d->image_instance_cache);
+ instance = Qunbound;
+ }
+ else
+ instance = Fgethash (pointerp ? ls3 : instantiator,
+ subtable, Qunbound);
+
+ if (UNBOUNDP (instance))
+ {
+ Lisp_Object locative =
+ noseeum_cons (Qnil,
+ 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
+ the hash table. If we succeed, we change the
+ car of the locative to the resulting instance,
+ which gets recorded instead. */
+ record_unwind_protect (image_instantiate_cache_result,
+ locative);
+ instance = instantiate_image_instantiator (device,
+ domain,
+ instantiator,
+ pointer_fg, pointer_bg,
+ dest_mask);
+ Fsetcar (locative, instance);
+ unbind_to (speccount, Qnil);
+ }
+ else
+ free_list (ls3);
+
+ if (NILP (instance))
+ signal_simple_error ("Can't instantiate image (probably cached)",
+ instantiator);
+ return instance;
+ }
+
+ abort ();
+ return Qnil; /* not reached */
+}
+
+/* Validate an image instantiator. */
+
+static void
+image_validate (Lisp_Object instantiator)
+{
+ if (IMAGE_INSTANCEP (instantiator) || STRINGP (instantiator))
+ return;
+ else if (VECTORP (instantiator))
+ {
+ Lisp_Object *elt = XVECTOR_DATA (instantiator);
+ int instantiator_len = XVECTOR_LENGTH (instantiator);
+ struct image_instantiator_methods *meths;
+ Lisp_Object already_seen = Qnil;
+ struct gcpro gcpro1;
+ int i;
+
+ if (instantiator_len < 1)
+ signal_simple_error ("Vector length must be at least 1",
+ instantiator);
+
+ meths = decode_image_instantiator_format (elt[0], ERROR_ME);
+ if (!(instantiator_len & 1))
+ signal_simple_error
+ ("Must have alternating keyword/value pairs", instantiator);
+
+ GCPRO1 (already_seen);
+
+ for (i = 1; i < instantiator_len; i += 2)
+ {
+ Lisp_Object keyword = elt[i];
+ Lisp_Object value = elt[i+1];
+ int j;
+
+ CHECK_SYMBOL (keyword);
+ if (!SYMBOL_IS_KEYWORD (keyword))
+ signal_simple_error ("Symbol must begin with a colon", keyword);
+
+ for (j = 0; j < Dynarr_length (meths->keywords); j++)
+ if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
+ break;
+
+ if (j == Dynarr_length (meths->keywords))
+ signal_simple_error ("Unrecognized keyword", keyword);
+
+ if (!Dynarr_at (meths->keywords, j).multiple_p)
+ {
+ if (!NILP (memq_no_quit (keyword, already_seen)))
+ signal_simple_error
+ ("Keyword may not appear more than once", keyword);
+ already_seen = Fcons (keyword, already_seen);
+ }
+
+ (Dynarr_at (meths->keywords, j).validate) (value);
+ }
+
+ UNGCPRO;
+
+ MAYBE_IIFORMAT_METH (meths, validate, (instantiator));
+ }
+ else
+ signal_simple_error ("Must be string or vector", instantiator);
+}
+
+static void
+image_after_change (Lisp_Object specifier, Lisp_Object locale)
+{
+ Lisp_Object attachee =
+ IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
+ Lisp_Object property =
+ IMAGE_SPECIFIER_ATTACHEE_PROPERTY (XIMAGE_SPECIFIER (specifier));
+ if (FACEP (attachee))
+ face_property_was_changed (attachee, property, locale);
+ else if (GLYPHP (attachee))
+ glyph_property_was_changed (attachee, property, locale);
+}
+
+void
+set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph,
+ Lisp_Object property)
+{
+ struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
+
+ IMAGE_SPECIFIER_ATTACHEE (image) = face_or_glyph;
+ IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = property;
+}
+
+static Lisp_Object
+image_going_to_add (Lisp_Object specifier, Lisp_Object locale,
+ Lisp_Object tag_set, Lisp_Object instantiator)
+{
+ Lisp_Object possible_console_types = Qnil;
+ Lisp_Object rest;
+ Lisp_Object retlist = Qnil;
+ struct gcpro gcpro1, gcpro2;
+
+ LIST_LOOP (rest, Vconsole_type_list)
+ {
+ Lisp_Object contype = XCAR (rest);
+ if (!NILP (memq_no_quit (contype, tag_set)))
+ possible_console_types = Fcons (contype, possible_console_types);
+ }
+
+ if (XINT (Flength (possible_console_types)) > 1)
+ /* two conflicting console types specified */
+ return Qnil;
+
+ if (NILP (possible_console_types))
+ possible_console_types = Vconsole_type_list;
+
+ GCPRO2 (retlist, possible_console_types);
+
+ LIST_LOOP (rest, possible_console_types)
+ {
+ Lisp_Object contype = XCAR (rest);
+ Lisp_Object newinst = call_with_suspended_errors
+ ((lisp_fn_t) normalize_image_instantiator,
+ Qnil, Qimage, ERROR_ME_NOT, 3, instantiator, contype,
+ make_int (XIMAGE_SPECIFIER_ALLOWED (specifier)));
+
+ if (!NILP (newinst))
+ {
+ Lisp_Object newtag;
+ if (NILP (memq_no_quit (contype, tag_set)))
+ newtag = Fcons (contype, tag_set);
+ else
+ newtag = tag_set;
+ retlist = Fcons (Fcons (newtag, newinst), retlist);
+ }
+ }
+
+ UNGCPRO;
+
+ return retlist;
+}
+
+DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /*
+Return non-nil if OBJECT is an image specifier.
+
+An image specifier is used for images (pixmaps and the like). It is used
+to describe the actual image in a glyph. It is instanced as an image-
+instance.
+
+Image instantiators come in many formats: `xbm', `xpm', `gif', `jpeg',
+etc. This describes the format of the data describing the image. The
+resulting image instances also come in many types -- `mono-pixmap',
+`color-pixmap', `text', `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 unspecified shades "foreground" and
+"background" that are determined from the face of the glyph or
+surrounding text; a text image appears as a string of text and has an
+unspecified foreground, background, and font; a pointer image behaves
+like a mono-pixmap image but can only be used as a mouse pointer
+\[mono-pixmap images cannot be used as mouse pointers]; etc.) It is
+important to keep the distinction between image instantiator format and
+image instance type in mind. Typically, a given image instantiator
+format can result in many different image instance types (for example,
+`xpm' can be instanced as `color-pixmap', `mono-pixmap', or `pointer';
+whereas `cursor-font' can be instanced only as `pointer'), and a
+particular image instance type can be generated by many different
+image instantiator formats (e.g. `color-pixmap' can be generated by `xpm',
+`gif', `jpeg', etc.).
+
+See `make-image-instance' for a more detailed discussion of image
+instance types.
+
+An image instantiator should be a string or a vector of the form
+
+ [FORMAT :KEYWORD VALUE ...]
+
+i.e. a format symbol followed by zero or more alternating keyword-value
+pairs. FORMAT should be one of
+
+'nothing
+ (Don't display anything; no keywords are valid for this.
+ Can only be instanced as `nothing'.)
+'string
+ (Display this image as a text string. Can only be instanced
+ as `text', although support for instancing as `mono-pixmap'
+ should be added.)
+'formatted-string
+ (Display this image as a text string, with replaceable fields;
+ not currently implemented.)
+'xbm
+ (An X bitmap; only if X support was compiled into this XEmacs.
+ Can be instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
+'xpm
+ (An XPM pixmap; only if XPM support was compiled into this XEmacs.
+ Can be instanced as `color-pixmap', `mono-pixmap', or `pointer'.)
+'xface
+ (An X-Face bitmap, used to encode people's faces in e-mail messages;
+ only if X-Face support was compiled into this XEmacs. Can be
+ instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
+'gif
+ (A GIF87 or GIF89 image; only if GIF support was compiled into this
+ XEmacs. Can be instanced as `color-pixmap'.)
+'jpeg
+ (A JPEG image; only if JPEG support was compiled into this XEmacs.
+ Can be instanced as `color-pixmap'.)
+'png
+ (A PNG/GIF24 image; only if PNG support was compiled into this XEmacs.
+ Can be instanced as `color-pixmap'.)
+'tiff
+ (A TIFF image; not currently implemented.)
+'cursor-font
+ (One of the standard cursor-font names, such as "watch" or
+ "right_ptr" under X. Under X, this is, more specifically, any
+ of the standard cursor names from appendix B of the Xlib manual
+ [also known as the file <X11/cursorfont.h>] minus the XC_ prefix.
+ On other window systems, the valid names will be specific to the
+ type of window system. Can only be instanced as `pointer'.)
+'font
+ (A glyph from a font; i.e. the name of a font, and glyph index into it
+ of the form "FONT fontname index [[mask-font] mask-index]".
+ Currently can only be instanced as `pointer', although this should
+ probably be fixed.)
+'subwindow
+ (An embedded X window; not currently implemented.)
+'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.
+ If so, and this filename contains XBM or XPM data, the appropriate
+ sort of pixmap or pointer will be created. [This includes picking up
+ any specified hotspot or associated mask file.] Otherwise, if `pointer'
+ is one of the allowable image-instance types and the string names a
+ valid cursor-font name, the image will be created as a pointer.
+ Otherwise, the image will be displayed as text. If no X support
+ exists, the image will always be displayed as text.)
+'inherit
+ Inherit from the background-pixmap property of a face.
+
+The valid keywords are:
+
+:data
+ (Inline data. For most formats above, this should be a string. For
+ XBM images, this should be a list of three elements: width, height, and
+ a string of bit data. This keyword is not valid for instantiator
+ formats `nothing' and `inherit'.)
+:file
+ (Data is contained in a file. The value is the name of this file.
+ If both :data and :file are specified, the image is created from
+ what is specified in :data and the string in :file becomes the
+ value of the `image-instance-file-name' function when applied to
+ the resulting image-instance. This keyword is not valid for
+ instantiator formats `nothing', `string', `formatted-string',
+ `cursor-font', `font', `autodetect', and `inherit'.)
+:foreground
+:background
+ (For `xbm', `xface', `cursor-font', and `font'. These keywords
+ allow you to explicitly specify foreground and background colors.
+ The argument should be anything acceptable to `make-color-instance'.
+ This will cause what would be a `mono-pixmap' to instead be colorized
+ as a two-color color-pixmap, and specifies the foreground and/or
+ background colors for a pointer instead of black and white.)
+:mask-data
+ (For `xbm' and `xface'. This specifies a mask to be used with the
+ bitmap. The format is a list of width, height, and bits, like for
+ :data.)
+:mask-file
+ (For `xbm' and `xface'. This specifies a file containing the mask data.
+ If neither a mask file nor inline mask data is given for an XBM image,
+ and the XBM image comes from a file, XEmacs will look for a mask file
+ with the same name as the image file but with "Mask" or "msk"
+ appended. For example, if you specify the XBM file "left_ptr"
+ [usually located in "/usr/include/X11/bitmaps"], the associated
+ mask file "left_ptrmsk" will automatically be picked up.)
+:hotspot-x
+:hotspot-y
+ (For `xbm' and `xface'. These keywords specify a hotspot if the image
+ is instantiated as a `pointer'. Note that if the XBM image file
+ specifies a hotspot, it will automatically be picked up if no
+ explicit hotspot is given.)
+:color-symbols
+ (Only for `xpm'. This specifies an alist that maps strings
+ that specify symbolic color names to the actual color to be used
+ for that symbolic color (in the form of a string or a color-specifier
+ 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.)
+
+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
+`console-type-image-conversion-list' (q.v.) for the console type of
+the domain (usually a window; sometimes a frame or device) over which
+the image is being instantiated.
+
+If the instantiator specifies data from a file, the data will be read
+in at the time that the instantiator is added to the image (which may
+be well before when the image is actually displayed), and the
+instantiator will be converted into one of the inline-data forms, with
+the filename retained using a :file keyword. This implies that the
+file must exist when the instantiator is added to the image, but does
+not need to exist at any other time (e.g. it may safely be a temporary
+file).
+*/
+ (object))
+{
+ return IMAGE_SPECIFIERP (object) ? Qt : Qnil;
+}
+
+\f
+/****************************************************************************
+ * Glyph Object *
+ ****************************************************************************/
+
+static Lisp_Object
+mark_glyph (Lisp_Object obj, void (*markobj) (Lisp_Object))
+{
+ struct Lisp_Glyph *glyph = XGLYPH (obj);
+
+ ((markobj) (glyph->image));
+ ((markobj) (glyph->contrib_p));
+ ((markobj) (glyph->baseline));
+ ((markobj) (glyph->face));
+
+ return glyph->plist;
+}
+
+static void
+print_glyph (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+ struct Lisp_Glyph *glyph = XGLYPH (obj);
+ char buf[20];
+
+ if (print_readably)
+ error ("printing unreadable object #<glyph 0x%x>", glyph->header.uid);
+
+ write_c_string ("#<glyph (", printcharfun);
+ print_internal (Fglyph_type (obj), printcharfun, 0);
+ write_c_string (") ", printcharfun);
+ print_internal (glyph->image, printcharfun, 1);
+ sprintf (buf, "0x%x>", glyph->header.uid);
+ write_c_string (buf, printcharfun);
+}
+
+/* Glyphs are equal if all of their display attributes are equal. We
+ don't compare names or doc-strings, because that would make equal
+ be eq.
+
+ This isn't concerned with "unspecified" attributes, that's what
+ #'glyph-differs-from-default-p is for. */
+static int
+glyph_equal (Lisp_Object o1, Lisp_Object o2, int depth)
+{
+ struct Lisp_Glyph *g1 = XGLYPH (o1);
+ struct Lisp_Glyph *g2 = XGLYPH (o2);
+
+ depth++;
+
+ return (internal_equal (g1->image, g2->image, depth) &&
+ internal_equal (g1->contrib_p, g2->contrib_p, depth) &&
+ internal_equal (g1->baseline, g2->baseline, depth) &&
+ internal_equal (g1->face, g2->face, depth) &&
+ !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1));
+}
+
+static unsigned long
+glyph_hash (Lisp_Object obj, int depth)
+{
+ depth++;
+
+ /* No need to hash all of the elements; that would take too long.
+ Just hash the most common ones. */
+ return HASH2 (internal_hash (XGLYPH (obj)->image, depth),
+ internal_hash (XGLYPH (obj)->face, depth));
+}
+
+static Lisp_Object
+glyph_getprop (Lisp_Object obj, Lisp_Object prop)
+{
+ struct Lisp_Glyph *g = XGLYPH (obj);
+
+ if (EQ (prop, Qimage)) return g->image;
+ if (EQ (prop, Qcontrib_p)) return g->contrib_p;
+ if (EQ (prop, Qbaseline)) return g->baseline;
+ if (EQ (prop, Qface)) return g->face;
+
+ return external_plist_get (&g->plist, prop, 0, ERROR_ME);
+}
+
+static int
+glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
+{
+ if ((EQ (prop, Qimage)) ||
+ (EQ (prop, Qcontrib_p)) ||
+ (EQ (prop, Qbaseline)))
+ return 0;
+
+ if (EQ (prop, Qface))
+ {
+ XGLYPH (obj)->face = Fget_face (value);
+ return 1;
+ }
+
+ external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME);
+ return 1;
+}
+
+static int
+glyph_remprop (Lisp_Object obj, Lisp_Object prop)
+{
+ if ((EQ (prop, Qimage)) ||
+ (EQ (prop, Qcontrib_p)) ||
+ (EQ (prop, Qbaseline)))
+ return -1;
+
+ if (EQ (prop, Qface))
+ {
+ XGLYPH (obj)->face = Qnil;
+ return 1;
+ }
+
+ return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME);
+}
+
+static Lisp_Object
+glyph_plist (Lisp_Object obj)
+{
+ struct Lisp_Glyph *glyph = XGLYPH (obj);
+ Lisp_Object result = glyph->plist;
+
+ result = cons3 (Qface, glyph->face, result);
+ result = cons3 (Qbaseline, glyph->baseline, result);
+ result = cons3 (Qcontrib_p, glyph->contrib_p, result);
+ result = cons3 (Qimage, glyph->image, result);
+
+ return result;
+}
+
+DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph,
+ mark_glyph, print_glyph, 0,
+ glyph_equal, glyph_hash,
+ glyph_getprop, glyph_putprop,
+ glyph_remprop, glyph_plist,
+ struct Lisp_Glyph);
+\f
+Lisp_Object
+allocate_glyph (enum glyph_type type,
+ void (*after_change) (Lisp_Object glyph, Lisp_Object property,
+ Lisp_Object locale))
+{
+ /* This function can GC */
+ Lisp_Object obj = Qnil;
+ struct Lisp_Glyph *g =
+ alloc_lcrecord_type (struct Lisp_Glyph, lrecord_glyph);
+
+ g->type = type;
+ g->image = Fmake_specifier (Qimage); /* This function can GC */
+ 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;
+ break;
+ case GLYPH_POINTER:
+ XIMAGE_SPECIFIER_ALLOWED (g->image) =
+ IMAGE_NOTHING_MASK | IMAGE_POINTER_MASK;
+ break;
+ case GLYPH_ICON:
+ XIMAGE_SPECIFIER_ALLOWED (g->image) =
+ IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK;
+ break;
+ default:
+ abort ();
+ }
+
+ /* I think Fmake_specifier can GC. I think set_specifier_fallback can GC. */
+ /* We're getting enough reports of odd behavior in this area it seems */
+ /* best to GCPRO everything. */
+ {
+ Lisp_Object tem1 = list1 (Fcons (Qnil, Vthe_nothing_vector));
+ Lisp_Object tem2 = list1 (Fcons (Qnil, Qt));
+ Lisp_Object tem3 = list1 (Fcons (Qnil, Qnil));
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+
+ GCPRO4 (obj, tem1, tem2, tem3);
+
+ set_specifier_fallback (g->image, tem1);
+ g->contrib_p = Fmake_specifier (Qboolean);
+ set_specifier_fallback (g->contrib_p, tem2);
+ /* #### should have a specifier for the following */
+ g->baseline = Fmake_specifier (Qgeneric);
+ set_specifier_fallback (g->baseline, tem3);
+ g->face = Qnil;
+ g->plist = Qnil;
+ g->after_change = after_change;
+ XSETGLYPH (obj, g);
+
+ set_image_attached_to (g->image, obj, Qimage);
+ UNGCPRO;
+ }
+
+ return obj;
+}
+
+static enum glyph_type
+decode_glyph_type (Lisp_Object type, Error_behavior errb)
+{
+ if (NILP (type))
+ return GLYPH_BUFFER;
+
+ if (ERRB_EQ (errb, ERROR_ME))
+ CHECK_SYMBOL (type);
+
+ if (EQ (type, Qbuffer)) return GLYPH_BUFFER;
+ if (EQ (type, Qpointer)) return GLYPH_POINTER;
+ if (EQ (type, Qicon)) return GLYPH_ICON;
+
+ maybe_signal_simple_error ("Invalid glyph type", type, Qimage, errb);
+
+ return GLYPH_UNKNOWN;
+}
+
+static int
+valid_glyph_type_p (Lisp_Object type)
+{
+ return !NILP (memq_no_quit (type, Vglyph_type_list));
+}
+
+DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /*
+Given a GLYPH-TYPE, return non-nil if it is valid.
+Valid types are `buffer', `pointer', and `icon'.
+*/
+ (glyph_type))
+{
+ return valid_glyph_type_p (glyph_type) ? Qt : Qnil;
+}
+
+DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /*
+Return a list of valid glyph types.
+*/
+ ())
+{
+ return Fcopy_sequence (Vglyph_type_list);
+}
+
+DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /*
+Create and return a new uninitialized glyph or type TYPE.
+
+TYPE specifies the type of the glyph; this should be one of `buffer',
+`pointer', or `icon', and defaults to `buffer'. The type of the glyph
+specifies in which contexts the glyph can be used, and controls the
+allowable image types into which the glyph's image can be
+instantiated.
+
+`buffer' glyphs can be used as the begin-glyph or end-glyph of an
+extent, in the modeline, and in the toolbar. Their image can be
+instantiated as `nothing', `mono-pixmap', `color-pixmap', `text',
+and `subwindow'.
+
+`pointer' glyphs can be used to specify the mouse pointer. Their
+image can be instantiated as `pointer'.
+
+`icon' glyphs can be used to specify the icon used when a frame is
+iconified. Their image can be instantiated as `mono-pixmap' and
+`color-pixmap'.
+*/
+ (type))
+{
+ enum glyph_type typeval = decode_glyph_type (type, ERROR_ME);
+ return allocate_glyph (typeval, 0);
+}
+
+DEFUN ("glyphp", Fglyphp, 1, 1, 0, /*
+Return non-nil if OBJECT is a glyph.
+
+A glyph is an object used for pixmaps and the like. It is used
+in begin-glyphs and end-glyphs attached to extents, in marginal and textual
+annotations, in overlay arrows (overlay-arrow-* variables), in toolbar
+buttons, and the like. Its image is described using an image specifier --
+see `image-specifier-p'.
+*/
+ (object))
+{
+ return GLYPHP (object) ? Qt : Qnil;
+}
+
+DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /*
+Return the type of the given glyph.
+The return value will be one of 'buffer, 'pointer, or 'icon.
+*/
+ (glyph))
+{
+ CHECK_GLYPH (glyph);
+ switch (XGLYPH_TYPE (glyph))
+ {
+ case GLYPH_BUFFER: return Qbuffer;
+ case GLYPH_POINTER: return Qpointer;
+ case GLYPH_ICON: return Qicon;
+ default:
+ abort ();
+ return Qnil; /* not reached */
+ }
+}
+
+/*****************************************************************************
+ 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.
+ ****************************************************************************/
+unsigned short
+glyph_width (Lisp_Object glyph, Lisp_Object frame_face,
+ face_index window_findex, Lisp_Object window)
+{
+ 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);
+
+ 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:
+ /* #### implement me */
+ return 0;
+
+ default:
+ abort ();
+ return 0;
+ }
+}
+
+DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /*
+Return the width of GLYPH on WINDOW.
+This may not be exact as it does not take into account all of the context
+that redisplay will.
+*/
+ (glyph, window))
+{
+ 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:
+ /* #### implement me */
+ return 0;
+
+ default:
+ abort ();
+ return 0;
+ }
+}
+
+unsigned short
+glyph_ascent (Lisp_Object glyph, Lisp_Object frame_face,
+ face_index window_findex, Lisp_Object window)
+{
+ return glyph_height_internal (glyph, frame_face, window_findex, window,
+ RETURN_ASCENT);
+}
+
+unsigned short
+glyph_descent (Lisp_Object glyph, Lisp_Object frame_face,
+ face_index window_findex, Lisp_Object window)
+{
+ return glyph_height_internal (glyph, frame_face, window_findex, window,
+ RETURN_DESCENT);
+}
+
+/* strictly a convenience function. */
+unsigned short
+glyph_height (Lisp_Object glyph, Lisp_Object frame_face,
+ face_index window_findex, Lisp_Object window)
+{
+ return glyph_height_internal (glyph, frame_face, window_findex, window,
+ RETURN_HEIGHT);
+}
+
+DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /*
+Return the ascent value of GLYPH on WINDOW.
+This may not be exact as it does not take into account all of the context
+that redisplay will.
+*/
+ (glyph, window))
+{
+ XSETWINDOW (window, decode_window (window));
+ CHECK_GLYPH (glyph);
+
+ return make_int (glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window));
+}
+
+DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /*
+Return the descent value of GLYPH on WINDOW.
+This may not be exact as it does not take into account all of the context
+that redisplay will.
+*/
+ (glyph, window))
+{
+ XSETWINDOW (window, decode_window (window));
+ CHECK_GLYPH (glyph);
+
+ return make_int (glyph_descent (glyph, Qnil, DEFAULT_INDEX, window));
+}
+
+/* This is redundant but I bet a lot of people expect it to exist. */
+DEFUN ("glyph-height", Fglyph_height, 1, 2, 0, /*
+Return the height of GLYPH on WINDOW.
+This may not be exact as it does not take into account all of the context
+that redisplay will.
+*/
+ (glyph, window))
+{
+ XSETWINDOW (window, decode_window (window));
+ CHECK_GLYPH (glyph);
+
+ return make_int (glyph_height (glyph, Qnil, DEFAULT_INDEX, window));
+}
+
+#undef RETURN_ASCENT
+#undef RETURN_DESCENT
+#undef RETURN_HEIGHT
+
+/* #### do we need to cache this info to speed things up? */
+
+Lisp_Object
+glyph_baseline (Lisp_Object glyph, Lisp_Object domain)
+{
+ if (!GLYPHP (glyph))
+ return Qnil;
+ else
+ {
+ Lisp_Object retval =
+ specifier_instance_no_quit (GLYPH_BASELINE (XGLYPH (glyph)),
+ /* #### look into ERROR_ME_NOT */
+ Qunbound, domain, ERROR_ME_NOT,
+ 0, Qzero);
+ if (!NILP (retval) && !INTP (retval))
+ retval = Qnil;
+ else if (INTP (retval))
+ {
+ if (XINT (retval) < 0)
+ retval = Qzero;
+ if (XINT (retval) > 100)
+ retval = make_int (100);
+ }
+ return retval;
+ }
+}
+
+Lisp_Object
+glyph_face (Lisp_Object glyph, Lisp_Object domain)
+{
+ /* #### Domain parameter not currently used but it will be */
+ return GLYPHP (glyph) ? GLYPH_FACE (XGLYPH (glyph)) : Qnil;
+}
+
+int
+glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain)
+{
+ if (!GLYPHP (glyph))
+ return 0;
+ else
+ return !NILP (specifier_instance_no_quit
+ (GLYPH_CONTRIB_P (XGLYPH (glyph)), Qunbound, domain,
+ /* #### look into ERROR_ME_NOT */
+ ERROR_ME_NOT, 0, Qzero));
+}
+
+static void
+glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property,
+ Lisp_Object locale)
+{
+ if (XGLYPH (glyph)->after_change)
+ (XGLYPH (glyph)->after_change) (glyph, property, locale);
+}
+
+\f
+/*****************************************************************************
+ * glyph cachel functions *
+ *****************************************************************************/
+
+/*
+ #### All of this is 95% copied from face cachels.
+ Consider consolidating.
+ #### We need to add a dirty flag to the glyphs.
+ */
+
+void
+mark_glyph_cachels (glyph_cachel_dynarr *elements,
+ void (*markobj) (Lisp_Object))
+{
+ int elt;
+
+ if (!elements)
+ return;
+
+ for (elt = 0; elt < Dynarr_length (elements); elt++)
+ {
+ struct glyph_cachel *cachel = Dynarr_atp (elements, elt);
+ ((markobj) (cachel->glyph));
+ }
+}
+
+static void
+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))
+ {
+ Lisp_Object window;
+
+ 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);
+ }
+
+ cachel->updated = 1;
+}
+
+static void
+add_glyph_cachel (struct window *w, Lisp_Object glyph)
+{
+ struct glyph_cachel new_cachel;
+
+ xzero (new_cachel);
+ new_cachel.glyph = Qnil;
+
+ update_glyph_cachel_data (w, glyph, &new_cachel);
+ Dynarr_add (w->glyph_cachels, new_cachel);
+}
+
+static glyph_index
+get_glyph_cachel_index (struct window *w, Lisp_Object glyph)
+{
+ int elt;
+
+ if (noninteractive)
+ return 0;
+
+ for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
+ {
+ struct glyph_cachel *cachel =
+ Dynarr_atp (w->glyph_cachels, elt);
+
+ if (EQ (cachel->glyph, glyph) && !NILP (glyph))
+ {
+ if (!cachel->updated)
+ update_glyph_cachel_data (w, glyph, cachel);
+ return elt;
+ }
+ }
+
+ /* If we didn't find the glyph, add it and then return its index. */
+ add_glyph_cachel (w, glyph);
+ return elt;
+}
+
+void
+reset_glyph_cachels (struct window *w)
+{
+ Dynarr_reset (w->glyph_cachels);
+ get_glyph_cachel_index (w, Vcontinuation_glyph);
+ get_glyph_cachel_index (w, Vtruncation_glyph);
+ get_glyph_cachel_index (w, Vhscroll_glyph);
+ get_glyph_cachel_index (w, Vcontrol_arrow_glyph);
+ get_glyph_cachel_index (w, Voctal_escape_glyph);
+ get_glyph_cachel_index (w, Vinvisible_text_glyph);
+}
+
+void
+mark_glyph_cachels_as_not_updated (struct window *w)
+{
+ int elt;
+
+ /* We need to have a dirty flag to tell if the glyph has changed.
+ We can check to see if each glyph variable is actually a
+ completely different glyph, though. */
+#define FROB(glyph_obj, gindex) \
+ update_glyph_cachel_data (w, glyph_obj, \
+ Dynarr_atp (w->glyph_cachels, gindex))
+
+ FROB (Vcontinuation_glyph, CONT_GLYPH_INDEX);
+ FROB (Vtruncation_glyph, TRUN_GLYPH_INDEX);
+ FROB (Vhscroll_glyph, HSCROLL_GLYPH_INDEX);
+ FROB (Vcontrol_arrow_glyph, CONTROL_GLYPH_INDEX);
+ FROB (Voctal_escape_glyph, OCT_ESC_GLYPH_INDEX);
+ FROB (Vinvisible_text_glyph, INVIS_GLYPH_INDEX);
+#undef FROB
+
+ for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
+ Dynarr_atp (w->glyph_cachels, elt)->updated = 0;
+}
+
+#ifdef MEMORY_USAGE_STATS
+
+int
+compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels,
+ struct overhead_stats *ovstats)
+{
+ int total = 0;
+
+ if (glyph_cachels)
+ total += Dynarr_memory_usage (glyph_cachels, ovstats);
+
+ return total;
+}
+
+#endif /* MEMORY_USAGE_STATS */
+
+\f
+/*****************************************************************************
+ * display tables *
+ *****************************************************************************/
+
+/* Get the display table for use currently on window W with face FACE.
+ Precedence:
+
+ -- FACE's display table
+ -- W's display table (comes from specifier `current-display-table')
+
+ Ignore the specified tables if they are not valid;
+ if no valid table is specified, return 0. */
+
+struct Lisp_Vector *
+get_display_table (struct window *w, face_index findex)
+{
+ Lisp_Object tem;
+
+ tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex);
+ if (VECTORP (tem) && XVECTOR_LENGTH (tem) == DISP_TABLE_SIZE)
+ return XVECTOR (tem);
+
+ tem = w->display_table;
+ if (VECTORP (tem) && XVECTOR_LENGTH (tem) == DISP_TABLE_SIZE)
+ return XVECTOR (tem);
+
+ return 0;
+}
+
+\f
+/*****************************************************************************
+ * initialization *
+ *****************************************************************************/
+
+void
+syms_of_glyphs (void)
+{
+ /* image instantiators */
+
+ DEFSUBR (Fimage_instantiator_format_list);
+ DEFSUBR (Fvalid_image_instantiator_format_p);
+ DEFSUBR (Fset_console_type_image_conversion_list);
+ DEFSUBR (Fconsole_type_image_conversion_list);
+
+ defkeyword (&Q_file, ":file");
+ defkeyword (&Q_data, ":data");
+ defkeyword (&Q_face, ":face");
+
+#ifdef HAVE_XPM
+ defkeyword (&Q_color_symbols, ":color-symbols");
+#endif
+#ifdef HAVE_WINDOW_SYSTEM
+ defkeyword (&Q_mask_file, ":mask-file");
+ defkeyword (&Q_mask_data, ":mask-data");
+ defkeyword (&Q_hotspot_x, ":hotspot-x");
+ defkeyword (&Q_hotspot_y, ":hotspot-y");
+ defkeyword (&Q_foreground, ":foreground");
+ defkeyword (&Q_background, ":background");
+#endif
+ /* image specifiers */
+
+ DEFSUBR (Fimage_specifier_p);
+ /* Qimage in general.c */
+
+ /* image instances */
+
+ defsymbol (&Qimage_instancep, "image-instance-p");
+
+ defsymbol (&Qnothing_image_instance_p, "nothing-image-instance-p");
+ defsymbol (&Qtext_image_instance_p, "text-image-instance-p");
+ defsymbol (&Qmono_pixmap_image_instance_p, "mono-pixmap-image-instance-p");
+ defsymbol (&Qcolor_pixmap_image_instance_p, "color-pixmap-image-instance-p");
+ defsymbol (&Qpointer_image_instance_p, "pointer-image-instance-p");
+ defsymbol (&Qsubwindow_image_instance_p, "subwindow-image-instance-p");
+
+ DEFSUBR (Fmake_image_instance);
+ DEFSUBR (Fimage_instance_p);
+ DEFSUBR (Fimage_instance_type);
+ DEFSUBR (Fvalid_image_instance_type_p);
+ DEFSUBR (Fimage_instance_type_list);
+ DEFSUBR (Fimage_instance_name);
+ DEFSUBR (Fimage_instance_string);
+ DEFSUBR (Fimage_instance_file_name);
+ DEFSUBR (Fimage_instance_mask_file_name);
+ DEFSUBR (Fimage_instance_depth);
+ DEFSUBR (Fimage_instance_height);
+ DEFSUBR (Fimage_instance_width);
+ DEFSUBR (Fimage_instance_hotspot_x);
+ DEFSUBR (Fimage_instance_hotspot_y);
+ DEFSUBR (Fimage_instance_foreground);
+ DEFSUBR (Fimage_instance_background);
+ DEFSUBR (Fcolorize_image_instance);
+
+ /* Qnothing defined as part of the "nothing" image-instantiator
+ type. */
+ /* Qtext defined in general.c */
+ defsymbol (&Qmono_pixmap, "mono-pixmap");
+ defsymbol (&Qcolor_pixmap, "color-pixmap");
+ /* Qpointer defined in general.c */
+ defsymbol (&Qsubwindow, "subwindow");
+
+ /* glyphs */
+
+ defsymbol (&Qglyphp, "glyphp");
+ defsymbol (&Qcontrib_p, "contrib-p");
+ defsymbol (&Qbaseline, "baseline");
+
+ defsymbol (&Qbuffer_glyph_p, "buffer-glyph-p");
+ defsymbol (&Qpointer_glyph_p, "pointer-glyph-p");
+ defsymbol (&Qicon_glyph_p, "icon-glyph-p");
+
+ defsymbol (&Qconst_glyph_variable, "const-glyph-variable");
+
+ DEFSUBR (Fglyph_type);
+ DEFSUBR (Fvalid_glyph_type_p);
+ DEFSUBR (Fglyph_type_list);
+ DEFSUBR (Fglyphp);
+ DEFSUBR (Fmake_glyph_internal);
+ DEFSUBR (Fglyph_width);
+ DEFSUBR (Fglyph_ascent);
+ DEFSUBR (Fglyph_descent);
+ DEFSUBR (Fglyph_height);
+
+ /* Qbuffer defined in general.c. */
+ /* Qpointer defined above */
+
+ /* Errors */
+ deferror (&Qimage_conversion_error,
+ "image-conversion-error",
+ "image-conversion error", Qio_error);
+
+}
+
+void
+specifier_type_create_image (void)
+{
+ /* image specifiers */
+
+ INITIALIZE_SPECIFIER_TYPE_WITH_DATA (image, "image", "imagep");
+
+ SPECIFIER_HAS_METHOD (image, create);
+ SPECIFIER_HAS_METHOD (image, mark);
+ SPECIFIER_HAS_METHOD (image, instantiate);
+ SPECIFIER_HAS_METHOD (image, validate);
+ SPECIFIER_HAS_METHOD (image, after_change);
+ SPECIFIER_HAS_METHOD (image, going_to_add);
+}
+
+void
+image_instantiator_format_create (void)
+{
+ /* image instantiators */
+
+ the_image_instantiator_format_entry_dynarr =
+ Dynarr_new (image_instantiator_format_entry);
+
+ Vimage_instantiator_format_list = Qnil;
+ staticpro (&Vimage_instantiator_format_list);
+
+ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing");
+
+ IIFORMAT_HAS_METHOD (nothing, possible_dest_types);
+ IIFORMAT_HAS_METHOD (nothing, instantiate);
+
+ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (inherit, "inherit");
+
+ IIFORMAT_HAS_METHOD (inherit, validate);
+ IIFORMAT_HAS_METHOD (inherit, normalize);
+ IIFORMAT_HAS_METHOD (inherit, possible_dest_types);
+ IIFORMAT_HAS_METHOD (inherit, instantiate);
+
+ IIFORMAT_VALID_KEYWORD (inherit, Q_face, check_valid_face);
+
+ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (string, "string");
+
+ IIFORMAT_HAS_METHOD (string, validate);
+ IIFORMAT_HAS_METHOD (string, possible_dest_types);
+ IIFORMAT_HAS_METHOD (string, instantiate);
+
+ IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string);
+
+ 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);
+
+#ifdef HAVE_WINDOW_SYSTEM
+ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm");
+
+ IIFORMAT_HAS_METHOD (xbm, validate);
+ IIFORMAT_HAS_METHOD (xbm, normalize);
+ IIFORMAT_HAS_METHOD (xbm, possible_dest_types);
+ IIFORMAT_HAS_METHOD (xbm, instantiate);
+
+ IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline);
+ IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string);
+ IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline);
+ IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string);
+ IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int);
+ IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int);
+ IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string);
+ IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string);
+#endif /* HAVE_WINDOW_SYSTEM */
+
+#ifdef HAVE_XPM
+ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm");
+
+ IIFORMAT_HAS_METHOD (xpm, validate);
+ IIFORMAT_HAS_METHOD (xpm, normalize);
+ IIFORMAT_HAS_METHOD (xpm, possible_dest_types);
+ IIFORMAT_HAS_METHOD (xpm, instantiate);
+
+ IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string);
+ IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string);
+ IIFORMAT_VALID_KEYWORD (xpm, Q_color_symbols, check_valid_xpm_color_symbols);
+#endif /* HAVE_XPM */
+}
+
+void
+vars_of_glyphs (void)
+{
+ Vthe_nothing_vector = vector1 (Qnothing);
+ staticpro (&Vthe_nothing_vector);
+
+ /* image instances */
+
+ Vimage_instance_type_list = list6 (Qnothing, Qtext, Qmono_pixmap,
+ Qcolor_pixmap, Qpointer, Qsubwindow);
+ staticpro (&Vimage_instance_type_list);
+
+ /* glyphs */
+
+ Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon);
+ staticpro (&Vglyph_type_list);
+
+ /* The octal-escape glyph, control-arrow-glyph and
+ invisible-text-glyph are completely initialized in glyphs.el */
+
+ DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /*
+What to prefix character codes displayed in octal with.
+*/);
+ Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
+
+ DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /*
+What to use as an arrow for control characters.
+*/);
+ Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER,
+ redisplay_glyph_changed);
+
+ DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /*
+What to use to indicate the presence of invisible text.
+This is the glyph that is displayed when an ellipsis is called for
+\(see `selective-display-ellipses' and `buffer-invisibility-spec').
+Normally this is three dots ("...").
+*/);
+ Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER,
+ redisplay_glyph_changed);
+
+ /* Partially initialized in glyphs.el */
+ DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /*
+What to display at the beginning of horizontally scrolled lines.
+*/);
+ Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
+
+#ifdef HAVE_XPM
+ Fprovide (Qxpm);
+
+ DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols /*
+Definitions of logical color-names used when reading XPM files.
+Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE).
+The COLOR-NAME should be a string, which is the name of the color to define;
+the FORM should evaluate to a `color' specifier object, or a string to be
+passed to `make-color-instance'. If a loaded XPM file references a symbolic
+color called COLOR-NAME, it will display as the computed color instead.
+
+The default value of this variable defines the logical color names
+\"foreground\" and \"background\" to be the colors of the `default' face.
+*/ );
+ Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */
+#endif /* HAVE_XPM */
+}
+
+void
+specifier_vars_of_glyphs (void)
+{
+ /* #### Can we GC here? The set_specifier_* calls definitely need */
+ /* protection. */
+ /* display tables */
+
+ DEFVAR_SPECIFIER ("current-display-table", &Vcurrent_display_table /*
+*The display table currently in use.
+This is a specifier; use `set-specifier' to change it.
+The display table is a vector created with `make-display-table'.
+The 256 elements control how to display each possible text character.
+Each value should be a string, a glyph, a vector or nil.
+If a value is a vector it must be composed only of strings and glyphs.
+nil means display the character in the default fashion.
+Faces can have their own, overriding display table.
+*/ );
+ Vcurrent_display_table = Fmake_specifier (Qdisplay_table);
+ set_specifier_fallback (Vcurrent_display_table,
+ list1 (Fcons (Qnil, Qnil)));
+ set_specifier_caching (Vcurrent_display_table,
+ slot_offset (struct window,
+ display_table),
+ some_window_value_changed,
+ 0, 0);
+}
+
+void
+complex_vars_of_glyphs (void)
+{
+ /* Partially initialized in glyphs-x.c, glyphs.el */
+ DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /*
+What to display at the end of truncated lines.
+*/ );
+ Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
+
+ /* Partially initialized in glyphs-x.c, glyphs.el */
+ DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /*
+What to display at the end of wrapped lines.
+*/ );
+ Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
+
+ /* Partially initialized in glyphs-x.c, glyphs.el */
+ DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /*
+The glyph used to display the XEmacs logo at startup.
+*/ );
+ Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0);
+}
--- /dev/null
+/* Indentation functions.
+ Copyright (C) 1995 Board of Trustees, University of Illinois.
+ Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995
+ 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. */
+
+/* This file has been Mule-ized. */
+
+/* Synched up with: 19.30. Diverges significantly from FSF. */
+
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "device.h"
+#include "extents.h"
+#include "faces.h"
+#include "frame.h"
+#include "glyphs.h"
+#include "insdel.h"
+#ifdef REGION_CACHE_NEEDS_WORK
+#include "region-cache.h"
+#endif
+#include "window.h"
+
+/* Indentation can insert tabs if this is non-zero;
+ otherwise always uses spaces */
+int indent_tabs_mode;
+
+/* Avoid recalculation by remembering things in these variables. */
+
+/* Last value returned by current_column.
+
+ Some things set last_known_column_point to -1
+ to mark the memoized value as invalid */
+static int last_known_column;
+
+/* Last buffer searched by current_column */
+static struct buffer *last_known_column_buffer;
+
+/* Value of point when current_column was called */
+static Bufpos last_known_column_point;
+
+/* Value of MODIFF when current_column was called */
+static int last_known_column_modified;
+
+static Bufpos
+last_visible_position (Bufpos pos, struct buffer *buf)
+{
+ Lisp_Object buffer;
+ Lisp_Object value;
+
+ XSETBUFFER (buffer, buf);
+ value = Fprevious_single_property_change (make_int (pos), Qinvisible,
+ buffer, Qnil);
+ if (NILP (value))
+ return 0; /* no visible position found */
+ else
+ /* #### bug bug bug!!! This will return the position of the beginning
+ of an invisible extent; this extent is very likely to be start-closed,
+ and thus the spaces inserted in `indent-to' will go inside the
+ invisible extent.
+
+ Not sure what the correct solution is here. Rethink indent-to? */
+ return XINT (value);
+}
+
+#ifdef REGION_CACHE_NEEDS_WORK
+
+/* Allocate or free the width run cache, as requested by the current
+ state of current_buffer's cache_long_line_scans variable. */
+static void
+width_run_cache_on_off (struct buffer *buf)
+{
+ if (NILP (buf->cache_long_line_scans))
+ {
+ /* It should be off. */
+ if (buf->width_run_cache)
+ {
+ free_region_cache (buf->width_run_cache);
+ buf->width_run_cache = 0;
+ buf->width_table = Qnil;
+ }
+ }
+ else
+ {
+ /* It should be on. */
+ if (buf->width_run_cache == 0)
+ {
+ buf->width_run_cache = new_region_cache ();
+ recompute_width_table (buf, buffer_display_table ());
+ }
+ }
+}
+
+#endif /* REGION_CACHE_NEEDS_WORK */
+\f
+
+/* Cancel any recorded value of the horizontal position. */
+
+void
+invalidate_current_column (void)
+{
+ last_known_column_point = -1;
+}
+
+int
+column_at_point (struct buffer *buf, Bufpos init_pos, int cur_col)
+{
+ int col;
+ int tab_seen;
+ int tab_width = XINT (buf->tab_width);
+ 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 <= BUF_BEGV (buf))
+ break;
+
+ pos--;
+ c = BUF_FETCH_CHAR (buf, 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' ||
+ (EQ (buf->selective_display, Qt) && c == '\r'))
+ break;
+ else
+ {
+ /* #### This needs updating to handle the new redisplay. */
+ /* #### FSFmacs looks at ctl_arrow, display tables.
+ We need to do similar. */
+#if 0
+ displayed_glyphs = glyphs_from_bufpos (sel_frame, buf,
+ XWINDOW (selected_window),
+ pos, dp, 0, col, 0, 0, 0);
+ col += (displayed_glyphs->columns
+ - (displayed_glyphs->begin_columns
+ + displayed_glyphs->end_columns));
+#else /* XEmacs */
+#ifdef MULE
+ col += XCHARSET_COLUMNS (CHAR_CHARSET (c));
+#else
+ col ++;
+#endif /* MULE */
+#endif /* XEmacs */
+ }
+ }
+
+ if (tab_seen)
+ {
+ col = ((col + tab_width) / tab_width) * tab_width;
+ col += post_tab;
+ }
+
+ if (cur_col)
+ {
+ last_known_column_buffer = buf;
+ last_known_column = col;
+ last_known_column_point = init_pos;
+ last_known_column_modified = BUF_MODIFF (buf);
+ }
+
+ return col;
+}
+
+int
+current_column (struct buffer *buf)
+{
+ if (buf == last_known_column_buffer
+ && BUF_PT (buf) == last_known_column_point
+ && BUF_MODIFF (buf) == last_known_column_modified)
+ return last_known_column;
+
+ return column_at_point (buf, BUF_PT (buf), 1);
+}
+
+DEFUN ("current-column", Fcurrent_column, 0, 1, 0, /*
+Return the horizontal position of point. Beginning of line is column 0.
+This is calculated by adding together the widths of all the displayed
+ representations of the character between the start of the previous line
+ and point. (e.g. control characters will have a width of 2 or 4, tabs
+ will have a variable width.)
+Ignores finite width of frame, which means that this function may return
+ values greater than (frame-width).
+Whether the line is visible (if `selective-display' is t) has no effect;
+ however, ^M is treated as end of line when `selective-display' is t.
+If BUFFER is nil, the current buffer is assumed.
+*/
+ (buffer))
+{
+ return make_int (current_column (decode_buffer (buffer, 0)));
+}
+
+\f
+DEFUN ("indent-to", Findent_to, 1, 3, "NIndent to column: ", /*
+Indent from point with tabs and spaces until COLUMN is reached.
+Optional second argument MIN says always do at least MIN spaces
+ even if that goes past COLUMN; by default, MIN is zero.
+If BUFFER is nil, the current buffer is assumed.
+*/
+ (col, minimum, buffer))
+{
+ /* This function can GC */
+ int mincol;
+ int fromcol;
+ struct buffer *buf = decode_buffer (buffer, 0);
+ int tab_width = XINT (buf->tab_width);
+ Bufpos opoint = 0;
+
+ CHECK_INT (col);
+ if (NILP (minimum))
+ minimum = Qzero;
+ else
+ CHECK_INT (minimum);
+
+ XSETBUFFER (buffer, buf);
+
+ fromcol = current_column (buf);
+ mincol = fromcol + XINT (minimum);
+ if (mincol < XINT (col)) mincol = XINT (col);
+
+ if (fromcol == mincol)
+ return make_int (mincol);
+
+ if (tab_width <= 0 || tab_width > 1000) tab_width = 8;
+
+ if (!NILP (Fextent_at (make_int (BUF_PT (buf)), buffer, Qinvisible,
+ Qnil, Qnil)))
+ {
+ Bufpos last_visible = last_visible_position (BUF_PT (buf), buf);
+
+ opoint = BUF_PT (buf);
+ if (last_visible >= BUF_BEGV (buf))
+ BUF_SET_PT (buf, last_visible);
+ else
+ error ("Visible portion of buffer not modifiable");
+ }
+
+ if (indent_tabs_mode)
+ {
+ int n = mincol / tab_width - fromcol / tab_width;
+ if (n != 0)
+ {
+ Finsert_char (make_char ('\t'), make_int (n), Qnil, buffer);
+
+ fromcol = (mincol / tab_width) * tab_width;
+ }
+ }
+
+ Finsert_char (make_char (' '), make_int (mincol - fromcol), Qnil, buffer);
+
+ last_known_column_buffer = buf;
+ last_known_column = mincol;
+ last_known_column_point = BUF_PT (buf);
+ last_known_column_modified = BUF_MODIFF (buf);
+
+ /* Not in FSF: */
+ if (opoint > 0)
+ BUF_SET_PT (buf, opoint);
+
+ return make_int (mincol);
+}
+
+int
+bi_spaces_at_point (struct buffer *b, Bytind bi_pos)
+{
+ Bytind bi_end = BI_BUF_ZV (b);
+ int col = 0;
+ Emchar c;
+ int tab_width = XINT (b->tab_width);
+
+ if (tab_width <= 0 || tab_width > 1000)
+ tab_width = 8;
+
+ while (bi_pos < bi_end &&
+ (c = BI_BUF_FETCH_CHAR (b, bi_pos),
+ (c == '\t'
+ ? (col += tab_width - col % tab_width)
+ : (c == ' ' ? ++col : 0))))
+ INC_BYTIND (b, bi_pos);
+
+ return col;
+}
+
+\f
+DEFUN ("current-indentation", Fcurrent_indentation, 0, 1, 0, /*
+Return the indentation of the current line.
+This is the horizontal position of the character
+following any initial whitespace.
+*/
+ (buffer))
+{
+ struct buffer *buf = decode_buffer (buffer, 0);
+ Bufpos pos = find_next_newline (buf, BUF_PT (buf), -1);
+
+ XSETBUFFER (buffer, buf);
+
+ if (!NILP (Fextent_at (make_int (pos), buffer, Qinvisible, Qnil, Qnil)))
+ return Qzero;
+
+ return make_int (bi_spaces_at_point (buf, bufpos_to_bytind (buf, pos)));
+}
+
+\f
+DEFUN ("move-to-column", Fmove_to_column, 1, 3, 0, /*
+Move point to column COLUMN in the current line.
+The column of a character is calculated by adding together the widths
+as displayed of the previous characters in the line.
+This function ignores line-continuation;
+there is no upper limit on the column number a character can have
+and horizontal scrolling has no effect.
+
+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.
+Returns the actual column that it moved to.
+*/
+ (column, force, buffer))
+{
+ /* This function can GC */
+ Bufpos pos;
+ struct buffer *buf = decode_buffer (buffer, 0);
+ int col = current_column (buf);
+ int goal;
+ Bufpos end;
+ int tab_width = XINT (buf->tab_width);
+
+ int prev_col = 0;
+ Emchar c = 0;
+
+ XSETBUFFER (buffer, buf);
+ if (tab_width <= 0 || tab_width > 1000) tab_width = 8;
+ CHECK_NATNUM (column);
+ goal = XINT (column);
+
+ retry:
+ pos = BUF_PT (buf);
+ end = BUF_ZV (buf);
+
+ /* If we're starting past the desired column,
+ back up to beginning of line and scan from there. */
+ if (col > goal)
+ {
+ pos = find_next_newline (buf, pos, -1);
+ col = 0;
+ }
+
+ while (col < goal && pos < end)
+ {
+ c = BUF_FETCH_CHAR (buf, pos);
+ if (c == '\n')
+ break;
+ if (c == '\r' && EQ (buf->selective_display, Qt))
+ break;
+ if (c == '\t')
+ {
+ prev_col = col;
+ col += tab_width;
+ col = col / tab_width * tab_width;
+ }
+ else
+ {
+ /* #### oh for the days of the complete new redisplay */
+ /* #### FSFmacs looks at ctl_arrow, display tables.
+ We need to do similar. */
+#if 0
+ displayed_glyphs = glyphs_from_bufpos (selected_frame (),
+ buf,
+ XWINDOW (Fselected_window (Qnil)),
+ pos, dp, 0, col, 0, 0, 0);
+ col += (displayed_glyphs->columns
+ - (displayed_glyphs->begin_columns
+ + displayed_glyphs->end_columns));
+#else /* XEmacs */
+#ifdef MULE
+ col += XCHARSET_COLUMNS (CHAR_CHARSET (c));
+#else
+ col ++;
+#endif /* MULE */
+#endif /* XEmacs */
+ }
+
+ pos++;
+ }
+
+ BUF_SET_PT (buf, pos);
+
+ /* If a tab char made us overshoot, change it to spaces
+ and scan through it again. */
+ if (!NILP (force) && col > goal && c == '\t' && prev_col < goal)
+ {
+ buffer_delete_range (buf, BUF_PT (buf) - 1, BUF_PT (buf), 0);
+ Findent_to (make_int (col - 1), Qzero, buffer);
+ buffer_insert_emacs_char (buf, ' ');
+ goto retry;
+ }
+
+ /* If line ends prematurely, add space to the end. */
+ if (col < goal && !NILP (force))
+ {
+ col = goal;
+ Findent_to (make_int (col), Qzero, buffer);
+ }
+
+ last_known_column_buffer = buf;
+ last_known_column = col;
+ last_known_column_point = BUF_PT (buf);
+ last_known_column_modified = BUF_MODIFF (buf);
+
+ return make_int (col);
+}
+
+#if 0 /* #### OK boys, this function needs to be present, I think.
+ It was there before the 19.12 redisplay rewrite. */
+
+xxDEFUN ("compute-motion", Fcompute_motion, 7, 7, 0, /*
+ "Scan through the current buffer, calculating screen position.
+Scan the current buffer forward from offset FROM,
+assuming it is at position FROMPOS--a cons of the form (HPOS . VPOS)--
+to position TO or position TOPOS--another cons of the form (HPOS . VPOS)--
+and return the ending buffer position and screen location.
+
+There are three additional arguments:
+
+WIDTH is the number of columns available to display text;
+this affects handling of continuation lines.
+This is usually the value returned by `window-width', less one (to allow
+for the continuation glyph).
+
+OFFSETS is either nil or a cons cell (HSCROLL . TAB-OFFSET).
+HSCROLL is the number of columns not being displayed at the left
+margin; this is usually taken from a window's hscroll member.
+TAB-OFFSET is the number of columns of the first tab that aren't
+being displayed, perhaps because the line was continued within it.
+If OFFSETS is nil, HSCROLL and TAB-OFFSET are assumed to be zero.
+
+WINDOW is the window to operate on. Currently this is used only to
+find the display table. It does not matter what buffer WINDOW displays;
+`compute-motion' always operates on the current buffer.
+
+The value is a list of five elements:
+ (POS HPOS VPOS PREVHPOS CONTIN)
+POS is the buffer position where the scan stopped.
+VPOS is the vertical position where the scan stopped.
+HPOS is the horizontal position where the scan stopped.
+
+PREVHPOS is the horizontal position one character back from POS.
+CONTIN is t if a line was continued after (or within) the previous character.
+
+For example, to find the buffer position of column COL of line LINE
+of a certain window, pass the window's starting location as FROM
+and the window's upper-left coordinates as FROMPOS.
+Pass the buffer's (point-max) as TO, to limit the scan to the end of the
+visible section of the buffer, and pass LINE and COL as TOPOS.
+*/
+ (from, frompos, to, topos, width, offsets, window))
+{
+ Lisp_Object bufpos, hpos, vpos, prevhpos, contin;
+ struct position *pos;
+ int hscroll, tab_offset;
+ struct window *w = decode_window (window);
+
+ CHECK_INT_COERCE_MARKER (from);
+ CHECK_CONS (frompos);
+ CHECK_INT (XCAR (frompos));
+ CHECK_INT (XCDR (frompos));
+ CHECK_INT_COERCE_MARKER (to);
+ CHECK_CONS (topos);
+ CHECK_INT (XCAR (topos));
+ CHECK_INT (XCDR (topos));
+ CHECK_INT (width);
+ if (!NILP (offsets))
+ {
+ CHECK_CONS (offsets);
+ CHECK_INT (XCAR (offsets));
+ CHECK_INT (XCDR (offsets));
+ hscroll = XINT (XCAR (offsets));
+ tab_offset = XINT (XCDR (offsets));
+ }
+ else
+ hscroll = tab_offset = 0;
+
+ pos = compute_motion (XINT (from), XINT (XCDR (frompos)),
+ XINT (XCAR (frompos)),
+ XINT (to), XINT (XCDR (topos)),
+ XINT (XCAR (topos)),
+ XINT (width), hscroll, tab_offset, w);
+
+ XSETINT (bufpos, pos->bufpos);
+ XSETINT (hpos, pos->hpos);
+ XSETINT (vpos, pos->vpos);
+ XSETINT (prevhpos, pos->prevhpos);
+
+ return list5 (bufpos, hpos, vpos, prevhpos,
+ pos->contin ? Qt : Qnil);
+}
+
+#endif /* 0 */
+
+/* Helper for vmotion_1 - compute vertical pixel motion between
+ START and END in the line start cache CACHE. This just sums
+ the line heights, including both the starting and ending lines.
+*/
+static int
+vpix_motion (line_start_cache_dynarr *cache, int start, int end)
+{
+ int i, vpix;
+
+ 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;
+
+ return vpix;
+}
+
+/*****************************************************************************
+ vmotion_1
+
+ Given a starting position ORIG, move point VTARGET lines in WINDOW.
+ Returns the new value for point. If the arg ret_vpos is not nil, it is
+ taken to be a pointer to an int and the number of lines actually moved is
+ returned in it. If the arg ret_vpix is not nil, it is taken to be a
+ pointer to an int and the vertical pixel height of the motion which
+ took place is returned in it.
+ ****************************************************************************/
+static Bufpos
+vmotion_1 (struct window *w, Bufpos orig, int vtarget,
+ int *ret_vpos, int *ret_vpix)
+{
+ struct buffer *b = XBUFFER (w->buffer);
+ int elt;
+
+ elt = point_in_line_start_cache (w, orig, (vtarget < 0
+ ? -vtarget
+ : vtarget));
+
+ /* #### This assertion must be true before the if statements are hit
+ but may possibly be wrong after the call to
+ point_in_line_start_cache if orig is outside of the visible
+ region of the buffer. Handle this. */
+ assert (elt >= 0);
+
+ /* Moving downward. */
+ if (vtarget > 0)
+ {
+ int cur_line = Dynarr_length (w->line_start_cache) - 1 - elt;
+ Bufpos ret_pt;
+
+ if (cur_line > vtarget)
+ cur_line = vtarget;
+
+ /* The traditional FSF behavior is to return the end of buffer
+ position if we couldn't move far enough because we hit it. */
+ if (cur_line < vtarget)
+ ret_pt = BUF_ZV (b);
+ else
+ ret_pt = Dynarr_atp (w->line_start_cache, cur_line + elt)->start;
+
+ while (ret_pt > BUF_ZV (b) && cur_line > 0)
+ {
+ cur_line--;
+ ret_pt = Dynarr_atp (w->line_start_cache, cur_line + elt)->start;
+ }
+
+ if (ret_vpos) *ret_vpos = cur_line;
+ if (ret_vpix)
+ *ret_vpix = vpix_motion (w->line_start_cache, elt, cur_line + elt);
+ return ret_pt;
+ }
+ else if (vtarget < 0)
+ {
+ if (elt < -vtarget)
+ {
+ if (ret_vpos) *ret_vpos = -elt;
+ if (ret_vpix)
+ *ret_vpix = vpix_motion (w->line_start_cache, 0, elt);
+ /* #### This should be BUF_BEGV (b), right? */
+ return Dynarr_atp (w->line_start_cache, 0)->start;
+ }
+ else
+ {
+ if (ret_vpos) *ret_vpos = vtarget;
+ if (ret_vpix)
+ *ret_vpix = vpix_motion (w->line_start_cache, elt + vtarget, elt);
+ return Dynarr_atp (w->line_start_cache, elt + vtarget)->start;
+ }
+ }
+ else
+ {
+ /* No vertical motion requested so we just return the position
+ of the beginning of the current line. */
+ if (ret_vpos) *ret_vpos = 0;
+ if (ret_vpix)
+ *ret_vpix = vpix_motion (w->line_start_cache, elt, elt);
+
+ return Dynarr_atp (w->line_start_cache, elt)->start;
+ }
+
+ RETURN_NOT_REACHED(0) /* shut up compiler */
+}
+
+/*****************************************************************************
+ vmotion
+
+ Given a starting position ORIG, move point VTARGET lines in WINDOW.
+ Returns the new value for point. If the arg ret_vpos is not nil, it is
+ taken to be a pointer to an int and the number of lines actually moved is
+ returned in it.
+ ****************************************************************************/
+Bufpos
+vmotion (struct window *w, Bufpos orig, int vtarget, int *ret_vpos)
+{
+ return vmotion_1 (w, orig, vtarget, ret_vpos, NULL);
+}
+
+/* Helper for Fvertical_motion.
+ */
+static
+Lisp_Object vertical_motion_1 (Lisp_Object lines, Lisp_Object window,
+ int pixels)
+{
+ Bufpos bufpos;
+ Bufpos orig;
+ int selected;
+ int *vpos, *vpix;
+ int value=0;
+ struct window *w;
+
+ if (NILP (window))
+ window = Fselected_window (Qnil);
+
+ CHECK_WINDOW (window);
+ CHECK_INT (lines);
+
+ selected = (EQ (window, Fselected_window (Qnil)));
+
+ w = XWINDOW (window);
+
+ orig = selected ? BUF_PT (XBUFFER (w->buffer))
+ : marker_position (w->pointm[CURRENT_DISP]);
+
+ vpos = pixels ? NULL : &value;
+ vpix = pixels ? &value : NULL;
+
+ bufpos = vmotion_1 (w, orig, XINT (lines), vpos, vpix);
+
+ /* Note that the buffer's point is set, not the window's point. */
+ if (selected)
+ BUF_SET_PT (XBUFFER (w->buffer), bufpos);
+ else
+ set_marker_restricted (w->pointm[CURRENT_DISP],
+ make_int(bufpos),
+ w->buffer);
+
+ return make_int (value);
+}
+
+DEFUN ("vertical-motion", Fvertical_motion, 1, 3, 0, /*
+Move to start of frame line LINES lines down.
+If LINES is negative, this is moving up.
+Optional second argument is WINDOW to move in,
+the default is the selected window.
+
+Sets point to position found; this may be start of line
+or just the start of a continuation line.
+If optional third argument PIXELS is nil, returns number
+of lines moved; may be closer to zero than LINES if beginning
+or end of buffer was reached. If PIXELS is non-nil, the
+vertical pixel height of the motion which took place is
+returned instead of the actual number of lines moved. A
+motion of zero lines returns the height of the current line.
+
+Note that `vertical-motion' sets WINDOW's buffer's point, not
+WINDOW's point. (This differs from FSF Emacs, which buggily always
+sets current buffer's point, regardless of WINDOW.)
+*/
+ (lines, window, pixels))
+{
+ return vertical_motion_1 (lines, window, !NILP (pixels));
+}
+
+/*
+ * Like vmotion() but requested and returned movement is in pixels.
+ * HOW specifies the stopping condition. Positive means move at least
+ * PIXELS. Negative means at most. Zero means as close as possible.
+ */
+Bufpos
+vmotion_pixels (Lisp_Object window, Bufpos start, int pixels, int how,
+ int *motion)
+{
+ struct window *w;
+ Bufpos eobuf, bobuf;
+ int defheight;
+ int needed;
+ int line, next;
+ int remain, abspix, dirn;
+ int elt, nelt;
+ int i;
+ line_start_cache_dynarr *cache;
+ int previous = -1;
+ int lines;
+
+ if (NILP (window))
+ window = Fselected_window (Qnil);
+
+ CHECK_WINDOW (window);
+ w = XWINDOW (window);
+
+ eobuf = BUF_ZV (XBUFFER (w->buffer));
+ bobuf = BUF_BEGV (XBUFFER (w->buffer));
+
+ default_face_height_and_width (window, &defheight, NULL);
+
+ /* guess num lines needed in line start cache + a few extra */
+ abspix = abs (pixels);
+ needed = (abspix + defheight-1)/defheight + 3;
+
+ dirn = (pixels >= 0) ? 1 : -1;
+
+ while (1)
+ {
+ elt = point_in_line_start_cache (w, start, needed);
+ assert (elt >= 0); /* in the cache */
+
+ cache = w->line_start_cache;
+ nelt = Dynarr_length (cache);
+
+ *motion = 0;
+
+ if (pixels == 0)
+ /* No vertical motion requested so we just return the position
+ of the beginning of the current display line. */
+ return Dynarr_atp (cache, elt)->start;
+
+ if ((dirn < 0 && elt == 0 &&
+ Dynarr_atp (cache, elt)->start <= bobuf) ||
+ (dirn > 0 && elt == nelt-1 &&
+ Dynarr_atp (cache, elt)->end >= eobuf))
+ return Dynarr_atp (cache, elt)->start;
+
+ remain = abspix;
+ for (i = elt; (dirn > 0) ? (i < nelt) : (i > 0); i += dirn)
+ {
+ /* cache line we're considering moving over */
+ int ii = (dirn > 0) ? i : i-1;
+
+ if (remain < 0)
+ return Dynarr_atp (cache, i)->start;
+
+ line = Dynarr_atp (cache, ii)->height;
+ next = remain - line;
+
+ /* is stopping condition satisfied? */
+ if ((how > 0 && remain <= 0) || /* at least */
+ (how < 0 && next < 0) || /* at most */
+ (how == 0 && remain <= abs (next))) /* closest */
+ return Dynarr_atp (cache, i)->start;
+
+ /* moving down and nowhere left to go? */
+ if (dirn > 0 && Dynarr_atp (cache, ii)->end >= eobuf)
+ return Dynarr_atp (cache, ii)->start;
+
+ /* take the step */
+ remain = next;
+ *motion += dirn * line;
+
+ /* moving up and nowhere left to go? */
+ if (dirn < 0 && Dynarr_atp (cache, ii)->start <= bobuf)
+ return Dynarr_atp (cache, ii)->start;
+ }
+
+ /* get here => need more cache lines. try again. */
+ assert (abs (*motion) > previous); /* progress? */
+ previous = abs (*motion);
+
+ lines = (pixels < 0) ? elt : (nelt - elt);
+ needed += (remain*lines + abspix-1)/abspix + 3;
+ }
+
+ RETURN_NOT_REACHED(0) /* shut up compiler */
+}
+
+DEFUN ("vertical-motion-pixels", Fvertical_motion_pixels, 1, 3, 0, /*
+Move to start of frame line PIXELS vertical pixels down.
+If PIXELS is negative, this is moving up.
+The actual vertical motion in pixels is returned.
+
+Optional second argument is WINDOW to move in,
+the default is the selected window.
+
+Optional third argument HOW specifies when to stop. A value
+less than zero indicates that the motion should be no more
+than PIXELS. A value greater than zero indicates that the
+motion should be at least PIXELS. Any other value indicates
+that the motion should be as close as possible to PIXELS.
+*/
+ (pixels, window, how))
+{
+ Bufpos bufpos;
+ Bufpos orig;
+ int selected;
+ int motion;
+ int howto;
+ struct window *w;
+
+ if (NILP (window))
+ window = Fselected_window (Qnil);
+
+ CHECK_WINDOW (window);
+ CHECK_INT (pixels);
+
+ selected = (EQ (window, Fselected_window (Qnil)));
+
+ w = XWINDOW (window);
+
+ orig = selected ? BUF_PT (XBUFFER (w->buffer))
+ : marker_position (w->pointm[CURRENT_DISP]);
+
+ howto = INTP (how) ? XINT (how) : 0;
+
+ bufpos = vmotion_pixels (window, orig, XINT (pixels), howto, &motion);
+
+ if (selected)
+ BUF_SET_PT (XBUFFER (w->buffer), bufpos);
+ else
+ set_marker_restricted (w->pointm[CURRENT_DISP],
+ make_int(bufpos),
+ w->buffer);
+
+ return make_int (motion);
+}
+
+\f
+void
+syms_of_indent (void)
+{
+ DEFSUBR (Fcurrent_indentation);
+ DEFSUBR (Findent_to);
+ DEFSUBR (Fcurrent_column);
+ DEFSUBR (Fmove_to_column);
+#if 0 /* #### */
+ DEFSUBR (Fcompute_motion);
+#endif
+ DEFSUBR (Fvertical_motion);
+ DEFSUBR (Fvertical_motion_pixels);
+}
+
+void
+vars_of_indent (void)
+{
+ DEFVAR_BOOL ("indent-tabs-mode", &indent_tabs_mode /*
+*Indentation can insert tabs if this is non-nil.
+Setting this variable automatically makes it local to the current buffer.
+*/ );
+ indent_tabs_mode = 1;
+}
--- /dev/null
+/* Buffer insertion/deletion and gap motion for XEmacs.
+ Copyright (C) 1985, 1986, 1991, 1992, 1993, 1994, 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.0, FSF 19.30. Diverges significantly. */
+
+/* This file has been Mule-ized. */
+
+/* Overhauled by Ben Wing, December 1994, for Mule implementation. */
+
+/*
+ There are three possible ways to specify positions in a buffer. All
+ of these are one-based: the beginning of the buffer is position or
+ index 1, and 0 is not a valid position.
+
+ As a "buffer position" (typedef Bufpos):
+
+ This is an index specifying an offset in characters from the
+ beginning of the buffer. Note that buffer positions are
+ logically *between* characters, not on a character. The
+ difference between two buffer positions specifies the number of
+ characters between those positions. Buffer positions are the
+ only kind of position externally visible to the user.
+
+ As a "byte index" (typedef Bytind):
+
+ This is an index over the bytes used to represent the characters
+ in the buffer. If there is no Mule support, this is identical
+ to a buffer position, because each character is represented
+ using one byte. However, with Mule support, many characters
+ require two or more bytes for their representation, and so a
+ byte index may be greater than the corresponding buffer
+ position.
+
+ As a "memory index" (typedef Memind):
+
+ This is the byte index adjusted for the gap. For positions
+ before the gap, this is identical to the byte index. For
+ positions after the gap, this is the byte index plus the gap
+ size. There are two possible memory indices for the gap
+ position; the memory index at the beginning of the gap should
+ always be used, except in code that deals with manipulating the
+ gap, where both indices may be seen. The address of the
+ character "at" (i.e. following) a particular position can be
+ obtained from the formula
+
+ buffer_start_address + memory_index(position) - 1
+
+ except in the case of characters at the gap position.
+
+ Other typedefs:
+ ===============
+
+ Emchar:
+ -------
+ This typedef represents a single Emacs character, which can be
+ ASCII, ISO-8859, or some extended character, as would typically
+ be used for Kanji. Note that the representation of a character
+ as an Emchar is *not* the same as the representation of that
+ same character in a string; thus, you cannot do the standard
+ C trick of passing a pointer to a character to a function that
+ expects a string.
+
+ An Emchar takes up 19 bits of representation and (for code
+ compatibility and such) is compatible with an int. This
+ representation is visible on the Lisp level. The important
+ characteristics of the Emchar representation are
+
+ -- values 0x00 - 0x7f represent ASCII.
+ -- values 0x80 - 0xff represent the right half of ISO-8859-1.
+ -- values 0x100 and up represent all other characters.
+
+ This means that Emchar values are upwardly compatible with
+ the standard 8-bit representation of ASCII/ISO-8859-1.
+
+ Bufbyte:
+ --------
+ The data in a buffer or string is logically made up of Bufbyte
+ objects, where a Bufbyte takes up the same amount of space as a
+ char. (It is declared differently, though, to catch invalid
+ usages.) Strings stored using Bufbytes are said to be in
+ "internal format". The important characteristics of internal
+ format are
+
+ -- ASCII characters are represented as a single Bufbyte,
+ in the range 0 - 0x7f.
+ -- All other characters are represented as a Bufbyte in
+ the range 0x80 - 0x9f followed by one or more Bufbytes
+ in the range 0xa0 to 0xff.
+
+ This leads to a number of desirable properties:
+
+ -- Given the position of the beginning of a character,
+ you can find the beginning of the next or previous
+ character in constant time.
+ -- When searching for a substring or an ASCII character
+ within the string, you need merely use standard
+ searching routines.
+
+ array of char:
+ --------------
+ Strings that go in or out of Emacs are in "external format",
+ typedef'ed as an array of char or a char *. There is more
+ than one external format (JIS, EUC, etc.) but they all
+ have similar properties. They are modal encodings,
+ which is to say that the meaning of particular bytes is
+ not fixed but depends on what "mode" the string is currently
+ in (e.g. bytes in the range 0 - 0x7f might be
+ interpreted as ASCII, or as Hiragana, or as 2-byte Kanji,
+ depending on the current mode). The mode starts out in
+ ASCII/ISO-8859-1 and is switched using escape sequences --
+ for example, in the JIS encoding, 'ESC $ B' switches to a
+ mode where pairs of bytes in the range 0 - 0x7f
+ are interpreted as Kanji characters.
+
+ External-formatted data is generally desirable for passing
+ data between programs because it is upwardly compatible
+ with standard ASCII/ISO-8859-1 strings and may require
+ less space than internal encodings such as the one
+ described above. In addition, some encodings (e.g. JIS)
+ keep all characters (except the ESC used to switch modes)
+ in the printing ASCII range 0x20 - 0x7e, which results in
+ a much higher probability that the data will avoid being
+ garbled in transmission. Externally-formatted data is
+ generally not very convenient to work with, however, and
+ for this reason is usually converted to internal format
+ before any work is done on the string.
+
+ NOTE: filenames need to be in external format so that
+ ISO-8859-1 characters come out correctly.
+
+ Charcount:
+ ----------
+ This typedef represents a count of characters, such as
+ a character offset into a string or the number of
+ characters between two positions in a buffer. The
+ difference between two Bufpos's is a Charcount, and
+ character positions in a string are represented using
+ a Charcount.
+
+ Bytecount:
+ ----------
+ Similar to a Charcount but represents a count of bytes.
+ The difference between two Bytind's is a Bytecount.
+
+
+ Usage of the various representations:
+ =====================================
+
+ Memory indices are used in low-level functions in insdel.c and for
+ extent endpoints and marker positions. The reason for this is that
+ this way, the extents and markers don't need to be updated for most
+ insertions, which merely shrink the gap and don't move any
+ characters around in memory.
+
+ (The beginning-of-gap memory index simplifies insertions w.r.t.
+ markers, because text usually gets inserted after markers. For
+ extents, it is merely for consistency, because text can get
+ inserted either before or after an extent's endpoint depending on
+ the open/closedness of the endpoint.)
+
+ Byte indices are used in other code that needs to be fast,
+ such as the searching, redisplay, and extent-manipulation code.
+
+ Buffer positions are used in all other code. This is because this
+ representation is easiest to work with (especially since Lisp
+ code always uses buffer positions), necessitates the fewest
+ changes to existing code, and is the safest (e.g. if the text gets
+ shifted underneath a buffer position, it will still point to a
+ character; if text is shifted under a byte index, it might point
+ to the middle of a character, which would be bad).
+
+ Similarly, Charcounts are used in all code that deals with strings
+ except for code that needs to be fast, which used Bytecounts.
+
+ Strings are always passed around internally using internal format.
+ Conversions between external format are performed at the time
+ that the data goes in or out of Emacs.
+
+ Working with the various representations:
+ ========================================= */
+
+#include <config.h>
+#include "lisp.h"
+#include <limits.h>
+
+#include "buffer.h"
+#include "device.h"
+#include "frame.h"
+#include "extents.h"
+#include "insdel.h"
+#include "lstream.h"
+#include "redisplay.h"
+#include "line-number.h"
+
+/* We write things this way because it's very important the
+ MAX_BYTIND_GAP_SIZE_3 is a multiple of 3. (As it happens,
+ 65535 is a multiple of 3, but this may not always be the
+ case.) */
+
+#define MAX_BUFPOS_GAP_SIZE_3 (65535/3)
+#define MAX_BYTIND_GAP_SIZE_3 (3 * MAX_BUFPOS_GAP_SIZE_3)
+
+short three_to_one_table[1 + MAX_BYTIND_GAP_SIZE_3];
+
+/* Various macros modelled along the lines of those in buffer.h.
+ Purposefully omitted from buffer.h because files other than this
+ one should not be using them. */
+
+/* Address of beginning of buffer. This is an lvalue because
+ BUFFER_ALLOC needs it to be. */
+#define BUF_BEG_ADDR(buf) ((buf)->text->beg)
+
+/* Set the address of beginning of buffer. */
+#define SET_BUF_BEG_ADDR(buf, addr) do { (buf)->text->beg = (addr); } while (0)
+
+/* Gap size. */
+#define BUF_GAP_SIZE(buf) ((buf)->text->gap_size + 0)
+#define BUF_END_GAP_SIZE(buf) ((buf)->text->end_gap_size + 0)
+/* Set gap size. */
+#define SET_BUF_GAP_SIZE(buf, value) \
+ do { (buf)->text->gap_size = (value); } while (0)
+#define SET_BUF_END_GAP_SIZE(buf, value) \
+ do { (buf)->text->end_gap_size = (value); } while (0)
+
+/* Gap location. */
+#define BI_BUF_GPT(buf) ((buf)->text->gpt + 0)
+#define BUF_GPT_ADDR(buf) (BUF_BEG_ADDR (buf) + BI_BUF_GPT (buf) - 1)
+
+/* Set gap location. */
+#define SET_BI_BUF_GPT(buf, value) do { (buf)->text->gpt = (value); } while (0)
+
+/* Set end of buffer. */
+#define SET_BOTH_BUF_Z(buf, val, bival) \
+do \
+{ \
+ (buf)->text->z = (bival); \
+ (buf)->text->bufz = (val); \
+} while (0)
+
+/* Under Mule, we maintain two sentinels in the buffer: one at the
+ beginning of the gap, and one at the end of the buffer. This
+ allows us to move forward, examining bytes looking for the
+ end of a character, and not worry about running off the end.
+ We do not need corresponding sentinels when moving backwards
+ because we do not have to look past the beginning of a character
+ to find the beginning of the character.
+
+ Every time we change the beginning of the gap, we have to
+ call SET_GAP_SENTINEL().
+
+ Every time we change the total size (characters plus gap)
+ of the buffer, we have to call SET_END_SENTINEL().
+ */
+
+
+#ifdef MULE
+# define GAP_CAN_HOLD_SIZE_P(buf, len) (BUF_GAP_SIZE (buf) >= (len) + 1)
+# define SET_GAP_SENTINEL(buf) (*BUF_GPT_ADDR (buf) = 0)
+# define BUF_END_SENTINEL_SIZE 1
+# define SET_END_SENTINEL(buf) \
+ (*(BUF_BEG_ADDR (buf) + BUF_GAP_SIZE (buf) + BI_BUF_Z (buf) - 1) = 0)
+#else
+# define GAP_CAN_HOLD_SIZE_P(buf, len) (BUF_GAP_SIZE (buf) >= (len))
+# define SET_GAP_SENTINEL(buf)
+# define BUF_END_SENTINEL_SIZE 0
+# define SET_END_SENTINEL(buf)
+#endif
+
+\f
+/************************************************************************/
+/* Charcount/Bytecount conversion */
+/************************************************************************/
+
+/* Optimization. Do it. Live it. Love it. */
+
+#ifdef MULE
+
+/* We include the basic functions here that require no specific
+ knowledge of how data is Mule-encoded into a buffer other
+ than the basic (00 - 7F), (80 - 9F), (A0 - FF) scheme.
+ Anything that requires more specific knowledge goes into
+ mule-charset.c. */
+
+/* Given a pointer to a text string and a length in bytes, return
+ the equivalent length in characters. */
+
+Charcount
+bytecount_to_charcount (CONST Bufbyte *ptr, Bytecount len)
+{
+ Charcount count = 0;
+ CONST Bufbyte *end = ptr + len;
+
+#if (LONGBITS == 32 || LONGBITS == 64)
+
+# if (LONGBITS == 32)
+# define LONG_BYTES 4
+# define ALIGN_MASK 0xFFFFFFFCU
+# define HIGH_BIT_MASK 0x80808080U
+# else
+# define LONG_BYTES 8
+# define ALIGN_MASK 0xFFFFFFFFFFFFFFF8UL
+ /* I had a dream, I was being overrun with early Intel processors ... */
+# define HIGH_BIT_MASK 0x8080808080808080UL
+# endif
+
+ /* When we have a large number of bytes to scan, we can be trickier
+ and significantly faster by scanning them in chunks of the CPU word
+ size (assuming that they're all ASCII -- we cut out as soon as
+ we find something non-ASCII). */
+ if (len >= 12)
+ {
+ /* 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)) &
+ ALIGN_MASK);
+ CONST Bufbyte *aligned_end =
+ (CONST Bufbyte *) (((unsigned long) end) & ALIGN_MASK);
+
+ /* Handle unaligned stuff at the beginning. */
+ while (ptr < aligned_ptr)
+ {
+ if (!BYTE_ASCII_P (*ptr))
+ goto bail;
+ count++, ptr++;
+ }
+ /* Now do it. */
+ while (ptr < aligned_end)
+ {
+
+ if ((* (unsigned long *) ptr) & HIGH_BIT_MASK)
+ goto bail;
+ ptr += LONG_BYTES;
+ count += LONG_BYTES;
+ }
+ }
+
+#endif /* LONGBITS == 32 || LONGBITS == 64 */
+
+ bail:
+ while (ptr < end)
+ {
+ count++;
+ INC_CHARPTR (ptr);
+ }
+#ifdef ERROR_CHECK_BUFPOS
+ /* Bomb out if the specified substring ends in the middle
+ of a character. Note that we might have already gotten
+ a core dump above from an invalid reference, but at least
+ we will get no farther than here. */
+ assert (ptr == end);
+#endif
+
+ return count;
+}
+
+/* Given a pointer to a text string and a length in characters, return
+ the equivalent length in bytes. */
+
+Bytecount
+charcount_to_bytecount (CONST Bufbyte *ptr, Charcount len)
+{
+ CONST Bufbyte *newptr = ptr;
+
+ while (len > 0)
+ {
+ INC_CHARPTR (newptr);
+ len--;
+ }
+ return newptr - ptr;
+}
+
+/* The next two functions are the actual meat behind the
+ bufpos-to-bytind and bytind-to-bufpos conversions. Currently
+ the method they use is fairly unsophisticated; see buffer.h.
+
+ Note that bufpos_to_bytind_func() is probably the most-called
+ function in all of XEmacs. Therefore, it must be FAST FAST FAST.
+ This is the reason why so much of the code is duplicated.
+
+ Similar considerations apply to bytind_to_bufpos_func(), although
+ less so because the function is not called so often.
+
+ #### At some point this should use a more sophisticated method;
+ see buffer.h. */
+
+static int not_very_random_number;
+
+Bytind
+bufpos_to_bytind_func (struct buffer *buf, Bufpos x)
+{
+ Bufpos bufmin;
+ Bufpos bufmax;
+ Bytind bytmin;
+ Bytind bytmax;
+ int size;
+ int forward_p;
+ Bytind retval;
+ int diff_so_far;
+ int add_to_cache = 0;
+
+ /* Check for some cached positions, for speed. */
+ if (x == BUF_PT (buf))
+ return BI_BUF_PT (buf);
+ if (x == BUF_ZV (buf))
+ return BI_BUF_ZV (buf);
+ if (x == BUF_BEGV (buf))
+ return BI_BUF_BEGV (buf);
+
+ bufmin = buf->text->mule_bufmin;
+ bufmax = buf->text->mule_bufmax;
+ bytmin = buf->text->mule_bytmin;
+ bytmax = buf->text->mule_bytmax;
+ size = (1 << buf->text->mule_shifter) + !!buf->text->mule_three_p;
+
+ /* The basic idea here is that we shift the "known region" up or down
+ until it overlaps the specified position. We do this by moving
+ the upper bound of the known region up one character at a time,
+ and moving the lower bound of the known region up as necessary
+ when the size of the character just seen changes.
+
+ We optimize this, however, by first shifting the known region to
+ one of the cached points if it's close by. (We don't check BEG or
+ Z, even though they're cached; most of the time these will be the
+ same as BEGV and ZV, and when they're not, they're not likely
+ to be used.) */
+
+ if (x > bufmax)
+ {
+ Bufpos diffmax = x - bufmax;
+ Bufpos diffpt = x - BUF_PT (buf);
+ Bufpos diffzv = BUF_ZV (buf) - x;
+ /* #### This value could stand some more exploration. */
+ Charcount heuristic_hack = (bufmax - bufmin) >> 2;
+
+ /* Check if the position is closer to PT or ZV than to the
+ end of the known region. */
+
+ if (diffpt < 0)
+ diffpt = -diffpt;
+ if (diffzv < 0)
+ diffzv = -diffzv;
+
+ /* But also implement a heuristic that favors the known region
+ over PT or ZV. The reason for this is that switching to
+ PT or ZV will wipe out the knowledge in the known region,
+ which might be annoying if the known region is large and
+ PT or ZV is not that much closer than the end of the known
+ region. */
+
+ diffzv += heuristic_hack;
+ diffpt += heuristic_hack;
+ if (diffpt < diffmax && diffpt <= diffzv)
+ {
+ bufmax = bufmin = BUF_PT (buf);
+ bytmax = bytmin = BI_BUF_PT (buf);
+ /* We set the size to 1 even though it doesn't really
+ matter because the new known region contains no
+ characters. We do this because this is the most
+ likely size of the characters around the new known
+ region, and we avoid potential yuckiness that is
+ done when size == 3. */
+ size = 1;
+ }
+ if (diffzv < diffmax)
+ {
+ bufmax = bufmin = BUF_ZV (buf);
+ bytmax = bytmin = BI_BUF_ZV (buf);
+ size = 1;
+ }
+ }
+#ifdef ERROR_CHECK_BUFPOS
+ else if (x >= bufmin)
+ abort ();
+#endif
+ else
+ {
+ Bufpos diffmin = bufmin - x;
+ Bufpos diffpt = BUF_PT (buf) - x;
+ Bufpos diffbegv = x - BUF_BEGV (buf);
+ /* #### This value could stand some more exploration. */
+ Charcount heuristic_hack = (bufmax - bufmin) >> 2;
+
+ if (diffpt < 0)
+ diffpt = -diffpt;
+ if (diffbegv < 0)
+ diffbegv = -diffbegv;
+
+ /* But also implement a heuristic that favors the known region --
+ see above. */
+
+ diffbegv += heuristic_hack;
+ diffpt += heuristic_hack;
+
+ if (diffpt < diffmin && diffpt <= diffbegv)
+ {
+ bufmax = bufmin = BUF_PT (buf);
+ bytmax = bytmin = BI_BUF_PT (buf);
+ /* We set the size to 1 even though it doesn't really
+ matter because the new known region contains no
+ characters. We do this because this is the most
+ likely size of the characters around the new known
+ region, and we avoid potential yuckiness that is
+ done when size == 3. */
+ size = 1;
+ }
+ if (diffbegv < diffmin)
+ {
+ bufmax = bufmin = BUF_BEGV (buf);
+ bytmax = bytmin = BI_BUF_BEGV (buf);
+ size = 1;
+ }
+ }
+
+ diff_so_far = x > bufmax ? x - bufmax : bufmin - x;
+ if (diff_so_far > 50)
+ {
+ /* If we have to move more than a certain amount, then look
+ into our cache. */
+ int minval = INT_MAX;
+ int found = 0;
+ int i;
+
+ add_to_cache = 1;
+ /* I considered keeping the positions ordered. This would speed
+ up this loop, but updating the cache would take longer, so
+ it doesn't seem like it would really matter. */
+ for (i = 0; i < 16; i++)
+ {
+ int diff = buf->text->mule_bufpos_cache[i] - x;
+
+ if (diff < 0)
+ diff = -diff;
+ if (diff < minval)
+ {
+ minval = diff;
+ found = i;
+ }
+ }
+
+ if (minval < diff_so_far)
+ {
+ bufmax = bufmin = buf->text->mule_bufpos_cache[found];
+ bytmax = bytmin = buf->text->mule_bytind_cache[found];
+ size = 1;
+ }
+ }
+
+ /* It's conceivable that the caching above could lead to X being
+ the same as one of the range edges. */
+ if (x >= bufmax)
+ {
+ Bytind newmax;
+ Bytecount newsize;
+
+ forward_p = 1;
+ while (x > bufmax)
+ {
+ newmax = bytmax;
+
+ INC_BYTIND (buf, newmax);
+ newsize = newmax - bytmax;
+ if (newsize != size)
+ {
+ bufmin = bufmax;
+ bytmin = bytmax;
+ size = newsize;
+ }
+ bytmax = newmax;
+ bufmax++;
+ }
+ retval = bytmax;
+
+ /* #### Should go past the found location to reduce the number
+ of times that this function is called */
+ }
+ else /* x < bufmin */
+ {
+ Bytind newmin;
+ Bytecount newsize;
+
+ forward_p = 0;
+ while (x < bufmin)
+ {
+ newmin = bytmin;
+
+ DEC_BYTIND (buf, newmin);
+ newsize = bytmin - newmin;
+ if (newsize != size)
+ {
+ bufmax = bufmin;
+ bytmax = bytmin;
+ size = newsize;
+ }
+ bytmin = newmin;
+ bufmin--;
+ }
+ retval = bytmin;
+
+ /* #### Should go past the found location to reduce the number
+ of times that this function is called
+ */
+ }
+
+ /* If size is three, than we have to max sure that the range we
+ discovered isn't too large, because we use a fixed-length
+ table to divide by 3. */
+
+ if (size == 3)
+ {
+ int gap = bytmax - bytmin;
+ buf->text->mule_three_p = 1;
+ buf->text->mule_shifter = 1;
+
+ if (gap > MAX_BYTIND_GAP_SIZE_3)
+ {
+ if (forward_p)
+ {
+ bytmin = bytmax - MAX_BYTIND_GAP_SIZE_3;
+ bufmin = bufmax - MAX_BUFPOS_GAP_SIZE_3;
+ }
+ else
+ {
+ bytmax = bytmin + MAX_BYTIND_GAP_SIZE_3;
+ bufmax = bufmin + MAX_BUFPOS_GAP_SIZE_3;
+ }
+ }
+ }
+ else
+ {
+ buf->text->mule_three_p = 0;
+ if (size == 4)
+ buf->text->mule_shifter = 2;
+ else
+ buf->text->mule_shifter = size - 1;
+ }
+
+ buf->text->mule_bufmin = bufmin;
+ buf->text->mule_bufmax = bufmax;
+ buf->text->mule_bytmin = bytmin;
+ buf->text->mule_bytmax = bytmax;
+
+ if (add_to_cache)
+ {
+ int replace_loc;
+
+ /* We throw away a "random" cached value and replace it with
+ the new value. It doesn't actually have to be very random
+ at all, just evenly distributed.
+
+ #### It would be better to use a least-recently-used algorithm
+ or something that tries to space things out, but I'm not sure
+ it's worth it to go to the trouble of maintaining that. */
+ not_very_random_number += 621;
+ replace_loc = not_very_random_number & 15;
+ buf->text->mule_bufpos_cache[replace_loc] = x;
+ buf->text->mule_bytind_cache[replace_loc] = retval;
+ }
+
+ return retval;
+}
+
+/* The logic in this function is almost identical to the logic in
+ the previous function. */
+
+Bufpos
+bytind_to_bufpos_func (struct buffer *buf, Bytind x)
+{
+ Bufpos bufmin;
+ Bufpos bufmax;
+ Bytind bytmin;
+ Bytind bytmax;
+ int size;
+ int forward_p;
+ Bufpos retval;
+ int diff_so_far;
+ int add_to_cache = 0;
+
+ /* Check for some cached positions, for speed. */
+ if (x == BI_BUF_PT (buf))
+ return BUF_PT (buf);
+ if (x == BI_BUF_ZV (buf))
+ return BUF_ZV (buf);
+ if (x == BI_BUF_BEGV (buf))
+ return BUF_BEGV (buf);
+
+ bufmin = buf->text->mule_bufmin;
+ bufmax = buf->text->mule_bufmax;
+ bytmin = buf->text->mule_bytmin;
+ bytmax = buf->text->mule_bytmax;
+ size = (1 << buf->text->mule_shifter) + !!buf->text->mule_three_p;
+
+ /* The basic idea here is that we shift the "known region" up or down
+ until it overlaps the specified position. We do this by moving
+ the upper bound of the known region up one character at a time,
+ and moving the lower bound of the known region up as necessary
+ when the size of the character just seen changes.
+
+ We optimize this, however, by first shifting the known region to
+ one of the cached points if it's close by. (We don't check BI_BEG or
+ BI_Z, even though they're cached; most of the time these will be the
+ same as BI_BEGV and BI_ZV, and when they're not, they're not likely
+ to be used.) */
+
+ if (x > bytmax)
+ {
+ Bytind diffmax = x - bytmax;
+ Bytind diffpt = x - BI_BUF_PT (buf);
+ Bytind diffzv = BI_BUF_ZV (buf) - x;
+ /* #### This value could stand some more exploration. */
+ Bytecount heuristic_hack = (bytmax - bytmin) >> 2;
+
+ /* Check if the position is closer to PT or ZV than to the
+ end of the known region. */
+
+ if (diffpt < 0)
+ diffpt = -diffpt;
+ if (diffzv < 0)
+ diffzv = -diffzv;
+
+ /* But also implement a heuristic that favors the known region
+ over BI_PT or BI_ZV. The reason for this is that switching to
+ BI_PT or BI_ZV will wipe out the knowledge in the known region,
+ which might be annoying if the known region is large and
+ BI_PT or BI_ZV is not that much closer than the end of the known
+ region. */
+
+ diffzv += heuristic_hack;
+ diffpt += heuristic_hack;
+ if (diffpt < diffmax && diffpt <= diffzv)
+ {
+ bufmax = bufmin = BUF_PT (buf);
+ bytmax = bytmin = BI_BUF_PT (buf);
+ /* We set the size to 1 even though it doesn't really
+ matter because the new known region contains no
+ characters. We do this because this is the most
+ likely size of the characters around the new known
+ region, and we avoid potential yuckiness that is
+ done when size == 3. */
+ size = 1;
+ }
+ if (diffzv < diffmax)
+ {
+ bufmax = bufmin = BUF_ZV (buf);
+ bytmax = bytmin = BI_BUF_ZV (buf);
+ size = 1;
+ }
+ }
+#ifdef ERROR_CHECK_BUFPOS
+ else if (x >= bytmin)
+ abort ();
+#endif
+ else
+ {
+ Bytind diffmin = bytmin - x;
+ Bytind diffpt = BI_BUF_PT (buf) - x;
+ Bytind diffbegv = x - BI_BUF_BEGV (buf);
+ /* #### This value could stand some more exploration. */
+ Bytecount heuristic_hack = (bytmax - bytmin) >> 2;
+
+ if (diffpt < 0)
+ diffpt = -diffpt;
+ if (diffbegv < 0)
+ diffbegv = -diffbegv;
+
+ /* But also implement a heuristic that favors the known region --
+ see above. */
+
+ diffbegv += heuristic_hack;
+ diffpt += heuristic_hack;
+
+ if (diffpt < diffmin && diffpt <= diffbegv)
+ {
+ bufmax = bufmin = BUF_PT (buf);
+ bytmax = bytmin = BI_BUF_PT (buf);
+ /* We set the size to 1 even though it doesn't really
+ matter because the new known region contains no
+ characters. We do this because this is the most
+ likely size of the characters around the new known
+ region, and we avoid potential yuckiness that is
+ done when size == 3. */
+ size = 1;
+ }
+ if (diffbegv < diffmin)
+ {
+ bufmax = bufmin = BUF_BEGV (buf);
+ bytmax = bytmin = BI_BUF_BEGV (buf);
+ size = 1;
+ }
+ }
+
+ diff_so_far = x > bytmax ? x - bytmax : bytmin - x;
+ if (diff_so_far > 50)
+ {
+ /* If we have to move more than a certain amount, then look
+ into our cache. */
+ int minval = INT_MAX;
+ int found = 0;
+ int i;
+
+ add_to_cache = 1;
+ /* I considered keeping the positions ordered. This would speed
+ up this loop, but updating the cache would take longer, so
+ it doesn't seem like it would really matter. */
+ for (i = 0; i < 16; i++)
+ {
+ int diff = buf->text->mule_bytind_cache[i] - x;
+
+ if (diff < 0)
+ diff = -diff;
+ if (diff < minval)
+ {
+ minval = diff;
+ found = i;
+ }
+ }
+
+ if (minval < diff_so_far)
+ {
+ bufmax = bufmin = buf->text->mule_bufpos_cache[found];
+ bytmax = bytmin = buf->text->mule_bytind_cache[found];
+ size = 1;
+ }
+ }
+
+ /* It's conceivable that the caching above could lead to X being
+ the same as one of the range edges. */
+ if (x >= bytmax)
+ {
+ Bytind newmax;
+ Bytecount newsize;
+
+ forward_p = 1;
+ while (x > bytmax)
+ {
+ newmax = bytmax;
+
+ INC_BYTIND (buf, newmax);
+ newsize = newmax - bytmax;
+ if (newsize != size)
+ {
+ bufmin = bufmax;
+ bytmin = bytmax;
+ size = newsize;
+ }
+ bytmax = newmax;
+ bufmax++;
+ }
+ retval = bufmax;
+
+ /* #### Should go past the found location to reduce the number
+ of times that this function is called */
+ }
+ else /* x <= bytmin */
+ {
+ Bytind newmin;
+ Bytecount newsize;
+
+ forward_p = 0;
+ while (x < bytmin)
+ {
+ newmin = bytmin;
+
+ DEC_BYTIND (buf, newmin);
+ newsize = bytmin - newmin;
+ if (newsize != size)
+ {
+ bufmax = bufmin;
+ bytmax = bytmin;
+ size = newsize;
+ }
+ bytmin = newmin;
+ bufmin--;
+ }
+ retval = bufmin;
+
+ /* #### Should go past the found location to reduce the number
+ of times that this function is called
+ */
+ }
+
+ /* If size is three, than we have to max sure that the range we
+ discovered isn't too large, because we use a fixed-length
+ table to divide by 3. */
+
+ if (size == 3)
+ {
+ int gap = bytmax - bytmin;
+ buf->text->mule_three_p = 1;
+ buf->text->mule_shifter = 1;
+
+ if (gap > MAX_BYTIND_GAP_SIZE_3)
+ {
+ if (forward_p)
+ {
+ bytmin = bytmax - MAX_BYTIND_GAP_SIZE_3;
+ bufmin = bufmax - MAX_BUFPOS_GAP_SIZE_3;
+ }
+ else
+ {
+ bytmax = bytmin + MAX_BYTIND_GAP_SIZE_3;
+ bufmax = bufmin + MAX_BUFPOS_GAP_SIZE_3;
+ }
+ }
+ }
+ else
+ {
+ buf->text->mule_three_p = 0;
+ if (size == 4)
+ buf->text->mule_shifter = 2;
+ else
+ buf->text->mule_shifter = size - 1;
+ }
+
+ buf->text->mule_bufmin = bufmin;
+ buf->text->mule_bufmax = bufmax;
+ buf->text->mule_bytmin = bytmin;
+ buf->text->mule_bytmax = bytmax;
+
+ if (add_to_cache)
+ {
+ int replace_loc;
+
+ /* We throw away a "random" cached value and replace it with
+ the new value. It doesn't actually have to be very random
+ at all, just evenly distributed.
+
+ #### It would be better to use a least-recently-used algorithm
+ or something that tries to space things out, but I'm not sure
+ it's worth it to go to the trouble of maintaining that. */
+ not_very_random_number += 621;
+ replace_loc = not_very_random_number & 15;
+ buf->text->mule_bufpos_cache[replace_loc] = retval;
+ buf->text->mule_bytind_cache[replace_loc] = x;
+ }
+
+ return retval;
+}
+
+/* Text of length BYTELENGTH and CHARLENGTH (in different units)
+ was inserted at bufpos START. */
+
+static void
+buffer_mule_signal_inserted_region (struct buffer *buf, Bufpos start,
+ Bytecount bytelength,
+ Charcount charlength)
+{
+ int size = (1 << buf->text->mule_shifter) + !!buf->text->mule_three_p;
+ int i;
+
+ /* Adjust the cache of known positions. */
+ for (i = 0; i < 16; i++)
+ {
+
+ if (buf->text->mule_bufpos_cache[i] > start)
+ {
+ buf->text->mule_bufpos_cache[i] += charlength;
+ buf->text->mule_bytind_cache[i] += bytelength;
+ }
+ }
+
+ if (start >= buf->text->mule_bufmax)
+ return;
+
+ /* The insertion is either before the known region, in which case
+ it shoves it forward; or within the known region, in which case
+ it shoves the end forward. (But it may make the known region
+ inconsistent, so we may have to shorten it.) */
+
+ if (start <= buf->text->mule_bufmin)
+ {
+ buf->text->mule_bufmin += charlength;
+ buf->text->mule_bufmax += charlength;
+ buf->text->mule_bytmin += bytelength;
+ buf->text->mule_bytmax += bytelength;
+ }
+ else
+ {
+ Bufpos end = start + charlength;
+ /* the insertion point divides the known region in two.
+ Keep the longer half, at least, and expand into the
+ inserted chunk as much as possible. */
+
+ if (start - buf->text->mule_bufmin > buf->text->mule_bufmax - start)
+ {
+ Bytind bytestart = (buf->text->mule_bytmin
+ + size * (start - buf->text->mule_bufmin));
+ Bytind bytenew;
+
+ while (start < end)
+ {
+ bytenew = bytestart;
+ INC_BYTIND (buf, bytenew);
+ if (bytenew - bytestart != size)
+ break;
+ start++;
+ bytestart = bytenew;
+ }
+ if (start != end)
+ {
+ buf->text->mule_bufmax = start;
+ buf->text->mule_bytmax = bytestart;
+ }
+ else
+ {
+ buf->text->mule_bufmax += charlength;
+ buf->text->mule_bytmax += bytelength;
+ }
+ }
+ else
+ {
+ Bytind byteend = (buf->text->mule_bytmin
+ + size * (start - buf->text->mule_bufmin)
+ + bytelength);
+ Bytind bytenew;
+
+ buf->text->mule_bufmax += charlength;
+ buf->text->mule_bytmax += bytelength;
+
+ while (end > start)
+ {
+ bytenew = byteend;
+ DEC_BYTIND (buf, bytenew);
+ if (byteend - bytenew != size)
+ break;
+ end--;
+ byteend = bytenew;
+ }
+ if (start != end)
+ {
+ buf->text->mule_bufmin = end;
+ buf->text->mule_bytmin = byteend;
+ }
+ }
+ }
+}
+
+/* Text from START to END (equivalent in Bytinds: from BI_START to
+ BI_END) was deleted. */
+
+static void
+buffer_mule_signal_deleted_region (struct buffer *buf, Bufpos start,
+ Bufpos end, Bytind bi_start,
+ Bytind bi_end)
+{
+ int i;
+
+ /* Adjust the cache of known positions. */
+ for (i = 0; i < 16; i++)
+ {
+ /* After the end; gets shoved backward */
+ if (buf->text->mule_bufpos_cache[i] > end)
+ {
+ buf->text->mule_bufpos_cache[i] -= end - start;
+ buf->text->mule_bytind_cache[i] -= bi_end - bi_start;
+ }
+ /* In the range; moves to start of range */
+ else if (buf->text->mule_bufpos_cache[i] > start)
+ {
+ buf->text->mule_bufpos_cache[i] = start;
+ buf->text->mule_bytind_cache[i] = bi_start;
+ }
+ }
+
+ /* We don't care about any text after the end of the known region. */
+
+ end = min (end, buf->text->mule_bufmax);
+ bi_end = min (bi_end, buf->text->mule_bytmax);
+ if (start >= end)
+ return;
+
+ /* The end of the known region offsets by the total amount of deletion,
+ since it's all before it. */
+
+ buf->text->mule_bufmax -= end - start;
+ buf->text->mule_bytmax -= bi_end - bi_start;
+
+ /* Now we don't care about any text after the start of the known region. */
+
+ end = min (end, buf->text->mule_bufmin);
+ bi_end = min (bi_end, buf->text->mule_bytmin);
+ if (start >= end)
+ return;
+
+ buf->text->mule_bufmin -= end - start;
+ buf->text->mule_bytmin -= bi_end - bi_start;
+}
+
+#endif /* MULE */
+
+#ifdef ERROR_CHECK_BUFPOS
+
+Bytind
+bufpos_to_bytind (struct buffer *buf, Bufpos x)
+{
+ Bytind retval = real_bufpos_to_bytind (buf, x);
+ ASSERT_VALID_BYTIND_UNSAFE (buf, retval);
+ return retval;
+}
+
+Bufpos
+bytind_to_bufpos (struct buffer *buf, Bytind x)
+{
+ ASSERT_VALID_BYTIND_UNSAFE (buf, x);
+ return real_bytind_to_bufpos (buf, x);
+}
+
+#endif /* ERROR_CHECK_BUFPOS */
+
+\f
+/************************************************************************/
+/* verifying buffer and string positions */
+/************************************************************************/
+
+/* Functions below are tagged with either _byte or _char indicating
+ whether they return byte or character positions. For a buffer,
+ a character position is a "Bufpos" and a byte position is a "Bytind".
+ For strings, these are sometimes typed using "Charcount" and
+ "Bytecount". */
+
+/* Flags for the functions below are:
+
+ GB_ALLOW_PAST_ACCESSIBLE
+
+ Allow positions to range over the entire buffer (BUF_BEG to BUF_Z),
+ rather than just the accessible portion (BUF_BEGV to BUF_ZV).
+ For strings, this flag has no effect.
+
+ GB_COERCE_RANGE
+
+ If the position is outside the allowable range, return the lower
+ or upper bound of the range, whichever is closer to the specified
+ position.
+
+ GB_NO_ERROR_IF_BAD
+
+ If the position is outside the allowable range, return -1.
+
+ GB_NEGATIVE_FROM_END
+
+ If a value is negative, treat it as an offset from the end.
+ Only applies to strings.
+
+ The following additional flags apply only to the functions
+ that return ranges:
+
+ GB_ALLOW_NIL
+
+ Either or both positions can be nil. If FROM is nil,
+ FROM_OUT will contain the lower bound of the allowed range.
+ If TO is nil, TO_OUT will contain the upper bound of the
+ allowed range.
+
+ GB_CHECK_ORDER
+
+ FROM must contain the lower bound and TO the upper bound
+ of the range. If the positions are reversed, an error is
+ signalled.
+
+ The following is a combination flag:
+
+ GB_HISTORICAL_STRING_BEHAVIOR
+
+ Equivalent to (GB_NEGATIVE_FROM_END | GB_ALLOW_NIL).
+ */
+
+/* Return a buffer position stored in a Lisp_Object. Full
+ error-checking is done on the position. Flags can be specified to
+ control the behavior of out-of-range values. The default behavior
+ is to require that the position is within the accessible part of
+ the buffer (BEGV and ZV), and to signal an error if the position is
+ out of range.
+
+*/
+
+Bufpos
+get_buffer_pos_char (struct buffer *b, Lisp_Object pos, unsigned int flags)
+{
+ Bufpos ind;
+ Bufpos min_allowed, max_allowed;
+
+ CHECK_INT_COERCE_MARKER (pos);
+ ind = XINT (pos);
+ min_allowed = flags & GB_ALLOW_PAST_ACCESSIBLE ? BUF_BEG (b) : BUF_BEGV (b);
+ max_allowed = flags & GB_ALLOW_PAST_ACCESSIBLE ? BUF_Z (b) : BUF_ZV (b);
+
+ if (ind < min_allowed || ind > max_allowed)
+ {
+ if (flags & GB_COERCE_RANGE)
+ ind = ind < min_allowed ? min_allowed : max_allowed;
+ else if (flags & GB_NO_ERROR_IF_BAD)
+ ind = -1;
+ else
+ {
+ Lisp_Object buffer;
+ XSETBUFFER (buffer, b);
+ args_out_of_range (buffer, pos);
+ }
+ }
+
+ return ind;
+}
+
+Bytind
+get_buffer_pos_byte (struct buffer *b, Lisp_Object pos, unsigned int flags)
+{
+ Bufpos bpos = get_buffer_pos_char (b, pos, flags);
+ if (bpos < 0) /* could happen with GB_NO_ERROR_IF_BAD */
+ return -1;
+ return bufpos_to_bytind (b, bpos);
+}
+
+/* Return a pair of buffer positions representing a range of text,
+ taken from a pair of Lisp_Objects. Full error-checking is
+ done on the positions. Flags can be specified to control the
+ behavior of out-of-range values. The default behavior is to
+ allow the range bounds to be specified in either order
+ (however, FROM_OUT will always be the lower bound of the range
+ and TO_OUT the upper bound),to require that the positions
+ are within the accessible part of the buffer (BEGV and ZV),
+ and to signal an error if the positions are out of range.
+*/
+
+void
+get_buffer_range_char (struct buffer *b, Lisp_Object from, Lisp_Object to,
+ Bufpos *from_out, Bufpos *to_out, unsigned int flags)
+{
+ Bufpos min_allowed, max_allowed;
+
+ min_allowed = (flags & GB_ALLOW_PAST_ACCESSIBLE) ?
+ BUF_BEG (b) : BUF_BEGV (b);
+ max_allowed = (flags & GB_ALLOW_PAST_ACCESSIBLE) ?
+ BUF_Z (b) : BUF_ZV (b);
+
+ if (NILP (from) && (flags & GB_ALLOW_NIL))
+ *from_out = min_allowed;
+ else
+ *from_out = get_buffer_pos_char (b, from, flags | GB_NO_ERROR_IF_BAD);
+
+ if (NILP (to) && (flags & GB_ALLOW_NIL))
+ *to_out = max_allowed;
+ else
+ *to_out = get_buffer_pos_char (b, to, flags | GB_NO_ERROR_IF_BAD);
+
+ if ((*from_out < 0 || *to_out < 0) && !(flags & GB_NO_ERROR_IF_BAD))
+ {
+ Lisp_Object buffer;
+ XSETBUFFER (buffer, b);
+ args_out_of_range_3 (buffer, from, to);
+ }
+
+ if (*from_out >= 0 && *to_out >= 0 && *from_out > *to_out)
+ {
+ if (flags & GB_CHECK_ORDER)
+ signal_simple_error_2 ("start greater than end", from, to);
+ else
+ {
+ Bufpos temp = *from_out;
+ *from_out = *to_out;
+ *to_out = temp;
+ }
+ }
+}
+
+void
+get_buffer_range_byte (struct buffer *b, Lisp_Object from, Lisp_Object to,
+ Bytind *from_out, Bytind *to_out, unsigned int flags)
+{
+ Bufpos s, e;
+
+ get_buffer_range_char (b, from, to, &s, &e, flags);
+ if (s >= 0)
+ *from_out = bufpos_to_bytind (b, s);
+ else /* could happen with GB_NO_ERROR_IF_BAD */
+ *from_out = -1;
+ if (e >= 0)
+ *to_out = bufpos_to_bytind (b, e);
+ else
+ *to_out = -1;
+}
+
+static Charcount
+get_string_pos_char_1 (Lisp_Object string, Lisp_Object pos, unsigned int flags,
+ Charcount known_length)
+{
+ Charcount ccpos;
+ Charcount min_allowed = 0;
+ Charcount max_allowed = known_length;
+
+ /* Computation of KNOWN_LENGTH is potentially expensive so we pass
+ it in. */
+ CHECK_INT (pos);
+ ccpos = XINT (pos);
+ if (ccpos < 0 && flags & GB_NEGATIVE_FROM_END)
+ ccpos += max_allowed;
+
+ if (ccpos < min_allowed || ccpos > max_allowed)
+ {
+ if (flags & GB_COERCE_RANGE)
+ ccpos = ccpos < min_allowed ? min_allowed : max_allowed;
+ else if (flags & GB_NO_ERROR_IF_BAD)
+ ccpos = -1;
+ else
+ args_out_of_range (string, pos);
+ }
+
+ return ccpos;
+}
+
+Charcount
+get_string_pos_char (Lisp_Object string, Lisp_Object pos, unsigned int flags)
+{
+ return get_string_pos_char_1 (string, pos, flags,
+ XSTRING_CHAR_LENGTH (string));
+}
+
+Bytecount
+get_string_pos_byte (Lisp_Object string, Lisp_Object pos, unsigned int flags)
+{
+ Charcount ccpos = get_string_pos_char (string, pos, flags);
+ if (ccpos < 0) /* could happen with GB_NO_ERROR_IF_BAD */
+ return -1;
+ return charcount_to_bytecount (XSTRING_DATA (string), ccpos);
+}
+
+void
+get_string_range_char (Lisp_Object string, Lisp_Object from, Lisp_Object to,
+ Charcount *from_out, Charcount *to_out,
+ unsigned int flags)
+{
+ Charcount min_allowed = 0;
+ Charcount max_allowed = XSTRING_CHAR_LENGTH (string);
+
+ if (NILP (from) && (flags & GB_ALLOW_NIL))
+ *from_out = min_allowed;
+ else
+ *from_out = get_string_pos_char_1 (string, from,
+ flags | GB_NO_ERROR_IF_BAD,
+ max_allowed);
+
+ if (NILP (to) && (flags & GB_ALLOW_NIL))
+ *to_out = max_allowed;
+ else
+ *to_out = get_string_pos_char_1 (string, to,
+ flags | GB_NO_ERROR_IF_BAD,
+ max_allowed);
+
+ if ((*from_out < 0 || *to_out < 0) && !(flags & GB_NO_ERROR_IF_BAD))
+ args_out_of_range_3 (string, from, to);
+
+ if (*from_out >= 0 && *to_out >= 0 && *from_out > *to_out)
+ {
+ if (flags & GB_CHECK_ORDER)
+ signal_simple_error_2 ("start greater than end", from, to);
+ else
+ {
+ Bufpos temp = *from_out;
+ *from_out = *to_out;
+ *to_out = temp;
+ }
+ }
+}
+
+void
+get_string_range_byte (Lisp_Object string, Lisp_Object from, Lisp_Object to,
+ Bytecount *from_out, Bytecount *to_out,
+ unsigned int flags)
+{
+ Charcount s, e;
+
+ get_string_range_char (string, from, to, &s, &e, flags);
+ if (s >= 0)
+ *from_out = charcount_to_bytecount (XSTRING_DATA (string), s);
+ else /* could happen with GB_NO_ERROR_IF_BAD */
+ *from_out = -1;
+ if (e >= 0)
+ *to_out = charcount_to_bytecount (XSTRING_DATA (string), e);
+ else
+ *to_out = -1;
+
+}
+
+Bufpos
+get_buffer_or_string_pos_char (Lisp_Object object, Lisp_Object pos,
+ unsigned int flags)
+{
+ return STRINGP (object) ?
+ get_string_pos_char (object, pos, flags) :
+ get_buffer_pos_char (XBUFFER (object), pos, flags);
+}
+
+Bytind
+get_buffer_or_string_pos_byte (Lisp_Object object, Lisp_Object pos,
+ unsigned int flags)
+{
+ return STRINGP (object) ?
+ get_string_pos_byte (object, pos, flags) :
+ get_buffer_pos_byte (XBUFFER (object), pos, flags);
+}
+
+void
+get_buffer_or_string_range_char (Lisp_Object object, Lisp_Object from,
+ Lisp_Object to, Bufpos *from_out,
+ Bufpos *to_out, unsigned int flags)
+{
+ if (STRINGP (object))
+ get_string_range_char (object, from, to, from_out, to_out, flags);
+ else
+ get_buffer_range_char (XBUFFER (object), from, to, from_out, to_out, flags);
+}
+
+void
+get_buffer_or_string_range_byte (Lisp_Object object, Lisp_Object from,
+ Lisp_Object to, Bytind *from_out,
+ Bytind *to_out, unsigned int flags)
+{
+ if (STRINGP (object))
+ get_string_range_byte (object, from, to, from_out, to_out, flags);
+ else
+ get_buffer_range_byte (XBUFFER (object), from, to, from_out, to_out, flags);
+}
+
+Bufpos
+buffer_or_string_accessible_begin_char (Lisp_Object object)
+{
+ return STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object));
+}
+
+Bufpos
+buffer_or_string_accessible_end_char (Lisp_Object object)
+{
+ return STRINGP (object) ?
+ XSTRING_CHAR_LENGTH (object) : BUF_ZV (XBUFFER (object));
+}
+
+Bytind
+buffer_or_string_accessible_begin_byte (Lisp_Object object)
+{
+ return STRINGP (object) ? 0 : BI_BUF_BEGV (XBUFFER (object));
+}
+
+Bytind
+buffer_or_string_accessible_end_byte (Lisp_Object object)
+{
+ return STRINGP (object) ?
+ XSTRING_LENGTH (object) : BI_BUF_ZV (XBUFFER (object));
+}
+
+Bufpos
+buffer_or_string_absolute_begin_char (Lisp_Object object)
+{
+ return STRINGP (object) ? 0 : BUF_BEG (XBUFFER (object));
+}
+
+Bufpos
+buffer_or_string_absolute_end_char (Lisp_Object object)
+{
+ return STRINGP (object) ?
+ XSTRING_CHAR_LENGTH (object) : BUF_Z (XBUFFER (object));
+}
+
+Bytind
+buffer_or_string_absolute_begin_byte (Lisp_Object object)
+{
+ return STRINGP (object) ? 0 : BI_BUF_BEG (XBUFFER (object));
+}
+
+Bytind
+buffer_or_string_absolute_end_byte (Lisp_Object object)
+{
+ return STRINGP (object) ?
+ XSTRING_LENGTH (object) : BI_BUF_Z (XBUFFER (object));
+}
+
+\f
+/************************************************************************/
+/* point and marker adjustment */
+/************************************************************************/
+
+/* just_set_point() is the only place `PT' is an lvalue in all of emacs.
+ This function is called from set_buffer_point(), which is the function
+ that the SET_PT and BUF_SET_PT macros expand into, and from the
+ routines below that insert and delete text. (This is in cases where
+ the point marker logically doesn't move but PT (being a byte index)
+ needs to get adjusted.) */
+
+/* Set point to a specified value. This is used only when the value
+ of point changes due to an insert or delete; it does not represent
+ a conceptual change in point as a marker. In particular, point is
+ not crossing any interval boundaries, so there's no need to use the
+ usual SET_PT macro. In fact it would be incorrect to do so, because
+ either the old or the new value of point is out of synch with the
+ current set of intervals. */
+
+/* This gets called more than enough to make the function call
+ overhead a significant factor so we've turned it into a macro. */
+#define JUST_SET_POINT(buf, bufpos, ind) \
+do \
+{ \
+ buf->bufpt = (bufpos); \
+ buf->pt = (ind); \
+} while (0)
+
+/* Set a buffer's point. */
+
+void
+set_buffer_point (struct buffer *buf, Bufpos bufpos, Bytind bytpos)
+{
+ assert (bytpos >= BI_BUF_BEGV (buf) && bytpos <= BI_BUF_ZV (buf));
+ if (bytpos == BI_BUF_PT (buf))
+ return;
+ JUST_SET_POINT (buf, bufpos, bytpos);
+ MARK_POINT_CHANGED;
+ assert (MARKERP (buf->point_marker));
+ XMARKER (buf->point_marker)->memind =
+ bytind_to_memind (buf, bytpos);
+
+ /* FSF makes sure that PT is not being set within invisible text.
+ However, this is the wrong place for that check. The check
+ should happen only at the next redisplay. */
+
+ /* Some old coder said:
+
+ "If there were to be hooks which were run when point entered/left an
+ extent, this would be the place to put them.
+
+ However, it's probably the case that such hooks should be implemented
+ using a post-command-hook instead, to avoid running the hooks as a
+ result of intermediate motion inside of save-excursions, for example."
+
+ I definitely agree with this. PT gets moved all over the place
+ and it would be a Bad Thing for any hooks to get called, both for
+ the reason above and because many callers are not prepared for
+ a GC within this function. --ben
+ */
+}
+
+/* Do the correct marker-like adjustment on MPOS (see below). FROM, TO,
+ and AMOUNT are as in adjust_markers(). If MPOS doesn't need to be
+ adjusted, nothing will happen. */
+Memind
+do_marker_adjustment (Memind mpos, Memind from,
+ Memind to, Bytecount amount)
+{
+ if (amount > 0)
+ {
+ if (mpos > to && mpos < to + amount)
+ mpos = to + amount;
+ }
+ else
+ {
+ if (mpos > from + amount && mpos <= from)
+ mpos = from + amount;
+ }
+ if (mpos > from && mpos <= to)
+ mpos += amount;
+ return mpos;
+}
+
+/* Do the following:
+
+ (1) Add `amount' to the position of every marker in the current buffer
+ whose current position is between `from' (exclusive) and `to' (inclusive).
+
+ (2) Also, any markers past the outside of that interval, in the direction
+ of adjustment, are first moved back to the near end of the interval
+ and then adjusted by `amount'.
+
+ This function is called in two different cases: when a region of
+ characters adjacent to the gap is moved, causing the gap to shift
+ to the other side of the region (in this case, `from' and `to'
+ point to the old position of the region and there should be no
+ markers affected by (2) because they would be inside the gap),
+ or when a region of characters adjacent to the gap is wiped out,
+ causing the gap to increase to include the region (in this case,
+ `from' and `to' are the same, both pointing to the boundary
+ between the gap and the deleted region, and there are no markers
+ affected by (1)).
+
+ The reason for the use of exclusive and inclusive is that markers at
+ the gap always sit at the beginning, not at the end.
+*/
+
+static void
+adjust_markers (struct buffer *buf, Memind from, Memind to,
+ Bytecount amount)
+{
+ struct Lisp_Marker *m;
+
+ for (m = BUF_MARKERS (buf); m; m = marker_next (m))
+ m->memind = do_marker_adjustment (m->memind, from, to, amount);
+}
+
+/* Adjust markers whose insertion-type is t
+ for an insertion of AMOUNT characters at POS. */
+
+static void
+adjust_markers_for_insert (struct buffer *buf, Memind ind, Bytecount amount)
+{
+ struct Lisp_Marker *m;
+
+ for (m = BUF_MARKERS (buf); m; m = marker_next (m))
+ {
+ if (m->insertion_type && m->memind == ind)
+ m->memind += amount;
+ }
+}
+
+\f
+/************************************************************************/
+/* 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
+ bigger. --ben */
+#define GAP_MOVE_CHUNK 300000
+
+/* Move the gap to POS, which is less than the current GPT. */
+
+static void
+gap_left (struct buffer *buf, Bytind pos)
+{
+ Bufbyte *to, *from;
+ Bytecount i;
+ Bytind new_s1;
+
+ from = BUF_GPT_ADDR (buf);
+ to = from + BUF_GAP_SIZE (buf);
+ new_s1 = BI_BUF_GPT (buf);
+
+ /* Now copy the characters. To move the gap down,
+ copy characters up. */
+
+ while (1)
+ {
+ /* I gets number of characters left to copy. */
+ i = new_s1 - pos;
+ if (i == 0)
+ break;
+ /* If a quit is requested, stop copying now.
+ Change POS to be where we have actually moved the gap to. */
+ if (QUITP)
+ {
+ pos = new_s1;
+ break;
+ }
+ /* 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 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;
+ memmove (to, from, i);
+ }
+ else
+#endif
+ {
+ new_s1 -= i;
+ while (--i >= 0)
+ *--to = *--from;
+ }
+ }
+
+ /* Adjust markers, and buffer data structure, to put the gap at POS.
+ POS is where the loop above stopped, which may be what was specified
+ or may be where a quit was detected. */
+ adjust_markers (buf, pos, BI_BUF_GPT (buf), BUF_GAP_SIZE (buf));
+ adjust_extents (make_buffer (buf), pos, BI_BUF_GPT (buf),
+ BUF_GAP_SIZE (buf));
+ SET_BI_BUF_GPT (buf, pos);
+ SET_GAP_SENTINEL (buf);
+#ifdef ERROR_CHECK_EXTENTS
+ sledgehammer_extent_check (make_buffer (buf));
+#endif
+ QUIT;
+}
+
+static void
+gap_right (struct buffer *buf, Bytind pos)
+{
+ Bufbyte *to, *from;
+ Bytecount i;
+ Bytind new_s1;
+
+ to = BUF_GPT_ADDR (buf);
+ from = to + BUF_GAP_SIZE (buf);
+ new_s1 = BI_BUF_GPT (buf);
+
+ /* Now copy the characters. To move the gap up,
+ copy characters down. */
+
+ while (1)
+ {
+ /* I gets number of characters left to copy. */
+ i = pos - new_s1;
+ if (i == 0)
+ break;
+ /* If a quit is requested, stop copying now.
+ Change POS to be where we have actually moved the gap to. */
+ if (QUITP)
+ {
+ pos = new_s1;
+ break;
+ }
+ /* 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 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;
+ }
+ else
+#endif
+ {
+ new_s1 += i;
+ while (--i >= 0)
+ *to++ = *from++;
+ }
+ }
+
+ {
+ int gsize = BUF_GAP_SIZE (buf);
+ adjust_markers (buf, BI_BUF_GPT (buf) + gsize, pos + gsize, - gsize);
+ adjust_extents (make_buffer (buf), BI_BUF_GPT (buf) + gsize, pos + gsize,
+ - gsize);
+ SET_BI_BUF_GPT (buf, pos);
+ SET_GAP_SENTINEL (buf);
+#ifdef ERROR_CHECK_EXTENTS
+ sledgehammer_extent_check (make_buffer (buf));
+#endif
+ }
+ if (pos == BI_BUF_Z (buf))
+ {
+ /* merge gap with end gap */
+
+ SET_BUF_GAP_SIZE (buf, BUF_GAP_SIZE (buf) + BUF_END_GAP_SIZE (buf));
+ SET_BUF_END_GAP_SIZE (buf, 0);
+ SET_END_SENTINEL (buf);
+ }
+
+ QUIT;
+}
+
+/* Move gap to position `pos'.
+ Note that this can quit! */
+
+static void
+move_gap (struct buffer *buf, Bytind pos)
+{
+ if (! BUF_BEG_ADDR (buf))
+ abort ();
+ if (pos < BI_BUF_GPT (buf))
+ gap_left (buf, pos);
+ else if (pos > BI_BUF_GPT (buf))
+ gap_right (buf, pos);
+}
+
+/* Merge the end gap into the gap */
+
+static void
+merge_gap_with_end_gap (struct buffer *buf)
+{
+ Lisp_Object tem;
+ Bytind real_gap_loc;
+ Bytecount old_gap_size;
+ Bytecount increment;
+
+ increment = BUF_END_GAP_SIZE (buf);
+ SET_BUF_END_GAP_SIZE (buf, 0);
+
+ if (increment > 0)
+ {
+ /* Prevent quitting in move_gap. */
+ tem = Vinhibit_quit;
+ Vinhibit_quit = Qt;
+
+ real_gap_loc = BI_BUF_GPT (buf);
+ old_gap_size = BUF_GAP_SIZE (buf);
+
+ /* Pretend the end gap is the gap */
+ SET_BI_BUF_GPT (buf, BI_BUF_Z (buf) + BUF_GAP_SIZE (buf));
+ SET_BUF_GAP_SIZE (buf, increment);
+
+ /* Move the new gap down to be consecutive with the end of the old one.
+ This adjusts the markers properly too. */
+ gap_left (buf, real_gap_loc + old_gap_size);
+
+ /* Now combine the two into one large gap. */
+ SET_BUF_GAP_SIZE (buf, BUF_GAP_SIZE (buf) + old_gap_size);
+ SET_BI_BUF_GPT (buf, real_gap_loc);
+ SET_GAP_SENTINEL (buf);
+
+ /* We changed the total size of the buffer (including gap),
+ so we need to fix up the end sentinel. */
+ SET_END_SENTINEL (buf);
+
+ Vinhibit_quit = tem;
+ }
+}
+
+/* Make the gap INCREMENT bytes longer. */
+
+static void
+make_gap (struct buffer *buf, Bytecount increment)
+{
+ Bufbyte *result;
+ Lisp_Object tem;
+ Bytind real_gap_loc;
+ Bytecount old_gap_size;
+
+ /* If we have to get more space, get enough to last a while. We use
+ a geometric progession that saves on realloc space. */
+ increment += 2000 + ((BI_BUF_Z (buf) - BI_BUF_BEG (buf)) / 8);
+
+ if (increment > BUF_END_GAP_SIZE (buf))
+ {
+ /* Don't allow a buffer size that won't fit in an int
+ even if it will fit in a Lisp integer.
+ That won't work because so many places use `int'. */
+
+ if (BUF_Z (buf) - BUF_BEG (buf) + BUF_GAP_SIZE (buf) + increment
+ > EMACS_INT_MAX)
+ error ("Maximum buffer size exceeded");
+
+ result = BUFFER_REALLOC (buf->text->beg,
+ BI_BUF_Z (buf) - BI_BUF_BEG (buf) +
+ BUF_GAP_SIZE (buf) + increment +
+ BUF_END_SENTINEL_SIZE);
+ if (result == 0)
+ memory_full ();
+
+ SET_BUF_BEG_ADDR (buf, result);
+ }
+ else
+ increment = BUF_END_GAP_SIZE (buf);
+
+ /* Prevent quitting in move_gap. */
+ tem = Vinhibit_quit;
+ Vinhibit_quit = Qt;
+
+ real_gap_loc = BI_BUF_GPT (buf);
+ old_gap_size = BUF_GAP_SIZE (buf);
+
+ /* Call the newly allocated space a gap at the end of the whole space. */
+ SET_BI_BUF_GPT (buf, BI_BUF_Z (buf) + BUF_GAP_SIZE (buf));
+ SET_BUF_GAP_SIZE (buf, increment);
+
+ SET_BUF_END_GAP_SIZE (buf, 0);
+
+ /* Move the new gap down to be consecutive with the end of the old one.
+ This adjusts the markers properly too. */
+ gap_left (buf, real_gap_loc + old_gap_size);
+
+ /* Now combine the two into one large gap. */
+ SET_BUF_GAP_SIZE (buf, BUF_GAP_SIZE (buf) + old_gap_size);
+ SET_BI_BUF_GPT (buf, real_gap_loc);
+ SET_GAP_SENTINEL (buf);
+
+ /* We changed the total size of the buffer (including gap),
+ so we need to fix up the end sentinel. */
+ SET_END_SENTINEL (buf);
+
+ Vinhibit_quit = tem;
+}
+
+\f
+/************************************************************************/
+/* Before/after-change processing */
+/************************************************************************/
+
+/* Those magic changes ... */
+
+static void
+buffer_signal_changed_region (struct buffer *buf, Bufpos start,
+ Bufpos end)
+{
+ /* The changed region is recorded as the number of unchanged
+ characters from the beginning and from the end of the
+ buffer. This obviates much of the need of shifting the
+ region around to compensate for insertions and deletions.
+ */
+ if (buf->changes->begin_unchanged < 0 ||
+ buf->changes->begin_unchanged > start - BUF_BEG (buf))
+ buf->changes->begin_unchanged = start - BUF_BEG (buf);
+ if (buf->changes->end_unchanged < 0 ||
+ buf->changes->end_unchanged > BUF_Z (buf) - end)
+ buf->changes->end_unchanged = BUF_Z (buf) - end;
+}
+
+void
+buffer_extent_signal_changed_region (struct buffer *buf, Bufpos start,
+ Bufpos end)
+{
+ if (buf->changes->begin_extent_unchanged < 0 ||
+ buf->changes->begin_extent_unchanged > start - BUF_BEG (buf))
+ buf->changes->begin_extent_unchanged = start - BUF_BEG (buf);
+ if (buf->changes->end_extent_unchanged < 0 ||
+ buf->changes->end_extent_unchanged > BUF_Z (buf) - end)
+ buf->changes->end_extent_unchanged = BUF_Z (buf) - end;
+}
+
+void
+buffer_reset_changes (struct buffer *buf)
+{
+ buf->changes->begin_unchanged = -1;
+ buf->changes->end_unchanged = -1;
+ buf->changes->begin_extent_unchanged = -1;
+ buf->changes->end_extent_unchanged = -1;
+ buf->changes->newline_was_deleted = 0;
+}
+
+static void
+signal_after_change (struct buffer *buf, Bufpos start, Bufpos orig_end,
+ Bufpos new_end);
+
+
+/* Call the after-change-functions according to the changes made so far
+ and treat all further changes as single until the outermost
+ multiple change exits. This is called when the outermost multiple
+ change exits and when someone is trying to make a change that violates
+ the constraints specified in begin_multiple_change(), typically
+ when nested multiple-change sessions occur. (There are smarter ways of
+ dealing with nested multiple changes, but these rarely occur so there's
+ probably no point in it.) */
+
+/* #### This needs to keep track of what actually changed and only
+ call the after-change functions on that region. */
+
+static void
+cancel_multiple_change (struct buffer *buf)
+{
+ /* This function can GC */
+ /* Call the after-change-functions except when they've already been
+ called or when there were no changes made to the buffer at all. */
+ if (buf->text->changes->mc_begin != 0 &&
+ buf->text->changes->mc_begin_signaled)
+ {
+ Bufpos real_mc_begin = buf->text->changes->mc_begin;
+ buf->text->changes->mc_begin = 0;
+
+ signal_after_change (buf, real_mc_begin, buf->text->changes->mc_orig_end,
+ buf->text->changes->mc_new_end);
+ }
+ else
+ {
+ buf->text->changes->mc_begin = 0;
+ }
+}
+
+/* this is an unwind_protect, to ensure that the after-change-functions
+ get called even in a non-local exit. */
+
+static Lisp_Object
+multiple_change_finish_up (Lisp_Object buffer)
+{
+ struct buffer *buf = XBUFFER (buffer);
+
+ /* #### I don't know whether or not it should even be possible to
+ get here with a dead buffer (though given how it is called I can
+ see how it might be). In any case, there isn't time before 19.14
+ to find out. */
+ if (!BUFFER_LIVE_P (buf))
+ return Qnil;
+
+ /* This function can GC */
+ buf->text->changes->in_multiple_change = 0; /* do this first so that
+ errors in the after-change
+ functions don't mess things
+ up. */
+ cancel_multiple_change (buf);
+ return Qnil;
+}
+
+/* Call this function when you're about to make a number of buffer changes
+ that should be considered a single change. (e.g. `replace-match' calls
+ this.) You need to specify the START and END of the region that is
+ going to be changed so that the before-change-functions are called
+ with the correct arguments. The after-change region is calculated
+ automatically, however, and if changes somehow or other happen outside
+ 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. */
+
+int
+begin_multiple_change (struct buffer *buf, Bufpos start, Bufpos end)
+{
+ /* This function can GC */
+ int count = -1;
+ if (buf->text->changes->in_multiple_change)
+ {
+ if (buf->text->changes->mc_begin != 0 &&
+ (start < buf->text->changes->mc_begin ||
+ end > buf->text->changes->mc_new_end))
+ cancel_multiple_change (buf);
+ }
+ else
+ {
+ Lisp_Object buffer;
+
+ buf->text->changes->mc_begin = start;
+ buf->text->changes->mc_orig_end = buf->text->changes->mc_new_end = end;
+ buf->text->changes->mc_begin_signaled = 0;
+ count = specpdl_depth ();
+ XSETBUFFER (buffer, buf);
+ record_unwind_protect (multiple_change_finish_up, buffer);
+ }
+ buf->text->changes->in_multiple_change++;
+ /* We don't call before-change-functions until signal_before_change()
+ is called, in case there is a read-only or other error. */
+ return count;
+}
+
+void
+end_multiple_change (struct buffer *buf, int count)
+{
+ assert (buf->text->changes->in_multiple_change > 0);
+ buf->text->changes->in_multiple_change--;
+ if (!buf->text->changes->in_multiple_change)
+ unbind_to (count, Qnil);
+}
+
+static int inside_change_hook;
+
+static Lisp_Object
+change_function_restore (Lisp_Object buffer)
+{
+ Fset_buffer (buffer);
+ inside_change_hook = 0;
+ return Qnil;
+}
+
+static int in_first_change;
+
+static Lisp_Object
+first_change_hook_restore (Lisp_Object buffer)
+{
+ Fset_buffer (buffer);
+ in_first_change = 0;
+ return Qnil;
+}
+
+/* Signal an initial modification to the buffer. */
+
+static void
+signal_first_change (struct buffer *buf)
+{
+ /* This function can GC */
+ Lisp_Object buffer;
+ XSETBUFFER (buffer, current_buffer);
+
+ if (!in_first_change)
+ {
+ if (!preparing_for_armageddon &&
+ !NILP (symbol_value_in_buffer (Qfirst_change_hook, buffer)))
+ {
+ int speccount = specpdl_depth ();
+ record_unwind_protect (first_change_hook_restore, buffer);
+ set_buffer_internal (buf);
+ in_first_change = 1;
+ run_hook (Qfirst_change_hook);
+ unbind_to (speccount, Qnil);
+ }
+ }
+}
+
+/* Signal a change to the buffer immediately before it happens.
+ START and END are the bounds of the text to be changed. */
+
+static void
+signal_before_change (struct buffer *buf, Bufpos start, Bufpos end)
+{
+ /* This function can GC */
+ Lisp_Object buffer;
+ XSETBUFFER (buffer, buf);
+
+ if (!inside_change_hook)
+ {
+ /* Are we in a multiple-change session? */
+ if (buf->text->changes->in_multiple_change &&
+ buf->text->changes->mc_begin != 0)
+ {
+ /* If we're violating the constraints of the session,
+ call the after-change-functions as necessary for the
+ changes already made and treat further changes as
+ single. */
+ if (start < buf->text->changes->mc_begin ||
+ end > buf->text->changes->mc_new_end)
+ cancel_multiple_change (buf);
+ /* Do nothing if this is not the first change in the session. */
+ else if (buf->text->changes->mc_begin_signaled)
+ return;
+ else
+ {
+ /* First time through; call the before-change-functions
+ specifying the entire region to be changed. (Note that
+ we didn't call before-change-functions in
+ begin_multiple_change() because the buffer might be
+ read-only, etc.) */
+ start = buf->text->changes->mc_begin;
+ end = buf->text->changes->mc_new_end;
+ }
+ }
+
+ /* If buffer is unmodified, run a special hook for that case. */
+ if (BUF_SAVE_MODIFF (buf) >= BUF_MODIFF (buf))
+ signal_first_change (buf);
+
+ /* Now in any case run the before-change-functions if any. */
+
+ if (!preparing_for_armageddon &&
+ (!NILP (symbol_value_in_buffer (Qbefore_change_functions, buffer)) ||
+ /* 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);
+ }
+
+ /* Only now do we indicate that the before-change-functions have
+ been called, in case some function throws out. */
+ buf->text->changes->mc_begin_signaled = 1;
+ }
+
+ /* #### At this point we should map over extents calling
+ modification-hooks, insert-before-hooks and insert-after-hooks
+ of relevant extents */
+}
+
+/* Signal a change immediately after it happens.
+ START is the bufpos of the start of the changed text.
+ ORIG_END is the bufpos of the end of the before-changed text.
+ NEW_END is the bufpos of the end of the after-changed text.
+ */
+
+static void
+signal_after_change (struct buffer *buf, Bufpos start, Bufpos orig_end,
+ Bufpos new_end)
+{
+ /* This function can GC */
+ Lisp_Object buffer;
+ XSETBUFFER (buffer, buf);
+
+ /* always do this. */
+ buffer_signal_changed_region (buf, start, new_end);
+ font_lock_maybe_update_syntactic_caches (buf, start, orig_end, new_end);
+
+ if (!inside_change_hook)
+ {
+ if (buf->text->changes->in_multiple_change &&
+ buf->text->changes->mc_begin != 0)
+ {
+ assert (start >= buf->text->changes->mc_begin &&
+ start <= buf->text->changes->mc_new_end);
+ assert (orig_end >= buf->text->changes->mc_begin &&
+ orig_end <= buf->text->changes->mc_new_end);
+ buf->text->changes->mc_new_end += new_end - orig_end;
+ return; /* after-change-functions signalled when all changes done */
+ }
+
+ if (!preparing_for_armageddon &&
+ (!NILP (symbol_value_in_buffer (Qafter_change_functions, buffer)) ||
+ /* 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,
+ make_int (start), make_int (new_end),
+ make_int (orig_end - start));
+ /* Obsolete, for compatibility */
+ 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);
+ }
+ }
+
+ /* #### At this point we should map over extents calling
+ some sort of modification hooks of relevant extents */
+}
+
+/* Call this if you're about to change the region of BUFFER from START
+ to END. This checks the read-only properties of the region, calls
+ the necessary modification hooks, and warns the next redisplay that
+ it should pay attention to that area. */
+
+static void
+prepare_to_modify_buffer (struct buffer *buf, Bufpos start, Bufpos end,
+ int lockit)
+{
+ /* This function can GC */
+ /* dmoore - This function can also kill the buffer buf, the current
+ buffer, and do anything it pleases. So if you call it, be
+ careful. */
+ Lisp_Object buffer;
+ struct gcpro gcpro1;
+
+ barf_if_buffer_read_only (buf, start, end);
+
+ /* if this is the first modification, see about locking the buffer's
+ file */
+ XSETBUFFER (buffer, buf);
+ GCPRO1 (buffer);
+ if (!NILP (buf->filename) && lockit &&
+ BUF_SAVE_MODIFF (buf) >= BUF_MODIFF (buf))
+ {
+#ifdef CLASH_DETECTION
+ if (!NILP (buf->file_truename))
+ /* Make binding buffer-file-name to nil effective. */
+ lock_file (buf->file_truename);
+#else
+ /* At least warn if this file has changed on disk since it was visited.*/
+ if (NILP (Fverify_visited_file_modtime (buffer))
+ && !NILP (Ffile_exists_p (buf->filename)))
+ call1_in_buffer (buf, intern ("ask-user-about-supersession-threat"),
+ buf->filename);
+#endif /* not CLASH_DETECTION */
+ }
+ UNGCPRO;
+
+ /* #### dmoore - is this reasonable in case of buf being killed above? */
+ if (!BUFFER_LIVE_P (buf))
+ return;
+
+ signal_before_change (buf, start, end);
+
+#ifdef REGION_CACHE_NEEDS_WORK
+ if (buf->newline_cache)
+ invalidate_region_cache (buf,
+ buf->newline_cache,
+ start - BUF_BEG (buf), BUF_Z (buf) - end);
+ if (buf->width_run_cache)
+ invalidate_region_cache (buf,
+ buf->width_run_cache,
+ start - BUF_BEG (buf), BUF_Z (buf) - end);
+#endif
+
+#if 0 /* FSFmacs */
+ Vdeactivate_mark = Qt;
+#endif
+
+ buf->point_before_scroll = Qnil;
+}
+
+\f
+/************************************************************************/
+/* Insertion of strings */
+/************************************************************************/
+
+void
+fixup_internal_substring (CONST Bufbyte *nonreloc, Lisp_Object reloc,
+ Bytecount offset, Bytecount *len)
+{
+ assert ((nonreloc && NILP (reloc)) || (!nonreloc && STRINGP (reloc)));
+
+ if (*len < 0)
+ {
+ if (nonreloc)
+ *len = strlen ((CONST char *) nonreloc) - offset;
+ else
+ *len = XSTRING_LENGTH (reloc) - offset;
+ }
+#ifdef ERROR_CHECK_BUFPOS
+ assert (*len >= 0);
+ if (STRINGP (reloc))
+ {
+ assert (offset >= 0 && offset <= XSTRING_LENGTH (reloc));
+ assert (offset + *len <= XSTRING_LENGTH (reloc));
+ }
+#endif
+}
+
+/* Insert a string into BUF at Bufpos POS. The string data comes
+ from one of two sources: constant, non-relocatable data (specified
+ in NONRELOC), or a Lisp string object (specified in RELOC), which
+ is relocatable and may have extent data that needs to be copied
+ into the buffer. OFFSET and LENGTH specify the substring of the
+ data that is actually to be inserted. As a special case, if POS
+ is -1, insert the string at point and move point to the end of the
+ string.
+
+ Normally, markers at the insertion point end up before the
+ inserted string. If INSDEL_BEFORE_MARKERS is set in flags, however,
+ they end up after the string.
+
+ INSDEL_NO_LOCKING is kludgy and is used when insert-file-contents is
+ visiting a new file; it inhibits the locking checks normally done
+ before modifying a buffer. Similar checks were already done
+ in the higher-level Lisp functions calling insert-file-contents. */
+
+Charcount
+buffer_insert_string_1 (struct buffer *buf, Bufpos pos,
+ CONST Bufbyte *nonreloc, Lisp_Object reloc,
+ Bytecount offset, Bytecount length,
+ int flags)
+{
+ /* This function can GC */
+ struct gcpro gcpro1;
+ Bytind ind;
+ Charcount cclen;
+ int move_point = 0;
+
+ /* Defensive steps just in case a buffer gets deleted and a calling
+ function doesn't notice it. */
+ if (!BUFFER_LIVE_P (buf))
+ return 0;
+
+ fixup_internal_substring (nonreloc, reloc, offset, &length);
+
+ if (pos == -1)
+ {
+ pos = BUF_PT (buf);
+ move_point = 1;
+ }
+
+#ifdef I18N3
+ /* #### See the comment in print_internal(). If this buffer is marked
+ as translatable, then Fgettext() should be called on obj if it
+ is a string. */
+#endif
+
+ /* Make sure that point-max won't exceed the size of an emacs int. */
+ if ((length + BUF_Z (buf)) > EMACS_INT_MAX)
+ error ("Maximum buffer size exceeded");
+
+ /* theoretically not necessary -- caller should GCPRO */
+ GCPRO1 (reloc);
+
+ prepare_to_modify_buffer (buf, pos, pos, !(flags & INSDEL_NO_LOCKING));
+
+ /* Defensive steps in case the before-change-functions fuck around */
+ if (!BUFFER_LIVE_P (buf))
+ {
+ UNGCPRO;
+ /* Bad bad pre-change function. */
+ return 0;
+ }
+
+ /* Make args be valid again. prepare_to_modify_buffer() might have
+ modified the buffer. */
+ if (pos < BUF_BEGV (buf))
+ pos = BUF_BEGV (buf);
+ if (pos > BUF_ZV (buf))
+ pos = BUF_ZV (buf);
+
+ /* string may have been relocated up to this point */
+ if (STRINGP (reloc))
+ nonreloc = XSTRING_DATA (reloc);
+
+ ind = bufpos_to_bytind (buf, pos);
+ cclen = bytecount_to_charcount (nonreloc + offset, length);
+
+ if (ind != BI_BUF_GPT (buf))
+ /* #### if debug-on-quit is invoked and the user changes the
+ buffer, bad things can happen. This is a rampant problem
+ in Emacs. */
+ move_gap (buf, ind); /* may QUIT */
+ if (! GAP_CAN_HOLD_SIZE_P (buf, length))
+ {
+ if (BUF_END_GAP_SIZE (buf) >= length)
+ merge_gap_with_end_gap (buf);
+ else
+ make_gap (buf, length - BUF_GAP_SIZE (buf));
+ }
+
+ insert_invalidate_line_number_cache (buf, pos, nonreloc + offset, length);
+
+ record_insert (buf, pos, cclen);
+ BUF_MODIFF (buf)++;
+ MARK_BUFFERS_CHANGED;
+
+ /* string may have been relocated up to this point */
+ if (STRINGP (reloc))
+ nonreloc = XSTRING_DATA (reloc);
+
+ memcpy (BUF_GPT_ADDR (buf), nonreloc + offset, length);
+
+ SET_BUF_GAP_SIZE (buf, BUF_GAP_SIZE (buf) - length);
+ SET_BI_BUF_GPT (buf, BI_BUF_GPT (buf) + length);
+ SET_BOTH_BUF_ZV (buf, BUF_ZV (buf) + cclen, BI_BUF_ZV (buf) + length);
+ SET_BOTH_BUF_Z (buf, BUF_Z (buf) + cclen, BI_BUF_Z (buf) + length);
+ SET_GAP_SENTINEL (buf);
+
+#ifdef MULE
+ buffer_mule_signal_inserted_region (buf, pos, length, cclen);
+#endif
+
+ process_extents_for_insertion (make_buffer (buf), ind, length);
+ /* We know the gap is at IND so the cast is OK. */
+ adjust_markers_for_insert (buf, (Memind) ind, length);
+
+ /* Point logically doesn't move, but may need to be adjusted because
+ it's a byte index. point-marker doesn't change because it's a
+ memory index. */
+ if (BI_BUF_PT (buf) > ind)
+ JUST_SET_POINT (buf, BUF_PT (buf) + cclen, BI_BUF_PT (buf) + length);
+
+ /* Well, point might move. */
+ if (move_point)
+ BI_BUF_SET_PT (buf, ind + length);
+
+ if (STRINGP (reloc))
+ splice_in_string_extents (reloc, buf, ind, length, offset);
+
+ if (flags & INSDEL_BEFORE_MARKERS)
+ {
+ /* ind - 1 is correct because the FROM argument is exclusive.
+ I formerly used DEC_BYTIND() but that caused problems at the
+ beginning of the buffer. */
+ adjust_markers (buf, ind - 1, ind, length);
+ }
+
+ signal_after_change (buf, pos, pos, pos + cclen);
+
+ UNGCPRO;
+
+ return cclen;
+}
+
+
+/* The following functions are interfaces onto the above function,
+ for inserting particular sorts of data. In all the functions,
+ BUF and POS specify the buffer and location where the insertion is
+ to take place. (If POS is -1, text is inserted at point and point
+ moves forward past the text.) FLAGS is as above. */
+
+Charcount
+buffer_insert_raw_string_1 (struct buffer *buf, Bufpos pos,
+ CONST Bufbyte *nonreloc, Bytecount length,
+ int flags)
+{
+ /* This function can GC */
+ return buffer_insert_string_1 (buf, pos, nonreloc, Qnil, 0, length,
+ flags);
+}
+
+Charcount
+buffer_insert_lisp_string_1 (struct buffer *buf, Bufpos pos, Lisp_Object str,
+ int flags)
+{
+ /* This function can GC */
+ assert (STRINGP (str));
+ return buffer_insert_string_1 (buf, pos, 0, str, 0,
+ XSTRING_LENGTH (str),
+ flags);
+}
+
+/* Insert the null-terminated string S (in external format). */
+
+Charcount
+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,
+ 0, strlen (translated), flags);
+}
+
+Charcount
+buffer_insert_emacs_char_1 (struct buffer *buf, Bufpos pos, Emchar ch,
+ int flags)
+{
+ /* This function can GC */
+ Bufbyte str[MAX_EMCHAR_LEN];
+ Bytecount len;
+
+ len = set_charptr_emchar (str, ch);
+ return buffer_insert_string_1 (buf, pos, str, Qnil, 0, len, flags);
+}
+
+Charcount
+buffer_insert_c_char_1 (struct buffer *buf, Bufpos pos, char c,
+ int flags)
+{
+ /* This function can GC */
+ return buffer_insert_emacs_char_1 (buf, pos, (Emchar) (unsigned char) c,
+ flags);
+}
+
+Charcount
+buffer_insert_from_buffer_1 (struct buffer *buf, Bufpos pos,
+ struct buffer *buf2, Bufpos pos2,
+ Charcount length, int flags)
+{
+ /* This function can GC */
+ Lisp_Object str = make_string_from_buffer (buf2, pos2, length);
+ return buffer_insert_string_1 (buf, pos, 0, str, 0,
+ XSTRING_LENGTH (str), flags);
+}
+
+\f
+/************************************************************************/
+/* Deletion of ranges */
+/************************************************************************/
+
+/* Delete characters in buffer from FROM up to (but not including) TO. */
+
+void
+buffer_delete_range (struct buffer *buf, Bufpos from, Bufpos to, int flags)
+{
+ /* This function can GC */
+ Charcount numdel;
+ Bytind bi_from, bi_to;
+ Bytecount bc_numdel;
+ EMACS_INT shortage;
+ Lisp_Object bufobj;
+
+ /* Defensive steps just in case a buffer gets deleted and a calling
+ function doesn't notice it. */
+ if (!BUFFER_LIVE_P (buf))
+ return;
+
+ /* Make args be valid */
+ if (from < BUF_BEGV (buf))
+ from = BUF_BEGV (buf);
+ if (to > BUF_ZV (buf))
+ to = BUF_ZV (buf);
+ if ((numdel = to - from) <= 0)
+ return;
+
+ prepare_to_modify_buffer (buf, from, to, !(flags & INSDEL_NO_LOCKING));
+
+ /* Defensive steps in case the before-change-functions fuck around */
+ if (!BUFFER_LIVE_P (buf))
+ /* Bad bad pre-change function. */
+ return;
+
+ /* Make args be valid again. prepare_to_modify_buffer() might have
+ modified the buffer. */
+ if (from < BUF_BEGV (buf))
+ from = BUF_BEGV (buf);
+ if (to > BUF_ZV (buf))
+ to = BUF_ZV (buf);
+ if ((numdel = to - from) <= 0)
+ return;
+
+ XSETBUFFER (bufobj, buf);
+
+ /* Redisplay needs to know if a newline was in the deleted region.
+ If we've already marked the changed region as having a deleted
+ newline there is no use in performing the check. */
+ if (!buf->changes->newline_was_deleted)
+ {
+ scan_buffer (buf, '\n', from, to, 1, &shortage, 1);
+ if (!shortage)
+ buf->changes->newline_was_deleted = 1;
+ }
+
+ bi_from = bufpos_to_bytind (buf, from);
+ bi_to = bufpos_to_bytind (buf, to);
+ bc_numdel = bi_to - bi_from;
+
+ delete_invalidate_line_number_cache (buf, from, to);
+
+ if (to == BUF_Z (buf) &&
+ bi_from > BI_BUF_GPT (buf))
+ {
+ /* avoid moving the gap just to delete from the bottom. */
+
+ record_delete (buf, from, numdel);
+ BUF_MODIFF (buf)++;
+ MARK_BUFFERS_CHANGED;
+
+ /* ### Point used to be modified here, but this causes problems with MULE,
+ as point is used to calculate bytinds, and if the offset in bc_numdel causes
+ point to move to a non first-byte location, causing some other function to
+ throw an assertion in ASSERT_VALID_BYTIND. I've moved the code to right after
+ the other movements and adjustments, but before the gap is moved.
+ -- jh 970813 */
+
+ /* Detach any extents that are completely within the range [FROM, TO],
+ if the extents are detachable.
+
+ This must come AFTER record_delete(), so that the appropriate extents
+ will be present to be recorded, and BEFORE the gap size is increased,
+ as otherwise we will be confused about where the extents end. */
+ process_extents_for_deletion (bufobj, bi_from, bi_to, 0);
+
+ /* Relocate all markers pointing into the new, larger gap
+ to point at the end of the text before the gap. */
+ adjust_markers (buf,
+ (bi_to + BUF_GAP_SIZE (buf)),
+ (bi_to + BUF_GAP_SIZE (buf)),
+ (- bc_numdel));
+
+ /* Relocate any extent endpoints just like markers. */
+ adjust_extents_for_deletion (bufobj, bi_from, bi_to,
+ BUF_GAP_SIZE (buf), bc_numdel, 0);
+
+ /* Relocate point as if it were a marker. */
+ if (bi_from < BI_BUF_PT (buf))
+ {
+ if (BI_BUF_PT (buf) < bi_to)
+ JUST_SET_POINT (buf, from, bi_from);
+ else
+ JUST_SET_POINT (buf, BUF_PT (buf) - numdel,
+ BI_BUF_PT (buf) - bc_numdel);
+ }
+
+ SET_BUF_END_GAP_SIZE (buf, BUF_END_GAP_SIZE (buf) + bc_numdel);
+
+ SET_BOTH_BUF_ZV (buf, BUF_ZV (buf) - numdel, BI_BUF_ZV (buf) - bc_numdel);
+ SET_BOTH_BUF_Z (buf, BUF_Z (buf) - numdel, BI_BUF_Z (buf) - bc_numdel);
+ SET_GAP_SENTINEL (buf);
+ }
+ else
+ {
+ /* Make sure the gap is somewhere in or next to what we are deleting. */
+ if (bi_to < BI_BUF_GPT (buf))
+ gap_left (buf, bi_to);
+ if (bi_from > BI_BUF_GPT (buf))
+ gap_right (buf, bi_from);
+
+ record_delete (buf, from, numdel);
+ BUF_MODIFF (buf)++;
+ MARK_BUFFERS_CHANGED;
+
+ /* ### Point used to be modified here, but this causes problems with MULE,
+ as point is used to calculate bytinds, and if the offset in bc_numdel causes
+ point to move to a non first-byte location, causing some other function to
+ throw an assertion in ASSERT_VALID_BYTIND. I've moved the code to right after
+ the other movements and adjustments, but before the gap is moved.
+ -- jh 970813 */
+
+ /* Detach any extents that are completely within the range [FROM, TO],
+ if the extents are detachable.
+
+ This must come AFTER record_delete(), so that the appropriate extents
+ will be present to be recorded, and BEFORE the gap size is increased,
+ as otherwise we will be confused about where the extents end. */
+ process_extents_for_deletion (bufobj, bi_from, bi_to, 0);
+
+ /* Relocate all markers pointing into the new, larger gap
+ to point at the end of the text before the gap. */
+ adjust_markers (buf,
+ (bi_to + BUF_GAP_SIZE (buf)),
+ (bi_to + BUF_GAP_SIZE (buf)),
+ (- bc_numdel - BUF_GAP_SIZE (buf)));
+
+ /* Relocate any extent endpoints just like markers. */
+ adjust_extents_for_deletion (bufobj, bi_from, bi_to, BUF_GAP_SIZE (buf),
+ bc_numdel, BUF_GAP_SIZE (buf));
+
+ /* Relocate point as if it were a marker. */
+ if (bi_from < BI_BUF_PT (buf))
+ {
+ if (BI_BUF_PT (buf) < bi_to)
+ JUST_SET_POINT (buf, from, bi_from);
+ else
+ JUST_SET_POINT (buf, BUF_PT (buf) - numdel,
+ BI_BUF_PT (buf) - bc_numdel);
+ }
+
+ SET_BUF_GAP_SIZE (buf, BUF_GAP_SIZE (buf) + bc_numdel);
+ SET_BOTH_BUF_ZV (buf, BUF_ZV (buf) - numdel, BI_BUF_ZV (buf) - bc_numdel);
+ SET_BOTH_BUF_Z (buf, BUF_Z (buf) - numdel, BI_BUF_Z (buf) - bc_numdel);
+ SET_BI_BUF_GPT (buf, bi_from);
+ SET_GAP_SENTINEL (buf);
+ }
+
+#ifdef MULE
+ buffer_mule_signal_deleted_region (buf, from, to, bi_from, bi_to);
+#endif
+
+#ifdef ERROR_CHECK_EXTENTS
+ sledgehammer_extent_check (bufobj);
+#endif
+
+ signal_after_change (buf, from, to, from);
+}
+
+\f
+/************************************************************************/
+/* Replacement of characters */
+/************************************************************************/
+
+/* Replace the character at POS in buffer B with CH. */
+
+void
+buffer_replace_char (struct buffer *b, Bufpos pos, Emchar ch,
+ int not_real_change, int force_lock_check)
+{
+ /* This function can GC */
+ Bufbyte curstr[MAX_EMCHAR_LEN];
+ Bufbyte newstr[MAX_EMCHAR_LEN];
+ Bytecount curlen, newlen;
+
+ /* Defensive steps just in case a buffer gets deleted and a calling
+ function doesn't notice it. */
+ if (!BUFFER_LIVE_P (b))
+ return;
+
+ curlen = BUF_CHARPTR_COPY_CHAR (b, pos, curstr);
+ newlen = set_charptr_emchar (newstr, ch);
+
+ if (curlen == newlen)
+ {
+ /* then we can just replace the text. */
+ prepare_to_modify_buffer (b, pos, pos + 1,
+ !not_real_change || force_lock_check);
+ /* Defensive steps in case the before-change-functions fuck around */
+ if (!BUFFER_LIVE_P (b))
+ /* Bad bad pre-change function. */
+ return;
+
+ /* Make args be valid again. prepare_to_modify_buffer() might have
+ modified the buffer. */
+ if (pos < BUF_BEGV (b))
+ pos = BUF_BEGV (b);
+ if (pos >= BUF_ZV (b))
+ pos = BUF_ZV (b) - 1;
+ if (pos < BUF_BEGV (b))
+ /* no more characters in buffer! */
+ return;
+
+ if (BUF_FETCH_CHAR (b, pos) == '\n')
+ b->changes->newline_was_deleted = 1;
+ MARK_BUFFERS_CHANGED;
+ if (!not_real_change)
+ {
+ record_change (b, pos, 1);
+ BUF_MODIFF (b)++;
+ }
+ memcpy (BUF_BYTE_ADDRESS (b, pos), newstr, newlen);
+ signal_after_change (b, pos, pos + 1, pos + 1);
+
+ /* We do not have to adjust the Mule data; we just replaced a
+ character with another of the same number of bytes. */
+ }
+ else
+ {
+ /*
+ * Must implement as deletion followed by insertion.
+ *
+ * Make a note to move point forward later in the one situation
+ * where it is needed, a delete/insert one position behind
+ * point. Point will drift backward by one position and stay
+ * there otherwise.
+ */
+ int movepoint = (pos == BUF_PT (b) - 1);
+
+ buffer_delete_range (b, pos, pos + 1, 0);
+ /* Defensive steps in case the before-change-functions fuck around */
+ if (!BUFFER_LIVE_P (b))
+ /* Bad bad pre-change function. */
+ return;
+
+ /* Make args be valid again. prepare_to_modify_buffer() might have
+ modified the buffer. */
+ if (pos < BUF_BEGV (b))
+ pos = BUF_BEGV (b);
+ if (pos >= BUF_ZV (b))
+ pos = BUF_ZV (b) - 1;
+ if (pos < BUF_BEGV (b))
+ /* no more characters in buffer! */
+ return;
+ /*
+ * -1 as the pos argument means to move point forward with the
+ * insertion, which we must do if the deletion moved point
+ * backward so that it now equals the insertion point.
+ */
+ buffer_insert_string_1 (b, (movepoint ? -1 : pos),
+ newstr, Qnil, 0, newlen, 0);
+ }
+}
+
+\f
+/************************************************************************/
+/* Other functions */
+/************************************************************************/
+
+/* Make a string from a buffer. This needs to take into account the gap,
+ and add any necessary extents from the buffer. */
+
+Lisp_Object
+make_string_from_buffer (struct buffer *buf, Bufpos pos, Charcount length)
+{
+ /* This function can GC */
+ Lisp_Object val;
+ struct gcpro gcpro1;
+ Bytind bi_ind;
+ Bytecount bi_len;
+
+ bi_ind = bufpos_to_bytind (buf, pos);
+ bi_len = bufpos_to_bytind (buf, pos + length) - bi_ind;
+
+ val = make_uninit_string (bi_len);
+ GCPRO1 (val);
+
+ add_string_extents (val, buf, bi_ind, bi_len);
+
+ {
+ Bytecount len1 = BI_BUF_GPT (buf) - bi_ind;
+ Bufbyte *start1 = BI_BUF_BYTE_ADDRESS (buf, bi_ind);
+ Bufbyte *dest = XSTRING_DATA (val);
+
+ if (len1 < 0)
+ {
+ /* Completely after gap */
+ memcpy (dest, start1, bi_len);
+ }
+ else if (bi_len <= len1)
+ {
+ /* Completely before gap */
+ memcpy (dest, start1, bi_len);
+ }
+ else
+ {
+ /* Spans gap */
+ Bytind pos2 = bi_ind + len1;
+ Bufbyte *start2 = BI_BUF_BYTE_ADDRESS (buf, pos2);
+
+ memcpy (dest, start1, len1);
+ memcpy (dest + len1, start2, bi_len - len1);
+ }
+ }
+
+ UNGCPRO;
+ return val;
+}
+
+void
+barf_if_buffer_read_only (struct buffer *buf, Bufpos from, Bufpos to)
+{
+ Lisp_Object buffer;
+ Lisp_Object iro;
+
+ XSETBUFFER (buffer, buf);
+ back:
+ iro = (buf == current_buffer ? Vinhibit_read_only :
+ symbol_value_in_buffer (Qinhibit_read_only, buffer));
+ if (!LISTP (iro))
+ return;
+ if (NILP (iro) && !NILP (buf->read_only))
+ {
+ Fsignal (Qbuffer_read_only, (list1 (buffer)));
+ goto back;
+ }
+ if (from > 0)
+ {
+ if (to < 0)
+ to = from;
+ verify_extent_modification (buffer,
+ bufpos_to_bytind (buf, from),
+ bufpos_to_bytind (buf, to),
+ iro);
+ }
+}
+
+void
+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;
+ memset (charsets, 0, NUM_LEADING_BYTES);
+
+ while (str < strend)
+ {
+ charsets[CHAR_LEADING_BYTE (charptr_emchar (str)) - 128] = 1;
+ INC_CHARPTR (str);
+ }
+#endif
+}
+
+void
+find_charsets_in_emchar_string (unsigned char *charsets, CONST Emchar *str,
+ Charcount len)
+{
+#ifndef MULE
+ /* Telescope this. */
+ charsets[0] = 1;
+#else
+ int i;
+
+ memset (charsets, 0, NUM_LEADING_BYTES);
+ for (i = 0; i < len; i++)
+ {
+ charsets[CHAR_LEADING_BYTE (str[i]) - 128] = 1;
+ }
+#endif
+}
+
+int
+bufbyte_string_displayed_columns (CONST Bufbyte *str, Bytecount len)
+{
+ int cols = 0;
+ CONST Bufbyte *end = str + len;
+
+ while (str < end)
+ {
+#ifdef MULE
+ Emchar ch = charptr_emchar (str);
+ cols += XCHARSET_COLUMNS (CHAR_CHARSET (ch));
+#else
+ cols++;
+#endif
+ INC_CHARPTR (str);
+ }
+
+ return cols;
+}
+
+int
+emchar_string_displayed_columns (CONST Emchar *str, Charcount len)
+{
+#ifdef MULE
+ int cols = 0;
+ int i;
+
+ for (i = 0; i < len; i++)
+ cols += XCHARSET_COLUMNS (CHAR_CHARSET (str[i]));
+
+ return cols;
+#else /* not MULE */
+ return len;
+#endif
+}
+
+/* NOTE: Does not reset the Dynarr. */
+
+void
+convert_bufbyte_string_into_emchar_dynarr (CONST Bufbyte *str, Bytecount len,
+ Emchar_dynarr *dyn)
+{
+ CONST Bufbyte *strend = str + len;
+
+ while (str < strend)
+ {
+ Emchar ch = charptr_emchar (str);
+ Dynarr_add (dyn, ch);
+ INC_CHARPTR (str);
+ }
+}
+
+int
+convert_bufbyte_string_into_emchar_string (CONST Bufbyte *str, Bytecount len,
+ Emchar *arr)
+{
+ CONST Bufbyte *strend = str + len;
+ Charcount newlen = 0;
+ while (str < strend)
+ {
+ Emchar ch = charptr_emchar (str);
+ arr[newlen++] = ch;
+ INC_CHARPTR (str);
+ }
+ return newlen;
+}
+
+/* Convert an array of Emchars into the equivalent string representation.
+ Store into the given Bufbyte dynarr. Does not reset the dynarr.
+ Does not add a terminating zero. */
+
+void
+convert_emchar_string_into_bufbyte_dynarr (Emchar *arr, int nels,
+ Bufbyte_dynarr *dyn)
+{
+ Bufbyte str[MAX_EMCHAR_LEN];
+ int i;
+
+ for (i = 0; i < nels; i++)
+ {
+ Bytecount len = set_charptr_emchar (str, arr[i]);
+ Dynarr_add_many (dyn, str, len);
+ }
+}
+
+/* Convert an array of Emchars into the equivalent string representation.
+ Malloc the space needed for this and return it. If LEN_OUT is not a
+ NULL pointer, store into LEN_OUT the number of Bufbytes in the
+ malloc()ed string. Note that the actual number of Bufbytes allocated
+ is one more than this: the returned string is zero-terminated. */
+
+Bufbyte *
+convert_emchar_string_into_malloced_string (Emchar *arr, int nels,
+ Bytecount *len_out)
+{
+ /* Damn zero-termination. */
+ Bufbyte *str = (Bufbyte *) alloca (nels * MAX_EMCHAR_LEN + 1);
+ Bufbyte *strorig = str;
+ Bytecount len;
+
+ int i;
+
+ for (i = 0; i < nels; i++)
+ str += set_charptr_emchar (str, arr[i]);
+ *str = '\0';
+ len = str - strorig;
+ str = (Bufbyte *) xmalloc (1 + len);
+ memcpy (str, strorig, 1 + len);
+ if (len_out)
+ *len_out = len;
+ return str;
+}
+
+\f
+/************************************************************************/
+/* initialization */
+/************************************************************************/
+
+void
+vars_of_insdel (void)
+{
+ int i;
+
+ inside_change_hook = 0;
+ in_first_change = 0;
+
+ for (i = 0; i <= MAX_BYTIND_GAP_SIZE_3; i++)
+ three_to_one_table[i] = i / 3;
+}
+
+void
+init_buffer_text (struct buffer *b, int indirect_p)
+{
+ if (!indirect_p)
+ {
+ SET_BUF_GAP_SIZE (b, 20);
+ BUFFER_ALLOC (b->text->beg, BUF_GAP_SIZE (b) + BUF_END_SENTINEL_SIZE);
+ if (! BUF_BEG_ADDR (b))
+ memory_full ();
+
+ SET_BUF_END_GAP_SIZE (b, 0);
+ SET_BI_BUF_GPT (b, 1);
+ SET_BOTH_BUF_Z (b, 1, 1);
+ SET_GAP_SENTINEL (b);
+ SET_END_SENTINEL (b);
+#ifdef MULE
+ {
+ int i;
+
+ b->text->mule_bufmin = b->text->mule_bufmax = 1;
+ b->text->mule_bytmin = b->text->mule_bytmax = 1;
+ b->text->mule_shifter = 0;
+ b->text->mule_three_p = 0;
+
+ for (i = 0; i < 16; i++)
+ {
+ b->text->mule_bufpos_cache[i] = 1;
+ b->text->mule_bytind_cache[i] = 1;
+ }
+ }
+#endif /* MULE */
+
+ BUF_MODIFF (b) = 1;
+ BUF_SAVE_MODIFF (b) = 1;
+
+ JUST_SET_POINT (b, 1, 1);
+ SET_BOTH_BUF_BEGV (b, 1, 1);
+ SET_BOTH_BUF_ZV (b, 1, 1);
+
+ b->text->changes = xnew_and_zero (struct buffer_text_change_data);
+ }
+ else
+ {
+ JUST_SET_POINT (b, BUF_PT (b->base_buffer), BI_BUF_PT (b->base_buffer));
+ SET_BOTH_BUF_BEGV (b, BUF_BEGV (b->base_buffer),
+ BI_BUF_BEGV (b->base_buffer));
+ SET_BOTH_BUF_ZV (b, BUF_ZV (b->base_buffer),
+ BI_BUF_ZV (b->base_buffer));
+ }
+
+ b->changes = xnew_and_zero (struct each_buffer_change_data);
+ BUF_FACECHANGE (b) = 1;
+
+#ifdef REGION_CACHE_NEEDS_WORK
+ b->newline_cache = 0;
+ b->width_run_cache = 0;
+ b->width_table = Qnil;
+#endif
+}
+
+void
+uninit_buffer_text (struct buffer *b, int indirect_p)
+{
+ if (!indirect_p)
+ {
+ BUFFER_FREE (b->text->beg);
+ xfree (b->text->changes);
+ }
+ xfree (b->changes);
+
+#ifdef REGION_CACHE_NEEDS_WORK
+ if (b->newline_cache)
+ {
+ free_region_cache (b->newline_cache);
+ b->newline_cache = 0;
+ }
+ if (b->width_run_cache)
+ {
+ free_region_cache (b->width_run_cache);
+ b->width_run_cache = 0;
+ }
+ b->width_table = Qnil;
+#endif
+}
--- /dev/null
+/* Fundamental definitions for XEmacs Lisp interpreter -- non-union objects.
+ Copyright (C) 1985, 1986, 1987, 1992, 1993 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: FSF 19.30. Split out from lisp.h. */
+/* This file has diverged greatly from FSF Emacs. Syncing is no
+ longer desirable or possible */
+
+/*
+ Format of a non-union-type Lisp Object
+
+ For the USE_MINIMAL_TAGBITS implementation:
+
+ 3 2 1 0
+ bit 10987654321098765432109876543210
+ --------------------------------
+ VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVTT
+
+ Integers are treated specially, and look like this:
+
+ 3 2 1 0
+ bit 10987654321098765432109876543210
+ --------------------------------
+ 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
+ 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
+ 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.
+ 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
+ XREALINT The value bits of a Lisp_Object storing an integer, signed
+ 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
+*/
+
+typedef EMACS_INT Lisp_Object;
+
+#ifdef USE_MINIMAL_TAGBITS
+
+# define XUNMARK(x) DO_NOTHING
+# define make_obj(vartype, x) ((Lisp_Object) (x))
+# define make_int(x) ((Lisp_Object) (((x) << INT_GCBITS) + 1))
+# 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) & 1)
+# define Qzero ((Lisp_Object) 1UL)
+
+#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)
+# define Qzero ((Lisp_Object) Lisp_Type_Int)
+
+#endif /* !USE_MINIMAL_TAGBITS */
+
+#define Qnull_pointer 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)))
+#define XSETOBJ(var, vartype, value) ((void) ((var) = make_obj (vartype, value)))
+
+/* 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) = ((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))
+
+/* Convert a Lisp_Object into something that can't be used as an
+ lvalue. Useful for type-checking. */
+#define NON_LVALUE(larg) ((larg) + 0)
--- /dev/null
+/* Fundamental definitions for XEmacs Lisp interpreter.
+ Copyright (C) 1985-1987, 1992-1995 Free Software Foundation, Inc.
+ Copyright (C) 1993-1996 Richard Mlynarik.
+ 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: FSF 19.30. */
+
+#ifndef _XEMACS_LISP_H_
+#define _XEMACS_LISP_H_
+
+/************************************************************************/
+/* general definitions */
+/************************************************************************/
+
+/* We include the following generally useful header files so that you
+ don't have to worry about prototypes when using the standard C
+ library functions and macros. These files shouldn't be excessively
+ large so they shouldn't cause that much of a slowdown. */
+
+#include <stdlib.h>
+#include <string.h> /* primarily for memcpy, etc. */
+#include <stdio.h> /* NULL, etc. */
+#include <ctype.h>
+#include <stdarg.h>
+
+#ifdef __lucid
+# include <sysent.h>
+#endif
+
+/* ---- Dynamic arrays ---- */
+
+#define Dynarr_declare(type) \
+ type *base; \
+ int elsize; \
+ int cur; \
+ int largest; \
+ int max
+
+typedef struct dynarr
+{
+ Dynarr_declare (void);
+} Dynarr;
+
+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_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_at(d, pos) ((d)->base[pos])
+#define Dynarr_atp(d, pos) (&Dynarr_at (d, pos))
+#define Dynarr_length(d) ((d)->cur)
+#define Dynarr_largest(d) ((d)->largest)
+#define Dynarr_reset(d) ((d)->cur = 0)
+#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_lisp_string(d, s) do { \
+ struct Lisp_String *dyna_ls_s = XSTRING (s); \
+ Dynarr_add_many (d, (char *) string_data (dyna_ls_s), \
+ string_length (dyna_ls_s)); \
+} while (0)
+
+#define Dynarr_add(d, el) ( \
+ (d)->cur >= (d)->max ? Dynarr_resize ((d), (d)->cur+1) : (void) 0, \
+ ((d)->base)[(d)->cur++] = (el), \
+ (d)->cur > (d)->largest ? (d)->largest = (d)->cur : (int) 0)
+
+/* The following defines will get you into real trouble if you aren't
+ careful. But they can save a lot of execution time when used wisely. */
+#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);
+#endif
+
+#include "symsinit.h" /* compiler warning suppression */
+
+/* Also define min() and max(). (Some compilers put them in strange
+ places that won't be referenced by the above include files, such
+ as 'macros.h' under Solaris.) */
+
+#ifndef min
+#define min(a,b) (((a) <= (b)) ? (a) : (b))
+#endif
+#ifndef max
+#define max(a,b) (((a) > (b)) ? (a) : (b))
+#endif
+
+/* Memory allocation */
+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 *);
+/* 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 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 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)))
+
+/* also generally useful if you want to avoid arbitrary size limits
+ but don't need a full dynamic array. Assumes that BASEVAR points
+ to a malloced array of TYPE objects (or possibly a NULL pointer,
+ if SIZEVAR is 0), with the total size stored in SIZEVAR. This
+ 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! */ \
+ 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); \
+} while (0)
+
+#ifdef ERROR_CHECK_MALLOC
+void xfree_1 (void *);
+#define xfree(lvalue) do \
+{ \
+ void **xfree_ptr = (void **) &(lvalue); \
+ xfree_1 (*xfree_ptr); \
+ *xfree_ptr = (void *) 0xDEADBEEF; \
+} while (0)
+#else
+void xfree (void *);
+#define xfree_1 xfree
+#endif /* ERROR_CHECK_MALLOC */
+
+#ifndef PRINTF_ARGS
+# if defined (__GNUC__) && (__GNUC__ >= 2)
+# define PRINTF_ARGS(string_index,first_to_check) \
+ __attribute__ ((format (printf, string_index, first_to_check)))
+# else
+# define PRINTF_ARGS(string_index,first_to_check)
+# endif /* GNUC */
+#endif
+
+#ifndef DOESNT_RETURN
+# if defined __GNUC__
+# if ((__GNUC__ > 2) || (__GNUC__ == 2) && (__GNUC_MINOR__ >= 5))
+# define DOESNT_RETURN void volatile
+# define DECLARE_DOESNT_RETURN(decl) \
+ extern void volatile decl __attribute__ ((noreturn))
+# define DECLARE_DOESNT_RETURN_GCC__ATTRIBUTE__SYNTAX_SUCKS(decl,str,idx) \
+ /* Should be able to state multiple independent __attribute__s, but \
+ the losing syntax doesn't work that way, and screws losing cpp */ \
+ extern void volatile decl \
+ __attribute__ ((noreturn, format (printf, str, idx)))
+# else
+# define DOESNT_RETURN void volatile
+# define DECLARE_DOESNT_RETURN(decl) extern void volatile decl
+# define DECLARE_DOESNT_RETURN_GCC__ATTRIBUTE__SYNTAX_SUCKS(decl,str,idx) \
+ extern void volatile decl PRINTF_ARGS(str,idx)
+# endif /* GNUC 2.5 */
+# else
+# define DOESNT_RETURN void
+# define DECLARE_DOESNT_RETURN(decl) extern void decl
+# define DECLARE_DOESNT_RETURN_GCC__ATTRIBUTE__SYNTAX_SUCKS(decl,str,idx) \
+ extern void decl PRINTF_ARGS(str,idx)
+# endif /* GNUC */
+#endif
+
+#ifndef ALIGNOF
+# if defined (__GNUC__) && (__GNUC__ >= 2)
+# define ALIGNOF(x) __alignof (x)
+# else
+# define ALIGNOF(x) sizeof (x)
+# endif
+#endif
+
+#define ALIGN_SIZE(len, unit) \
+ ((((len) + (unit) - 1) / (unit)) * (unit))
+
+/* #### Yuck, this is kind of evil */
+#define ALIGN_PTR(ptr, unit) \
+ ((void *) ALIGN_SIZE ((long) (ptr), unit))
+
+#ifdef QUANTIFY
+#include "quantify.h"
+#define QUANTIFY_START_RECORDING quantify_start_recording_data ()
+#define QUANTIFY_STOP_RECORDING quantify_stop_recording_data ()
+#else /* !QUANTIFY */
+#define QUANTIFY_START_RECORDING
+#define QUANTIFY_STOP_RECORDING
+#endif /* !QUANTIFY */
+
+#ifndef DO_NOTHING
+#define DO_NOTHING do {} while (0)
+#endif
+
+#ifndef DECLARE_NOTHING
+#define DECLARE_NOTHING struct nosuchstruct
+#endif
+
+/* We define assert iff USE_ASSERTIONS or DEBUG_XEMACS is defined.
+ Otherwise we define it to be empty. Quantify has shown that the
+ time the assert checks take is measurable so let's not include them
+ in production binaries. */
+
+#ifdef USE_ASSERTIONS
+/* Highly dubious kludge */
+/* (thanks, Jamie, I feel better now -- ben) */
+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
+# ifdef DEBUG_XEMACS
+# define assert(x) ((x) ? (void) 0 : (void) abort ())
+# else
+# define assert(x)
+# endif
+#endif
+
+/*#ifdef DEBUG_XEMACS*/
+#define REGISTER
+#define register
+/*#else*/
+/*#define REGISTER register*/
+/*#endif*/
+
+\f
+/************************************************************************/
+/* typedefs */
+/************************************************************************/
+
+/* We put typedefs here so that prototype declarations don't choke.
+ Note that we don't actually declare the structures here (except
+ maybe for simple structures like Dynarrs); that keeps them private
+ to the routines that actually use them. */
+
+/* The data representing the text in a buffer is logically a set
+ of Bufbytes, declared as follows. */
+
+typedef unsigned char Bufbyte;
+
+/* The data representing a string in "external" format (simple
+ binary format) is logically a set of Extbytes, declared as follows. */
+
+typedef unsigned char Extbyte;
+
+/* To the user, a buffer is made up of characters, declared as follows.
+ In the non-Mule world, characters and Bufbytes are equivalent.
+ In the Mule world, a character requires (typically) 1 to 4
+ Bufbytes for its representation in a buffer. */
+
+typedef int Emchar;
+
+/* Different ways of referring to a position in a buffer. We use
+ the typedefs in preference to 'int' to make it clearer what
+ sort of position is being used. See extents.c for a description
+ of the different positions. We put them here instead of in
+ buffer.h (where they rightfully belong) to avoid syntax errors
+ in function prototypes. */
+
+typedef int Bufpos;
+typedef int Bytind;
+typedef int Memind;
+
+/* Counts of bytes or chars */
+
+typedef int Bytecount;
+typedef int Charcount;
+
+/* Length in bytes of a string in external format */
+typedef int Extcount;
+
+typedef struct lstream Lstream;
+
+typedef unsigned int face_index;
+
+typedef struct
+{
+ Dynarr_declare (struct face_cachel);
+} face_cachel_dynarr;
+
+typedef unsigned int glyph_index;
+
+/* This is shared by process.h, events.h and others in future.
+ See events.h for description */
+typedef unsigned int USID;
+
+typedef struct
+{
+ Dynarr_declare (struct glyph_cachel);
+} glyph_cachel_dynarr;
+
+struct buffer; /* "buffer.h" */
+struct console; /* "console.h" */
+struct device; /* "device.h" */
+struct extent_fragment;
+struct extent;
+typedef struct extent *EXTENT;
+struct frame; /* "frame.h" */
+struct window; /* "window.h" */
+struct Lisp_Event; /* "events.h" */
+struct Lisp_Face;
+struct Lisp_Process; /* "process.c" */
+struct stat; /* <sys/stat.h> */
+struct Lisp_Color_Instance;
+struct Lisp_Font_Instance;
+struct Lisp_Image_Instance;
+struct display_line;
+struct redisplay_info;
+struct window_mirror;
+struct scrollbar_instance;
+struct font_metric_info;
+struct face_cachel;
+struct console_type_entry;
+
+typedef struct
+{
+ Dynarr_declare (Bufbyte);
+} Bufbyte_dynarr;
+
+typedef struct
+{
+ Dynarr_declare (Extbyte);
+} Extbyte_dynarr;
+
+typedef struct
+{
+ Dynarr_declare (Emchar);
+} Emchar_dynarr;
+
+typedef struct
+{
+ Dynarr_declare (char);
+} char_dynarr;
+
+typedef unsigned char unsigned_char;
+typedef struct
+{
+ Dynarr_declare (unsigned char);
+} unsigned_char_dynarr;
+
+typedef unsigned long unsigned_long;
+typedef struct
+{
+ Dynarr_declare (unsigned long);
+} unsigned_long_dynarr;
+
+typedef struct
+{
+ Dynarr_declare (int);
+} int_dynarr;
+
+typedef struct
+{
+ Dynarr_declare (Bufpos);
+} Bufpos_dynarr;
+
+typedef struct
+{
+ Dynarr_declare (Bytind);
+} Bytind_dynarr;
+
+typedef struct
+{
+ Dynarr_declare (Charcount);
+} Charcount_dynarr;
+
+typedef struct
+{
+ Dynarr_declare (Bytecount);
+} Bytecount_dynarr;
+
+typedef struct
+{
+ 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,
+ RUN_HOOKS_UNTIL_SUCCESS,
+ RUN_HOOKS_UNTIL_FAILURE
+};
+
+#ifdef HAVE_TOOLBARS
+enum toolbar_pos
+{
+ TOP_TOOLBAR,
+ BOTTOM_TOOLBAR,
+ LEFT_TOOLBAR,
+ RIGHT_TOOLBAR
+};
+#endif
+
+#ifndef ERROR_CHECK_TYPECHECK
+
+typedef enum error_behavior
+{
+ ERROR_ME,
+ ERROR_ME_NOT,
+ ERROR_ME_WARN
+} Error_behavior;
+
+#define ERRB_EQ(a, b) ((a) == (b))
+
+#else
+
+/* By defining it like this, we provide strict type-checking
+ for code that lazily uses ints. */
+
+typedef struct _error_behavior_struct_
+{
+ int really_unlikely_name_to_have_accidentally_in_a_non_errb_structure;
+} Error_behavior;
+
+extern Error_behavior ERROR_ME;
+extern Error_behavior ERROR_ME_NOT;
+extern Error_behavior ERROR_ME_WARN;
+
+#define ERRB_EQ(a, b) \
+ ((a).really_unlikely_name_to_have_accidentally_in_a_non_errb_structure == \
+ (b).really_unlikely_name_to_have_accidentally_in_a_non_errb_structure)
+
+#endif
+
+enum munge_me_out_the_door
+{
+ MUNGE_ME_FUNCTION_KEY,
+ MUNGE_ME_KEY_TRANSLATION
+};
+
+\f
+/************************************************************************/
+/* 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
+{
+ /* Integer. XINT(obj) is the integer value. */
+ Lisp_Type_Int,
+
+ /* XRECORD_LHEADER (object) points to a struct lrecord_header
+ lheader->implementation determines the type (and GC behaviour)
+ of the object. */
+ Lisp_Type_Record,
+
+#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,
+ Lisp_Type_Int_Even,
+ Lisp_Type_Char,
+ Lisp_Type_Int_Odd
+};
+
+#define POINTER_TYPE_P(type) ((type) == Lisp_Type_Record)
+
+#endif /* USE_MINIMAL_TAGBITS */
+
+/* This should be the underlying type into which a Lisp_Object must fit.
+ In a strict ANSI world, this must be `int', since ANSI says you can't
+ use bitfields on any type other than `int'. However, on a machine
+ where `int' and `long' are not the same size, this should be the
+ longer of the two. (This also must be something into which a pointer
+ to an arbitrary object will fit, modulo any DATA_SEG_BITS cruft.)
+ */
+/* ### We should be using uintptr_t and SIZEOF_VOID_P here */
+#if (LONGBITS > INTBITS)
+# define EMACS_INT long
+# define EMACS_UINT unsigned long
+# define SIZEOF_EMACS_INT SIZEOF_LONG
+#else
+# define EMACS_INT int
+# define EMACS_UINT unsigned int
+# define SIZEOF_EMACS_INT SIZEOF_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 INT_VALBITS (BITS_PER_EMACS_INT - INT_GCBITS)
+#define VALBITS (BITS_PER_EMACS_INT - GCBITS)
+#define EMACS_INT_MAX ((1UL << INT_VALBITS) -1UL)
+
+#ifdef USE_UNION_TYPE
+# include "lisp-union.h"
+#else /* !USE_UNION_TYPE */
+# 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 */
+
+
+/* WARNING WARNING WARNING. You must ensure on your own that proper
+ GC protection is provided for the elements in this array. */
+typedef struct
+{
+ Dynarr_declare (Lisp_Object);
+} Lisp_Object_dynarr;
+
+/* 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)) \
+ && XCHAR_OR_INT (obj1) == XCHAR_OR_INT (obj2)))
+
+#ifdef DEBUG_XEMACS
+extern int debug_issue_ebola_notices;
+int eq_with_ebola_notice (Lisp_Object, Lisp_Object);
+#define EQ_WITH_EBOLA_NOTICE(obj1, obj2) \
+ (debug_issue_ebola_notices ? eq_with_ebola_notice (obj1, obj2) \
+ : EQ (obj1, obj2))
+#else
+#define EQ_WITH_EBOLA_NOTICE(obj1, obj2) EQ (obj1, obj2)
+#endif
+
+/* OK, you can open them again */
+
+\f
+/************************************************************************/
+/* Definitions of basic Lisp objects */
+/************************************************************************/
+
+#include "lrecord.h"
+
+/********** unbound ***********/
+
+/* Qunbound is a special Lisp_Object (actually of type
+ symbol-value-forward), that can never be visible to
+ the Lisp caller and thus can be used in the C code
+ to mean "no such value". */
+
+#define UNBOUNDP(val) EQ (val, Qunbound)
+#define GC_UNBOUNDP(val) GC_EQ (val, Qunbound)
+
+/*********** cons ***********/
+
+/* In a cons, the markbit of the car is the gc mark bit */
+
+struct Lisp_Cons
+{
+#ifdef LRECORD_CONS
+ struct lrecord_header lheader;
+#endif
+ Lisp_Object car, cdr;
+};
+
+#if 0 /* FSFmacs */
+/* Like a cons, but records info on where the text lives that it was read from */
+/* This is not really in use now */
+
+struct Lisp_Buffer_Cons
+{
+ Lisp_Object car, cdr;
+ struct buffer *buffer;
+ int bufpos;
+};
+#endif
+
+#ifdef LRECORD_CONS
+
+DECLARE_LRECORD (cons, struct Lisp_Cons);
+#define XCONS(x) XRECORD (x, cons, struct 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, struct Lisp_Cons);
+#define XCONS(a) XNONRECORD (a, cons, Lisp_Type_Cons, struct 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 */
+
+#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))
+
+#define CHECK_LIST(x) do { \
+ if (!LISTP (x)) \
+ dead_wrong_type_argument (Qlistp, x); \
+} while (0)
+
+#define CONCHECK_LIST(x) do { \
+ if (!LISTP (x)) \
+ x = wrong_type_argument (Qlistp, x); \
+} while (0)
+
+/* For a list that's known to be in valid list format --
+ will abort() if the list is not in valid format */
+#define LIST_LOOP(consvar, list) \
+ for (consvar = list; !NILP (consvar); consvar = XCDR (consvar))
+
+/* For a list that's known to be in valid list format, where we may
+ be deleting the current element out of the list --
+ will abort() if the list is not in valid format */
+#define LIST_LOOP_DELETING(consvar, nextconsvar, list) \
+ for (consvar = list; \
+ !NILP (consvar) ? (nextconsvar = XCDR (consvar), 1) : 0; \
+ consvar = nextconsvar)
+
+/* For a list that may not be in valid list format --
+ will signal an error if the list is not in valid format */
+#define EXTERNAL_LIST_LOOP(consvar, listp) \
+ for (consvar = listp; !NILP (consvar); consvar = XCDR (consvar)) \
+ if (!CONSP (consvar)) \
+ signal_simple_error ("Invalid list format", listp); \
+ else
+
+extern Lisp_Object Qnil;
+
+INLINE int TRUE_LIST_P (Lisp_Object object);
+INLINE int
+TRUE_LIST_P (Lisp_Object object)
+{
+ while (CONSP (object))
+ object = XCDR (object);
+ return NILP (object);
+}
+
+#define CHECK_TRUE_LIST(object) do { \
+ if (!TRUE_LIST_P (object)) \
+ dead_wrong_type_argument (Qtrue_list_p, object); \
+} while (0)
+
+/* For a property list (alternating keywords/values) that may not be
+ in valid list format -- will signal an error if the list is not in
+ valid format. CONSVAR is used to keep track of the iterations
+ without modifying LISTP.
+
+ We have to be tricky to still keep the same C format.*/
+#define EXTERNAL_PROPERTY_LIST_LOOP(consvar, keyword, value, listp) \
+ for (consvar = listp; \
+ (CONSP (consvar) && CONSP (XCDR (consvar)) ? \
+ (keyword = XCAR (consvar), value = XCAR (XCDR (consvar))) : \
+ (keyword = Qunbound, value = Qunbound)), \
+ !NILP (consvar); \
+ consvar = XCDR (XCDR (consvar))) \
+ if (UNBOUNDP (keyword)) \
+ signal_simple_error ("Invalid property list format", listp); \
+ else
+
+/*********** string ***********/
+
+/* In a string or vector, the sign bit of the `size' is the gc mark bit */
+
+/* (The size and data fields have underscores prepended to catch old
+ code that attempts to reference the fields directly) */
+struct Lisp_String
+{
+#ifdef LRECORD_STRING
+ struct lrecord_header lheader;
+#endif
+ Bytecount _size;
+ Bufbyte *_data;
+ Lisp_Object plist;
+};
+
+#ifdef LRECORD_STRING
+
+DECLARE_LRECORD (string, struct Lisp_String);
+#define XSTRING(x) XRECORD (x, string, struct 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, struct Lisp_String);
+#define XSTRING(x) XNONRECORD (x, string, Lisp_Type_String, struct 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);
+
+#else /* not MULE */
+
+# define bytecount_to_charcount(ptr, len) (len)
+# define charcount_to_bytecount(ptr, len) (len)
+
+#endif /* not MULE */
+
+#define string_length(s) ((s)->_size)
+#define XSTRING_LENGTH(s) string_length (XSTRING (s))
+#define XSTRING_CHAR_LENGTH(s) string_char_length (XSTRING (s))
+#define string_data(s) ((s)->_data + 0)
+#define XSTRING_DATA(s) string_data (XSTRING (s))
+#define string_byte(s, i) ((s)->_data[i] + 0)
+#define XSTRING_BYTE(s, i) string_byte (XSTRING (s), i)
+#define string_byte_addr(s, i) (&((s)->_data[i]))
+#define set_string_length(s, len) ((void) ((s)->_size = (len)))
+#define set_string_data(s, ptr) ((void) ((s)->_data = (ptr)))
+#define set_string_byte(s, i, c) ((void) ((s)->_data[i] = (c)))
+
+void resize_string (struct Lisp_String *s, Bytecount pos, Bytecount delta);
+
+#ifdef MULE
+
+INLINE Charcount string_char_length (struct Lisp_String *s);
+INLINE Charcount
+string_char_length (struct Lisp_String *s)
+{
+ return bytecount_to_charcount (string_data (s), string_length (s));
+}
+
+# define string_char(s, i) charptr_emchar_n (string_data (s), i)
+# define string_char_addr(s, i) charptr_n_addr (string_data (s), i)
+void set_string_char (struct Lisp_String *s, Charcount i, Emchar c);
+
+#else /* not MULE */
+
+# define string_char_length(s) string_length (s)
+# define string_char(s, i) ((Emchar) string_byte (s, i))
+# define string_char_addr(s, i) string_byte_addr (s, i)
+# define set_string_char(s, i, c) set_string_byte (s, i, c)
+
+#endif /* not MULE */
+
+/*********** vector ***********/
+
+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" */
+ /* struct Lisp_Vector *next; */
+ Lisp_Object contents[1];
+};
+
+#ifdef LRECORD_VECTOR
+
+DECLARE_LRECORD (vector, struct Lisp_Vector);
+#define XVECTOR(x) XRECORD (x, vector, struct 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, struct Lisp_Vector);
+#define XVECTOR(x) XNONRECORD (x, vector, Lisp_Type_Vector, struct 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 ***********/
+
+#if (LONGBITS < 16)
+#error What the hell?!
+#elif (LONGBITS < 32)
+# define LONGBITS_LOG2 4
+# define LONGBITS_POWER_OF_2 16
+#elif (LONGBITS < 64)
+# define LONGBITS_LOG2 5
+# define LONGBITS_POWER_OF_2 32
+#elif (LONGBITS < 128)
+# define LONGBITS_LOG2 6
+# define LONGBITS_POWER_OF_2 64
+#else
+#error You really have 128-bit integers?!
+#endif
+
+struct Lisp_Bit_Vector
+{
+ struct lrecord_header lheader;
+ Lisp_Object next;
+ long size;
+ unsigned int bits[1];
+};
+
+DECLARE_LRECORD (bit_vector, struct Lisp_Bit_Vector);
+#define XBIT_VECTOR(x) XRECORD (x, bit_vector, struct 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)) \
+ dead_wrong_type_argument (Qbitp, x);\
+} while (0)
+
+#define CONCHECK_BIT(x) do { \
+ if (!BITP (x)) \
+ x = wrong_type_argument (Qbitp, x); \
+} while (0)
+
+#define bit_vector_length(v) ((v)->size)
+#define bit_vector_next(v) ((v)->next)
+
+INLINE int bit_vector_bit (struct Lisp_Bit_Vector *v, int i);
+INLINE int
+bit_vector_bit (struct Lisp_Bit_Vector *v, int i)
+{
+ unsigned int ui = (unsigned int) i;
+
+ return (((v)->bits[ui >> LONGBITS_LOG2] >> (ui & (LONGBITS_POWER_OF_2 - 1)))
+ & 1);
+}
+
+INLINE void set_bit_vector_bit (struct Lisp_Bit_Vector *v, int i, int value);
+INLINE void
+set_bit_vector_bit (struct Lisp_Bit_Vector *v, int i, int value)
+{
+ unsigned int ui = (unsigned int) i;
+ if (value)
+ (v)->bits[ui >> LONGBITS_LOG2] |= (1 << (ui & (LONGBITS_POWER_OF_2 - 1)));
+ else
+ (v)->bits[ui >> LONGBITS_LOG2] &= ~(1 << (ui & (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)
+
+
+/*********** symbol ***********/
+
+/* In a symbol, the markbit of the plist is used as the gc mark bit */
+
+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_Object value;
+ Lisp_Object function;
+ /* non-nil if the symbol is interned in Vobarray */
+ Lisp_Object obarray;
+ Lisp_Object plist;
+};
+
+#define SYMBOL_IS_KEYWORD(sym) (string_byte (XSYMBOL(sym)->name, 0) == ':')
+#define KEYWORDP(obj) (SYMBOLP (obj) && SYMBOL_IS_KEYWORD (obj))
+
+#ifdef LRECORD_SYMBOL
+
+DECLARE_LRECORD (symbol, struct Lisp_Symbol);
+#define XSYMBOL(x) XRECORD (x, symbol, struct 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, struct Lisp_Symbol);
+#define XSYMBOL(x) XNONRECORD (x, symbol, Lisp_Type_Symbol, struct 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)
+#define symbol_function(s) ((s)->function)
+#define symbol_plist(s) ((s)->plist)
+
+/*********** subr ***********/
+
+typedef Lisp_Object (*lisp_fn_t) (void);
+
+struct Lisp_Subr
+{
+ struct lrecord_header lheader;
+ short min_args, max_args;
+ CONST char *prompt;
+ CONST char *doc;
+ CONST char *name;
+ lisp_fn_t subr_fn;
+};
+
+DECLARE_LRECORD (subr, struct Lisp_Subr);
+#define XSUBR(x) XRECORD (x, subr, struct 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
+
+/*********** marker ***********/
+
+struct Lisp_Marker
+{
+ struct lrecord_header lheader;
+ struct Lisp_Marker *next, *prev;
+ struct buffer *buffer;
+ Memind memind;
+ char insertion_type;
+};
+
+DECLARE_LRECORD (marker, struct Lisp_Marker);
+#define XMARKER(x) XRECORD (x, marker, struct 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)
+
+/* The second check was looking for GCed markers still in use */
+/* if (INTP (XMARKER (x)->lheader.next.v)) abort (); */
+
+#define marker_next(m) ((m)->next)
+#define marker_prev(m) ((m)->prev)
+
+/*********** char ***********/
+
+#define CHARP(x) (XTYPE (x) == Lisp_Type_Char)
+#define GC_CHARP(x) (XGCTYPE (x) == Lisp_Type_Char)
+
+#ifdef ERROR_CHECK_TYPECHECK
+
+INLINE Emchar XCHAR (Lisp_Object obj);
+INLINE Emchar
+XCHAR (Lisp_Object obj)
+{
+ assert (CHARP (obj));
+ return XCHARVAL (obj);
+}
+
+#else
+
+#define XCHAR(x) XCHARVAL (x)
+
+#endif
+
+#define CHECK_CHAR(x) CHECK_NONRECORD (x, Lisp_Type_Char, Qcharacterp)
+#define CONCHECK_CHAR(x) CONCHECK_NONRECORD (x, Lisp_Type_Char, Qcharacterp)
+
+
+/*********** float ***********/
+
+#ifdef LISP_FLOAT_TYPE
+
+/* Note: the 'unused__next__' field exists only to ensure that the
+ `next' pointer fits within the structure, for the purposes of the
+ free list. This makes a difference in the unlikely case of
+ sizeof(double) being smaller than sizeof(void *). */
+
+struct Lisp_Float
+{
+ struct lrecord_header lheader;
+ union { double d; struct Lisp_Float *unused__next__; } data;
+};
+
+DECLARE_LRECORD (float, struct Lisp_Float);
+#define XFLOAT(x) XRECORD (x, float, struct 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)
+
+#define float_data(f) ((f)->data.d)
+
+#define XFLOATINT(n) extract_float (n)
+
+#define CHECK_INT_OR_FLOAT(x) do { \
+ if (!INT_OR_FLOATP (x)) \
+ dead_wrong_type_argument (Qnumberp, x); \
+} while (0)
+
+#define CONCHECK_INT_OR_FLOAT(x) do { \
+ if (!INT_OR_FLOATP (x)) \
+ x = wrong_type_argument (Qnumberp, x); \
+} while (0)
+
+/* These are always continuable because they change their arguments
+ even when no error is signalled. */
+
+#define CHECK_INT_OR_FLOAT_COERCE_MARKER(x) do { \
+ if (INT_OR_FLOATP (x)) \
+ ; \
+ else if (MARKERP (x)) \
+ x = make_int (marker_position (x)); \
+ else \
+ x = wrong_type_argument (Qnumber_or_marker_p, x); \
+} while (0)
+
+#define CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER(x) do { \
+ if (INT_OR_FLOATP (x)) \
+ ; \
+ else if (CHARP (x)) \
+ x = make_int (XCHAR (x)); \
+ else if (MARKERP (x)) \
+ x = make_int (marker_position (x)); \
+ else \
+ x = wrong_type_argument (Qnumber_char_or_marker_p, x); \
+} 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 CHECK_INT_OR_FLOAT_COERCE_MARKER CHECK_INT_COERCE_MARKER
+#define CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER \
+ CHECK_INT_COERCE_CHAR_OR_MARKER
+#define INT_OR_FLOATP(x) (INTP (x))
+# define GC_INT_OR_FLOATP(x) (GC_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
+
+INLINE EMACS_INT XINT (Lisp_Object obj);
+INLINE EMACS_INT
+XINT (Lisp_Object obj)
+{
+ assert (INTP (obj));
+ return XREALINT (obj);
+}
+
+INLINE EMACS_INT XCHAR_OR_INT (Lisp_Object obj);
+INLINE EMACS_INT
+XCHAR_OR_INT (Lisp_Object obj)
+{
+ assert (INTP (obj) || CHARP (obj));
+ return CHARP (obj) ? XCHAR (obj) : XINT (obj);
+}
+
+#else /* no error checking */
+
+#define XINT(obj) XREALINT (obj)
+#define XCHAR_OR_INT(obj) (CHARP (obj) ? XCHAR (obj) : XINT (obj))
+
+#endif /* no error checking */
+
+#define CHECK_INT(x) do { \
+ if (!INTP (x)) \
+ dead_wrong_type_argument (Qintegerp, x); \
+} while (0)
+
+#define CONCHECK_INT(x) do { \
+ if (!INTP (x)) \
+ x = wrong_type_argument (Qintegerp, x); \
+} 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)) \
+ dead_wrong_type_argument (Qnatnump, x); \
+} while (0)
+
+#define CONCHECK_NATNUM(x) do { \
+ if (!NATNUMP (x)) \
+ x = wrong_type_argument (Qnatnump, x); \
+} while (0)
+
+/* next three always continuable because they coerce their arguments. */
+#define CHECK_INT_COERCE_CHAR(x) do { \
+ if (INTP (x)) \
+ ; \
+ else if (CHARP (x)) \
+ x = make_int (XCHAR (x)); \
+ else \
+ x = wrong_type_argument (Qinteger_or_char_p, x); \
+} while (0)
+
+#define CHECK_INT_COERCE_MARKER(x) do { \
+ if (INTP (x)) \
+ ; \
+ else if (MARKERP (x)) \
+ x = make_int (marker_position (x)); \
+ else \
+ x = wrong_type_argument (Qinteger_or_marker_p, x); \
+} while (0)
+
+#define CHECK_INT_COERCE_CHAR_OR_MARKER(x) do { \
+ if (INTP (x)) \
+ ; \
+ else if (CHARP (x)) \
+ x = make_int (XCHAR (x)); \
+ else if (MARKERP (x)) \
+ x = make_int (marker_position (x)); \
+ else \
+ x = wrong_type_argument (Qinteger_char_or_marker_p, x); \
+} while (0)
+
+/*********** pure space ***********/
+
+#define CHECK_IMPURE(obj) \
+ do { if (purified (obj)) pure_write_error (obj); } while (0)
+
+/*********** structures ***********/
+
+typedef struct structure_keyword_entry structure_keyword_entry;
+struct structure_keyword_entry
+{
+ Lisp_Object keyword;
+ int (*validate) (Lisp_Object keyword, Lisp_Object value,
+ Error_behavior errb);
+};
+
+typedef struct
+{
+ Dynarr_declare (structure_keyword_entry);
+} structure_keyword_entry_dynarr;
+
+typedef struct structure_type structure_type;
+struct structure_type
+{
+ Lisp_Object type;
+ structure_keyword_entry_dynarr *keywords;
+ int (*validate) (Lisp_Object data, Error_behavior errb);
+ Lisp_Object (*instantiate) (Lisp_Object data);
+};
+
+typedef struct
+{
+ Dynarr_declare (structure_type);
+} structure_type_dynarr;
+
+struct structure_type *define_structure_type (Lisp_Object type,
+ int (*validate)
+ (Lisp_Object data,
+ Error_behavior errb),
+ Lisp_Object (*instantiate)
+ (Lisp_Object data));
+void define_structure_type_keyword (struct structure_type *st,
+ Lisp_Object keyword,
+ int (*validate) (Lisp_Object keyword,
+ Lisp_Object value,
+ Error_behavior errb));
+
+/*********** weak lists ***********/
+
+enum weak_list_type
+{
+ /* element disappears if it's unmarked. */
+ WEAK_LIST_SIMPLE,
+ /* element disappears if it's a cons and either its car or
+ cdr is unmarked. */
+ WEAK_LIST_ASSOC,
+ /* element disappears if it's a cons and its car is unmarked. */
+ WEAK_LIST_KEY_ASSOC,
+ /* element disappears if it's a cons and its cdr is unmarked. */
+ WEAK_LIST_VALUE_ASSOC
+};
+
+struct weak_list
+{
+ struct lcrecord_header header;
+ Lisp_Object list; /* don't mark through this! */
+ enum weak_list_type type;
+ Lisp_Object next_weak; /* don't mark through this! */
+};
+
+DECLARE_LRECORD (weak_list, struct weak_list);
+#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)
+
+#define weak_list_list(w) ((w)->list)
+#define XWEAK_LIST_LIST(w) (XWEAK_LIST (w)->list)
+
+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));
+
+/*********** lcrecord lists ***********/
+
+struct lcrecord_list
+{
+ struct lcrecord_header header;
+ Lisp_Object free;
+ size_t size;
+ 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
+ *implementation);
+Lisp_Object allocate_managed_lcrecord (Lisp_Object lcrecord_list);
+void free_managed_lcrecord (Lisp_Object lcrecord_list, Lisp_Object lcrecord);
+
+\f
+/************************************************************************/
+/* Definitions of primitive Lisp functions and variables */
+/************************************************************************/
+
+
+/* DEFUN - Define a built-in Lisp-visible C function or `subr'.
+ `lname' should be the name to give the function in Lisp,
+ as a null-terminated C string.
+ `Fname' should be the C equivalent of `lname', using only characters
+ valid in a C identifier, with an "F" prepended.
+ The name of the C constant structure that records information
+ on this function for internal use is "S" concatenated with Fname.
+ `minargs' should be a number, the minimum number of arguments allowed.
+ `maxargs' should be a number, the maximum number of arguments allowed,
+ or else MANY or UNEVALLED.
+ MANY means pass a vector of evaluated arguments,
+ in the form of an integer number-of-arguments
+ followed by the address of a vector of Lisp_Objects
+ which contains the argument values.
+ UNEVALLED means pass the list of unevaluated arguments.
+ `prompt' says how to read arguments for an interactive call.
+ See the doc string for `interactive'.
+ A null string means call interactively with no arguments.
+ `arglist' are the comma-separated arguments (always Lisp_Objects) for
+ the function.
+ The docstring for the function is placed as a "C" comment between
+ the prompt and the `args' argument. make-docfile reads the
+ comment and creates the DOC file from it.
+*/
+
+#define EXFUN_0 void
+#define EXFUN_1 Lisp_Object
+#define EXFUN_2 Lisp_Object,Lisp_Object
+#define EXFUN_3 Lisp_Object,Lisp_Object,Lisp_Object
+#define EXFUN_4 Lisp_Object,Lisp_Object,Lisp_Object,Lisp_Object
+#define EXFUN_5 Lisp_Object,Lisp_Object,Lisp_Object,Lisp_Object,Lisp_Object
+#define EXFUN_6 Lisp_Object,Lisp_Object,Lisp_Object,Lisp_Object,Lisp_Object, \
+Lisp_Object
+#define EXFUN_7 Lisp_Object,Lisp_Object,Lisp_Object,Lisp_Object,Lisp_Object, \
+Lisp_Object,Lisp_Object
+#define EXFUN_8 Lisp_Object,Lisp_Object,Lisp_Object,Lisp_Object,Lisp_Object, \
+Lisp_Object,Lisp_Object,Lisp_Object
+#define EXFUN_MANY int, Lisp_Object*
+#define EXFUN_UNEVALLED Lisp_Object
+#define EXFUN(sym, maxargs) Lisp_Object sym (EXFUN_##maxargs)
+
+#define SUBR_MAX_ARGS 8
+#define MANY -2
+#define UNEVALLED -1
+
+/* 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 DEFUN(lname, Fname, minargs, maxargs, prompt, arglist) \
+ Lisp_Object Fname (EXFUN_##maxargs); \
+ static struct Lisp_Subr S##Fname = { subr_lheader_initializer, \
+ minargs, maxargs, prompt, 0, lname, (lisp_fn_t) Fname }; \
+ Lisp_Object Fname (DEFUN_##maxargs arglist)
+
+/* Heavy ANSI C preprocessor hackery to get DEFUN to declare a
+ prototype that matches maxargs, and add the obligatory
+ `Lisp_Object' type declaration to the formal C arguments. */
+
+#define DEFUN_MANY(named_int, named_Lisp_Object) named_int, named_Lisp_Object
+#define DEFUN_UNEVALLED(args) Lisp_Object args
+#define DEFUN_0() void
+#define DEFUN_1(a) Lisp_Object a
+#define DEFUN_2(a,b) DEFUN_1(a), Lisp_Object b
+#define DEFUN_3(a,b,c) DEFUN_2(a,b), Lisp_Object c
+#define DEFUN_4(a,b,c,d) DEFUN_3(a,b,c), Lisp_Object d
+#define DEFUN_5(a,b,c,d,e) DEFUN_4(a,b,c,d), Lisp_Object e
+#define DEFUN_6(a,b,c,d,e,f) DEFUN_5(a,b,c,d,e), Lisp_Object f
+#define DEFUN_7(a,b,c,d,e,f,g) DEFUN_6(a,b,c,d,e,f), Lisp_Object g
+#define DEFUN_8(a,b,c,d,e,f,g,h) DEFUN_7(a,b,c,d,e,f,g),Lisp_Object h
+
+/* WARNING: If you add defines here for higher values of maxargs,
+ make sure to also fix the clauses in inline_funcall_fn(),
+ and change the define of SUBR_MAX_ARGS above. */
+
+#include "symeval.h"
+
+/* Depth of special binding/unwind-protect stack. Use as arg to `unbind_to' */
+int specpdl_depth (void);
+
+\f
+/************************************************************************/
+/* Checking for QUIT */
+/************************************************************************/
+
+/* Asynchronous events set something_happened, and then are processed
+ within the QUIT macro. At this point, we are guaranteed to not be in
+ any sensitive code. */
+
+extern volatile int something_happened;
+int check_what_happened (void);
+
+extern volatile int quit_check_signal_happened;
+extern volatile int quit_check_signal_tick_count;
+int check_quit (void);
+
+void signal_quit (void);
+
+/* Nonzero if ought to quit now. */
+#define QUITP \
+ ((quit_check_signal_happened ? check_quit () : 0), \
+ (!NILP (Vquit_flag) && (NILP (Vinhibit_quit) \
+ || EQ (Vquit_flag, Qcritical))))
+
+/* QUIT used to call QUITP, but there are some places where QUITP
+ is called directly, and check_what_happened() should only be called
+ when Emacs is actually ready to quit because it could do things
+ like switch threads. */
+#define INTERNAL_QUITP \
+ ((something_happened ? check_what_happened () : 0), \
+ (!NILP (Vquit_flag) && \
+ (NILP (Vinhibit_quit) || EQ (Vquit_flag, Qcritical))))
+
+#define INTERNAL_REALLY_QUITP \
+ (check_what_happened (), \
+ (!NILP (Vquit_flag) && \
+ (NILP (Vinhibit_quit) || EQ (Vquit_flag, Qcritical))))
+
+/* Check quit-flag and quit if it is non-nil. Also do any other things
+ that might have gotten queued until it was safe. */
+#define QUIT do { if (INTERNAL_QUITP) signal_quit (); } while (0)
+
+#define REALLY_QUIT do { if (INTERNAL_REALLY_QUITP) signal_quit (); } while (0)
+
+\f
+/************************************************************************/
+/* hashing */
+/************************************************************************/
+
+/* #### for a 64-bit machine, we should substitute a prime just over 2^32 */
+#define GOOD_HASH 65599 /* prime number just over 2^16; Dragon book, p. 435 */
+#define HASH2(a,b) (GOOD_HASH * (a) + (b))
+#define HASH3(a,b,c) (GOOD_HASH * HASH2 (a,b) + (c))
+#define HASH4(a,b,c,d) (GOOD_HASH * HASH3 (a,b,c) + (d))
+#define HASH5(a,b,c,d,e) (GOOD_HASH * HASH4 (a,b,c,d) + (e))
+#define HASH6(a,b,c,d,e,f) (GOOD_HASH * HASH5 (a,b,c,d,e) + (f))
+#define HASH7(a,b,c,d,e,f,g) (GOOD_HASH * HASH6 (a,b,c,d,e,f) + (g))
+#define HASH8(a,b,c,d,e,f,g,h) (GOOD_HASH * HASH7 (a,b,c,d,e,f,g) + (h))
+#define HASH9(a,b,c,d,e,f,g,h,i) (GOOD_HASH * HASH8 (a,b,c,d,e,f,g,h) + (i))
+
+/* Enough already! */
+
+#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 internal_hash (Lisp_Object obj, int depth);
+unsigned long internal_array_hash (Lisp_Object *arr, int size, int depth);
+
+\f
+/************************************************************************/
+/* String translation */
+/************************************************************************/
+
+#ifdef I18N3
+#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 *);
+#endif /* HAVE_LIBINTL_H */
+
+#define GETTEXT(x) gettext(x)
+#define LISP_GETTEXT(x) Fgettext (x)
+#else /* !I18N3 */
+#define GETTEXT(x) (x)
+#define LISP_GETTEXT(x) (x)
+#endif /* !I18N3 */
+
+/* DEFER_GETTEXT is used to identify strings which are translated when
+ they are referenced instead of when they are defined.
+ These include Qerror_messages and initialized arrays of strings.
+*/
+#define DEFER_GETTEXT(x) (x)
+
+\f
+/************************************************************************/
+/* Garbage collection / GC-protection */
+/************************************************************************/
+
+/* number of bytes of structure consed since last GC */
+
+extern EMACS_INT consing_since_gc;
+
+/* threshold for doing another gc */
+
+extern EMACS_INT gc_cons_threshold;
+
+/* Structure for recording stack slots that need marking */
+
+/* This is a chain of structures, each of which points at a Lisp_Object
+ variable whose value should be marked in garbage collection.
+ Normally every link of the chain is an automatic variable of a function,
+ and its `val' points to some argument or local variable of the function.
+ On exit to the function, the chain is set back to the value it had on
+ entry. This way, no link remains in the chain when the stack frame
+ containing the link disappears.
+
+ Every function that can call Feval must protect in this fashion all
+ Lisp_Object variables whose contents will be used again. */
+
+extern struct gcpro *gcprolist;
+
+struct gcpro
+{
+ struct gcpro *next;
+ Lisp_Object *var; /* Address of first protected variable */
+ int nvars; /* Number of consecutive protected variables */
+};
+
+/* Normally, you declare variables gcpro1, gcpro2, ... and use the
+ GCPROn() macros. However, if you need to have nested gcpro's,
+ declare ngcpro1, ngcpro2, ... and use NGCPROn(). If you need
+ to nest another level, use nngcpro1, nngcpro2, ... and use
+ NNGCPROn(). If you need to nest yet another level, create
+ the appropriate macros. */
+
+#ifdef DEBUG_GCPRO
+
+void debug_gcpro1 (char *, int, struct gcpro *, Lisp_Object *);
+void debug_gcpro2 (char *, int, struct gcpro *, struct gcpro *,
+ Lisp_Object *, Lisp_Object *);
+void debug_gcpro3 (char *, int, struct gcpro *, struct gcpro *, struct gcpro *,
+ Lisp_Object *, Lisp_Object *, Lisp_Object *);
+void debug_gcpro4 (char *, int, struct gcpro *, struct gcpro *, struct gcpro *,
+ struct gcpro *, Lisp_Object *, Lisp_Object *, Lisp_Object *,
+ Lisp_Object *);
+void debug_gcpro5 (char *, int, struct gcpro *, struct gcpro *, struct gcpro *,
+ struct gcpro *, struct gcpro *, Lisp_Object *, Lisp_Object *,
+ Lisp_Object *, Lisp_Object *, Lisp_Object *);
+void debug_ungcpro(char *, int, struct gcpro *);
+
+#define GCPRO1(v) \
+ debug_gcpro1 (__FILE__, __LINE__,&gcpro1,&v)
+#define GCPRO2(v1,v2) \
+ debug_gcpro2 (__FILE__, __LINE__,&gcpro1,&gcpro2,&v1,&v2)
+#define GCPRO3(v1,v2,v3) \
+ debug_gcpro3 (__FILE__, __LINE__,&gcpro1,&gcpro2,&gcpro3,&v1,&v2,&v3)
+#define GCPRO4(v1,v2,v3,v4) \
+ debug_gcpro4 (__FILE__, __LINE__,&gcpro1,&gcpro2,&gcpro3,&gcpro4,\
+ &v1,&v2,&v3,&v4)
+#define GCPRO5(v1,v2,v3,v4,v5) \
+ debug_gcpro5 (__FILE__, __LINE__,&gcpro1,&gcpro2,&gcpro3,&gcpro4,&gcpro5,\
+ &v1,&v2,&v3,&v4,&v5)
+#define UNGCPRO \
+ debug_ungcpro(__FILE__, __LINE__,&gcpro1)
+
+#define NGCPRO1(v) \
+ debug_gcpro1 (__FILE__, __LINE__,&ngcpro1,&v)
+#define NGCPRO2(v1,v2) \
+ debug_gcpro2 (__FILE__, __LINE__,&ngcpro1,&ngcpro2,&v1,&v2)
+#define NGCPRO3(v1,v2,v3) \
+ debug_gcpro3 (__FILE__, __LINE__,&ngcpro1,&ngcpro2,&ngcpro3,&v1,&v2,&v3)
+#define NGCPRO4(v1,v2,v3,v4) \
+ debug_gcpro4 (__FILE__, __LINE__,&ngcpro1,&ngcpro2,&ngcpro3,&ngcpro4,\
+ &v1,&v2,&v3,&v4)
+#define NGCPRO5(v1,v2,v3,v4,v5) \
+ debug_gcpro5 (__FILE__, __LINE__,&ngcpro1,&ngcpro2,&ngcpro3,&ngcpro4,\
+ &ngcpro5,&v1,&v2,&v3,&v4,&v5)
+#define NUNGCPRO \
+ debug_ungcpro(__FILE__, __LINE__,&ngcpro1)
+
+#define NNGCPRO1(v) \
+ debug_gcpro1 (__FILE__, __LINE__,&nngcpro1,&v)
+#define NNGCPRO2(v1,v2) \
+ debug_gcpro2 (__FILE__, __LINE__,&nngcpro1,&nngcpro2,&v1,&v2)
+#define NNGCPRO3(v1,v2,v3) \
+ debug_gcpro3 (__FILE__, __LINE__,&nngcpro1,&nngcpro2,&nngcpro3,&v1,&v2,&v3)
+#define NNGCPRO4(v1,v2,v3,v4) \
+ debug_gcpro4 (__FILE__, __LINE__,&nngcpro1,&nngcpro2,&nngcpro3,&nngcpro4,\
+ &v1,&v2,&v3,&v4)
+#define NNGCPRO5(v1,v2,v3,v4,v5) \
+ debug_gcpro5 (__FILE__, __LINE__,&nngcpro1,&nngcpro2,&nngcpro3,&nngcpro4,\
+ &nngcpro5,&v1,&v2,&v3,&v4,&v5)
+#define NUNNGCPRO \
+ debug_ungcpro(__FILE__, __LINE__,&nngcpro1)
+
+#else /* ! DEBUG_GCPRO */
+
+#define GCPRO1(varname) \
+ {gcpro1.next = gcprolist; gcpro1.var = &varname; gcpro1.nvars = 1; \
+ gcprolist = &gcpro1; }
+
+#define GCPRO2(varname1, varname2) \
+ {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
+ gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
+ gcprolist = &gcpro2; }
+
+#define GCPRO3(varname1, varname2, varname3) \
+ {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
+ gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
+ gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
+ gcprolist = &gcpro3; }
+
+#define GCPRO4(varname1, varname2, varname3, varname4) \
+ {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
+ gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
+ gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
+ gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
+ gcprolist = &gcpro4; }
+
+#define GCPRO5(varname1, varname2, varname3, varname4, varname5) \
+ {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
+ gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
+ gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
+ gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
+ gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \
+ gcprolist = &gcpro5; }
+
+#define UNGCPRO (gcprolist = gcpro1.next)
+
+#define NGCPRO1(varname) \
+ {ngcpro1.next = gcprolist; ngcpro1.var = &varname; ngcpro1.nvars = 1; \
+ gcprolist = &ngcpro1; }
+
+#define NGCPRO2(varname1, varname2) \
+ {ngcpro1.next = gcprolist; ngcpro1.var = &varname1; ngcpro1.nvars = 1; \
+ ngcpro2.next = &ngcpro1; ngcpro2.var = &varname2; ngcpro2.nvars = 1; \
+ gcprolist = &ngcpro2; }
+
+#define NGCPRO3(varname1, varname2, varname3) \
+ {ngcpro1.next = gcprolist; ngcpro1.var = &varname1; ngcpro1.nvars = 1; \
+ ngcpro2.next = &ngcpro1; ngcpro2.var = &varname2; ngcpro2.nvars = 1; \
+ ngcpro3.next = &ngcpro2; ngcpro3.var = &varname3; ngcpro3.nvars = 1; \
+ gcprolist = &ngcpro3; }
+
+#define NGCPRO4(varname1, varname2, varname3, varname4) \
+ {ngcpro1.next = gcprolist; ngcpro1.var = &varname1; ngcpro1.nvars = 1; \
+ ngcpro2.next = &ngcpro1; ngcpro2.var = &varname2; ngcpro2.nvars = 1; \
+ ngcpro3.next = &ngcpro2; ngcpro3.var = &varname3; ngcpro3.nvars = 1; \
+ ngcpro4.next = &ngcpro3; ngcpro4.var = &varname4; ngcpro4.nvars = 1; \
+ gcprolist = &ngcpro4; }
+
+#define NGCPRO5(varname1, varname2, varname3, varname4, varname5) \
+ {ngcpro1.next = gcprolist; ngcpro1.var = &varname1; ngcpro1.nvars = 1; \
+ ngcpro2.next = &ngcpro1; ngcpro2.var = &varname2; ngcpro2.nvars = 1; \
+ ngcpro3.next = &ngcpro2; ngcpro3.var = &varname3; ngcpro3.nvars = 1; \
+ ngcpro4.next = &ngcpro3; ngcpro4.var = &varname4; ngcpro4.nvars = 1; \
+ ngcpro5.next = &ngcpro4; ngcpro5.var = &varname5; ngcpro5.nvars = 1; \
+ gcprolist = &ngcpro5; }
+
+#define NUNGCPRO (gcprolist = ngcpro1.next)
+
+#define NNGCPRO1(varname) \
+ {nngcpro1.next = gcprolist; nngcpro1.var = &varname; nngcpro1.nvars = 1; \
+ gcprolist = &nngcpro1; }
+
+#define NNGCPRO2(varname1, varname2) \
+ {nngcpro1.next = gcprolist; nngcpro1.var = &varname1; nngcpro1.nvars = 1; \
+ nngcpro2.next = &nngcpro1; nngcpro2.var = &varname2; nngcpro2.nvars = 1; \
+ gcprolist = &nngcpro2; }
+
+#define NNGCPRO3(varname1, varname2, varname3) \
+ {nngcpro1.next = gcprolist; nngcpro1.var = &varname1; nngcpro1.nvars = 1; \
+ nngcpro2.next = &nngcpro1; nngcpro2.var = &varname2; nngcpro2.nvars = 1; \
+ nngcpro3.next = &nngcpro2; nngcpro3.var = &varname3; nngcpro3.nvars = 1; \
+ gcprolist = &nngcpro3; }
+
+#define NNGCPRO4(varname1, varname2, varname3, varname4) \
+ {nngcpro1.next = gcprolist; nngcpro1.var = &varname1; nngcpro1.nvars = 1; \
+ nngcpro2.next = &nngcpro1; nngcpro2.var = &varname2; nngcpro2.nvars = 1; \
+ nngcpro3.next = &nngcpro2; nngcpro3.var = &varname3; nngcpro3.nvars = 1; \
+ nngcpro4.next = &nngcpro3; nngcpro4.var = &varname4; nngcpro4.nvars = 1; \
+ gcprolist = &nngcpro4; }
+
+#define NNGCPRO5(varname1, varname2, varname3, varname4, varname5) \
+ {nngcpro1.next = gcprolist; nngcpro1.var = &varname1; nngcpro1.nvars = 1; \
+ nngcpro2.next = &nngcpro1; nngcpro2.var = &varname2; nngcpro2.nvars = 1; \
+ nngcpro3.next = &nngcpro2; nngcpro3.var = &varname3; nngcpro3.nvars = 1; \
+ nngcpro4.next = &nngcpro3; nngcpro4.var = &varname4; nngcpro4.nvars = 1; \
+ nngcpro5.next = &nngcpro4; nngcpro5.var = &varname5; nngcpro5.nvars = 1; \
+ gcprolist = &nngcpro5; }
+
+#define NNUNGCPRO (gcprolist = nngcpro1.next)
+
+#endif /* ! DEBUG_GCPRO */
+
+/* Another try to fix SunPro C compiler warnings */
+/* "end-of-loop code not reached" */
+/* "statement not reached */
+#ifdef __SUNPRO_C
+#define RETURN__ if (1) return
+#define RETURN_NOT_REACHED(value)
+#else
+#define RETURN__ return
+#define RETURN_NOT_REACHED(value) return value;
+#endif
+
+/* Evaluate expr, UNGCPRO, and then return the value of expr. */
+#define RETURN_UNGCPRO(expr) do \
+{ \
+ Lisp_Object ret_ungc_val = (expr); \
+ UNGCPRO; \
+ RETURN__ ret_ungc_val; \
+} while (0)
+
+/* Evaluate expr, NUNGCPRO, UNGCPRO, and then return the value of expr. */
+#define RETURN_NUNGCPRO(expr) do \
+{ \
+ Lisp_Object ret_ungc_val = (expr); \
+ NUNGCPRO; \
+ UNGCPRO; \
+ RETURN__ ret_ungc_val; \
+} while (0)
+
+/* Evaluate expr, NNUNGCPRO, NUNGCPRO, UNGCPRO, and then return the
+ value of expr. */
+#define RETURN_NNUNGCPRO(expr) do \
+{ \
+ Lisp_Object ret_ungc_val = (expr); \
+ NNUNGCPRO; \
+ NUNGCPRO; \
+ UNGCPRO; \
+ RETURN__ ret_ungc_val; \
+} while (0)
+
+/* Evaluate expr, return it if it's not Qunbound. */
+#define RETURN_IF_NOT_UNBOUND(expr) do \
+{ \
+ Lisp_Object ret_nunb_val = (expr); \
+ if (!UNBOUNDP (ret_nunb_val)) \
+ RETURN__ ret_nunb_val; \
+} while (0)
+
+/* Call staticpro (&var) to protect static variable `var'. */
+void staticpro (Lisp_Object *);
+
+/* Nonzero means Emacs has already been initialized.
+ Used during startup to detect startup of dumped Emacs. */
+extern int initialized;
+
+#ifdef MEMORY_USAGE_STATS
+
+/* This structure is used to keep statistics on the amount of memory
+ in use.
+
+ WAS_REQUESTED stores the actual amount of memory that was requested
+ of the allocation function. The *_OVERHEAD fields store the
+ additional amount of memory that was grabbed by the functions to
+ facilitate allocation, reallocation, etc. MALLOC_OVERHEAD is for
+ memory allocated with malloc(); DYNARR_OVERHEAD is for dynamic
+ arrays; GAP_OVERHEAD is for gap arrays. Note that for (e.g.)
+ dynamic arrays, there is both MALLOC_OVERHEAD and DYNARR_OVERHEAD
+ memory: The dynamic array allocates memory above and beyond what
+ was asked of it, and when it in turns allocates memory using
+ malloc(), malloc() allocates memory beyond what it was asked
+ to allocate.
+
+ Functions that accept a structure of this sort do not initialize
+ the fields to 0, and add any existing values to whatever was there
+ before; this way, you can get a cumulative effect. */
+
+struct overhead_stats
+{
+ int was_requested;
+ int malloc_overhead;
+ int dynarr_overhead;
+ int gap_overhead;
+};
+
+#endif /* MEMORY_USAGE_STATS */
+
+#ifndef DIRECTORY_SEP
+#define DIRECTORY_SEP '/'
+#endif
+#ifndef IS_DIRECTORY_SEP
+#define IS_DIRECTORY_SEP(_c_) ((_c_) == DIRECTORY_SEP)
+#endif
+#ifndef IS_DEVICE_SEP
+#ifndef DEVICE_SEP
+#define IS_DEVICE_SEP(_c_) 0
+#else
+#define IS_DEVICE_SEP(_c_) ((_c_) == DEVICE_SEP)
+#endif
+#endif
+#ifndef IS_ANY_SEP
+#define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_))
+#endif
+
+#ifdef HAVE_INTTYPES_H
+#include <inttypes.h>
+#elif SIZEOF_VOID_P == SIZEOF_INT
+typedef int intptr_t;
+typedef unsigned int uintptr_t;
+#elif SIZEOF_VOID_P == SIZEOF_LONG
+typedef long intptr_t;
+typedef unsigned long uintptr_t;
+#elif defined(SIZEOF_LONG_LONG) && SIZEOF_VOID_P == SIZEOF_LONG_LONG
+typedef long long intptr_t;
+typedef unsigned long long uintptr_t;
+#else
+/* Just pray. May break, may not. */
+typedef long intptr_t;
+typedef unsigned long uintptr_t;
+#endif
+
+/* Defined in alloc.c */
+void release_breathing_space (void);
+Lisp_Object noseeum_cons (Lisp_Object, Lisp_Object);
+Lisp_Object make_vector (EMACS_INT, Lisp_Object);
+Lisp_Object vector1 (Lisp_Object);
+Lisp_Object vector2 (Lisp_Object, Lisp_Object);
+Lisp_Object vector3 (Lisp_Object, Lisp_Object, Lisp_Object);
+Lisp_Object make_bit_vector (EMACS_INT, Lisp_Object);
+Lisp_Object make_bit_vector_from_byte_vector (unsigned char *, EMACS_INT);
+Lisp_Object noseeum_make_marker (void);
+void garbage_collect_1 (void);
+Lisp_Object acons (Lisp_Object, Lisp_Object, Lisp_Object);
+Lisp_Object cons3 (Lisp_Object, Lisp_Object, Lisp_Object);
+Lisp_Object list1 (Lisp_Object);
+Lisp_Object list2 (Lisp_Object, Lisp_Object);
+Lisp_Object list3 (Lisp_Object, Lisp_Object, Lisp_Object);
+Lisp_Object list4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
+Lisp_Object list5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object);
+Lisp_Object list6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object);
+DECLARE_DOESNT_RETURN (memory_full (void));
+void disksave_object_finalization (void);
+extern int purify_flag;
+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);
+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);
+void free_cons (struct Lisp_Cons *);
+void free_list (Lisp_Object);
+void free_alist (Lisp_Object);
+void mark_conses_in_list (Lisp_Object);
+void free_marker (struct Lisp_Marker *);
+int object_dead_p (Lisp_Object);
+
+#ifdef MEMORY_USAGE_STATS
+size_t malloced_storage_size (void *, size_t, struct overhead_stats *);
+size_t fixed_type_block_overhead (size_t);
+#endif
+
+/* Defined in buffer.c */
+Lisp_Object make_buffer (struct buffer *);
+Lisp_Object get_truename_buffer (Lisp_Object);
+void switch_to_buffer (Lisp_Object, Lisp_Object);
+extern int find_file_compare_truenames;
+extern int find_file_use_truenames;
+
+/* Defined in callproc.c */
+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 (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);
+
+enum arith_comparison {
+ arith_equal,
+ arith_notequal,
+ arith_less,
+ arith_grtr,
+ arith_less_or_equal,
+ arith_grtr_or_equal };
+Lisp_Object arithcompare (Lisp_Object, Lisp_Object, enum arith_comparison);
+
+Lisp_Object word_to_lisp (unsigned int);
+unsigned int lisp_to_word (Lisp_Object);
+
+/* Defined in dired.c */
+Lisp_Object make_directory_hash_table (CONST char *);
+Lisp_Object wasteful_word_to_lisp (unsigned int);
+
+/* Defined in doc.c */
+Lisp_Object unparesseuxify_doc_string (int, EMACS_INT, char *, Lisp_Object);
+Lisp_Object read_doc_string (Lisp_Object);
+
+/* Defined in doprnt.c */
+Bytecount emacs_doprnt_c (Lisp_Object, CONST Bufbyte *, Lisp_Object,
+ Bytecount, ...);
+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, int, ...);
+Lisp_Object emacs_doprnt_string_c (CONST Bufbyte *, Lisp_Object,
+ Bytecount, ...);
+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,
+ Bytecount, int, ...);
+
+/* Defined in editfns.c */
+void uncache_home_directory (void);
+char *get_home_directory (void);
+char *user_login_name (int *);
+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 save_excursion_save (void);
+Lisp_Object save_restriction_save (void);
+Lisp_Object save_excursion_restore (Lisp_Object);
+Lisp_Object save_restriction_restore (Lisp_Object);
+
+/* Defined in emacsfns.c */
+Lisp_Object save_current_buffer_restore (Lisp_Object);
+
+/* Defined in emacs.c */
+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);
+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 *);
+/* Nonzero means don't do interactive redisplay and don't change tty modes */
+extern int noninteractive;
+extern int preparing_for_armageddon;
+extern int emacs_priority;
+extern int running_asynch_code;
+extern int suppress_early_error_handler_backtrace;
+
+/* Defined in eval.c */
+DECLARE_DOESNT_RETURN (signal_error (Lisp_Object, Lisp_Object));
+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 *,
+ ...), 1, 2);
+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 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,
+ 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, Error_behavior);
+DECLARE_DOESNT_RETURN_GCC__ATTRIBUTE__SYNTAX_SUCKS (error_with_frob
+ (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 *,
+ ...) 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));
+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, Lisp_Object);
+Lisp_Object maybe_signal_simple_continuable_error_2 (CONST char *, Lisp_Object,
+ Lisp_Object, Lisp_Object,
+ Error_behavior);
+Lisp_Object funcall_recording_as (Lisp_Object, int, Lisp_Object *);
+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);
+void va_run_hook_with_args (Lisp_Object, int, ...);
+void va_run_hook_with_args_in_buffer (struct buffer *, Lisp_Object, int, ...);
+Lisp_Object run_hook (Lisp_Object);
+Lisp_Object apply1 (Lisp_Object, Lisp_Object);
+Lisp_Object call0 (Lisp_Object);
+Lisp_Object call1 (Lisp_Object, Lisp_Object);
+Lisp_Object call2 (Lisp_Object, Lisp_Object, Lisp_Object);
+Lisp_Object call3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
+Lisp_Object call4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object);
+Lisp_Object call5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object);
+Lisp_Object call6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object, Lisp_Object);
+Lisp_Object call7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
+Lisp_Object call8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object);
+Lisp_Object call0_in_buffer (struct buffer *, Lisp_Object);
+Lisp_Object call1_in_buffer (struct buffer *, Lisp_Object, Lisp_Object);
+Lisp_Object call2_in_buffer (struct buffer *, Lisp_Object, Lisp_Object,
+ Lisp_Object);
+Lisp_Object call3_in_buffer (struct buffer *, Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object);
+Lisp_Object call4_in_buffer (struct buffer *, Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object, Lisp_Object);
+Lisp_Object call5_in_buffer (struct buffer *, Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object);
+Lisp_Object call6_in_buffer (struct buffer *, Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object);
+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);
+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, ...);
+/* C Code should be using internal_catch, record_unwind_p, condition_case_1 */
+Lisp_Object internal_catch (Lisp_Object, Lisp_Object (*) (Lisp_Object),
+ Lisp_Object, int * volatile);
+Lisp_Object condition_case_1 (Lisp_Object,
+ Lisp_Object (*) (Lisp_Object),
+ Lisp_Object,
+ Lisp_Object (*) (Lisp_Object, Lisp_Object),
+ Lisp_Object);
+Lisp_Object condition_case_3 (Lisp_Object, Lisp_Object, Lisp_Object);
+Lisp_Object unbind_to (int, Lisp_Object);
+void specbind (Lisp_Object, Lisp_Object);
+void record_unwind_protect (Lisp_Object (*) (Lisp_Object), Lisp_Object);
+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 *,
+ ...) PRINTF_ARGS (3, 4);
+
+
+/* Defined in event-stream.c */
+void wait_delaying_user_input (int (*) (void *), void *);
+int detect_input_pending (void);
+void reset_this_command_keys (Lisp_Object, int);
+Lisp_Object enqueue_misc_user_event (Lisp_Object, Lisp_Object, Lisp_Object);
+Lisp_Object enqueue_misc_user_event_pos (Lisp_Object, Lisp_Object,
+ Lisp_Object, int, int, int, int);
+
+/* Defined in event-Xt.c */
+void signal_special_Xt_user_event (Lisp_Object, Lisp_Object, Lisp_Object);
+
+
+/* Defined in events.c */
+void clear_event_resource (void);
+Lisp_Object allocate_event (void);
+int event_to_character (struct 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,
+ Lisp_Object, Error_behavior);
+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 *,
+ Lisp_Object));
+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 *,
+ Lisp_Object, Lisp_Object));
+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);
+int internal_delete_file (Lisp_Object);
+
+/* Defined in filelock.c */
+void lock_file (Lisp_Object);
+void unlock_file (Lisp_Object);
+void unlock_all_files (void);
+void unlock_buffer (struct buffer *);
+
+/* Defined in filemode.c */
+void filemodestring (struct stat *, char *);
+
+/* Defined in floatfns.c */
+double extract_float (Lisp_Object);
+
+/* Defined in fns.c */
+Lisp_Object list_sort (Lisp_Object, Lisp_Object,
+ int (*) (Lisp_Object, Lisp_Object, Lisp_Object));
+Lisp_Object merge (Lisp_Object, Lisp_Object, Lisp_Object);
+
+void bump_string_modiff (Lisp_Object);
+Lisp_Object memq_no_quit (Lisp_Object, Lisp_Object);
+Lisp_Object assoc_no_quit (Lisp_Object, Lisp_Object);
+Lisp_Object assq_no_quit (Lisp_Object, Lisp_Object);
+Lisp_Object rassq_no_quit (Lisp_Object, Lisp_Object);
+Lisp_Object delq_no_quit (Lisp_Object, Lisp_Object);
+Lisp_Object delq_no_quit_and_free_cons (Lisp_Object, Lisp_Object);
+Lisp_Object remassoc_no_quit (Lisp_Object, Lisp_Object);
+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);
+int internal_remprop (Lisp_Object *, Lisp_Object);
+Lisp_Object external_plist_get (Lisp_Object *, Lisp_Object,
+ int, Error_behavior);
+void external_plist_put (Lisp_Object *, Lisp_Object,
+ Lisp_Object, int, Error_behavior);
+int external_remprop (Lisp_Object *, Lisp_Object, int, Error_behavior);
+int internal_equal (Lisp_Object, Lisp_Object, int);
+Lisp_Object concat2 (Lisp_Object, Lisp_Object);
+Lisp_Object concat3 (Lisp_Object, Lisp_Object, Lisp_Object);
+Lisp_Object vconcat2 (Lisp_Object, Lisp_Object);
+Lisp_Object vconcat3 (Lisp_Object, Lisp_Object, Lisp_Object);
+Lisp_Object nconc2 (Lisp_Object, Lisp_Object);
+void check_losing_bytecode (CONST char *, Lisp_Object);
+
+/* Defined in getloadavg.c */
+int getloadavg (double[], int);
+
+/* Defined in glyphs.c */
+Error_behavior decode_error_behavior_flag (Lisp_Object);
+Lisp_Object encode_error_behavior_flag (Error_behavior);
+
+/* Defined in indent.c */
+int bi_spaces_at_point (struct buffer *, Bytind);
+int column_at_point (struct buffer *, Bufpos, int);
+int current_column (struct buffer *);
+void invalidate_current_column (void);
+Bufpos vmotion (struct window *, Bufpos, int, int *);
+Bufpos vmotion_pixels (Lisp_Object, Bufpos, int, int, int *);
+
+/* Defined in keymap.c */
+void where_is_to_char (Lisp_Object, char *);
+
+/* 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 *);
+
+/* Well, I've decided to enable this. -- ben */
+/* And I've decided to make it work right. -- sb */
+#define LOADHIST
+/* Define the following symbol to enable load history of dumped files */
+#define LOADHIST_DUMPED
+/* Define the following symbol to enable load history of C source */
+#define LOADHIST_BUILTIN
+
+#ifdef LOADHIST /* this is just a stupid idea */
+#define LOADHIST_ATTACH(x) \
+ do { if (initialized) Vcurrent_load_list = Fcons (x, Vcurrent_load_list); } \
+ while (0)
+#else /*! LOADHIST */
+# define LOADHIST_ATTACH(x)
+#endif /*! LOADHIST */
+
+/* Defined in marker.c */
+Bytind bi_marker_position (Lisp_Object);
+Bufpos marker_position (Lisp_Object);
+void set_bi_marker_position (Lisp_Object, Bytind);
+void set_marker_position (Lisp_Object, Bufpos);
+void unchain_marker (Lisp_Object);
+Lisp_Object noseeum_copy_marker (Lisp_Object, Lisp_Object);
+Lisp_Object set_marker_restricted (Lisp_Object, Lisp_Object, Lisp_Object);
+#ifdef MEMORY_USAGE_STATS
+int compute_buffer_marker_usage (struct buffer *, struct overhead_stats *);
+#endif
+
+/* Defined in menubar.c */
+extern int popup_menu_up_p;
+extern int menubar_show_keybindings;
+extern int popup_menu_titles;
+
+/* Defined in minibuf.c */
+extern int minibuf_level;
+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,
+ 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,
+ Bytecount, Bytecount, 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,
+ 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 clear_message (void);
+
+/* Defined in print.c */
+void write_string_to_stdio_stream (FILE *, struct console *,
+ CONST Bufbyte *, Bytecount, Bytecount,
+ enum external_data_format);
+void debug_print (Lisp_Object);
+void debug_short_backtrace (int);
+void temp_output_buffer_setup (CONST char *);
+void temp_output_buffer_show (Lisp_Object, Lisp_Object);
+/* 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);
+/* Same goes for this function. */
+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);
+void long_to_string (char *, long);
+void print_internal (Lisp_Object, Lisp_Object, int);
+void print_symbol (Lisp_Object, Lisp_Object, int);
+void print_float (Lisp_Object, Lisp_Object, int);
+void print_compiled_function (Lisp_Object, Lisp_Object, int);
+extern int print_escape_newlines;
+extern int print_readably;
+Lisp_Object internal_with_output_to_temp_buffer (CONST char *,
+ Lisp_Object (*) (Lisp_Object),
+ Lisp_Object, Lisp_Object);
+void float_to_string (char *, double);
+void internal_object_printer (Lisp_Object, Lisp_Object, int);
+
+/* Defined in profile.c */
+void mark_profiling_info (void (*) (Lisp_Object));
+void profile_increase_call_count (Lisp_Object);
+extern int profiling_active;
+extern int profiling_redisplay_flag;
+
+/* Defined in rangetab.c */
+void put_range_table (Lisp_Object, EMACS_INT, EMACS_INT, Lisp_Object);
+int unified_range_table_bytes_needed (Lisp_Object);
+int unified_range_table_bytes_used (void *);
+void unified_range_table_copy_data (Lisp_Object, void *);
+Lisp_Object unified_range_table_lookup (void *, EMACS_INT, Lisp_Object);
+int unified_range_table_nentries (void *);
+void unified_range_table_get_range (void *, int, EMACS_INT *, EMACS_INT *,
+ Lisp_Object *);
+
+/* Defined in search.c */
+struct re_pattern_buffer;
+struct re_registers;
+Bufpos scan_buffer (struct buffer *, Emchar, Bufpos, Bufpos, EMACS_INT, EMACS_INT *, int);
+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);
+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 *,
+ Lisp_Object, Bytecount,
+ Bytecount, int, Error_behavior, int);
+Bytecount fast_lisp_string_match (Lisp_Object, Lisp_Object);
+void restore_match_data (void);
+
+/* Defined in signal.c */
+void init_interrupts_late (void);
+extern int dont_check_for_quit;
+void begin_dont_check_for_quit (void);
+void emacs_sleep (int);
+
+/* Defined in sound.c */
+void init_device_sound (struct device *);
+
+/* Defined in specifier.c */
+Lisp_Object specifier_instance (Lisp_Object, Lisp_Object, Lisp_Object,
+ Error_behavior, int, int, Lisp_Object);
+Lisp_Object specifier_instance_no_quit (Lisp_Object, Lisp_Object, Lisp_Object,
+ 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);
+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);
+void kill_buffer_local_variables (struct buffer *);
+int symbol_value_buffer_local_info (Lisp_Object, struct buffer *);
+Lisp_Object find_symbol_value (Lisp_Object);
+Lisp_Object find_symbol_value_quickly (Lisp_Object, int);
+Lisp_Object top_level_value (Lisp_Object);
+
+/* Defined in syntax.c */
+int scan_words (struct buffer *, int, int);
+
+/* Defined in undo.c */
+Lisp_Object truncate_undo_list (Lisp_Object, int, int);
+void record_extent (Lisp_Object, int);
+void record_insert (struct buffer *, Bufpos, Charcount);
+void record_delete (struct buffer *, Bufpos, Charcount);
+void record_change (struct buffer *, Bufpos, Charcount);
+
+/* Defined in unex*.c */
+int unexec (char *, char *, uintptr_t, uintptr_t, uintptr_t);
+#ifdef RUN_TIME_REMAP
+int run_time_remap (char *);
+#endif
+
+/* Defined in vm-limit.c */
+void memory_warnings (void *, void (*) (CONST char *));
+
+/* Defined in window.c */
+Lisp_Object save_window_excursion_unwind (Lisp_Object);
+Lisp_Object display_buffer (Lisp_Object, Lisp_Object, Lisp_Object);
+
+/* The following were machine generated 19980312 */
+
+
+EXFUN (Faccept_process_output, 3);
+EXFUN (Fadd1, 1);
+EXFUN (Fadd_spec_to_specifier, 5);
+EXFUN (Fadd_timeout, 4);
+EXFUN (Fappend, MANY);
+EXFUN (Fapply, MANY);
+EXFUN (Faref, 2);
+EXFUN (Faset, 3);
+EXFUN (Fassoc, 2);
+EXFUN (Fassq, 2);
+EXFUN (Fbacktrace, 2);
+EXFUN (Fbeginning_of_line, 2);
+EXFUN (Fbobp, 1);
+EXFUN (Fbolp, 1);
+EXFUN (Fboundp, 1);
+EXFUN (Fbuffer_substring, 3);
+EXFUN (Fbuilt_in_variable_type, 1);
+EXFUN (Fbyte_code, 3);
+EXFUN (Fcall_interactively, 3);
+EXFUN (Fcanonicalize_lax_plist, 2);
+EXFUN (Fcanonicalize_plist, 2);
+EXFUN (Fcar, 1);
+EXFUN (Fcar_safe, 1);
+EXFUN (Fcdr, 1);
+EXFUN (Fchar_after, 2);
+EXFUN (Fchar_to_string, 1);
+EXFUN (Fcheck_valid_plist, 1);
+EXFUN (Fclear_range_table, 1);
+EXFUN (Fclrhash, 1);
+EXFUN (Fcoding_category_list, 0);
+EXFUN (Fcoding_category_system, 1);
+EXFUN (Fcoding_priority_list, 0);
+EXFUN (Fcoding_system_charset, 2);
+EXFUN (Fcoding_system_doc_string, 1);
+EXFUN (Fcoding_system_list, 0);
+EXFUN (Fcoding_system_name, 1);
+EXFUN (Fcoding_system_p, 1);
+EXFUN (Fcoding_system_property, 2);
+EXFUN (Fcoding_system_type, 1);
+EXFUN (Fcommand_execute, 3);
+EXFUN (Fcommandp, 1);
+EXFUN (Fcompiled_function_domain, 1);
+EXFUN (Fconcat, MANY);
+EXFUN (Fcons, 2);
+EXFUN (Fcopy_alist, 1);
+EXFUN (Fcopy_coding_system, 2);
+EXFUN (Fcopy_event, 2);
+EXFUN (Fcopy_marker, 2);
+EXFUN (Fcopy_sequence, 1);
+EXFUN (Fcopy_tree, 2);
+EXFUN (Fcurrent_window_configuration, 1);
+EXFUN (Fdecode_big5_char, 1);
+EXFUN (Fdecode_coding_region, 4);
+EXFUN (Fdecode_shift_jis_char, 1);
+EXFUN (Fdefault_boundp, 1);
+EXFUN (Fdefault_value, 1);
+EXFUN (Fdefine_key, 3);
+EXFUN (Fdelete_region, 3);
+EXFUN (Fdelq, 2);
+EXFUN (Fdestructive_alist_to_plist, 1);
+EXFUN (Fdetect_coding_region, 3);
+EXFUN (Fdgettext, 2);
+EXFUN (Fding, 3);
+EXFUN (Fdirectory_file_name, 1);
+EXFUN (Fdisable_timeout, 1);
+EXFUN (Fdiscard_input, 0);
+EXFUN (Fdispatch_event, 1);
+EXFUN (Fdisplay_error, 2);
+EXFUN (Fdo_auto_save, 2);
+EXFUN (Fdowncase, 2);
+EXFUN (Felt, 2);
+EXFUN (Fencode_big5_char, 1);
+EXFUN (Fencode_coding_region, 4);
+EXFUN (Fencode_shift_jis_char, 1);
+EXFUN (Fend_of_line, 2);
+EXFUN (Fenqueue_eval_event, 2);
+EXFUN (Feobp, 1);
+EXFUN (Feolp, 1);
+EXFUN (Fequal, 2);
+EXFUN (Ferror_message_string, 1);
+EXFUN (Feval, 1);
+EXFUN (Fevent_to_character, 4);
+EXFUN (Fexecute_kbd_macro, 2);
+EXFUN (Fexpand_abbrev, 0);
+EXFUN (Fexpand_file_name, 2);
+EXFUN (Fextent_at, 5);
+EXFUN (Fextent_property, 3);
+EXFUN (Ffboundp, 1);
+EXFUN (Ffile_accessible_directory_p, 1);
+EXFUN (Ffile_directory_p, 1);
+EXFUN (Ffile_executable_p, 1);
+EXFUN (Ffile_exists_p, 1);
+EXFUN (Ffile_name_absolute_p, 1);
+EXFUN (Ffile_name_as_directory, 1);
+EXFUN (Ffile_name_directory, 1);
+EXFUN (Ffile_name_nondirectory, 1);
+EXFUN (Ffile_readable_p, 1);
+EXFUN (Ffile_symlink_p, 1);
+EXFUN (Ffile_truename, 2);
+EXFUN (Ffind_coding_system, 1);
+EXFUN (Ffind_file_name_handler, 2);
+EXFUN (Ffollowing_char, 1);
+EXFUN (Fformat, MANY);
+EXFUN (Fforward_char, 2);
+EXFUN (Fforward_line, 2);
+EXFUN (Ffset, 2);
+EXFUN (Ffuncall, MANY);
+EXFUN (Fgeq, MANY);
+EXFUN (Fget, 3);
+EXFUN (Fget_buffer_process, 1);
+EXFUN (Fget_coding_system, 1);
+EXFUN (Fget_process, 1);
+EXFUN (Fget_range_table, 3);
+EXFUN (Fgethash, 3);
+EXFUN (Fgettext, 1);
+EXFUN (Fgoto_char, 2);
+EXFUN (Fgtr, MANY);
+EXFUN (Fhashtablep, 1);
+EXFUN (Findent_to, 3);
+EXFUN (Findirect_function, 1);
+EXFUN (Finsert, MANY);
+EXFUN (Finsert_buffer_substring, 3);
+EXFUN (Finsert_char, 4);
+EXFUN (Finsert_file_contents_internal, 7);
+EXFUN (Finteractive_p, 0);
+EXFUN (Fintern, 2);
+EXFUN (Fintern_soft, 2);
+EXFUN (Fkey_description, 1);
+EXFUN (Fkill_emacs, 1);
+EXFUN (Fkill_local_variable, 1);
+EXFUN (Flax_plist_get, 3);
+EXFUN (Flax_plist_remprop, 2);
+EXFUN (Flength, 1);
+EXFUN (Fleq, MANY);
+EXFUN (Flist, MANY);
+EXFUN (Flistp, 1);
+EXFUN (Flss, MANY);
+EXFUN (Fmake_byte_code, MANY);
+EXFUN (Fmake_coding_system, 4);
+EXFUN (Fmake_glyph_internal, 1);
+EXFUN (Fmake_hashtable, 2);
+EXFUN (Fmake_list, 2);
+EXFUN (Fmake_marker, 0);
+EXFUN (Fmake_range_table, 0);
+EXFUN (Fmake_sparse_keymap, 1);
+EXFUN (Fmake_string, 2);
+EXFUN (Fmake_symbol, 1);
+EXFUN (Fmake_vector, 2);
+EXFUN (Fmapcar, 2);
+EXFUN (Fmarker_buffer, 1);
+EXFUN (Fmarker_position, 1);
+EXFUN (Fmatch_beginning, 1);
+EXFUN (Fmatch_end, 1);
+EXFUN (Fmax, MANY);
+EXFUN (Fmember, 2);
+EXFUN (Fmemq, 2);
+EXFUN (Fmin, MANY);
+EXFUN (Fminus, MANY);
+EXFUN (Fnarrow_to_region, 3);
+EXFUN (Fnconc, MANY);
+EXFUN (Fnext_event, 2);
+EXFUN (Fnreverse, 1);
+EXFUN (Fnthcdr, 2);
+EXFUN (Fnumber_to_string, 1);
+EXFUN (Fold_assq, 2);
+EXFUN (Fold_equal, 2);
+EXFUN (Fold_member, 2);
+EXFUN (Fold_memq, 2);
+EXFUN (Fplist_get, 3);
+EXFUN (Fplist_put, 3);
+EXFUN (Fplus, MANY);
+EXFUN (Fpoint, 1);
+EXFUN (Fpoint_marker, 2);
+EXFUN (Fpoint_max, 1);
+EXFUN (Fpoint_min, 1);
+EXFUN (Fpreceding_char, 1);
+EXFUN (Fprefix_numeric_value, 1);
+EXFUN (Fprin1, 2);
+EXFUN (Fprin1_to_string, 2);
+EXFUN (Fprinc, 2);
+EXFUN (Fprint, 2);
+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);
+EXFUN (Fputhash, 3);
+EXFUN (Fquo, MANY);
+EXFUN (Frassq, 2);
+EXFUN (Fread, 1);
+EXFUN (Fread_key_sequence, 3);
+EXFUN (Freally_free, 1);
+EXFUN (Frem, 2);
+EXFUN (Fremassq, 2);
+EXFUN (Fselected_frame, 1);
+EXFUN (Fset, 2);
+EXFUN (Fset_coding_category_system, 2);
+EXFUN (Fset_coding_priority_list, 1);
+EXFUN (Fset_default, 2);
+EXFUN (Fset_marker, 3);
+EXFUN (Fset_standard_case_table, 1);
+EXFUN (Fsetcar, 2);
+EXFUN (Fsetcdr, 2);
+EXFUN (Fsignal, 2);
+EXFUN (Fsit_for, 2);
+EXFUN (Fskip_chars_backward, 3);
+EXFUN (Fskip_chars_forward, 3);
+EXFUN (Fsleep_for, 1);
+EXFUN (Fsort, 2);
+EXFUN (Fspecifier_spec_list, 4);
+EXFUN (Fstring_equal, 2);
+EXFUN (Fstring_lessp, 2);
+EXFUN (Fstring_match, 4);
+EXFUN (Fsub1, 1);
+EXFUN (Fsubr_max_args, 1);
+EXFUN (Fsubr_min_args, 1);
+EXFUN (Fsubsidiary_coding_system, 2);
+EXFUN (Fsubstitute_command_keys, 1);
+EXFUN (Fsubstitute_in_file_name, 1);
+EXFUN (Fsubstring, 3);
+EXFUN (Fsymbol_function, 1);
+EXFUN (Fsymbol_name, 1);
+EXFUN (Fsymbol_plist, 1);
+EXFUN (Fsymbol_value, 1);
+EXFUN (Fthrow, 2);
+EXFUN (Ftimes, MANY);
+EXFUN (Ftruncate, 1);
+EXFUN (Fundo_boundary, 0);
+EXFUN (Funhandled_file_name_directory, 1);
+EXFUN (Funlock_buffer, 0);
+EXFUN (Fupcase, 2);
+EXFUN (Fupcase_initials, 2);
+EXFUN (Fupcase_initials_region, 3);
+EXFUN (Fupcase_region, 3);
+EXFUN (Fuser_home_directory, 0);
+EXFUN (Fuser_login_name, 1);
+EXFUN (Fvector, MANY);
+EXFUN (Fverify_visited_file_modtime, 1);
+EXFUN (Fvertical_motion, 3);
+EXFUN (Fwiden, 1);
+
+
+extern Lisp_Object Q_style, Qactually_requested, Qactivate_menubar_hook;
+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 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_property_list, Qcoding_system_error;
+extern Lisp_Object Qcoding_system_p, 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 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 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 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 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 Qlist, Qlistp, Qload, Qlock_shift, Qmacro, Qmagic;
+extern Lisp_Object Qmalformed_property_list, 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 Qnil, 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 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 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, Qself_insert_command;
+extern Lisp_Object Qsequencep, Qsetting_constant, 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;
+extern Lisp_Object Qsubwindow_image_instance_p, Qsymbol, Qsyntax, Qt, 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 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, 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 Vcharset_ascii, Vcharset_composite, Vcharset_control_1;
+extern Lisp_Object Vcoding_system_for_read, Vcoding_system_for_write;
+extern Lisp_Object Vcoding_system_hashtable, Vcommand_history;
+extern Lisp_Object Vcommand_line_args, Vconfigure_info_directory;
+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 Vecho_area_buffer, Vemacs_major_version;
+extern Lisp_Object Vemacs_minor_version, Vexec_directory, Vexec_path;
+extern Lisp_Object Vexecuting_macro, Vfeatures, Vfile_domain;
+extern Lisp_Object Vfile_name_coding_system, Vinhibit_quit;
+extern Lisp_Object Vinvocation_directory, Vinvocation_name;
+extern Lisp_Object Vkeyboard_coding_system, Vlast_command, Vlast_command_char;
+extern Lisp_Object Vlast_command_event, Vlast_input_event;
+extern Lisp_Object Vload_file_name_internal;
+extern Lisp_Object Vload_file_name_internal_the_purecopy, Vload_history;
+extern Lisp_Object Vload_path, Vmark_even_if_inactive, Vmenubar_configuration;
+extern Lisp_Object Vminibuf_preprompt, Vminibuf_prompt, Vminibuffer_zero;
+extern Lisp_Object Vmirror_ascii_canon_table, Vmirror_ascii_downcase_table;
+extern Lisp_Object Vmirror_ascii_eqv_table, Vmirror_ascii_upcase_table;
+extern Lisp_Object 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 Vrecent_keys_ring, Vshell_file_name, Vsite_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;
+
+
+#endif /* _XEMACS_LISP_H_ */
--- /dev/null
+/* Lisp parsing and input streams.
+ Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc.
+ Copyright (C) 1995 Tinker Systems.
+ Copyright (C) 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: Mule 2.0, FSF 19.30. */
+
+/* This file has been Mule-ized. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "bytecode.h"
+#include "commands.h"
+#include "insdel.h"
+#include "lstream.h"
+#include "opaque.h"
+#include <paths.h>
+#ifdef FILE_CODING
+#include "file-coding.h"
+#endif
+
+#include "sysfile.h"
+
+#ifdef LISP_FLOAT_TYPE
+#define THIS_FILENAME lread
+#include "sysfloat.h"
+#endif /* LISP_FLOAT_TYPE */
+
+Lisp_Object Qread_char, Qstandard_input;
+Lisp_Object Qvariable_documentation;
+#define LISP_BACKQUOTES
+#ifdef LISP_BACKQUOTES
+/*
+ Nonzero means inside a new-style backquote
+ with no surrounding parentheses.
+ Fread initializes this to zero, so we need not specbind it
+ or worry about what happens to it when there is an error.
+
+XEmacs:
+ Nested backquotes are perfectly legal and fail utterly with
+ this silliness. */
+static int new_backquote_flag, old_backquote_flag;
+Lisp_Object Qbackquote, Qbacktick, Qcomma, Qcomma_at, Qcomma_dot;
+#endif
+Lisp_Object Qvariable_domain; /* I18N3 */
+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;
+
+/* See read_escape() for an explanation of this. */
+#if 0
+int fail_on_bucky_bit_character_escapes;
+#endif
+
+/* This symbol is also used in fns.c */
+#define FEATUREP_SYNTAX
+
+#ifdef FEATUREP_SYNTAX
+Lisp_Object Qfeaturep;
+#endif
+
+/* non-zero if inside `load' */
+int load_in_progress;
+
+/* Whether Fload_internal() should check whether the .el is newer
+ when loading .elc */
+int load_warn_when_source_newer;
+/* Whether Fload_internal() should check whether the .elc doesn't exist */
+int load_warn_when_source_only;
+/* Whether Fload_internal() should ignore .elc files when no suffix is given */
+int load_ignore_elc_files;
+
+/* Directory in which the sources were found. */
+Lisp_Object Vsource_directory;
+
+/* Search path for files to be loaded. */
+Lisp_Object Vload_path;
+
+/* Search path for files when dumping. */
+/* Lisp_Object Vdump_load_path; */
+
+/* This is the user-visible association list that maps features to
+ lists of defs in their load files. */
+Lisp_Object Vload_history;
+
+/* This is used to build the load history. */
+Lisp_Object Vcurrent_load_list;
+
+/* Name of file actually being read by `load'. */
+Lisp_Object Vload_file_name;
+
+/* Same as Vload_file_name but not Lisp-accessible. This ensures that
+ our #$ checks are reliable. */
+Lisp_Object Vload_file_name_internal;
+
+Lisp_Object Vload_file_name_internal_the_purecopy;
+
+/* Function to use for reading, in `load' and friends. */
+Lisp_Object Vload_read_function;
+
+/* The association list of objects read with the #n=object form.
+ 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;
+
+/* Nonzero means load should forcibly load all dynamic doc strings. */
+/* Note that this always happens (with some special behavior) when
+ purify_flag is set. */
+static int load_force_doc_strings;
+
+/* List of descriptors now open for Fload_internal. */
+static Lisp_Object Vload_descriptor_list;
+
+/* In order to implement "load_force_doc_strings", we keep
+ a list of all the compiled-function objects and such
+ that we have created in the process of loading this file.
+ See the rant below.
+
+ We specbind this just like Vload_file_name, so there's no
+ problems with recursive loading. */
+static Lisp_Object Vload_force_doc_string_list;
+
+/* A resizing-buffer stream used to temporarily hold data while reading */
+static Lisp_Object Vread_buffer_stream;
+
+#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+Lisp_Object Vcurrent_compiled_function_annotation;
+#endif
+
+static int load_byte_code_version;
+
+/* An array describing all known built-in structure types */
+static structure_type_dynarr *the_structure_type_dynarr;
+
+#if 0 /* FSF defun hack */
+/* When nonzero, read conses in pure space */
+static int read_pure;
+#endif
+
+#if 0 /* FSF stuff */
+/* For use within read-from-string (this reader is non-reentrant!!) */
+static int read_from_string_index;
+static int read_from_string_limit;
+#endif
+
+#if 0 /* More FSF implementation kludges. */
+/* In order to implement load-force-doc-string, FSF saves the
+ #@-quoted string when it's seen, and goes back and retrieves
+ it later.
+
+ This approach is not only kludgy, but it in general won't work
+ correctly because there's no stack of remembered #@-quoted-strings
+ and those strings don't generally appear in the file in the same
+ order as their #$ references. (Yes, that is amazingly stupid too.
+
+ It would be trivially easy to always encode the #@ string
+ [which is a comment, anyway] in the middle of the (#$ . INT) cons
+ reference. That way, it would be really easy to implement
+ load-force-doc-string in a non-kludgy way by just retrieving the
+ string immediately, because it's delivered on a silver platter.)
+
+ And finally, this stupid approach doesn't work under Mule, or
+ under MS-DOS or Windows NT, or under VMS, or any other place
+ where you either can't do an ftell() or don't get back a byte
+ count.
+
+ Oh, and one more lossage in this approach: If you attempt to
+ dump any ELC files that were compiled with `byte-compile-dynamic'
+ (as opposed to just `byte-compile-dynamic-docstring'), you
+ get hosed. FMH! (as the illustrious JWZ was prone to utter)
+
+ The approach we use is clean, solves all of these problems, and is
+ probably easier to implement anyway. We just save a list of all
+ the containing objects that have (#$ . INT) conses in them (this
+ will only be compiled-function objects and lists), and when the
+ file is finished loading, we go through and fill in all the
+ doc strings at once. */
+
+ /* This contains the last string skipped with #@. */
+static char *saved_doc_string;
+/* Length of buffer allocated in saved_doc_string. */
+static int saved_doc_string_size;
+/* Length of actual data in saved_doc_string. */
+static int saved_doc_string_length;
+/* This is the file position that string came from. */
+static int saved_doc_string_position;
+#endif
+
+EXFUN (Fread_from_string, 3);
+
+/* When errors are signaled, the actual readcharfun should not be used
+ as an argument if it is an lstream, so that lstreams don't escape
+ to the Lisp level. */
+#define READCHARFUN_MAYBE(x) (LSTREAMP (x) \
+ ? (build_string ("internal input stream")) \
+ : (x))
+\f
+
+static DOESNT_RETURN
+syntax_error (CONST char *string)
+{
+ signal_error (Qinvalid_read_syntax,
+ list1 (build_translated_string (string)));
+}
+
+static Lisp_Object
+continuable_syntax_error (CONST char *string)
+{
+ return Fsignal (Qinvalid_read_syntax,
+ list1 (build_translated_string (string)));
+}
+
+\f
+/* Handle unreading and rereading of characters. */
+static Emchar
+readchar (Lisp_Object readcharfun)
+{
+ /* This function can GC */
+
+ if (BUFFERP (readcharfun))
+ {
+ Emchar c;
+ struct buffer *b = XBUFFER (readcharfun);
+
+ if (!BUFFER_LIVE_P (b))
+ error ("Reading from killed buffer");
+
+ if (BUF_PT (b) >= BUF_ZV (b))
+ return -1;
+ c = BUF_FETCH_CHAR (b, BUF_PT (b));
+ BUF_SET_PT (b, BUF_PT (b) + 1);
+
+ return c;
+ }
+ else if (LSTREAMP (readcharfun))
+ {
+ Emchar c = Lstream_get_emchar (XLSTREAM (readcharfun));
+#ifdef DEBUG_XEMACS /* testing Mule */
+ static int testing_mule = 0; /* Change via debugger */
+ if (testing_mule) {
+ if (c >= 0x20 && c <= 0x7E) fprintf (stderr, "%c", c);
+ else if (c == '\n') fprintf (stderr, "\\n\n");
+ else fprintf (stderr, "\\%o ", c);
+ }
+#endif
+ return c;
+ }
+ else if (MARKERP (readcharfun))
+ {
+ Emchar c;
+ Bufpos mpos = marker_position (readcharfun);
+ struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
+
+ if (mpos >= BUF_ZV (inbuffer))
+ return -1;
+ c = BUF_FETCH_CHAR (inbuffer, mpos);
+ set_marker_position (readcharfun, mpos + 1);
+ return c;
+ }
+ else
+ {
+ Lisp_Object tem = call0 (readcharfun);
+
+ if (!CHAR_OR_CHAR_INTP (tem))
+ return -1;
+ return XCHAR_OR_CHAR_INT (tem);
+ }
+}
+
+/* Unread the character C in the way appropriate for the stream READCHARFUN.
+ If the stream is a user function, call it with the char as argument. */
+
+static void
+unreadchar (Lisp_Object readcharfun, Emchar c)
+{
+ if (c == -1)
+ /* Don't back up the pointer if we're unreading the end-of-input mark,
+ since readchar didn't advance it when we read it. */
+ ;
+ else if (BUFFERP (readcharfun))
+ BUF_SET_PT (XBUFFER (readcharfun), BUF_PT (XBUFFER (readcharfun)) - 1);
+ else if (LSTREAMP (readcharfun))
+ {
+ Lstream_unget_emchar (XLSTREAM (readcharfun), c);
+#ifdef DEBUG_XEMACS /* testing Mule */
+ {
+ static int testing_mule = 0; /* Set this using debugger */
+ if (testing_mule)
+ fprintf (stderr,
+ (c >= 0x20 && c <= 0x7E) ? "UU%c" :
+ ((c == '\n') ? "UU\\n\n" : "UU\\%o"), c);
+ }
+#endif
+ }
+ else if (MARKERP (readcharfun))
+ set_marker_position (readcharfun, marker_position (readcharfun) - 1);
+ else
+ call1 (readcharfun, make_char (c));
+}
+
+static Lisp_Object read0 (Lisp_Object readcharfun);
+static Lisp_Object read1 (Lisp_Object readcharfun);
+/* allow_dotted_lists means that something like (foo bar . baz)
+ is acceptable. If -1, means check for starting with defun
+ and make structure pure. (not implemented, probably for very
+ good reasons)
+*/
+/*
+ If check_for_doc_references, look for (#$ . INT) doc references
+ in the list and record if load_force_doc_strings is non-zero.
+ (Such doc references will be destroyed during the loadup phase
+ by replacing with Qzero, because Snarf-documentation will fill
+ them in again.)
+
+ WARNING: If you set this, you sure as hell better not call
+ free_list() on the returned list here. */
+
+static Lisp_Object read_list (Lisp_Object readcharfun,
+ Emchar terminator,
+ int allow_dotted_lists,
+ int check_for_doc_references);
+\f
+static void readevalloop (Lisp_Object readcharfun,
+ Lisp_Object sourcefile,
+ Lisp_Object (*evalfun) (Lisp_Object),
+ int printflag);
+
+static Lisp_Object
+load_unwind (Lisp_Object stream) /* used as unwind-protect function in load */
+{
+ Lstream_close (XLSTREAM (stream));
+ if (--load_in_progress < 0)
+ load_in_progress = 0;
+ return Qnil;
+}
+
+static Lisp_Object
+load_descriptor_unwind (Lisp_Object oldlist)
+{
+ Vload_descriptor_list = oldlist;
+ return Qnil;
+}
+
+static Lisp_Object
+load_file_name_internal_unwind (Lisp_Object oldval)
+{
+ Vload_file_name_internal = oldval;
+ return Qnil;
+}
+
+static Lisp_Object
+load_file_name_internal_the_purecopy_unwind (Lisp_Object oldval)
+{
+ Vload_file_name_internal_the_purecopy = oldval;
+ return Qnil;
+}
+
+static Lisp_Object
+load_byte_code_version_unwind (Lisp_Object oldval)
+{
+ load_byte_code_version = XINT (oldval);
+ return Qnil;
+}
+
+/* The plague is coming.
+
+ Ring around the rosy, pocket full of posy,
+ Ashes ashes, they all fall down.
+ */
+void
+ebolify_bytecode_constants (Lisp_Object vector)
+{
+ int len = XVECTOR_LENGTH (vector);
+ int i;
+
+ for (i = 0; i < len; i++)
+ {
+ Lisp_Object el = XVECTOR_DATA (vector)[i];
+
+ /* We don't check for `eq', `equal', and the others that have
+ bytecode opcodes. This might lose if someone passes #'eq or
+ something to `funcall', but who would really do that? As
+ they say in law, we've made a "good-faith effort" to
+ unfuckify ourselves. And doing it this way avoids screwing
+ up args to `make-hashtable' and such. As it is, we have to
+ add an extra Ebola check in decode_weak_list_type(). --ben */
+ if (EQ (el, Qassoc))
+ el = Qold_assoc;
+ if (EQ (el, Qdelq))
+ el = Qold_delq;
+#if 0
+ /* I think this is a bad idea because it will probably mess
+ with keymap code. */
+ if (EQ (el, Qdelete))
+ el = Qold_delete;
+#endif
+ if (EQ (el, Qrassq))
+ el = Qold_rassq;
+ if (EQ (el, Qrassoc))
+ el = Qold_rassoc;
+ XVECTOR_DATA (vector)[i] = el;
+ }
+}
+
+static Lisp_Object
+pas_de_lache_ici (int fd, Lisp_Object victim)
+{
+ Lisp_Object tem;
+ EMACS_INT pos;
+
+ if (!INTP (XCDR (victim)))
+ signal_simple_error ("Bogus doc string reference", victim);
+ pos = XINT (XCDR (victim));
+ if (pos < 0)
+ pos = -pos; /* kludge to mark a user variable */
+ tem = unparesseuxify_doc_string (fd, pos, 0, Vload_file_name_internal);
+ if (!STRINGP (tem))
+ signal_error (Qerror, tem);
+ return tem;
+}
+
+static Lisp_Object
+load_force_doc_string_unwind (Lisp_Object oldlist)
+{
+ struct gcpro gcpro1;
+ 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. */
+ Vload_force_doc_string_list = oldlist;
+
+ LIST_LOOP (tail, list)
+ {
+ Lisp_Object john = Fcar (tail);
+ if (CONSP (john))
+ {
+ assert (CONSP (XCAR (john)));
+ assert (!purify_flag); /* should have been handled in read_list() */
+ XCAR (john) = pas_de_lache_ici (fd, XCAR (john));
+ }
+ else
+ {
+ Lisp_Object doc;
+
+ assert (COMPILED_FUNCTIONP (john));
+ if (CONSP (XCOMPILED_FUNCTION (john)->bytecodes))
+ {
+ struct gcpro ngcpro1;
+ Lisp_Object juan = (pas_de_lache_ici
+ (fd, XCOMPILED_FUNCTION (john)->bytecodes));
+ Lisp_Object ivan;
+
+ NGCPRO1 (juan);
+ ivan = Fread (juan);
+ if (!CONSP (ivan))
+ signal_simple_error ("invalid lazy-loaded byte code", ivan);
+ /* Remember to purecopy; see above. */
+ XCOMPILED_FUNCTION (john)->bytecodes = Fpurecopy (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));
+ NUNGCPRO;
+ }
+ doc = compiled_function_documentation (XCOMPILED_FUNCTION (john));
+ if (CONSP (doc))
+ {
+ assert (!purify_flag); /* should have been handled in
+ read_compiled_function() */
+ doc = pas_de_lache_ici (fd, doc);
+ set_compiled_function_documentation (XCOMPILED_FUNCTION (john),
+ doc);
+ }
+ }
+ }
+
+ if (!NILP (list))
+ free_list (list);
+
+ UNGCPRO;
+ return Qnil;
+}
+
+/* Close all descriptors in use for Fload_internal.
+ This is used when starting a subprocess. */
+
+void
+close_load_descs (void)
+{
+ Lisp_Object tail;
+ LIST_LOOP (tail, Vload_descriptor_list)
+ close (XINT (XCAR (tail)));
+}
+
+#ifdef I18N3
+Lisp_Object Vfile_domain;
+
+Lisp_Object
+restore_file_domain (Lisp_Object val)
+{
+ Vfile_domain = val;
+ return Qnil;
+}
+#endif /* I18N3 */
+
+DEFUN ("load-internal", Fload_internal, 1, 6, 0, /*
+Execute a file of Lisp code named FILE; no coding-system frobbing.
+This function is identical to `load' except for the handling of the
+CODESYS and USED-CODESYS arguments under XEmacs/Mule. (When Mule
+support is not present, both functions are identical and ignore the
+CODESYS and USED-CODESYS arguments.)
+
+If support for Mule exists in this Emacs, the file is decoded
+according to CODESYS; if omitted, no conversion happens. If
+USED-CODESYS is non-nil, it should be a symbol, and the actual coding
+system that was used for the decoding is stored into it. It will in
+general be different from CODESYS if CODESYS specifies automatic
+encoding detection or end-of-line detection.
+*/
+ (file, no_error, nomessage, nosuffix, codesys, used_codesys))
+{
+ /* This function can GC */
+ int fd = -1;
+ int speccount = specpdl_depth ();
+ int source_only = 0;
+ Lisp_Object newer = Qnil;
+ Lisp_Object handler = Qnil;
+ Lisp_Object found = Qnil;
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ int reading_elc = 0;
+ 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);
+
+ CHECK_STRING (file);
+
+/*#ifdef DEBUG_XEMACS*/
+ if (purify_flag && noninteractive)
+ {
+ message_p = 1;
+ last_file_loaded = file;
+ pure_usage = purespace_usage ();
+ }
+/*#endif / * DEBUG_XEMACS */
+
+ /* If file name is magic, call the handler. */
+ handler = Ffind_file_name_handler (file, Qload);
+ if (!NILP (handler))
+ RETURN_UNGCPRO (call5 (handler, Qload, file, no_error,
+ nomessage, nosuffix));
+
+ /* Do this after the handler to avoid
+ the need to gcpro noerror, nomessage and nosuffix.
+ (Below here, we care only whether they are nil or not.) */
+ file = Fsubstitute_in_file_name (file);
+#ifdef FILE_CODING
+ if (!NILP (used_codesys))
+ CHECK_SYMBOL (used_codesys);
+#endif
+
+ /* Avoid weird lossage with null string as arg,
+ since it would try to load a directory as a Lisp file.
+ Unix truly sucks. */
+ if (XSTRING_LENGTH (file) > 0)
+ {
+ char *foundstr;
+ int foundlen;
+
+ fd = locate_file (Vload_path, file,
+ ((!NILP (nosuffix)) ? "" :
+ load_ignore_elc_files ? ".el:" :
+ ".elc:.el:"),
+ &found,
+ -1);
+
+ if (fd < 0)
+ {
+ if (NILP (no_error))
+ signal_file_error ("Cannot open load file", file);
+ else
+ {
+ UNGCPRO;
+ return Qnil;
+ }
+ }
+
+ foundstr = (char *) alloca (XSTRING_LENGTH (found) + 1);
+ strcpy (foundstr, (char *) XSTRING_DATA (found));
+ foundlen = strlen (foundstr);
+
+ /* The omniscient JWZ thinks this is worthless, but I beg to
+ differ. --ben */
+ if (load_ignore_elc_files)
+ {
+ newer = Ffile_name_nondirectory (found);
+ }
+ else if (load_warn_when_source_newer &&
+ !memcmp (".elc", foundstr + foundlen - 4, 4))
+ {
+ if (! fstat (fd, &s1)) /* can't fail, right? */
+ {
+ int result;
+ /* temporarily hack the 'c' off the end of the filename */
+ foundstr[foundlen - 1] = '\0';
+ result = stat (foundstr, &s2);
+ if (result >= 0 &&
+ (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
+ {
+ Lisp_Object newer_name = make_string ((Bufbyte *) foundstr,
+ foundlen - 1);
+ struct gcpro nngcpro1;
+ NNGCPRO1 (newer_name);
+ newer = Ffile_name_nondirectory (newer_name);
+ NNUNGCPRO;
+ }
+ /* put the 'c' back on (kludge-o-rama) */
+ foundstr[foundlen - 1] = 'c';
+ }
+ }
+ else if (load_warn_when_source_only &&
+ /* `found' ends in ".el" */
+ !memcmp (".el", foundstr + foundlen - 3, 3) &&
+ /* `file' does not end in ".el" */
+ memcmp (".el",
+ XSTRING_DATA (file) + XSTRING_LENGTH (file) - 3,
+ 3))
+ {
+ source_only = 1;
+ }
+
+ if (!memcmp (".elc", foundstr + foundlen - 4, 4))
+ reading_elc = 1;
+ }
+
+#define PRINT_LOADING_MESSAGE(done) do { \
+ if (load_ignore_elc_files) \
+ { \
+ if (message_p) \
+ message ("Loading %s..." done, XSTRING_DATA (newer)); \
+ } \
+ else if (!NILP (newer)) \
+ message ("Loading %s..." done " (file %s is newer)", \
+ XSTRING_DATA (file), \
+ XSTRING_DATA (newer)); \
+ else if (source_only) \
+ message ("Loading %s..." done " (file %s.elc does not exist)", \
+ XSTRING_DATA (file), \
+ XSTRING_DATA (Ffile_name_nondirectory (file))); \
+ else if (message_p) \
+ message ("Loading %s..." done, XSTRING_DATA (file)); \
+ } while (0)
+
+ PRINT_LOADING_MESSAGE ("");
+
+ {
+ /* Lisp_Object's must be malloc'ed, not stack-allocated */
+ Lisp_Object lispstream = Qnil;
+ CONST int block_size = 8192;
+ struct gcpro ngcpro1;
+
+ NGCPRO1 (lispstream);
+ lispstream = make_filedesc_input_stream (fd, 0, -1, LSTR_CLOSING);
+ /* 64K is used for normal files; 8K should be OK here because Lisp
+ files aren't really all that big. */
+ Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
+ block_size);
+#ifdef FILE_CODING
+ lispstream = make_decoding_input_stream
+ (XLSTREAM (lispstream), Fget_coding_system (codesys));
+ Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
+ block_size);
+#endif
+ /* NOTE: Order of these is very important. Don't rearrange them. */
+ record_unwind_protect (load_unwind, lispstream);
+ record_unwind_protect (load_descriptor_unwind, Vload_descriptor_list);
+ record_unwind_protect (load_file_name_internal_unwind,
+ Vload_file_name_internal);
+ record_unwind_protect (load_file_name_internal_the_purecopy_unwind,
+ Vload_file_name_internal_the_purecopy);
+ record_unwind_protect (load_force_doc_string_unwind,
+ Vload_force_doc_string_list);
+ Vload_file_name_internal = found;
+ Vload_file_name_internal_the_purecopy = Qnil;
+ specbind (Qload_file_name, found);
+ Vload_descriptor_list = Fcons (make_int (fd), Vload_descriptor_list);
+ Vload_force_doc_string_list = Qnil;
+#ifdef I18N3
+ record_unwind_protect (restore_file_domain, Vfile_domain);
+ Vfile_domain = Qnil; /* set it to nil; a call to #'domain will set it. */
+#endif
+ load_in_progress++;
+
+ /* Now determine what sort of ELC file we're reading in. */
+ record_unwind_protect (load_byte_code_version_unwind,
+ make_int (load_byte_code_version));
+ if (reading_elc)
+ {
+ char elc_header[8];
+ int num_read;
+
+ num_read = Lstream_read (XLSTREAM (lispstream), elc_header, 8);
+ if (num_read < 8
+ || strncmp (elc_header, ";ELC", 4))
+ {
+ /* Huh? Probably not a valid ELC file. */
+ load_byte_code_version = 100; /* no Ebolification needed */
+ Lstream_unread (XLSTREAM (lispstream), elc_header, num_read);
+ }
+ else
+ load_byte_code_version = elc_header[4];
+ }
+ else
+ load_byte_code_version = 100; /* no Ebolification needed */
+
+ readevalloop (lispstream, file, Feval, 0);
+#ifdef FILE_CODING
+ if (!NILP (used_codesys))
+ Fset (used_codesys,
+ XCODING_SYSTEM_NAME
+ (decoding_stream_coding_system (XLSTREAM (lispstream))));
+#endif
+ unbind_to (speccount, Qnil);
+
+ NUNGCPRO;
+ }
+
+ {
+ Lisp_Object tem;
+ /* #### Disgusting kludge */
+ /* Run any load-hooks for this file. */
+ /* #### An even more disgusting kludge. There is horrible code */
+ /* that is relying on the fact that dumped lisp files are found */
+ /* via `load-path' search. */
+ Lisp_Object name = file;
+
+ if (!NILP(Ffile_name_absolute_p(file)))
+ {
+ name = Ffile_name_nondirectory(file);
+ }
+
+ {
+ struct gcpro ngcpro1;
+
+ NGCPRO1 (name);
+ tem = Fassoc (name, Vafter_load_alist);
+ NUNGCPRO;
+ }
+ if (!NILP (tem))
+ {
+ struct gcpro ngcpro1;
+
+ NGCPRO1 (tem);
+ /* Use eval so that errors give a semi-meaningful backtrace. --Stig */
+ tem = Fcons (Qprogn, Fcdr (tem));
+ Feval (tem);
+ NUNGCPRO;
+ }
+ }
+
+/*#ifdef DEBUG_XEMACS*/
+ if (purify_flag && noninteractive)
+ {
+ if (EQ (last_file_loaded, file))
+ message_append (" (%d)", purespace_usage() - pure_usage);
+ else
+ message ("Loading %s ...done (%d)", XSTRING_DATA (file),
+ purespace_usage() - pure_usage);
+ }
+/*#endif / * DEBUG_XEMACS */
+
+ if (!noninteractive)
+ PRINT_LOADING_MESSAGE ("done");
+
+ UNGCPRO;
+ return Qt;
+}
+
+\f
+#if 0 /* FSFmacs */
+/* not used */
+static int
+complete_filename_p (Lisp_Object pathname)
+{
+ 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
+ );
+}
+#endif /* 0 */
+
+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.
+
+`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
+the face of a changing and unpredictable environment, but can occasionally
+get tripped up. In this case, you will have to call
+`locate-file-clear-hashing' to get it back on track. See that function
+for details.
+*/
+ (filename, path_list, suffixes, mode))
+{
+ /* This function can GC */
+ Lisp_Object tp;
+
+ CHECK_STRING (filename);
+ if (!NILP (suffixes))
+ 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)));
+ return tp;
+}
+
+/* recalculate the hash table for the given string */
+
+static Lisp_Object
+locate_file_refresh_hashing (Lisp_Object str)
+{
+ Lisp_Object hash =
+ make_directory_hash_table ((char *) XSTRING_DATA (str));
+ Fput (str, Qlocate_file_hash_table, hash);
+ 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)
+{
+ Lisp_Object hash = Fget (str, Qlocate_file_hash_table, Qnil);
+ if (NILP (Fhashtablep (hash)))
+ return locate_file_refresh_hashing (str);
+ return hash;
+}
+
+/* look for STR in PATH, optionally adding suffixes in SUFFIX */
+
+static int
+locate_file_in_directory (Lisp_Object path, Lisp_Object str,
+ CONST char *suffix, 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;
+ Lisp_Object filename = Qnil;
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ CONST char *nsuffix;
+
+ GCPRO3 (path, str, filename);
+
+ filename = Fexpand_file_name (str, path);
+ 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
+ default-directory to be something non-absolute ... */
+ {
+ if (NILP (filename))
+ /* NIL means current dirctory */
+ filename = current_buffer->directory;
+ else
+ filename = Fexpand_file_name (filename,
+ current_buffer->directory);
+ if (NILP (Ffile_name_absolute_p (filename)))
+ {
+ /* Give up on this path element! */
+ 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;
+ }
+
+ UNGCPRO;
+ return -1;
+}
+
+/* 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,
+ 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 val = locate_file_in_directory (Fcar (path), str, suffix,
+ storeptr, mode);
+ if (val >= 0)
+ {
+ UNGCPRO;
+ return val;
+ }
+ if (absolute)
+ break;
+ }
+
+ UNGCPRO;
+ return -1;
+}
+
+/* Construct a list of all files to search for. */
+
+static Lisp_Object
+locate_file_construct_suffixed_files (Lisp_Object str, CONST char *suffix)
+{
+ 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);
+}
+
+DEFUN ("locate-file-clear-hashing", Flocate_file_clear_hashing, 1, 1, 0, /*
+Clear the hash records for the specified list of directories.
+`locate-file' uses a hashing scheme to speed lookup, and will correctly
+track the following environmental changes:
+
+-- changes of any sort to the list of directories to be searched.
+-- addition and deletion of non-shadowing files (see below) from the
+ directories in the list.
+-- byte-compilation of a .el file into a .elc file.
+
+`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'.
+*/
+ (path))
+{
+ Lisp_Object pathtail;
+
+ for (pathtail = path; !NILP (pathtail); pathtail = Fcdr (pathtail))
+ {
+ Lisp_Object pathel = Fcar (pathtail);
+ if (!purified (pathel))
+ Fput (pathel, Qlocate_file_hash_table, Qnil);
+ }
+ 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.
+ On success, returns a file descriptor. On failure, returns -1.
+
+ MODE nonnegative means don't open the files,
+ just look for one for which access(file,MODE) succeeds. In this case,
+ returns 1 on success.
+
+ If STOREPTR is nonzero, it points to a slot where the name of
+ the file actually found should be stored as a Lisp string.
+ Nil is stored there on failure.
+
+ Called openp() in FSFmacs. */
+
+int
+locate_file (Lisp_Object path, Lisp_Object str, CONST char *suffix,
+ Lisp_Object *storeptr, int mode)
+{
+ /* This function can GC */
+ Lisp_Object suffixtab = Qnil;
+ Lisp_Object pathtail;
+ int val;
+ struct gcpro gcpro1, gcpro2, gcpro3;
+
+ if (storeptr)
+ *storeptr = Qnil;
+
+ /* 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);
+ Lisp_Object hashtab;
+ 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))
+ {
+ val = locate_file_in_directory (pathel, str, suffix, storeptr,
+ mode);
+ if (val >= 0)
+ {
+ UNGCPRO;
+ return val;
+ }
+ continue;
+ }
+
+ hashtab = locate_file_find_directory_hash_table (pathel);
+
+ /* Loop over suffixes. */
+ for (tail = suffixtab, found = 0; !found && CONSP (tail);
+ tail = XCDR (tail))
+ {
+ if (!NILP (Fgethash (XCAR (tail), hashtab, Qnil)))
+ found = 1;
+ }
+
+ 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,
+ mode);
+ if (val >= 0)
+ {
+ UNGCPRO;
+ return val;
+ }
+
+ /* Hmm ... the file isn't actually there. (Or possibly it's
+ a directory ...) So refresh our hashing. */
+ locate_file_refresh_hashing (pathel);
+ }
+ }
+
+ /* File is probably not there, but check the hard way just in case. */
+ val = locate_file_without_hash (path, str, suffix, storeptr,
+ mode);
+ if (val >= 0)
+ {
+ /* Sneaky user added a file without telling us. */
+ Flocate_file_clear_hashing (path);
+ }
+
+ UNGCPRO;
+ return val;
+}
+
+\f
+#ifdef LOADHIST
+
+/* Merge the list we've accumulated of globals from the current input source
+ into the load_history variable. The details depend on whether
+ the source has an associated file name or not. */
+
+static void
+build_load_history (int loading, Lisp_Object source)
+{
+ REGISTER Lisp_Object tail, prev, newelt;
+ REGISTER Lisp_Object tem, tem2;
+ int foundit;
+
+#if !defined(LOADHIST_DUMPED)
+ /* Don't bother recording anything for preloaded files. */
+ if (purify_flag)
+ return;
+#endif
+
+ tail = Vload_history;
+ prev = Qnil;
+ foundit = 0;
+ while (!NILP (tail))
+ {
+ tem = Fcar (tail);
+
+ /* Find the feature's previous assoc list... */
+ if (internal_equal (source, Fcar (tem), 0))
+ {
+ foundit = 1;
+
+ /* If we're loading, remove it. */
+ if (loading)
+ {
+ if (NILP (prev))
+ Vload_history = Fcdr (tail);
+ else
+ Fsetcdr (prev, Fcdr (tail));
+ }
+
+ /* Otherwise, cons on new symbols that are not already members. */
+ else
+ {
+ tem2 = Vcurrent_load_list;
+
+ while (CONSP (tem2))
+ {
+ newelt = XCAR (tem2);
+
+ if (NILP (Fmemq (newelt, tem)))
+ Fsetcar (tail, Fcons (Fcar (tem),
+ Fcons (newelt, Fcdr (tem))));
+
+ tem2 = XCDR (tem2);
+ QUIT;
+ }
+ }
+ }
+ else
+ prev = tail;
+ tail = Fcdr (tail);
+ QUIT;
+ }
+
+ /* If we're loading, cons the new assoc onto the front of load-history,
+ the most-recently-loaded position. Also do this if we didn't find
+ an existing member for the current source. */
+ if (loading || !foundit)
+ Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
+ Vload_history);
+}
+
+#else /* !LOADHIST */
+#define build_load_history(x,y)
+#endif /* !LOADHIST */
+
+\f
+#if 0 /* FSFmacs defun hack */
+Lisp_Object
+unreadpure (void) /* Used as unwind-protect function in readevalloop */
+{
+ read_pure = 0;
+ return Qnil;
+}
+#endif /* 0 */
+
+static void
+readevalloop (Lisp_Object readcharfun,
+ Lisp_Object sourcename,
+ Lisp_Object (*evalfun) (Lisp_Object),
+ int printflag)
+{
+ /* This function can GC */
+ REGISTER Emchar c;
+ REGISTER Lisp_Object val;
+ int speccount = specpdl_depth ();
+ struct gcpro gcpro1;
+ struct buffer *b = 0;
+
+ if (BUFFERP (readcharfun))
+ b = XBUFFER (readcharfun);
+ else if (MARKERP (readcharfun))
+ b = XMARKER (readcharfun)->buffer;
+
+ /* Don't do this. It is not necessary, and it needlessly exposes
+ READCHARFUN (which can be a stream) to Lisp. --hniksic */
+ /*specbind (Qstandard_input, readcharfun);*/
+
+ specbind (Qcurrent_load_list, Qnil);
+
+#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+ Vcurrent_compiled_function_annotation = Qnil;
+#endif
+ GCPRO1 (sourcename);
+
+ LOADHIST_ATTACH (sourcename);
+
+ while (1)
+ {
+ QUIT;
+
+ if (b != 0 && !BUFFER_LIVE_P (b))
+ error ("Reading from killed buffer");
+
+ c = readchar (readcharfun);
+ if (c == ';')
+ {
+ /* Skip comment */
+ while ((c = readchar (readcharfun)) != '\n' && c != -1)
+ QUIT;
+ continue;
+ }
+ if (c < 0)
+ break;
+
+ /* Ignore whitespace here, so we can detect eof. */
+ if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r')
+ continue;
+
+#if 0 /* FSFmacs defun hack */
+ if (purify_flag && c == '(')
+ {
+ int count1 = specpdl_depth ();
+ record_unwind_protect (unreadpure, Qnil);
+ val = read_list (readcharfun, ')', -1, 1);
+ unbind_to (count1, Qnil);
+ }
+ else
+#else /* No "defun hack" -- Emacs 19 uses read-time syntax for bytecodes */
+ {
+ unreadchar (readcharfun, c);
+ read_objects = Qnil;
+ if (NILP (Vload_read_function))
+ val = read0 (readcharfun);
+ else
+ val = call1 (Vload_read_function, readcharfun);
+ }
+#endif
+ val = (*evalfun) (val);
+ if (printflag)
+ {
+ Vvalues = Fcons (val, Vvalues);
+ if (EQ (Vstandard_output, Qt))
+ Fprin1 (val, Qnil);
+ else
+ Fprint (val, Qnil);
+ }
+ }
+
+ build_load_history (LSTREAMP (readcharfun) ||
+ /* This looks weird, but it's what's in FSFmacs */
+ (b ? BUF_NARROWED (b) : BUF_NARROWED (current_buffer)),
+ sourcename);
+ UNGCPRO;
+
+ unbind_to (speccount, Qnil);
+}
+
+DEFUN ("eval-buffer", Feval_buffer, 0, 2, "bBuffer: ", /*
+Execute BUFFER as Lisp code.
+Programs can pass two arguments, BUFFER and PRINTFLAG.
+BUFFER is the buffer to evaluate (nil means use current buffer).
+PRINTFLAG controls printing of output:
+nil means discard it; anything else is stream for print.
+
+If there is no error, point does not move. If there is an error,
+point remains at the end of the last character read from the buffer.
+Execute BUFFER as Lisp code.
+*/
+ (bufname, printflag))
+{
+ /* This function can GC */
+ int speccount = specpdl_depth ();
+ Lisp_Object tem, buf;
+
+ if (NILP (bufname))
+ buf = Fcurrent_buffer ();
+ else
+ buf = Fget_buffer (bufname);
+ if (NILP (buf))
+ error ("No such buffer.");
+
+ if (NILP (printflag))
+ tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
+ else
+ tem = printflag;
+ specbind (Qstandard_output, tem);
+ record_unwind_protect (save_excursion_restore, save_excursion_save ());
+ BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
+ readevalloop (buf, XBUFFER (buf)->filename, Feval,
+ !NILP (printflag));
+
+ return unbind_to (speccount, Qnil);
+}
+
+#if 0
+xxDEFUN ("eval-current-buffer", Feval_current_buffer, 0, 1, "", /*
+Execute the current buffer as Lisp code.
+Programs can pass argument PRINTFLAG which controls printing of output:
+nil means discard it; anything else is stream for print.
+
+If there is no error, point does not move. If there is an error,
+point remains at the end of the last character read from the buffer.
+*/
+ (printflag))
+{
+ code omitted;
+}
+#endif /* 0 */
+
+DEFUN ("eval-region", Feval_region, 2, 3, "r", /*
+Execute the region as Lisp code.
+When called from programs, expects two arguments,
+giving starting and ending indices in the current buffer
+of the text to be executed.
+Programs can pass third argument PRINTFLAG which controls output:
+nil means discard it; anything else is stream for printing it.
+
+If there is no error, point does not move. If there is an error,
+point remains at the end of the last character read from the buffer.
+
+Note: Before evaling the region, this function narrows the buffer to it.
+If the code being eval'd should happen to trigger a redisplay you may
+see some text temporarily disappear because of this.
+*/
+ (b, e, printflag))
+{
+ /* This function can GC */
+ int speccount = specpdl_depth ();
+ Lisp_Object tem;
+ Lisp_Object cbuf = Fcurrent_buffer ();
+
+ if (NILP (printflag))
+ tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
+ else
+ tem = printflag;
+ specbind (Qstandard_output, tem);
+
+ if (NILP (printflag))
+ record_unwind_protect (save_excursion_restore, save_excursion_save ());
+ record_unwind_protect (save_restriction_restore, save_restriction_save ());
+
+ /* This both uses b and checks its type. */
+ Fgoto_char (b, cbuf);
+ Fnarrow_to_region (make_int (BUF_BEGV (current_buffer)), e, cbuf);
+ readevalloop (cbuf, XBUFFER (cbuf)->filename, Feval,
+ !NILP (printflag));
+
+ return unbind_to (speccount, Qnil);
+}
+\f
+DEFUN ("read", Fread, 0, 1, 0, /*
+Read one Lisp expression as text from STREAM, return as Lisp object.
+If STREAM is nil, use the value of `standard-input' (which see).
+STREAM or the value of `standard-input' may be:
+ a buffer (read from point and advance it)
+ a marker (read from where it points and advance it)
+ a function (call it with no arguments for each character,
+ call it with a char as argument to push a char back)
+ a string (takes text from string, starting at the beginning)
+ t (read text line using minibuffer and use it).
+*/
+ (stream))
+{
+ if (NILP (stream))
+ stream = Vstandard_input;
+ if (EQ (stream, Qt))
+ stream = Qread_char;
+
+ read_objects = Qnil;
+
+#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+ Vcurrent_compiled_function_annotation = Qnil;
+#endif
+ if (EQ (stream, Qread_char))
+ {
+ Lisp_Object val = call1 (Qread_from_minibuffer,
+ build_translated_string ("Lisp expression: "));
+ return Fcar (Fread_from_string (val, Qnil, Qnil));
+ }
+
+ if (STRINGP (stream))
+ return Fcar (Fread_from_string (stream, Qnil, Qnil));
+
+ return read0 (stream);
+}
+
+DEFUN ("read-from-string", Fread_from_string, 1, 3, 0, /*
+Read one Lisp expression which is represented as text by STRING.
+Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
+START and END optionally delimit a substring of STRING from which to read;
+ they default to 0 and (length STRING) respectively.
+*/
+ (string, start, end))
+{
+ Bytecount startval, endval;
+ Lisp_Object tem;
+ Lisp_Object lispstream = Qnil;
+ struct gcpro gcpro1;
+
+#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+ Vcurrent_compiled_function_annotation = Qnil;
+#endif
+ GCPRO1 (lispstream);
+ CHECK_STRING (string);
+ get_string_range_byte (string, start, end, &startval, &endval,
+ GB_HISTORICAL_STRING_BEHAVIOR);
+ lispstream = make_lisp_string_input_stream (string, startval,
+ endval - startval);
+
+ read_objects = Qnil;
+
+ tem = read0 (lispstream);
+ /* Yeah, it's ugly. Gonna make something of it?
+ At least our reader is reentrant ... */
+ tem =
+ (Fcons (tem, make_int
+ (bytecount_to_charcount
+ (XSTRING_DATA (string),
+ startval + Lstream_byte_count (XLSTREAM (lispstream))))));
+ Lstream_delete (XLSTREAM (lispstream));
+ UNGCPRO;
+ return tem;
+}
+
+\f
+#ifdef LISP_BACKQUOTES
+
+static Lisp_Object
+backquote_unwind (Lisp_Object ptr)
+{ /* used as unwind-protect function in read0() */
+ int *counter = (int *) get_opaque_ptr (ptr);
+ if (--*counter < 0)
+ *counter = 0;
+ free_opaque_ptr (ptr);
+ return Qnil;
+}
+
+#endif
+
+/* Use this for recursive reads, in contexts where internal tokens
+ are not allowed. See also read1(). */
+static Lisp_Object
+read0 (Lisp_Object readcharfun)
+{
+ Lisp_Object val;
+
+ val = read1 (readcharfun);
+ if (CONSP (val) && UNBOUNDP (XCAR (val)))
+ {
+ Emchar c = XCHAR (XCDR (val));
+ free_cons (XCONS (val));
+ return Fsignal (Qinvalid_read_syntax,
+ list1 (Fchar_to_string (make_char (c))));
+ }
+
+ return val;
+}
+\f
+static Emchar
+read_escape (Lisp_Object readcharfun)
+{
+ /* This function can GC */
+ Emchar c = readchar (readcharfun);
+
+ if (c < 0)
+ signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
+
+ switch (c)
+ {
+ case 'a': return '\007';
+ case 'b': return '\b';
+ case 'd': return 0177;
+ case 'e': return 033;
+ case 'f': return '\f';
+ case 'n': return '\n';
+ case 'r': return '\r';
+ case 't': return '\t';
+ case 'v': return '\v';
+ case '\n': return -1;
+
+ case 'M':
+ c = readchar (readcharfun);
+ if (c < 0)
+ signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
+ if (c != '-')
+ error ("Invalid escape character syntax");
+ c = readchar (readcharfun);
+ if (c < 0)
+ signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
+ if (c == '\\')
+ c = read_escape (readcharfun);
+ return c | 0200;
+
+ /* Originally, FSF_KEYS provided a degree of FSF Emacs
+ compatibility by defining character "modifiers" alt, super,
+ hyper and shift to infest the characters (i.e. integers).
+
+ However, this doesn't cut it for XEmacs 20, which
+ distinguishes characters from integers. Without Mule, ?\H-a
+ simply returns ?a because every character is clipped into
+ 0-255. Under Mule it is much worse -- ?\H-a with FSF_KEYS
+ produces an illegal character, and moves us to crash-land.
+
+ For these reasons, FSF_KEYS hack is useless and without hope
+ of ever working under XEmacs 20. */
+#undef FSF_KEYS
+
+#ifdef FSF_KEYS
+#define alt_modifier (0x040000)
+#define super_modifier (0x080000)
+#define hyper_modifier (0x100000)
+#define shift_modifier (0x200000)
+/* fsf uses a different modifiers for meta and control. Possibly
+ byte_compiled code will still work fsfmacs, though... --Stig
+
+ #define ctl_modifier (0x400000)
+ #define meta_modifier (0x800000)
+*/
+#define FSF_LOSSAGE(mask) \
+ if (fail_on_bucky_bit_character_escapes || \
+ ((c = readchar (readcharfun)) != '-')) \
+ error ("Invalid escape character syntax"); \
+ c = readchar (readcharfun); \
+ if (c < 0) \
+ signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun))); \
+ if (c == '\\') \
+ c = read_escape (readcharfun); \
+ return c | mask
+
+ case 'S': FSF_LOSSAGE (shift_modifier);
+ case 'H': FSF_LOSSAGE (hyper_modifier);
+ case 'A': FSF_LOSSAGE (alt_modifier);
+ case 's': FSF_LOSSAGE (super_modifier);
+#undef alt_modifier
+#undef super_modifier
+#undef hyper_modifier
+#undef shift_modifier
+#undef FSF_LOSSAGE
+
+#endif /* FSF_KEYS */
+
+ case 'C':
+ c = readchar (readcharfun);
+ if (c < 0)
+ signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
+ if (c != '-')
+ error ("Invalid escape character syntax");
+ case '^':
+ c = readchar (readcharfun);
+ if (c < 0)
+ signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
+ if (c == '\\')
+ c = read_escape (readcharfun);
+ /* FSFmacs junk for non-ASCII controls.
+ Not used here. */
+ if (c == '?')
+ return 0177;
+ else
+ return c & (0200 | 037);
+
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ /* An octal escape, as in ANSI C. */
+ {
+ REGISTER Emchar i = c - '0';
+ REGISTER int count = 0;
+ while (++count < 3)
+ {
+ if ((c = readchar (readcharfun)) >= '0' && c <= '7')
+ i = (i << 3) + (c - '0');
+ else
+ {
+ unreadchar (readcharfun, c);
+ break;
+ }
+ }
+ return i;
+ }
+
+ case 'x':
+ /* A hex escape, as in ANSI C. */
+ {
+ REGISTER Emchar i = 0;
+ while (1)
+ {
+ c = readchar (readcharfun);
+ /* Remember, can't use isdigit(), isalpha() etc. on Emchars */
+ if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
+ else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
+ else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
+ else
+ {
+ unreadchar (readcharfun, c);
+ break;
+ }
+ }
+ return i;
+ }
+
+#ifdef MULE
+ /* #### need some way of reading an extended character with
+ an escape sequence. */
+#endif
+
+ default:
+ return c;
+ }
+}
+
+
+\f
+/* read symbol-constituent stuff into `Vread_buffer_stream'. */
+static Bytecount
+read_atom_0 (Lisp_Object readcharfun, Emchar firstchar, int *saw_a_backslash)
+{
+ /* This function can GC */
+ Emchar c = ((firstchar) >= 0 ? firstchar : readchar (readcharfun));
+ Lstream_rewind (XLSTREAM (Vread_buffer_stream));
+
+ *saw_a_backslash = 0;
+
+ while (c > 040 /* #### - comma should be here as should backquote */
+ && !(c == '\"' || c == '\'' || c == ';'
+ || c == '(' || c == ')'
+#ifndef LISP_FLOAT_TYPE
+ /* If we have floating-point support, then we need
+ to allow <digits><dot><digits>. */
+ || c =='.'
+#endif /* not LISP_FLOAT_TYPE */
+ || c == '[' || c == ']' || c == '#'
+ ))
+ {
+ if (c == '\\')
+ {
+ c = readchar (readcharfun);
+ if (c < 0)
+ signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
+ *saw_a_backslash = 1;
+ }
+ Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c);
+ QUIT;
+ c = readchar (readcharfun);
+ }
+
+ if (c >= 0)
+ unreadchar (readcharfun, c);
+ /* blasted terminating 0 */
+ Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), 0);
+ Lstream_flush (XLSTREAM (Vread_buffer_stream));
+
+ return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1;
+}
+
+static Lisp_Object parse_integer (CONST Bufbyte *buf, Bytecount len, int base);
+
+static Lisp_Object
+read_atom (Lisp_Object readcharfun,
+ Emchar firstchar,
+ int uninterned_symbol)
+{
+ /* This function can GC */
+ int saw_a_backslash;
+ Bytecount len = read_atom_0 (readcharfun, firstchar, &saw_a_backslash);
+ char *read_ptr = (char *)
+ resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream));
+
+ /* Is it an integer? */
+ if (! (saw_a_backslash || uninterned_symbol))
+ {
+ /* If a token had any backslashes in it, it is disqualified from
+ being an integer or a float. This means that 123\456 is a
+ symbol, as is \123 (which is the way (intern "123") prints).
+ Also, if token was preceded by #:, it's always a symbol.
+ */
+ char *p = read_ptr + len;
+ char *p1 = read_ptr;
+
+ if (*p1 == '+' || *p1 == '-') p1++;
+ if (p1 != p)
+ {
+ int c;
+
+ while (p1 != p && (c = *p1) >= '0' && c <= '9')
+ p1++;
+#ifdef LISP_FLOAT_TYPE
+ /* Integers can have trailing decimal points. */
+ if (p1 > read_ptr && p1 < p && *p1 == '.')
+ p1++;
+#endif
+ if (p1 == p)
+ {
+ /* It is an integer. */
+#ifdef LISP_FLOAT_TYPE
+ if (p1[-1] == '.')
+ p1[-1] = '\0';
+#endif
+#if 0
+ {
+ int number = 0;
+ if (sizeof (int) == sizeof (EMACS_INT))
+ number = atoi (read_buffer);
+ else if (sizeof (long) == sizeof (EMACS_INT))
+ number = atol (read_buffer);
+ else
+ abort ();
+ return make_int (number);
+ }
+#else
+ return parse_integer ((Bufbyte *) read_ptr, len, 10);
+#endif
+ }
+ }
+#ifdef LISP_FLOAT_TYPE
+ if (isfloat_string (read_ptr))
+ return make_float (atof (read_ptr));
+#endif
+ }
+
+ {
+ 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)));
+ 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;
+ }
+}
+
+
+static Lisp_Object
+parse_integer (CONST Bufbyte *buf, Bytecount len, int base)
+{
+ CONST Bufbyte *lim = buf + len;
+ CONST Bufbyte *p = buf;
+ EMACS_UINT num = 0;
+ int negativland = 0;
+
+ if (*p == '-')
+ {
+ negativland = 1;
+ p++;
+ }
+ else if (*p == '+')
+ {
+ p++;
+ }
+
+ if (p == lim)
+ goto loser;
+
+ for (; (p < lim) && (*p != '\0'); p++)
+ {
+ int c = *p;
+ EMACS_UINT onum;
+
+ if (isdigit (c))
+ c = c - '0';
+ else if (isupper (c))
+ c = c - 'A' + 10;
+ else if (islower (c))
+ c = c - 'a' + 10;
+ else
+ goto loser;
+
+ if (c < 0 || c >= base)
+ goto loser;
+
+ onum = num;
+ num = num * base + c;
+ if (num < onum)
+ goto overflow;
+ }
+
+ {
+ EMACS_INT int_result = negativland ? - (EMACS_INT) num : (EMACS_INT) num;
+ Lisp_Object result = make_int (int_result);
+ if (num && ((XINT (result) < 0) != negativland))
+ goto overflow;
+ if (XINT (result) != int_result)
+ goto overflow;
+ return result;
+ }
+ overflow:
+ return Fsignal (Qinvalid_read_syntax,
+ list3 (build_translated_string
+ ("Integer constant overflow in reader"),
+ make_string (buf, len),
+ make_int (base)));
+ loser:
+ return Fsignal (Qinvalid_read_syntax,
+ list3 (build_translated_string
+ ("Invalid integer constant in reader"),
+ make_string (buf, len),
+ make_int (base)));
+}
+
+
+static Lisp_Object
+read_integer (Lisp_Object readcharfun, int base)
+{
+ /* This function can GC */
+ int saw_a_backslash;
+ Bytecount len = read_atom_0 (readcharfun, -1, &saw_a_backslash);
+ return (parse_integer
+ (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
+ ((saw_a_backslash)
+ ? 0 /* make parse_integer signal error */
+ : len),
+ base));
+}
+
+static Lisp_Object
+read_bit_vector (Lisp_Object readcharfun)
+{
+ unsigned_char_dynarr *dyn = Dynarr_new (unsigned_char);
+ Emchar c;
+
+ while (1)
+ {
+ c = readchar (readcharfun);
+ if (c != '0' && c != '1')
+ break;
+ Dynarr_add (dyn, (unsigned char) (c - '0'));
+ }
+
+ if (c >= 0)
+ unreadchar (readcharfun, c);
+
+ return make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
+ Dynarr_length (dyn));
+}
+
+\f
+
+/* structures */
+
+struct structure_type *
+define_structure_type (Lisp_Object type,
+ int (*validate) (Lisp_Object data,
+ Error_behavior errb),
+ Lisp_Object (*instantiate) (Lisp_Object data))
+{
+ struct structure_type st;
+
+ st.type = type;
+ st.keywords = Dynarr_new (structure_keyword_entry);
+ st.validate = validate;
+ st.instantiate = instantiate;
+ Dynarr_add (the_structure_type_dynarr, st);
+
+ return Dynarr_atp (the_structure_type_dynarr,
+ Dynarr_length (the_structure_type_dynarr) - 1);
+}
+
+void
+define_structure_type_keyword (struct structure_type *st, Lisp_Object keyword,
+ int (*validate) (Lisp_Object keyword,
+ Lisp_Object value,
+ Error_behavior errb))
+{
+ struct structure_keyword_entry en;
+
+ en.keyword = keyword;
+ en.validate = validate;
+ Dynarr_add (st->keywords, en);
+}
+
+static struct structure_type *
+recognized_structure_type (Lisp_Object type)
+{
+ int i;
+
+ for (i = 0; i < Dynarr_length (the_structure_type_dynarr); i++)
+ {
+ struct structure_type *st = Dynarr_atp (the_structure_type_dynarr, i);
+ if (EQ (st->type, type))
+ return st;
+ }
+
+ return 0;
+}
+
+static Lisp_Object
+read_structure (Lisp_Object readcharfun)
+{
+ Emchar c = readchar (readcharfun);
+ Lisp_Object list = Qnil;
+ Lisp_Object orig_list = Qnil;
+ Lisp_Object already_seen = Qnil;
+ int keyword_count;
+ struct structure_type *st;
+ struct gcpro gcpro1, gcpro2;
+
+ GCPRO2 (orig_list, already_seen);
+ if (c != '(')
+ RETURN_UNGCPRO (continuable_syntax_error ("#s not followed by paren"));
+ list = read_list (readcharfun, ')', 0, 0);
+ orig_list = list;
+ {
+ int len = XINT (Flength (list));
+ if (len == 0)
+ RETURN_UNGCPRO (continuable_syntax_error
+ ("structure type not specified"));
+ if (!(len & 1))
+ RETURN_UNGCPRO
+ (continuable_syntax_error
+ ("structures must have alternating keyword/value pairs"));
+ }
+
+ st = recognized_structure_type (XCAR (list));
+ if (!st)
+ RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
+ list2 (build_translated_string
+ ("unrecognized structure type"),
+ XCAR (list))));
+
+ list = Fcdr (list);
+ keyword_count = Dynarr_length (st->keywords);
+ while (!NILP (list))
+ {
+ Lisp_Object keyword, value;
+ int i;
+ struct structure_keyword_entry *en = NULL;
+
+ keyword = Fcar (list);
+ list = Fcdr (list);
+ value = Fcar (list);
+ list = Fcdr (list);
+
+ if (!NILP (memq_no_quit (keyword, already_seen)))
+ RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
+ list2 (build_translated_string
+ ("structure keyword already seen"),
+ keyword)));
+
+ for (i = 0; i < keyword_count; i++)
+ {
+ en = Dynarr_atp (st->keywords, i);
+ if (EQ (keyword, en->keyword))
+ break;
+ }
+
+ if (i == keyword_count)
+ RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
+ list2 (build_translated_string
+ ("unrecognized structure keyword"),
+ keyword)));
+
+ if (en->validate && ! (en->validate) (keyword, value, ERROR_ME))
+ RETURN_UNGCPRO
+ (Fsignal (Qinvalid_read_syntax,
+ list3 (build_translated_string
+ ("invalid value for structure keyword"),
+ keyword, value)));
+
+ already_seen = Fcons (keyword, already_seen);
+ }
+
+ if (st->validate && ! (st->validate) (orig_list, ERROR_ME))
+ RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
+ list2 (build_translated_string
+ ("invalid structure initializer"),
+ orig_list)));
+
+ RETURN_UNGCPRO ((st->instantiate) (XCDR (orig_list)));
+}
+
+\f
+static Lisp_Object read_compiled_function (Lisp_Object readcharfun,
+ int terminator);
+static Lisp_Object read_vector (Lisp_Object readcharfun, int terminator);
+
+/* Get the next character; filter out whitespace and comments */
+
+static Emchar
+reader_nextchar (Lisp_Object readcharfun)
+{
+ /* This function can GC */
+ Emchar c;
+
+ retry:
+ QUIT;
+ c = readchar (readcharfun);
+ if (c < 0)
+ signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
+
+ switch (c)
+ {
+ default:
+ {
+ /* Ignore whitespace and control characters */
+ if (c <= 040)
+ goto retry;
+ return c;
+ }
+
+ case ';':
+ {
+ /* Comment */
+ while ((c = readchar (readcharfun)) >= 0 && c != '\n')
+ QUIT;
+ goto retry;
+ }
+ }
+}
+
+#if 0
+static Lisp_Object
+list2_pure (int pure, Lisp_Object a, Lisp_Object b)
+{
+ return pure ? pure_cons (a, pure_cons (b, Qnil)) : list2 (a, b);
+}
+#endif
+
+/* Read the next Lisp object from the stream READCHARFUN and return it.
+ If the return value is a cons whose car is Qunbound, then read1()
+ encountered a misplaced token (e.g. a right bracket, right paren,
+ or dot followed by a non-number). To filter this stuff out,
+ use read0(). */
+
+static Lisp_Object
+read1 (Lisp_Object readcharfun)
+{
+ Emchar c;
+
+retry:
+ c = reader_nextchar (readcharfun);
+
+ switch (c)
+ {
+ case '(':
+ {
+#ifdef LISP_BACKQUOTES /* old backquote compatibility in lisp reader */
+ /* if this is disabled, then other code in eval.c must be enabled */
+ Emchar ch = reader_nextchar (readcharfun);
+ switch (ch)
+ {
+ case '`':
+ {
+ Lisp_Object tem;
+ int speccount = specpdl_depth ();
+ ++old_backquote_flag;
+ record_unwind_protect (backquote_unwind,
+ make_opaque_ptr (&old_backquote_flag));
+ tem = read0 (readcharfun);
+ unbind_to (speccount, Qnil);
+ ch = reader_nextchar (readcharfun);
+ if (ch != ')')
+ {
+ unreadchar (readcharfun, ch);
+ return Fsignal (Qinvalid_read_syntax,
+ list1 (build_string
+ ("Weird old-backquote syntax")));
+ }
+ return list2 (Qbacktick, tem);
+ }
+ case ',':
+ {
+ if (old_backquote_flag)
+ {
+ Lisp_Object tem, comma_type;
+ ch = readchar (readcharfun);
+ if (ch == '@')
+ comma_type = Qcomma_at;
+ else
+ {
+ if (ch >= 0)
+ unreadchar (readcharfun, ch);
+ comma_type = Qcomma;
+ }
+ tem = read0 (readcharfun);
+ ch = reader_nextchar (readcharfun);
+ if (ch != ')')
+ {
+ unreadchar (readcharfun, ch);
+ return Fsignal (Qinvalid_read_syntax,
+ list1 (build_string
+ ("Weird old-backquote syntax")));
+ }
+ return list2 (comma_type, tem);
+ }
+ else
+ {
+ unreadchar (readcharfun, ch);
+#if 0
+ return Fsignal (Qinvalid_read_syntax,
+ list1 (build_string ("Comma outside of backquote")));
+#else
+ /* #### - yuck....but this is reverse compatible. */
+ /* mostly this is required by edebug, which does its own
+ annotated reading. We need to have an annotated_read
+ function that records (with markers) the buffer
+ positions of the elements that make up lists, then that
+ can be used in edebug and bytecomp and the check above
+ can go back in. --Stig */
+ break;
+#endif
+ }
+ }
+ default:
+ unreadchar (readcharfun, ch);
+ } /* switch(ch) */
+#endif /* old backquote crap... */
+ return read_list (readcharfun, ')', 1, 1);
+ }
+ case '[':
+ return read_vector (readcharfun, ']');
+
+ case ')':
+ case ']':
+ /* #### - huh? these don't do what they seem... */
+ return noseeum_cons (Qunbound, make_char (c));
+ case '.':
+ {
+#ifdef LISP_FLOAT_TYPE
+ /* If a period is followed by a number, then we should read it
+ as a floating point number. Otherwise, it denotes a dotted
+ pair.
+ */
+ c = readchar (readcharfun);
+ unreadchar (readcharfun, c);
+
+ /* Can't use isdigit on Emchars */
+ if (c < '0' || c > '9')
+ return noseeum_cons (Qunbound, make_char ('.'));
+
+ /* Note that read_atom will loop
+ at least once, assuring that we will not try to UNREAD
+ two characters in a row.
+ (I think this doesn't matter anymore because there should
+ be no more danger in unreading multiple characters) */
+ return read_atom (readcharfun, '.', 0);
+
+#else /* ! LISP_FLOAT_TYPE */
+ return noseeum_cons (Qunbound, make_char ('.'));
+#endif /* ! LISP_FLOAT_TYPE */
+ }
+
+ case '#':
+ {
+ c = readchar (readcharfun);
+ switch (c)
+ {
+#if 0 /* FSFmacs silly char-table syntax */
+ case '^':
+#endif
+#if 0 /* FSFmacs silly bool-vector syntax */
+ case '&':
+#endif
+ /* "#["-- byte-code constant syntax */
+ /* purecons #[...] syntax */
+ case '[': return read_compiled_function (readcharfun, ']'
+ /*, purify_flag */ );
+ /* "#:"-- gensym syntax */
+ case ':': return read_atom (readcharfun, -1, 1);
+ /* #'x => (function x) */
+ case '\'': return list2 (Qfunction, read0 (readcharfun));
+#if 0
+ /* RMS uses this syntax for fat-strings.
+ If we use it for vectors, then obscure bugs happen.
+ */
+ /* "#(" -- Scheme/CL vector syntax */
+ case '(': return read_vector (readcharfun, ')');
+#endif
+#if 0 /* FSFmacs */
+ case '(':
+ {
+ Lisp_Object tmp;
+ struct gcpro gcpro1;
+
+ /* Read the string itself. */
+ tmp = read1 (readcharfun);
+ if (!STRINGP (tmp))
+ {
+ if (CONSP (tmp) && UNBOUNDP (XCAR (tmp)))
+ free_cons (XCONS (tmp));
+ return Fsignal (Qinvalid_read_syntax,
+ list1 (build_string ("#")));
+ }
+ GCPRO1 (tmp);
+ /* Read the intervals and their properties. */
+ while (1)
+ {
+ Lisp_Object beg, end, plist;
+ Emchar ch;
+ int invalid = 0;
+
+ beg = read1 (readcharfun);
+ if (CONSP (beg) && UNBOUNDP (XCAR (beg)))
+ {
+ ch = XCHAR (XCDR (beg));
+ free_cons (XCONS (beg));
+ if (ch == ')')
+ break;
+ else
+ invalid = 1;
+ }
+ if (!invalid)
+ {
+ end = read1 (readcharfun);
+ if (CONSP (end) && UNBOUNDP (XCAR (end)))
+ {
+ free_cons (XCONS (end));
+ invalid = 1;
+ }
+ }
+ if (!invalid)
+ {
+ plist = read1 (readcharfun);
+ if (CONSP (plist) && UNBOUNDP (XCAR (plist)))
+ {
+ free_cons (XCONS (plist));
+ invalid = 1;
+ }
+ }
+ if (invalid)
+ RETURN_UNGCPRO
+ (Fsignal (Qinvalid_read_syntax,
+ list2
+ (build_string ("invalid string property list"),
+ XCDR (plist))));
+ Fset_text_properties (beg, end, plist, tmp);
+ }
+ UNGCPRO;
+ return tmp;
+ }
+#endif /* 0 */
+ case '@':
+ {
+ /* #@NUMBER is used to skip NUMBER following characters.
+ That's used in .elc files to skip over doc strings
+ and function definitions. */
+ int i, nskip = 0;
+
+ /* Read a decimal integer. */
+ while ((c = readchar (readcharfun)) >= 0
+ && c >= '0' && c <= '9')
+ nskip = (10 * nskip) + (c - '0');
+ if (c >= 0)
+ unreadchar (readcharfun, c);
+
+ /* FSF has code here that maybe caches the skipped
+ string. See above for why this is totally
+ losing. We handle this differently. */
+
+ /* Skip that many characters. */
+ for (i = 0; i < nskip && c >= 0; i++)
+ c = readchar (readcharfun);
+
+ goto retry;
+ }
+ case '$': return Vload_file_name_internal;
+ /* bit vectors */
+ case '*': return read_bit_vector (readcharfun);
+ /* #o10 => 8 -- octal constant syntax */
+ case 'o': return read_integer (readcharfun, 8);
+ /* #xdead => 57005 -- hex constant syntax */
+ case 'x': return read_integer (readcharfun, 16);
+ /* #b010 => 2 -- binary constant syntax */
+ case 'b': return read_integer (readcharfun, 2);
+ /* #s(foobar key1 val1 key2 val2) -- structure syntax */
+ case 's': return read_structure (readcharfun);
+ case '<':
+ {
+ unreadchar (readcharfun, c);
+ return Fsignal (Qinvalid_read_syntax,
+ list1 (build_string ("Cannot read unreadable object")));
+ }
+#ifdef FEATUREP_SYNTAX
+ case '+':
+ case '-':
+ {
+ Lisp_Object fexp, obj, tem;
+ struct gcpro gcpro1, gcpro2;
+
+ fexp = read0(readcharfun);
+ obj = read0(readcharfun);
+
+ /* the call to `featurep' may GC. */
+ GCPRO2(fexp, obj);
+ tem = call1(Qfeaturep, fexp);
+ UNGCPRO;
+
+ if (c == '+' && NILP(tem)) goto retry;
+ if (c == '-' && !NILP(tem)) goto retry;
+ return obj;
+ }
+#endif
+ case '0': case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7': case '8': case '9':
+ /* Reader forms that can reuse previously read objects. */
+ {
+ int n = 0;
+ Lisp_Object found;
+
+ /* Using read_integer() here is impossible, because it
+ chokes on `='. Using parse_integer() is too hard.
+ So we simply read it in, and ignore overflows, which
+ is safe. */
+ while (c >= '0' && c <= '9')
+ {
+ n *= 10;
+ n += c - '0';
+ c = readchar (readcharfun);
+ }
+ found = assq_no_quit (make_int (n), read_objects);
+ if (c == '=')
+ {
+ /* #n=object returns object, but associates it with
+ n for #n#. */
+ Lisp_Object obj;
+ if (CONSP (found))
+ return Fsignal (Qinvalid_read_syntax,
+ list2 (build_translated_string
+ ("Multiply defined symbol label"),
+ make_int (n)));
+ obj = read0 (readcharfun);
+ read_objects = Fcons (Fcons (make_int (n), obj), read_objects);
+ return obj;
+ }
+ else if (c == '#')
+ {
+ /* #n# returns a previously read object. */
+ if (CONSP (found))
+ return XCDR (found);
+ else
+ return Fsignal (Qinvalid_read_syntax,
+ list2 (build_translated_string
+ ("Undefined symbol label"),
+ make_int (n)));
+ }
+ return Fsignal (Qinvalid_read_syntax,
+ list1 (build_string ("#")));
+ }
+ default:
+ {
+ unreadchar (readcharfun, c);
+ return Fsignal (Qinvalid_read_syntax,
+ list1 (build_string ("#")));
+ }
+ }
+ }
+
+ /* Quote */
+ case '\'': return list2 (Qquote, read0 (readcharfun));
+
+#ifdef LISP_BACKQUOTES
+ case '`':
+ {
+ Lisp_Object tem;
+ int speccount = specpdl_depth ();
+ ++new_backquote_flag;
+ record_unwind_protect (backquote_unwind,
+ make_opaque_ptr (&new_backquote_flag));
+ tem = read0 (readcharfun);
+ unbind_to (speccount, Qnil);
+ return list2 (Qbackquote, tem);
+ }
+
+ case ',':
+ {
+ if (new_backquote_flag)
+ {
+ Lisp_Object comma_type = Qnil;
+ int ch = readchar (readcharfun);
+
+ if (ch == '@')
+ comma_type = Qcomma_at;
+ else if (ch == '.')
+ comma_type = Qcomma_dot;
+ else
+ {
+ if (ch >= 0)
+ unreadchar (readcharfun, ch);
+ comma_type = Qcomma;
+ }
+ return list2 (comma_type, read0 (readcharfun));
+ }
+ else
+ {
+ /* YUCK. 99.999% backwards compatibility. The Right
+ Thing(tm) is to signal an error here, because it's
+ really invalid read syntax. Instead, this permits
+ commas to begin symbols (unless they're inside
+ backquotes). If an error is signalled here in the
+ future, then commas should be invalid read syntax
+ outside of backquotes anywhere they're found (i.e.
+ they must be quoted in symbols) -- Stig */
+ return read_atom (readcharfun, c, 0);
+ }
+ }
+#endif
+
+ case '?':
+ {
+ /* Evil GNU Emacs "character" (ie integer) syntax */
+ c = readchar (readcharfun);
+ if (c < 0)
+ return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
+
+ if (c == '\\')
+ c = read_escape (readcharfun);
+ return make_char (c);
+ }
+
+ case '\"':
+ {
+ /* String */
+#ifdef I18N3
+ /* #### If the input stream is translating, then the string
+ should be marked as translatable by setting its
+ `string-translatable' property to t. .el and .elc files
+ normally are translating input streams. See Fgettext()
+ and print_internal(). */
+#endif
+ int cancel = 0;
+
+ Lstream_rewind (XLSTREAM (Vread_buffer_stream));
+ while ((c = readchar (readcharfun)) >= 0
+ && c != '\"')
+ {
+ if (c == '\\')
+ c = read_escape (readcharfun);
+ /* c is -1 if \ newline has just been seen */
+ if (c == -1)
+ {
+ if (Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) == 0)
+ cancel = 1;
+ }
+ else
+ Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c);
+ QUIT;
+ }
+ if (c < 0)
+ return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
+
+ /* If purifying, and string starts with \ newline,
+ return zero instead. This is for doc strings
+ that we are really going to find in lib-src/DOC.nn.nn */
+ if (purify_flag && NILP (Vinternal_doc_file_name) && cancel)
+ 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)));
+ }
+
+ default:
+ {
+ /* Ignore whitespace and control characters */
+ if (c <= 040)
+ goto retry;
+ return read_atom (readcharfun, c, 0);
+ }
+ }
+}
+
+
+\f
+#ifdef LISP_FLOAT_TYPE
+
+#define LEAD_INT 1
+#define DOT_CHAR 2
+#define TRAIL_INT 4
+#define E_CHAR 8
+#define EXP_INT 16
+
+int
+isfloat_string (CONST char *cp)
+{
+ int state = 0;
+ CONST Bufbyte *ucp = (CONST Bufbyte *) cp;
+
+ if (*ucp == '+' || *ucp == '-')
+ ucp++;
+
+ if (*ucp >= '0' && *ucp <= '9')
+ {
+ state |= LEAD_INT;
+ while (*ucp >= '0' && *ucp <= '9')
+ ucp++;
+ }
+ if (*ucp == '.')
+ {
+ state |= DOT_CHAR;
+ ucp++;
+ }
+ if (*ucp >= '0' && *ucp <= '9')
+ {
+ state |= TRAIL_INT;
+ while (*ucp >= '0' && *ucp <= '9')
+ ucp++;
+ }
+ if (*ucp == 'e' || *ucp == 'E')
+ {
+ state |= E_CHAR;
+ ucp++;
+ if ((*ucp == '+') || (*ucp == '-'))
+ ucp++;
+ }
+
+ if (*ucp >= '0' && *ucp <= '9')
+ {
+ state |= EXP_INT;
+ while (*ucp >= '0' && *ucp <= '9')
+ ucp++;
+ }
+ return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') || (*ucp == '\n')
+ || (*ucp == '\r') || (*ucp == '\f'))
+ && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
+ || state == (DOT_CHAR|TRAIL_INT)
+ || state == (LEAD_INT|E_CHAR|EXP_INT)
+ || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
+ || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
+}
+#endif /* LISP_FLOAT_TYPE */
+\f
+static void *
+sequence_reader (Lisp_Object readcharfun,
+ Emchar terminator,
+ void *state,
+ void * (*conser) (Lisp_Object readcharfun,
+ void *state, Charcount len))
+{
+ Charcount len;
+
+ for (len = 0; ; len++)
+ {
+ Emchar ch;
+
+ QUIT;
+ ch = reader_nextchar (readcharfun);
+
+ if (ch == terminator)
+ return state;
+ else
+ unreadchar (readcharfun, ch);
+#ifdef FEATUREP_SYNTAX
+ if (ch == ']')
+ syntax_error ("\"]\" in a list");
+ else if (ch == ')')
+ syntax_error ("\")\" in a vector");
+#endif
+ state = ((conser) (readcharfun, state, len));
+ }
+}
+
+
+struct read_list_state
+ {
+ Lisp_Object head;
+ Lisp_Object tail;
+ int length;
+ int allow_dotted_lists;
+ Emchar terminator;
+ };
+
+static void *
+read_list_conser (Lisp_Object readcharfun, void *state, Charcount len)
+{
+ struct read_list_state *s = (struct read_list_state *) state;
+ Lisp_Object elt;
+
+ elt = read1 (readcharfun);
+
+ if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
+ {
+ Lisp_Object tem = elt;
+ Emchar ch;
+
+ elt = XCDR (elt);
+ free_cons (XCONS (tem));
+ tem = Qnil;
+ ch = XCHAR (elt);
+#ifdef FEATUREP_SYNTAX
+ if (ch == s->terminator) /* deal with #+, #- reader macros */
+ {
+ unreadchar (readcharfun, s->terminator);
+ goto done;
+ }
+ else if (ch == ']')
+ syntax_error ("']' in a list");
+ else if (ch == ')')
+ syntax_error ("')' in a vector");
+ else
+#endif
+ if (ch != '.')
+ signal_simple_error ("BUG! Internal reader error", elt);
+ else if (!s->allow_dotted_lists)
+ syntax_error ("\".\" in a vector");
+ else
+ {
+ if (!NILP (s->tail))
+ XCDR (s->tail) = read0 (readcharfun);
+ else
+ s->head = read0 (readcharfun);
+ elt = read1 (readcharfun);
+ if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
+ {
+ ch = XCHAR (XCDR (elt));
+ free_cons (XCONS (elt));
+ if (ch == s->terminator)
+ {
+ unreadchar (readcharfun, s->terminator);
+ goto done;
+ }
+ }
+ syntax_error (". in wrong context");
+ }
+ }
+
+#if 0 /* FSFmacs defun hack, or something ... */
+ if (NILP (tail) && defun_hack && EQ (elt, Qdefun) && !read_pure)
+ {
+ record_unwind_protect (unreadpure, Qzero);
+ read_pure = 1;
+ }
+#endif
+
+#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+ if (s->length == 1 && s->allow_dotted_lists && EQ (XCAR (s->head), Qfset))
+ {
+ if (CONSP (elt) && EQ (XCAR (elt), Qquote) && CONSP (XCDR (elt)))
+ Vcurrent_compiled_function_annotation = XCAR (XCDR (elt));
+ else
+ Vcurrent_compiled_function_annotation = elt;
+ }
+#endif
+
+ elt = Fcons (elt, Qnil);
+ if (!NILP (s->tail))
+ XCDR (s->tail) = elt;
+ else
+ s->head = elt;
+ s->tail = elt;
+ done:
+ s->length++;
+ return s;
+}
+
+\f
+#if 0 /* FSFmacs defun hack */
+/* -1 for allow_dotted_lists means allow_dotted_lists and check
+ for starting with defun and make structure pure. */
+#endif
+
+static Lisp_Object
+read_list (Lisp_Object readcharfun,
+ Emchar terminator,
+ int allow_dotted_lists,
+ int check_for_doc_references)
+{
+ struct read_list_state s;
+ struct gcpro gcpro1, gcpro2;
+#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+ Lisp_Object old_compiled_function_annotation =
+ Vcurrent_compiled_function_annotation;
+#endif
+
+ s.head = Qnil;
+ s.tail = Qnil;
+ s.length = 0;
+ s.allow_dotted_lists = allow_dotted_lists;
+ s.terminator = terminator;
+ GCPRO2 (s.head, s.tail);
+
+ sequence_reader (readcharfun, terminator, &s, read_list_conser);
+#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+ Vcurrent_compiled_function_annotation = old_compiled_function_annotation;
+#endif
+
+ if ((purify_flag || load_force_doc_strings) && check_for_doc_references)
+ {
+ /* check now for any doc string references and record them
+ for later. */
+ Lisp_Object tail;
+
+ /* We might be dealing with an imperfect list so don't
+ use LIST_LOOP */
+ for (tail = s.head; CONSP (tail); tail = XCDR (tail))
+ {
+ Lisp_Object holding_cons = Qnil;
+
+ {
+ Lisp_Object elem = XCAR (tail);
+ /* elem might be (#$ . INT) ... */
+ if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
+ holding_cons = tail;
+ /* or it might be (quote (#$ . INT)) i.e.
+ (quote . ((#$ . INT) . nil)) in the case of
+ `autoload' (autoload evaluates its arguments, while
+ `defvar', `defun', etc. don't). */
+ if (CONSP (elem) && EQ (XCAR (elem), Qquote)
+ && CONSP (XCDR (elem)))
+ {
+ elem = XCAR (XCDR (elem));
+ if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
+ holding_cons = XCDR (XCAR (tail));
+ }
+ }
+
+ if (CONSP (holding_cons))
+ {
+ if (purify_flag)
+ {
+ if (NILP (Vinternal_doc_file_name))
+ /* We have not yet called Snarf-documentation, so
+ assume this file is described in the DOC file
+ and Snarf-documentation will fill in the right
+ value later. For now, replace the whole list
+ with 0. */
+ XCAR (holding_cons) = Qzero;
+ else
+ /* We have already called Snarf-documentation, so
+ make a relative file name for this file, so it
+ can be found properly in the installed Lisp
+ directory. We don't use Fexpand_file_name
+ because that would make the directory absolute
+ now. */
+ XCAR (XCAR (holding_cons)) =
+ concat2 (build_string ("../lisp/"),
+ Ffile_name_nondirectory
+ (Vload_file_name_internal));
+ }
+ else
+ /* Not pure. Just add to Vload_force_doc_string_list,
+ and the string will be filled in properly in
+ load_force_doc_string_unwind(). */
+ Vload_force_doc_string_list =
+ /* We pass the cons that holds the (#$ . INT) so we
+ can modify it in-place. */
+ Fcons (holding_cons, Vload_force_doc_string_list);
+ }
+ }
+ }
+
+ UNGCPRO;
+ return s.head;
+}
+
+static Lisp_Object
+read_vector (Lisp_Object readcharfun,
+ Emchar terminator)
+{
+ Lisp_Object tem;
+ Lisp_Object *p;
+ int len;
+ int i;
+ struct read_list_state s;
+ struct gcpro gcpro1, gcpro2;
+
+ s.head = Qnil;
+ s.tail = Qnil;
+ s.length = 0;
+ s.allow_dotted_lists = 0;
+ GCPRO2 (s.head, s.tail);
+
+ sequence_reader (readcharfun, terminator, &s, read_list_conser);
+
+ UNGCPRO;
+ tem = s.head;
+ len = XINT (Flength (tem));
+
+#if 0 /* FSFmacs defun hack */
+ if (read_pure)
+ s.head = make_pure_vector (len, Qnil);
+ else
+#endif
+ s.head = make_vector (len, Qnil);
+
+ for (i = 0, p = &(XVECTOR_DATA (s.head)[0]);
+ 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);
+ *p = tem;
+ tem = otem->cdr;
+ free_cons (otem);
+ }
+ return s.head;
+}
+
+static Lisp_Object
+read_compiled_function (Lisp_Object readcharfun, Emchar terminator)
+{
+ /* Accept compiled functions at read-time so that we don't
+ have to build them at load-time. */
+ Lisp_Object stuff;
+ Lisp_Object make_byte_code_args[COMPILED_DOMAIN + 1];
+ struct gcpro gcpro1;
+ int len;
+ int iii;
+ int saw_a_doc_ref = 0;
+
+ /* Note: we tell read_list not to search for doc references
+ because we need to handle the "doc reference" for the
+ instructions and constants differently. */
+ stuff = read_list (readcharfun, terminator, 0, 0);
+ len = XINT (Flength (stuff));
+ if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
+ return
+ continuable_syntax_error ("#[...] used with wrong number of elements");
+
+ for (iii = 0; CONSP (stuff); iii++)
+ {
+ struct 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])
+ && EQ (XCAR (make_byte_code_args[iii]), Vload_file_name_internal))
+ {
+ if (purify_flag && iii == COMPILED_DOC_STRING)
+ {
+ /* same as in read_list(). */
+ if (NILP (Vinternal_doc_file_name))
+ make_byte_code_args[iii] = Qzero;
+ else
+ XCAR (make_byte_code_args[iii]) =
+ concat2 (build_string ("../lisp/"),
+ Ffile_name_nondirectory
+ (Vload_file_name_internal));
+ }
+ else
+ saw_a_doc_ref = 1;
+ }
+ stuff = Fcdr (stuff);
+ free_cons (victim);
+ }
+ GCPRO1 (make_byte_code_args[0]);
+ gcpro1.nvars = len;
+
+ /* v18 or v19 bytecode file. Need to Ebolify. */
+ if (load_byte_code_version < 20 && VECTORP (make_byte_code_args[2]))
+ ebolify_bytecode_constants (make_byte_code_args[2]);
+
+ /* make-byte-code looks at purify_flag, which should have the same
+ * value as our "read-pure" argument */
+ stuff = Fmake_byte_code (len, make_byte_code_args);
+ XCOMPILED_FUNCTION (stuff)->flags.ebolified = (load_byte_code_version < 20);
+ if (saw_a_doc_ref)
+ Vload_force_doc_string_list = Fcons (stuff, Vload_force_doc_string_list);
+ UNGCPRO;
+ return stuff;
+}
+
+
+\f
+void
+init_lread (void)
+{
+ Vvalues = Qnil;
+
+ load_in_progress = 0;
+
+ Vload_descriptor_list = Qnil;
+
+ /* kludge: locate-file does not work for a null load-path, even if
+ the file name is absolute. */
+
+ Vload_path = Fcons (build_string (""), Qnil);
+
+ /* This used to get initialized in init_lread because all streams
+ got closed when dumping occurs. This is no longer true --
+ Vread_buffer_stream is a resizing output stream, and there is no
+ reason to close it at dump-time.
+
+ Vread_buffer_stream is set to Qnil in vars_of_lread, and this
+ will initialize it only once, at dump-time. */
+ if (NILP (Vread_buffer_stream))
+ Vread_buffer_stream = make_resizing_buffer_output_stream ();
+
+ Vload_force_doc_string_list = Qnil;
+}
+
+void
+syms_of_lread (void)
+{
+ DEFSUBR (Fread);
+ DEFSUBR (Fread_from_string);
+ DEFSUBR (Fload_internal);
+ DEFSUBR (Flocate_file);
+ DEFSUBR (Flocate_file_clear_hashing);
+ DEFSUBR (Feval_buffer);
+ DEFSUBR (Feval_region);
+
+ defsymbol (&Qstandard_input, "standard-input");
+ defsymbol (&Qread_char, "read-char");
+ 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
+ defsymbol (&Qbackquote, "backquote");
+ defsymbol (&Qbacktick, "`");
+ defsymbol (&Qcomma, ",");
+ defsymbol (&Qcomma_at, ",@");
+ defsymbol (&Qcomma_dot, ",.");
+#endif
+}
+
+void
+structure_type_create (void)
+{
+ the_structure_type_dynarr = Dynarr_new (structure_type);
+}
+
+void
+vars_of_lread (void)
+{
+ DEFVAR_LISP ("values", &Vvalues /*
+List of values of all expressions which were read, evaluated and printed.
+Order is reverse chronological.
+*/ );
+
+ DEFVAR_LISP ("standard-input", &Vstandard_input /*
+Stream for read to get input from.
+See documentation of `read' for possible values.
+*/ );
+ Vstandard_input = Qt;
+
+ DEFVAR_LISP ("load-path", &Vload_path /*
+*List of directories to search for files to load.
+Each element is a string (directory name) or nil (try default directory).
+
+Note that the elements of this list *may not* begin with "~", so you must
+call `expand-file-name' on them before adding them to this list.
+
+Initialized based on EMACSLOADPATH environment variable, if any,
+otherwise to default specified in by file `paths.h' when XEmacs was built.
+If there were no paths specified in `paths.h', then XEmacs chooses a default
+value for this variable by looking around in the file-system near the
+directory in which the XEmacs executable resides.
+*/ );
+ Vload_path = Qnil;
+
+/* xxxDEFVAR_LISP ("dump-load-path", &Vdump_load_path,
+ "*Location of lisp files to be used when dumping ONLY."); */
+
+ DEFVAR_BOOL ("load-in-progress", &load_in_progress /*
+Non-nil iff inside of `load'.
+*/ );
+
+ DEFVAR_LISP ("after-load-alist", &Vafter_load_alist /*
+An alist of expressions to be evalled when particular files are loaded.
+Each element looks like (FILENAME FORMS...).
+When `load' is run and the file-name argument is FILENAME,
+the FORMS in the corresponding element are executed at the end of loading.
+
+FILENAME must match exactly! Normally FILENAME is the name of a library,
+with no directory specified, since that is how `load' is normally called.
+An error in FORMS does not undo the load,
+but does prevent execution of the rest of the FORMS.
+*/ );
+ Vafter_load_alist = Qnil;
+
+ DEFVAR_BOOL ("load-warn-when-source-newer", &load_warn_when_source_newer /*
+*Whether `load' should check whether the source is newer than the binary.
+If this variable is true, then when a `.elc' file is being loaded and the
+corresponding `.el' is newer, a warning message will be printed.
+*/ );
+ load_warn_when_source_newer = 0;
+
+ DEFVAR_BOOL ("load-warn-when-source-only", &load_warn_when_source_only /*
+*Whether `load' should warn when loading a `.el' file instead of an `.elc'.
+If this variable is true, then when `load' is called with a filename without
+an extension, and the `.elc' version doesn't exist but the `.el' version does,
+then a message will be printed. If an explicit extension is passed to `load',
+no warning will be printed.
+*/ );
+ load_warn_when_source_only = 0;
+
+ DEFVAR_BOOL ("load-ignore-elc-files", &load_ignore_elc_files /*
+*Whether `load' should ignore `.elc' files when a suffix is not given.
+This is normally used only to bootstrap the `.elc' files when building XEmacs.
+*/ );
+ load_ignore_elc_files = 0;
+
+#ifdef LOADHIST
+ DEFVAR_LISP ("load-history", &Vload_history /*
+Alist mapping source file names to symbols and features.
+Each alist element is a list that starts with a file name,
+except for one element (optional) that starts with nil and describes
+definitions evaluated from buffers not visiting files.
+The remaining elements of each list are symbols defined as functions
+or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.
+*/ );
+ Vload_history = Qnil;
+
+ DEFVAR_LISP ("current-load-list", &Vcurrent_load_list /*
+Used for internal purposes by `load'.
+*/ );
+ Vcurrent_load_list = Qnil;
+#endif
+
+ DEFVAR_LISP ("load-file-name", &Vload_file_name /*
+Full name of file being loaded by `load'.
+*/ );
+ Vload_file_name = Qnil;
+
+ DEFVAR_LISP ("load-read-function", &Vload_read_function /*
+Function used by `load' and `eval-region' for reading expressions.
+The default is nil, which means use the function `read'.
+*/ );
+ Vload_read_function = Qnil;
+
+ DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings /*
+Non-nil means `load' should force-load all dynamic doc strings.
+This is useful when the file being loaded is a temporary copy.
+*/ );
+ load_force_doc_strings = 0;
+
+ DEFVAR_LISP ("source-directory", &Vsource_directory /*
+Directory in which XEmacs sources were found when XEmacs was built.
+You cannot count on them to still be there!
+*/ );
+ Vsource_directory = Qnil;
+
+ /* See read_escape(). */
+#if 0
+ /* Used to be named `puke-on-fsf-keys' */
+ DEFVAR_BOOL ("fail-on-bucky-bit-character-escapes",
+ &fail_on_bucky_bit_character_escapes /*
+Whether `read' should signal an error when it encounters unsupported
+character escape syntaxes or just read them incorrectly.
+*/ );
+ fail_on_bucky_bit_character_escapes = 0;
+#endif
+
+ /* This must be initialized in init_lread otherwise it may start out
+ 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);
+
+ Vload_file_name_internal = Qnil;
+ staticpro (&Vload_file_name_internal);
+
+ Vload_file_name_internal_the_purecopy = Qnil;
+ staticpro (&Vload_file_name_internal_the_purecopy);
+
+#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+ Vcurrent_compiled_function_annotation = Qnil;
+ staticpro (&Vcurrent_compiled_function_annotation);
+#endif
+
+ /* So that early-early stuff will work */
+ Ffset (Qload, intern ("load-internal"));
+
+#ifdef FEATUREP_SYNTAX
+ defsymbol (&Qfeaturep, "featurep");
+ Fprovide(intern("xemacs"));
+#ifdef INFODOCK
+ Fprovide(intern("infodock"));
+#endif /* INFODOCK */
+#endif /* FEATUREP_SYNTAX */
+
+#ifdef LISP_BACKQUOTES
+ old_backquote_flag = new_backquote_flag = 0;
+#endif
+
+#ifdef I18N3
+ Vfile_domain = Qnil;
+#endif
+
+ read_objects = Qnil;
+ staticpro (&read_objects);
+}
--- /dev/null
+/* The "lrecord" structure (header of a compound lisp object).
+ Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+ Copyright (C) 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 _XEMACS_LRECORD_H_
+#define _XEMACS_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.
+
+ Lrecords are of two types: straight lrecords, and lcrecords.
+ Straight lrecords are used for those types of objects that have
+ their own allocation routines (typically allocated out of 2K chunks
+ of memory called `frob blocks'). These objects have a `struct
+ lrecord_header' at the top, containing only the bits needed to find
+ 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().
+
+ Creating a new lcrecord type is fairly easy; just follow the
+ lead of some existing type (e.g. hashtables). Note that you
+ do not need to supply all the methods (see below); reasonable
+ defaults are provided for many of them. Alternatively, if you're
+ just looking for a way of encapsulating data (which possibly
+ could contain Lisp_Objects in it), you may well be able to use
+ the opaque type. */
+
+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 type:8;
+ /* 1 if the object is marked during GC, 0 otherwise. */
+ unsigned mark:1;
+ /* 1 if the object resides in pure (read-only) space */
+ unsigned pure:1;
+#else
+ CONST struct lrecord_implementation *implementation;
+#endif
+};
+
+struct lrecord_implementation;
+int lrecord_type_index (CONST struct lrecord_implementation *implementation);
+
+#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
+# define set_lheader_implementation(header,imp) do \
+{ \
+ (header)->type = lrecord_type_index (imp); \
+ (header)->mark = 0; \
+ (header)->pure = 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
+ so that the GC can find (and free) all of them.
+ "alloc_lcrecord" threads records 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. (For
+ example, the event and marker datatypes allocate members out of
+ memory chunks, and are able to find all unmarked members by
+ sweeping through the elements of the list of chunks) */
+ struct lcrecord_header *next;
+ /* This is just for debugging/printing convenience.
+ Having this slot doesn't hurt us much spacewise, since an lcrecord
+ already has the above slots together with malloc overhead. */
+ unsigned int uid :31;
+ /* A flag that indicates whether this lcrecord is on a "free list".
+ Free lists are used to minimize the number of calls to malloc()
+ when we're repeatedly allocating and freeing a number of the
+ same sort of lcrecord. Lcrecords on a free list always get
+ marked in a different fashion, so we can use this flag as a
+ sanity check to make sure that free lists only have freed lcrecords
+ and there are no freed lcrecords elsewhere. */
+ unsigned int free :1;
+};
+
+/* Used for lcrecords in an lcrecord-list. */
+struct free_lcrecord_header
+{
+ struct lcrecord_header lcheader;
+ 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));
+
+struct lrecord_implementation
+{
+ CONST char *name;
+ /* This function 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
+ marked (don't call the mark_object function explicitly on it,
+ because the GC routines will do this). Doing it this way reduces
+ 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. */
+ void (*printer) (Lisp_Object, Lisp_Object printcharfun, int escapeflag);
+ /* This function 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
+ finalization is necessary.
+
+ WARNING: remember that the 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). */
+ unsigned long (*hash) (Lisp_Object, int);
+ 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(). */
+ size_t static_size;
+ 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;
+};
+
+#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
+extern CONST struct lrecord_implementation *lrecord_implementations_table[];
+
+# 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
+
+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) (lheader)->mark = 1
+# define UNMARK_RECORD_HEADER(lheader) (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) \
+ do { (((lheader)->implementation)++); } while (0)
+# define UNMARK_RECORD_HEADER(lheader) \
+ do { (((lheader)->implementation)--); } while (0)
+
+#endif /* ! USE_INDEXED_LRECORD_IMPLEMENTATION */
+
+#define UNMARKABLE_RECORD_HEADER_P(lheader) \
+ ((LHEADER_IMPLEMENTATION (lheader)->marker) \
+ == this_one_is_unmarkable)
+
+/* 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-
+ dump file */
+
+#ifdef DEBUG_XEMACS
+#define CONST_IF_NOT_DEBUG
+#else
+#define CONST_IF_NOT_DEBUG CONST
+#endif
+
+/* DEFINE_LRECORD_IMPLEMENTATION is for objects with constant size.
+ DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION is for objects whose size varies.
+ */
+
+#if defined (ERROR_CHECK_TYPECHECK)
+# define DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype)
+#else
+# 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_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_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_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_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_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 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,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 } }
+
+#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) \
+ (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.
+
+ Furthermore, you always need to put the DECLARE_LRECORD() in a header
+ file, and make sure the header file is included in inline.c, even
+ if the type is private to a particular file. Otherwise, you will
+ get undefined references for the error_check_foo() inline function
+ under GCC. */
+
+#ifdef ERROR_CHECK_TYPECHECK
+
+# define DECLARE_LRECORD(c_name, structtype) \
+extern CONST_IF_NOT_DEBUG struct lrecord_implementation \
+ 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)); \
+ return (structtype *) XPNTR (_obj); \
+} \
+extern Lisp_Object Q##c_name##p
+
+# define DECLARE_NONRECORD(c_name, type_enum, structtype) \
+INLINE structtype *error_check_##c_name (Lisp_Object _obj); \
+INLINE structtype * \
+error_check_##c_name (Lisp_Object _obj) \
+{ \
+ XUNMARK (_obj); \
+ assert (XGCTYPE (_obj) == type_enum); \
+ return (structtype *) XPNTR (_obj); \
+} \
+extern Lisp_Object Q##c_name##p
+
+# define XRECORD(x, c_name, structtype) error_check_##c_name (x)
+# define XNONRECORD(x, c_name, type_enum, structtype) error_check_##c_name (x)
+
+# define XSETRECORD(var, p, c_name) do \
+{ \
+ XSETOBJ (var, Lisp_Type_Record, p); \
+ assert (RECORD_TYPEP (var, lrecord_##c_name) || \
+ MARKED_RECORD_P (var)); \
+} while (0)
+
+#else /* not ERROR_CHECK_TYPECHECK */
+
+# define DECLARE_LRECORD(c_name, structtype) \
+extern Lisp_Object Q##c_name##p; \
+extern CONST_IF_NOT_DEBUG struct lrecord_implementation \
+ 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))
+# define XNONRECORD(x, c_name, type_enum, structtype) \
+ ((structtype *) XPNTR (x))
+# define XSETRECORD(var, p, c_name) XSETOBJ (var, Lisp_Type_Record, p)
+
+#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)
+
+/* Note: we now have two different kinds of type-checking macros.
+ The "old" kind has now been renamed CONCHECK_foo. The reason for
+ this is that the CONCHECK_foo macros signal a continuable error,
+ allowing the user (through debug-on-error) to substitute a different
+ value and return from the signal, which causes the lvalue argument
+ to get changed. Quite a lot of code would crash if that happened,
+ because it did things like
+
+ foo = XCAR (list);
+ CHECK_STRING (foo);
+
+ and later on did XSTRING (XCAR (list)), assuming that the type
+ is correct (when it might be wrong, if the user substituted a
+ correct value in the debugger).
+
+ To get around this, I made all the CHECK_foo macros signal a
+ non-continuable error. Places where a continuable error is OK
+ (generally only when called directly on the argument of a Lisp
+ primitive) should be changed to use CONCHECK().
+
+ FSF Emacs does not have this problem because RMS took the cheesy
+ way out and disabled returning from a signal entirely. */
+
+#define CONCHECK_RECORD(x, c_name) do { \
+ 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 {\
+ if (XTYPE (x) != lisp_enum) \
+ x = wrong_type_argument (predicate, x); \
+ } while (0)
+#define CHECK_RECORD(x, c_name) do { \
+ 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 { \
+ if (XTYPE (x) != lisp_enum) \
+ dead_wrong_type_argument (predicate, x); \
+ } while (0)
+
+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))
+
+#define zero_lcrecord(lcr) \
+ memset ((char *) lcr + sizeof (struct lcrecord_header), 0, \
+ sizeof (*lcr) - sizeof (struct lcrecord_header))
+
+#endif /* _XEMACS_LRECORD_H_ */
--- /dev/null
+/* Generic stream implementation -- header file.
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Copyright (C) 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. */
+
+/* Written by Ben Wing. */
+
+#ifndef _XEMACS_LSTREAM_H_
+#define _XEMACS_LSTREAM_H_
+
+/************************************************************************/
+/* definition of Lstream object */
+/************************************************************************/
+
+DECLARE_LRECORD (lstream, struct lstream);
+#define XLSTREAM(x) XRECORD (x, lstream, struct lstream)
+#define XSETLSTREAM(x, p) XSETRECORD (x, p, lstream)
+#define LSTREAMP(x) RECORDP (x, lstream)
+/* #define CHECK_LSTREAM(x) CHECK_RECORD (x, lstream)
+ Lstream pointers should never escape to the Lisp level, so
+ functions should not be doing this. */
+
+#ifndef EOF
+#define EOF (-1)
+#endif
+
+typedef enum lstream_buffering
+{
+ /* No buffering. */
+ LSTREAM_UNBUFFERED,
+ /* Buffer until a '\n' character is reached. */
+ LSTREAM_LINE_BUFFERED,
+ /* Buffer in standard-size (i.e. 512-byte) blocks. */
+ LSTREAM_BLOCK_BUFFERED,
+ /* Buffer in blocks of a specified size. */
+ LSTREAM_BLOCKN_BUFFERED,
+ /* Buffer until the stream is closed (only applies to write-only
+ streams). Only one call to the stream writer will be made,
+ and that is when the stream is closed. */
+ LSTREAM_UNLIMITED
+} Lstream_buffering;
+
+/* Methods defining how this stream works. Some may be undefined. */
+
+/* We do not implement the seek/tell paradigm. I tried to do that,
+ but getting the semantics right in the presence of buffering is
+ extremely tricky and very error-prone and basically not worth it.
+ This is especially the case with complicated streams like
+ decoding streams -- the seek pointer in this case can't be a single
+ integer but has to be a whole complicated structure that records
+ all of the stream's state at the time.
+
+ Rewind semantics are generally easy to implement, so we do provide
+ a rewind method. Even rewind() may not be available on a stream,
+ however -- e.g. on process output. */
+
+typedef struct lstream_implementation
+{
+ 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
+ can hold 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 of an EOF, or because there is a granularity greater
+ than one byte that the stream imposes on the returned data, and
+ SIZE is less than this granularity. (This will happen frequently
+ for streams that need to return whole characters, because
+ Lstream_read() calls the reader function repeatedly until it
+ has the number of bytes it wants or until 0 is returned.)
+ The lstream functions do not treat a 0 return as EOF or do
+ anything special; however, the calling function will interpret
+ any 0 it gets back as EOF. This will normally not happen unless
+ the caller calls Lstream_read() with a very small size.
+
+ This function can be NULL if the stream is output-only. */
+ /* 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);
+ /* 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
+ that case, the function will just be called again until there is
+ no data left or 0 is returned. A return value of 0 means that no
+ more data can be currently stored, but there is no error; the
+ data will be squirrelled away until the writer can accept
+ 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);
+ /* 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 */
+ int (*was_blocked_p) (Lstream *stream);
+ /* Rewind the stream. If this is NULL, the stream is not seekable. */
+ int (*rewinder) (Lstream *stream);
+ /* 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. */
+ int (*seekable_p) (Lstream *stream);
+ /* Perform any additional operations necessary to flush the
+ data in this stream. */
+ int (*flusher) (Lstream *stream);
+ /* Perform any additional operations necessary to close this
+ stream down. May be NULL. This function is called when
+ Lstream_close() is called or when the stream is garbage-
+ collected. When this function is called, all pending data
+ in the stream will already have been written out. */
+ 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));
+} Lstream_implementation;
+
+#define DEFINE_LSTREAM_IMPLEMENTATION(name,c_name,size) \
+ Lstream_implementation c_name[1] = \
+ { { (name), (size) } }
+
+#define LSTREAM_FL_IS_OPEN 1
+#define LSTREAM_FL_READ 2
+#define LSTREAM_FL_WRITE 4
+#define LSTREAM_FL_NO_PARTIAL_CHARS 8
+#define LSTREAM_FL_CLOSE_AT_DISKSAVE 16
+
+struct lstream
+{
+ struct lcrecord_header header;
+ CONST Lstream_implementation *imp; /* methods for this stream */
+ Lstream_buffering buffering; /* type of buffering in use */
+ size_t buffering_size; /* number of bytes buffered */
+
+ unsigned char *in_buffer; /* holds characters read from stream end */
+ size_t in_buffer_size; /* allocated size of buffer */
+ size_t in_buffer_current; /* number of characters in buffer */
+ size_t in_buffer_ind; /* pointer to next character to take from buffer */
+
+ unsigned char *out_buffer; /* holds characters to write to stream end */
+ size_t out_buffer_size; /* allocated size of buffer */
+ size_t out_buffer_ind; /* pointer to next buffer spot to write a character */
+
+ /* The unget buffer is more or less a stack -- things get pushed
+ onto the end and read back from the end. Lstream_read()
+ basically reads backwards from the end to get stuff; Lstream_unread()
+ similarly has to push the data on backwards. */
+ unsigned char *unget_buffer; /* holds characters pushed back onto input */
+ size_t unget_buffer_size; /* allocated size of buffer */
+ size_t unget_buffer_ind; /* pointer to next buffer spot to write a character */
+
+ size_t byte_count;
+ long flags; /* Align pointer for 64 bit machines (kny) */
+ char data[1];
+};
+
+#define LSTREAM_TYPE_P(lstr, type) \
+ ((lstr)->imp == lstream_##type)
+
+#ifdef ERROR_CHECK_TYPECHECK
+INLINE struct lstream *
+error_check_lstream_type (struct lstream *stream,
+ CONST Lstream_implementation *imp);
+INLINE struct lstream *
+error_check_lstream_type (struct lstream *stream,
+ CONST Lstream_implementation *imp)
+{
+ assert (stream->imp == imp);
+ return stream;
+}
+# define LSTREAM_TYPE_DATA(lstr, type) \
+ ((struct type##_stream *) \
+ Lstream_data (error_check_lstream_type(lstr, lstream_##type)))
+#else
+# define LSTREAM_TYPE_DATA(lstr, type) \
+ ((struct type##_stream *) Lstream_data (lstr))
+#endif
+
+/* Declare that lstream-type TYPE has method M; used in
+ initialization routines */
+#define LSTREAM_HAS_METHOD(type, m) \
+ (lstream_##type->m = type##_##m)
+
+
+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);
+int Lstream_flush (Lstream *lstr);
+int Lstream_flush_out (Lstream *lstr);
+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);
+int Lstream_was_blocked_p (Lstream *lstr);
+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);
+void Lstream_delete (Lstream *lstr);
+void Lstream_set_character_mode (Lstream *str);
+
+/* Call the function equivalent if the out buffer is full. Otherwise,
+ add to the end of the out buffer and, if line buffering is called for
+ and the character marks the end of a line, write out the buffer. */
+
+#define Lstream_putc(stream, c) \
+ ((stream)->out_buffer_ind >= (stream)->out_buffer_size ? \
+ Lstream_fputc (stream, c) : \
+ ((stream)->out_buffer[(stream)->out_buffer_ind++] = \
+ (unsigned char) (c), \
+ (stream)->byte_count++, \
+ (stream)->buffering == LSTREAM_LINE_BUFFERED && \
+ (stream)->out_buffer[(stream)->out_buffer_ind - 1] == '\n' ? \
+ Lstream_flush_out (stream) : 0))
+
+/* Retrieve from unget buffer if there are any characters there;
+ else retrieve from in buffer if there's anything there;
+ else call the function equivalent */
+#define Lstream_getc(stream) \
+ ((stream)->unget_buffer_ind > 0 ? \
+ ((stream)->byte_count++, \
+ (stream)->unget_buffer[--(stream)->unget_buffer_ind]) : \
+ (stream)->in_buffer_ind < (stream)->in_buffer_current ? \
+ ((stream)->byte_count++, \
+ (stream)->in_buffer[(stream)->in_buffer_ind++]) : \
+ Lstream_fgetc (stream))
+
+/* Add to the end if it won't overflow buffer; otherwise call the
+ function equivalent */
+#define Lstream_ungetc(stream, c) \
+ ((stream)->unget_buffer_ind >= (stream)->unget_buffer_size ? \
+ Lstream_fungetc (stream, c) : \
+ (void) ((stream)->byte_count--, \
+ ((stream)->unget_buffer[(stream)->unget_buffer_ind++] = \
+ (unsigned char) (c))))
+
+#define Lstream_data(stream) ((void *) ((stream)->data))
+#define Lstream_byte_count(stream) ((stream)->byte_count)
+
+\f
+/************************************************************************/
+/* working with an Lstream as a stream of Emchars */
+/************************************************************************/
+
+#ifdef MULE
+
+#ifndef BYTE_ASCII_P
+#include "mule-charset.h"
+#endif
+
+INLINE Emchar Lstream_get_emchar (Lstream *stream);
+INLINE Emchar
+Lstream_get_emchar (Lstream *stream)
+{
+ int c = Lstream_getc (stream);
+ return BYTE_ASCII_P (c) ? (Emchar) c :
+ Lstream_get_emchar_1 (stream, c);
+}
+
+INLINE int Lstream_put_emchar (Lstream *stream, Emchar ch);
+INLINE int
+Lstream_put_emchar (Lstream *stream, Emchar ch)
+{
+ return CHAR_ASCII_P (ch) ?
+ Lstream_putc (stream, ch) :
+ Lstream_fput_emchar (stream, ch);
+}
+
+INLINE void Lstream_unget_emchar (Lstream *stream, Emchar ch);
+INLINE void
+Lstream_unget_emchar (Lstream *stream, Emchar ch)
+{
+ if (CHAR_ASCII_P (ch))
+ Lstream_ungetc (stream, ch);
+ else
+ Lstream_funget_emchar (stream, ch);
+}
+#else /* not MULE */
+
+# define Lstream_get_emchar(stream) Lstream_getc (stream)
+# define Lstream_put_emchar(stream, ch) Lstream_putc (stream, ch)
+# define Lstream_unget_emchar(stream, ch) Lstream_ungetc (stream, ch)
+
+#endif /* not MULE */
+
+\f
+/************************************************************************/
+/* Lstream implementations */
+/************************************************************************/
+
+/* Flags we can pass to the filedesc and stdio streams. */
+
+/* If set, close the descriptor or FILE * when the stream is closed. */
+#define LSTR_CLOSING 1
+
+/* If set, allow quitting out of the actual I/O. */
+#define LSTR_ALLOW_QUIT 2
+
+/* If set and filedesc_stream_set_pty_flushing() has been called
+ on the stream, do not send more than pty_max_bytes on a single
+ line without flushing the data out using the eof_char. */
+#define LSTR_PTY_FLUSHING 4
+
+/* If set, an EWOULDBLOCK error is not treated as an error but
+ simply causes the write function to return 0 as the number
+ of bytes written out. */
+#define LSTR_BLOCKED_OK 8
+
+Lisp_Object make_stdio_input_stream (FILE *stream, int flags);
+Lisp_Object make_stdio_output_stream (FILE *stream, int flags);
+Lisp_Object make_filedesc_input_stream (int filedesc, int offset, int count,
+ int flags);
+Lisp_Object make_filedesc_output_stream (int filedesc, int offset, int count,
+ int flags);
+void filedesc_stream_set_pty_flushing (Lstream *stream,
+ int pty_max_bytes,
+ Bufbyte eof_char);
+int filedesc_stream_fd (Lstream *stream);
+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);
+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);
+Lisp_Object make_dynarr_output_stream (unsigned_char_dynarr *dyn);
+#define LSTR_SELECTIVE 1
+#define LSTR_IGNORE_ACCESSIBLE 2
+Lisp_Object make_lisp_buffer_input_stream (struct buffer *buf, Bufpos start,
+ Bufpos end, int flags);
+Lisp_Object make_lisp_buffer_output_stream (struct buffer *buf, Bufpos pos,
+ int flags);
+Bufpos lisp_buffer_stream_startpos (Lstream *stream);
+
+#endif /* _XEMACS_LSTREAM_H_ */
--- /dev/null
+/* CANNA interface
+
+ Copyright (C) 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. */
+
+/* #### The comments in this file are mostly in EUC-formatted Japanese.
+ It would be ***soooo*** much nicer if someone could translate
+ them ... */
+
+/*
+
+ Authors: Akira Kon (kon@uxd.fc.nec.co.jp)
+ Ichiro Hirakura (hirakura@uxd.fc.nec.co.jp)
+
+ Functions defined in this file are
+
+ (canna-key-proc key)
+ key: single STRING
+ RETURNS:
+ Length of converted string if no error occurs.
+ Error string if error occurs.
+ DESCRIPTION:
+ Convert a key input to a set of strings. The
+ strings contain both well-formed string and a
+ intermediate result to show the translation
+ information to a user. converted strings are
+ stored in specific variables.
+
+ (canna-initialize)
+ RETURNS:
+ List of the following things:
+ - list of keys to toggle Japanese-mode
+ - error message
+ - list of warning messages
+ DESCRIPTION:
+ Initialize ``canna'', which is a kana-to-kanji
+ converter for GNU Emacs. The first arg
+ specifies if inserting space character between
+ BUNSETSU when candidates are displayed. The
+ second arg specifies server. The third arg
+ specifies a file which will be used as a
+ customization description. If nil is
+ specified for each arg, the default value will
+ be used.
+
+ (canna-finalize)
+ RETURNS:
+ list of warning messages
+ DESCRIPTION:
+ finalize ``canna'', which is a kana-to-kanji
+ converter for GNU Emacs. This cause to write
+ miscellaneous informations to kana-to-kanji
+ dictionary.
+
+ (canna-touroku-string string)
+ string:
+ String to register to a dictionary.
+ RETURNS:
+ The same thing returns as canna-key-proc does.
+ DESCRIPTION:
+ Register Kanji words into kana-to-kanji
+ conversion dictionary.
+
+ (canna-set-width width)
+ width:
+ Column width of the place where the candidates
+ of kana-to-kanji conversion will be shown.
+ RETURNS:
+ nil
+ DESCRIPTION:
+ Set status-line width information, which is
+ used to display kanji candidates.
+
+ (canna-change-mode num)
+ num:
+ The mode number of Canna.
+ RETURNS:
+ The same thing returns as canna-key-proc does.
+ DESCRIPTION:
+ Change Japanese pre-edit mode.
+
+ (canna-store-yomi yomi roma)
+ yomi:
+ ``Yomi'' to be stored.
+ roma:
+ ``Romaji'' which corresponds to the ``Yomi''.
+ RETURNS:
+ The same thing returns as canna-key-proc does.
+ DESCRIPTION:
+ Store yomi characters as a YOMI of
+ kana-to-kanji conversion.
+
+ (canna-do-function num ch)
+ num:
+ A function number to be called.
+ ch:
+ A character will be specified in order to feed
+ the character to the function if the function
+ needs a input character.
+ RETURNS:
+ The same thing returns as canna-key-proc does.
+ DESCRIPTION:
+ Do specified function at current mode.
+
+ (canna-parse string)
+ string:
+ To be parsed.
+ RETURNS:
+ List of warning messages.
+ DESCRIPTION:
+ Parse customize string.
+
+ (canna-query-mode)
+ RETURNS:
+ A string which indicate the current mode.
+ DESCRIPTION:
+ Get current mode string.
+
+ Functions below are used for KKCP compatible library. These
+ functions provides a base kana-to-kanji conversion system for EGG.
+ These functions may be used when users want to change the engine
+ from Wnn to Canna without changing user interface of Japanese input.
+
+ (canna-henkan-begin)
+ (canna-henkan-next)
+ (canna-bunsetu-henkou)
+ (canna-henkan-kakutei)
+ (canna-henkan-end)
+ (canna-henkan-quit)
+
+ */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "file-coding.h"
+
+#ifdef CANNA2
+#define IROHA_BC
+#include "canna/jrkanji.h"
+#include "canna/RK.h"
+#else /* !CANNA2 */
+#include "iroha/jrkanji.h"
+#include "iroha/RK.h"
+#endif /* !CANNA2 */
+extern char *jrKanjiError;
+
+#define KEYTOSTRSIZE 2048
+static unsigned char buf[KEYTOSTRSIZE];
+static char **warning;
+
+static int Vcanna_empty_info, Vcanna_through_info;
+static int Vcanna_underline;
+static int Vcanna_inhibit_hankakukana;
+
+static Lisp_Object Vcanna_kakutei_string;
+static Lisp_Object Vcanna_kakutei_yomi;
+static Lisp_Object Vcanna_kakutei_romaji;
+static Lisp_Object Vcanna_henkan_string;
+static int Vcanna_henkan_length;
+static int Vcanna_henkan_revPos;
+static int Vcanna_henkan_revLen;
+static Lisp_Object Vcanna_ichiran_string;
+static int Vcanna_ichiran_length;
+static int Vcanna_ichiran_revPos;
+static int Vcanna_ichiran_revLen;
+static Lisp_Object Vcanna_mode_string;
+
+static int IRCP_context;
+
+static Lisp_Object storeResults (unsigned char *, int, jrKanjiStatus *);
+static Lisp_Object kanjiYomiList (int, int);
+
+#ifdef CANNA_MULE
+static void m2c (unsigned char *, int, unsigned char *);
+static Lisp_Object mule_make_string (unsigned char *, int);
+static int mule_strlen (unsigned char *, int);
+static void count_char (unsigned char *,int, int, int, int *, int *, int *);
+#define make_string mule_make_string
+#endif
+
+/* Lisp functions definition */
+
+DEFUN ("canna-key-proc", Fcanna_key_proc, 1, 1, 0, /*
+Translate a key input to a set of strings. The strings contain both
+well-formed string and intermediate result to show the translation
+information to a user. Converted strings are stored in specific
+variables.
+*/
+ (ch))
+{
+ jrKanjiStatus ks;
+ int len;
+
+ CHECK_CHAR_COERCE_INT (ch);
+ len = jrKanjiString (0, XCHAR (ch), buf, KEYTOSTRSIZE, &ks);
+ return storeResults (buf, len, &ks);
+}
+
+static Lisp_Object
+storeResults (unsigned char *buf, int len, jrKanjiStatus *ks)
+{
+ Lisp_Object val = Qnil;
+
+ if (len < 0)
+ { /* Error detected */
+ val = make_string ((unsigned char*) jrKanjiError, strlen (jrKanjiError));
+ }
+ else
+ {
+ /* ³ÎÄꤷ¤¿Ê¸»úÎó */
+ Vcanna_kakutei_string = make_string (buf, len);
+ val = make_int (len);
+ /* ³ÎÄꤷ¤¿Ê¸»úÎó¤ÎÆɤߤξðÊó... */
+ Vcanna_kakutei_yomi = Vcanna_kakutei_romaji = Qnil;
+ if (ks->info & KanjiYomiInfo)
+ {
+ unsigned char *p = buf + len + 1;
+ int yomilen = strlen (p);
+
+ if (len + yomilen + 1 < KEYTOSTRSIZE)
+ {
+ int yomilen2;
+
+ Vcanna_kakutei_yomi = make_string (p, yomilen); /* ÆÉ¤ß */
+ p += yomilen + 1;
+ yomilen2 = strlen (p);
+ if (len + yomilen + yomilen2 + 2 < KEYTOSTRSIZE)
+ {
+ Vcanna_kakutei_romaji = make_string (p, yomilen2); /* ¥í¡¼¥Þ»ú */
+ }
+ }
+ }
+
+
+ /* ¸õÊäɽ¼¨¤Îʸ»úÎó¤Ç¤¹¡£*/
+ Vcanna_henkan_string = Qnil;
+ if (ks->length >= 0)
+ {
+ Vcanna_henkan_string = make_string (ks->echoStr, ks->length);
+#ifndef CANNA_MULE
+ Vcanna_henkan_length = ks->length;
+ Vcanna_henkan_revPos = ks->revPos;
+ Vcanna_henkan_revLen = ks->revLen;
+#else /* CANNA_MULE */
+ if (Vcanna_underline)
+ {
+ Vcanna_henkan_length = mule_strlen (ks->echoStr,ks->length);
+ Vcanna_henkan_revPos = mule_strlen (ks->echoStr,ks->revPos);
+ Vcanna_henkan_revLen = mule_strlen (ks->echoStr+ks->revPos,ks->revLen);
+ }
+ else
+ {
+ count_char (ks->echoStr, ks->length, ks->revPos, ks->revLen,
+ &Vcanna_henkan_length, &Vcanna_henkan_revPos,
+ &Vcanna_henkan_revLen);
+ }
+#endif /* CANNA_MULE */
+ }
+
+ /* °ìÍ÷¤Î¾ðÊó */
+ Vcanna_ichiran_string = Qnil;
+ if (ks->info & KanjiGLineInfo && ks->gline.length >= 0)
+ {
+ Vcanna_ichiran_string = make_string (ks->gline.line, ks->gline.length);
+#ifndef CANNA_MULE
+ Vcanna_ichiran_length = ks->gline.length;
+ Vcanna_ichiran_revPos = ks->gline.revPos;
+ Vcanna_ichiran_revLen = ks->gline.revLen;
+#else /* CANNA_MULE */
+ count_char (ks->gline.line, ks->gline.length,
+ ks->gline.revPos, ks->gline.revLen, &Vcanna_ichiran_length,
+ &Vcanna_ichiran_revPos, &Vcanna_ichiran_revLen);
+#endif /* CANNA_MULE */
+ }
+
+ /* ¥â¡¼¥É¤Î¾ðÊó */
+ Vcanna_mode_string = Qnil;
+ if (ks->info & KanjiModeInfo)
+ {
+ Vcanna_mode_string = make_string (ks->mode, strlen (ks->mode));
+ }
+
+ /* ¤½¤Î¾¤Î¾ðÊó */
+ Vcanna_empty_info = (ks->info & KanjiEmptyInfo) ? 1 : 0;
+ Vcanna_through_info = (ks->info & KanjiThroughInfo) ? 1 : 0;
+ }
+
+ return val;
+}
+
+DEFUN ("canna-set-bunsetsu-kugiri", Fcanna_set_bunsetsu, 0, 1, 0, /*
+This function sets the clause separator.
+If non-nil value is specified, the white space separator will be used.
+No separator will be used otherwise.
+*/
+ (num))
+{
+ int kugiri; /* ʸÀá¶èÀÚ¤ê¤ò¤¹¤ë¤«¡© */
+
+ kugiri = NILP (num) ? 0 : 1;
+
+ jrKanjiControl (0, KC_SETBUNSETSUKUGIRI, (char *) kugiri);
+
+ return Qnil;
+}
+
+/* For whatever reason, calling Fding directly from libCanna loses */
+static void call_Fding()
+{
+ extern Lisp_Object Fding();
+
+ Fding (Qnil, Qnil, Qnil);
+}
+
+DEFUN ("canna-initialize", Fcanna_initialize, 0, 3, 0, /*
+Initialize ``canna'', which is a kana-to-kanji converter for GNU Emacs.
+The first arg specifies if inserting space character between BUNSETSU when
+candidates are displayed.
+The second arg specifies server.
+The third arg specifies a file which will be used as a customization
+description.
+If nil is specified for each arg, the default value will be used.
+*/
+ (num, server, rcfile))
+{
+ Lisp_Object val;
+ int res;
+ unsigned char **p, **q;
+
+ int kugiri; /* ʸÀá¶èÀÚ¤ê¤ò¤¹¤ë¤«¡© */
+
+ IRCP_context = -1;
+
+ if (NILP (num))
+ {
+ kugiri = 1;
+ }
+ else
+ {
+ CHECK_INT (num);
+ kugiri = XINT (num);
+ kugiri = (kugiri == 1) ? 1 : 0;
+ }
+
+ if (NILP (server))
+ {
+ jrKanjiControl (0, KC_SETSERVERNAME, (char *) 0);
+ }
+ else
+ {
+ char servername[256];
+
+ CHECK_STRING (server);
+ strncpy (servername, XSTRING (server)->_data, XSTRING (server)->_size);
+ servername[XSTRING (server)->_size] = '\0';
+ jrKanjiControl (0, KC_SETSERVERNAME, servername);
+ }
+
+ if (NILP (rcfile))
+ {
+ jrKanjiControl (0, KC_SETINITFILENAME, (char *) 0);
+ }
+ else
+ {
+ char rcname[256];
+
+ CHECK_STRING (rcfile);
+ strncpy (rcname, XSTRING (rcfile)->_data, XSTRING (rcfile)->_size);
+ rcname[XSTRING (rcfile)->_size] = '\0';
+ jrKanjiControl (0, KC_SETINITFILENAME, rcname);
+ }
+
+ warning = (char **) 0;
+#ifdef nec_ews_svr4
+ stop_polling ();
+#endif /* nec_ews_svr4 */
+ res = jrKanjiControl (0, KC_INITIALIZE, (char *)&warning);
+#ifdef nec_ews_svr4
+ start_polling ();
+#endif /* nec_ews_svr4 */
+ val = Qnil;
+ if (warning)
+ {
+ for (p = q = (unsigned char **) warning ; *q ; q++)
+ ;
+ while (p < q)
+ {
+ q--;
+ val = Fcons (make_string (*q, strlen (*q)), val);
+ }
+ }
+ val = Fcons (val, Qnil);
+
+ if (res == -1)
+ {
+ val = Fcons (make_string ((unsigned char*) jrKanjiError,
+ strlen (jrKanjiError)), val);
+ /* ¥¤¥Ë¥·¥ã¥é¥¤¥º¤Ç¼ºÇÔ¤·¤¿¾ì¹ç¡£ */
+ return Fcons (Qnil, val);
+ }
+ else
+ {
+ extern void (*jrBeepFunc)();
+ Lisp_Object CANNA_mode_keys ();
+
+ jrBeepFunc = call_Fding;
+
+#ifdef KC_SETAPPNAME
+#ifndef CANNA_MULE
+ wcKanjiControl (0, KC_SETAPPNAME, "nemacs");
+#else /* CANNA_MULE */
+ wcKanjiControl (0, KC_SETAPPNAME, "mule");
+#endif /* CANNA_MULE */
+#endif /* KC_SETAPPNAME */
+
+ jrKanjiControl (0, KC_SETBUNSETSUKUGIRI, (char *) kugiri);
+ jrKanjiControl (0, KC_SETWIDTH, (char *) 78);
+#ifndef CANNA_MULE
+ jrKanjiControl (0, KC_INHIBITHANKAKUKANA, (char *) 1);
+#else
+ /* mule ¤À¤Ã¤¿¤éȾ³Ñ¥«¥¿¥«¥Ê¤â»È¤¨¤ë */
+ if (Vcanna_inhibit_hankakukana)
+ jrKanjiControl (0, KC_INHIBITHANKAKUKANA, (char *) 1);
+#endif
+ jrKanjiControl (0, KC_YOMIINFO, (char *) 2); /* ¢¨£²: ¥í¡¼¥Þ»ú¤Þ¤ÇÊÖ¤¹ */
+ val = Fcons (Qnil, val);
+ return Fcons (CANNA_mode_keys (), val);
+ }
+}
+
+DEFUN ("canna-finalize", Fcanna_finalize, 0, 0, 0, /*
+finalize ``canna'', which is a kana-to-kanji converter for GNU Emacs.
+This cause to write miscellaneous informations to kana-to-kanji dictionary.
+*/
+ ())
+{
+ Lisp_Object val;
+ unsigned char **p;
+
+ jrKanjiControl (0, KC_FINALIZE, (char *)&warning);
+
+ val = Qnil;
+ if (warning)
+ {
+ for (p = (unsigned char**) warning ; *p ; p++)
+ {
+ val = Fcons (make_string (*p, strlen (*p)), val);
+ }
+ }
+ val = Fcons (val, Qnil);
+ IRCP_context = -1;
+ return val;
+}
+
+DEFUN ("canna-touroku-string", Fcanna_touroku_string, 1, 1, 0, /*
+Register Kanji words into kana-to-kanji conversion dictionary.
+*/
+ (str))
+{
+ jrKanjiStatusWithValue ksv;
+ jrKanjiStatus ks;
+ int len;
+ Lisp_Object val;
+#ifdef CANNA_MULE
+ unsigned char cbuf[4096];
+#endif
+
+ CHECK_STRING (str);
+ ksv.buffer = (unsigned char *) buf;
+ ksv.bytes_buffer = KEYTOSTRSIZE;
+#ifndef CANNA_MULE
+ ks.echoStr = XSTRING (str)->_data;
+ ks.length = XSTRING (str)->_size;
+#else /* CANNA_MULE */
+ m2c (XSTRING (str)->_data, XSTRING (str)->_size, cbuf);
+ ks.echoStr = cbuf;
+ ks.length = strlen (cbuf);
+#endif /* CANNA_MULE */
+ ksv.ks = &ks;
+ len = jrKanjiControl (0, KC_DEFINEKANJI, (char *)&ksv);
+ val = storeResults (buf, ksv.val, ksv.ks);
+ return val;
+}
+
+DEFUN ("canna-set-width", Fcanna_set_width, 1, 1, 0, /*
+Set status-line width information, which is used to display
+kanji candidates.
+*/
+ (num))
+{
+ CHECK_INT (num);
+
+ jrKanjiControl (0, KC_SETWIDTH, (char *) XINT (num));
+ return Qnil;
+}
+
+DEFUN ("canna-change-mode", Fcanna_change_mode, 1, 1, 0, /*
+Change Japanese pre-edit mode.
+*/
+ (num))
+{
+ jrKanjiStatusWithValue ksv;
+ jrKanjiStatus ks;
+ Lisp_Object val;
+
+ CHECK_INT (num);
+
+ ksv.buffer = (unsigned char *) buf;
+ ksv.bytes_buffer = KEYTOSTRSIZE;
+ ksv.ks = &ks;
+ ksv.val = XINT (num);
+ jrKanjiControl (0, KC_CHANGEMODE, (char *)&ksv);
+ val = storeResults (buf, ksv.val, ksv.ks);
+ return val;
+}
+
+Lisp_Object
+CANNA_mode_keys (void)
+{
+#define CANNAWORKBUFSIZE 32
+ char xxx[CANNAWORKBUFSIZE];
+ Lisp_Object val;
+ int i, n;
+
+ n = jrKanjiControl (0, KC_MODEKEYS, xxx);
+ val = Qnil;
+ for (i = n ; i > 0 ;)
+ {
+ --i;
+ /* !!#### something fucked here */
+ val = Fcons (make_char ((int)(0xFF & (unsigned char) xxx[i])), val);
+ }
+ return val;
+}
+
+DEFUN ("canna-store-yomi", Fcanna_store_yomi, 1, 2, 0, /*
+Store yomi characters as a YOMI of kana-to-kanji conversion.
+*/
+ (yomi, roma))
+{
+ jrKanjiStatusWithValue ksv;
+ jrKanjiStatus ks;
+
+ CHECK_STRING (yomi);
+#ifndef CANNA_MULE
+ strncpy (buf, XSTRING (yomi)->_data, XSTRING (yomi)->_size);
+ ks.length = XSTRING (yomi)->_size;
+ buf[ks.length] = '\0';
+#else /* CANNA_MULE */
+ m2c (XSTRING (yomi)->_data, XSTRING (yomi)->_size, buf);
+ ks.length = strlen (buf);
+#endif /* CANNA_MULE */
+
+ if (NILP (roma))
+ {
+ ks.mode = 0;
+ }
+ else
+ {
+ CHECK_STRING (roma);
+
+#ifndef CANNA_MULE
+ strncpy (buf + XSTRING (yomi)->_size + 1, XSTRING (roma)->_data,
+ XSTRING (roma)->_size);
+ buf[XSTRING (yomi)->_size + 1 + XSTRING (roma)->_size] = '\0';
+ ks.mode = (unsigned char *)(buf + XSTRING (yomi)->_size + 1);
+#else /* CANNA_MULE */
+ ks.mode = (unsigned char *)(buf + ks.length + 1);
+ m2c (XSTRING (roma)->_data, XSTRING (roma)->_size, ks.mode);
+#endif /* CANNA_MULE */
+ }
+
+ ks.echoStr = (unsigned char *) buf;
+ ksv.buffer = (unsigned char *) buf; /* ÊÖÃÍÍÑ */
+ ksv.bytes_buffer = KEYTOSTRSIZE;
+ ksv.ks = &ks;
+
+ jrKanjiControl (0, KC_STOREYOMI, (char *)&ksv);
+
+ return storeResults (buf, ksv.val, ksv.ks);
+}
+
+DEFUN ("canna-do-function", Fcanna_do_function, 1, 2, 0, /*
+Do specified function at current mode.
+*/
+ (num, ch))
+{
+ jrKanjiStatusWithValue ksv;
+ jrKanjiStatus ks;
+ Lisp_Object val;
+
+ CHECK_INT (num);
+
+ if (NILP (ch))
+ {
+ *buf = '@';
+ }
+ else
+ {
+ CHECK_CHAR (ch);
+ *buf = XCHAR (ch);
+ }
+
+ ksv.buffer = (unsigned char *) buf;
+ ksv.bytes_buffer = KEYTOSTRSIZE;
+ ksv.ks = &ks;
+ ksv.val = XINT (num);
+ jrKanjiControl (0, KC_DO, (char *) &ksv);
+ val = storeResults (buf, ksv.val, ksv.ks);
+ return val;
+}
+
+DEFUN ("canna-parse", Fcanna_parse, 1, 1, 0, /*
+Parse customize string.
+*/
+ (str))
+{
+ Lisp_Object val;
+ unsigned char **p;
+ int n;
+
+ CHECK_STRING (str);
+
+#ifndef CANNA_MULE
+ strncpy (buf, XSTRING (str)->_data, XSTRING (str)->_size);
+ buf[XSTRING (str)->_size] = '\0';
+#else /* CANNA_MULE */
+ m2c (XSTRING (str)->_data, XSTRING (str)->_size, buf);
+#endif /* CANNA_MULE */
+ p = (unsigned char**) buf;
+ n = jrKanjiControl (0, KC_PARSE, (char *) &p);
+ val = Qnil;
+ while (n > 0)
+ {
+ n--;
+ val = Fcons (make_string (p[n], strlen (p[n])), val);
+ }
+ return val;
+}
+
+DEFUN ("canna-query-mode", Fcanna_query_mode, 0, 0, 0, /*
+Get current mode string.
+*/
+ ())
+{
+ unsigned char buf[256];
+
+ jrKanjiControl (0, KC_QUERYMODE, buf);
+ return make_string (buf, strlen (buf));
+}
+
+/*
+ * Functions following this line are for KKCP interface compatible
+ * library. These functions may be used by MILK system.
+ */
+
+#define RKBUFSIZE 1024
+
+static unsigned char yomibuf[RKBUFSIZE];
+static short kugiri[RKBUFSIZE / 2];
+
+static int
+confirmContext (void)
+{
+ if (IRCP_context < 0)
+ {
+ int context;
+
+ if ((context = jrKanjiControl (0, KC_GETCONTEXT, (char *) 0)) == -1)
+ {
+ return 0;
+ }
+ IRCP_context = context;
+ }
+ return 1;
+}
+
+static int
+byteLen (int bun, int len)
+{
+ int i = 0, offset = 0, ch;
+
+ if (0 <= bun && bun < RKBUFSIZE)
+ {
+ offset = kugiri[bun];
+ }
+
+ while (len-- > 0 && (ch = (int) yomibuf[offset + i]))
+ {
+ i++;
+ if (ch & 0x80)
+ {
+ i++;
+ }
+ }
+ return i;
+}
+
+DEFUN ("canna-henkan-begin", Fcanna_henkan_begin, 1, 1, 0, /*
+¤«¤Ê´Á»úÊÑ´¹¤·¤¿·ë²Ì¤òÊÖ´Ô¤¹¤ë¡£Ê¸ÀáÀڤ꤬¤·¤Æ¤¢¤ë¡£
+*/
+ (yomi))
+{
+ int nbun;
+
+ CHECK_STRING (yomi);
+ if (confirmContext () == 0)
+ {
+ return Qnil;
+ }
+#ifndef CANNA_MULE
+ strncpy (yomibuf, XSTRING (yomi)->_data, XSTRING (yomi)->_size);
+ yomibuf[XSTRING (yomi)->_size] = '\0';
+ nbun = RkBgnBun (IRCP_context, XSTRING (yomi)->_data, XSTRING (yomi)->_size,
+ (RK_XFER << RK_XFERBITS) | RK_KFER);
+#else /* CANNA_MULE */
+ m2c (XSTRING (yomi)->_data, XSTRING (yomi)->_size, yomibuf);
+ nbun = RkBgnBun (IRCP_context, (char *) yomibuf, strlen (yomibuf),
+ (RK_XFER << RK_XFERBITS) | RK_KFER);
+#endif /* CANNA_MULE */
+
+ return kanjiYomiList (IRCP_context, nbun);
+}
+
+static Lisp_Object
+kanjiYomiList (int context, int nbun)
+{
+ Lisp_Object val, res = Qnil;
+ unsigned char RkBuf[RKBUFSIZE];
+ int len, i, total;
+
+ for (i = nbun ; i > 0 ; )
+ {
+ i--;
+ RkGoTo (context, i);
+ len = RkGetKanji (context, RkBuf, RKBUFSIZE);
+ val = make_string (RkBuf, len);
+ len = RkGetYomi (context, RkBuf, RKBUFSIZE);
+ res = Fcons (Fcons (val, make_string (RkBuf, len)), res);
+ if (i < RKBUFSIZE / 2)
+ {
+ kugiri[i] = len;
+ }
+ }
+ for (i = 0, total = 0 ; i < nbun ; i++)
+ {
+ int temp = kugiri[i];
+ kugiri[i] = total;
+ total += temp;
+ }
+ return res;
+}
+
+DEFUN ("canna-henkan-next", Fcanna_henkan_next, 1, 1, 0, /*
+¸õÊä°ìÍ÷¤òµá¤á¤ë¡£
+*/
+ (bunsetsu))
+{
+ int i, slen, len;
+ unsigned char *p, RkBuf[RKBUFSIZE];
+ Lisp_Object res = Qnil, endp;
+
+ CHECK_INT (bunsetsu);
+ if (confirmContext () == 0)
+ {
+ return Qnil;
+ }
+ RkGoTo (IRCP_context, XINT (bunsetsu));
+ len = RkGetKanjiList (IRCP_context, RkBuf, RKBUFSIZE);
+ p = RkBuf;
+ for (i = 0 ; i < len ; i++)
+ {
+ slen = strlen (p);
+ if (NILP(res))
+ {
+ endp = res = Fcons (make_string (p, slen), Qnil);
+ }
+ else
+ {
+ endp = XCDR (endp) = Fcons (make_string (p, slen), Qnil);
+ }
+ p += slen + 1;
+ }
+ return res;
+}
+
+DEFUN ("canna-bunsetu-henkou", Fcanna_bunsetu_henkou, 2, 2, 0, /*
+ʸÀá¤ÎŤµ¤ò»ØÄꤹ¤ë¡£
+*/
+ (bunsetsu, bunlen))
+{
+ int nbun, len;
+
+ CHECK_INT (bunsetsu);
+ CHECK_INT (bunlen);
+
+ nbun = XINT (bunsetsu);
+ if (confirmContext () == 0)
+ {
+ return Qnil;
+ }
+ RkGoTo (IRCP_context, nbun);
+ len = byteLen (nbun, XINT (bunlen));
+ return kanjiYomiList (IRCP_context, RkResize (IRCP_context, len));
+}
+
+DEFUN ("canna-henkan-kakutei", Fcanna_henkan_kakutei, 2, 2, 0, /*
+¸õÊäÁªÂò¡£
+*/
+ (bun, kouho))
+{
+ int nbun, nkouho;
+
+ if (confirmContext () == 0)
+ {
+ return Qnil;
+ }
+ nbun = XINT(bun);
+ RkGoTo (IRCP_context, nbun);
+
+ nkouho = XINT(kouho);
+ RkXfer (IRCP_context, nkouho);
+ return Qt;
+}
+
+DEFUN ("canna-henkan-end", Fcanna_henkan_end, 0, 0, 0, /*
+ÊÑ´¹½ªÎ»¡£
+*/
+ ())
+{
+ if (confirmContext () == 0)
+ {
+ return Qnil;
+ }
+ RkEndBun (IRCP_context, 1); /* ³Ø½¬¤Ï¤¤¤Ä¤Ç¤â¹Ô¤Ã¤ÆÎɤ¤¤â¤Î¤Ê¤Î¤«¡© */
+ return Qt;
+}
+
+DEFUN ("canna-henkan-quit", Fcanna_henkan_quit, 0, 0, 0, /*
+ÊÑ´¹½ªÎ»¡£
+*/
+ ())
+{
+ if (confirmContext () == 0)
+ {
+ return Qnil;
+ }
+ RkEndBun (IRCP_context, 0);
+ return Qt;
+}
+
+/* variables below this line is constants of Canna */
+
+static int Vcanna_mode_AlphaMode = IROHA_MODE_AlphaMode;
+static int Vcanna_mode_EmptyMode = IROHA_MODE_EmptyMode;
+static int Vcanna_mode_KigoMode = IROHA_MODE_KigoMode;
+static int Vcanna_mode_YomiMode = IROHA_MODE_YomiMode;
+static int Vcanna_mode_JishuMode = IROHA_MODE_JishuMode;
+static int Vcanna_mode_TankouhoMode = IROHA_MODE_TankouhoMode;
+static int Vcanna_mode_IchiranMode = IROHA_MODE_IchiranMode;
+static int Vcanna_mode_YesNoMode = IROHA_MODE_YesNoMode;
+static int Vcanna_mode_OnOffMode = IROHA_MODE_OnOffMode;
+#ifdef CANNA_MODE_AdjustBunsetsuMode
+static int Vcanna_mode_AdjustBunsetsuMode = CANNA_MODE_AdjustBunsetsuMode;
+#endif
+#ifdef CANNA_MODE_ChikujiYomiMode
+static int Vcanna_mode_ChikujiYomiMode = CANNA_MODE_ChikujiYomiMode;
+static int Vcanna_mode_ChikujiTanMode = CANNA_MODE_ChikujiTanMode;
+#endif
+
+static int Vcanna_mode_HenkanMode = IROHA_MODE_HenkanMode;
+#ifdef CANNA_MODE_HenkanNyuryokuMode
+static int Vcanna_mode_HenkanNyuryokuMode = CANNA_MODE_HenkanNyuryokuMode;
+#endif
+#ifdef CANNA_MODE_ZenHiraHenkanMode
+static int Vcanna_mode_ZenHiraHenkanMode = CANNA_MODE_ZenHiraHenkanMode;
+#ifdef CANNA_MODE_HanHiraHenkanMode
+static int Vcanna_mode_HanHiraHenkanMode = CANNA_MODE_HanHiraHenkanMode;
+#endif
+static int Vcanna_mode_ZenKataHenkanMode = CANNA_MODE_ZenKataHenkanMode;
+static int Vcanna_mode_HanKataHenkanMode = CANNA_MODE_HanKataHenkanMode;
+static int Vcanna_mode_ZenAlphaHenkanMode = CANNA_MODE_ZenAlphaHenkanMode;
+static int Vcanna_mode_HanAlphaHenkanMode = CANNA_MODE_HanAlphaHenkanMode;
+#endif
+static int Vcanna_mode_ZenHiraKakuteiMode = IROHA_MODE_ZenHiraKakuteiMode;
+#ifdef CANNA_MODE_HanHiraKakuteiMode
+static int Vcanna_mode_HanHiraKakuteiMode = CANNA_MODE_HanHiraKakuteiMode;
+#endif
+static int Vcanna_mode_ZenKataKakuteiMode = IROHA_MODE_ZenKataKakuteiMode;
+static int Vcanna_mode_HanKataKakuteiMode = IROHA_MODE_HanKataKakuteiMode;
+static int Vcanna_mode_ZenAlphaKakuteiMode = IROHA_MODE_ZenAlphaKakuteiMode;
+static int Vcanna_mode_HanAlphaKakuteiMode = IROHA_MODE_HanAlphaKakuteiMode;
+static int Vcanna_mode_HexMode = IROHA_MODE_HexMode;
+static int Vcanna_mode_BushuMode = IROHA_MODE_BushuMode;
+static int Vcanna_mode_ExtendMode = IROHA_MODE_ExtendMode;
+static int Vcanna_mode_RussianMode = IROHA_MODE_RussianMode;
+static int Vcanna_mode_GreekMode = IROHA_MODE_GreekMode;
+static int Vcanna_mode_LineMode = IROHA_MODE_LineMode;
+static int Vcanna_mode_ChangingServerMode = IROHA_MODE_ChangingServerMode;
+static int Vcanna_mode_HenkanMethodMode = IROHA_MODE_HenkanMethodMode;
+static int Vcanna_mode_DeleteDicMode = IROHA_MODE_DeleteDicMode;
+static int Vcanna_mode_TourokuMode = IROHA_MODE_TourokuMode;
+static int Vcanna_mode_TourokuEmptyMode = IROHA_MODE_TourokuEmptyMode;
+static int Vcanna_mode_TourokuHinshiMode = IROHA_MODE_TourokuHinshiMode;
+static int Vcanna_mode_TourokuDicMode = IROHA_MODE_TourokuDicMode;
+static int Vcanna_mode_QuotedInsertMode = IROHA_MODE_QuotedInsertMode;
+static int Vcanna_mode_BubunMuhenkanMode = IROHA_MODE_BubunMuhenkanMode;
+static int Vcanna_mode_MountDicMode = IROHA_MODE_MountDicMode;
+
+static int Vcanna_fn_SelfInsert = IROHA_FN_SelfInsert;
+static int Vcanna_fn_FunctionalInsert = IROHA_FN_FunctionalInsert;
+static int Vcanna_fn_QuotedInsert = IROHA_FN_QuotedInsert;
+static int Vcanna_fn_JapaneseMode = IROHA_FN_JapaneseMode;
+static int Vcanna_fn_AlphaMode = IROHA_FN_AlphaMode;
+static int Vcanna_fn_HenkanNyuryokuMode = IROHA_FN_HenkanNyuryokuMode;
+static int Vcanna_fn_Forward = IROHA_FN_Forward;
+static int Vcanna_fn_Backward = IROHA_FN_Backward;
+static int Vcanna_fn_Next = IROHA_FN_Next;
+static int Vcanna_fn_Prev = IROHA_FN_Prev;
+static int Vcanna_fn_BeginningOfLine = IROHA_FN_BeginningOfLine;
+static int Vcanna_fn_EndOfLine = IROHA_FN_EndOfLine;
+static int Vcanna_fn_DeleteNext = IROHA_FN_DeleteNext;
+static int Vcanna_fn_DeletePrevious = IROHA_FN_DeletePrevious;
+static int Vcanna_fn_KillToEndOfLine = IROHA_FN_KillToEndOfLine;
+static int Vcanna_fn_Henkan = IROHA_FN_Henkan;
+static int Vcanna_fn_Kakutei = IROHA_FN_Kakutei;
+static int Vcanna_fn_Extend = IROHA_FN_Extend;
+static int Vcanna_fn_Shrink = IROHA_FN_Shrink;
+#ifdef CANNA_FN_AdjustBunsetsu
+static int Vcanna_fn_AdjustBunsetsu = CANNA_FN_AdjustBunsetsu;
+#endif
+static int Vcanna_fn_Quit = IROHA_FN_Quit;
+static int Vcanna_fn_ConvertAsHex = IROHA_FN_ConvertAsHex;
+static int Vcanna_fn_ConvertAsBushu = IROHA_FN_ConvertAsBushu;
+static int Vcanna_fn_KouhoIchiran = IROHA_FN_KouhoIchiran;
+static int Vcanna_fn_BubunMuhenkan = IROHA_FN_BubunMuhenkan;
+static int Vcanna_fn_Zenkaku = IROHA_FN_Zenkaku;
+static int Vcanna_fn_Hankaku = IROHA_FN_Hankaku;
+static int Vcanna_fn_ToUpper = IROHA_FN_ToUpper;
+static int Vcanna_fn_Capitalize = IROHA_FN_Capitalize;
+static int Vcanna_fn_ToLower = IROHA_FN_ToLower;
+static int Vcanna_fn_Hiragana = IROHA_FN_Hiragana;
+static int Vcanna_fn_Katakana = IROHA_FN_Katakana;
+static int Vcanna_fn_Romaji = IROHA_FN_Romaji;
+#ifdef CANNA_FN_BaseHiragana
+static int Vcanna_fn_BaseHiragana = CANNA_FN_BaseHiragana;
+static int Vcanna_fn_BaseKatakana = CANNA_FN_BaseKatakana;
+static int Vcanna_fn_BaseEisu = CANNA_FN_BaseEisu;
+static int Vcanna_fn_BaseZenkaku = CANNA_FN_BaseZenkaku;
+static int Vcanna_fn_BaseHankaku = CANNA_FN_BaseHankaku;
+static int Vcanna_fn_BaseKana = CANNA_FN_BaseKana;
+static int Vcanna_fn_BaseKakutei = CANNA_FN_BaseKakutei;
+static int Vcanna_fn_BaseHenkan = CANNA_FN_BaseHenkan;
+static int Vcanna_fn_BaseHiraKataToggle = CANNA_FN_BaseHiraKataToggle;
+static int Vcanna_fn_BaseZenHanToggle = CANNA_FN_BaseZenHanToggle;
+static int Vcanna_fn_BaseKanaEisuToggle = CANNA_FN_BaseKanaEisuToggle;
+static int Vcanna_fn_BaseKakuteiHenkanToggle =
+ CANNA_FN_BaseKakuteiHenkanToggle;
+static int Vcanna_fn_BaseRotateForward = CANNA_FN_BaseRotateForward;
+static int Vcanna_fn_BaseRotateBackward = CANNA_FN_BaseRotateBackward;
+#endif
+static int Vcanna_fn_ExtendMode = IROHA_FN_ExtendMode;
+static int Vcanna_fn_Touroku = IROHA_FN_Touroku;
+static int Vcanna_fn_HexMode = IROHA_FN_HexMode;
+static int Vcanna_fn_BushuMode = IROHA_FN_BushuMode;
+static int Vcanna_fn_KigouMode = IROHA_FN_KigouMode;
+#ifdef CANNA_FN_Mark
+static int Vcanna_fn_Mark = CANNA_FN_Mark;
+#endif
+#ifdef CANNA_FN_TemporalMode
+static int Vcanna_fn_TemporalMode = CANNA_FN_TemporalMode;
+#endif
+
+static int Vcanna_key_Nfer = IROHA_KEY_Nfer;
+static int Vcanna_key_Xfer = IROHA_KEY_Xfer;
+static int Vcanna_key_Up = IROHA_KEY_Up;
+static int Vcanna_key_Left = IROHA_KEY_Left;
+static int Vcanna_key_Right = IROHA_KEY_Right;
+static int Vcanna_key_Down = IROHA_KEY_Down;
+static int Vcanna_key_Insert = IROHA_KEY_Insert;
+static int Vcanna_key_Rollup = IROHA_KEY_Rollup;
+static int Vcanna_key_Rolldown = IROHA_KEY_Rolldown;
+static int Vcanna_key_Home = IROHA_KEY_Home;
+static int Vcanna_key_Help = IROHA_KEY_Help;
+static int Vcanna_key_KP_Key = IROHA_KEY_KP_Key;
+static int Vcanna_key_Shift_Nfer = IROHA_KEY_Shift_Nfer;
+static int Vcanna_key_Shift_Xfer = IROHA_KEY_Shift_Xfer;
+static int Vcanna_key_Shift_Up = IROHA_KEY_Shift_Up;
+static int Vcanna_key_Shift_Left = IROHA_KEY_Shift_Left;
+static int Vcanna_key_Shift_Right = IROHA_KEY_Shift_Right;
+static int Vcanna_key_Shift_Down = IROHA_KEY_Shift_Down;
+static int Vcanna_key_Cntrl_Nfer = IROHA_KEY_Cntrl_Nfer;
+static int Vcanna_key_Cntrl_Xfer = IROHA_KEY_Cntrl_Xfer;
+static int Vcanna_key_Cntrl_Up = IROHA_KEY_Cntrl_Up;
+static int Vcanna_key_Cntrl_Left = IROHA_KEY_Cntrl_Left;
+static int Vcanna_key_Cntrl_Right = IROHA_KEY_Cntrl_Right;
+static int Vcanna_key_Cntrl_Down = IROHA_KEY_Cntrl_Down;
+
+Lisp_Object VCANNA; /* by MORIOKA Tomohiko <morioka@jaist.ac.jp>
+ 1996/6/7 */
+
+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);
+ DEFSUBR (Fcanna_touroku_string);
+ DEFSUBR (Fcanna_set_width);
+ DEFSUBR (Fcanna_change_mode);
+ DEFSUBR (Fcanna_store_yomi);
+ DEFSUBR (Fcanna_do_function);
+ DEFSUBR (Fcanna_parse);
+ DEFSUBR (Fcanna_query_mode);
+ DEFSUBR (Fcanna_set_bunsetsu);
+
+ DEFSUBR (Fcanna_henkan_begin);
+ DEFSUBR (Fcanna_henkan_next);
+ DEFSUBR (Fcanna_bunsetu_henkou);
+ DEFSUBR (Fcanna_henkan_kakutei);
+ DEFSUBR (Fcanna_henkan_end);
+ DEFSUBR (Fcanna_henkan_quit);
+}
+
+void
+vars_of_mule_canna (void)
+{
+ DEFVAR_LISP ("canna-kakutei-string", &Vcanna_kakutei_string /*
+
+*/ );
+ DEFVAR_LISP ("canna-kakutei-yomi", &Vcanna_kakutei_yomi /*
+
+*/ );
+ DEFVAR_LISP ("canna-kakutei-romaji", &Vcanna_kakutei_romaji /*
+
+*/ );
+ DEFVAR_LISP ("canna-henkan-string", &Vcanna_henkan_string /*
+
+*/ );
+ DEFVAR_INT ("canna-henkan-length", &Vcanna_henkan_length /*
+
+*/ );
+ DEFVAR_INT ("canna-henkan-revpos", &Vcanna_henkan_revPos /*
+
+*/ );
+ DEFVAR_INT ("canna-henkan-revlen", &Vcanna_henkan_revLen /*
+
+*/ );
+ DEFVAR_LISP ("canna-ichiran-string", &Vcanna_ichiran_string /*
+
+*/ );
+ DEFVAR_INT ("canna-ichiran-length", &Vcanna_ichiran_length /*
+
+*/ );
+ DEFVAR_INT ("canna-ichiran-revpos", &Vcanna_ichiran_revPos /*
+
+*/ );
+ DEFVAR_INT ("canna-ichiran-revlen", &Vcanna_ichiran_revLen /*
+
+*/ );
+ DEFVAR_LISP ("canna-mode-string", &Vcanna_mode_string /*
+
+*/ );
+
+ DEFVAR_BOOL ("canna-empty-info", &Vcanna_empty_info /*
+For canna
+*/ );
+ DEFVAR_BOOL ("canna-through-info", &Vcanna_through_info /*
+For canna
+*/ );
+ DEFVAR_BOOL ("canna-underline", &Vcanna_underline /*
+For canna
+*/ );
+ DEFVAR_BOOL ("canna-inhibit-hankakukana", &Vcanna_inhibit_hankakukana /*
+For canna
+*/ );
+
+ DEFVAR_INT ("canna-mode-alpha-mode", &Vcanna_mode_AlphaMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-empty-mode", &Vcanna_mode_EmptyMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-kigo-mode", &Vcanna_mode_KigoMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-yomi-mode", &Vcanna_mode_YomiMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-jishu-mode", &Vcanna_mode_JishuMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-tankouho-mode", &Vcanna_mode_TankouhoMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-ichiran-mode", &Vcanna_mode_IchiranMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-yes-no-mode", &Vcanna_mode_YesNoMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-on-off-mode", &Vcanna_mode_OnOffMode /*
+
+*/ );
+#ifdef CANNA_MODE_AdjustBunsetsuMode
+ DEFVAR_INT ("canna-mode-adjust-bunsetsu-mode",
+ &Vcanna_mode_AdjustBunsetsuMode /*
+
+*/ );
+#endif
+#ifdef CANNA_MODE_ChikujiYomiMode
+ DEFVAR_INT ("canna-mode-chikuji-yomi-mode", &Vcanna_mode_ChikujiYomiMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-chikuji-bunsetsu-mode",
+ &Vcanna_mode_ChikujiTanMode /*
+
+*/ );
+#endif
+
+ DEFVAR_INT ("canna-mode-henkan-mode", &Vcanna_mode_HenkanMode /*
+
+*/ );
+#ifdef CANNA_MODE_HenkanNyuryokuMode
+ DEFVAR_INT ("canna-mode-henkan-nyuuryoku-mode",
+ &Vcanna_mode_HenkanNyuryokuMode /*
+
+*/ );
+#endif
+#ifdef CANNA_MODE_ZenHiraHenkanMode
+ DEFVAR_INT ("canna-mode-zen-hira-henkan-mode",
+ &Vcanna_mode_ZenHiraHenkanMode /*
+
+*/ );
+#ifdef CANNA_MODE_HanHiraHenkanMode
+ DEFVAR_INT ("canna-mode-han-hira-henkan-mode",
+ &Vcanna_mode_HanHiraHenkanMode /*
+
+*/ );
+#endif
+ DEFVAR_INT ("canna-mode-zen-kata-henkan-mode",
+ &Vcanna_mode_ZenKataHenkanMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-han-kata-henkan-mode",
+ &Vcanna_mode_HanKataHenkanMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-zen-alpha-henkan-mode",
+ &Vcanna_mode_ZenAlphaHenkanMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-han-alpha-henkan-mode",
+ &Vcanna_mode_HanAlphaHenkanMode /*
+
+*/ );
+#endif
+ DEFVAR_INT ("canna-mode-zen-hira-kakutei-mode",
+ &Vcanna_mode_ZenHiraKakuteiMode /*
+
+*/ );
+#ifdef CANNA_MODE_HanHiraKakuteiMode
+ DEFVAR_INT ("canna-mode-han-hira-kakutei-mode",
+ &Vcanna_mode_HanHiraKakuteiMode /*
+
+*/ );
+#endif
+ DEFVAR_INT ("canna-mode-zen-kata-kakutei-mode",
+ &Vcanna_mode_ZenKataKakuteiMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-han-kata-kakutei-mode",
+ &Vcanna_mode_HanKataKakuteiMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-zen-alpha-kakutei-mode",
+ &Vcanna_mode_ZenAlphaKakuteiMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-han-alpha-kakutei-mode",
+ &Vcanna_mode_HanAlphaKakuteiMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-hex-mode", &Vcanna_mode_HexMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-bushu-mode", &Vcanna_mode_BushuMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-extend-mode", &Vcanna_mode_ExtendMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-russian-mode", &Vcanna_mode_RussianMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-greek-mode", &Vcanna_mode_GreekMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-line-mode", &Vcanna_mode_LineMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-changing-server-mode",
+ &Vcanna_mode_ChangingServerMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-henkan-method-mode",
+ &Vcanna_mode_HenkanMethodMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-delete-dic-mode", &Vcanna_mode_DeleteDicMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-touroku-mode", &Vcanna_mode_TourokuMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-touroku-empty-mode",
+ &Vcanna_mode_TourokuEmptyMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-touroku-hinshi-mode",
+ &Vcanna_mode_TourokuHinshiMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-touroku-dic-mode", &Vcanna_mode_TourokuDicMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-quoted-insert-mode",
+ &Vcanna_mode_QuotedInsertMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-bubun-muhenkan-mode",
+ &Vcanna_mode_BubunMuhenkanMode /*
+
+*/ );
+ DEFVAR_INT ("canna-mode-mount-dic-mode", &Vcanna_mode_MountDicMode /*
+
+*/ );
+
+ DEFVAR_INT ("canna-func-self-insert", &Vcanna_fn_SelfInsert /*
+
+*/ );
+ DEFVAR_INT ("canna-func-functional-insert", &Vcanna_fn_FunctionalInsert /*
+
+*/ );
+ DEFVAR_INT ("canna-func-quoted-insert", &Vcanna_fn_QuotedInsert /*
+
+*/ );
+ DEFVAR_INT ("canna-func-japanese-mode", &Vcanna_fn_JapaneseMode /*
+
+*/ );
+ DEFVAR_INT ("canna-func-alpha-mode", &Vcanna_fn_AlphaMode /*
+
+*/ );
+ DEFVAR_INT ("canna-func-henkan-nyuryoku-mode",
+ &Vcanna_fn_HenkanNyuryokuMode /*
+
+*/ );
+ DEFVAR_INT ("canna-func-forward", &Vcanna_fn_Forward /*
+
+*/ );
+ DEFVAR_INT ("canna-func-backward", &Vcanna_fn_Backward /*
+
+*/ );
+ DEFVAR_INT ("canna-func-next", &Vcanna_fn_Next /*
+
+*/ );
+ DEFVAR_INT ("canna-func-previous", &Vcanna_fn_Prev /*
+
+*/ );
+ DEFVAR_INT ("canna-func-beginning-of-line", &Vcanna_fn_BeginningOfLine /*
+
+*/ );
+ DEFVAR_INT ("canna-func-end-of-line", &Vcanna_fn_EndOfLine /*
+
+*/ );
+ DEFVAR_INT ("canna-func-delete-next", &Vcanna_fn_DeleteNext /*
+
+*/ );
+ DEFVAR_INT ("canna-func-delete_previous", &Vcanna_fn_DeletePrevious /*
+
+*/ );
+ DEFVAR_INT ("canna-func-kill-to-end-of-line", &Vcanna_fn_KillToEndOfLine /*
+
+*/ );
+ DEFVAR_INT ("canna-func-henkan", &Vcanna_fn_Henkan /*
+
+*/ );
+ DEFVAR_INT ("canna-func-kakutei", &Vcanna_fn_Kakutei /*
+
+*/ );
+ DEFVAR_INT ("canna-func-extend", &Vcanna_fn_Extend /*
+
+*/ );
+ DEFVAR_INT ("canna-func-shrink", &Vcanna_fn_Shrink /*
+
+*/ );
+#ifdef CANNA_FN_AdjustBunsetsu
+ DEFVAR_INT ("canna-func-adjust-bunsetsu", &Vcanna_fn_AdjustBunsetsu /*
+
+*/ );
+#endif
+ DEFVAR_INT ("canna-func-quit", &Vcanna_fn_Quit /*
+
+*/ );
+ DEFVAR_INT ("canna-func-convert-as-hex", &Vcanna_fn_ConvertAsHex /*
+
+*/ );
+ DEFVAR_INT ("canna-func-convert-as-bushu", &Vcanna_fn_ConvertAsBushu /*
+
+*/ );
+ DEFVAR_INT ("canna-func-kouho-ichiran", &Vcanna_fn_KouhoIchiran /*
+
+*/ );
+ DEFVAR_INT ("canna-func-bubun-muhenkan", &Vcanna_fn_BubunMuhenkan /*
+
+*/ );
+ DEFVAR_INT ("canna-func-zenkaku", &Vcanna_fn_Zenkaku /*
+
+*/ );
+ DEFVAR_INT ("canna-func-hankaku", &Vcanna_fn_Hankaku /*
+
+*/ );
+ DEFVAR_INT ("canna-func-to-upper", &Vcanna_fn_ToUpper /*
+
+*/ );
+ DEFVAR_INT ("canna-func-capitalize", &Vcanna_fn_Capitalize /*
+
+*/ );
+ DEFVAR_INT ("canna-func-to-lower", &Vcanna_fn_ToLower /*
+
+*/ );
+ DEFVAR_INT ("canna-func-hiragana", &Vcanna_fn_Hiragana /*
+
+*/ );
+ DEFVAR_INT ("canna-func-katakana", &Vcanna_fn_Katakana /*
+
+*/ );
+ DEFVAR_INT ("canna-func-romaji", &Vcanna_fn_Romaji /*
+
+*/ );
+#ifdef CANNA_FN_BaseHiragana
+ DEFVAR_INT ("canna-func-base-hiragana", &Vcanna_fn_BaseHiragana /*
+
+*/ );
+ DEFVAR_INT ("canna-func-base-katakana", &Vcanna_fn_BaseKatakana /*
+
+*/ );
+ DEFVAR_INT ("canna-func-base-eisu", &Vcanna_fn_BaseEisu /*
+
+*/ );
+ DEFVAR_INT ("canna-func-base-zenkaku", &Vcanna_fn_BaseZenkaku /*
+
+*/ );
+ DEFVAR_INT ("canna-func-base-hankaku", &Vcanna_fn_BaseHankaku /*
+
+*/ );
+ DEFVAR_INT ("canna-func-base-kana", &Vcanna_fn_BaseKana /*
+
+*/ );
+ DEFVAR_INT ("canna-func-base-kakutei", &Vcanna_fn_BaseKakutei /*
+
+*/ );
+ DEFVAR_INT ("canna-func-base-henkan", &Vcanna_fn_BaseHenkan /*
+
+*/ );
+ DEFVAR_INT ("canna-func-base-hiragana-katakana-toggle",
+ &Vcanna_fn_BaseHiraKataToggle /*
+
+*/ );
+ DEFVAR_INT ("canna-func-base-zenkaku-hankaku-toggle",
+ &Vcanna_fn_BaseZenHanToggle /*
+
+*/ );
+ DEFVAR_INT ("canna-func-base-kana-eisu-toggle",
+ &Vcanna_fn_BaseKanaEisuToggle /*
+
+*/ );
+ DEFVAR_INT ("canna-func-base-kakutei-henkan-toggle",
+ &Vcanna_fn_BaseKakuteiHenkanToggle /*
+
+*/ );
+ DEFVAR_INT ("canna-func-base-rotate-forward",
+ &Vcanna_fn_BaseRotateForward /*
+
+*/ );
+ DEFVAR_INT ("canna-func-base-rotate-backward",
+ &Vcanna_fn_BaseRotateBackward /*
+
+*/ );
+#endif
+ DEFVAR_INT ("canna-func-extend-mode", &Vcanna_fn_ExtendMode /*
+
+*/ );
+ DEFVAR_INT ("canna-func-touroku", &Vcanna_fn_Touroku /*
+
+*/ );
+ DEFVAR_INT ("canna-func-hex-mode", &Vcanna_fn_HexMode /*
+
+*/ );
+ DEFVAR_INT ("canna-func-bushu-mode", &Vcanna_fn_BushuMode /*
+
+*/ );
+ DEFVAR_INT ("canna-func-kigo-mode", &Vcanna_fn_KigouMode /*
+
+*/ );
+#ifdef CANNA_FN_Mark
+ DEFVAR_INT ("canna-func-mark", &Vcanna_fn_Mark /*
+
+*/ );
+#endif
+#ifdef CANNA_FN_TemporalMode
+ DEFVAR_INT ("canna-func-temporal-mode", &Vcanna_fn_TemporalMode /*
+
+*/ );
+#endif
+
+ DEFVAR_INT ("canna-key-nfer", &Vcanna_key_Nfer /*
+
+*/ );
+ DEFVAR_INT ("canna-key-xfer", &Vcanna_key_Xfer /*
+
+*/ );
+ DEFVAR_INT ("canna-key-up", &Vcanna_key_Up /*
+
+*/ );
+ DEFVAR_INT ("canna-key-left", &Vcanna_key_Left /*
+
+*/ );
+ DEFVAR_INT ("canna-key-right", &Vcanna_key_Right /*
+
+*/ );
+ DEFVAR_INT ("canna-key-down", &Vcanna_key_Down /*
+
+*/ );
+ DEFVAR_INT ("canna-key-insert", &Vcanna_key_Insert /*
+
+*/ );
+ DEFVAR_INT ("canna-key-rollup", &Vcanna_key_Rollup /*
+
+*/ );
+ DEFVAR_INT ("canna-key-rolldown", &Vcanna_key_Rolldown /*
+
+*/ );
+ DEFVAR_INT ("canna-key-home", &Vcanna_key_Home /*
+
+*/ );
+ DEFVAR_INT ("canna-key-help", &Vcanna_key_Help /*
+
+*/ );
+ DEFVAR_INT ("canna-key-kp-key", &Vcanna_key_KP_Key /*
+
+*/ );
+ DEFVAR_INT ("canna-key-shift-nfer", &Vcanna_key_Shift_Nfer /*
+
+*/ );
+ DEFVAR_INT ("canna-key-shift-xfer", &Vcanna_key_Shift_Xfer /*
+
+*/ );
+ DEFVAR_INT ("canna-key-shift-up", &Vcanna_key_Shift_Up /*
+
+*/ );
+ DEFVAR_INT ("canna-key-shift-left", &Vcanna_key_Shift_Left /*
+
+*/ );
+ DEFVAR_INT ("canna-key-shift-right", &Vcanna_key_Shift_Right /*
+
+*/ );
+ DEFVAR_INT ("canna-key-shift-down", &Vcanna_key_Shift_Down /*
+
+*/ );
+ DEFVAR_INT ("canna-key-control-nfer", &Vcanna_key_Cntrl_Nfer /*
+
+*/ );
+ DEFVAR_INT ("canna-key-control-xfer", &Vcanna_key_Cntrl_Xfer /*
+
+*/ );
+ DEFVAR_INT ("canna-key-control-up", &Vcanna_key_Cntrl_Up /*
+
+*/ );
+ DEFVAR_INT ("canna-key-control-left", &Vcanna_key_Cntrl_Left /*
+
+*/ );
+ DEFVAR_INT ("canna-key-control-right", &Vcanna_key_Cntrl_Right /*
+
+*/ );
+ DEFVAR_INT ("canna-key-control-down", &Vcanna_key_Cntrl_Down /*
+
+*/ );
+
+ Fprovide(intern("CANNA"));
+}
+
+#ifdef CANNA_MULE
+/* To handle MULE internal code and EUC.
+ I assume CANNA can handle only Japanese EUC. */
+
+/* EUC multibyte string to MULE internal string */
+
+static void
+c2mu (char *cp, int l, char *mp)
+{
+ char ch, *ep = cp+l;
+
+ while ((cp < ep) && (ch = *cp))
+ {
+ if ((unsigned char) ch == ISO_CODE_SS2)
+ {
+ *mp++ = LEADING_BYTE_KATAKANA_JISX0201;
+ cp++;
+ }
+ else if ((unsigned char) ch == ISO_CODE_SS3)
+ {
+ *mp++ = LEADING_BYTE_JAPANESE_JISX0212;
+ cp++;
+ *mp++ = *cp++;
+ }
+ else if (ch & 0x80)
+ {
+ *mp++ = LEADING_BYTE_JAPANESE_JISX0208;
+ *mp++ = *cp++;
+ }
+ *mp++ = *cp++;
+ }
+ *mp = 0;
+}
+
+/* MULE internal string to EUC multibyte string */
+
+static void
+m2c (unsigned char *mp, int l, unsigned char *cp)
+{
+ unsigned char ch, *ep = mp + l;;
+
+ while ((mp < ep) && (ch = *mp++))
+ {
+ switch (ch)
+ {
+ case LEADING_BYTE_KATAKANA_JISX0201:
+ *cp++ = ISO_CODE_SS2;
+ *cp++ = *mp++;
+ break;
+ case LEADING_BYTE_JAPANESE_JISX0212:
+ *cp++ = ISO_CODE_SS3;
+ case LEADING_BYTE_JAPANESE_JISX0208:
+ *cp++ = *mp++;
+ *cp++ = *mp++;
+ break;
+ default:
+ *cp++ = ch;
+ break;
+ }
+ }
+ *cp = 0;
+}
+
+#undef make_string
+
+/* make_string after converting EUC string to MULE internal string */
+static Lisp_Object
+mule_make_string (unsigned char *p, int l)
+{
+ unsigned char cbuf[4096];
+
+ c2mu (p,l,cbuf);
+ return (make_string (cbuf,strlen (cbuf)));
+}
+
+/* return the MULE internal string length of EUC string */
+/* Modified by sb to return a character count not byte count. */
+static int
+mule_strlen (unsigned char *p, int l)
+{
+ unsigned char ch, *cp = p;
+ int len = 0;
+
+ while ((cp < p + l) && (ch = *cp))
+ {
+ if ((unsigned char) ch == ISO_CODE_SS2)
+ {
+ len++;
+ cp += 2;
+ }
+ else if ((unsigned char) ch == ISO_CODE_SS3)
+ {
+ len++;
+ cp += 3;
+ }
+ else if (ch & 0x80)
+ {
+ len++;
+ cp += 2;
+ }
+ else
+ {
+ len++;
+ cp++;
+ }
+ }
+ return (len);
+}
+
+/* count number of characters */
+static void
+count_char (unsigned char *p, int len, int pos, int rev, int *clen, int *cpos,
+ int *crev)
+{
+ unsigned char *q = p;
+
+ *clen = *cpos = *crev = 0;
+ if (len == 0) return;
+ while (q < p + pos)
+ {
+ (*clen)++;
+ (*cpos)++;
+ if (*q++ & 0x80) q++;
+ }
+ while (q < p + pos + rev)
+ {
+ (*clen)++;
+ (*crev)++;
+ if (*q++ & 0x80) q++;
+ }
+ while (q < p + len)
+ {
+ (*clen)++;
+ if (*q++ & 0x80) q++;
+ }
+}
+#endif /* CANNA_MULE */
--- /dev/null
+/* CCL (Code Conversion Language) interpreter.
+ Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
+ Licensed to the Free Software Foundation.
+
+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.
+
+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 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. */
+
+/* Synched up with : FSF Emacs 20.2 */
+
+#ifdef emacs
+
+#include <config.h>
+#include "lisp.h"
+#include "buffer.h"
+#include "mule-charset.h"
+#include "mule-ccl.h"
+#include "file-coding.h"
+
+#else /* not emacs */
+
+#include <stdio.h>
+#include "mulelib.h"
+
+#endif /* not emacs */
+
+/* Alist of fontname patterns vs corresponding CCL program. */
+Lisp_Object Vfont_ccl_encoder_alist;
+
+/* Vector of CCL program names vs corresponding program data. */
+Lisp_Object Vccl_program_table;
+
+/* CCL (Code Conversion Language) is a simple language which has
+ operations on one input buffer, one output buffer, and 7 registers.
+ The syntax of CCL is described in `ccl.el'. Emacs Lisp function
+ `ccl-compile' compiles a CCL program and produces a CCL code which
+ is a vector of integers. The structure of this vector is as
+ follows: The 1st element: buffer-magnification, a factor for the
+ size of output buffer compared with the size of input buffer. The
+ 2nd element: address of CCL code to be executed when encountered
+ with end of input stream. The 3rd and the remaining elements: CCL
+ codes. */
+
+/* Header of CCL compiled code */
+#define CCL_HEADER_BUF_MAG 0
+#define CCL_HEADER_EOF 1
+#define CCL_HEADER_MAIN 2
+
+/* CCL code is a sequence of 28-bit non-negative integers (i.e. the
+ MSB is always 0), each contains CCL command and/or arguments in the
+ following format:
+
+ |----------------- integer (28-bit) ------------------|
+ |------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -|
+ |--constant argument--|-register-|-register-|-command-|
+ ccccccccccccccccc RRR rrr XXXXX
+ or
+ |------- relative address -------|-register-|-command-|
+ cccccccccccccccccccc rrr XXXXX
+ or
+ |------------- constant or other args ----------------|
+ cccccccccccccccccccccccccccc
+
+ where, `cc...c' is a non-negative integer indicating constant value
+ (the left most `c' is always 0) or an absolute jump address, `RRR'
+ and `rrr' are CCL register number, `XXXXX' is one of the following
+ CCL commands. */
+
+/* CCL commands
+
+ Each comment fields shows one or more lines for command syntax and
+ the following lines for semantics of the command. In semantics, IC
+ stands for Instruction Counter. */
+
+#define CCL_SetRegister 0x00 /* Set register a register value:
+ 1:00000000000000000RRRrrrXXXXX
+ ------------------------------
+ reg[rrr] = reg[RRR];
+ */
+
+#define CCL_SetShortConst 0x01 /* Set register a short constant value:
+ 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
+ ------------------------------
+ reg[rrr] = CCCCCCCCCCCCCCCCCCC;
+ */
+
+#define CCL_SetConst 0x02 /* Set register a constant value:
+ 1:00000000000000000000rrrXXXXX
+ 2:CONSTANT
+ ------------------------------
+ reg[rrr] = CONSTANT;
+ IC++;
+ */
+
+#define CCL_SetArray 0x03 /* Set register an element of array:
+ 1:CCCCCCCCCCCCCCCCCRRRrrrXXXXX
+ 2:ELEMENT[0]
+ 3:ELEMENT[1]
+ ...
+ ------------------------------
+ if (0 <= reg[RRR] < CC..C)
+ reg[rrr] = ELEMENT[reg[RRR]];
+ IC += CC..C;
+ */
+
+#define CCL_Jump 0x04 /* Jump:
+ 1:A--D--D--R--E--S--S-000XXXXX
+ ------------------------------
+ IC += ADDRESS;
+ */
+
+/* Note: If CC..C is greater than 0, the second code is omitted. */
+
+#define CCL_JumpCond 0x05 /* Jump conditional:
+ 1:A--D--D--R--E--S--S-rrrXXXXX
+ ------------------------------
+ if (!reg[rrr])
+ IC += ADDRESS;
+ */
+
+
+#define CCL_WriteRegisterJump 0x06 /* Write register and jump:
+ 1:A--D--D--R--E--S--S-rrrXXXXX
+ ------------------------------
+ write (reg[rrr]);
+ IC += ADDRESS;
+ */
+
+#define CCL_WriteRegisterReadJump 0x07 /* Write register, read, and jump:
+ 1:A--D--D--R--E--S--S-rrrXXXXX
+ 2:A--D--D--R--E--S--S-rrrYYYYY
+ -----------------------------
+ write (reg[rrr]);
+ IC++;
+ read (reg[rrr]);
+ IC += ADDRESS;
+ */
+/* Note: If read is suspended, the resumed execution starts from the
+ second code (YYYYY == CCL_ReadJump). */
+
+#define CCL_WriteConstJump 0x08 /* Write constant and jump:
+ 1:A--D--D--R--E--S--S-000XXXXX
+ 2: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
+ 3:A--D--D--R--E--S--S-rrrYYYYY
+ -----------------------------
+ write (CONST);
+ IC += 2;
+ read (reg[rrr]);
+ IC += ADDRESS;
+ */
+/* Note: If read is suspended, the resumed execution starts from the
+ second code (YYYYY == CCL_ReadJump). */
+
+#define CCL_WriteStringJump 0x0A /* Write string and jump:
+ 1:A--D--D--R--E--S--S-000XXXXX
+ 2:LENGTH
+ 3:0000STRIN[0]STRIN[1]STRIN[2]
+ ...
+ ------------------------------
+ write_string (STRING, LENGTH);
+ IC += ADDRESS;
+ */
+
+#define CCL_WriteArrayReadJump 0x0B /* Write an array element, read, and jump:
+ 1:A--D--D--R--E--S--S-rrrXXXXX
+ 2:LENGTH
+ 3:ELEMENET[0]
+ 4:ELEMENET[1]
+ ...
+ N:A--D--D--R--E--S--S-rrrYYYYY
+ ------------------------------
+ if (0 <= reg[rrr] < LENGTH)
+ write (ELEMENT[reg[rrr]]);
+ IC += LENGTH + 2; (... pointing at N+1)
+ read (reg[rrr]);
+ IC += ADDRESS;
+ */
+/* Note: If read is suspended, the resumed execution starts from the
+ Nth code (YYYYY == CCL_ReadJump). */
+
+#define CCL_ReadJump 0x0C /* Read and jump:
+ 1:A--D--D--R--E--S--S-rrrYYYYY
+ -----------------------------
+ read (reg[rrr]);
+ IC += ADDRESS;
+ */
+
+#define CCL_Branch 0x0D /* Jump by branch table:
+ 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
+ 2:A--D--D--R--E-S-S[0]000XXXXX
+ 3:A--D--D--R--E-S-S[1]000XXXXX
+ ...
+ ------------------------------
+ if (0 <= reg[rrr] < CC..C)
+ IC += ADDRESS[reg[rrr]];
+ else
+ IC += ADDRESS[CC..C];
+ */
+
+#define CCL_ReadRegister 0x0E /* Read bytes into registers:
+ 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
+ 2:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
+ ...
+ ------------------------------
+ while (CCC--)
+ read (reg[rrr]);
+ */
+
+#define CCL_WriteExprConst 0x0F /* write result of expression:
+ 1:00000OPERATION000RRR000XXXXX
+ 2:CONSTANT
+ ------------------------------
+ write (reg[RRR] OPERATION CONSTANT);
+ IC++;
+ */
+
+/* Note: If the Nth read is suspended, the resumed execution starts
+ from the Nth code. */
+
+#define CCL_ReadBranch 0x10 /* Read one byte into a register,
+ and jump by branch table:
+ 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
+ 2:A--D--D--R--E-S-S[0]000XXXXX
+ 3:A--D--D--R--E-S-S[1]000XXXXX
+ ...
+ ------------------------------
+ read (read[rrr]);
+ if (0 <= reg[rrr] < CC..C)
+ IC += ADDRESS[reg[rrr]];
+ else
+ IC += ADDRESS[CC..C];
+ */
+
+#define CCL_WriteRegister 0x11 /* Write registers:
+ 1:CCCCCCCCCCCCCCCCCCCrrrXXXXX
+ 2:CCCCCCCCCCCCCCCCCCCrrrXXXXX
+ ...
+ ------------------------------
+ while (CCC--)
+ write (reg[rrr]);
+ ...
+ */
+
+/* Note: If the Nth write is suspended, the resumed execution
+ starts from the Nth code. */
+
+#define CCL_WriteExprRegister 0x12 /* Write result of expression
+ 1:00000OPERATIONRrrRRR000XXXXX
+ ------------------------------
+ write (reg[RRR] OPERATION reg[Rrr]);
+ */
+
+#define CCL_Call 0x13 /* Write a constant:
+ 1:CCCCCCCCCCCCCCCCCCCC000XXXXX
+ ------------------------------
+ call (CC..C)
+ */
+
+#define CCL_WriteConstString 0x14 /* Write a constant or a string:
+ 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
+ [2:0000STRIN[0]STRIN[1]STRIN[2]]
+ [...]
+ -----------------------------
+ if (!rrr)
+ write (CC..C)
+ else
+ write_string (STRING, CC..C);
+ IC += (CC..C + 2) / 3;
+ */
+
+#define CCL_WriteArray 0x15 /* Write an element of array:
+ 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
+ 2:ELEMENT[0]
+ 3:ELEMENT[1]
+ ...
+ ------------------------------
+ if (0 <= reg[rrr] < CC..C)
+ write (ELEMENT[reg[rrr]]);
+ IC += CC..C;
+ */
+
+#define CCL_End 0x16 /* Terminate:
+ 1:00000000000000000000000XXXXX
+ ------------------------------
+ terminate ();
+ */
+
+/* The following two codes execute an assignment arithmetic/logical
+ operation. The form of the operation is like REG OP= OPERAND. */
+
+#define CCL_ExprSelfConst 0x17 /* REG OP= constant:
+ 1:00000OPERATION000000rrrXXXXX
+ 2:CONSTANT
+ ------------------------------
+ reg[rrr] OPERATION= CONSTANT;
+ */
+
+#define CCL_ExprSelfReg 0x18 /* REG1 OP= REG2:
+ 1:00000OPERATION000RRRrrrXXXXX
+ ------------------------------
+ reg[rrr] OPERATION= reg[RRR];
+ */
+
+/* The following codes execute an arithmetic/logical operation. The
+ form of the operation is like REG_X = REG_Y OP OPERAND2. */
+
+#define CCL_SetExprConst 0x19 /* REG_X = REG_Y OP constant:
+ 1:00000OPERATION000RRRrrrXXXXX
+ 2:CONSTANT
+ ------------------------------
+ reg[rrr] = reg[RRR] OPERATION CONSTANT;
+ IC++;
+ */
+
+#define CCL_SetExprReg 0x1A /* REG1 = REG2 OP REG3:
+ 1:00000OPERATIONRrrRRRrrrXXXXX
+ ------------------------------
+ reg[rrr] = reg[RRR] OPERATION reg[Rrr];
+ */
+
+#define CCL_JumpCondExprConst 0x1B /* Jump conditional according to
+ an operation on constant:
+ 1:A--D--D--R--E--S--S-rrrXXXXX
+ 2:OPERATION
+ 3:CONSTANT
+ -----------------------------
+ reg[7] = reg[rrr] OPERATION CONSTANT;
+ if (!(reg[7]))
+ IC += ADDRESS;
+ else
+ IC += 2
+ */
+
+#define CCL_JumpCondExprReg 0x1C /* Jump conditional according to
+ an operation on register:
+ 1:A--D--D--R--E--S--S-rrrXXXXX
+ 2:OPERATION
+ 3:RRR
+ -----------------------------
+ reg[7] = reg[rrr] OPERATION reg[RRR];
+ if (!reg[7])
+ IC += ADDRESS;
+ else
+ IC += 2;
+ */
+
+#define CCL_ReadJumpCondExprConst 0x1D /* Read and jump conditional according
+ to an operation on constant:
+ 1:A--D--D--R--E--S--S-rrrXXXXX
+ 2:OPERATION
+ 3:CONSTANT
+ -----------------------------
+ read (reg[rrr]);
+ reg[7] = reg[rrr] OPERATION CONSTANT;
+ if (!reg[7])
+ IC += ADDRESS;
+ else
+ IC += 2;
+ */
+
+#define CCL_ReadJumpCondExprReg 0x1E /* Read and jump conditional according
+ to an operation on register:
+ 1:A--D--D--R--E--S--S-rrrXXXXX
+ 2:OPERATION
+ 3:RRR
+ -----------------------------
+ read (reg[rrr]);
+ reg[7] = reg[rrr] OPERATION reg[RRR];
+ if (!reg[7])
+ IC += ADDRESS;
+ else
+ IC += 2;
+ */
+
+#define CCL_Extention 0x1F /* Extended CCL code
+ 1:ExtendedCOMMNDRrrRRRrrrXXXXX
+ 2:ARGUEMENT
+ 3:...
+ ------------------------------
+ extended_command (rrr,RRR,Rrr,ARGS)
+ */
+
+
+/* CCL arithmetic/logical operators. */
+#define CCL_PLUS 0x00 /* X = Y + Z */
+#define CCL_MINUS 0x01 /* X = Y - Z */
+#define CCL_MUL 0x02 /* X = Y * Z */
+#define CCL_DIV 0x03 /* X = Y / Z */
+#define CCL_MOD 0x04 /* X = Y % Z */
+#define CCL_AND 0x05 /* X = Y & Z */
+#define CCL_OR 0x06 /* X = Y | Z */
+#define CCL_XOR 0x07 /* X = Y ^ Z */
+#define CCL_LSH 0x08 /* X = Y << Z */
+#define CCL_RSH 0x09 /* X = Y >> Z */
+#define CCL_LSH8 0x0A /* X = (Y << 8) | Z */
+#define CCL_RSH8 0x0B /* X = Y >> 8, r[7] = Y & 0xFF */
+#define CCL_DIVMOD 0x0C /* X = Y / Z, r[7] = Y % Z */
+#define CCL_LS 0x10 /* X = (X < Y) */
+#define CCL_GT 0x11 /* X = (X > Y) */
+#define CCL_EQ 0x12 /* X = (X == Y) */
+#define CCL_LE 0x13 /* X = (X <= Y) */
+#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))
+ 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. */
+
+/* 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. */
+#define CCL_WRITE_CHAR(ch) do { \
+ if (!destination) \
+ { \
+ ccl->status = CCL_STAT_INVALID_CMD; \
+ goto ccl_error_handler; \
+ } \
+ else \
+ { \
+ Bufbyte work[MAX_EMCHAR_LEN]; \
+ int len = ( ch < 256 ) ? \
+ simple_set_charptr_emchar (work, ch) : \
+ non_ascii_set_charptr_emchar (work, ch); \
+ Dynarr_add_many (destination, work, len); \
+ } \
+} while (0)
+
+/* 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); \
+} while (0)
+
+/* Read one byte from the current input buffer into Rth register. */
+#define CCL_READ_CHAR(r) do { \
+ if (!src) \
+ { \
+ ccl->status = CCL_STAT_INVALID_CMD; \
+ goto ccl_error_handler; \
+ } \
+ else if (src < src_end) \
+ r = *src++; \
+ else if (ccl->last_block) \
+ { \
+ ic = ccl->eof_ic; \
+ goto ccl_finish; \
+ } \
+ else \
+ /* 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. */ \
+ { \
+ ic--; \
+ ccl->status = CCL_STAT_SUSPEND; \
+ goto ccl_finish; \
+ } \
+} while (0)
+
+
+/* Execute CCL code on SRC_BYTES length text at SOURCE. The resulting
+ text goes to a place pointed by DESTINATION. The bytes actually
+ processed is returned as *CONSUMED. The return value is the length
+ of the resulting text. As a side effect, the contents of CCL registers
+ are updated. If SOURCE or DESTINATION is NULL, only operations on
+ registers are permitted. */
+
+#ifdef CCL_DEBUG
+#define CCL_DEBUG_BACKTRACE_LEN 256
+int ccl_backtrace_table[CCL_BACKTRACE_TABLE];
+int ccl_backtrace_idx;
+#endif
+
+struct ccl_prog_stack
+ {
+ Lisp_Object *ccl_prog; /* Pointer to an array of CCL code. */
+ int ic; /* Instruction Counter. */
+ };
+
+int
+ccl_driver (struct ccl_program *ccl, CONST unsigned char *source, unsigned_char_dynarr *destination, int src_bytes, int *consumed)
+{
+ 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;
+ 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];
+
+ if (ic >= ccl->eof_ic)
+ ic = CCL_HEADER_MAIN;
+
+#ifdef CCL_DEBUG
+ ccl_backtrace_idx = 0;
+#endif
+
+ for (;;)
+ {
+#ifdef CCL_DEBUG
+ ccl_backtrace_table[ccl_backtrace_idx++] = ic;
+ if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN)
+ ccl_backtrace_idx = 0;
+ ccl_backtrace_table[ccl_backtrace_idx] = 0;
+#endif
+
+ if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
+ {
+ /* We can't just signal Qquit, instead break the loop as if
+ the whole data is processed. Don't reset Vquit_flag, it
+ must be handled later at a safer place. */
+ if (consumed)
+ src = source + src_bytes;
+ ccl->status = CCL_STAT_QUIT;
+ break;
+ }
+
+ code = XINT (ccl_prog[ic]); ic++;
+ field1 = code >> 8;
+ field2 = (code & 0xFF) >> 5;
+
+#define rrr field2
+#define RRR (field1 & 7)
+#define Rrr ((field1 >> 3) & 7)
+#define ADDR field1
+
+ switch (code & 0x1F)
+ {
+ case CCL_SetRegister: /* 00000000000000000RRRrrrXXXXX */
+ reg[rrr] = reg[RRR];
+ break;
+
+ case CCL_SetShortConst: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
+ reg[rrr] = field1;
+ break;
+
+ case CCL_SetConst: /* 00000000000000000000rrrXXXXX */
+ reg[rrr] = XINT (ccl_prog[ic]);
+ ic++;
+ break;
+
+ case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
+ i = reg[RRR];
+ j = field1 >> 3;
+ if ((unsigned int) i < j)
+ reg[rrr] = XINT (ccl_prog[ic + i]);
+ ic += j;
+ break;
+
+ case CCL_Jump: /* A--D--D--R--E--S--S-000XXXXX */
+ ic += ADDR;
+ break;
+
+ case CCL_JumpCond: /* A--D--D--R--E--S--S-rrrXXXXX */
+ if (!reg[rrr])
+ ic += ADDR;
+ break;
+
+ case CCL_WriteRegisterJump: /* A--D--D--R--E--S--S-rrrXXXXX */
+ i = reg[rrr];
+ CCL_WRITE_CHAR (i);
+ ic += ADDR;
+ break;
+
+ case CCL_WriteRegisterReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
+ i = reg[rrr];
+ CCL_WRITE_CHAR (i);
+ ic++;
+ CCL_READ_CHAR (reg[rrr]);
+ ic += ADDR - 1;
+ break;
+
+ case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */
+ i = XINT (ccl_prog[ic]);
+ CCL_WRITE_CHAR (i);
+ ic += ADDR;
+ break;
+
+ case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
+ i = XINT (ccl_prog[ic]);
+ CCL_WRITE_CHAR (i);
+ ic++;
+ CCL_READ_CHAR (reg[rrr]);
+ ic += ADDR - 1;
+ break;
+
+ case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
+ j = XINT (ccl_prog[ic]);
+ ic++;
+ CCL_WRITE_STRING (j);
+ ic += ADDR - 1;
+ break;
+
+ case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
+ i = reg[rrr];
+ j = XINT (ccl_prog[ic]);
+ if ((unsigned int) i < j)
+ {
+ i = XINT (ccl_prog[ic + 1 + i]);
+ CCL_WRITE_CHAR (i);
+ }
+ ic += j + 2;
+ CCL_READ_CHAR (reg[rrr]);
+ ic += ADDR - (j + 2);
+ break;
+
+ case CCL_ReadJump: /* A--D--D--R--E--S--S-rrrYYYYY */
+ CCL_READ_CHAR (reg[rrr]);
+ ic += ADDR;
+ break;
+
+ case CCL_ReadBranch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
+ CCL_READ_CHAR (reg[rrr]);
+ /* fall through ... */
+ case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
+ if ((unsigned int) reg[rrr] < field1)
+ ic += XINT (ccl_prog[ic + reg[rrr]]);
+ else
+ ic += XINT (ccl_prog[ic + field1]);
+ break;
+
+ case CCL_ReadRegister: /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
+ while (1)
+ {
+ CCL_READ_CHAR (reg[rrr]);
+ if (!field1) break;
+ code = XINT (ccl_prog[ic]); ic++;
+ field1 = code >> 8;
+ field2 = (code & 0xFF) >> 5;
+ }
+ break;
+
+ case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */
+ rrr = 7;
+ i = reg[RRR];
+ j = XINT (ccl_prog[ic]);
+ op = field1 >> 6;
+ ic++;
+ goto ccl_set_expr;
+
+ case CCL_WriteRegister: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */
+ while (1)
+ {
+ i = reg[rrr];
+ CCL_WRITE_CHAR (i);
+ if (!field1) break;
+ code = XINT (ccl_prog[ic]); ic++;
+ field1 = code >> 8;
+ field2 = (code & 0xFF) >> 5;
+ }
+ break;
+
+ case CCL_WriteExprRegister: /* 1:00000OPERATIONRrrRRR000XXXXX */
+ rrr = 7;
+ i = reg[RRR];
+ j = reg[Rrr];
+ op = field1 >> 6;
+ goto ccl_set_expr;
+
+ case CCL_Call: /* CCCCCCCCCCCCCCCCCCCC000XXXXX */
+ {
+ Lisp_Object slot;
+
+ if (stack_idx >= 256
+ || field1 < 0
+ || field1 >= XVECTOR_LENGTH (Vccl_program_table)
+ || (slot = XVECTOR_DATA (Vccl_program_table)[field1],
+ !CONSP (slot))
+ || !VECTORP (XCDR (slot)))
+ {
+ if (stack_idx > 0)
+ {
+ ccl_prog = ccl_prog_stack_struct[0].ccl_prog;
+ ic = ccl_prog_stack_struct[0].ic;
+ }
+ ccl->status = CCL_STAT_INVALID_CMD;
+ goto ccl_error_handler;
+ }
+
+ ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
+ ccl_prog_stack_struct[stack_idx].ic = ic;
+ stack_idx++;
+ ccl_prog = XVECTOR_DATA (XCDR (slot));
+ ic = CCL_HEADER_MAIN;
+ }
+ break;
+
+ case CCL_WriteConstString: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
+ if (!rrr)
+ CCL_WRITE_CHAR (field1);
+ else
+ {
+ CCL_WRITE_STRING (field1);
+ ic += (field1 + 2) / 3;
+ }
+ break;
+
+ case CCL_WriteArray: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
+ i = reg[rrr];
+ if ((unsigned int) i < field1)
+ {
+ j = XINT (ccl_prog[ic + i]);
+ CCL_WRITE_CHAR (j);
+ }
+ ic += field1;
+ break;
+
+ case CCL_End: /* 0000000000000000000000XXXXX */
+ if (stack_idx-- > 0)
+ {
+ ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
+ ic = ccl_prog_stack_struct[stack_idx].ic;
+ break;
+ }
+ /* Terminate CCL program successfully. */
+ ccl->status = CCL_STAT_SUCCESS;
+ ccl->ic = CCL_HEADER_MAIN;
+ goto ccl_finish;
+
+ case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
+ i = XINT (ccl_prog[ic]);
+ ic++;
+ op = field1 >> 6;
+ goto ccl_expr_self;
+
+ case CCL_ExprSelfReg: /* 00000OPERATION000RRRrrrXXXXX */
+ i = reg[RRR];
+ op = field1 >> 6;
+
+ ccl_expr_self:
+ switch (op)
+ {
+ case CCL_PLUS: reg[rrr] += i; break;
+ case CCL_MINUS: reg[rrr] -= i; break;
+ case CCL_MUL: reg[rrr] *= i; break;
+ case CCL_DIV: reg[rrr] /= i; break;
+ case CCL_MOD: reg[rrr] %= i; break;
+ case CCL_AND: reg[rrr] &= i; break;
+ case CCL_OR: reg[rrr] |= i; break;
+ case CCL_XOR: reg[rrr] ^= i; break;
+ case CCL_LSH: reg[rrr] <<= i; break;
+ case CCL_RSH: reg[rrr] >>= i; break;
+ case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break;
+ case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break;
+ case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break;
+ case CCL_LS: reg[rrr] = reg[rrr] < i; break;
+ case CCL_GT: reg[rrr] = reg[rrr] > i; break;
+ case CCL_EQ: reg[rrr] = reg[rrr] == i; break;
+ case CCL_LE: reg[rrr] = reg[rrr] <= i; break;
+ case CCL_GE: reg[rrr] = reg[rrr] >= i; break;
+ case CCL_NE: reg[rrr] = reg[rrr] != i; break;
+ default:
+ ccl->status = CCL_STAT_INVALID_CMD;
+ goto ccl_error_handler;
+ }
+ break;
+
+ case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */
+ i = reg[RRR];
+ j = XINT (ccl_prog[ic]);
+ op = field1 >> 6;
+ jump_address = ++ic;
+ goto ccl_set_expr;
+
+ case CCL_SetExprReg: /* 00000OPERATIONRrrRRRrrrXXXXX */
+ i = reg[RRR];
+ j = reg[Rrr];
+ op = field1 >> 6;
+ jump_address = ic;
+ goto ccl_set_expr;
+
+ case CCL_ReadJumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
+ CCL_READ_CHAR (reg[rrr]);
+ case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
+ i = reg[rrr];
+ op = XINT (ccl_prog[ic]);
+ jump_address = ic++ + ADDR;
+ j = XINT (ccl_prog[ic]);
+ ic++;
+ rrr = 7;
+ goto ccl_set_expr;
+
+ case CCL_ReadJumpCondExprReg: /* A--D--D--R--E--S--S-rrrXXXXX */
+ CCL_READ_CHAR (reg[rrr]);
+ case CCL_JumpCondExprReg:
+ i = reg[rrr];
+ op = XINT (ccl_prog[ic]);
+ jump_address = ic++ + ADDR;
+ j = reg[XINT (ccl_prog[ic])];
+ ic++;
+ rrr = 7;
+
+ ccl_set_expr:
+ switch (op)
+ {
+ case CCL_PLUS: reg[rrr] = i + j; break;
+ case CCL_MINUS: reg[rrr] = i - j; break;
+ case CCL_MUL: reg[rrr] = i * j; break;
+ case CCL_DIV: reg[rrr] = i / j; break;
+ case CCL_MOD: reg[rrr] = i % j; break;
+ case CCL_AND: reg[rrr] = i & j; break;
+ case CCL_OR: reg[rrr] = i | j; break;
+ case CCL_XOR: reg[rrr] = i ^ j;; break;
+ case CCL_LSH: reg[rrr] = i << j; break;
+ case CCL_RSH: reg[rrr] = i >> j; break;
+ case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
+ case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break;
+ case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break;
+ case CCL_LS: reg[rrr] = i < j; break;
+ case CCL_GT: reg[rrr] = i > j; break;
+ case CCL_EQ: reg[rrr] = i == j; break;
+ 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_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;
+ }
+ code &= 0x1F;
+ if (code == CCL_WriteExprConst || code == CCL_WriteExprRegister)
+ {
+ i = reg[rrr];
+ CCL_WRITE_CHAR (i);
+ }
+ else if (!reg[rrr])
+ ic = jump_address;
+ break;
+
+ default:
+ ccl->status = CCL_STAT_INVALID_CMD;
+ goto ccl_error_handler;
+ }
+ }
+
+ ccl_error_handler:
+ if (destination)
+ {
+ /* We can insert an error message only if DESTINATION is
+ specified and we still have a room to store the message
+ there. */
+ char msg[256];
+
+ 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);
+#ifdef CCL_DEBUG
+ {
+ int i = ccl_backtrace_idx - 1;
+ int j;
+
+ Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
+
+ for (j = 0; j < CCL_DEBUG_BACKTRACE_LEN; j++, i--)
+ {
+ if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1;
+ if (ccl_backtrace_table[i] == 0)
+ break;
+ sprintf(msg, " %d", ccl_backtrace_table[i]);
+ Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
+ }
+ }
+#endif
+ goto ccl_finish;
+
+ case CCL_STAT_QUIT:
+ sprintf(msg, "\nCCL: Quited.");
+ break;
+
+ default:
+ sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status);
+ }
+
+ Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
+ }
+
+ ccl_finish:
+ ccl->ic = ic;
+ if (consumed) *consumed = src - source;
+ if (destination)
+ return Dynarr_length (destination);
+ else
+ return 0;
+}
+
+/* Setup fields of the structure pointed by CCL appropriately for the
+ execution of compiled CCL code in VEC (vector of integer). */
+void
+setup_ccl_program (struct ccl_program *ccl, Lisp_Object vec)
+{
+ int i;
+
+ ccl->size = XVECTOR_LENGTH (vec);
+ ccl->prog = XVECTOR_DATA (vec);
+ 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->status = 0;
+}
+
+#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.
+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.
+*/
+ (ccl_prog, reg))
+{
+ struct ccl_program ccl;
+ int i;
+
+ CHECK_VECTOR (ccl_prog);
+ CHECK_VECTOR (reg);
+ if (XVECTOR_LENGTH (reg) != 8)
+ signal_simple_error ("Vector should be of length 8", reg);
+
+ setup_ccl_program (&ccl, ccl_prog);
+ for (i = 0; i < 8; i++)
+ ccl.reg[i] = (INTP (XVECTOR_DATA (reg)[i])
+ ? XINT (XVECTOR_DATA (reg)[i])
+ : 0);
+
+ ccl_driver (&ccl, (CONST unsigned char *)0, (unsigned_char_dynarr *)0,
+ 0, (int *)0);
+ QUIT;
+ if (ccl.status != CCL_STAT_SUCCESS)
+ error ("Error in CCL program at %dth code", ccl.ic);
+
+ for (i = 0; i < 8; i++)
+ XSETINT (XVECTOR_DATA (reg)[i], ccl.reg[i]);
+ return Qnil;
+}
+
+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'.
+Read buffer is set to STRING, and write buffer is allocated automatically.
+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.
+*/
+ (ccl_prog, status, str, contin))
+{
+ Lisp_Object val;
+ struct ccl_program ccl;
+ int i, produced;
+ unsigned_char_dynarr *outbuf;
+ struct gcpro gcpro1, gcpro2, gcpro3;
+
+ CHECK_VECTOR (ccl_prog);
+ CHECK_VECTOR (status);
+ if (XVECTOR_LENGTH (status) != 9)
+ signal_simple_error ("Vector should be of length 9", status);
+ CHECK_STRING (str);
+ GCPRO3 (ccl_prog, status, str);
+
+ setup_ccl_program (&ccl, ccl_prog);
+ for (i = 0; i < 8; i++)
+ {
+ if (NILP (XVECTOR_DATA (status)[i]))
+ XSETINT (XVECTOR_DATA (status)[i], 0);
+ if (INTP (XVECTOR_DATA (status)[i]))
+ ccl.reg[i] = XINT (XVECTOR_DATA (status)[i]);
+ }
+ if (INTP (XVECTOR_DATA (status)[8]))
+ {
+ i = XINT (XVECTOR_DATA (status)[8]);
+ if (ccl.ic < i && i < ccl.size)
+ ccl.ic = i;
+ }
+ outbuf = Dynarr_new (unsigned_char);
+ ccl.last_block = NILP (contin);
+ produced = ccl_driver (&ccl, XSTRING_DATA (str), outbuf,
+ XSTRING_LENGTH (str), (int *)0);
+ for (i = 0; i < 8; i++)
+ XVECTOR_DATA (status)[i] = make_int(ccl.reg[i]);
+ XSETINT (XVECTOR_DATA (status)[8], ccl.ic);
+ UNGCPRO;
+
+ val = make_string (Dynarr_atp (outbuf, 0), produced);
+ Dynarr_free (outbuf);
+ QUIT;
+ if (ccl.status != CCL_STAT_SUCCESS
+ && ccl.status != CCL_STAT_SUSPEND)
+ error ("Error in CCL program at %dth code", ccl.ic);
+
+ return val;
+}
+
+DEFUN ("register-ccl-program", Fregister_ccl_program, 2, 2, 0, /*
+Register CCL program PROGRAM of NAME in `ccl-program-table'.
+PROGRAM should be a compiled code of CCL program, or nil.
+Return index number of the registered CCL program.
+*/
+ (name, ccl_prog))
+{
+ int len = XVECTOR_LENGTH (Vccl_program_table);
+ int i;
+
+ CHECK_SYMBOL (name);
+ if (!NILP (ccl_prog))
+ CHECK_VECTOR (ccl_prog);
+
+ for (i = 0; i < len; i++)
+ {
+ Lisp_Object slot = XVECTOR_DATA (Vccl_program_table)[i];
+
+ if (!CONSP (slot))
+ break;
+
+ if (EQ (name, XCAR (slot)))
+ {
+ XCDR (slot) = ccl_prog;
+ return make_int (i);
+ }
+ }
+
+ if (i == len)
+ {
+ Lisp_Object new_table = Fmake_vector (make_int (len * 2), Qnil);
+ int j;
+
+ for (j = 0; j < len; j++)
+ XVECTOR_DATA (new_table)[j]
+ = XVECTOR_DATA (Vccl_program_table)[j];
+ Vccl_program_table = new_table;
+ }
+
+ XVECTOR_DATA (Vccl_program_table)[i] = Fcons (name, ccl_prog);
+ return make_int (i);
+}
+
+void
+syms_of_mule_ccl (void)
+{
+ staticpro (&Vccl_program_table);
+ Vccl_program_table = Fmake_vector (make_int (32), Qnil);
+
+ 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),
+ where CCL-CODE is a compiled CCL program.
+When a font whose name matches REGEXP is used for displaying a character,
+ CCL-CODE is executed to calculate the code point in the font
+ from the charset number and position code(s) of the character which are set
+ in CCL registers R0, R1, and R2 before the execution.
+The code point in the font is set in CCL registers R1 and R2
+ when the execution terminated.
+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 */
--- /dev/null
+/* Functions to handle multilingual characters.
+ Copyright (C) 1992, 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>. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "chartab.h"
+#include "elhash.h"
+#include "lstream.h"
+#include "device.h"
+#include "faces.h"
+
+/* The various pre-defined charsets. */
+
+Lisp_Object Vcharset_ascii;
+Lisp_Object Vcharset_control_1;
+Lisp_Object Vcharset_latin_iso8859_1;
+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_greek_iso8859_7;
+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_japanese_jisx0208_1978;
+Lisp_Object Vcharset_japanese_jisx0208;
+Lisp_Object Vcharset_japanese_jisx0212;
+Lisp_Object Vcharset_chinese_gb2312;
+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;
+Lisp_Object Vcharset_composite;
+
+/* Hashtables for composite chars. One maps string representing
+ composed chars to their equivalent chars; one goes the
+ other way. */
+Lisp_Object Vcomposite_char_char2string_hashtable;
+Lisp_Object Vcomposite_char_string2char_hashtable;
+
+/* Table of charsets indexed by leading byte. */
+Lisp_Object charset_by_leading_byte[128];
+
+/* Table of charsets indexed by type/final-byte/direction. */
+Lisp_Object charset_by_attributes[4][128][2];
+
+static int composite_char_row_next;
+static int composite_char_col_next;
+
+/* Table of number of bytes in the string representation of a character
+ indexed by the first byte of that representation.
+
+ 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))) */
+
+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,
+ 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,
+ 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,
+ 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,
+ /* 0x80 - 0x8f are for Dimension-1 official charsets */
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ /* 0x90 - 0x9d are for Dimension-2 official charsets */
+ /* 0x9e is for Dimension-1 private charsets */
+ /* 0x9f is for Dimension-2 private charsets */
+ 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4
+};
+
+Lisp_Object Qcharsetp;
+
+/* Qdoc_string, Qdimension, Qchars defined in general.c */
+Lisp_Object Qregistry, Qfinal, Qgraphic;
+Lisp_Object Qdirection;
+Lisp_Object Qreverse_direction_charset;
+Lisp_Object Qccl_program;
+
+Lisp_Object Qascii, Qcontrol_1,
+
+ Qlatin_iso8859_1,
+ Qlatin_iso8859_2,
+ Qlatin_iso8859_3,
+ Qlatin_iso8859_4,
+ Qcyrillic_iso8859_5,
+ Qarabic_iso8859_6,
+ Qgreek_iso8859_7,
+ Qhebrew_iso8859_8,
+ Qlatin_iso8859_9,
+
+ Qthai_tis620,
+
+ Qkatakana_jisx0201, Qlatin_jisx0201,
+ Qjapanese_jisx0208_1978,
+ Qjapanese_jisx0208,
+ Qjapanese_jisx0212,
+
+ Qchinese_gb2312,
+ Qchinese_big5_1, Qchinese_big5_2,
+ Qchinese_cns11643_1, Qchinese_cns11643_2,
+
+ Qkorean_ksc5601, Qcomposite;
+
+Lisp_Object Ql2r, Qr2l;
+
+Lisp_Object Vcharset_hashtable;
+
+static Bufbyte next_allocated_1_byte_leading_byte;
+static Bufbyte next_allocated_2_byte_leading_byte;
+
+/* Composite characters are characters constructed by overstriking two
+ or more regular characters.
+
+ 1) The old Mule implementation involves storing composite characters
+ in a buffer as a tag followed by all of the actual characters
+ used to make up the composite character. I think this is a bad
+ idea; it greatly complicates code that wants to handle strings
+ one character at a time because it has to deal with the possibility
+ of great big ungainly characters. It's much more reasonable to
+ simply store an index into a table of composite characters.
+
+ 2) The current implementation only allows for 16,384 separate
+ composite characters over the lifetime of the XEmacs process.
+ This could become a potential problem if the user
+ edited lots of different files that use composite characters.
+ Due to FSF bogosity, increasing the number of allowable
+ composite characters under Mule would decrease the number
+ of possible faces that can exist. Mule already has shrunk
+ this to 2048, and further shrinkage would become uncomfortable.
+ No such problems exist in XEmacs.
+
+ Composite characters could be represented as 0x80 C1 C2 C3,
+ where each C[1-3] is in the range 0xA0 - 0xFF. This allows
+ for slightly under 2^20 (one million) composite characters
+ over the XEmacs process lifetime, and you only need to
+ increase the size of a Mule character from 19 to 21 bits.
+ Or you could use 0x80 C1 C2 C3 C4, allowing for about
+ 85 million (slightly over 2^26) composite characters. */
+
+\f
+/************************************************************************/
+/* Basic Emchar functions */
+/************************************************************************/
+
+/* Convert a non-ASCII Mule character C into a one-character Mule-encoded
+ string in STR. Returns the number of bytes stored.
+ Do not call this directly. Use the macro set_charptr_emchar() instead.
+ */
+
+Bytecount
+non_ascii_set_charptr_emchar (Bufbyte *str, Emchar c)
+{
+ Bufbyte *p;
+ Bufbyte lb;
+ int c1, c2;
+ Lisp_Object charset;
+
+ p = str;
+ BREAKUP_CHAR (c, charset, c1, c2);
+ lb = CHAR_LEADING_BYTE (c);
+ if (LEADING_BYTE_PRIVATE_P (lb))
+ *p++ = PRIVATE_LEADING_BYTE_PREFIX (lb);
+ *p++ = lb;
+ if (EQ (charset, Vcharset_control_1))
+ c1 += 0x20;
+ *p++ = c1 | 0x80;
+ if (c2)
+ *p++ = c2 | 0x80;
+
+ return (p - str);
+}
+
+/* Return the first character from a Mule-encoded string in STR,
+ assuming it's non-ASCII. Do not call this directly.
+ Use the macro charptr_emchar() instead. */
+
+Emchar
+non_ascii_charptr_emchar (CONST Bufbyte *str)
+{
+ Bufbyte i0 = *str, i1, i2 = 0;
+ Lisp_Object charset;
+
+ if (i0 == LEADING_BYTE_CONTROL_1)
+ return (Emchar) (*++str - 0x20);
+
+ if (LEADING_BYTE_PREFIX_P (i0))
+ i0 = *++str;
+
+ i1 = *++str & 0x7F;
+
+ charset = CHARSET_BY_LEADING_BYTE (i0);
+ if (XCHARSET_DIMENSION (charset) == 2)
+ i2 = *++str & 0x7F;
+
+ return MAKE_CHAR (charset, i1, i2);
+}
+
+/* Return whether CH is a valid Emchar, assuming it's non-ASCII.
+ Do not call this directly. Use the macro valid_char_p() instead. */
+
+int
+non_ascii_valid_char_p (Emchar ch)
+{
+ int f1, f2, f3;
+
+ /* Must have only lowest 19 bits set */
+ if (ch & ~0x7FFFF)
+ return 0;
+
+ f1 = CHAR_FIELD1 (ch);
+ f2 = CHAR_FIELD2 (ch);
+ f3 = CHAR_FIELD3 (ch);
+
+ if (f1 == 0)
+ {
+ Lisp_Object charset;
+
+ if (f2 < MIN_CHAR_FIELD2_OFFICIAL ||
+ (f2 > MAX_CHAR_FIELD2_OFFICIAL && f2 < MIN_CHAR_FIELD2_PRIVATE) ||
+ f2 > MAX_CHAR_FIELD2_PRIVATE)
+ return 0;
+ if (f3 < 0x20)
+ return 0;
+
+ if (f3 != 0x20 && f3 != 0x7F)
+ return 1;
+
+ /*
+ NOTE: This takes advantage of the fact that
+ FIELD2_TO_OFFICIAL_LEADING_BYTE and
+ FIELD2_TO_PRIVATE_LEADING_BYTE are the same.
+ */
+ charset = CHARSET_BY_LEADING_BYTE (f2 + FIELD2_TO_OFFICIAL_LEADING_BYTE);
+ return (XCHARSET_CHARS (charset) == 96);
+ }
+ else
+ {
+ Lisp_Object charset;
+
+ if (f1 < MIN_CHAR_FIELD1_OFFICIAL ||
+ (f1 > MAX_CHAR_FIELD1_OFFICIAL && f1 < MIN_CHAR_FIELD1_PRIVATE) ||
+ f1 > MAX_CHAR_FIELD1_PRIVATE)
+ return 0;
+ if (f2 < 0x20 || f3 < 0x20)
+ return 0;
+
+ if (f1 + FIELD1_TO_OFFICIAL_LEADING_BYTE == LEADING_BYTE_COMPOSITE)
+ {
+ if (UNBOUNDP (Fgethash (make_int (ch),
+ Vcomposite_char_char2string_hashtable,
+ Qunbound)))
+ return 0;
+ return 1;
+ }
+
+ if (f2 != 0x20 && f2 != 0x7F && f3 != 0x20 && f3 != 0x7F)
+ return 1;
+
+ if (f1 <= MAX_CHAR_FIELD1_OFFICIAL)
+ charset =
+ CHARSET_BY_LEADING_BYTE (f1 + FIELD1_TO_OFFICIAL_LEADING_BYTE);
+ else
+ charset =
+ CHARSET_BY_LEADING_BYTE (f1 + FIELD1_TO_PRIVATE_LEADING_BYTE);
+
+ return (XCHARSET_CHARS (charset) == 96);
+ }
+}
+
+\f
+/************************************************************************/
+/* Basic string functions */
+/************************************************************************/
+
+/* Copy the character pointed to by PTR into STR, assuming it's
+ non-ASCII. Do not call this directly. Use the macro
+ charptr_copy_char() instead. */
+
+Bytecount
+non_ascii_charptr_copy_char (CONST Bufbyte *ptr, Bufbyte *str)
+{
+ Bufbyte *strptr = str;
+ *strptr = *ptr++;
+ switch (REP_BYTES_BY_FIRST_BYTE (*strptr))
+ {
+ /* Notice fallthrough. */
+ case 4: *++strptr = *ptr++;
+ case 3: *++strptr = *ptr++;
+ case 2: *++strptr = *ptr;
+ break;
+ default:
+ abort ();
+ }
+ return strptr + 1 - str;
+}
+
+\f
+/************************************************************************/
+/* streams of Emchars */
+/************************************************************************/
+
+/* Treat a stream as a stream of Emchar's rather than a stream of bytes.
+ The functions below are not meant to be called directly; use
+ the macros in insdel.h. */
+
+Emchar
+Lstream_get_emchar_1 (Lstream *stream, int ch)
+{
+ Bufbyte str[MAX_EMCHAR_LEN];
+ Bufbyte *strptr = str;
+
+ str[0] = (Bufbyte) ch;
+ switch (REP_BYTES_BY_FIRST_BYTE (ch))
+ {
+ /* Notice fallthrough. */
+ case 4:
+ ch = Lstream_getc (stream);
+ assert (ch >= 0);
+ *++strptr = (Bufbyte) ch;
+ case 3:
+ ch = Lstream_getc (stream);
+ assert (ch >= 0);
+ *++strptr = (Bufbyte) ch;
+ case 2:
+ ch = Lstream_getc (stream);
+ assert (ch >= 0);
+ *++strptr = (Bufbyte) ch;
+ break;
+ default:
+ abort ();
+ }
+ return charptr_emchar (str);
+}
+
+int
+Lstream_fput_emchar (Lstream *stream, Emchar ch)
+{
+ Bufbyte str[MAX_EMCHAR_LEN];
+ Bytecount len = set_charptr_emchar (str, ch);
+ return Lstream_write (stream, str, len);
+}
+
+void
+Lstream_funget_emchar (Lstream *stream, Emchar ch)
+{
+ Bufbyte str[MAX_EMCHAR_LEN];
+ Bytecount len = set_charptr_emchar (str, ch);
+ Lstream_unread (stream, str, len);
+}
+
+\f
+/************************************************************************/
+/* charset object */
+/************************************************************************/
+
+static Lisp_Object
+mark_charset (Lisp_Object obj, void (*markobj) (Lisp_Object))
+{
+ struct Lisp_Charset *cs = XCHARSET (obj);
+
+ (markobj) (cs->doc_string);
+ (markobj) (cs->registry);
+ (markobj) (cs->ccl_program);
+ return cs->name;
+}
+
+static void
+print_charset (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+ struct Lisp_Charset *cs = XCHARSET (obj);
+ char buf[200];
+
+ if (print_readably)
+ error ("printing unreadable object #<charset %s 0x%x>",
+ string_data (XSYMBOL (CHARSET_NAME (cs))->name),
+ cs->header.uid);
+
+ write_c_string ("#<charset ", printcharfun);
+ print_internal (CHARSET_NAME (cs), printcharfun, 0);
+ 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" :
+ CHARSET_TYPE (cs) == CHARSET_TYPE_96 ? "96" :
+ CHARSET_TYPE (cs) == CHARSET_TYPE_94X94 ? "94x94" :
+ "96x96",
+ CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? "l2r" : "r2l",
+ CHARSET_COLUMNS (cs),
+ CHARSET_GRAPHIC (cs),
+ CHARSET_FINAL (cs));
+ write_c_string (buf, printcharfun);
+ print_internal (CHARSET_REGISTRY (cs), printcharfun, 0);
+ sprintf (buf, " 0x%x>", cs->header.uid);
+ write_c_string (buf, printcharfun);
+}
+
+DEFINE_LRECORD_IMPLEMENTATION ("charset", charset,
+ mark_charset, print_charset, 0, 0, 0,
+ struct Lisp_Charset);
+/* Make a new charset. */
+
+static Lisp_Object
+make_charset (int id, Lisp_Object name, Bufbyte leading_byte, unsigned char rep_bytes,
+ unsigned char type, unsigned char columns, unsigned char graphic,
+ Bufbyte final, unsigned char direction, Lisp_Object doc,
+ Lisp_Object reg)
+{
+ Lisp_Object obj;
+ struct Lisp_Charset *cs =
+ alloc_lcrecord_type (struct Lisp_Charset, lrecord_charset);
+ XSETCHARSET (obj, cs);
+
+ CHARSET_ID (cs) = id;
+ CHARSET_NAME (cs) = name;
+ CHARSET_LEADING_BYTE (cs) = leading_byte;
+ CHARSET_REP_BYTES (cs) = rep_bytes;
+ CHARSET_DIRECTION (cs) = direction;
+ CHARSET_TYPE (cs) = type;
+ CHARSET_COLUMNS (cs) = columns;
+ CHARSET_GRAPHIC (cs) = graphic;
+ CHARSET_FINAL (cs) = final;
+ CHARSET_DOC_STRING (cs) = doc;
+ CHARSET_REGISTRY (cs) = reg;
+ CHARSET_CCL_PROGRAM (cs) = Qnil;
+ CHARSET_REVERSE_DIRECTION_CHARSET (cs) = Qnil;
+
+ CHARSET_DIMENSION (cs) = (CHARSET_TYPE (cs) == CHARSET_TYPE_94 ||
+ CHARSET_TYPE (cs) == CHARSET_TYPE_96) ? 1 : 2;
+ CHARSET_CHARS (cs) = (CHARSET_TYPE (cs) == CHARSET_TYPE_94 ||
+ CHARSET_TYPE (cs) == CHARSET_TYPE_94X94) ? 94 : 96;
+
+ if (final)
+ {
+ /* 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 (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;
+
+ /* Some charsets are "faux" and don't have names or really exist at
+ all except in the leading-byte table. */
+ if (!NILP (name))
+ Fputhash (name, obj, Vcharset_hashtable);
+ return obj;
+}
+
+static int
+get_unallocated_leading_byte (int dimension)
+{
+ int lb;
+
+ if (dimension == 1)
+ {
+ if (next_allocated_1_byte_leading_byte > MAX_LEADING_BYTE_PRIVATE_1)
+ lb = 0;
+ else
+ lb = next_allocated_1_byte_leading_byte++;
+ }
+ else
+ {
+ if (next_allocated_2_byte_leading_byte > MAX_LEADING_BYTE_PRIVATE_2)
+ lb = 0;
+ else
+ lb = next_allocated_2_byte_leading_byte++;
+ }
+
+ if (!lb)
+ signal_simple_error
+ ("No more character sets free for this dimension",
+ make_int (dimension));
+
+ return lb;
+}
+
+\f
+/************************************************************************/
+/* Basic charset Lisp functions */
+/************************************************************************/
+
+DEFUN ("charsetp", Fcharsetp, 1, 1, 0, /*
+Return non-nil if OBJECT is a charset.
+*/
+ (object))
+{
+ return CHARSETP (object) ? Qt : Qnil;
+}
+
+DEFUN ("find-charset", Ffind_charset, 1, 1, 0, /*
+Retrieve the charset of the given name.
+If CHARSET-OR-NAME is a charset object, it is simply returned.
+Otherwise, CHARSET-OR-NAME should be a symbol. If there is no such charset,
+nil is returned. Otherwise the associated charset object is returned.
+*/
+ (charset_or_name))
+{
+ if (CHARSETP (charset_or_name))
+ return charset_or_name;
+
+ CHECK_SYMBOL (charset_or_name);
+ return Fgethash (charset_or_name, Vcharset_hashtable, Qnil);
+}
+
+DEFUN ("get-charset", Fget_charset, 1, 1, 0, /*
+Retrieve the charset of the given name.
+Same as `find-charset' except an error is signalled if there is no such
+charset instead of returning nil.
+*/
+ (name))
+{
+ Lisp_Object charset = Ffind_charset (name);
+
+ if (NILP (charset))
+ signal_simple_error ("No such charset", name);
+ return charset;
+}
+
+/* We store the charsets in hash tables with the names as the key and the
+ actual charset object as the value. Occasionally we need to use them
+ in a list format. These routines provide us with that. */
+struct charset_list_closure
+{
+ Lisp_Object *charset_list;
+};
+
+static int
+add_charset_to_list_mapper (CONST void *hash_key, void *hash_contents,
+ void *charset_list_closure)
+{
+ /* This function can GC */
+ Lisp_Object key, contents;
+ Lisp_Object *charset_list;
+ struct charset_list_closure *chcl =
+ (struct charset_list_closure*) charset_list_closure;
+ CVOID_TO_LISP (key, hash_key);
+ VOID_TO_LISP (contents, hash_contents);
+ charset_list = chcl->charset_list;
+
+ *charset_list = Fcons (XCHARSET_NAME (contents), *charset_list);
+ return 0;
+}
+
+DEFUN ("charset-list", Fcharset_list, 0, 0, 0, /*
+Return a list of the names of all defined charsets.
+*/
+ ())
+{
+ Lisp_Object charset_list = Qnil;
+ struct gcpro gcpro1;
+ struct charset_list_closure charset_list_closure;
+
+ GCPRO1 (charset_list);
+ charset_list_closure.charset_list = &charset_list;
+ elisp_maphash (add_charset_to_list_mapper, Vcharset_hashtable,
+ &charset_list_closure);
+ UNGCPRO;
+
+ return charset_list;
+}
+
+DEFUN ("charset-name", Fcharset_name, 1, 1, 0, /*
+Return the name of the given charset.
+*/
+ (charset))
+{
+ return XCHARSET_NAME (Fget_charset (charset));
+}
+
+DEFUN ("make-charset", Fmake_charset, 3, 3, 0, /*
+Define a new character set.
+This function is for use with Mule support.
+NAME is a symbol, the name by which the character set is normally referred.
+DOC-STRING is a string describing the character set.
+PROPS is a property list, describing the specific nature of the
+character set. Recognized properties are:
+
+'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.
+ Either 1 or 2. Defaults to 1.
+'columns Number of columns used to display a character in this charset.
+ Only used in TTY mode. (Under X, the actual width of a
+ character can be derived from the font used to display the
+ characters.) If unspecified, defaults to the dimension
+ (this is almost always the correct value).
+'chars Number of characters in each dimension (94 or 96).
+ Defaults to 94. Note that if the dimension is 2, the
+ character set thus described is 94x94 or 96x96.
+'final Final byte of ISO 2022 escape sequence. Must be
+ supplied. Each combination of (DIMENSION, CHARS) defines a
+ separate namespace for final bytes. Note that ISO
+ 2022 restricts the final byte to the range
+ 0x30 - 0x7E if dimension == 1, and 0x30 - 0x5F if
+ dimension == 2. Note also that final bytes in the range
+ 0x30 - 0x3F are reserved for user-defined (not official)
+ character sets.
+'graphic 0 (use left half of font on output) or 1 (use right half
+ of font on output). Defaults to 0. For example, for
+ a font whose registry is ISO8859-1, the left half
+ (octets 0x20 - 0x7F) is the `ascii' character set, while
+ the right half (octets 0xA0 - 0xFF) is the `latin-1'
+ character set. With 'graphic set to 0, the octets
+ will have their high bit cleared; with it set to 1,
+ the octets will have their high bit set.
+'direction 'l2r (left-to-right) or 'r2l (right-to-left).
+ Defaults to 'l2r.
+'ccl-program A compiled CCL program used to convert a character in
+ this charset into an index into the font. This is in
+ addition to the 'graphic property. The CCL program
+ is passed the octets of the character, with the high
+ bit cleared and set depending upon whether the value
+ of the 'graphic property is 0 or 1.
+*/
+ (name, doc_string, props))
+{
+ int lb, 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;
+
+ CHECK_SYMBOL (name);
+ if (!NILP (doc_string))
+ CHECK_STRING (doc_string);
+
+ charset = Ffind_charset (name);
+ if (!NILP (charset))
+ signal_simple_error ("Cannot redefine existing charset", name);
+
+ EXTERNAL_PROPERTY_LIST_LOOP (rest, keyword, value, props)
+ {
+ if (EQ (keyword, Qdimension))
+ {
+ CHECK_INT (value);
+ dimension = XINT (value);
+ if (dimension < 1 || dimension > 2)
+ signal_simple_error ("Invalid value for 'dimension", value);
+ }
+
+ else if (EQ (keyword, Qchars))
+ {
+ CHECK_INT (value);
+ chars = XINT (value);
+ if (chars != 94 && chars != 96)
+ signal_simple_error ("Invalid value for 'chars", value);
+ }
+
+ else if (EQ (keyword, Qcolumns))
+ {
+ CHECK_INT (value);
+ columns = XINT (value);
+ if (columns != 1 && columns != 2)
+ signal_simple_error ("Invalid value for 'columns", value);
+ }
+
+ else if (EQ (keyword, Qgraphic))
+ {
+ CHECK_INT (value);
+ graphic = XINT (value);
+ if (graphic < 0 || graphic > 1)
+ signal_simple_error ("Invalid value for 'graphic", value);
+ }
+
+ else if (EQ (keyword, Qregistry))
+ {
+ CHECK_STRING (value);
+ registry = value;
+ }
+
+ else if (EQ (keyword, Qdirection))
+ {
+ if (EQ (value, Ql2r))
+ direction = CHARSET_LEFT_TO_RIGHT;
+ else if (EQ (value, Qr2l))
+ direction = CHARSET_RIGHT_TO_LEFT;
+ else
+ signal_simple_error ("Invalid value for 'direction", value);
+ }
+
+ else if (EQ (keyword, Qfinal))
+ {
+ CHECK_CHAR_COERCE_INT (value);
+ final = XCHAR (value);
+ if (final < '0' || final > '~')
+ signal_simple_error ("Invalid value for 'final", value);
+ }
+
+ else if (EQ (keyword, Qccl_program))
+ {
+ CHECK_VECTOR (value);
+ ccl_program = value;
+ }
+
+ else
+ signal_simple_error ("Unrecognized property", keyword);
+ }
+
+ if (!final)
+ error ("'final must be specified");
+ if (dimension == 2 && final > 0x5F)
+ signal_simple_error
+ ("Final must be in the range 0x30 - 0x5F for dimension == 2",
+ make_char (final));
+
+ if (dimension == 1)
+ type = (chars == 94) ? CHARSET_TYPE_94 : CHARSET_TYPE_96;
+ else
+ type = (chars == 94) ? CHARSET_TYPE_94X94 : CHARSET_TYPE_96X96;
+
+ if (!NILP (CHARSET_BY_ATTRIBUTES (type, final, CHARSET_LEFT_TO_RIGHT)) ||
+ !NILP (CHARSET_BY_ATTRIBUTES (type, final, CHARSET_RIGHT_TO_LEFT)))
+ error
+ ("Character set already defined for this DIMENSION/CHARS/FINAL combo");
+
+ lb = get_unallocated_leading_byte (dimension);
+
+ if (NILP (doc_string))
+ doc_string = build_string ("");
+
+ if (NILP (registry))
+ registry = build_string ("");
+
+ if (columns == -1)
+ columns = dimension;
+ charset = make_charset (-1, name, lb, dimension + 2, type, columns, graphic,
+ final, direction, doc_string, registry);
+ if (!NILP (ccl_program))
+ XCHARSET_CCL_PROGRAM (charset) = ccl_program;
+ return charset;
+}
+
+DEFUN ("make-reverse-direction-charset", Fmake_reverse_direction_charset,
+ 2, 2, 0, /*
+Make a charset equivalent to CHARSET but which goes in the opposite direction.
+NEW-NAME is the name of the new charset. Return the new charset.
+*/
+ (charset, new_name))
+{
+ Lisp_Object new_charset = Qnil;
+ int lb, dimension, columns, graphic, final;
+ int direction, type;
+ Lisp_Object registry, doc_string;
+ struct Lisp_Charset *cs;
+
+ charset = Fget_charset (charset);
+ if (!NILP (XCHARSET_REVERSE_DIRECTION_CHARSET (charset)))
+ signal_simple_error ("Charset already has reverse-direction charset",
+ charset);
+
+ CHECK_SYMBOL (new_name);
+ if (!NILP (Ffind_charset (new_name)))
+ signal_simple_error ("Cannot redefine existing charset", new_name);
+
+ cs = XCHARSET (charset);
+
+ type = CHARSET_TYPE (cs);
+ columns = CHARSET_COLUMNS (cs);
+ dimension = CHARSET_DIMENSION (cs);
+ lb = get_unallocated_leading_byte (dimension);
+
+ graphic = CHARSET_GRAPHIC (cs);
+ final = CHARSET_FINAL (cs);
+ direction = CHARSET_RIGHT_TO_LEFT;
+ if (CHARSET_DIRECTION (cs) == CHARSET_RIGHT_TO_LEFT)
+ direction = CHARSET_LEFT_TO_RIGHT;
+ doc_string = CHARSET_DOC_STRING (cs);
+ registry = CHARSET_REGISTRY (cs);
+
+ new_charset = make_charset (-1, new_name, lb, dimension + 2, type, columns,
+ graphic, final, direction, doc_string, registry);
+
+ CHARSET_REVERSE_DIRECTION_CHARSET (cs) = new_charset;
+ XCHARSET_REVERSE_DIRECTION_CHARSET (new_charset) = charset;
+
+ return new_charset;
+}
+
+/* #### Reverse direction charsets not yet implemented. */
+#if 0
+DEFUN ("charset-reverse-direction-charset", Fcharset_reverse_direction_charset,
+ 1, 1, 0, /*
+Return the reverse-direction charset parallel to CHARSET, if any.
+This is the charset with the same properties (in particular, the same
+dimension, number of characters per dimension, and final byte) as
+CHARSET but whose characters are displayed in the opposite direction.
+*/
+ (charset))
+{
+ charset = Fget_charset (charset);
+ return XCHARSET_REVERSE_DIRECTION_CHARSET (charset);
+}
+#endif
+
+DEFUN ("charset-from-attributes", Fcharset_from_attributes, 3, 4, 0, /*
+Return a charset with the given DIMENSION, CHARS, FINAL, and DIRECTION.
+If DIRECTION is omitted, both directions will be checked (left-to-right
+will be returned if character sets exist for both directions).
+*/
+ (dimension, chars, final, direction))
+{
+ int dm, ch, fi, di = -1;
+ int type;
+ Lisp_Object obj = Qnil;
+
+ CHECK_INT (dimension);
+ dm = XINT (dimension);
+ if (dm < 1 || dm > 2)
+ signal_simple_error ("Invalid value for DIMENSION", dimension);
+
+ CHECK_INT (chars);
+ ch = XINT (chars);
+ if (ch != 94 && ch != 96)
+ signal_simple_error ("Invalid value for CHARS", chars);
+
+ CHECK_CHAR_COERCE_INT (final);
+ fi = XCHAR (final);
+ if (fi < '0' || fi > '~')
+ signal_simple_error ("Invalid value for FINAL", final);
+
+ if (EQ (direction, Ql2r))
+ di = CHARSET_LEFT_TO_RIGHT;
+ else if (EQ (direction, Qr2l))
+ di = CHARSET_RIGHT_TO_LEFT;
+ else if (!NILP (direction))
+ signal_simple_error ("Invalid value for DIRECTION", direction);
+
+ if (dm == 2 && fi > 0x5F)
+ signal_simple_error
+ ("Final must be in the range 0x30 - 0x5F for dimension == 2", final);
+
+ if (dm == 1)
+ type = (ch == 94) ? CHARSET_TYPE_94 : CHARSET_TYPE_96;
+ else
+ type = (ch == 94) ? CHARSET_TYPE_94X94 : CHARSET_TYPE_96X96;
+
+ if (di == -1)
+ {
+ obj = CHARSET_BY_ATTRIBUTES (type, fi, CHARSET_LEFT_TO_RIGHT);
+ if (NILP (obj))
+ obj = CHARSET_BY_ATTRIBUTES (type, fi, CHARSET_RIGHT_TO_LEFT);
+ }
+ else
+ obj = CHARSET_BY_ATTRIBUTES (type, fi, di);
+
+ if (CHARSETP (obj))
+ return XCHARSET_NAME (obj);
+ return obj;
+}
+
+DEFUN ("charset-doc-string", Fcharset_doc_string, 1, 1, 0, /*
+Return doc string of CHARSET.
+*/
+ (charset))
+{
+ return XCHARSET_DOC_STRING (Fget_charset (charset));
+}
+
+DEFUN ("charset-dimension", Fcharset_dimension, 1, 1, 0, /*
+Return dimension of CHARSET.
+*/
+ (charset))
+{
+ return make_int (XCHARSET_DIMENSION (Fget_charset (charset)));
+}
+
+DEFUN ("charset-property", Fcharset_property, 2, 2, 0, /*
+Return property PROP of CHARSET.
+Recognized properties are those listed in `make-charset', as well as
+'name and 'doc-string.
+*/
+ (charset, prop))
+{
+ struct Lisp_Charset *cs;
+
+ charset = Fget_charset (charset);
+ cs = XCHARSET (charset);
+
+ CHECK_SYMBOL (prop);
+ if (EQ (prop, Qname)) return CHARSET_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));
+ if (EQ (prop, Qgraphic)) return make_int (CHARSET_GRAPHIC (cs));
+ if (EQ (prop, Qfinal)) return make_char (CHARSET_FINAL (cs));
+ if (EQ (prop, Qchars)) return make_int (CHARSET_CHARS (cs));
+ if (EQ (prop, Qregistry)) return CHARSET_REGISTRY (cs);
+ if (EQ (prop, Qccl_program)) return CHARSET_CCL_PROGRAM (cs);
+ if (EQ (prop, Qdirection))
+ return CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? Ql2r : Qr2l;
+ if (EQ (prop, Qreverse_direction_charset))
+ {
+ Lisp_Object obj = CHARSET_REVERSE_DIRECTION_CHARSET (cs);
+ if (NILP (obj))
+ return Qnil;
+ else
+ return XCHARSET_NAME (obj);
+ }
+ signal_simple_error ("Unrecognized charset property name", prop);
+ return Qnil; /* not reached */
+}
+
+DEFUN ("charset-id", Fcharset_id, 1, 1, 0, /*
+Return charset identification number of CHARSET.
+*/
+ (charset))
+{
+ return make_int(XCHARSET_ID (Fget_charset (charset)));
+}
+
+/* #### We need to figure out which properties we really want to
+ allow to be set. */
+
+DEFUN ("set-charset-ccl-program", Fset_charset_ccl_program, 2, 2, 0, /*
+Set the 'ccl-program property of CHARSET to CCL-PROGRAM.
+*/
+ (charset, ccl_program))
+{
+ charset = Fget_charset (charset);
+ CHECK_VECTOR (ccl_program);
+ XCHARSET_CCL_PROGRAM (charset) = ccl_program;
+ return Qnil;
+}
+
+static void
+invalidate_charset_font_caches (Lisp_Object charset)
+{
+ /* Invalidate font cache entries for charset on all devices. */
+ Lisp_Object devcons, concons, hashtab;
+ DEVICE_LOOP_NO_BREAK (devcons, concons)
+ {
+ struct device *d = XDEVICE (XCAR (devcons));
+ hashtab = Fgethash (charset, d->charset_font_cache, Qunbound);
+ if (!UNBOUNDP (hashtab))
+ Fclrhash (hashtab);
+ }
+}
+
+/* Japanese folks may want to (set-charset-registry 'ascii "jisx0201") */
+DEFUN ("set-charset-registry", Fset_charset_registry, 2, 2, 0, /*
+Set the 'registry property of CHARSET to REGISTRY.
+*/
+ (charset, registry))
+{
+ charset = Fget_charset (charset);
+ CHECK_STRING (registry);
+ XCHARSET_REGISTRY (charset) = registry;
+ invalidate_charset_font_caches (charset);
+ face_property_was_changed (Vdefault_face, Qfont, Qglobal);
+ return Qnil;
+}
+
+\f
+/************************************************************************/
+/* Lisp primitives for working with characters */
+/************************************************************************/
+
+DEFUN ("make-char", Fmake_char, 2, 3, 0, /*
+Make a multi-byte character from CHARSET and octets ARG1 and ARG2.
+*/
+ (charset, arg1, arg2))
+{
+ struct Lisp_Charset *cs;
+ int a1, a2;
+ int lowlim, highlim;
+
+ charset = Fget_charset (charset);
+ cs = XCHARSET (charset);
+
+ if (EQ (charset, Vcharset_ascii)) lowlim = 0, highlim = 127;
+ else if (EQ (charset, Vcharset_control_1)) lowlim = 0, highlim = 31;
+ else if (CHARSET_CHARS (cs) == 94) lowlim = 33, highlim = 126;
+ else /* CHARSET_CHARS (cs) == 96) */ lowlim = 32, highlim = 127;
+
+ CHECK_INT (arg1);
+ a1 = XINT (arg1);
+ if (a1 < lowlim || a1 > highlim)
+ args_out_of_range_3 (arg1, make_int (lowlim), make_int (highlim));
+
+ if (CHARSET_DIMENSION (cs) == 1)
+ {
+ if (!NILP (arg2))
+ signal_simple_error
+ ("Charset is of dimension one; second octet must be nil", arg2);
+ return make_char (MAKE_CHAR (charset, a1, 0));
+ }
+
+ CHECK_INT (arg2);
+ a2 = XINT (arg2);
+ if (a2 < lowlim || a2 > highlim)
+ args_out_of_range_3 (arg2, make_int (lowlim), make_int (highlim));
+
+ return make_char (MAKE_CHAR (charset, a1, a2));
+}
+
+DEFUN ("char-charset", Fchar_charset, 1, 1, 0, /*
+Return the character set of char CH.
+*/
+ (ch))
+{
+ CHECK_CHAR_COERCE_INT (ch);
+
+ return XCHARSET_NAME (CHARSET_BY_LEADING_BYTE
+ (CHAR_LEADING_BYTE (XCHAR (ch))));
+}
+
+DEFUN ("char-octet", Fchar_octet, 1, 2, 0, /*
+Return the octet numbered N (should be 0 or 1) of char CH.
+N defaults to 0 if omitted.
+*/
+ (ch, n))
+{
+ Lisp_Object charset;
+ int c1, c2, int_n;
+
+ CHECK_CHAR_COERCE_INT (ch);
+ if (NILP (n))
+ int_n = 0;
+ 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);
+ }
+ BREAKUP_CHAR (XCHAR (ch), charset, c1, c2);
+ return make_int (int_n == 0 ? c1 : c2);
+}
+
+\f
+/************************************************************************/
+/* composite character functions */
+/************************************************************************/
+
+Emchar
+lookup_composite_char (Bufbyte *str, int len)
+{
+ Lisp_Object lispstr = make_string (str, len);
+ Lisp_Object ch = Fgethash (lispstr,
+ Vcomposite_char_string2char_hashtable,
+ Qunbound);
+ Emchar emch;
+
+ if (UNBOUNDP (ch))
+ {
+ if (composite_char_row_next >= 128)
+ signal_simple_error ("No more composite chars available", lispstr);
+ emch = MAKE_CHAR (Vcharset_composite, composite_char_row_next,
+ composite_char_col_next);
+ Fputhash (make_char (emch), lispstr,
+ Vcomposite_char_char2string_hashtable);
+ Fputhash (lispstr, make_char (emch),
+ Vcomposite_char_string2char_hashtable);
+ composite_char_col_next++;
+ if (composite_char_col_next >= 128)
+ {
+ composite_char_col_next = 32;
+ composite_char_row_next++;
+ }
+ }
+ else
+ emch = XCHAR (ch);
+ return emch;
+}
+
+Lisp_Object
+composite_char_string (Emchar ch)
+{
+ Lisp_Object str = Fgethash (make_char (ch),
+ Vcomposite_char_char2string_hashtable,
+ Qunbound);
+ assert (!UNBOUNDP (str));
+ return str;
+}
+
+DEFUN ("make-composite-char", Fmake_composite_char, 1, 1, 0, /*
+Convert a string into a single composite character.
+The character is the result of overstriking all the characters in
+the string.
+*/
+ (string))
+{
+ CHECK_STRING (string);
+ return make_char (lookup_composite_char (XSTRING_DATA (string),
+ XSTRING_LENGTH (string)));
+}
+
+DEFUN ("composite-char-string", Fcomposite_char_string, 1, 1, 0, /*
+Return a string of the characters comprising a composite character.
+*/
+ (ch))
+{
+ Emchar emch;
+
+ CHECK_CHAR (ch);
+ emch = XCHAR (ch);
+ if (CHAR_LEADING_BYTE (emch) != LEADING_BYTE_COMPOSITE)
+ signal_simple_error ("Must be composite char", ch);
+ return composite_char_string (emch);
+}
+
+\f
+/************************************************************************/
+/* initialization */
+/************************************************************************/
+
+void
+syms_of_mule_charset (void)
+{
+ DEFSUBR (Fcharsetp);
+ DEFSUBR (Ffind_charset);
+ DEFSUBR (Fget_charset);
+ DEFSUBR (Fcharset_list);
+ DEFSUBR (Fcharset_name);
+ DEFSUBR (Fmake_charset);
+ DEFSUBR (Fmake_reverse_direction_charset);
+ /* DEFSUBR (Freverse_direction_charset); */
+ DEFSUBR (Fcharset_from_attributes);
+ DEFSUBR (Fcharset_doc_string);
+ DEFSUBR (Fcharset_dimension);
+ DEFSUBR (Fcharset_property);
+ DEFSUBR (Fcharset_id);
+ DEFSUBR (Fset_charset_ccl_program);
+ DEFSUBR (Fset_charset_registry);
+
+ DEFSUBR (Fmake_char);
+ DEFSUBR (Fchar_charset);
+ DEFSUBR (Fchar_octet);
+
+ DEFSUBR (Fmake_composite_char);
+ DEFSUBR (Fcomposite_char_string);
+
+ defsymbol (&Qcharsetp, "charsetp");
+ defsymbol (&Qregistry, "registry");
+ defsymbol (&Qfinal, "final");
+ defsymbol (&Qgraphic, "graphic");
+ defsymbol (&Qdirection, "direction");
+ defsymbol (&Qreverse_direction_charset, "reverse-direction-charset");
+ defsymbol (&Qccl_program, "ccl-program");
+
+ defsymbol (&Ql2r, "l2r");
+ defsymbol (&Qr2l, "r2l");
+
+ /* Charsets, compatible with Emacs/Mule 19.33-delta
+ Naming convention is Script-Charset[-Edition] */
+ defsymbol (&Qascii, "ascii");
+ defsymbol (&Qcontrol_1, "control-1");
+ defsymbol (&Qlatin_iso8859_1, "latin-iso8859-1");
+ 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 (&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 (&Qjapanese_jisx0208_1978, "japanese-jisx0208-1978");
+ defsymbol (&Qjapanese_jisx0208, "japanese-jisx0208");
+ defsymbol (&Qjapanese_jisx0212, "japanese-jisx0212");
+
+ defsymbol (&Qchinese_gb2312, "chinese-gb2312");
+ 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");
+}
+
+void
+vars_of_mule_charset (void)
+{
+ int i, j, k;
+
+ /* Table of charsets indexed by leading byte. */
+ for (i = 0; i < countof (charset_by_leading_byte); i++)
+ 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;
+
+ next_allocated_1_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_1;
+ next_allocated_2_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_2;
+}
+
+void
+complex_vars_of_mule_charset (void)
+{
+ staticpro (&Vcharset_hashtable);
+ Vcharset_hashtable = make_lisp_hashtable (50, HASHTABLE_NONWEAK,
+ HASHTABLE_EQ);
+
+ /* Predefined character sets. We store them into variables for
+ ease of access. */
+
+ Vcharset_ascii =
+ make_charset (0, Qascii, LEADING_BYTE_ASCII, 1,
+ CHARSET_TYPE_94, 1, 0, 'B',
+ CHARSET_LEFT_TO_RIGHT,
+ build_string ("ASCII (ISO 646 IRV)"),
+ build_string ("iso8859-1"));
+ Vcharset_control_1 =
+ make_charset (-1, Qcontrol_1, LEADING_BYTE_CONTROL_1, 2,
+ CHARSET_TYPE_94, 1, 0, 0,
+ CHARSET_LEFT_TO_RIGHT,
+ build_string ("Control characters"),
+ build_string (""));
+ Vcharset_latin_iso8859_1 =
+ make_charset (129, Qlatin_iso8859_1, LEADING_BYTE_LATIN_ISO8859_1, 2,
+ CHARSET_TYPE_96, 1, 1, 'A',
+ CHARSET_LEFT_TO_RIGHT,
+ build_string ("ISO 8859-1 (Latin-1)"),
+ build_string ("iso8859-1"));
+ Vcharset_latin_iso8859_2 =
+ make_charset (130, Qlatin_iso8859_2, LEADING_BYTE_LATIN_ISO8859_2, 2,
+ CHARSET_TYPE_96, 1, 1, 'B',
+ CHARSET_LEFT_TO_RIGHT,
+ build_string ("ISO 8859-2 (Latin-2)"),
+ build_string ("iso8859-2"));
+ Vcharset_latin_iso8859_3 =
+ make_charset (131, Qlatin_iso8859_3, LEADING_BYTE_LATIN_ISO8859_3, 2,
+ CHARSET_TYPE_96, 1, 1, 'C',
+ CHARSET_LEFT_TO_RIGHT,
+ build_string ("ISO 8859-3 (Latin-3)"),
+ build_string ("iso8859-3"));
+ Vcharset_latin_iso8859_4 =
+ make_charset (132, Qlatin_iso8859_4, LEADING_BYTE_LATIN_ISO8859_4, 2,
+ CHARSET_TYPE_96, 1, 1, 'D',
+ CHARSET_LEFT_TO_RIGHT,
+ build_string ("ISO 8859-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"));
+ Vcharset_thai_tis620 =
+ make_charset (133, Qthai_tis620, LEADING_BYTE_THAI_TIS620, 2,
+ CHARSET_TYPE_96, 1, 1, 'T',
+ CHARSET_LEFT_TO_RIGHT,
+ build_string ("TIS 620.2529 (Thai)"),
+ build_string ("tis620"));
+
+ /* Japanese */
+ Vcharset_katakana_jisx0201 =
+ make_charset (137, Qkatakana_jisx0201,
+ LEADING_BYTE_KATAKANA_JISX0201, 2,
+ CHARSET_TYPE_94, 1, 1, 'I',
+ CHARSET_LEFT_TO_RIGHT,
+ build_string ("JIS X0201-Katakana"),
+ build_string ("jisx0201.1976"));
+ Vcharset_latin_jisx0201 =
+ make_charset (138, Qlatin_jisx0201,
+ LEADING_BYTE_LATIN_JISX0201, 2,
+ CHARSET_TYPE_94, 1, 0, 'J',
+ CHARSET_LEFT_TO_RIGHT,
+ build_string ("JIS X0201-Latin"),
+ build_string ("jisx0201.1976"));
+ Vcharset_japanese_jisx0208_1978 =
+ make_charset (144, Qjapanese_jisx0208_1978,
+ LEADING_BYTE_JAPANESE_JISX0208_1978, 3,
+ CHARSET_TYPE_94X94, 2, 0, '@',
+ CHARSET_LEFT_TO_RIGHT,
+ build_string
+ ("JIS X0208-1978 (Japanese Kanji; Old Version)"),
+ build_string ("\\(jisx0208\\|jisc6226\\).19"));
+ Vcharset_japanese_jisx0208 =
+ make_charset (146, Qjapanese_jisx0208,
+ LEADING_BYTE_JAPANESE_JISX0208, 3,
+ CHARSET_TYPE_94X94, 2, 0, 'B',
+ CHARSET_LEFT_TO_RIGHT,
+ build_string ("JIS X0208-1983 (Japanese Kanji)"),
+ build_string ("jisx0208.19\\(83\\|90\\)"));
+ Vcharset_japanese_jisx0212 =
+ make_charset (148, Qjapanese_jisx0212,
+ LEADING_BYTE_JAPANESE_JISX0212, 3,
+ CHARSET_TYPE_94X94, 2, 0, 'D',
+ CHARSET_LEFT_TO_RIGHT,
+ build_string ("JIS X0212 (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 "$"
+ Vcharset_chinese_cns11643_1 =
+ make_charset (149, Qchinese_cns11643_1,
+ LEADING_BYTE_CHINESE_CNS11643_1, 3,
+ CHARSET_TYPE_94X94, 2, 0, 'G',
+ CHARSET_LEFT_TO_RIGHT,
+ build_string
+ ("CNS 11643 Plane 1 (Traditional Chinese for daily use)"),
+ build_string (CHINESE_CNS_PLANE_RE("1")));
+ Vcharset_chinese_cns11643_2 =
+ make_charset (150, Qchinese_cns11643_2,
+ LEADING_BYTE_CHINESE_CNS11643_2, 3,
+ CHARSET_TYPE_94X94, 2, 0, 'H',
+ CHARSET_LEFT_TO_RIGHT,
+ build_string
+ ("CNS 11643 Plane 2 (Traditional Chinese for daily use)"),
+ build_string (CHINESE_CNS_PLANE_RE("2")));
+ Vcharset_chinese_big5_1 =
+ make_charset (152, Qchinese_big5_1, LEADING_BYTE_CHINESE_BIG5_1, 3,
+ CHARSET_TYPE_94X94, 2, 0, '0',
+ CHARSET_LEFT_TO_RIGHT,
+ build_string
+ ("Big5 Level 1 (Traditional Chinese for daily use)"),
+ build_string ("big5"));
+ Vcharset_chinese_big5_2 =
+ make_charset (153, Qchinese_big5_2, LEADING_BYTE_CHINESE_BIG5_2, 3,
+ CHARSET_TYPE_94X94, 2, 0, '1',
+ CHARSET_LEFT_TO_RIGHT,
+ build_string
+ ("Big5 Level 2 (Traditional Chinese for daily use)"),
+ 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"));
+ /* #### 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. */
+ Vcharset_composite =
+ make_charset (-1, Qcomposite, LEADING_BYTE_COMPOSITE, 3,
+ CHARSET_TYPE_96X96, 2, 0, 0,
+ CHARSET_LEFT_TO_RIGHT,
+ build_string ("Composite characters"),
+ build_string (""));
+
+ composite_char_row_next = 32;
+ composite_char_col_next = 32;
+
+ Vcomposite_char_string2char_hashtable =
+ make_lisp_hashtable (500, HASHTABLE_NONWEAK, HASHTABLE_EQUAL);
+ Vcomposite_char_char2string_hashtable =
+ make_lisp_hashtable (500, HASHTABLE_NONWEAK, HASHTABLE_EQ);
+ staticpro (&Vcomposite_char_string2char_hashtable);
+ staticpro (&Vcomposite_char_char2string_hashtable);
+
+}
--- /dev/null
+/* Header for multilingual functions.
+ Copyright (C) 1992, 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>. */
+
+#ifndef _XEMACS_MULE_CHARSET_H
+#define _XEMACS_MULE_CHARSET_H
+
+/*
+ 1. Character Sets
+ =================
+
+ A character set (or "charset") is an ordered set of characters.
+ A particular character in a charset is indexed using one or
+ more "position codes", which are non-negative integers.
+ The number of position codes needed to identify a particular
+ character in a charset is called the "dimension" of the
+ charset. In XEmacs/Mule, all charsets have 1 or 2 dimensions,
+ and the size of all charsets (except for a few special cases)
+ is either 94, 96, 94 by 94, or 96 by 96. The range of
+ position codes used to index characters from any of these
+ types of character sets is as follows:
+
+ Charset type Position code 1 Position code 2
+ ------------------------------------------------------------
+ 94 33 - 126 N/A
+ 96 32 - 127 N/A
+ 94x94 33 - 126 33 - 126
+ 96x96 32 - 127 32 - 127
+
+ Note that in the above cases position codes do not start at
+ an expected value such as 0 or 1. The reason for this will
+ become clear later.
+
+ For example, Latin-1 is a 96-character charset, and JISX0208
+ (the Japanese national character set) is a 94x94-character
+ charset.
+
+ [Note that, although the ranges above define the *valid*
+ position codes for a charset, some of the slots in a particular
+ charset may in fact be empty. This is the case for JISX0208,
+ for example, where (e.g.) all the slots whose first
+ position code is in the range 118 - 127 are empty.]
+
+ There are three charsets that do not follow the above rules.
+ All of them have one dimension, and have ranges of position
+ codes as follows:
+
+ Charset name Position code 1
+ ------------------------------------
+ ASCII 0 - 127
+ Control-1 0 - 31
+ Composite 0 - some large number
+
+ (The upper bound of the position code for composite characters
+ has not yet been determined, but it will probably be at
+ least 16,383).
+
+ ASCII is the union of two subsidiary character sets:
+ Printing-ASCII (the printing ASCII character set,
+ consisting of position codes 33 - 126, like for a standard
+ 94-character charset) and Control-ASCII (the non-printing
+ characters that would appear in a binary file with codes 0
+ - 32 and 127).
+
+ Control-1 contains the non-printing characters that would
+ appear in a binary file with codes 128 - 159.
+
+ Composite contains characters that are generated by
+ overstriking one or more characters from other charsets.
+
+ Note that some characters in ASCII, and all characters
+ in Control-1, are "control" (non-printing) characters.
+ These have no printed representation but instead control
+ some other function of the printing (e.g. TAB or 8 moves
+ the current character position to the next tab stop).
+ All other characters in all charsets are "graphic"
+ (printing) characters.
+
+ When a binary file is read in, the bytes in the file are
+ assigned to character sets as follows:
+
+ Bytes Character set Range
+ --------------------------------------------------
+ 0 - 127 ASCII 0 - 127
+ 128 - 159 Control-1 0 - 31
+ 160 - 255 Latin-1 32 - 127
+
+ This is a bit ad-hoc but gets the job done.
+
+ 2. Encodings
+ ============
+
+ An "encoding" is a way of numerically representing
+ characters from one or more character sets. If an encoding
+ only encompasses one character set, then the position codes
+ for the characters in that character set could be used
+ directly. This is not possible, however, if more than one
+ character set is to be used in the encoding.
+
+ For example, the conversion detailed above between bytes in
+ a binary file and characters is effectively an encoding
+ that encompasses the three character sets ASCII, Control-1,
+ and Latin-1 in a stream of 8-bit bytes.
+
+ Thus, an encoding can be viewed as a way of encoding
+ characters from a specified group of character sets using a
+ stream of bytes, each of which contains a fixed number of
+ bits (but not necessarily 8, as in the common usage of
+ "byte").
+
+ Here are descriptions of a couple of common
+ encodings:
+
+
+ A. Japanese EUC (Extended Unix Code)
+
+ This encompasses the character sets:
+ - Printing-ASCII,
+ - Katakana-JISX0201 (half-width katakana, the right half of JISX0201).
+ - Japanese-JISX0208
+ - Japanese-JISX0212
+ It uses 8-bit bytes.
+
+ Note that Printing-ASCII and Katakana-JISX0201 are 94-character
+ charsets, while Japanese-JISX0208 is a 94x94-character charset.
+
+ The encoding is as follows:
+
+ Character set Representation (PC == position-code)
+ ------------- --------------
+ Printing-ASCII PC1
+ Japanese-JISX0208 PC1 + 0x80 | PC2 + 0x80
+ Katakana-JISX0201 0x8E | PC1 + 0x80
+
+
+ B. JIS7
+
+ This encompasses the character sets:
+ - Printing-ASCII
+ - Latin-JISX0201 (the left half of JISX0201; this character set is
+ very similar to Printing-ASCII and is a 94-character charset)
+ - Japanese-JISX0208
+ - Katakana-JISX0201
+ It uses 7-bit bytes.
+
+ Unlike Japanese EUC, this is a "modal" encoding, which
+ means that there are multiple states that the encoding can
+ be in, which affect how the bytes are to be interpreted.
+ Special sequences of bytes (called "escape sequences")
+ are used to change states.
+
+ The encoding is as follows:
+
+ Character set Representation
+ ------------- --------------
+ Printing-ASCII PC1
+ Latin-JISX0201 PC1
+ Katakana-JISX0201 PC1
+ Japanese-JISX0208 PC1 | PC2
+
+ Escape sequence ASCII equivalent Meaning
+ --------------- ---------------- -------
+ 0x1B 0x28 0x42 ESC ( B invoke Printing-ASCII
+ 0x1B 0x28 0x4A ESC ( J invoke Latin-JISX0201
+ 0x1B 0x28 0x49 ESC ( I invoke Katakana-JISX0201
+ 0x1B 0x24 0x42 ESC $ B invoke Japanese-JISX0208
+
+ Initially, Printing-ASCII is invoked.
+
+ 3. Internal Mule Encodings
+ ==========================
+
+ In XEmacs/Mule, each character set is assigned a unique number,
+ called a "leading byte". This is used in the encodings of a
+ character. Leading bytes are in the range 0x80 - 0xFF
+ (except for ASCII, which has a leading byte of 0), although
+ some leading bytes are reserved.
+
+ Charsets whose leading byte is in the range 0x80 - 0x9F are
+ called "official" and are used for built-in charsets.
+ Other charsets are called "private" and have leading bytes
+ in the range 0xA0 - 0xFF; these are user-defined charsets.
+
+ More specifically:
+
+ Character set Leading byte
+ ------------- ------------
+ ASCII 0
+ Composite 0x80
+ Dimension-1 Official 0x81 - 0x8D
+ (0x8E is free)
+ Control 0x8F
+ Dimension-2 Official 0x90 - 0x99
+ (0x9A - 0x9D are free;
+ 0x9E and 0x9F are reserved)
+ Dimension-1 Private 0xA0 - 0xEF
+ Dimension-2 Private 0xF0 - 0xFF
+
+ There are two internal encodings for characters in XEmacs/Mule.
+ One is called "string encoding" and is an 8-bit encoding that
+ is used for representing characters in a buffer or string.
+ It uses 1 to 4 bytes per character. The other is called
+ "character encoding" and is a 19-bit encoding that is used
+ for representing characters individually in a variable.
+
+ (In the following descriptions, we'll ignore composite
+ characters for the moment. We also give a general (structural)
+ overview first, followed later by the exact details.)
+
+ A. Internal String Encoding
+
+ ASCII characters are encoded using their position code directly.
+ Other characters are encoded using their leading byte followed
+ by their position code(s) with the high bit set. Characters
+ in private character sets have their leading byte prefixed with
+ a "leading byte prefix", which is either 0x9E or 0x9F. (No
+ character sets are ever assigned these leading bytes.) Specifically:
+
+ Character set Encoding (PC == position-code)
+ ------------- -------- (LB == leading-byte)
+ ASCII PC1 |
+ Control-1 LB | PC1 + 0xA0
+ Dimension-1 official LB | PC1 + 0x80
+ Dimension-1 private 0x9E | LB | PC1 + 0x80
+ Dimension-2 official LB | PC1 | PC2 + 0x80
+ Dimension-2 private 0x9F | LB | PC1 + 0x80 | PC2 + 0x80
+
+ The basic characteristic of this encoding is that the first byte
+ of all characters is in the range 0x00 - 0x9F, and the second and
+ following bytes of all characters is in the range 0xA0 - 0xFF.
+ This means that it is impossible to get out of sync, or more
+ specifically:
+
+ 1. Given any byte position, the beginning of the character it is
+ within can be determined in constant time.
+ 2. Given any byte position at the beginning of a character, the
+ beginning of the next character can be determined in constant
+ time.
+ 3. Given any byte position at the beginning of a character, the
+ beginning of the previous character can be determined in constant
+ time.
+ 4. Textual searches can simply treat encoded strings as if they
+ were encoded in a one-byte-per-character fashion rather than
+ the actual multi-byte encoding.
+
+ None of the standard non-modal encodings meet all of these
+ conditions. For example, EUC satisfies only (2) and (3), while
+ Shift-JIS and Big5 (not yet described) satisfy only (2). (All
+ non-modal encodings must satisfy (2), in order to be unambiguous.)
+
+ B. Internal Character Encoding
+
+ One 19-bit word represents a single character. The word is
+ separated into three fields:
+
+ Bit number: 18 17 16 15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00
+ <------------> <------------------> <------------------>
+ Field: 1 2 3
+
+ Note that fields 2 and 3 hold 7 bits each, while field 1 holds 5 bits.
+
+ Character set Field 1 Field 2 Field 3
+ ------------- ------- ------- -------
+ ASCII 0 0 PC1
+ range: (00 - 7F)
+ Control-1 0 1 PC1
+ range: (00 - 1F)
+ Dimension-1 official 0 LB - 0x80 PC1
+ range: (01 - 0D) (20 - 7F)
+ Dimension-1 private 0 LB - 0x80 PC1
+ range: (20 - 6F) (20 - 7F)
+ Dimension-2 official LB - 0x8F PC1 PC2
+ range: (01 - 0A) (20 - 7F) (20 - 7F)
+ Dimension-2 private LB - 0xE1 PC1 PC2
+ range: (0F - 1E) (20 - 7F) (20 - 7F)
+ Composite 0x1F ? ?
+
+ Note that character codes 0 - 255 are the same as the "binary encoding"
+ described above.
+*/
+
+/*
+ About Unicode support:
+
+ Adding Unicode support is very desirable. Unicode will likely be a
+ very common representation in the future, and thus we should
+ represent Unicode characters using three bytes instead of four.
+ This means we need to find leading bytes for Unicode. Given that
+ there are 65,536 characters in Unicode and we can attach 96x96 =
+ 9,216 characters per leading byte, we need eight leading bytes for
+ Unicode. We currently have four free (0x9A - 0x9D), and with a
+ little bit of rearranging we can get five: ASCII doesn't really
+ need to take up a leading byte. (We could just as well use 0x7F,
+ with a little change to the functions that assume that 0x80 is the
+ lowest leading byte.) This means we still need to dump three
+ leading bytes and move them into private space. The CNS charsets
+ are good candidates since they are rarely used, and
+ JAPANESE_JISX0208_1978 is becoming less and less used and could
+ also be dumped. */
+
+\f
+/************************************************************************/
+/* Definition of leading bytes */
+/************************************************************************/
+
+#define MIN_LEADING_BYTE 0x80
+/* These need special treatment in a string and/or character */
+#define LEADING_BYTE_ASCII 0x8E /* Omitted in a buffer */
+#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. **/
+
+#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 */
+
+#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 */
+
+#define MIN_LEADING_BYTE_OFFICIAL_2 LEADING_BYTE_JAPANESE_JISX0208_1978
+#define MAX_LEADING_BYTE_OFFICIAL_2 LEADING_BYTE_CHINESE_BIG5_2
+
+/** The following are for 1- and 2-byte characters in a private charset. **/
+
+#define PRE_LEADING_BYTE_PRIVATE_1 0x9E /* 1-byte char-set */
+#define PRE_LEADING_BYTE_PRIVATE_2 0x9F /* 2-byte char-set */
+
+#define MIN_LEADING_BYTE_PRIVATE_1 0xA0
+#define MAX_LEADING_BYTE_PRIVATE_1 0xEF
+#define MIN_LEADING_BYTE_PRIVATE_2 0xF0
+#define MAX_LEADING_BYTE_PRIVATE_2 0xFF
+
+#define NUM_LEADING_BYTES 128
+
+\f
+/************************************************************************/
+/* Operations on leading bytes */
+/************************************************************************/
+
+/* Is this leading byte for a private charset? */
+
+#define LEADING_BYTE_PRIVATE_P(lb) ((lb) >= MIN_LEADING_BYTE_PRIVATE_1)
+
+/* Is this a prefix for a private leading byte? */
+
+INLINE int LEADING_BYTE_PREFIX_P (unsigned char lb);
+INLINE int
+LEADING_BYTE_PREFIX_P (unsigned char lb)
+{
+ return (lb == PRE_LEADING_BYTE_PRIVATE_1 ||
+ lb == PRE_LEADING_BYTE_PRIVATE_2);
+}
+
+/* Given a private leading byte, return the leading byte prefix stored
+ in a string */
+
+#define PRIVATE_LEADING_BYTE_PREFIX(lb) \
+ ((lb) < MIN_LEADING_BYTE_PRIVATE_2 ? \
+ PRE_LEADING_BYTE_PRIVATE_1 : \
+ PRE_LEADING_BYTE_PRIVATE_2)
+
+\f
+/************************************************************************/
+/* Operations on individual bytes */
+/* of any format */
+/************************************************************************/
+
+/* Argument `c' should be (unsigned int) or (unsigned char). */
+/* Note that SP and DEL are not included. */
+
+#define BYTE_ASCII_P(c) ((c) < 0x80)
+#define BYTE_C0_P(c) ((c) < 0x20)
+/* Do some forced casting just to make *sure* things are gotten right. */
+#define BYTE_C1_P(c) ((unsigned int) ((unsigned int) (c) - 0x80) < 0x20)
+
+\f
+/************************************************************************/
+/* Operations on individual bytes */
+/* in a Mule-formatted string */
+/************************************************************************/
+
+/* Does this byte represent the first byte of a character? */
+
+#define BUFBYTE_FIRST_BYTE_P(c) ((c) < 0xA0)
+
+/* Does this byte represent the first byte of a multi-byte character? */
+
+#define BUFBYTE_LEADING_BYTE_P(c) BYTE_C1_P (c)
+
+\f
+/************************************************************************/
+/* Information about a particular character set */
+/************************************************************************/
+
+struct Lisp_Charset
+{
+ struct lcrecord_header header;
+
+ int id;
+ Lisp_Object name;
+ Lisp_Object doc_string, registry;
+
+ 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;
+
+ /* Number of bytes (1 - 4) required in the internal representation
+ for characters in this character set. This is *not* the
+ same as the dimension of the character set). */
+ unsigned int rep_bytes;
+
+ /* Number of columns a character in this charset takes up, on TTY
+ devices. Not used for X devices. */
+ unsigned int columns;
+
+ /* Direction of this character set */
+ unsigned int direction;
+
+ /* Type of this character set (94, 96, 94x94, 96x96) */
+ unsigned int type;
+
+ /* Number of bytes used in encoding of this character set (1 or 2) */
+ unsigned int dimension;
+
+ /* Number of chars in each dimension (usually 94 or 96) */
+ unsigned int chars;
+
+ /* Which half of font to be used to display this character set */
+ unsigned int graphic;
+};
+
+DECLARE_LRECORD (charset, struct Lisp_Charset);
+#define XCHARSET(x) XRECORD (x, charset, struct 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)
+
+#define CHARSET_TYPE_94 0 /* This charset includes 94 characters. */
+#define CHARSET_TYPE_96 1 /* This charset includes 96 characters. */
+#define CHARSET_TYPE_94X94 2 /* This charset includes 94x94 characters. */
+#define CHARSET_TYPE_96X96 3 /* This charset includes 96x96 characters. */
+
+#define CHARSET_LEFT_TO_RIGHT 0
+#define CHARSET_RIGHT_TO_LEFT 1
+
+#define CHARSET_ID(cs) ((cs)->id)
+#define CHARSET_NAME(cs) ((cs)->name)
+#define CHARSET_LEADING_BYTE(cs) ((cs)->leading_byte)
+#define CHARSET_REP_BYTES(cs) ((cs)->rep_bytes)
+#define CHARSET_COLUMNS(cs) ((cs)->columns)
+#define CHARSET_GRAPHIC(cs) ((cs)->graphic)
+#define CHARSET_TYPE(cs) ((cs)->type)
+#define CHARSET_DIRECTION(cs) ((cs)->direction)
+#define CHARSET_FINAL(cs) ((cs)->final)
+#define CHARSET_DOC_STRING(cs) ((cs)->doc_string)
+#define CHARSET_REGISTRY(cs) ((cs)->registry)
+#define CHARSET_CCL_PROGRAM(cs) ((cs)->ccl_program)
+#define CHARSET_DIMENSION(cs) ((cs)->dimension)
+#define CHARSET_CHARS(cs) ((cs)->chars)
+#define CHARSET_REVERSE_DIRECTION_CHARSET(cs) ((cs)->reverse_direction_charset)
+
+
+#define CHARSET_PRIVATE_P(cs) LEADING_BYTE_PRIVATE_P (CHARSET_LEADING_BYTE (cs))
+
+#define XCHARSET_ID(cs) CHARSET_ID (XCHARSET (cs))
+#define XCHARSET_NAME(cs) CHARSET_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))
+#define XCHARSET_TYPE(cs) CHARSET_TYPE (XCHARSET (cs))
+#define XCHARSET_DIRECTION(cs) CHARSET_DIRECTION (XCHARSET (cs))
+#define XCHARSET_FINAL(cs) CHARSET_FINAL (XCHARSET (cs))
+#define XCHARSET_DOC_STRING(cs) CHARSET_DOC_STRING (XCHARSET (cs))
+#define XCHARSET_REGISTRY(cs) CHARSET_REGISTRY (XCHARSET (cs))
+#define XCHARSET_LEADING_BYTE(cs) CHARSET_LEADING_BYTE (XCHARSET (cs))
+#define XCHARSET_CCL_PROGRAM(cs) CHARSET_CCL_PROGRAM (XCHARSET (cs))
+#define XCHARSET_DIMENSION(cs) CHARSET_DIMENSION (XCHARSET (cs))
+#define XCHARSET_CHARS(cs) CHARSET_CHARS (XCHARSET (cs))
+#define XCHARSET_PRIVATE_P(cs) CHARSET_PRIVATE_P (XCHARSET (cs))
+#define XCHARSET_REVERSE_DIRECTION_CHARSET(cs) \
+ CHARSET_REVERSE_DIRECTION_CHARSET (XCHARSET (cs))
+
+/* 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];
+
+/* 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
+
+ (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];
+
+#ifdef ERROR_CHECK_TYPECHECK
+/* int not Bufbyte even though that is the actual type of a leading byte.
+ This way, out-ot-range values will get caught rather than automatically
+ truncated. */
+INLINE Lisp_Object CHARSET_BY_LEADING_BYTE (int lb);
+INLINE Lisp_Object
+CHARSET_BY_LEADING_BYTE (int lb)
+{
+ assert (lb >= 0x80 && lb <= 0xFF);
+ return charset_by_leading_byte[lb - 128];
+}
+
+#else
+
+#define CHARSET_BY_LEADING_BYTE(lb) (charset_by_leading_byte[(lb) - 128])
+
+#endif
+
+#define CHARSET_BY_ATTRIBUTES(type, final, dir) \
+ (charset_by_attributes[type][final][dir])
+
+#ifdef ERROR_CHECK_TYPECHECK
+
+/* 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);
+ return rep_bytes_by_first_byte[fb];
+}
+
+#else
+#define REP_BYTES_BY_FIRST_BYTE(fb) (rep_bytes_by_first_byte[fb])
+#endif
+
+\f
+/************************************************************************/
+/* Dealing with characters */
+/************************************************************************/
+
+/* Is this character represented by more than one byte in a string? */
+
+#define CHAR_MULTIBYTE_P(c) ((c) >= 0x80)
+
+#define CHAR_ASCII_P(c) (!CHAR_MULTIBYTE_P (c))
+
+/* The bit fields of character are divided into 3 parts:
+ FIELD1(5bits):FIELD2(7bits):FIELD3(7bits) */
+
+#define CHAR_FIELD1_MASK (0x1F << 14)
+#define CHAR_FIELD2_MASK (0x7F << 7)
+#define CHAR_FIELD3_MASK 0x7F
+
+/* Macros to access each field of a character code of C. */
+
+#define CHAR_FIELD1(c) (((c) & CHAR_FIELD1_MASK) >> 14)
+#define CHAR_FIELD2(c) (((c) & CHAR_FIELD2_MASK) >> 7)
+#define CHAR_FIELD3(c) ((c) & CHAR_FIELD3_MASK)
+
+/* Field 1, if non-zero, usually holds a leading byte for a
+ dimension-2 charset. Field 2, if non-zero, usually holds a leading
+ byte for a dimension-1 charset. */
+
+/* Converting between field values and leading bytes. */
+
+#define FIELD2_TO_OFFICIAL_LEADING_BYTE 0x80
+#define FIELD2_TO_PRIVATE_LEADING_BYTE 0x80
+
+#define FIELD1_TO_OFFICIAL_LEADING_BYTE 0x8F
+#define FIELD1_TO_PRIVATE_LEADING_BYTE 0xE1
+
+/* Minimum and maximum allowed values for the fields. */
+
+#define MIN_CHAR_FIELD2_OFFICIAL \
+ (MIN_LEADING_BYTE_OFFICIAL_1 - FIELD2_TO_OFFICIAL_LEADING_BYTE)
+#define MAX_CHAR_FIELD2_OFFICIAL \
+ (MAX_LEADING_BYTE_OFFICIAL_1 - FIELD2_TO_OFFICIAL_LEADING_BYTE)
+
+#define MIN_CHAR_FIELD1_OFFICIAL \
+ (MIN_LEADING_BYTE_OFFICIAL_2 - FIELD1_TO_OFFICIAL_LEADING_BYTE)
+#define MAX_CHAR_FIELD1_OFFICIAL \
+ (MAX_LEADING_BYTE_OFFICIAL_2 - FIELD1_TO_OFFICIAL_LEADING_BYTE)
+
+#define MIN_CHAR_FIELD2_PRIVATE \
+ (MIN_LEADING_BYTE_PRIVATE_1 - FIELD2_TO_PRIVATE_LEADING_BYTE)
+#define MAX_CHAR_FIELD2_PRIVATE \
+ (MAX_LEADING_BYTE_PRIVATE_1 - FIELD2_TO_PRIVATE_LEADING_BYTE)
+
+#define MIN_CHAR_FIELD1_PRIVATE \
+ (MIN_LEADING_BYTE_PRIVATE_2 - FIELD1_TO_PRIVATE_LEADING_BYTE)
+#define MAX_CHAR_FIELD1_PRIVATE \
+ (MAX_LEADING_BYTE_PRIVATE_2 - FIELD1_TO_PRIVATE_LEADING_BYTE)
+
+/* Minimum character code of each <type> character. */
+
+#define MIN_CHAR_OFFICIAL_TYPE9N (MIN_CHAR_FIELD2_OFFICIAL << 7)
+#define MIN_CHAR_PRIVATE_TYPE9N (MIN_CHAR_FIELD2_PRIVATE << 7)
+#define MIN_CHAR_OFFICIAL_TYPE9NX9N (MIN_CHAR_FIELD1_OFFICIAL << 14)
+#define MIN_CHAR_PRIVATE_TYPE9NX9N (MIN_CHAR_FIELD1_PRIVATE << 14)
+#define MIN_CHAR_COMPOSITION (0x1F << 14)
+
+/* Leading byte of a character.
+
+ NOTE: This takes advantage of the fact that
+ FIELD2_TO_OFFICIAL_LEADING_BYTE and
+ FIELD2_TO_PRIVATE_LEADING_BYTE are the same.
+ */
+
+INLINE Bufbyte CHAR_LEADING_BYTE (Emchar c);
+INLINE Bufbyte
+CHAR_LEADING_BYTE (Emchar c)
+{
+ if (CHAR_ASCII_P (c))
+ return LEADING_BYTE_ASCII;
+ else if (c < 0xA0)
+ return LEADING_BYTE_CONTROL_1;
+ else if (c < MIN_CHAR_OFFICIAL_TYPE9NX9N)
+ return CHAR_FIELD2 (c) + FIELD2_TO_OFFICIAL_LEADING_BYTE;
+ else if (c < MIN_CHAR_PRIVATE_TYPE9NX9N)
+ return CHAR_FIELD1 (c) + FIELD1_TO_OFFICIAL_LEADING_BYTE;
+ else if (c < MIN_CHAR_COMPOSITION)
+ return CHAR_FIELD1 (c) + FIELD1_TO_PRIVATE_LEADING_BYTE;
+ else
+ return LEADING_BYTE_COMPOSITE;
+}
+
+#define CHAR_CHARSET(c) CHARSET_BY_LEADING_BYTE (CHAR_LEADING_BYTE (c))
+
+/* Return a character whose charset is CHARSET and position-codes
+ are C1 and C2. TYPE9N character ignores C2.
+
+ NOTE: This takes advantage of the fact that
+ FIELD2_TO_OFFICIAL_LEADING_BYTE and
+ FIELD2_TO_PRIVATE_LEADING_BYTE are the same.
+ */
+
+INLINE Emchar MAKE_CHAR (Lisp_Object charset, int c1, int c2);
+INLINE Emchar
+MAKE_CHAR (Lisp_Object charset, int c1, int c2)
+{
+ if (EQ (charset, Vcharset_ascii))
+ return c1;
+ else if (EQ (charset, Vcharset_control_1))
+ return c1 | 0x80;
+ else if (EQ (charset, Vcharset_composite))
+ return (0x1F << 14) | ((c1) << 7) | (c2);
+ else if (XCHARSET_DIMENSION (charset) == 1)
+ return ((XCHARSET_LEADING_BYTE (charset) -
+ FIELD2_TO_OFFICIAL_LEADING_BYTE) << 7) | (c1);
+ else if (!XCHARSET_PRIVATE_P (charset))
+ return ((XCHARSET_LEADING_BYTE (charset) -
+ FIELD1_TO_OFFICIAL_LEADING_BYTE) << 14) | ((c1) << 7) | (c2);
+ else
+ return ((XCHARSET_LEADING_BYTE (charset) -
+ FIELD1_TO_PRIVATE_LEADING_BYTE) << 14) | ((c1) << 7) | (c2);
+}
+
+/* The charset of character C is set to CHARSET, and the
+ position-codes of C are set to C1 and C2. C2 of TYPE9N character
+ is 0. */
+
+/* BREAKUP_CHAR_1_UNSAFE assumes that the charset has already been
+ calculated, and just computes c1 and c2.
+
+ BREAKUP_CHAR also computes and stores the charset. */
+
+#define BREAKUP_CHAR_1_UNSAFE(c, charset, c1, c2) \
+ XCHARSET_DIMENSION (charset) == 1 \
+ ? ((c1) = CHAR_FIELD3 (c), (c2) = 0) \
+ : ((c1) = CHAR_FIELD2 (c), \
+ (c2) = CHAR_FIELD3 (c))
+
+INLINE void breakup_char_1 (Emchar c, Lisp_Object *charset, int *c1, int *c2);
+INLINE void
+breakup_char_1 (Emchar c, Lisp_Object *charset, int *c1, int *c2)
+{
+ *charset = CHAR_CHARSET (c);
+ BREAKUP_CHAR_1_UNSAFE (c, *charset, *c1, *c2);
+}
+
+#define BREAKUP_CHAR(c, charset, c1, c2) \
+ breakup_char_1 (c, &(charset), &(c1), &(c2))
+
+
+\f
+/************************************************************************/
+/* Composite characters */
+/************************************************************************/
+
+Emchar lookup_composite_char (Bufbyte *str, int len);
+Lisp_Object composite_char_string (Emchar ch);
+
+\f
+/************************************************************************/
+/* Exported functions */
+/************************************************************************/
+
+EXFUN (Ffind_charset, 1);
+EXFUN (Fget_charset, 1);
+
+extern Lisp_Object Vcharset_chinese_big5_1;
+extern Lisp_Object Vcharset_chinese_big5_2;
+extern Lisp_Object Vcharset_japanese_jisx0208;
+
+Emchar Lstream_get_emchar_1 (Lstream *stream, int first_char);
+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,
+ unsigned char *external);
+Bytecount copy_external_to_internal (CONST unsigned char *external,
+ int len, Bufbyte *internal);
+
+#endif /* _XEMACS_MULE_CHARSET_H */
--- /dev/null
+/*
+ Copyright (C) 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. */
+
+/* Jserver Interface for Mule
+ Coded by Yutaka Ishikawa at ETL (yisikawa@etl.go.jp)
+ Satoru Tomura at ETL (tomura@etl.go.jp)
+ Modified for Wnn4 library by
+ Toshiaki Shingu (shingu@cpr.canon.co.jp)
+ Hiroshi Kuribayashi (kuri@nff.ncl.omron.co.jp) */
+
+/*
+ * Functions defined in this file are
+ * (wnn-server-open wnn-host-name login-name)
+ * wnn-host-name: STRING or NIL
+ * login-name: STRING
+ * RETURNS: BOOLEAN
+ * DESCRIPTION:
+ * jserver \e$B$H@\B3$7!"%5!<%P!<FbIt$K@5JQ49!?5UJQ49#2$D$N4D6-$r\e(B
+ * \e$B:n$k!#%(%i!<$N;~$O\e(B nil \e$B$rJV$9!#\e(B
+ *
+ * (wnn-server-close)
+ * RETURNS: BOOLEAN
+ * DESCRIPTION:
+ * jserver \e$B$H$N@\B3$r@Z$k!#<-=q!"IQEY$O%;!<%V$5$l$J$$!#\e(B
+ *
+ * (wnn-server-dict-add dict-file-name hindo-file-name priority
+ * dict-file-mode hindo-file-mode pw1 pw2)
+ * dict-file-name: STRING
+ * hindo-file-name: STRING or NULL-STRING
+ * priority: INTEGER
+ * dict-file-mode: BOOLEAN
+ * hindo-file-mode: BOOLEAN
+ * pw1: STRING or NIL
+ * pw2: STRING or NIL
+ * DESCRIPTION:
+ * \e$B<-=q%U%!%$%kL>!"IQEY%U%!%$%kL>!"M%@hEY!"<-=q%U%!%$%k%b!<%I\e(B
+ * \e$BIQEY%U%!%$%k%b!<%I$G;XDj$7$?<-=q$r%P%C%U%!$KDI2C$9$k!#\e(B
+ * pw1, pw2 \e$B$O<-=q%U%!%$%k!"IQEY%U%!%$%k$N%Q%9%o!<%I!#\e(B
+ *
+ * (wnn-server-dict-delete dic-no)
+ * dic-no: INTEGER
+ * RETURNS: \e$B%(%i!<$N;~\e(B nil
+ * DESCRIPTION: dic-no \e$B$N<-=qHV9f$N<-=q$r!"%P%C%U%!$+$i\e(B
+ * \e$B:o=|$9$k!#\e(B
+ *
+ * (wnn-server-dict-list)
+ * RETURNS: ((dic-no1 file-name1 comment1 word-no1 nice1)
+ * (dic-no2 file-name2 comment2 word-no2 nice2)...)
+ * DESCRIPTION: \e$B%P%C%U%!>e$N<-=q$N%j%9%H$rF@$k!#\e(B
+ *
+ * (wnn-server-dict-comment dic-no comment)
+ * RETURNS: \e$B%(%i!<$N;~\e(B nil
+ * DESCRIPTION: dic-no \e$B$N<-=q$K%3%a%s%H$r$D$1$k!#\e(B
+ *
+ * (wnn-server-set-rev rev)
+ * rev: BOOLEAN
+ * rev \e$B$,\e(B nil \e$B$N;~$O@5JQ49!"$=$l0J30$N;~$O5UJQ49\e(B
+ *
+ * (wnn-server-henkan-begin henkan-string)
+ * henkan-string: STRING
+ * RETURNS: bunsetu-suu
+ * DESCRIPTION:
+ * \e$B2>L>4A;zJQ49$r$7!"Bh0l8uJd$NJ8@a?t$rJV$9!#\e(B
+ *
+ * (wnn-server-zenkouho bunsetu-no dai)
+ * bunsetu-no: INTEGER
+ * dai: BOOLEAN
+ * RETURNS: offset
+ * DESCRIPTION:
+ * \e$BJ8@aHV9f$G;XDj$5$l$?J8@a$NA48uJd$r$H$j$@$7\e(B
+ * \e$B!"8=:_$N%*%U%;%C%H$rJV$9!#\e(B
+ *
+ * (wnn-server-get-zenkouho offset)
+ * bunsetu-no: INTEGER
+ * dai: BOOLEAN
+ * RETURNS: list of zenkouho
+ * DESCRIPTION:
+ * \e$B%*%U%;%C%H$G;XDj$5$l$?8uJd$rF@$k!#\e(B
+ *
+ * (wnn-server-zenkouho-bun)
+ * RETURNS: INTEGER
+ * DESCRIPTION:
+ * \e$BA48uJd$rI=<($7$F$$$kJ8@aHV9f$rF@$k!#\e(B
+ *
+ * (wnn-server-zenkouho-suu)
+ * RETURNS: INTEGER
+ * DESCRIPTION:
+ * \e$BA48uJd$rI=<($7$F$$$kJ8@a$NA48uJd?t$rF@$k!#\e(B
+ *
+ * (wnn-server-dai-top bun-no)
+ * bun-no: INTEGER
+ * RETURNS: BOOLEAN
+ * DESCRIPTION:
+ * \e$BJ8@a$,BgJ8@a$N@hF,$J$i\e(B t
+ *
+ * (wnn-server-dai-end bun-no)
+ * bun-no: INTEGER
+ * RETURNS: INTEGER
+ * DESCRIPTION:
+ * \e$B<!$NBgJ8@a$NJ8@aHV9f$rF@$k!#\e(B
+ *
+ * (wnn-server-henkan-kakutei kouho-no dai)
+ * kouho-no: INTEGER
+ * dai: BOOLEAN
+ * RETURNS: BOOLEAN
+ * DESCRIPTION:
+ * \e$B8uJdHV9f$G<($5$l$?8uJd$rA*Br$9$k!#\e(B
+ * (wnn-server-zenkouho) \e$B$r8F$s$F$+$i$G$J$$$H$$$1$J$$!#\e(B
+ *
+ * (wnn-server-bunsetu-henkou bunsetu-no bunsetu-length dai)
+ * bunsetu-no: INTEGER
+ * bunsetu-length: INTEGER
+ * dai: BOOLEAN
+ * RETURNS:
+ * DESCRIPTION:
+ * \e$BJ8@a$ND9$5$rJQ99$9$k!#\e(B
+ *
+ * (wnn-bunsetu-kouho-inspect bunsetu-no)
+ * bunsetu-no: INTEGER
+ * RETURNS: (kanji yomi jisho-no serial-no hinsi hindo
+ * ima hyoka daihyoka kangovect)
+ * DESCRIPTION:
+ * \e$BJ8@a$N?'!9$J>pJs$rJQ49%P%C%U%!$+$i$H$j=P$9!#\e(B
+ *
+ * (wnn-server-henkan-quit)
+ * RETURNS: BOOLEAN
+ * DESCRIPTION:
+ * \e$B2?$b$7$J$$!#\e(B
+ *
+ * (wnn-server-bunsetu-kanji bun-no)
+ * RETURNS: (bunsetu-kanji length)
+ * DESCRIPTION:
+ *
+ * (wnn-server-bunsetu-yomi bun-no)
+ * RETURNS: (bunsetu-yomi length)
+ * DESCRIPTION:
+ *
+ * (wnn-server-bunsetu-suu)
+ * RETURNS: bunsetu-suu
+ * DESCRIPTION:
+ *
+ * (wnn-server-hindo-update &optional bunsetu-no)
+ * bunsetu-no: INTEGER
+ * RETURNS: BOOLEAN
+ * DESCRIPTION:
+ * \e$BIQEY>pJs$r99?7$9$k!#\e(B
+ *
+ * (wnn-server-word-add dic-no tango yomi comment hinsi)
+ * dic-no: INTEGER
+ * tango: STRING
+ * yoni: STRING
+ * comment: STRING
+ * hinsi: INTEGER
+ * RETURNS: BOOLEAN
+ * DESCRIPTION:
+ * \e$B<-=q$KC18l$rEPO?$9$k!#\e(B
+ *
+ * (wnn-server-word-delete dic-no entry)
+ * dic-no: INTEGER
+ * entry: INTEGER
+ * RETURNS: BOOLEAN
+ * DESCRIPTION:
+ * \e$B<-=q$+$i%(%s%H%jHV9f$G<($5$l$kC18l$r:o=|$9$k!#\e(B
+ *
+ * (wnn-server-word-use dic-no entry)
+ * dic-no: INTEGER
+ * entry: INTEGER
+ * RETURNS: BOOLEAN
+ * DESCRIPTION:
+ * \e$B<-=q$+$i%(%s%H%jHV9f$G<($5$l$kC18l$NM-8z!?L58z$r%H%0%k$9$k!#\e(B
+ *
+ * (wnn-server-word-info dic-no entry)
+ * dic-no: INTEGER
+ * entry: INTEGER
+ * RETURNS: (yomi kanji comment hindo hinsi)
+ * DESCRIPTION:
+ * \e$B<-=q$+$i%(%s%H%jHV9f$G<($5$l$kC18l$N>pJs$rF@$k!#\e(B
+ *
+ * (wnn-server-word-hindo-set dic-no entry hindo)
+ * dic-no: INTEGER
+ * entry: INTEGER
+ * hindo: INTEGER
+ * RETURNS: BOOLEAN
+ * DESCRIPTION:
+ * \e$B<-=q$+$i%(%s%H%jHV9f$G<($5$l$kC18l$NIQEY$r@_Dj$9$k!#\e(B
+ *
+ * (wnn-server-word-search yomi)
+ * yomi: STRING
+ * RETURNS: a LIST of dict-joho
+ * DESCRIPTION:
+ * \e$BA4$F$N<-=q$+$iC18l8!:w$r9T$J$&!#\e(B
+ *
+ * (wnn-server-dict-save)
+ * RETURNS: BOOLEAN
+ * DESCRIPTION:
+ * \e$BA4$F$N<-=q$HIQEY%U%!%$%k$r%;!<%V$9$k!#\e(B
+ *
+ * (wnn-server-get-param)
+ * RETURNS: (n nsho p1 p2 p3 ... p15)
+ * DESCRIPTION: \e$BJQ49%Q%i%a!<%?$rF@$k!#\e(B
+ *
+ * (wnn-server-set-param n sho p1 ... p15)
+ * RETURNS: \e$B%(%i!<$N;~\e(B nil
+ * DESCRIPTION: \e$BJQ49%Q%i%a!<%?$r@_Dj$9$k!#\e(B
+ *
+ * (wnn-server-get-msg error-no)
+ * RETURNS: \e$B%(%i!<%a225;!<%8\e(B
+ * DESCRIPTION: \e$B%(%i!<HV9f$+$i%a%C%;!<%8$rF@$k!#\e(B
+ *
+ * (wnn-server-fuzokugo-set fname)
+ * RETURNS: \e$B%(%i!<$N;~\e(B nil
+ * DESCRIPTION: \e$B%P%C%U%!$KImB08l%U%!%$%k$rFI$_9~$`!#\e(B
+ *
+ * (wnn-server-fuzokugo-get)
+ * RETURNS: \e$B%U%!%$%kL>\e(B
+ * DESCRIPTION: \e$B%P%C%U%!$NImB08l%U%!%$%kL>$rF@$k!#\e(B
+ *
+ * (wnn-server-isconnect)
+ * RETURNS: \e$B%3%M%/%H$7$F$l$P\e(B t, \e$B$7$F$J$1$l$P\e(B nil
+ * DESCRIPTION: \e$B%5!<%P$H7Q$C$F$$$k$+D4$Y$k!#\e(B
+ *
+ * (wnn-server-hinsi-dicts hinsi-no)
+ * RETURNS: (dic-no1 dic-no2 ...)
+ * DESCRIPTION: hinsi-no \e$B$NIJ;l$,EPO?$G$-$k<-=q$N%j%9%H$rF@$k!#\e(B
+ * hinsi-no = -1 \e$B$N$H$-$K$O!"EPO?2DG=$JA4<-=q$rF@$k!#\e(B
+ *
+ * (wnn-server-hinsi-list dic-no name)
+ * RETURNS: (name1 name2 ... )
+ * DESCRIPTION: dic-no \e$B$N<-=q$G!"IJ;l%N!<%I$KB0$9$k\e(B
+ * \e$BIJ;l%N!<%I!JL>!K$N%j%9%H$rF@$k!#\e(B
+ * \e$BIJ;lL>$rM?$($?;~$O!"#0$rJV$9!#\e(B
+ *
+ * (wnn-server-hinsi-name hinsi-no)
+ * RETURNS: hinsi-name
+ * DESCRIPTION: \e$BIJ;lHV9f$+$iL>A0$r<h$k!#\e(B
+ *
+ * (wnn-server-hinsi-number hinsi-name)
+ * RETURNS: hinsi-no
+ * DESCRIPTION: \e$BIJ;lL>$rIJ;lHV9f$KJQ49$9$k!#\e(B
+ *
+ * (wnn-server-version)
+ * RETURNS: version ID(int)
+ *
+ */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "window.h"
+#include "sysdep.h"
+
+#include "wnn/commonhd.h"
+#include "mule-charset.h"
+#include "wnn/jllib.h"
+#include "wnn/cplib.h"
+
+/* UCHAR \e$B$,Fs=EDj5A$5$l$k$N$G\e(B */
+#define _UCHAR_T
+
+#define EGG_TIMEOUT 5
+#define NSERVER 4
+#define WNNSERVER_J 0
+#define WNNSERVER_C 1
+#define WNNSERVER_T 2
+#define WNNSERVER_K 3
+
+int check_wnn_server_type (void);
+void w2m (w_char *wp, unsigned char *mp, unsigned char lb);
+void m2w (unsigned char *mp, w_char *wp);
+void w2y (w_char *w);
+void c2m (unsigned char *cp, unsigned char *mp, unsigned char lb);
+static void puts2 (char *s);
+static int dai_end (int no, int server);
+static int yes_or_no (unsigned char *s);
+
+ /* Why doesn't wnn have a prototype for these? */
+typedef unsigned int letter;
+int cwnn_yincod_pzy(w_char *, w_char, int);
+int cwnn_pzy_yincod(letter *, letter *, int);
+
+static struct wnn_buf *wnnfns_buf[NSERVER];
+static struct wnn_env *wnnfns_env_norm[NSERVER];
+static struct wnn_env *wnnfns_env_rev[NSERVER];
+static int wnnfns_norm;
+static unsigned char lb_wnn_server_type[NSERVER] =
+{LEADING_BYTE_JAPANESE_JISX0208, LEADING_BYTE_CHINESE_GB2312, LEADING_BYTE_THAI_TIS620, LEADING_BYTE_KOREAN_KSC5601};
+
+/* Lisp Variables and Constants Definition */
+Lisp_Object Qjserver;
+Lisp_Object Qcserver;
+/*Lisp_Object Qtserver;*/
+Lisp_Object Qkserver;
+Lisp_Object Qwnn_no_uniq;
+Lisp_Object Qwnn_uniq;
+Lisp_Object Qwnn_uniq_kanji;
+Lisp_Object Qwnn_n, Qwnn_nsho, Qwnn_hindo, Qwnn_len, Qwnn_jiri, Qwnn_flag;
+Lisp_Object Qwnn_jisho, Qwnn_sbn, Qwnn_dbn_len, Qwnn_sbn_cnt, Qwnn_suuji;
+Lisp_Object Qwnn_kana, Qwnn_eisuu, Qwnn_kigou, Qwnn_toji_kakko, Qwnn_fuzokogo, Qwnn_kaikakko;
+Lisp_Object Vwnn_server_type;
+Lisp_Object Vcwnn_zhuyin;
+Lisp_Object Vwnnenv_sticky;
+Lisp_Object Vwnn_uniq_level;
+int lb_sisheng;
+
+/* Lisp functions definition */
+
+DEFUN ("wnn-server-open", Fwnn_open, 2, 2, 0, /*
+Connect to jserver of host HNAME, make an environment with
+login name LNAME in the server.
+Return nil if error occurs
+*/
+ (hname, lname))
+{
+ char *envname;
+ char *langname;
+ char *hostname;
+ int snum;
+ int size;
+ CHECK_STRING (lname);
+
+ snum = check_wnn_server_type ();
+ switch (snum)
+ {
+ case WNNSERVER_J:
+ langname = "ja_JP";
+ break;
+ case WNNSERVER_C:
+ langname = "zh_CN";
+ break;
+/*
+ case WNNSERVER_T:
+ strcpy (langname, "zh_TW");
+ break;
+ */
+ case WNNSERVER_K:
+ langname = "ko_KR";
+ break;
+ case -1:
+ default:
+ return Qnil;
+ }
+ size = XSTRING_LENGTH (lname) > 1024 ? 1026 : XSTRING_LENGTH (lname) + 2;
+ envname = alloca (size);
+ strncpy (envname, (char *) XSTRING_DATA (lname), size-2);
+ envname[size-2] = '\0';
+ if (NILP (hname)) hostname = "";
+ else
+ {
+ CHECK_STRING (hname);
+ size = XSTRING_LENGTH(hname) > 1024 ? 1025 : XSTRING_LENGTH(hname) + 1;
+
+ hostname = alloca (size);
+ strncpy (hostname, (char *) XSTRING_DATA (hname), size-1);
+ hostname[size-1] = '\0';
+ }
+ CHECK_STRING (lname);
+ /* 97/4/16 jhod@po.iijnet.or.jp
+ * libwnn uses SIGALRM, so we need to stop and start interrupts.
+ */
+ stop_interrupts();
+ if (!(wnnfns_buf[snum] = jl_open_lang (envname, hostname, langname,
+ 0, 0, 0, EGG_TIMEOUT)))
+ {
+ start_interrupts();
+ return Qnil;
+ }
+ if (!jl_isconnect (wnnfns_buf[snum]))
+ {
+ start_interrupts();
+ return Qnil;
+ }
+ wnnfns_env_norm[snum] = jl_env_get (wnnfns_buf[snum]);
+/* if (Vwnnenv_sticky == Qt) jl_env_sticky_e (wnnfns_env_norm[snum]);
+ else jl_env_un_sticky_e (wnnfns_env_norm[snum]);*/
+ strcat (envname, "R");
+ if (!(wnnfns_env_rev[snum] = jl_connect_lang (envname, hostname, langname,
+ 0, 0, 0, EGG_TIMEOUT)))
+ {
+ start_interrupts();
+ return Qnil;
+ }
+/* if (Vwnnenv_sticky == Qt) jl_env_sticky_e (wnnfns_env_rev[snum]);
+ else jl_env_un_sticky_e (wnnfns_env_rev[snum]);*/
+ start_interrupts();
+ return Qt;
+}
+
+
+DEFUN ("wnn-server-close", Fwnn_close, 0, 0, 0, /*
+Close the connection to jserver, Dictionary and friquency files
+are not saved.
+*/
+ ())
+{
+ int snum;
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ if (wnnfns_env_norm[snum])
+ {
+ if (EQ(Vwnnenv_sticky, Qnil)) jl_env_un_sticky_e (wnnfns_env_norm[snum]);
+ else jl_env_sticky_e (wnnfns_env_norm[snum]);
+ jl_disconnect (wnnfns_env_norm[snum]);
+ }
+ if (wnnfns_env_rev[snum])
+ {
+ if (EQ(Vwnnenv_sticky, Qnil)) jl_env_un_sticky_e (wnnfns_env_rev[snum]);
+ else jl_env_sticky_e (wnnfns_env_rev[snum]);
+ jl_disconnect (wnnfns_env_rev[snum]);
+ }
+ jl_env_set (wnnfns_buf[snum], 0);
+ jl_close (wnnfns_buf[snum]);
+ wnnfns_buf[snum] = (struct wnn_buf *) 0;
+ wnnfns_env_norm[snum] = wnnfns_env_rev[snum] = (struct wnn_env *) 0;
+ return Qt;
+}
+
+DEFUN ("wnn-server-dict-add", Fwnn_dict_add, 5, MANY, 0, /*
+Add dictionary specified by DICT-FILE-NAME, FREQ-FILE-NAME,
+PRIORITY, DICT-FILE-MODE, FREQ-FILE-MODE.
+Specify password files of dictionary and frequency, PW1 and PW2, if needed.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ struct gcpro gcpro1;
+ int snum;
+ CHECK_STRING (args[0]);
+ CHECK_STRING (args[1]);
+ CHECK_INT (args[2]);
+ if (!EQ(args[5], Qnil)) CHECK_STRING (args[5]);
+ if (!EQ(args[6], Qnil)) CHECK_STRING (args[6]);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ GCPRO1 (*args);
+ gcpro1.nvars = nargs;
+ if (jl_dic_add (wnnfns_buf[snum],
+ XSTRING (args[0])->_data,
+ XSTRING (args[1])->_data,
+ wnnfns_norm ? WNN_DIC_ADD_NOR : WNN_DIC_ADD_REV,
+ XINT (args[2]),
+ (EQ(args[3], Qnil)) ? WNN_DIC_RDONLY : WNN_DIC_RW,
+ (EQ(args[4], Qnil)) ? WNN_DIC_RDONLY : WNN_DIC_RW,
+ (EQ(args[5], Qnil)) ? 0 : XSTRING (args[5])->_data,
+ (EQ(args[6], Qnil)) ? 0 : XSTRING (args[6])->_data,
+ yes_or_no,
+ puts2 ) < 0)
+ {
+ UNGCPRO;
+ return Qnil;
+ }
+ UNGCPRO;
+ return Qt;
+}
+
+DEFUN ("wnn-server-dict-delete", Fwnn_dict_delete, 1, 1, 0, /*
+Remove dictionary specified by DIC-NUMBER from buffer.
+*/
+ (dicno))
+{
+ int no;
+ int snum;
+ CHECK_INT (dicno);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ no = XINT (dicno);
+ if (!wnnfns_buf[snum]) return Qnil;
+ if (jl_dic_delete (wnnfns_buf[snum], no) < 0) return Qnil;
+ return Qt;
+}
+
+DEFUN ("wnn-server-dict-list", Fwnn_dict_list, 0, 0, 0, /*
+Return information of dictionaries.
+*/
+ ())
+{
+ WNN_DIC_INFO *dicinfo;
+ int cnt, i;
+ unsigned char comment[1024];
+ Lisp_Object val;
+ int snum;
+ unsigned char lb;
+
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ lb = lb_wnn_server_type[snum];
+ if (!wnnfns_buf[snum]) return Qnil;
+#ifdef WNN6
+ if((cnt = jl_fi_dic_list (wnnfns_buf[snum], 0x3f, &dicinfo)) < 0)
+ return Qnil;
+#else
+ if((cnt = jl_dic_list (wnnfns_buf[snum], &dicinfo)) < 0) return Qnil;
+#endif
+ val = Qnil;
+ for (i = 0, dicinfo += cnt; i < cnt; i++)
+ {
+ dicinfo--;
+ w2m (dicinfo->comment, comment, lb);
+ /* #### The following has not been Mule-ized!!
+ fname and comment must be ASCII strings! */
+ val =
+ Fcons (Fcons (make_int (dicinfo->dic_no),
+ list4 (make_string ((Bufbyte *) (dicinfo->fname),
+ strlen (dicinfo->fname)),
+ make_string (comment, strlen ((char *) comment)),
+ make_int (dicinfo->gosuu),
+ make_int (dicinfo->nice))), val);
+ }
+ return val;
+}
+
+DEFUN ("wnn-server-dict-comment", Fwnn_dict_comment, 2, 2, 0, /*
+Set comment to dictionary specified by DIC-NUMBER.
+Comment string COMMENT
+*/
+ (dicno, comment))
+{
+ w_char wbuf[512];
+ int snum;
+ CHECK_INT (dicno);
+ CHECK_STRING (comment);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ m2w (XSTRING (comment)->_data, wbuf);
+ if (jl_dic_comment_set (wnnfns_buf[snum], XINT (dicno), wbuf) < 0)
+ return Qnil;
+ return Qt;
+}
+
+
+DEFUN ("wnn-server-set-rev", Fwnn_set_rev, 1, 1, 0, /*
+Switch the translation mode to normal if T, or reverse if NIL.
+*/
+ (rev))
+{
+ int snum;
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (EQ(rev, Qnil))
+ {
+ if ((!wnnfns_buf[snum]) || (!wnnfns_env_norm[snum])) return Qnil;
+ jl_env_set (wnnfns_buf[snum], wnnfns_env_norm[snum]);
+ wnnfns_norm = 1;
+ }
+ else
+ {
+ if ((!wnnfns_buf[snum]) || (!wnnfns_env_rev[snum])) return Qnil;
+ jl_env_set (wnnfns_buf[snum], wnnfns_env_rev[snum]);
+ wnnfns_norm = 0;
+ }
+ return Qt;
+}
+
+DEFUN ("wnn-server-henkan-begin", Fwnn_begin_henkan, 1, 1, 0, /*
+Translate YOMI string to kanji. Retuen the number of bunsetsu.
+*/
+ (hstring))
+{
+ int cnt;
+ w_char wbuf[5000];
+ int snum;
+ CHECK_STRING (hstring);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ m2w (XSTRING (hstring)->_data, wbuf);
+ if (snum == WNNSERVER_C)
+ w2y (wbuf);
+
+#ifdef WNN6
+ if ((cnt = jl_fi_ren_conv (wnnfns_buf[snum], wbuf, 0, -1, WNN_USE_MAE)) < 0)
+ return Qnil;
+#else
+ if ((cnt = jl_ren_conv (wnnfns_buf[snum], wbuf, 0, -1, WNN_USE_MAE)) < 0)
+ return Qnil;
+#endif
+ return make_int (cnt);
+}
+
+DEFUN ("wnn-server-zenkouho", Fwnn_zenkouho, 2, 2, 0, /*
+Get zenkouho at BUNSETSU-NUMBER. Second argument DAI is t.
+if dai-bunsetsu, NIL if sho-bunsetsu. Return the current offset of zenkouho.
+*/
+ (bunNo, dai))
+{
+ int no, offset;
+ int snum;
+ int uniq_level;
+ CHECK_INT (bunNo);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ no = XINT (bunNo);
+ if (EQ(Vwnn_uniq_level, Qwnn_no_uniq)) uniq_level = WNN_NO_UNIQ;
+ else if (EQ(Vwnn_uniq_level, Qwnn_uniq)) uniq_level = WNN_UNIQ;
+ else uniq_level = WNN_UNIQ_KNJ;
+ if (NILP (dai))
+ {
+ if ((offset = jl_zenkouho (wnnfns_buf[snum],no,WNN_USE_MAE,
+ uniq_level)) < 0)
+ return Qnil;
+ }
+ else
+ {
+ if ((offset = jl_zenkouho_dai (wnnfns_buf[snum], no, dai_end (no, snum),
+ WNN_USE_MAE, uniq_level)) < 0)
+ return Qnil;
+ }
+ return make_int (offset);
+}
+
+
+DEFUN ("wnn-server-get-zenkouho", Fwnn_get_zenkouho, 1, 1, 0, /*
+Get kanji string of KOUHO-NUMBER.
+*/
+ (kouhoNo))
+{
+ unsigned char kanji_buf[256];
+ w_char wbuf[256];
+ int snum;
+ unsigned char lb;
+ CHECK_INT (kouhoNo);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ lb = lb_wnn_server_type[snum];
+ if (!wnnfns_buf[snum]) return Qnil;
+ jl_get_zenkouho_kanji (wnnfns_buf[snum], XINT (kouhoNo), wbuf);
+ w2m (wbuf, kanji_buf, lb);
+ return make_string (kanji_buf, strlen ((char *) kanji_buf));
+}
+
+DEFUN ("wnn-server-zenkouho-bun", Fwnn_zenkouho_bun, 0, 0, 0, /*
+For Wnn.
+*/
+ ())
+{
+ int snum;
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ return make_int (jl_zenkouho_bun (wnnfns_buf[snum]));
+}
+
+DEFUN ("wnn-server-zenkouho-suu", Fwnn_zenkouho_suu, 0, 0, 0, /*
+Return the number of zen kouho.
+*/
+ ())
+{
+ int snum;
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ return make_int (jl_zenkouho_suu (wnnfns_buf[snum]));
+}
+
+DEFUN ("wnn-server-dai-top", Fwnn_dai_top, 1, 1, 0, /*
+Return t if bunsetsu BUN-NUMBER is dai-bunsetsu.
+*/
+ (bunNo))
+{
+ int snum;
+ CHECK_INT (bunNo);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ if (jl_dai_top (wnnfns_buf[snum], XINT (bunNo)) == 1) return Qt;
+ else return Qnil;
+}
+
+DEFUN ("wnn-server-dai-end", Fwnn_dai_end, 1, 1, 0, /*
+Return the bunsetu number of the next dai-bunsetsu after BUN-NUMBER.
+*/
+ (bunNo))
+{
+ int snum;
+ CHECK_INT (bunNo);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ return make_int (dai_end (XINT (bunNo), snum));
+}
+
+DEFUN ("wnn-server-henkan-kakutei", Fwnn_kakutei, 2, 2, 0, /*
+Set candidate with OFFSET, DAI. DAI is T if dai-bunsetsu.
+*/
+ (offset, dai))
+{
+ int snum;
+ CHECK_INT (offset);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ if (EQ(dai, Qnil))
+ {
+ if (jl_set_jikouho (wnnfns_buf[snum], XINT (offset)) < 0) return Qnil;
+ }
+ else
+ {
+ if (jl_set_jikouho_dai (wnnfns_buf[snum], XINT (offset)) < 0)
+ return Qnil;
+ }
+ return Qt;
+}
+
+DEFUN ("wnn-server-bunsetu-henkou", Fwnn_bunsetu_henkou, 3, 3, 0, /*
+Change length of BUN-NUMBER bunsetu to LEN. DAI is T if dai-bunsetsu.
+*/
+ (bunNo, len, dai))
+{
+ int cnt, no;
+ int snum;
+ CHECK_INT (bunNo);
+ CHECK_INT (len);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ no = XINT (bunNo);
+#ifdef WNN6
+ if ((cnt = jl_fi_nobi_conv (wnnfns_buf[snum], no, XINT(len), -1, WNN_USE_MAE,
+ (EQ(dai, Qnil)) ? WNN_SHO : WNN_DAI)) < 0)
+ return Qnil;
+#else
+ if ((cnt = jl_nobi_conv (wnnfns_buf[snum], no, XINT(len), -1, WNN_USE_MAE,
+ (EQ(dai, Qnil)) ? WNN_SHO : WNN_DAI)) < 0)
+ return Qnil;
+#endif
+ return make_int (cnt);
+}
+
+DEFUN ("wnn-server-inspect", Fwnn_inspect, 1, 1, 0, /*
+Get bunsetsu information specified by BUN-NUMBER.
+*/
+ (bunNo))
+{
+ Lisp_Object val;
+ unsigned char cbuf[512];
+ w_char wbuf[256];
+ int bun_no, yomilen, jirilen, i;
+ int snum;
+ unsigned char lb;
+ CHECK_INT (bunNo);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ lb = lb_wnn_server_type[snum];
+ if (!wnnfns_buf[snum]) return Qnil;
+ bun_no = XINT (bunNo);
+ val = Qnil;
+ val = Fcons (make_int (wnnfns_buf[snum]->bun[bun_no]->kangovect), val);
+ val = Fcons (make_int (wnnfns_buf[snum]->bun[bun_no]->daihyoka), val);
+ val = Fcons (make_int (wnnfns_buf[snum]->bun[bun_no]->hyoka), val);
+ val = Fcons (make_int (wnnfns_buf[snum]->bun[bun_no]->ima), val);
+ val = Fcons (make_int (wnnfns_buf[snum]->bun[bun_no]->hindo), val);
+ val = Fcons (make_int (wnnfns_buf[snum]->bun[bun_no]->hinsi), val);
+ val = Fcons (make_int (wnnfns_buf[snum]->bun[bun_no]->entry), val);
+ val = Fcons (make_int (wnnfns_buf[snum]->bun[bun_no]->dic_no), val);
+ yomilen = jl_get_yomi (wnnfns_buf[snum], bun_no, bun_no + 1, wbuf);
+ jirilen = wnnfns_buf[snum]->bun[bun_no]->jirilen;
+ for (i = yomilen; i >= jirilen; i--) wbuf[i+1] = wbuf[i];
+ wbuf[jirilen] = '+';
+ w2m (wbuf, cbuf, lb);
+ val = Fcons (make_string (cbuf, strlen ((char *) cbuf)), val);
+ jl_get_kanji (wnnfns_buf[snum], bun_no, bun_no + 1, wbuf);
+ w2m (wbuf, cbuf, lb);
+ val = Fcons (make_string (cbuf, strlen ((char *) cbuf)), val);
+ return val;
+}
+
+
+DEFUN ("wnn-server-henkan-quit", Fwnn_quit_henkan, 0, 0, 0, /*
+do nothing
+*/
+ ())
+{
+ int snum;
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ return Qt;
+}
+
+DEFUN ("wnn-server-bunsetu-kanji", Fwnn_bunsetu_kanji, 1, 1, 0, /*
+Get the pair of kanji and length of bunsetsu specified by BUN-NUMBER.
+*/
+ (bunNo))
+{
+ int no;
+ unsigned char kanji_buf[256];
+ w_char wbuf[256];
+ int kanji_len;
+ int snum;
+ unsigned char lb;
+ CHECK_INT (bunNo);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ lb = lb_wnn_server_type[snum];
+ if (!wnnfns_buf[snum]) return Qnil;
+ no = XINT (bunNo);
+ kanji_len = jl_get_kanji (wnnfns_buf[snum], no, no + 1, wbuf);
+ w2m (wbuf, kanji_buf, lb);
+ return Fcons (make_string (kanji_buf, strlen ((char *) kanji_buf)),
+ make_int (kanji_len));
+}
+
+DEFUN ("wnn-server-bunsetu-yomi", Fwnn_bunsetu_yomi, 1, 1, 0, /*
+Get the pair of yomi and length of bunsetsu specified by BUN-NUMBER.
+*/
+ (bunNo))
+{
+ int no;
+ unsigned char yomi_buf[256];
+ w_char wbuf[256];
+ int yomi_len;
+ int snum;
+ unsigned char lb;
+ CHECK_INT (bunNo);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ lb = lb_wnn_server_type[snum];
+ if (!wnnfns_buf[snum]) return Qnil;
+ no = XINT (bunNo);
+ yomi_len = jl_get_yomi (wnnfns_buf[snum], no, no + 1, wbuf);
+ w2m (wbuf, yomi_buf, lb);
+ return Fcons (make_string (yomi_buf, strlen ((char *) yomi_buf)),
+ make_int (yomi_len));
+}
+
+DEFUN ("wnn-server-bunsetu-suu", Fwnn_bunsetu_suu, 0, 0, 0, /*
+Get the number of bunsetsu.
+*/
+ ())
+{
+ int snum;
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ return make_int (jl_bun_suu (wnnfns_buf[snum]));
+}
+
+DEFUN ("wnn-server-hindo-update", Fwnn_hindo_update, 0, 1, 0, /*
+Update frequency of bunsetsu specified by NUM-NUMBER.
+*/
+ (bunNo))
+{
+ int no;
+ int snum;
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (EQ(bunNo, Qnil)) no = -1;
+ else
+ {
+ CHECK_INT (bunNo);
+ no = XINT (bunNo);
+ }
+ if (!wnnfns_buf[snum]) return Qnil;
+#ifdef WNN6
+ if (jl_optimize_fi (wnnfns_buf[snum], 0, no) < 0) return Qnil;
+#else
+ if (jl_update_hindo (wnnfns_buf[snum], 0, no) < 0) return Qnil;
+#endif
+ return Qt;
+}
+
+
+DEFUN ("wnn-server-word-add", Fwnn_word_toroku, 5, 5, 0, /*
+Add a word to dictionary. Arguments are
+DIC-NUMBER, KANJI, YOMI, COMMENT, HINSI-NUMBER
+*/
+ (dicno, kanji, yomi, comment, hinsi))
+{
+ w_char yomi_buf[256], kanji_buf[256], comment_buf[256];
+ int snum;
+ CHECK_INT (dicno);
+ CHECK_STRING (kanji);
+ CHECK_STRING (yomi);
+ CHECK_STRING (comment);
+ CHECK_INT (hinsi);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ m2w (XSTRING (yomi)->_data, yomi_buf);
+ if (snum == WNNSERVER_C)
+ w2y (yomi_buf);
+ m2w (XSTRING (kanji)->_data, kanji_buf);
+ m2w (XSTRING (comment)->_data, comment_buf);
+ if (jl_word_add (wnnfns_buf[snum], XINT (dicno), yomi_buf, kanji_buf,
+ comment_buf, XINT (hinsi), 0) < 0)
+ return Qnil;
+ else return Qt;
+}
+
+
+DEFUN ("wnn-server-word-delete", Fwnn_word_sakujo, 2, 2, 0, /*
+Delete a word from dictionary, specified by DIC-NUMBER, SERIAL-NUMBER
+*/
+ (no, serial))
+{
+ int snum;
+ CHECK_INT (no);
+ CHECK_INT (serial);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ if (jl_word_delete (wnnfns_buf[snum], XINT (no), XINT (serial)) < 0)
+ return Qnil;
+ else return Qt;
+}
+
+
+DEFUN ("wnn-server-word-use", Fwnn_word_use, 2, 2, 0, /*
+Toggle on/off word, specified by DIC-NUMBER and SERIAL-NUMBER
+*/
+ (no, serial))
+{
+ int snum;
+ CHECK_INT (no);
+ CHECK_INT (serial);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ if (jl_word_use (wnnfns_buf[snum], XINT (no), XINT (serial)) < 0)
+ return Qnil;
+ else return Qt;
+}
+
+DEFUN ("wnn-server-word-info", Fwnn_word_info, 2, 2, 0, /*
+Return list of yomi, kanji, comment, hindo, hinshi.
+*/
+ (no, serial))
+{
+ Lisp_Object val;
+ struct wnn_jdata *info_buf;
+ unsigned char cbuf[512];
+ int snum;
+ unsigned char lb;
+ CHECK_INT (no);
+ CHECK_INT (serial);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ lb = lb_wnn_server_type[snum];
+ if (!wnnfns_buf[snum]) return Qnil;
+ if ((info_buf = jl_word_info (wnnfns_buf[snum],
+ XINT (no), XINT (serial))) != NULL)
+ {
+ return Qnil;
+ }
+ else
+ {
+ val = Qnil;
+ val = Fcons (make_int (info_buf->hinshi), val);
+ val = Fcons (make_int (info_buf->hindo), val);
+ w2m (info_buf->com, cbuf, lb);
+ val = Fcons (make_string (cbuf, strlen ((char *) cbuf)), val);
+ w2m (info_buf->kanji, cbuf, lb);
+ val = Fcons (make_string (cbuf, strlen ((char *) cbuf)), val);
+ w2m (info_buf->yomi, cbuf, lb);
+ val = Fcons (make_string (cbuf, strlen ((char *) cbuf)), val);
+ return val;
+ }
+}
+
+DEFUN ("wnn-server-word-hindo-set", Fwnn_hindo_set, 3, 3, 0, /*
+Set frequency to arbitrary value. Specified by DIC-NUMBER,
+SERIAL-NUMBER, FREQUENCY
+*/
+ (no, serial, hindo))
+{
+ int snum;
+ CHECK_INT (no);
+ CHECK_INT (serial);
+ CHECK_INT (hindo);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ if (js_hindo_set (jl_env_get (wnnfns_buf[snum]),
+ XINT (no),
+ XINT (serial),
+ WNN_HINDO_NOP,
+ XINT (hindo)) < 0)
+ return Qnil;
+ else return Qt;
+}
+
+
+DEFUN ("wnn-server-word-search", Fwnn_dict_search, 1, 1, 0, /*
+Search a word YOMI from buffer.
+Return list of (kanji hinshi freq dic_no serial).
+*/
+ (yomi))
+{
+ Lisp_Object val;
+ struct wnn_jdata *wordinfo;
+ int i, count;
+ w_char wbuf[256];
+ unsigned char kanji_buf[256];
+ int snum;
+ unsigned char lb;
+ CHECK_STRING (yomi);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ lb = lb_wnn_server_type[snum];
+ if (!wnnfns_buf[snum]) return Qnil;
+ m2w (XSTRING (yomi)->_data, wbuf);
+ if (snum == WNNSERVER_C)
+ w2y (wbuf);
+ if ((count = jl_word_search_by_env (wnnfns_buf[snum],
+ wbuf, &wordinfo)) < 0)
+ return Qnil;
+ val = Qnil;
+ for (i = 0, wordinfo += count; i < count; i++)
+ {
+ wordinfo--;
+ w2m (wordinfo->kanji, kanji_buf, lb);
+ val = Fcons (Fcons (make_string (kanji_buf, strlen ((char *) kanji_buf)),
+ list4 (make_int (wordinfo->hinshi),
+ make_int (wordinfo->hindo),
+ make_int (wordinfo->dic_no),
+ make_int (wordinfo->serial))),
+ val);
+ }
+ return val;
+}
+
+DEFUN ("wnn-server-dict-save", Fwnn_dict_save, 0, 0, 0, /*
+Save all dictionaries and frequency files.
+*/
+ ())
+{
+ int snum;
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ if (jl_dic_save_all (wnnfns_buf[snum]) < 0) return Qnil;
+ else return Qt;
+}
+
+DEFUN ("wnn-server-get-param", Fwnn_get_param, 0, 0, 0, /*
+Returns (n nsho hindo len jiri flag jisho sbn dbn_len sbn_cnt
+suuji kana eisuu kigou toji_kakko fuzokogo kaikakko)
+*/
+ ())
+{
+ struct wnn_param param;
+ int snum;
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ if (jl_param_get (wnnfns_buf[snum], ¶m) < 0) return Qnil;
+ return Fcons (make_int (param.n),
+ Fcons (make_int (param.nsho),
+ Fcons (make_int (param.p1),
+ Fcons (make_int (param.p2),
+ Fcons (make_int (param.p3),
+ Fcons (make_int (param.p4),
+ Fcons (make_int (param.p5),
+ Fcons (make_int (param.p6),
+ Fcons (make_int (param.p7),
+ Fcons (make_int (param.p8),
+ Fcons (make_int (param.p9),
+ Fcons (make_int (param.p10),
+ Fcons (make_int (param.p11),
+ Fcons (make_int (param.p12),
+ Fcons (make_int (param.p13),
+ Fcons (make_int (param.p14),
+ Fcons (make_int (param.p15),Qnil)))))))))))))))));
+}
+
+DEFUN ("wnn-server-set-param", Fwnn_set_param, 1, 1, 0, /*
+Set parameters using an alist, where the CAR contains one of
+wnn_n, wnn_nsho, wnn_hindo, wnn_len, wnn_jiri, wnn_flag,
+wnn_jisho, wnn_sbn, wnn_dbn_len, wnn_sbn_cnt, wnn_suuji,
+wnn_kana, wnn_eisuu, wnn_kigou, wnn_toji_kakko, wnn_fuzokogo,
+or wnn_kaikakko and the CDR contains the value.
+*/
+ (Vsetvalues_alist))
+{
+ int rc;
+ struct wnn_param param;
+ Lisp_Object tail, key, val;
+ int snum;
+
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ rc = jl_param_get (wnnfns_buf[snum], ¶m);
+ if (rc < 0) return Qnil;
+
+ EXTERNAL_PROPERTY_LIST_LOOP (tail, key, val, Vsetvalues_alist)
+ {
+ int setval;
+ CHECK_INT (val);
+ setval = XINT (val);
+ if (EQ (key, Qwnn_n)) param.n = setval;
+ else if (EQ (key, Qwnn_nsho)) param.nsho = setval;
+ else if (EQ (key, Qwnn_hindo)) param.p1 = setval;
+ else if (EQ (key, Qwnn_len)) param.p2 = setval;
+ else if (EQ (key, Qwnn_jiri)) param.p3 = setval;
+ else if (EQ (key, Qwnn_flag)) param.p4 = setval;
+ else if (EQ (key, Qwnn_jisho)) param.p5 = setval;
+ else if (EQ (key, Qwnn_sbn)) param.p6 = setval;
+ else if (EQ (key, Qwnn_dbn_len)) param.p7 = setval;
+ else if (EQ (key, Qwnn_sbn_cnt)) param.p8 = setval;
+ else if (EQ (key, Qwnn_suuji)) param.p9 = setval;
+ else if (EQ (key, Qwnn_kana)) param.p10 = setval;
+ else if (EQ (key, Qwnn_eisuu)) param.p11 = setval;
+ else if (EQ (key, Qwnn_kigou)) param.p12 = setval;
+ else if (EQ (key, Qwnn_toji_kakko)) param.p13 = setval;
+ else if (EQ (key, Qwnn_fuzokogo)) param.p14 = setval;
+ else if (EQ (key, Qwnn_kaikakko)) param.p15 = setval;
+ else
+ {
+ signal_simple_error ("Invalid wnn keyword", key);
+ return Qnil;
+ }
+ }
+
+#if 0
+ printf("wnn_n = %d\n",param.n);
+ printf("wnn_nsho = %d\n",param.nsho);
+ printf("wnn_hindo = %d\n",param.p1);
+ printf("wnn_len = %d\n",param.p2);
+ printf("wnn_jiri = %d\n",param.p3);
+ printf("wnn_flag = %d\n",param.p4);
+ printf("wnn_jisho = %d\n",param.p5);
+ printf("wnn_sbn = %d\n",param.p6);
+ printf("wnn_dbn_len = %d\n",param.p7);
+ printf("wnn_sbn_cnt = %d\n",param.p8);
+ printf("wnn_suuji = %d\n",param.p9);
+ printf("wnn_kana = %d\n",param.p10);
+ printf("wnn_eisuu = %d\n",param.p11);
+ printf("wnn_kigou = %d\n",param.p12);
+ printf("wnn_toji_kakko = %d\n",param.p13);
+ printf("wnn_fuzokogo = %d\n",param.p14);
+ printf("wnn_kaikakko = %d\n",param.p15);
+#endif
+
+ rc = jl_param_set (wnnfns_buf[snum], ¶m);
+ if (rc < 0) return Qnil;
+ return Qt;
+}
+
+DEFUN ("wnn-server-get-msg", Fwnn_get_msg, 0, 0, 0, /*
+Get message string from wnn_perror.
+*/
+ ())
+{
+ unsigned char mbuf[256];
+ char *msgp;
+ int snum;
+ unsigned char lb;
+ char langname[32];
+/* CHECK_INT (errno);*/
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ lb = lb_wnn_server_type[snum];
+ switch (snum)
+ {
+ case WNNSERVER_J:
+ strcpy (langname, "ja_JP");
+ break;
+ case WNNSERVER_C:
+ strcpy (langname, "zh_CN");
+ break;
+/*
+ case WNNSERVER_T:
+ strcpy (langname, "zh_TW");
+ break;
+ */
+ case WNNSERVER_K:
+ strcpy (langname, "ko_KR");
+ break;
+ }
+ if (!wnnfns_buf[snum]) return Qnil;
+/* msgp = msg_get (wnn_msg_cat, XINT (errno), 0, 0);*/
+ msgp = wnn_perror_lang (langname);
+ c2m ((unsigned char *) msgp, mbuf, lb);
+ return make_string (mbuf, strlen ((char *) mbuf));
+}
+
+
+DEFUN ("wnn-server-fuzokugo-set", Fwnn_fuzokugo_set, 1, 1, 0, /*
+For Wnn.
+*/
+ (file))
+{
+ int snum;
+ CHECK_STRING (file);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ if (jl_fuzokugo_set (wnnfns_buf[snum], XSTRING (file)->_data) < 0)
+ return Qnil;
+ return Qt;
+}
+
+DEFUN ("wnn-server-fuzokugo-get", Fwnn_fuzokugo_get, 0, 0, 0, /*
+For Wnn.
+*/
+ ())
+{
+ char fname[256];
+ int snum;
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ if (jl_fuzokugo_get (wnnfns_buf[snum], fname) < 0) return Qnil;
+ return make_string ((Bufbyte *) fname, strlen (fname));
+}
+
+
+DEFUN ("wnn-server-isconnect", Fwnn_isconnect, 0, 0, 0, /*
+For Wnn.
+*/
+ ())
+{
+ int snum;
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ if (jl_isconnect (wnnfns_buf[snum])) return Qt;
+ else return Qnil;
+}
+
+DEFUN ("wnn-server-hinsi-dicts", Fwnn_hinsi_dicts, 1, 1, 0, /*
+For Wnn.
+*/
+ (hinsi))
+{
+ int *area;
+ int cnt;
+ Lisp_Object val;
+ int snum;
+ CHECK_INT (hinsi);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ if ((cnt = jl_hinsi_dicts (wnnfns_buf[snum], XINT (hinsi), &area)) < 0)
+ return Qnil;
+ val = Qnil;
+ for (area += cnt; cnt > 0; cnt--)
+ {
+ area--;
+ val = Fcons (make_int (*area), val);
+ }
+ return val;
+}
+
+DEFUN ("wnn-server-hinsi-list", Fwnn_hinsi_list, 2, 2, 0, /*
+For Wnn.
+*/
+ (dicno, name))
+{
+ int cnt;
+ Lisp_Object val;
+ w_char wbuf[256];
+ w_char **area;
+ unsigned char cbuf[512];
+ int snum;
+ unsigned char lb;
+ CHECK_INT (dicno);
+ CHECK_STRING (name);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ lb = lb_wnn_server_type[snum];
+ if (!wnnfns_buf[snum]) return Qnil;
+ m2w (XSTRING (name)->_data, wbuf);
+ if ((cnt = jl_hinsi_list (wnnfns_buf[snum], XINT (dicno), wbuf, &area)) < 0)
+ return Qnil;
+ if (cnt == 0) return make_int (0);
+ val = Qnil;
+ for (area += cnt; cnt > 0; cnt--)
+ {
+ area--;
+ w2m (*area, cbuf, lb);
+ val = Fcons (make_string (cbuf, strlen ((char *) cbuf)), val);
+ }
+ return val;
+}
+
+DEFUN ("wnn-server-hinsi-name", Fwnn_hinsi_name, 1, 1, 0, /*
+For Wnn.
+*/
+ (no))
+{
+ unsigned char name[256];
+ w_char *wname;
+ int snum;
+ unsigned char lb;
+ CHECK_INT (no);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ lb = lb_wnn_server_type[snum];
+ if (!wnnfns_buf[snum]) return Qnil;
+ if ((wname = jl_hinsi_name (wnnfns_buf[snum], XINT (no))) == 0) return Qnil;
+ w2m (wname, name, lb);
+ return make_string (name, strlen ((char *) name));
+}
+#ifdef WNN6
+DEFUN ("wnn-server-fisys-dict-add", Fwnn_fisys_dict_add, 3, MANY, 0, /*
+Add dictionary specified by FISYS-DICT-FILE-NAME, FISYS-FREQ-FILE-NAME,
+FISYS-FREQ-FILE-MODE.
+Specify password files of dictionary and frequency, PW1 and PW2, if needed.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ struct gcpro gcpro1;
+ int snum;
+ CHECK_STRING (args[0]);
+ CHECK_STRING (args[1]);
+ if (!EQ(args[3], Qnil)) CHECK_STRING (args[3]);
+ if ((snum = check_wnn_server_type()) == -1) return Qnil;
+ if(!wnnfns_buf[snum]) return Qnil;
+ GCPRO1 (*args);
+ gcpro1.nvars = nargs;
+ if(jl_fi_dic_add(wnnfns_buf[snum],
+ XSTRING(args[0])->_data,
+ XSTRING(args[1])->_data,
+ WNN_FI_SYSTEM_DICT,
+ WNN_DIC_RDONLY,
+ (EQ(args[2], Qnil)) ? WNN_DIC_RDONLY : WNN_DIC_RW,
+ 0,
+ (EQ(args[3], Qnil)) ? 0 : XSTRING(args[3])->_data,
+ yes_or_no,
+ puts2 ) < 0) {
+ UNGCPRO;
+ return Qnil;
+ }
+ UNGCPRO;
+ return Qt;
+}
+
+DEFUN ("wnn-server-fiusr-dict-add", Fwnn_fiusr_dict_add, 4, MANY, 0, /*
+Add dictionary specified by FIUSR-DICT-FILE-NAME, FIUSR-FREQ-FILE-NAME,
+FIUSR-DICT-FILE-MODE, FIUSR-FREQ-FILE-MODE.
+Specify password files of dictionary and frequency, PW1 and PW2, if needed.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ struct gcpro gcpro1;
+ int snum;
+ CHECK_STRING (args[0]);
+ CHECK_STRING (args[1]);
+ if (!EQ(args[4], Qnil)) CHECK_STRING (args[4]);
+ if (!EQ(args[5], Qnil)) CHECK_STRING (args[5]);
+ if ((snum = check_wnn_server_type()) == -1) return Qnil;
+ if(!wnnfns_buf[snum]) return Qnil;
+ GCPRO1 (*args);
+ gcpro1.nvars = nargs;
+ if(jl_fi_dic_add(wnnfns_buf[snum],
+ XSTRING(args[0])->_data,
+ XSTRING(args[1])->_data,
+ WNN_FI_USER_DICT,
+ (EQ(args[2], Qnil)) ? WNN_DIC_RDONLY : WNN_DIC_RW,
+ (EQ(args[3], Qnil)) ? WNN_DIC_RDONLY : WNN_DIC_RW,
+ (EQ(args[4], Qnil)) ? 0 : XSTRING(args[4])->_data,
+ (EQ(args[5], Qnil)) ? 0 : XSTRING(args[5])->_data,
+ yes_or_no,
+ puts2 ) < 0) {
+ UNGCPRO;
+ return Qnil;
+ }
+ UNGCPRO;
+ return Qt;
+}
+
+DEFUN ("wnn-server-notrans-dict-add", Fwnn_notrans_dict_add, 3, MANY, 0, /*
+Add dictionary specified by NOTRANS-DICT-FILE-NAME, PRIORITY, DICT-FILE-MODE.
+Specify password files of dictionary and frequency PW1 if needed.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ struct gcpro gcpro1;
+ int snum;
+ int dic_no;
+ struct wnn_env *cur_env;
+ unsigned long vmask = 0;
+ struct wnn_henkan_env henv;
+ CHECK_STRING (args[0]);
+ CHECK_INT (args[1]);
+ if (!EQ(args[3], Qnil)) CHECK_STRING (args[3]);
+ if ((snum = check_wnn_server_type()) == -1) return Qnil;
+ if(!wnnfns_buf[snum]) return Qnil;
+ GCPRO1 (*args);
+ gcpro1.nvars = nargs;
+ if(wnnfns_norm)
+ cur_env = wnnfns_env_norm[snum];
+ else
+ cur_env = wnnfns_env_rev[snum];
+ dic_no = js_get_autolearning_dic(cur_env, WNN_MUHENKAN_LEARNING);
+ if (dic_no == WNN_NO_LEARNING) {
+ if((dic_no = jl_dic_add(wnnfns_buf[snum],
+ XSTRING(args[0])->_data,
+ 0,
+ wnnfns_norm ? WNN_DIC_ADD_NOR : WNN_DIC_ADD_REV,
+ XINT(args[1]),
+ WNN_DIC_RW, WNN_DIC_RW,
+ (EQ(args[3], Qnil)) ? 0 : XSTRING(args[3])->_data,
+ 0,
+ yes_or_no,
+ puts2)) < 0) {
+ UNGCPRO;
+ return Qnil;
+ }
+ js_set_autolearning_dic(cur_env, WNN_MUHENKAN_LEARNING, dic_no);
+ }
+ if(!js_is_loaded_temporary_dic(cur_env)) {
+ if(js_temporary_dic_add(cur_env,
+ wnnfns_norm ? WNN_DIC_ADD_NOR : WNN_DIC_ADD_REV) < 0) {
+ UNGCPRO;
+ return Qnil;
+ }
+ }
+ vmask |= WNN_ENV_MUHENKAN_LEARN_MASK;
+ henv.muhenkan_flag = (EQ(args[2], Qnil)) ? WNN_DIC_RDONLY : WNN_DIC_RW;
+ if(jl_set_henkan_env(wnnfns_buf[snum],
+ vmask,
+ &henv) < 0) {
+ UNGCPRO;
+ return Qnil;
+ }
+ UNGCPRO;
+ return Qt;
+}
+
+DEFUN ("wnn-server-bmodify-dict-add", Fwnn_bmodify_dict_add, 3, MANY, 0, /*
+Add dictionary specified by BMODIFY-DICT-FILE-NAME, PRIORITY, DICT-FILE-MODE.
+Specify password files of dictionary and frequency PW1 if needed.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ struct gcpro gcpro1;
+ int snum;
+ int dic_no;
+ struct wnn_env *cur_env;
+ unsigned long vmask = 0;
+ struct wnn_henkan_env henv;
+ CHECK_STRING (args[0]);
+ CHECK_INT (args[1]);
+ if (!EQ(args[3], Qnil)) CHECK_STRING (args[3]);
+ if ((snum = check_wnn_server_type()) == -1) return Qnil;
+ if(!wnnfns_buf[snum]) return Qnil;
+ GCPRO1 (*args);
+ gcpro1.nvars = nargs;
+ if(wnnfns_norm)
+ cur_env = wnnfns_env_norm[snum];
+ else
+ cur_env = wnnfns_env_rev[snum];
+ dic_no = js_get_autolearning_dic(cur_env, WNN_BUNSETSUGIRI_LEARNING);
+ if (dic_no == WNN_NO_LEARNING) {
+ if((dic_no = jl_dic_add(wnnfns_buf[snum],
+ XSTRING(args[0])->_data,
+ 0,
+ wnnfns_norm ? WNN_DIC_ADD_NOR : WNN_DIC_ADD_REV,
+ XINT(args[1]),
+ WNN_DIC_RW, WNN_DIC_RW,
+ (EQ(args[3], Qnil)) ? 0 : XSTRING(args[3])->_data,
+ 0,
+ yes_or_no,
+ puts2)) < 0) {
+ UNGCPRO;
+ return Qnil;
+ }
+ js_set_autolearning_dic(cur_env, WNN_BUNSETSUGIRI_LEARNING, dic_no);
+ }
+ if(!js_is_loaded_temporary_dic(cur_env)) {
+ if(js_temporary_dic_add(cur_env,
+ wnnfns_norm ? WNN_DIC_ADD_NOR : WNN_DIC_ADD_REV) < 0) {
+ UNGCPRO;
+ return Qnil;
+ }
+ }
+ vmask |= WNN_ENV_BUNSETSUGIRI_LEARN_MASK;
+ henv.bunsetsugiri_flag = (EQ(args[2], Qnil)) ? WNN_DIC_RDONLY : WNN_DIC_RW;
+ if(jl_set_henkan_env(wnnfns_buf[snum],
+ vmask,
+ &henv) < 0) {
+ UNGCPRO;
+ return Qnil;
+ }
+ UNGCPRO;
+ return Qt;
+}
+
+DEFUN ("wnn-server-set-last-is-first", Fwnn_last_is_first, 1, 1, 0, /*
+For FI-Wnn.
+*/
+ (mode))
+{
+ int snum;
+ unsigned long vmask = 0;
+ struct wnn_henkan_env henv;
+ if ((snum = check_wnn_server_type()) == -1) return Qnil;
+ if(!wnnfns_buf[snum]) return Qnil;
+ vmask |= WNN_ENV_LAST_IS_FIRST_MASK;
+ henv.last_is_first_flag = (EQ(mode, Qnil)) ? False : True;
+ if(jl_set_henkan_env(wnnfns_buf[snum],
+ vmask,
+ &henv) < 0) return Qnil;
+ return Qt;
+}
+
+DEFUN ("wnn-server-set-complex-conv-mode", Fwnn_complex_conv, 1, 1, 0, /*
+For FI-Wnn.
+*/
+ (mode))
+{
+ int snum;
+ unsigned long vmask = 0;
+ struct wnn_henkan_env henv;
+ if ((snum = check_wnn_server_type()) == -1) return Qnil;
+ if(!wnnfns_buf[snum]) return Qnil;
+ vmask |= WNN_ENV_COMPLEX_CONV_MASK;
+ henv.complex_flag = (EQ(mode, Qnil)) ? False : True;
+ if(jl_set_henkan_env(wnnfns_buf[snum],
+ vmask,
+ &henv) < 0) return Qnil;
+ return Qt;
+}
+
+DEFUN ("wnn-server-set-okuri-learn-mode", Fwnn_okuri_learn, 1, 1, 0, /*
+For FI-Wnn.
+*/
+ (mode))
+{
+ int snum;
+ unsigned long vmask = 0;
+ struct wnn_henkan_env henv;
+ if ((snum = check_wnn_server_type()) == -1) return Qnil;
+ if(!wnnfns_buf[snum]) return Qnil;
+ vmask |= WNN_ENV_OKURI_LEARN_MASK;
+ henv.okuri_learn_flag = (EQ(mode, Qnil)) ? False : True;
+ if(jl_set_henkan_env(wnnfns_buf[snum],
+ vmask,
+ &henv) < 0) return Qnil;
+ return Qt;
+}
+
+DEFUN ("wnn-server-set-okuri-flag", Fwnn_okuri_flag, 1, 1, 0, /*
+For FI-Wnn.
+*/
+ (lmode))
+{
+ int snum, mode;
+ unsigned long vmask = 0;
+ struct wnn_henkan_env henv;
+ CHECK_INT (lmode);
+ mode = XINT (lmode);
+ if ((snum = check_wnn_server_type()) == -1) return Qnil;
+ if(!wnnfns_buf[snum]) return Qnil;
+ if(mode != WNN_OKURI_REGULATION &&
+ mode != WNN_OKURI_NO &&
+ mode != WNN_OKURI_YES)
+ return Qnil;
+ else
+ henv.okuri_flag = mode;
+ vmask |= WNN_ENV_OKURI_MASK;
+ if(jl_set_henkan_env(wnnfns_buf[snum],
+ vmask,
+ &henv) < 0) return Qnil;
+ return Qt;
+}
+
+DEFUN ("wnn-server-set-prefix-learn-mode", Fwnn_prefix_learn, 1, 1, 0, /*
+For FI-Wnn.
+*/
+ (mode))
+{
+ int snum;
+ unsigned long vmask = 0;
+ struct wnn_henkan_env henv;
+ if ((snum = check_wnn_server_type()) == -1) return Qnil;
+ if(!wnnfns_buf[snum]) return Qnil;
+ vmask |= WNN_ENV_PREFIX_LEARN_MASK;
+ henv.prefix_learn_flag = (EQ(mode, Qnil)) ? False : True;
+ if(jl_set_henkan_env(wnnfns_buf[snum],
+ vmask,
+ &henv) < 0) return Qnil;
+ return Qt;
+}
+
+DEFUN ("wnn-server-set-prefix-flag", Fwnn_prefix_flag, 1, 1, 0, /*
+For FI-Wnn.
+*/
+ (lmode))
+{
+ int snum, mode;
+ unsigned long vmask = 0;
+ struct wnn_henkan_env henv;
+ CHECK_INT (lmode);
+ mode = XINT (lmode);
+ if ((snum = check_wnn_server_type()) == -1) return Qnil;
+ if(!wnnfns_buf[snum]) return Qnil;
+ if(mode != WNN_KANA_KOUHO && mode != WNN_KANJI_KOUHO)
+ return Qnil;
+ else
+ henv.prefix_flag = mode;
+ vmask |= WNN_ENV_PREFIX_MASK;
+ if(jl_set_henkan_env(wnnfns_buf[snum],
+ vmask,
+ &henv) < 0) return Qnil;
+ return Qt;
+}
+
+DEFUN ("wnn-server-set-suffix-learn-mode", Fwnn_suffix_learn, 1, 1, 0, /*
+For FI-Wnn.
+*/
+ (mode))
+{
+ int snum;
+ unsigned long vmask = 0;
+ struct wnn_henkan_env henv;
+ if ((snum = check_wnn_server_type()) == -1) return Qnil;
+ if(!wnnfns_buf[snum]) return Qnil;
+ vmask |= WNN_ENV_SUFFIX_LEARN_MASK;
+ henv.suffix_learn_flag = (EQ(mode, Qnil)) ? False : True;
+ if(jl_set_henkan_env(wnnfns_buf[snum],
+ vmask,
+ &henv) < 0) return Qnil;
+ return Qt;
+}
+
+DEFUN ("wnn-server-set-common-learn-mode", Fwnn_common_learn, 1, 1, 0, /*
+For FI-Wnn.
+*/
+ (mode))
+{
+ int snum;
+ unsigned long vmask = 0;
+ struct wnn_henkan_env henv;
+ if ((snum = check_wnn_server_type()) == -1) return Qnil;
+ if(!wnnfns_buf[snum]) return Qnil;
+ vmask |= WNN_ENV_COMMON_LAERN_MASK;
+ henv.common_learn_flag = (EQ(mode, Qnil)) ? False : True;
+ if(jl_set_henkan_env(wnnfns_buf[snum],
+ vmask,
+ &henv) < 0) return Qnil;
+ return Qt;
+}
+
+DEFUN ("wnn-server-set-freq-func-mode", Fwnn_freq_func, 1, 1, 0, /*
+For FI-Wnn.
+*/
+ (lmode))
+{
+ int snum, mode;
+ unsigned long vmask = 0;
+ struct wnn_henkan_env henv;
+ CHECK_INT (lmode);
+ mode = XINT (lmode);
+ if ((snum = check_wnn_server_type()) == -1) return Qnil;
+ if(!wnnfns_buf[snum]) return Qnil;
+ if(mode != 0 && mode != 1 && mode != 2 && mode != 3 && mode != 4)
+ return Qnil;
+ else
+ henv.freq_func_flag = mode;
+ vmask |= WNN_ENV_FREQ_FUNC_MASK;
+ if(jl_set_henkan_env(wnnfns_buf[snum],
+ vmask,
+ &henv) < 0) return Qnil;
+ return Qt;
+}
+
+DEFUN ("wnn-server-set-numeric-mode", Fwnn_numeric, 1, 1, 0, /*
+For FI-Wnn.
+*/
+ (lmode))
+{
+ int snum, mode;
+ unsigned long vmask = 0;
+ struct wnn_henkan_env henv;
+ CHECK_INT (lmode);
+ mode = XINT (lmode);
+ if ((snum = check_wnn_server_type()) == -1) return Qnil;
+ if(!wnnfns_buf[snum]) return Qnil;
+ if(mode != WNN_NUM_KANSUUJI &&
+ mode != WNN_NUM_KANOLD &&
+ mode != WNN_NUM_HANCAN &&
+ mode != WNN_NUM_ZENCAN &&
+ mode != WNN_NUM_HAN &&
+ mode != WNN_NUM_ZEN &&
+ mode != WNN_NUM_KAN)
+ return Qnil;
+ else
+ henv.numeric_flag = mode;
+ vmask |= WNN_ENV_NUMERIC_MASK;
+ if(jl_set_henkan_env(wnnfns_buf[snum],
+ vmask,
+ &henv) < 0) return Qnil;
+ return Qt;
+}
+
+DEFUN ("wnn-server-set-alphabet-mode", Fwnn_alphabet, 1, 1, 0, /*
+For FI-Wnn.
+*/
+ (lmode))
+{
+ int snum, mode;
+ unsigned long vmask = 0;
+ struct wnn_henkan_env henv;
+ CHECK_INT (lmode);
+ mode = XINT (lmode);
+ if ((snum = check_wnn_server_type()) == -1) return Qnil;
+ if(!wnnfns_buf[snum]) return Qnil;
+ if(mode != WNN_ALP_HAN && mode != WNN_ALP_ZEN)
+ return Qnil;
+ else
+ henv.alphabet_flag = mode;
+ vmask |= WNN_ENV_ALPHABET_MASK;
+ if(jl_set_henkan_env(wnnfns_buf[snum],
+ vmask,
+ &henv) < 0) return Qnil;
+ return Qt;
+}
+
+DEFUN ("wnn-server-set-symbol-mode", Fwnn_symbol, 1, 1, 0, /*
+For FI-Wnn.
+*/
+ (lmode))
+{
+ int snum, mode;
+ unsigned long vmask = 0;
+ struct wnn_henkan_env henv;
+ CHECK_INT (lmode);
+ mode = XINT (lmode);
+ if ((snum = check_wnn_server_type()) == -1) return Qnil;
+ if(!wnnfns_buf[snum]) return Qnil;
+ if(mode != WNN_KIG_HAN && mode != WNN_KIG_JIS && mode != WNN_KIG_ASC)
+ return Qnil;
+ else
+ henv.symbol_flag = mode;
+ vmask |= WNN_ENV_SYMBOL_MASK;
+ if(jl_set_henkan_env(wnnfns_buf[snum],
+ vmask,
+ &henv) < 0) return Qnil;
+ return Qt;
+}
+
+DEFUN ("wnn-server-set-yuragi-mode", Fwnn_yuragi, 1, 1, 0, /*
+For FI-Wnn.
+*/
+ (mode))
+{
+ int snum;
+ unsigned long vmask = 0;
+ struct wnn_henkan_env henv;
+ if ((snum = check_wnn_server_type()) == -1) return Qnil;
+ if(!wnnfns_buf[snum]) return Qnil;
+ vmask |= WNN_ENV_YURAGI_MASK;
+ henv.yuragi_flag = (EQ(mode, Qnil)) ? False : True;
+ if(jl_set_henkan_env(wnnfns_buf[snum],
+ vmask,
+ &henv) < 0) return Qnil;
+ return Qt;
+}
+
+DEFUN ("wnn-reset-previous-info", Fwnn_reset_prev, 0, 0, 0, /*
+For FI-Wnn.
+*/
+ ())
+{
+ int snum;
+ if ((snum = check_wnn_server_type()) == -1) return Qnil;
+ if(!wnnfns_buf[snum]) return Qnil;
+ if(jl_reset_prev_bun(wnnfns_buf[snum]) < 0) return Qnil;
+ return Qt;
+}
+#endif /* Wnn6 */
+
+DEFUN ("wnn-server-version", Fwnn_version, 0, 0, 0, /*
+Returns Wnn server version ID.
+*/
+ ())
+{
+ int snum;
+ int serv;
+ int libv;
+ struct wnn_env *cur_env;
+ if ((snum = check_wnn_server_type()) == -1) return Qnil;
+ if(!wnnfns_buf[snum]) return Qnil;
+ if(wnnfns_norm)
+ cur_env = wnnfns_env_norm[snum];
+ else
+ cur_env = wnnfns_env_rev[snum];
+ if(js_version (cur_env->js_id,&serv,&libv) < 0) return Qnil;
+ return make_int (serv);
+}
+
+DEFUN ("wnn-server-hinsi-number", Fwnn_hinsi_number, 1, 1, 0, /*
+For Wnn.
+*/
+ (name))
+{
+ w_char w_buf[256];
+ int no;
+ int snum;
+ CHECK_STRING (name);
+ if ((snum = check_wnn_server_type ()) == -1) return Qnil;
+ if (!wnnfns_buf[snum]) return Qnil;
+ m2w (XSTRING (name)->_data, w_buf);
+ if ((no = jl_hinsi_number (wnnfns_buf[snum], w_buf)) < 0) return Qnil;
+ return make_int (no);
+}
+
+void
+syms_of_mule_wnn (void)
+{
+ DEFSUBR (Fwnn_open);
+ DEFSUBR (Fwnn_close);
+ DEFSUBR (Fwnn_dict_add);
+ DEFSUBR (Fwnn_dict_delete);
+ DEFSUBR (Fwnn_dict_list);
+ DEFSUBR (Fwnn_dict_comment);
+ DEFSUBR (Fwnn_set_rev);
+ DEFSUBR (Fwnn_begin_henkan);
+ DEFSUBR (Fwnn_zenkouho);
+ DEFSUBR (Fwnn_get_zenkouho);
+ DEFSUBR (Fwnn_zenkouho_bun);
+ DEFSUBR (Fwnn_zenkouho_suu);
+ DEFSUBR (Fwnn_dai_top);
+ DEFSUBR (Fwnn_dai_end);
+ DEFSUBR (Fwnn_kakutei);
+ DEFSUBR (Fwnn_bunsetu_henkou);
+ DEFSUBR (Fwnn_inspect);
+ DEFSUBR (Fwnn_quit_henkan);
+ DEFSUBR (Fwnn_bunsetu_kanji);
+ DEFSUBR (Fwnn_bunsetu_yomi);
+ DEFSUBR (Fwnn_bunsetu_suu);
+ DEFSUBR (Fwnn_hindo_update);
+ DEFSUBR (Fwnn_word_toroku);
+ DEFSUBR (Fwnn_word_sakujo);
+ DEFSUBR (Fwnn_word_use);
+ DEFSUBR (Fwnn_word_info);
+ DEFSUBR (Fwnn_hindo_set);
+ DEFSUBR (Fwnn_dict_search);
+ DEFSUBR (Fwnn_dict_save);
+ DEFSUBR (Fwnn_get_param);
+ DEFSUBR (Fwnn_set_param);
+ DEFSUBR (Fwnn_get_msg);
+ DEFSUBR (Fwnn_fuzokugo_set);
+ DEFSUBR (Fwnn_fuzokugo_get);
+ DEFSUBR (Fwnn_isconnect);
+ DEFSUBR (Fwnn_hinsi_dicts);
+ DEFSUBR (Fwnn_hinsi_list);
+ DEFSUBR (Fwnn_hinsi_name);
+ DEFSUBR (Fwnn_hinsi_number);
+#ifdef WNN6
+ DEFSUBR (Fwnn_fisys_dict_add);
+ DEFSUBR (Fwnn_fiusr_dict_add);
+ DEFSUBR (Fwnn_notrans_dict_add);
+ DEFSUBR (Fwnn_bmodify_dict_add);
+ DEFSUBR (Fwnn_last_is_first);
+ DEFSUBR (Fwnn_complex_conv);
+ DEFSUBR (Fwnn_okuri_learn);
+ DEFSUBR (Fwnn_okuri_flag);
+ DEFSUBR (Fwnn_prefix_learn);
+ DEFSUBR (Fwnn_prefix_flag);
+ DEFSUBR (Fwnn_suffix_learn);
+ DEFSUBR (Fwnn_common_learn);
+ DEFSUBR (Fwnn_freq_func);
+ DEFSUBR (Fwnn_numeric);
+ DEFSUBR (Fwnn_alphabet);
+ DEFSUBR (Fwnn_symbol);
+ DEFSUBR (Fwnn_yuragi);
+ DEFSUBR (Fwnn_reset_prev);
+#endif /* Wnn6 */
+ DEFSUBR (Fwnn_version);
+
+ defsymbol (&Qjserver, "jserver");
+ defsymbol (&Qcserver, "cserver");
+ /* defsymbol (&Qtserver, "tserver"); */
+ defsymbol (&Qkserver, "kserver");
+
+ defsymbol (&Qwnn_no_uniq, "wnn-no-uniq");
+ defsymbol (&Qwnn_uniq, "wnn-uniq");
+ defsymbol (&Qwnn_uniq_kanji, "wnn-uniq-kanji");
+ defsymbol (&Qwnn_n, "wnn_n");
+ defsymbol (&Qwnn_nsho, "wnn_nsho");
+ defsymbol (&Qwnn_hindo, "wnn_hindo");
+ defsymbol (&Qwnn_len, "wnn_len");
+ defsymbol (&Qwnn_jiri, "wnn_jiri");
+ defsymbol (&Qwnn_flag, "wnn_flag");
+ defsymbol (&Qwnn_jisho, "wnn_jisho");
+ defsymbol (&Qwnn_sbn, "wnn_sbn");
+ defsymbol (&Qwnn_dbn_len, "wnn_dbn_len");
+ defsymbol (&Qwnn_sbn_cnt, "wnn_sbn_cnt");
+ defsymbol (&Qwnn_suuji, "wnn_suuji");
+ defsymbol (&Qwnn_kana, "wnn_kana");
+ defsymbol (&Qwnn_eisuu, "wnn_eisuu");
+ defsymbol (&Qwnn_kigou, "wnn_kigou");
+ defsymbol (&Qwnn_toji_kakko, "wnn_toji_kakko");
+ defsymbol (&Qwnn_fuzokogo, "wnn_fuzokogo");
+ defsymbol (&Qwnn_kaikakko, "wnn_kaikakko");
+}
+
+void
+vars_of_mule_wnn (void)
+{
+ int i;
+
+ DEFVAR_INT ("lb-sisheng", &lb_sisheng /*
+Leading character for Sisheng.
+*/ );
+ DEFVAR_LISP ("wnn-server-type", &Vwnn_server_type /*
+*jserver, cserver ..
+*/ );
+ DEFVAR_LISP ("cwnn-zhuyin", &Vcwnn_zhuyin /*
+*pinyin or zhuyin
+*/ );
+ DEFVAR_LISP ("wnnenv-sticky", &Vwnnenv_sticky /*
+*If non-nil, make environment sticky
+*/ );
+ DEFVAR_LISP ("wnn-uniq-level", &Vwnn_uniq_level /*
+*Uniq level
+*/ );
+
+ Vwnn_server_type = Qjserver;
+ Vcwnn_zhuyin = Qnil;
+ Vwnnenv_sticky = Qnil;
+
+ 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"));
+}
+
+void
+w2m (w_char *wp, unsigned char *mp, unsigned char lb)
+{
+ w_char wc;
+ w_char pzy[10];
+ int i, len;
+
+ while ((wc = *wp++) != 0)
+ {
+ switch (wc & 0x8080)
+ {
+ case 0x80:
+ if (EQ(Vwnn_server_type, Qcserver))
+ {
+ len = cwnn_yincod_pzy (pzy, wc,
+ (EQ(Vcwnn_zhuyin, Qnil))
+ ? CWNN_PINYIN
+ : CWNN_ZHUYIN);
+ for (i = 0; i < len; i++)
+ {
+ if (pzy[i] & 0x80)
+ {
+ *mp++ = PRE_LEADING_BYTE_PRIVATE_1; /* #### Not sure about this one... */
+ *mp++ = lb_sisheng;
+ }
+ *mp++ = pzy[i];
+ }
+ }
+ else
+ {
+ *mp++ = LEADING_BYTE_KATAKANA_JISX0201;
+ *mp++ = (wc & 0xff);
+ }
+ break;
+ case 0x8080:
+ *mp++ = lb;
+ *mp++ = (wc & 0xff00) >> 8;
+ *mp++ = wc & 0x00ff;
+ break;
+ case 0x8000:
+ if (lb == LEADING_BYTE_JAPANESE_JISX0208)
+ *mp++ = LEADING_BYTE_JAPANESE_JISX0212;
+ else if (lb == LEADING_BYTE_CHINESE_BIG5_1)
+ *mp++ = LEADING_BYTE_CHINESE_BIG5_2;
+ else
+ *mp++ = lb;
+ *mp++ = (wc & 0xff00) >> 8;
+ *mp++ = (wc & 0x00ff) | 0x80;
+ break;
+ default:
+ *mp++ = wc & 0x00ff;
+ break;
+ }
+ }
+ *mp = 0;
+}
+
+void
+m2w (unsigned char *mp, w_char *wp)
+{
+ unsigned int ch;
+
+ while ((ch = *mp++) != 0)
+ {
+ if (BUFBYTE_LEADING_BYTE_P (ch))
+ {
+ switch (ch)
+ {
+ case LEADING_BYTE_KATAKANA_JISX0201:
+ *wp++ = *mp++; break;
+ case LEADING_BYTE_LATIN_JISX0201:
+ *wp++ = *mp++ & 0x7F; break;
+ case LEADING_BYTE_JAPANESE_JISX0208_1978:
+ case LEADING_BYTE_CHINESE_GB2312:
+ case LEADING_BYTE_JAPANESE_JISX0208:
+ case LEADING_BYTE_KOREAN_KSC5601:
+ /* case LEADING_BYTE_TW: */
+ ch = *mp++;
+ *wp++ = (ch << 8) | *mp++;
+ break;
+ case LEADING_BYTE_JAPANESE_JISX0212:
+ ch = *mp++;
+ *wp++ = (ch << 8) | (*mp++ & 0x7f);
+ break;
+ case PRE_LEADING_BYTE_PRIVATE_1: /* #### Not sure about this one... */
+ ch = *mp++;
+ if (ch == lb_sisheng)
+ *wp++ = 0x8e80 | *mp++;
+ else
+ mp++;
+ break;
+ default: /* ignore this character */
+ mp += REP_BYTES_BY_FIRST_BYTE(ch) - 1;
+ }
+ }
+ else
+ {
+ *wp++ = ch;
+ }
+ }
+ *wp = 0;
+}
+
+void
+w2y (w_char *w)
+{
+ letter pbuf[5000], ybuf[5000];
+ unsigned int *pin;
+ w_char *y;
+ int len;
+
+ pin = pbuf;
+ y = w;
+ while (1)
+ {
+ if (*w == 0)
+ {*pin =0; break;}
+ else *pin = *w;
+ w++; pin++;
+ }
+ len = cwnn_pzy_yincod (ybuf, pbuf,
+ (EQ(Vcwnn_zhuyin, Qnil)) ? CWNN_PINYIN : CWNN_ZHUYIN);
+ if (len <= 0)
+ return;
+
+ pin = ybuf;
+ while (1)
+ {
+ if (*pin == 0 || len == 0)
+ {*y = 0;break;}
+ *y = *pin;
+ y++; pin++; len--;
+ }
+}
+
+void
+c2m (unsigned char *cp, unsigned char *mp, unsigned char lb)
+{
+ unsigned char ch;
+ while ((ch = *cp) != 0)
+ {
+ if (ch & 0x80)
+ {
+ *mp++ = lb;
+ *mp++ = *cp++;
+ }
+ *mp++ = *cp++;
+ }
+ *mp = 0;
+}
+
+static int
+dai_end (int no, int server)
+{
+ for (no++; no < jl_bun_suu (wnnfns_buf[server])
+ && !jl_dai_top (wnnfns_buf[server], no); no++);
+ return (no);
+}
+
+static int
+yes_or_no (unsigned char *s)
+{
+ unsigned char mbuf[512];
+ unsigned char lb;
+ int len;
+ int snum;
+ if ((snum = check_wnn_server_type ()) == -1) return 0;
+ lb = lb_wnn_server_type[snum];
+ /* if no message found, create file without query */
+ /* if (wnn_msg_cat->msg_bd == 0) return 1;*/
+ if (*s == 0) return 1;
+ c2m (s, mbuf, lb);
+ /* truncate "(Y/N)" */
+ for (len = 0; (mbuf[len]) && (len < 512); len++);
+ for (; (mbuf[len] != '(') && (len > 0); len--);
+ {
+ Lisp_Object yes, str;
+ struct gcpro gcpro1;
+
+ str = make_string (mbuf, len);
+ GCPRO1 (str);
+ yes = call1(Qyes_or_no_p, str);
+ UNGCPRO;
+ if (NILP (yes)) return 0;
+ else return (1);
+ }
+}
+
+static void
+puts2 (char *s)
+{
+#if 0 /* jhod: We don't really need this echoed... */
+#if 0
+ Lisp_Object args[1];
+ char mbuf[512];
+ unsigned char lb;
+ extern Lisp_Object Fmessage ();
+ int snum;
+ if ((snum = check_wnn_server_type ()) == -1) return;
+ lb = lb_wnn_server_type[snum];
+ c2m (s, mbuf, lb);
+ args[0] = make_string (mbuf, strlen (mbuf));
+ Fmessage (1, args);
+#else
+ message("%s",s);
+#endif
+#endif
+}
+
+int
+check_wnn_server_type (void)
+{
+ if (EQ(Vwnn_server_type, Qjserver))
+ {
+ return WNNSERVER_J;
+ }
+ else if (EQ(Vwnn_server_type, Qcserver))
+ {
+ return WNNSERVER_C;
+ }
+ /* else if (Vwnn_server_type == Qtserver)
+ {
+ return WNNSERVER_T;
+ } */
+ else if (EQ(Vwnn_server_type, Qkserver))
+ {
+ return WNNSERVER_K;
+ }
+ else return -1;
+}
--- /dev/null
+/* Copyright (C) 1995 Free Software Foundation.
+
+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. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "regex.h"
+
+#ifdef MULE_REGEXP
+
+Lisp_Object Vre_word;
+
+int re_short_flag;
+
+\f
+DEFUN ("define-word-pattern", Fdefine_word_pattern, 1, 1, 0, /*
+Don't call this function directly, instead use 'define-word' which
+accept a pattern compiled by 'regexp-compile' with word-option t.
+*/
+ (pattern))
+{
+ int i, len;
+ char *p;
+ Lisp_Object temp;
+ struct Lisp_String *s;
+
+ CHECK_CONS (pattern);
+ len = XINT (Flength (pattern));
+ if (len > MAXWORDBUF)
+ error ("Too complicated regular expression for word!");
+ for (i = 0; i < len; i++)
+ {
+ temp = XCAR (pattern);
+ CHECK_VECTOR (temp);
+ CHECK_STRING (XVECTOR_DATA (temp)[0]);
+ s = XSTRING (XVECTOR_DATA (temp)[0]);
+ if (!wordbuf[i])
+ wordbuf[i] = xnew (struct re_pattern_buffer);
+ else
+ if (wordbuf[i]->buffer) xfree (wordbuf[i]->buffer);
+ wordbuf[i]->buffer = (char *) xmalloc (s->size + 1);
+ wordbuf[i]->used = s->size;
+ memcpy (wordbuf[i]->buffer, s->data, s->size + 1);
+#ifdef EMACS19_REGEXP
+ wordbuf[i]->translate = 0;
+ wordbuf[i]->fastmap_accurate = 0;
+ wordbuf[i]->fastmap = 0;
+ wordbuf[i]->can_be_null = 1;
+
+ wordbuf[i]->mc_flag = 1;
+ wordbuf[i]->short_flag = 0;
+ wordbuf[i]->no_empty = 0;
+
+ wordbuf[i]->syntax_version = 0;
+ wordbuf[i]->category_version = 0;
+
+ wordbuf[i]->regs_allocated = REGS_UNALLOCATED;
+ wordbuf[i]->re_nsub = 0;
+ wordbuf[i]->no_sub = 0;
+ wordbuf[i]->newline_anchor = 1;
+
+ wordbuf[i]->syntax = 0;
+ wordbuf[i]->not_bol = wordbuf[i]->not_eol = 0;
+#endif /* EMACS19_REGEXP */
+ pattern = XCDR (pattern);
+ }
+ for (; i < MAXWORDBUF && wordbuf[i]; i++)
+ {
+ if (wordbuf[i]->buffer) xfree (wordbuf[i]->buffer);
+ xfree (wordbuf[i]);
+ wordbuf[i] = (struct re_pattern_buffer *) 0;
+ }
+ return Qnil;
+}
+
+#endif /* MULE_REGEXP */
+
+\f
+void
+syms_of_mule (void)
+{
+#ifdef MULE_REGEXP
+ DEFSUBR (Fdefine_word_pattern);
+#endif
+}
+
+void
+vars_of_mule (void)
+{
+#ifdef MULE_REGEXP
+ DEFVAR_BOOL ("re-short-flag", &re_short_flag /*
+*T means regexp search success when the shortest match is found.
+*/ );
+ re_short_flag = 0;
+#endif /* MULE_REGEXP */
+
+ Fprovide (intern ("mule"));
+
+#ifdef HAVE_EGG
+ Fprovide (intern ("egg"));
+#endif
+#ifdef HAVE_WNN
+ Fprovide (intern ("wnn"));
+#endif
+}
--- /dev/null
+/* mswindows-specific Lisp objects.
+ Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+ Copyright (C) 1995 Board of Trustees, University of Illinois.
+ Copyright (C) 1995 Tinker Systems.
+ Copyright (C) 1995, 1996 Ben Wing.
+ Copyright (C) 1995 Sun Microsystems, Inc.
+ Copyright (C) 1997 Jonathan Harris.
+
+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. */
+
+/* Authorship:
+
+ Jamie Zawinski, Chuck Thompson, Ben Wing
+ Rewritten for mswindows by Jonathan Harris, November 1997 for 21.0.
+ */
+
+
+/* TODO: palette handling */
+
+#include <config.h>
+#include "lisp.h"
+#include "hash.h"
+
+#include "console-msw.h"
+#include "objects-msw.h"
+
+#ifdef MULE
+#include "mule-charset.h"
+#endif
+
+#include "buffer.h"
+#include "device.h"
+#include "insdel.h"
+
+#ifdef __CYGWIN32__
+#define stricmp strcasecmp
+#endif
+
+typedef struct colormap_t
+{
+ char *name;
+ 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[] =
+{
+ {"snow" , PALETTERGB (255, 250, 250) },
+ {"GhostWhite" , PALETTERGB (248, 248, 255) },
+ {"WhiteSmoke" , PALETTERGB (245, 245, 245) },
+ {"gainsboro" , PALETTERGB (220, 220, 220) },
+ {"FloralWhite" , PALETTERGB (255, 250, 240) },
+ {"OldLace" , PALETTERGB (253, 245, 230) },
+ {"linen" , PALETTERGB (250, 240, 230) },
+ {"AntiqueWhite" , PALETTERGB (250, 235, 215) },
+ {"PapayaWhip" , PALETTERGB (255, 239, 213) },
+ {"BlanchedAlmond" , PALETTERGB (255, 235, 205) },
+ {"bisque" , PALETTERGB (255, 228, 196) },
+ {"PeachPuff" , PALETTERGB (255, 218, 185) },
+ {"NavajoWhite" , PALETTERGB (255, 222, 173) },
+ {"moccasin" , PALETTERGB (255, 228, 181) },
+ {"cornsilk" , PALETTERGB (255, 248, 220) },
+ {"ivory" , PALETTERGB (255, 255, 240) },
+ {"LemonChiffon" , PALETTERGB (255, 250, 205) },
+ {"seashell" , PALETTERGB (255, 245, 238) },
+ {"honeydew" , PALETTERGB (240, 255, 240) },
+ {"MintCream" , PALETTERGB (245, 255, 250) },
+ {"azure" , PALETTERGB (240, 255, 255) },
+ {"AliceBlue" , PALETTERGB (240, 248, 255) },
+ {"lavender" , PALETTERGB (230, 230, 250) },
+ {"LavenderBlush" , PALETTERGB (255, 240, 245) },
+ {"MistyRose" , PALETTERGB (255, 228, 225) },
+ {"white" , PALETTERGB (255, 255, 255) },
+ {"black" , PALETTERGB (0, 0, 0) },
+ {"DarkSlateGray" , PALETTERGB (47, 79, 79) },
+ {"DarkSlateGrey" , PALETTERGB (47, 79, 79) },
+ {"DimGray" , PALETTERGB (105, 105, 105) },
+ {"DimGrey" , PALETTERGB (105, 105, 105) },
+ {"SlateGray" , PALETTERGB (112, 128, 144) },
+ {"SlateGrey" , PALETTERGB (112, 128, 144) },
+ {"LightSlateGray" , PALETTERGB (119, 136, 153) },
+ {"LightSlateGrey" , PALETTERGB (119, 136, 153) },
+ {"gray" , PALETTERGB (190, 190, 190) },
+ {"grey" , PALETTERGB (190, 190, 190) },
+ {"LightGrey" , PALETTERGB (211, 211, 211) },
+ {"LightGray" , PALETTERGB (211, 211, 211) },
+ {"MidnightBlue" , PALETTERGB (25, 25, 112) },
+ {"navy" , PALETTERGB (0, 0, 128) },
+ {"NavyBlue" , PALETTERGB (0, 0, 128) },
+ {"CornflowerBlue" , PALETTERGB (100, 149, 237) },
+ {"DarkSlateBlue" , PALETTERGB (72, 61, 139) },
+ {"SlateBlue" , PALETTERGB (106, 90, 205) },
+ {"MediumSlateBlue" , PALETTERGB (123, 104, 238) },
+ {"LightSlateBlue" , PALETTERGB (132, 112, 255) },
+ {"MediumBlue" , PALETTERGB (0, 0, 205) },
+ {"RoyalBlue" , PALETTERGB (65, 105, 225) },
+ {"blue" , PALETTERGB (0, 0, 255) },
+ {"DodgerBlue" , PALETTERGB (30, 144, 255) },
+ {"DeepSkyBlue" , PALETTERGB (0, 191, 255) },
+ {"SkyBlue" , PALETTERGB (135, 206, 235) },
+ {"LightSkyBlue" , PALETTERGB (135, 206, 250) },
+ {"SteelBlue" , PALETTERGB (70, 130, 180) },
+ {"LightSteelBlue" , PALETTERGB (176, 196, 222) },
+ {"LightBlue" , PALETTERGB (173, 216, 230) },
+ {"PowderBlue" , PALETTERGB (176, 224, 230) },
+ {"PaleTurquoise" , PALETTERGB (175, 238, 238) },
+ {"DarkTurquoise" , PALETTERGB (0, 206, 209) },
+ {"MediumTurquoise" , PALETTERGB (72, 209, 204) },
+ {"turquoise" , PALETTERGB (64, 224, 208) },
+ {"cyan" , PALETTERGB (0, 255, 255) },
+ {"LightCyan" , PALETTERGB (224, 255, 255) },
+ {"CadetBlue" , PALETTERGB (95, 158, 160) },
+ {"MediumAquamarine" , PALETTERGB (102, 205, 170) },
+ {"aquamarine" , PALETTERGB (127, 255, 212) },
+ {"DarkGreen" , PALETTERGB (0, 100, 0) },
+ {"DarkOliveGreen" , PALETTERGB (85, 107, 47) },
+ {"DarkSeaGreen" , PALETTERGB (143, 188, 143) },
+ {"SeaGreen" , PALETTERGB (46, 139, 87) },
+ {"MediumSeaGreen" , PALETTERGB (60, 179, 113) },
+ {"LightSeaGreen" , PALETTERGB (32, 178, 170) },
+ {"PaleGreen" , PALETTERGB (152, 251, 152) },
+ {"SpringGreen" , PALETTERGB (0, 255, 127) },
+ {"LawnGreen" , PALETTERGB (124, 252, 0) },
+ {"green" , PALETTERGB (0, 255, 0) },
+ {"chartreuse" , PALETTERGB (127, 255, 0) },
+ {"MediumSpringGreen" , PALETTERGB (0, 250, 154) },
+ {"GreenYellow" , PALETTERGB (173, 255, 47) },
+ {"LimeGreen" , PALETTERGB (50, 205, 50) },
+ {"YellowGreen" , PALETTERGB (154, 205, 50) },
+ {"ForestGreen" , PALETTERGB (34, 139, 34) },
+ {"OliveDrab" , PALETTERGB (107, 142, 35) },
+ {"DarkKhaki" , PALETTERGB (189, 183, 107) },
+ {"khaki" , PALETTERGB (240, 230, 140) },
+ {"PaleGoldenrod" , PALETTERGB (238, 232, 170) },
+ {"LightGoldenrodYellow" , PALETTERGB (250, 250, 210) },
+ {"LightYellow" , PALETTERGB (255, 255, 224) },
+ {"yellow" , PALETTERGB (255, 255, 0) },
+ {"gold" , PALETTERGB (255, 215, 0) },
+ {"LightGoldenrod" , PALETTERGB (238, 221, 130) },
+ {"goldenrod" , PALETTERGB (218, 165, 32) },
+ {"DarkGoldenrod" , PALETTERGB (184, 134, 11) },
+ {"RosyBrown" , PALETTERGB (188, 143, 143) },
+ {"IndianRed" , PALETTERGB (205, 92, 92) },
+ {"SaddleBrown" , PALETTERGB (139, 69, 19) },
+ {"sienna" , PALETTERGB (160, 82, 45) },
+ {"peru" , PALETTERGB (205, 133, 63) },
+ {"burlywood" , PALETTERGB (222, 184, 135) },
+ {"beige" , PALETTERGB (245, 245, 220) },
+ {"wheat" , PALETTERGB (245, 222, 179) },
+ {"SandyBrown" , PALETTERGB (244, 164, 96) },
+ {"tan" , PALETTERGB (210, 180, 140) },
+ {"chocolate" , PALETTERGB (210, 105, 30) },
+ {"firebrick" , PALETTERGB (178, 34, 34) },
+ {"brown" , PALETTERGB (165, 42, 42) },
+ {"DarkSalmon" , PALETTERGB (233, 150, 122) },
+ {"salmon" , PALETTERGB (250, 128, 114) },
+ {"LightSalmon" , PALETTERGB (255, 160, 122) },
+ {"orange" , PALETTERGB (255, 165, 0) },
+ {"DarkOrange" , PALETTERGB (255, 140, 0) },
+ {"coral" , PALETTERGB (255, 127, 80) },
+ {"LightCoral" , PALETTERGB (240, 128, 128) },
+ {"tomato" , PALETTERGB (255, 99, 71) },
+ {"OrangeRed" , PALETTERGB (255, 69, 0) },
+ {"red" , PALETTERGB (255, 0, 0) },
+ {"HotPink" , PALETTERGB (255, 105, 180) },
+ {"DeepPink" , PALETTERGB (255, 20, 147) },
+ {"pink" , PALETTERGB (255, 192, 203) },
+ {"LightPink" , PALETTERGB (255, 182, 193) },
+ {"PaleVioletRed" , PALETTERGB (219, 112, 147) },
+ {"maroon" , PALETTERGB (176, 48, 96) },
+ {"MediumVioletRed" , PALETTERGB (199, 21, 133) },
+ {"VioletRed" , PALETTERGB (208, 32, 144) },
+ {"magenta" , PALETTERGB (255, 0, 255) },
+ {"violet" , PALETTERGB (238, 130, 238) },
+ {"plum" , PALETTERGB (221, 160, 221) },
+ {"orchid" , PALETTERGB (218, 112, 214) },
+ {"MediumOrchid" , PALETTERGB (186, 85, 211) },
+ {"DarkOrchid" , PALETTERGB (153, 50, 204) },
+ {"DarkViolet" , PALETTERGB (148, 0, 211) },
+ {"BlueViolet" , PALETTERGB (138, 43, 226) },
+ {"purple" , PALETTERGB (160, 32, 240) },
+ {"MediumPurple" , PALETTERGB (147, 112, 219) },
+ {"thistle" , PALETTERGB (216, 191, 216) },
+ {"snow1" , PALETTERGB (255, 250, 250) },
+ {"snow2" , PALETTERGB (238, 233, 233) },
+ {"snow3" , PALETTERGB (205, 201, 201) },
+ {"snow4" , PALETTERGB (139, 137, 137) },
+ {"seashell1" , PALETTERGB (255, 245, 238) },
+ {"seashell2" , PALETTERGB (238, 229, 222) },
+ {"seashell3" , PALETTERGB (205, 197, 191) },
+ {"seashell4" , PALETTERGB (139, 134, 130) },
+ {"AntiqueWhite1" , PALETTERGB (255, 239, 219) },
+ {"AntiqueWhite2" , PALETTERGB (238, 223, 204) },
+ {"AntiqueWhite3" , PALETTERGB (205, 192, 176) },
+ {"AntiqueWhite4" , PALETTERGB (139, 131, 120) },
+ {"bisque1" , PALETTERGB (255, 228, 196) },
+ {"bisque2" , PALETTERGB (238, 213, 183) },
+ {"bisque3" , PALETTERGB (205, 183, 158) },
+ {"bisque4" , PALETTERGB (139, 125, 107) },
+ {"PeachPuff1" , PALETTERGB (255, 218, 185) },
+ {"PeachPuff2" , PALETTERGB (238, 203, 173) },
+ {"PeachPuff3" , PALETTERGB (205, 175, 149) },
+ {"PeachPuff4" , PALETTERGB (139, 119, 101) },
+ {"NavajoWhite1" , PALETTERGB (255, 222, 173) },
+ {"NavajoWhite2" , PALETTERGB (238, 207, 161) },
+ {"NavajoWhite3" , PALETTERGB (205, 179, 139) },
+ {"NavajoWhite4" , PALETTERGB (139, 121, 94) },
+ {"LemonChiffon1" , PALETTERGB (255, 250, 205) },
+ {"LemonChiffon2" , PALETTERGB (238, 233, 191) },
+ {"LemonChiffon3" , PALETTERGB (205, 201, 165) },
+ {"LemonChiffon4" , PALETTERGB (139, 137, 112) },
+ {"cornsilk1" , PALETTERGB (255, 248, 220) },
+ {"cornsilk2" , PALETTERGB (238, 232, 205) },
+ {"cornsilk3" , PALETTERGB (205, 200, 177) },
+ {"cornsilk4" , PALETTERGB (139, 136, 120) },
+ {"ivory1" , PALETTERGB (255, 255, 240) },
+ {"ivory2" , PALETTERGB (238, 238, 224) },
+ {"ivory3" , PALETTERGB (205, 205, 193) },
+ {"ivory4" , PALETTERGB (139, 139, 131) },
+ {"honeydew1" , PALETTERGB (240, 255, 240) },
+ {"honeydew2" , PALETTERGB (224, 238, 224) },
+ {"honeydew3" , PALETTERGB (193, 205, 193) },
+ {"honeydew4" , PALETTERGB (131, 139, 131) },
+ {"LavenderBlush1" , PALETTERGB (255, 240, 245) },
+ {"LavenderBlush2" , PALETTERGB (238, 224, 229) },
+ {"LavenderBlush3" , PALETTERGB (205, 193, 197) },
+ {"LavenderBlush4" , PALETTERGB (139, 131, 134) },
+ {"MistyRose1" , PALETTERGB (255, 228, 225) },
+ {"MistyRose2" , PALETTERGB (238, 213, 210) },
+ {"MistyRose3" , PALETTERGB (205, 183, 181) },
+ {"MistyRose4" , PALETTERGB (139, 125, 123) },
+ {"azure1" , PALETTERGB (240, 255, 255) },
+ {"azure2" , PALETTERGB (224, 238, 238) },
+ {"azure3" , PALETTERGB (193, 205, 205) },
+ {"azure4" , PALETTERGB (131, 139, 139) },
+ {"SlateBlue1" , PALETTERGB (131, 111, 255) },
+ {"SlateBlue2" , PALETTERGB (122, 103, 238) },
+ {"SlateBlue3" , PALETTERGB (105, 89, 205) },
+ {"SlateBlue4" , PALETTERGB (71, 60, 139) },
+ {"RoyalBlue1" , PALETTERGB (72, 118, 255) },
+ {"RoyalBlue2" , PALETTERGB (67, 110, 238) },
+ {"RoyalBlue3" , PALETTERGB (58, 95, 205) },
+ {"RoyalBlue4" , PALETTERGB (39, 64, 139) },
+ {"blue1" , PALETTERGB (0, 0, 255) },
+ {"blue2" , PALETTERGB (0, 0, 238) },
+ {"blue3" , PALETTERGB (0, 0, 205) },
+ {"blue4" , PALETTERGB (0, 0, 139) },
+ {"DodgerBlue1" , PALETTERGB (30, 144, 255) },
+ {"DodgerBlue2" , PALETTERGB (28, 134, 238) },
+ {"DodgerBlue3" , PALETTERGB (24, 116, 205) },
+ {"DodgerBlue4" , PALETTERGB (16, 78, 139) },
+ {"SteelBlue1" , PALETTERGB (99, 184, 255) },
+ {"SteelBlue2" , PALETTERGB (92, 172, 238) },
+ {"SteelBlue3" , PALETTERGB (79, 148, 205) },
+ {"SteelBlue4" , PALETTERGB (54, 100, 139) },
+ {"DeepSkyBlue1" , PALETTERGB (0, 191, 255) },
+ {"DeepSkyBlue2" , PALETTERGB (0, 178, 238) },
+ {"DeepSkyBlue3" , PALETTERGB (0, 154, 205) },
+ {"DeepSkyBlue4" , PALETTERGB (0, 104, 139) },
+ {"SkyBlue1" , PALETTERGB (135, 206, 255) },
+ {"SkyBlue2" , PALETTERGB (126, 192, 238) },
+ {"SkyBlue3" , PALETTERGB (108, 166, 205) },
+ {"SkyBlue4" , PALETTERGB (74, 112, 139) },
+ {"LightSkyBlue1" , PALETTERGB (176, 226, 255) },
+ {"LightSkyBlue2" , PALETTERGB (164, 211, 238) },
+ {"LightSkyBlue3" , PALETTERGB (141, 182, 205) },
+ {"LightSkyBlue4" , PALETTERGB (96, 123, 139) },
+ {"SlateGray1" , PALETTERGB (198, 226, 255) },
+ {"SlateGray2" , PALETTERGB (185, 211, 238) },
+ {"SlateGray3" , PALETTERGB (159, 182, 205) },
+ {"SlateGray4" , PALETTERGB (108, 123, 139) },
+ {"LightSteelBlue1" , PALETTERGB (202, 225, 255) },
+ {"LightSteelBlue2" , PALETTERGB (188, 210, 238) },
+ {"LightSteelBlue3" , PALETTERGB (162, 181, 205) },
+ {"LightSteelBlue4" , PALETTERGB (110, 123, 139) },
+ {"LightBlue1" , PALETTERGB (191, 239, 255) },
+ {"LightBlue2" , PALETTERGB (178, 223, 238) },
+ {"LightBlue3" , PALETTERGB (154, 192, 205) },
+ {"LightBlue4" , PALETTERGB (104, 131, 139) },
+ {"LightCyan1" , PALETTERGB (224, 255, 255) },
+ {"LightCyan2" , PALETTERGB (209, 238, 238) },
+ {"LightCyan3" , PALETTERGB (180, 205, 205) },
+ {"LightCyan4" , PALETTERGB (122, 139, 139) },
+ {"PaleTurquoise1" , PALETTERGB (187, 255, 255) },
+ {"PaleTurquoise2" , PALETTERGB (174, 238, 238) },
+ {"PaleTurquoise3" , PALETTERGB (150, 205, 205) },
+ {"PaleTurquoise4" , PALETTERGB (102, 139, 139) },
+ {"CadetBlue1" , PALETTERGB (152, 245, 255) },
+ {"CadetBlue2" , PALETTERGB (142, 229, 238) },
+ {"CadetBlue3" , PALETTERGB (122, 197, 205) },
+ {"CadetBlue4" , PALETTERGB (83, 134, 139) },
+ {"turquoise1" , PALETTERGB (0, 245, 255) },
+ {"turquoise2" , PALETTERGB (0, 229, 238) },
+ {"turquoise3" , PALETTERGB (0, 197, 205) },
+ {"turquoise4" , PALETTERGB (0, 134, 139) },
+ {"cyan1" , PALETTERGB (0, 255, 255) },
+ {"cyan2" , PALETTERGB (0, 238, 238) },
+ {"cyan3" , PALETTERGB (0, 205, 205) },
+ {"cyan4" , PALETTERGB (0, 139, 139) },
+ {"DarkSlateGray1" , PALETTERGB (151, 255, 255) },
+ {"DarkSlateGray2" , PALETTERGB (141, 238, 238) },
+ {"DarkSlateGray3" , PALETTERGB (121, 205, 205) },
+ {"DarkSlateGray4" , PALETTERGB (82, 139, 139) },
+ {"aquamarine1" , PALETTERGB (127, 255, 212) },
+ {"aquamarine2" , PALETTERGB (118, 238, 198) },
+ {"aquamarine3" , PALETTERGB (102, 205, 170) },
+ {"aquamarine4" , PALETTERGB (69, 139, 116) },
+ {"DarkSeaGreen1" , PALETTERGB (193, 255, 193) },
+ {"DarkSeaGreen2" , PALETTERGB (180, 238, 180) },
+ {"DarkSeaGreen3" , PALETTERGB (155, 205, 155) },
+ {"DarkSeaGreen4" , PALETTERGB (105, 139, 105) },
+ {"SeaGreen1" , PALETTERGB (84, 255, 159) },
+ {"SeaGreen2" , PALETTERGB (78, 238, 148) },
+ {"SeaGreen3" , PALETTERGB (67, 205, 128) },
+ {"SeaGreen4" , PALETTERGB (46, 139, 87) },
+ {"PaleGreen1" , PALETTERGB (154, 255, 154) },
+ {"PaleGreen2" , PALETTERGB (144, 238, 144) },
+ {"PaleGreen3" , PALETTERGB (124, 205, 124) },
+ {"PaleGreen4" , PALETTERGB (84, 139, 84) },
+ {"SpringGreen1" , PALETTERGB (0, 255, 127) },
+ {"SpringGreen2" , PALETTERGB (0, 238, 118) },
+ {"SpringGreen3" , PALETTERGB (0, 205, 102) },
+ {"SpringGreen4" , PALETTERGB (0, 139, 69) },
+ {"green1" , PALETTERGB (0, 255, 0) },
+ {"green2" , PALETTERGB (0, 238, 0) },
+ {"green3" , PALETTERGB (0, 205, 0) },
+ {"green4" , PALETTERGB (0, 139, 0) },
+ {"chartreuse1" , PALETTERGB (127, 255, 0) },
+ {"chartreuse2" , PALETTERGB (118, 238, 0) },
+ {"chartreuse3" , PALETTERGB (102, 205, 0) },
+ {"chartreuse4" , PALETTERGB (69, 139, 0) },
+ {"OliveDrab1" , PALETTERGB (192, 255, 62) },
+ {"OliveDrab2" , PALETTERGB (179, 238, 58) },
+ {"OliveDrab3" , PALETTERGB (154, 205, 50) },
+ {"OliveDrab4" , PALETTERGB (105, 139, 34) },
+ {"DarkOliveGreen1" , PALETTERGB (202, 255, 112) },
+ {"DarkOliveGreen2" , PALETTERGB (188, 238, 104) },
+ {"DarkOliveGreen3" , PALETTERGB (162, 205, 90) },
+ {"DarkOliveGreen4" , PALETTERGB (110, 139, 61) },
+ {"khaki1" , PALETTERGB (255, 246, 143) },
+ {"khaki2" , PALETTERGB (238, 230, 133) },
+ {"khaki3" , PALETTERGB (205, 198, 115) },
+ {"khaki4" , PALETTERGB (139, 134, 78) },
+ {"LightGoldenrod1" , PALETTERGB (255, 236, 139) },
+ {"LightGoldenrod2" , PALETTERGB (238, 220, 130) },
+ {"LightGoldenrod3" , PALETTERGB (205, 190, 112) },
+ {"LightGoldenrod4" , PALETTERGB (139, 129, 76) },
+ {"LightYellow1" , PALETTERGB (255, 255, 224) },
+ {"LightYellow2" , PALETTERGB (238, 238, 209) },
+ {"LightYellow3" , PALETTERGB (205, 205, 180) },
+ {"LightYellow4" , PALETTERGB (139, 139, 122) },
+ {"yellow1" , PALETTERGB (255, 255, 0) },
+ {"yellow2" , PALETTERGB (238, 238, 0) },
+ {"yellow3" , PALETTERGB (205, 205, 0) },
+ {"yellow4" , PALETTERGB (139, 139, 0) },
+ {"gold1" , PALETTERGB (255, 215, 0) },
+ {"gold2" , PALETTERGB (238, 201, 0) },
+ {"gold3" , PALETTERGB (205, 173, 0) },
+ {"gold4" , PALETTERGB (139, 117, 0) },
+ {"goldenrod1" , PALETTERGB (255, 193, 37) },
+ {"goldenrod2" , PALETTERGB (238, 180, 34) },
+ {"goldenrod3" , PALETTERGB (205, 155, 29) },
+ {"goldenrod4" , PALETTERGB (139, 105, 20) },
+ {"DarkGoldenrod1" , PALETTERGB (255, 185, 15) },
+ {"DarkGoldenrod2" , PALETTERGB (238, 173, 14) },
+ {"DarkGoldenrod3" , PALETTERGB (205, 149, 12) },
+ {"DarkGoldenrod4" , PALETTERGB (139, 101, 8) },
+ {"RosyBrown1" , PALETTERGB (255, 193, 193) },
+ {"RosyBrown2" , PALETTERGB (238, 180, 180) },
+ {"RosyBrown3" , PALETTERGB (205, 155, 155) },
+ {"RosyBrown4" , PALETTERGB (139, 105, 105) },
+ {"IndianRed1" , PALETTERGB (255, 106, 106) },
+ {"IndianRed2" , PALETTERGB (238, 99, 99) },
+ {"IndianRed3" , PALETTERGB (205, 85, 85) },
+ {"IndianRed4" , PALETTERGB (139, 58, 58) },
+ {"sienna1" , PALETTERGB (255, 130, 71) },
+ {"sienna2" , PALETTERGB (238, 121, 66) },
+ {"sienna3" , PALETTERGB (205, 104, 57) },
+ {"sienna4" , PALETTERGB (139, 71, 38) },
+ {"burlywood1" , PALETTERGB (255, 211, 155) },
+ {"burlywood2" , PALETTERGB (238, 197, 145) },
+ {"burlywood3" , PALETTERGB (205, 170, 125) },
+ {"burlywood4" , PALETTERGB (139, 115, 85) },
+ {"wheat1" , PALETTERGB (255, 231, 186) },
+ {"wheat2" , PALETTERGB (238, 216, 174) },
+ {"wheat3" , PALETTERGB (205, 186, 150) },
+ {"wheat4" , PALETTERGB (139, 126, 102) },
+ {"tan1" , PALETTERGB (255, 165, 79) },
+ {"tan2" , PALETTERGB (238, 154, 73) },
+ {"tan3" , PALETTERGB (205, 133, 63) },
+ {"tan4" , PALETTERGB (139, 90, 43) },
+ {"chocolate1" , PALETTERGB (255, 127, 36) },
+ {"chocolate2" , PALETTERGB (238, 118, 33) },
+ {"chocolate3" , PALETTERGB (205, 102, 29) },
+ {"chocolate4" , PALETTERGB (139, 69, 19) },
+ {"firebrick1" , PALETTERGB (255, 48, 48) },
+ {"firebrick2" , PALETTERGB (238, 44, 44) },
+ {"firebrick3" , PALETTERGB (205, 38, 38) },
+ {"firebrick4" , PALETTERGB (139, 26, 26) },
+ {"brown1" , PALETTERGB (255, 64, 64) },
+ {"brown2" , PALETTERGB (238, 59, 59) },
+ {"brown3" , PALETTERGB (205, 51, 51) },
+ {"brown4" , PALETTERGB (139, 35, 35) },
+ {"salmon1" , PALETTERGB (255, 140, 105) },
+ {"salmon2" , PALETTERGB (238, 130, 98) },
+ {"salmon3" , PALETTERGB (205, 112, 84) },
+ {"salmon4" , PALETTERGB (139, 76, 57) },
+ {"LightSalmon1" , PALETTERGB (255, 160, 122) },
+ {"LightSalmon2" , PALETTERGB (238, 149, 114) },
+ {"LightSalmon3" , PALETTERGB (205, 129, 98) },
+ {"LightSalmon4" , PALETTERGB (139, 87, 66) },
+ {"orange1" , PALETTERGB (255, 165, 0) },
+ {"orange2" , PALETTERGB (238, 154, 0) },
+ {"orange3" , PALETTERGB (205, 133, 0) },
+ {"orange4" , PALETTERGB (139, 90, 0) },
+ {"DarkOrange1" , PALETTERGB (255, 127, 0) },
+ {"DarkOrange2" , PALETTERGB (238, 118, 0) },
+ {"DarkOrange3" , PALETTERGB (205, 102, 0) },
+ {"DarkOrange4" , PALETTERGB (139, 69, 0) },
+ {"coral1" , PALETTERGB (255, 114, 86) },
+ {"coral2" , PALETTERGB (238, 106, 80) },
+ {"coral3" , PALETTERGB (205, 91, 69) },
+ {"coral4" , PALETTERGB (139, 62, 47) },
+ {"tomato1" , PALETTERGB (255, 99, 71) },
+ {"tomato2" , PALETTERGB (238, 92, 66) },
+ {"tomato3" , PALETTERGB (205, 79, 57) },
+ {"tomato4" , PALETTERGB (139, 54, 38) },
+ {"OrangeRed1" , PALETTERGB (255, 69, 0) },
+ {"OrangeRed2" , PALETTERGB (238, 64, 0) },
+ {"OrangeRed3" , PALETTERGB (205, 55, 0) },
+ {"OrangeRed4" , PALETTERGB (139, 37, 0) },
+ {"red1" , PALETTERGB (255, 0, 0) },
+ {"red2" , PALETTERGB (238, 0, 0) },
+ {"red3" , PALETTERGB (205, 0, 0) },
+ {"red4" , PALETTERGB (139, 0, 0) },
+ {"DeepPink1" , PALETTERGB (255, 20, 147) },
+ {"DeepPink2" , PALETTERGB (238, 18, 137) },
+ {"DeepPink3" , PALETTERGB (205, 16, 118) },
+ {"DeepPink4" , PALETTERGB (139, 10, 80) },
+ {"HotPink1" , PALETTERGB (255, 110, 180) },
+ {"HotPink2" , PALETTERGB (238, 106, 167) },
+ {"HotPink3" , PALETTERGB (205, 96, 144) },
+ {"HotPink4" , PALETTERGB (139, 58, 98) },
+ {"pink1" , PALETTERGB (255, 181, 197) },
+ {"pink2" , PALETTERGB (238, 169, 184) },
+ {"pink3" , PALETTERGB (205, 145, 158) },
+ {"pink4" , PALETTERGB (139, 99, 108) },
+ {"LightPink1" , PALETTERGB (255, 174, 185) },
+ {"LightPink2" , PALETTERGB (238, 162, 173) },
+ {"LightPink3" , PALETTERGB (205, 140, 149) },
+ {"LightPink4" , PALETTERGB (139, 95, 101) },
+ {"PaleVioletRed1" , PALETTERGB (255, 130, 171) },
+ {"PaleVioletRed2" , PALETTERGB (238, 121, 159) },
+ {"PaleVioletRed3" , PALETTERGB (205, 104, 137) },
+ {"PaleVioletRed4" , PALETTERGB (139, 71, 93) },
+ {"maroon1" , PALETTERGB (255, 52, 179) },
+ {"maroon2" , PALETTERGB (238, 48, 167) },
+ {"maroon3" , PALETTERGB (205, 41, 144) },
+ {"maroon4" , PALETTERGB (139, 28, 98) },
+ {"VioletRed1" , PALETTERGB (255, 62, 150) },
+ {"VioletRed2" , PALETTERGB (238, 58, 140) },
+ {"VioletRed3" , PALETTERGB (205, 50, 120) },
+ {"VioletRed4" , PALETTERGB (139, 34, 82) },
+ {"magenta1" , PALETTERGB (255, 0, 255) },
+ {"magenta2" , PALETTERGB (238, 0, 238) },
+ {"magenta3" , PALETTERGB (205, 0, 205) },
+ {"magenta4" , PALETTERGB (139, 0, 139) },
+ {"orchid1" , PALETTERGB (255, 131, 250) },
+ {"orchid2" , PALETTERGB (238, 122, 233) },
+ {"orchid3" , PALETTERGB (205, 105, 201) },
+ {"orchid4" , PALETTERGB (139, 71, 137) },
+ {"plum1" , PALETTERGB (255, 187, 255) },
+ {"plum2" , PALETTERGB (238, 174, 238) },
+ {"plum3" , PALETTERGB (205, 150, 205) },
+ {"plum4" , PALETTERGB (139, 102, 139) },
+ {"MediumOrchid1" , PALETTERGB (224, 102, 255) },
+ {"MediumOrchid2" , PALETTERGB (209, 95, 238) },
+ {"MediumOrchid3" , PALETTERGB (180, 82, 205) },
+ {"MediumOrchid4" , PALETTERGB (122, 55, 139) },
+ {"DarkOrchid1" , PALETTERGB (191, 62, 255) },
+ {"DarkOrchid2" , PALETTERGB (178, 58, 238) },
+ {"DarkOrchid3" , PALETTERGB (154, 50, 205) },
+ {"DarkOrchid4" , PALETTERGB (104, 34, 139) },
+ {"purple1" , PALETTERGB (155, 48, 255) },
+ {"purple2" , PALETTERGB (145, 44, 238) },
+ {"purple3" , PALETTERGB (125, 38, 205) },
+ {"purple4" , PALETTERGB (85, 26, 139) },
+ {"MediumPurple1" , PALETTERGB (171, 130, 255) },
+ {"MediumPurple2" , PALETTERGB (159, 121, 238) },
+ {"MediumPurple3" , PALETTERGB (137, 104, 205) },
+ {"MediumPurple4" , PALETTERGB (93, 71, 139) },
+ {"thistle1" , PALETTERGB (255, 225, 255) },
+ {"thistle2" , PALETTERGB (238, 210, 238) },
+ {"thistle3" , PALETTERGB (205, 181, 205) },
+ {"thistle4" , PALETTERGB (139, 123, 139) },
+ {"gray0" , PALETTERGB (0, 0, 0) },
+ {"grey0" , PALETTERGB (0, 0, 0) },
+ {"gray1" , PALETTERGB (3, 3, 3) },
+ {"grey1" , PALETTERGB (3, 3, 3) },
+ {"gray2" , PALETTERGB (5, 5, 5) },
+ {"grey2" , PALETTERGB (5, 5, 5) },
+ {"gray3" , PALETTERGB (8, 8, 8) },
+ {"grey3" , PALETTERGB (8, 8, 8) },
+ {"gray4" , PALETTERGB (10, 10, 10) },
+ {"grey4" , PALETTERGB (10, 10, 10) },
+ {"gray5" , PALETTERGB (13, 13, 13) },
+ {"grey5" , PALETTERGB (13, 13, 13) },
+ {"gray6" , PALETTERGB (15, 15, 15) },
+ {"grey6" , PALETTERGB (15, 15, 15) },
+ {"gray7" , PALETTERGB (18, 18, 18) },
+ {"grey7" , PALETTERGB (18, 18, 18) },
+ {"gray8" , PALETTERGB (20, 20, 20) },
+ {"grey8" , PALETTERGB (20, 20, 20) },
+ {"gray9" , PALETTERGB (23, 23, 23) },
+ {"grey9" , PALETTERGB (23, 23, 23) },
+ {"gray10" , PALETTERGB (26, 26, 26) },
+ {"grey10" , PALETTERGB (26, 26, 26) },
+ {"gray11" , PALETTERGB (28, 28, 28) },
+ {"grey11" , PALETTERGB (28, 28, 28) },
+ {"gray12" , PALETTERGB (31, 31, 31) },
+ {"grey12" , PALETTERGB (31, 31, 31) },
+ {"gray13" , PALETTERGB (33, 33, 33) },
+ {"grey13" , PALETTERGB (33, 33, 33) },
+ {"gray14" , PALETTERGB (36, 36, 36) },
+ {"grey14" , PALETTERGB (36, 36, 36) },
+ {"gray15" , PALETTERGB (38, 38, 38) },
+ {"grey15" , PALETTERGB (38, 38, 38) },
+ {"gray16" , PALETTERGB (41, 41, 41) },
+ {"grey16" , PALETTERGB (41, 41, 41) },
+ {"gray17" , PALETTERGB (43, 43, 43) },
+ {"grey17" , PALETTERGB (43, 43, 43) },
+ {"gray18" , PALETTERGB (46, 46, 46) },
+ {"grey18" , PALETTERGB (46, 46, 46) },
+ {"gray19" , PALETTERGB (48, 48, 48) },
+ {"grey19" , PALETTERGB (48, 48, 48) },
+ {"gray20" , PALETTERGB (51, 51, 51) },
+ {"grey20" , PALETTERGB (51, 51, 51) },
+ {"gray21" , PALETTERGB (54, 54, 54) },
+ {"grey21" , PALETTERGB (54, 54, 54) },
+ {"gray22" , PALETTERGB (56, 56, 56) },
+ {"grey22" , PALETTERGB (56, 56, 56) },
+ {"gray23" , PALETTERGB (59, 59, 59) },
+ {"grey23" , PALETTERGB (59, 59, 59) },
+ {"gray24" , PALETTERGB (61, 61, 61) },
+ {"grey24" , PALETTERGB (61, 61, 61) },
+ {"gray25" , PALETTERGB (64, 64, 64) },
+ {"grey25" , PALETTERGB (64, 64, 64) },
+ {"gray26" , PALETTERGB (66, 66, 66) },
+ {"grey26" , PALETTERGB (66, 66, 66) },
+ {"gray27" , PALETTERGB (69, 69, 69) },
+ {"grey27" , PALETTERGB (69, 69, 69) },
+ {"gray28" , PALETTERGB (71, 71, 71) },
+ {"grey28" , PALETTERGB (71, 71, 71) },
+ {"gray29" , PALETTERGB (74, 74, 74) },
+ {"grey29" , PALETTERGB (74, 74, 74) },
+ {"gray30" , PALETTERGB (77, 77, 77) },
+ {"grey30" , PALETTERGB (77, 77, 77) },
+ {"gray31" , PALETTERGB (79, 79, 79) },
+ {"grey31" , PALETTERGB (79, 79, 79) },
+ {"gray32" , PALETTERGB (82, 82, 82) },
+ {"grey32" , PALETTERGB (82, 82, 82) },
+ {"gray33" , PALETTERGB (84, 84, 84) },
+ {"grey33" , PALETTERGB (84, 84, 84) },
+ {"gray34" , PALETTERGB (87, 87, 87) },
+ {"grey34" , PALETTERGB (87, 87, 87) },
+ {"gray35" , PALETTERGB (89, 89, 89) },
+ {"grey35" , PALETTERGB (89, 89, 89) },
+ {"gray36" , PALETTERGB (92, 92, 92) },
+ {"grey36" , PALETTERGB (92, 92, 92) },
+ {"gray37" , PALETTERGB (94, 94, 94) },
+ {"grey37" , PALETTERGB (94, 94, 94) },
+ {"gray38" , PALETTERGB (97, 97, 97) },
+ {"grey38" , PALETTERGB (97, 97, 97) },
+ {"gray39" , PALETTERGB (99, 99, 99) },
+ {"grey39" , PALETTERGB (99, 99, 99) },
+ {"gray40" , PALETTERGB (102, 102, 102) },
+ {"grey40" , PALETTERGB (102, 102, 102) },
+ {"gray41" , PALETTERGB (105, 105, 105) },
+ {"grey41" , PALETTERGB (105, 105, 105) },
+ {"gray42" , PALETTERGB (107, 107, 107) },
+ {"grey42" , PALETTERGB (107, 107, 107) },
+ {"gray43" , PALETTERGB (110, 110, 110) },
+ {"grey43" , PALETTERGB (110, 110, 110) },
+ {"gray44" , PALETTERGB (112, 112, 112) },
+ {"grey44" , PALETTERGB (112, 112, 112) },
+ {"gray45" , PALETTERGB (115, 115, 115) },
+ {"grey45" , PALETTERGB (115, 115, 115) },
+ {"gray46" , PALETTERGB (117, 117, 117) },
+ {"grey46" , PALETTERGB (117, 117, 117) },
+ {"gray47" , PALETTERGB (120, 120, 120) },
+ {"grey47" , PALETTERGB (120, 120, 120) },
+ {"gray48" , PALETTERGB (122, 122, 122) },
+ {"grey48" , PALETTERGB (122, 122, 122) },
+ {"gray49" , PALETTERGB (125, 125, 125) },
+ {"grey49" , PALETTERGB (125, 125, 125) },
+ {"gray50" , PALETTERGB (127, 127, 127) },
+ {"grey50" , PALETTERGB (127, 127, 127) },
+ {"gray51" , PALETTERGB (130, 130, 130) },
+ {"grey51" , PALETTERGB (130, 130, 130) },
+ {"gray52" , PALETTERGB (133, 133, 133) },
+ {"grey52" , PALETTERGB (133, 133, 133) },
+ {"gray53" , PALETTERGB (135, 135, 135) },
+ {"grey53" , PALETTERGB (135, 135, 135) },
+ {"gray54" , PALETTERGB (138, 138, 138) },
+ {"grey54" , PALETTERGB (138, 138, 138) },
+ {"gray55" , PALETTERGB (140, 140, 140) },
+ {"grey55" , PALETTERGB (140, 140, 140) },
+ {"gray56" , PALETTERGB (143, 143, 143) },
+ {"grey56" , PALETTERGB (143, 143, 143) },
+ {"gray57" , PALETTERGB (145, 145, 145) },
+ {"grey57" , PALETTERGB (145, 145, 145) },
+ {"gray58" , PALETTERGB (148, 148, 148) },
+ {"grey58" , PALETTERGB (148, 148, 148) },
+ {"gray59" , PALETTERGB (150, 150, 150) },
+ {"grey59" , PALETTERGB (150, 150, 150) },
+ {"gray60" , PALETTERGB (153, 153, 153) },
+ {"grey60" , PALETTERGB (153, 153, 153) },
+ {"gray61" , PALETTERGB (156, 156, 156) },
+ {"grey61" , PALETTERGB (156, 156, 156) },
+ {"gray62" , PALETTERGB (158, 158, 158) },
+ {"grey62" , PALETTERGB (158, 158, 158) },
+ {"gray63" , PALETTERGB (161, 161, 161) },
+ {"grey63" , PALETTERGB (161, 161, 161) },
+ {"gray64" , PALETTERGB (163, 163, 163) },
+ {"grey64" , PALETTERGB (163, 163, 163) },
+ {"gray65" , PALETTERGB (166, 166, 166) },
+ {"grey65" , PALETTERGB (166, 166, 166) },
+ {"gray66" , PALETTERGB (168, 168, 168) },
+ {"grey66" , PALETTERGB (168, 168, 168) },
+ {"gray67" , PALETTERGB (171, 171, 171) },
+ {"grey67" , PALETTERGB (171, 171, 171) },
+ {"gray68" , PALETTERGB (173, 173, 173) },
+ {"grey68" , PALETTERGB (173, 173, 173) },
+ {"gray69" , PALETTERGB (176, 176, 176) },
+ {"grey69" , PALETTERGB (176, 176, 176) },
+ {"gray70" , PALETTERGB (179, 179, 179) },
+ {"grey70" , PALETTERGB (179, 179, 179) },
+ {"gray71" , PALETTERGB (181, 181, 181) },
+ {"grey71" , PALETTERGB (181, 181, 181) },
+ {"gray72" , PALETTERGB (184, 184, 184) },
+ {"grey72" , PALETTERGB (184, 184, 184) },
+ {"gray73" , PALETTERGB (186, 186, 186) },
+ {"grey73" , PALETTERGB (186, 186, 186) },
+ {"gray74" , PALETTERGB (189, 189, 189) },
+ {"grey74" , PALETTERGB (189, 189, 189) },
+ {"gray75" , PALETTERGB (191, 191, 191) },
+ {"grey75" , PALETTERGB (191, 191, 191) },
+ {"gray76" , PALETTERGB (194, 194, 194) },
+ {"grey76" , PALETTERGB (194, 194, 194) },
+ {"gray77" , PALETTERGB (196, 196, 196) },
+ {"grey77" , PALETTERGB (196, 196, 196) },
+ {"gray78" , PALETTERGB (199, 199, 199) },
+ {"grey78" , PALETTERGB (199, 199, 199) },
+ {"gray79" , PALETTERGB (201, 201, 201) },
+ {"grey79" , PALETTERGB (201, 201, 201) },
+ {"gray80" , PALETTERGB (204, 204, 204) },
+ {"grey80" , PALETTERGB (204, 204, 204) },
+ {"gray81" , PALETTERGB (207, 207, 207) },
+ {"grey81" , PALETTERGB (207, 207, 207) },
+ {"gray82" , PALETTERGB (209, 209, 209) },
+ {"grey82" , PALETTERGB (209, 209, 209) },
+ {"gray83" , PALETTERGB (212, 212, 212) },
+ {"grey83" , PALETTERGB (212, 212, 212) },
+ {"gray84" , PALETTERGB (214, 214, 214) },
+ {"grey84" , PALETTERGB (214, 214, 214) },
+ {"gray85" , PALETTERGB (217, 217, 217) },
+ {"grey85" , PALETTERGB (217, 217, 217) },
+ {"gray86" , PALETTERGB (219, 219, 219) },
+ {"grey86" , PALETTERGB (219, 219, 219) },
+ {"gray87" , PALETTERGB (222, 222, 222) },
+ {"grey87" , PALETTERGB (222, 222, 222) },
+ {"gray88" , PALETTERGB (224, 224, 224) },
+ {"grey88" , PALETTERGB (224, 224, 224) },
+ {"gray89" , PALETTERGB (227, 227, 227) },
+ {"grey89" , PALETTERGB (227, 227, 227) },
+ {"gray90" , PALETTERGB (229, 229, 229) },
+ {"grey90" , PALETTERGB (229, 229, 229) },
+ {"gray91" , PALETTERGB (232, 232, 232) },
+ {"grey91" , PALETTERGB (232, 232, 232) },
+ {"gray92" , PALETTERGB (235, 235, 235) },
+ {"grey92" , PALETTERGB (235, 235, 235) },
+ {"gray93" , PALETTERGB (237, 237, 237) },
+ {"grey93" , PALETTERGB (237, 237, 237) },
+ {"gray94" , PALETTERGB (240, 240, 240) },
+ {"grey94" , PALETTERGB (240, 240, 240) },
+ {"gray95" , PALETTERGB (242, 242, 242) },
+ {"grey95" , PALETTERGB (242, 242, 242) },
+ {"gray96" , PALETTERGB (245, 245, 245) },
+ {"grey96" , PALETTERGB (245, 245, 245) },
+ {"gray97" , PALETTERGB (247, 247, 247) },
+ {"grey97" , PALETTERGB (247, 247, 247) },
+ {"gray98" , PALETTERGB (250, 250, 250) },
+ {"grey98" , PALETTERGB (250, 250, 250) },
+ {"gray99" , PALETTERGB (252, 252, 252) },
+ {"grey99" , PALETTERGB (252, 252, 252) },
+ {"gray100" , PALETTERGB (255, 255, 255) },
+ {"grey100" , PALETTERGB (255, 255, 255) },
+ {"DarkGrey" , PALETTERGB (169, 169, 169) },
+ {"DarkGray" , PALETTERGB (169, 169, 169) },
+ {"DarkBlue" , PALETTERGB (0, 0, 139) },
+ {"DarkCyan" , PALETTERGB (0, 139, 139) },
+ {"DarkMagenta" , PALETTERGB (139, 0, 139) },
+ {"DarkRed" , PALETTERGB (139, 0, 0) },
+ {"LightGreen" , PALETTERGB (144, 238, 144) }
+};
+
+\f
+/************************************************************************/
+/* helpers */
+/************************************************************************/
+
+static int
+hexval (char c)
+{
+ /* assumes ASCII and isxdigit(c) */
+ if (c >= 'a')
+ return c-'a' + 10;
+ else if (c >= 'A')
+ return c-'A' + 10;
+ else
+ return c-'0';
+}
+
+COLORREF
+mswindows_string_to_color(CONST char *name)
+{
+ int i;
+
+ if (*name == '#')
+ {
+ /* numeric names look like "#RRGGBB", "#RRRGGGBBB" or "#RRRRGGGGBBBB"
+ or "rgb:rrrr/gggg/bbbb" */
+ unsigned int r, g, b;
+
+ for (i=1; i<strlen(name); i++)
+ {
+ if (!isxdigit ((int)name[i]))
+ return (COLORREF) -1;
+ }
+ if (strlen(name)==7)
+ {
+ r = hexval (name[1]) * 16 + hexval (name[2]);
+ g = hexval (name[3]) * 16 + hexval (name[4]);
+ b = hexval (name[5]) * 16 + hexval (name[6]);
+ return (PALETTERGB (r, g, b));
+ }
+ else if (strlen(name)==10)
+ {
+ r = hexval (name[1]) * 16 + hexval (name[2]);
+ g = hexval (name[4]) * 16 + hexval (name[5]);
+ b = hexval (name[7]) * 16 + hexval (name[8]);
+ return (PALETTERGB (r, g, b));
+ }
+ else if (strlen(name)==13)
+ {
+ r = hexval (name[1]) * 16 + hexval (name[2]);
+ g = hexval (name[5]) * 16 + hexval (name[6]);
+ b = hexval (name[9]) * 16 + hexval (name[10]);
+ return (PALETTERGB (r, g, b));
+ }
+ }
+ else if (!strncmp(name, "rgb:", 4))
+ {
+ unsigned int r,g,b;
+
+ if (sscanf(name, "rgb:%04x/%04x/%04x", &r, &g, &b) == 3)
+ {
+ int len = strlen (name);
+ if (len == 18)
+ {
+ r /= 257;
+ g /= 257;
+ b /= 257;
+ }
+ else if (len == 15)
+ {
+ r /= 17;
+ g /= 17;
+ b /= 17;
+ }
+ return (PALETTERGB (r, g, b));
+ }
+ else
+ return (COLORREF) -1;
+ }
+ else if (*name) /* Can't be an empty string */
+ {
+ char *nospaces = alloca (strlen (name)+1);
+ char *c=nospaces;
+ while (*name)
+ if (*name != ' ')
+ *(c++) = *(name++);
+ else
+ name++;
+ *c = '\0';
+
+ for (i=0; i< countof (mswindows_X_color_map); i++)
+ if (!stricmp (nospaces, mswindows_X_color_map[i].name))
+ return (mswindows_X_color_map[i].colorref);
+ }
+ return (COLORREF) -1;
+}
+
+/*
+ * Returns non-zero if the two supplied font patterns match.
+ * If they match and fontname is not NULL, copies the logical OR of the
+ * patterns to fontname (which is assumed to be at least MSW_FONTSIZE in size).
+ *
+ * The patterns 'match' iff for each field that is not blank in either pattern,
+ * the corresponding field in the other pattern is either identical or blank.
+ */
+static int
+match_font (char *pattern1, char *pattern2, char *fontname)
+{
+ char *c1=pattern1, *c2=pattern2, *e1=0, *e2=0;
+ int i;
+
+ if (fontname)
+ fontname[0] = '\0';
+
+ for (i=0; i<5; i++)
+ {
+ if (c1 && (e1 = strchr (c1, ':')))
+ *(e1) = '\0';
+ if (c2 && (e2 = strchr (c2, ':')))
+ *(e2) = '\0';
+
+ if (c1 && c1[0]!='\0')
+ {
+ if (c2 && c2[0]!='\0' && stricmp(c1, c2))
+ {
+ if (e1) *e1 = ':';
+ if (e2) *e2 = ':';
+ return 0;
+ }
+ else if (fontname)
+ strcat (strcat (fontname, c1), ":");
+ }
+ else if (fontname)
+ {
+ if (c2 && c2[0]!='\0')
+ strcat (strcat (fontname, c2), ":");
+ else
+ strcat (fontname, ":");
+ }
+
+ if (e1) *(e1++) = ':';
+ if (e2) *(e2++) = ':';
+ c1=e1;
+ c2=e2;
+ }
+
+ if (fontname)
+ fontname[strlen (fontname) - 1] = '\0'; /* Trim trailing ':' */
+ return 1;
+}
+
+\f
+/************************************************************************/
+/* methods */
+/************************************************************************/
+
+static int
+mswindows_initialize_color_instance (struct Lisp_Color_Instance *c, Lisp_Object name,
+ Lisp_Object device, Error_behavior errb)
+{
+ CONST char *extname;
+ COLORREF color;
+
+ GET_C_STRING_CTEXT_DATA_ALLOCA (name, extname);
+ color = mswindows_string_to_color(extname);
+ if (color != -1)
+ {
+ c->data = xnew (struct mswindows_color_instance_data);
+ COLOR_INSTANCE_MSWINDOWS_COLOR (c) = color;
+ return 1;
+ }
+ maybe_signal_simple_error ("unrecognized color", name, Qcolor, errb);
+ return(0);
+}
+
+#if 0
+static void
+mswindows_mark_color_instance (struct Lisp_Color_Instance *c,
+ void (*markobj) (Lisp_Object))
+{
+}
+#endif
+
+static void
+mswindows_print_color_instance (struct Lisp_Color_Instance *c,
+ Lisp_Object printcharfun,
+ int escapeflag)
+{
+ char buf[32];
+ COLORREF color = COLOR_INSTANCE_MSWINDOWS_COLOR (c);
+ sprintf (buf, " %06ld=(%04X,%04X,%04X)", color & 0xffffff,
+ GetRValue(color)*257, GetGValue(color)*257, GetBValue(color)*257);
+ write_c_string (buf, printcharfun);
+}
+
+static void
+mswindows_finalize_color_instance (struct Lisp_Color_Instance *c)
+{
+ if (c->data)
+ {
+ xfree (c->data);
+ c->data = 0;
+ }
+}
+
+static int
+mswindows_color_instance_equal (struct Lisp_Color_Instance *c1,
+ struct 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)
+{
+ return (unsigned long)(COLOR_INSTANCE_MSWINDOWS_COLOR(c));
+}
+
+static Lisp_Object
+mswindows_color_instance_rgb_components (struct Lisp_Color_Instance *c)
+{
+ COLORREF color = COLOR_INSTANCE_MSWINDOWS_COLOR (c);
+ return list3 (make_int (GetRValue (color) * 257),
+ make_int (GetGValue (color) * 257),
+ make_int (GetBValue (color) * 257));
+}
+
+static int
+mswindows_valid_color_name_p (struct device *d, Lisp_Object color)
+{
+ CONST char *extname;
+
+ GET_C_STRING_CTEXT_DATA_ALLOCA (color, extname);
+ return (mswindows_string_to_color(extname)!=-1);
+}
+
+
+\f
+static void
+mswindows_finalize_font_instance (struct Lisp_Font_Instance *f)
+{
+ 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;
+ LOGFONT logfont;
+ int fields;
+ int pt;
+ char fontname[LF_FACESIZE], weight[LF_FACESIZE], *style, points[8];
+ char effects[LF_FACESIZE], charset[LF_FACESIZE];
+ char *c;
+
+ GET_C_STRING_CTEXT_DATA_ALLOCA (f->name, extname);
+
+ /*
+ * mswindows fonts look like:
+ * fontname[:[weight ][style][:pointsize[:effects]]][:charset]
+ * The font name field shouldn't be empty.
+ *
+ * ie:
+ * Lucida Console:Regular:10
+ * minimal:
+ * Courier New
+ * maximal:
+ * Courier New:Bold Italic:10:underline strikeout:western
+ */
+
+ fields = sscanf (extname, "%31[^:]:%31[^:]:%7[^:]:%31[^:]:%31s",
+ fontname, weight, points, effects, charset);
+
+ /* This function is implemented in a fairly ad-hoc manner.
+ * The general idea is to validate and canonicalize each of the above fields
+ * at the same time as we build up the win32 LOGFONT structure. This enables
+ * us to use math_font() on a canonicalized font string to check the
+ * availability of the requested font */
+
+ if (fields<0)
+ {
+ maybe_signal_simple_error ("Invalid font", f->name, Qfont, errb);
+ return (0);
+ }
+
+ if (fields>0 && strlen(fontname))
+ {
+ strncpy (logfont.lfFaceName, fontname, LF_FACESIZE);
+ logfont.lfFaceName[LF_FACESIZE-1] = 0;
+ }
+ else
+ {
+ maybe_signal_simple_error ("Must specify a font name", f->name, Qfont, errb);
+ return (0);
+ }
+
+ /* weight */
+ if (fields < 2)
+ strcpy (weight, "Regular");
+
+ /* Maybe split weight into weight and style */
+ if ((c=strchr(weight, ' ')))
+ {
+ *c = '\0';
+ style = c+1;
+ }
+ else
+ style = NULL;
+
+#define FROB(wgt) \
+ if (stricmp (weight, #wgt) == 0) \
+ logfont.lfWeight = FW_##wgt
+
+ FROB (REGULAR);
+ else FROB (THIN);
+ else FROB (EXTRALIGHT);
+ else FROB (ULTRALIGHT);
+ else FROB (LIGHT);
+ else FROB (NORMAL);
+ else FROB (MEDIUM);
+ else FROB (SEMIBOLD);
+ else FROB (DEMIBOLD);
+ else FROB (BOLD);
+ else FROB (EXTRABOLD);
+ else FROB (ULTRABOLD);
+ else FROB (HEAVY);
+ else FROB (BLACK);
+ else if (!style)
+ {
+ logfont.lfWeight = FW_REGULAR;
+ style = weight; /* May have specified style without weight */
+ }
+ else
+ {
+ maybe_signal_simple_error ("Invalid font weight", f->name, Qfont, errb);
+ return (0);
+ }
+
+#undef FROB
+
+ if (style)
+ {
+ /* #### what about oblique? */
+ if (stricmp (style,"italic") == 0)
+ logfont.lfItalic = TRUE;
+ else
+ {
+ maybe_signal_simple_error ("Invalid font weight or style", f->name, Qfont, errb);
+ return (0);
+ }
+
+ /* Glue weight and style together again */
+ if (weight != style)
+ *c = ' ';
+ }
+ else
+ logfont.lfItalic = FALSE;
+
+ if (fields < 3)
+ pt = 10; /* #### Should we reject strings that don't specify a size? */
+ else if ((pt=atoi(points)) == 0)
+ {
+ maybe_signal_simple_error ("Invalid font pointsize", f->name, Qfont, errb);
+ return (0);
+ }
+
+ /* Formula for pointsize->height from LOGFONT docs in MSVC5 Platform SDK */
+ logfont.lfHeight = -MulDiv(pt, DEVICE_MSWINDOWS_LOGPIXELSY(XDEVICE (device)), 72);
+ logfont.lfWidth = 0;
+
+ /* Effects */
+ logfont.lfUnderline = FALSE;
+ logfont.lfStrikeOut = FALSE;
+ if (fields >= 4 && effects[0] != '\0')
+ {
+ char *effects2;
+
+ /* Maybe split effects into effects and effects2 */
+ if ((c=strchr (effects, ' ')))
+ {
+ *c = '\0';
+ effects2 = c+1;
+ }
+ else
+ effects2 = NULL;
+
+ if (stricmp (effects, "underline") == 0)
+ logfont.lfUnderline = TRUE;
+ else if (stricmp (effects, "strikeout") == 0)
+ logfont.lfStrikeOut = TRUE;
+ else
+ {
+ maybe_signal_simple_error ("Invalid font effect", f->name,
+ Qfont, errb);
+ return (0);
+ }
+
+ if (effects2 && effects2[0] != '\0')
+ {
+ if (stricmp (effects2, "underline") == 0)
+ logfont.lfUnderline = TRUE;
+ else if (stricmp (effects2, "strikeout") == 0)
+ logfont.lfStrikeOut = TRUE;
+ else
+ {
+ maybe_signal_simple_error ("Invalid font effect", f->name,
+ Qfont, errb);
+ return (0);
+ }
+ }
+
+ /* Regenerate sanitised effects string */
+ if (logfont.lfUnderline)
+ {
+ if (logfont.lfStrikeOut)
+ strcpy (effects, "underline strikeout");
+ else
+ strcpy (effects, "underline");
+ }
+ else if (logfont.lfStrikeOut)
+ strcpy (effects, "strikeout");
+ }
+ else
+ effects[0] = '\0';
+
+#define FROB(cs) \
+ else if (stricmp (charset, #cs) == 0) \
+ logfont.lfCharSet = cs##_CHARSET
+
+ /* Charset aliases. Hangeul = Hangul is defined in windows.h.
+ We do not use the name "russian", only "cyrillic", as it is
+ the common name of this charset, used in other languages
+ than Russian. */
+#define CYRILLIC_CHARSET RUSSIAN_CHARSET
+#define CENTRALEUROPEAN_CHARSET EASTEUROPE_CHARSET
+#define CENTRALEUROPEAN_CHARSET EASTEUROPE_CHARSET
+
+ /* charset can be specified even if earlier fields havn't been */
+ if ((fields < 5) && (c=strchr (extname, ':')) && (c=strchr (c+1, ':')) &&
+ (c=strchr (c+1, ':')) && (c=strchr (c+1, ':')))
+ {
+ strncpy (charset, c+1, LF_FACESIZE);
+ charset[LF_FACESIZE-1] = '\0';
+ }
+ else
+ charset[0] = '\0';
+
+ if (charset[0] == '\0' || (stricmp (charset, "ansi") == 0) ||
+ (stricmp (charset, "western") == 0))
+ {
+ logfont.lfCharSet = ANSI_CHARSET;
+ strcpy (charset, "western");
+ }
+ FROB (SYMBOL);
+ FROB (SHIFTJIS);
+ FROB (GB2312);
+ FROB (HANGEUL);
+ FROB (CHINESEBIG5);
+ FROB (JOHAB);
+ FROB (HEBREW);
+ FROB (ARABIC);
+ FROB (GREEK);
+ FROB (TURKISH);
+ FROB (THAI);
+ FROB (EASTEUROPE);
+ FROB (CENTRALEUROPEAN);
+ FROB (CYRILLIC);
+ FROB (MAC);
+ FROB (BALTIC);
+ else if (stricmp (charset, "oem/dos") == 0)
+ logfont.lfCharSet = OEM_CHARSET;
+ else
+ {
+ maybe_signal_simple_error ("Invalid charset", f->name, Qfont, errb);
+ return 0;
+ }
+
+#undef FROB
+
+ /* 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", f->name, Qfont, errb);
+ return 0;
+ }
+ }
+
+ /* Misc crud */
+ logfont.lfEscapement = logfont.lfOrientation = 0;
+#if 1
+ logfont.lfOutPrecision = OUT_DEFAULT_PRECIS;
+ logfont.lfClipPrecision = CLIP_DEFAULT_PRECIS;
+ logfont.lfQuality = DEFAULT_QUALITY;
+#else
+ logfont.lfOutPrecision = OUT_STROKE_PRECIS;
+ logfont.lfClipPrecision = CLIP_STROKE_PRECIS;
+ logfont.lfQuality = PROOF_QUALITY;
+#endif
+ /* Default to monospaced if the specified fontname doesn't exist.
+ * The match_font calls above should mean that this can't happen. */
+ logfont.lfPitchAndFamily = FF_MODERN;
+
+ if ((f->data = CreateFontIndirect(&logfont)) == NULL)
+ {
+ maybe_signal_simple_error ("Couldn't create font", f->name, Qfont, errb);
+ return 0;
+ }
+
+ {
+ HDC hdc;
+ HFONT holdfont;
+ TEXTMETRIC metrics;
+
+ hdc = CreateCompatibleDC (NULL);
+ if (hdc)
+ {
+ holdfont = SelectObject(hdc, f->data);
+ if (holdfont)
+ {
+ 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;
+ }
+ DeleteDC (hdc);
+ }
+ mswindows_finalize_font_instance (f);
+ maybe_signal_simple_error ("Couldn't map font", f->name, Qfont, errb);
+ }
+ return 0;
+}
+
+#if 0
+static void
+mswindows_mark_font_instance (struct Lisp_Font_Instance *f,
+ void (*markobj) (Lisp_Object))
+{
+}
+#endif
+
+static void
+mswindows_print_font_instance (struct Lisp_Font_Instance *f,
+ Lisp_Object printcharfun,
+ int escapeflag)
+{
+}
+
+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;
+
+ GET_C_STRING_CTEXT_DATA_ALLOCA (pattern, extpattern);
+ fontlist = DEVICE_MSWINDOWS_FONTLIST (XDEVICE (device));
+ while (fontlist)
+ {
+ if (match_font (fontlist->fontname, extpattern, fontname))
+ result = Fcons (build_string (fontname), result);
+ fontlist = fontlist->next;
+ }
+
+ return Fnreverse (result);
+}
+
+#ifdef MULE
+
+static int
+mswindows_font_spec_matches_charset (struct device *d, Lisp_Object charset,
+ CONST Bufbyte *nonreloc, Lisp_Object reloc,
+ Bytecount offset, Bytecount length)
+{
+ /* #### Implement me */
+ if (UNBOUNDP (charset))
+ return 1;
+
+ return 1;
+}
+
+/* find a font spec that matches font spec FONT and also matches
+ (the registry of) CHARSET. */
+static Lisp_Object
+mswindows_find_charset_font (Lisp_Object device, Lisp_Object font,
+ Lisp_Object charset)
+{
+ /* #### Implement me */
+ return build_string ("Courier New:Regular:10");
+}
+
+#endif /* MULE */
+
+\f
+/************************************************************************/
+/* non-methods */
+/************************************************************************/
+
+DEFUN ("mswindows-color-list", Fmswindows_color_list, 0, 0, 0, /*
+Return a list of the colors available on mswindows devices.
+*/
+ ())
+{
+ Lisp_Object result = Qnil;
+ int i;
+
+ for (i=0; i<countof (mswindows_X_color_map); i++)
+ result = Fcons (build_string (mswindows_X_color_map[i].name), result);
+
+ return Fnreverse (result);
+}
+
+
+\f
+/************************************************************************/
+/* initialization */
+/************************************************************************/
+
+void
+syms_of_objects_mswindows (void)
+{
+ DEFSUBR (Fmswindows_color_list);
+}
+
+void
+console_type_create_objects_mswindows (void)
+{
+ /* object methods */
+ CONSOLE_HAS_METHOD (mswindows, initialize_color_instance);
+/* CONSOLE_HAS_METHOD (mswindows, mark_color_instance); */
+ CONSOLE_HAS_METHOD (mswindows, print_color_instance);
+ CONSOLE_HAS_METHOD (mswindows, finalize_color_instance);
+ CONSOLE_HAS_METHOD (mswindows, color_instance_equal);
+ CONSOLE_HAS_METHOD (mswindows, color_instance_hash);
+ CONSOLE_HAS_METHOD (mswindows, color_instance_rgb_components);
+ CONSOLE_HAS_METHOD (mswindows, valid_color_name_p);
+
+ CONSOLE_HAS_METHOD (mswindows, initialize_font_instance);
+/* 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, list_fonts);
+#ifdef MULE
+ CONSOLE_HAS_METHOD (mswindows, font_spec_matches_charset);
+ CONSOLE_HAS_METHOD (mswindows, find_charset_font);
+#endif
+}
+
+void
+vars_of_objects_mswindows (void)
+{
+}
--- /dev/null
+/* TTY-specific Lisp objects.
+ Copyright (C) 1995 Board of Trustees, University of Illinois.
+ 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. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "console-tty.h"
+#include "insdel.h"
+#include "objects-tty.h"
+#ifdef MULE
+#include "device.h"
+#include "mule-charset.h"
+#endif
+
+/* An alist mapping from color names to a cons of (FG-STRING, BG-STRING). */
+Lisp_Object Vtty_color_alist;
+#if 0 /* This stuff doesn't quite work yet */
+Lisp_Object Vtty_dynamic_color_fg;
+Lisp_Object Vtty_dynamic_color_bg;
+#endif
+
+DEFUN ("register-tty-color", Fregister_tty_color, 3, 3, 0, /*
+Register COLOR as a recognized TTY color.
+COLOR should be a string.
+Strings FG-STRING and BG-STRING should specify the escape sequences to
+ set the foreground and background to the given color, respectively.
+*/
+ (color, fg_string, bg_string))
+{
+ CHECK_STRING (color);
+ CHECK_STRING (fg_string);
+ CHECK_STRING (bg_string);
+
+ color = Fintern (color, Qnil);
+ Vtty_color_alist = Fremassq (color, Vtty_color_alist);
+ Vtty_color_alist = Fcons (Fcons (color, Fcons (fg_string, bg_string)),
+ Vtty_color_alist);
+
+ return Qnil;
+}
+
+DEFUN ("unregister-tty-color", Funregister_tty_color, 1, 1, 0, /*
+Unregister COLOR as a recognized TTY color.
+*/
+ (color))
+{
+ CHECK_STRING (color);
+
+ color = Fintern (color, Qnil);
+ Vtty_color_alist = Fremassq (color, Vtty_color_alist);
+ return Qnil;
+}
+
+DEFUN ("find-tty-color", Ffind_tty_color, 1, 1, 0, /*
+Look up COLOR in the list of registered TTY colors.
+If it is found, return a list (FG-STRING BG-STRING) of the escape
+sequences used to set the foreground and background to the color, respectively.
+If it is not found, return nil.
+*/
+ (color))
+{
+ Lisp_Object result;
+
+ CHECK_STRING (color);
+
+ result = Fassq (Fintern (color, Qnil), Vtty_color_alist);
+ if (!NILP (result))
+ return list2 (Fcar (Fcdr (result)), Fcdr (Fcdr (result)));
+ else
+ return Qnil;
+}
+
+DEFUN ("tty-color-list", Ftty_color_list, 0, 0, 0, /*
+Return a list of the registered TTY colors.
+*/
+ ())
+{
+ Lisp_Object result = Qnil;
+ Lisp_Object rest;
+
+ LIST_LOOP (rest, Vtty_color_alist)
+ {
+ result = Fcons (Fsymbol_name (XCAR (XCAR (rest))), result);
+ }
+
+ return Fnreverse (result);
+}
+
+#if 0
+
+/* This approach is too simplistic. The problem is that the
+ dynamic color settings apply to *all* text in the default color,
+ not just the text output after the escape sequence has been given. */
+
+DEFUN ("set-tty-dynamic-color-specs", Fset_tty_dynamic_color_specs, 2, 2, 0, /*
+Set the dynamic color specifications for TTY's.
+FG and BG should be either nil or vaguely printf-like strings,
+where each occurrence of %s is replaced with the color name and each
+occurrence of %% is replaced with a single % character.
+*/
+ (fg, bg))
+{
+ if (!NILP (fg))
+ CHECK_STRING (fg);
+ if (!NILP (bg))
+ CHECK_STRING (bg);
+
+ Vtty_dynamic_color_fg = fg;
+ Vtty_dynamic_color_bg = bg;
+
+ return Qnil;
+}
+
+DEFUN ("tty-dynamic-color-specs", Ftty_dynamic_color_specs, 0, 0, 0, /*
+Return the dynamic color specifications for TTY's as a list of (FG BG).
+See `set-tty-dynamic-color-specs'.
+*/
+ ())
+{
+ return list2 (Vtty_dynamic_color_fg, Vtty_dynamic_color_bg);
+}
+
+#endif /* 0 */
+
+static int
+tty_initialize_color_instance (struct Lisp_Color_Instance *c, Lisp_Object name,
+ Lisp_Object device, Error_behavior errb)
+{
+ Lisp_Object result;
+
+ name = Fintern (name, Qnil);
+ result = assq_no_quit (name, Vtty_color_alist);
+
+ if (NILP (result))
+ {
+#if 0
+ if (!STRINGP (Vtty_dynamic_color_fg)
+ && !STRINGP (Vtty_dynamic_color_bg))
+#endif
+ return 0;
+ }
+
+ /* Don't allocate the data until we're sure that we will succeed. */
+ c->data = xnew (struct tty_color_instance_data);
+ COLOR_INSTANCE_TTY_SYMBOL (c) = name;
+
+ return 1;
+}
+
+static void
+tty_mark_color_instance (struct Lisp_Color_Instance *c,
+ void (*markobj) (Lisp_Object))
+{
+ ((markobj) (COLOR_INSTANCE_TTY_SYMBOL (c)));
+}
+
+static void
+tty_print_color_instance (struct Lisp_Color_Instance *c,
+ Lisp_Object printcharfun,
+ int escapeflag)
+{
+}
+
+static void
+tty_finalize_color_instance (struct 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,
+ int depth)
+{
+ return (EQ (COLOR_INSTANCE_TTY_SYMBOL (c1),
+ COLOR_INSTANCE_TTY_SYMBOL (c2)));
+}
+
+static unsigned long
+tty_color_instance_hash (struct Lisp_Color_Instance *c, int depth)
+{
+ return LISP_HASH (COLOR_INSTANCE_TTY_SYMBOL (c));
+}
+
+static int
+tty_valid_color_name_p (struct device *d, Lisp_Object color)
+{
+ return (!NILP (assoc_no_quit (Fintern (color, Qnil), Vtty_color_alist)));
+#if 0
+ || STRINGP (Vtty_dynamic_color_fg)
+ || STRINGP (Vtty_dynamic_color_bg)
+#endif
+}
+
+\f
+static int
+tty_initialize_font_instance (struct 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))
+ return 0;
+ str += 6;
+ if (*str)
+ {
+#ifdef MULE
+ if (*str != '/')
+ return 0;
+ str++;
+ charset = Ffind_charset (intern ((CONST char *) str));
+ if (NILP (charset))
+ return 0;
+#else
+ return 0;
+#endif
+ }
+
+ /* Don't allocate the data until we're sure that we will succeed. */
+ f->data = xnew (struct tty_font_instance_data);
+ FONT_INSTANCE_TTY_CHARSET (f) = charset;
+#ifdef MULE
+ if (CHARSETP (charset))
+ f->width = XCHARSET_COLUMNS (charset);
+ else
+#endif
+ f->width = 1;
+
+ f->proportional_p = 0;
+ f->ascent = f->height = 1;
+ f->descent = 0;
+
+ return 1;
+}
+
+static void
+tty_mark_font_instance (struct Lisp_Font_Instance *f,
+ void (*markobj) (Lisp_Object))
+{
+ ((markobj) (FONT_INSTANCE_TTY_CHARSET (f)));
+}
+
+static void
+tty_print_font_instance (struct Lisp_Font_Instance *f,
+ Lisp_Object printcharfun,
+ int escapeflag)
+{
+}
+
+static void
+tty_finalize_font_instance (struct Lisp_Font_Instance *f)
+{
+ if (f->data)
+ xfree (f->data);
+}
+
+static Lisp_Object
+tty_list_fonts (Lisp_Object pattern, Lisp_Object device)
+{
+ return list1 (build_string ("normal"));
+}
+
+#ifdef MULE
+
+static int
+tty_font_spec_matches_charset (struct device *d, Lisp_Object charset,
+ CONST Bufbyte *nonreloc, Lisp_Object reloc,
+ Bytecount offset, Bytecount length)
+{
+ CONST Bufbyte *the_nonreloc = nonreloc;
+
+ if (!the_nonreloc)
+ the_nonreloc = XSTRING_DATA (reloc);
+ fixup_internal_substring (nonreloc, reloc, offset, &length);
+ the_nonreloc += offset;
+
+ if (UNBOUNDP (charset))
+ return !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));
+ }
+}
+
+/* find a font spec that matches font spec FONT and also matches
+ (the registry of) CHARSET. */
+static Lisp_Object
+tty_find_charset_font (Lisp_Object device, Lisp_Object font,
+ Lisp_Object charset)
+{
+ Bufbyte *fontname = XSTRING_DATA (font);
+
+ if (strchr ((CONST char *) fontname, '/'))
+ {
+ if (tty_font_spec_matches_charset (XDEVICE (device), charset, 0,
+ font, 0, -1))
+ return font;
+ return Qnil;
+ }
+
+ if (UNBOUNDP (charset))
+ return font;
+
+ return concat3 (font, build_string ("/"),
+ Fsymbol_name (XCHARSET_NAME (charset)));
+}
+
+#endif /* MULE */
+
+\f
+/************************************************************************/
+/* initialization */
+/************************************************************************/
+
+void
+syms_of_objects_tty (void)
+{
+ DEFSUBR (Fregister_tty_color);
+ DEFSUBR (Funregister_tty_color);
+ DEFSUBR (Ffind_tty_color);
+ DEFSUBR (Ftty_color_list);
+#if 0
+ DEFSUBR (Fset_tty_dynamic_color_specs);
+ DEFSUBR (Ftty_dynamic_color_specs);
+#endif
+}
+
+void
+console_type_create_objects_tty (void)
+{
+ /* object methods */
+ CONSOLE_HAS_METHOD (tty, initialize_color_instance);
+ CONSOLE_HAS_METHOD (tty, mark_color_instance);
+ CONSOLE_HAS_METHOD (tty, print_color_instance);
+ CONSOLE_HAS_METHOD (tty, finalize_color_instance);
+ CONSOLE_HAS_METHOD (tty, color_instance_equal);
+ CONSOLE_HAS_METHOD (tty, color_instance_hash);
+ CONSOLE_HAS_METHOD (tty, valid_color_name_p);
+
+ CONSOLE_HAS_METHOD (tty, initialize_font_instance);
+ CONSOLE_HAS_METHOD (tty, mark_font_instance);
+ CONSOLE_HAS_METHOD (tty, print_font_instance);
+ CONSOLE_HAS_METHOD (tty, finalize_font_instance);
+ CONSOLE_HAS_METHOD (tty, list_fonts);
+#ifdef MULE
+ CONSOLE_HAS_METHOD (tty, font_spec_matches_charset);
+ CONSOLE_HAS_METHOD (tty, find_charset_font);
+#endif
+}
+
+void
+vars_of_objects_tty (void)
+{
+ staticpro (&Vtty_color_alist);
+ Vtty_color_alist = Qnil;
+
+#if 0
+ staticpro (&Vtty_dynamic_color_fg);
+ Vtty_dynamic_color_fg = Qnil;
+
+ staticpro (&Vtty_dynamic_color_bg);
+ Vtty_dynamic_color_bg = Qnil;
+#endif
+}
--- /dev/null
+/* mswindows output and frame manipulation routines.
+ Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
+ Copyright (C) 1994 Lucid, 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: Not in FSF. */
+
+/* Authorship:
+
+ Chuck Thompson
+ Lots of work done by Ben Wing for Mule
+ Partially rewritten for mswindows by Jonathan Harris, November 1997 for 21.0.
+ */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "console-msw.h"
+#include "objects-msw.h"
+
+#include "buffer.h"
+#include "debug.h"
+#include "events.h"
+#include "faces.h"
+#include "frame.h"
+#include "glyphs-msw.h"
+#include "redisplay.h"
+#include "sysdep.h"
+#include "window.h"
+
+#include "windows.h"
+#ifdef MULE
+#include "mule-ccl.h"
+#include "mule-charset.h"
+#endif
+
+#define MSWINDOWS_EOL_CURSOR_WIDTH 5
+
+/*
+ * Random forward delarations
+ */
+static void mswindows_update_dc (HDC hdc, Lisp_Object font, Lisp_Object fg,
+ Lisp_Object bg, Lisp_Object bg_pmap);
+static void mswindows_clear_region (Lisp_Object locale, face_index findex,
+ int x, int y, int width, int height);
+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);
+
+typedef struct textual_run
+{
+ Lisp_Object charset;
+ unsigned char *ptr;
+ int len;
+ int dimension;
+} textual_run;
+
+/* Separate out the text in DYN into a series of textual runs of a
+ particular charset. Also convert the characters as necessary into
+ the format needed by XDrawImageString(), XDrawImageString16(), et
+ al. (This means converting to one or two byte format, possibly
+ tweaking the high bits, and possibly running a CCL program.) You
+ must pre-allocate the space used and pass it in. (This is done so
+ you can alloca() the space.) You need to allocate (2 * len) bytes
+ of TEXT_STORAGE and (len * sizeof (textual_run)) bytes of
+ RUN_STORAGE, where LEN is the length of the dynarr.
+
+ Returns the number of runs actually used. */
+
+static int
+separate_textual_runs (unsigned char *text_storage,
+ textual_run *run_storage,
+ CONST Emchar *str, Charcount len)
+{
+ Lisp_Object prev_charset = Qunbound; /* not Qnil because that is a
+ possible valid charset when
+ MULE is not defined */
+ int runs_so_far = 0;
+ int i;
+#ifdef MULE
+ struct ccl_program char_converter;
+ int need_ccl_conversion = 0;
+#endif
+
+ for (i = 0; i < len; i++)
+ {
+ Emchar ch = str[i];
+ Lisp_Object charset;
+ int byte1, byte2;
+ int dimension;
+ int graphic;
+
+ BREAKUP_CHAR (ch, charset, byte1, byte2);
+ dimension = XCHARSET_DIMENSION (charset);
+ graphic = XCHARSET_GRAPHIC (charset);
+
+ if (!EQ (charset, prev_charset))
+ {
+ run_storage[runs_so_far].ptr = text_storage;
+ run_storage[runs_so_far].charset = charset;
+ run_storage[runs_so_far].dimension = dimension;
+
+ if (runs_so_far)
+ {
+ run_storage[runs_so_far - 1].len =
+ text_storage - run_storage[runs_so_far - 1].ptr;
+ if (run_storage[runs_so_far - 1].dimension == 2)
+ run_storage[runs_so_far - 1].len >>= 1;
+ }
+ runs_so_far++;
+ prev_charset = charset;
+#ifdef MULE
+ {
+ Lisp_Object ccl_prog = XCHARSET_CCL_PROGRAM (charset);
+ need_ccl_conversion = !NILP (ccl_prog);
+ if (need_ccl_conversion)
+ setup_ccl_program (&char_converter, ccl_prog);
+ }
+#endif
+ }
+
+ if (graphic == 0)
+ {
+ byte1 &= 0x7F;
+ byte2 &= 0x7F;
+ }
+ else if (graphic == 1)
+ {
+ byte1 |= 0x80;
+ byte2 |= 0x80;
+ }
+#ifdef MULE
+ if (need_ccl_conversion)
+ {
+ char_converter.reg[0] = XCHARSET_ID (charset);
+ 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);
+ byte1 = char_converter.reg[1];
+ byte2 = char_converter.reg[2];
+ }
+#endif
+ *text_storage++ = (unsigned char) byte1;
+ if (dimension == 2)
+ *text_storage++ = (unsigned char) byte2;
+ }
+
+ if (runs_so_far)
+ {
+ run_storage[runs_so_far - 1].len =
+ text_storage - run_storage[runs_so_far - 1].ptr;
+ if (run_storage[runs_so_far - 1].dimension == 2)
+ run_storage[runs_so_far - 1].len >>= 1;
+ }
+
+ return runs_so_far;
+}
+
+
+static int
+mswindows_text_width_single_run (HDC hdc, struct face_cachel *cachel,
+ textual_run *run)
+{
+ Lisp_Object font_inst = FACE_CACHEL_FONT (cachel, run->charset);
+ struct Lisp_Font_Instance *fi = XFONT_INSTANCE (font_inst);
+ SIZE size;
+
+ if (!fi->proportional_p || !hdc)
+ return (fi->width * run->len);
+ else
+ {
+ assert(run->dimension == 1); /* #### FIXME! */
+ mswindows_update_dc (hdc, font_inst, Qnil, Qnil, Qnil);
+ GetTextExtentPoint32 (hdc, run->ptr, run->len, &size);
+ return(size.cx);
+ }
+}
+
+
+/*****************************************************************************
+ mswindows_update_dc
+
+ 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)
+{
+ 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);
+ SetBkColor (hdc, COLOR_INSTANCE_MSWINDOWS_COLOR (XCOLOR_INSTANCE (bg)));
+ }
+ else
+ {
+ SetBkMode (hdc, TRANSPARENT);
+ }
+}
+
+
+/*****************************************************************************
+ 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)
+{
+ 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);
+ }
+}
+
+
+/*****************************************************************************
+ mswindows_output_hline
+
+ Output a horizontal line in the foreground of its face.
+ ****************************************************************************/
+static void
+mswindows_output_hline (struct window *w, struct display_line *dl, struct rune *rb)
+{ /* XXX Implement me */
+}
+
+
+/*****************************************************************************
+ mswindows_output_blank
+
+ Output a blank by clearing the area it covers in the background color
+ of its face.
+ ****************************************************************************/
+static void
+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 };
+ struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, rb->findex);
+
+ Lisp_Object bg_pmap = WINDOW_FACE_CACHEL_BACKGROUND_PIXMAP (w, rb->findex);
+
+ if (!IMAGE_INSTANCEP (bg_pmap)
+ || !IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap)))
+ bg_pmap = Qnil;
+
+ if (!NILP(bg_pmap))
+ {
+ /* blank the background in the appropriate color */
+ mswindows_update_dc (FRAME_MSWINDOWS_DC (f), Qnil, 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,
+ 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_output_cursor
+
+ Draw a normal or end-of-line cursor. The end-of-line cursor is
+ narrower than the normal cursor.
+ ****************************************************************************/
+static void
+mswindows_output_cursor (struct window *w, struct display_line *dl, int xpos,
+ int width, face_index findex, Emchar ch, int image_p)
+{
+ struct frame *f = XFRAME (w->frame);
+ struct device *d = XDEVICE (f->device);
+ struct face_cachel *cachel;
+ 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;
+ char *p_char = NULL;
+ int n_char = 0;
+ RECT rect = { xpos,
+ dl->ypos - dl->ascent,
+ xpos + width,
+ dl->ypos + dl->descent - dl->clip};
+ 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;
+
+ if (real_char_p)
+ {
+ /* Use the font from the underlying character */
+ cachel = WINDOW_FACE_CACHEL (w, findex);
+
+ /* #### MULE: Need to know the charset! */
+ font = FACE_CACHEL_FONT (cachel, Vcharset_ascii);
+ }
+
+ if ((focus || bar_p) && real_char_p)
+ {
+ p_char = (char*) &ch;
+ n_char = 1;
+ }
+
+ if (!image_p)
+ {
+ struct face_cachel *color_cachel;
+
+ /* 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);
+ color_cachel = WINDOW_FACE_CACHEL (w, ((!cursor_p || bar_p) ?
+ findex : face_index));
+ mswindows_update_dc (hdc, font, color_cachel->foreground,
+ color_cachel->background, Qnil);
+ 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)
+ return;
+
+ 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);
+ ExtTextOut (hdc, xpos, dl->ypos, ETO_OPAQUE, &rect, NULL, 0, NULL);
+ }
+ else if (!focus)
+ {
+ /* Now have real character drawn in its own color. We deflate
+ the rectangle so character cell will be bounded by the
+ previously drawn cursor shape */
+ InflateRect (&rect, -1, -1);
+
+ if (real_char_p)
+ {
+ p_char = (char*) &ch;
+ 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);
+ 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);
+ }
+}
+
+
+/*****************************************************************************
+ mswindows_output_string
+
+ Given a string and a starting position, output that string in the
+ given face.
+ Correctly handles multiple charsets in the string.
+
+ The meaning of the parameters is something like this:
+
+ W Window that the text is to be displayed in.
+ DL Display line that this text is on. The values in the
+ structure are used to determine the vertical position and
+ clipping range of the text.
+ BUF Dynamic array of Emchars specifying what is actually to be
+ drawn.
+ XPOS X position in pixels where the text should start being drawn.
+ XOFFSET Number of pixels to be chopped off the left side of the
+ text. The effect is as if the text were shifted to the
+ left this many pixels and clipped at XPOS.
+ CLIP_START Clip everything left of this X position.
+ WIDTH Clip everything right of XPOS + WIDTH.
+ FINDEX Index for the face cache element describing how to display
+ the text.
+ ****************************************************************************/
+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)
+{
+ struct frame *f = XFRAME (w->frame);
+ /* struct device *d = XDEVICE (f->device);*/
+ Lisp_Object window;
+ HDC hdc = FRAME_MSWINDOWS_DC (f);
+ int clip_end;
+ Lisp_Object bg_pmap;
+ int len = Dynarr_length (buf);
+ unsigned char *text_storage = (unsigned char *) alloca (2 * len);
+ textual_run *runs = alloca_array (textual_run, len);
+ int nruns;
+ int i, height;
+ RECT rect;
+ struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, findex);
+
+ XSETWINDOW (window, w);
+
+#if 0 /* #### FIXME? */
+ /* We can't work out the width before we've set the font in the DC */
+ if (width < 0)
+ width = mswindows_text_width (cachel, Dynarr_atp (buf, 0), Dynarr_length (buf));
+#else
+ assert(width>=0);
+#endif
+
+ /* Regularize the variables passed in. */
+ if (clip_start < xpos)
+ clip_start = xpos;
+ clip_end = xpos + width;
+ if (clip_start >= clip_end)
+ /* It's all clipped out. */
+ return;
+
+ xpos -= xoffset;
+
+ /* sort out the destination rectangle */
+ height = dl->ascent + dl->descent - dl->clip;
+ rect.left = clip_start;
+ rect.top = dl->ypos - dl->ascent;
+ rect.right = clip_end;
+ rect.bottom = height + dl->ypos - dl->ascent;
+
+ /* output the background pixmap if there is one */
+ bg_pmap = cachel->background_pixmap;
+ if (!IMAGE_INSTANCEP (bg_pmap)
+ || !IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap)))
+ bg_pmap = Qnil;
+
+ if (!NILP(bg_pmap))
+ {
+ /* 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,
+ 0, 0, 0, TRUE);
+ /* output pixmap calls this so we have to recall to get correct
+ references */
+ cachel = WINDOW_FACE_CACHEL (w, findex);
+ }
+
+ nruns = separate_textual_runs (text_storage, runs, Dynarr_atp (buf, 0),
+ Dynarr_length (buf));
+
+ for (i = 0; i < nruns; i++)
+ {
+ Lisp_Object font = FACE_CACHEL_FONT (cachel, runs[i].charset);
+ struct 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,
+ NILP(bg_pmap) ? cachel->background : Qnil, Qnil);
+
+ 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))
+ {
+ int clear_start = max (xpos, clip_start);
+ int clear_end = min (xpos + this_width, clip_end);
+
+ {
+ mswindows_clear_region (window, findex, clear_start,
+ dl->ypos - dl->ascent,
+ clear_end - clear_start,
+ height);
+ /* output pixmap calls this so we have to recall to get correct
+ references */
+ cachel = WINDOW_FACE_CACHEL (w, findex);
+ }
+ }
+
+ assert (runs[i].dimension == 1); /* #### FIXME: Broken when Mule? */
+ ExtTextOut (hdc, xpos, dl->ypos,
+ 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)
+{
+ HDC hdc = FRAME_MSWINDOWS_DC (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))
+ {
+ RGBQUAD col;
+ col.rgbBlue = GetBValue (bgcolor);
+ col.rgbRed = GetRValue (bgcolor);
+ col.rgbGreen = GetGValue (bgcolor);
+ col.rgbReserved = 0;
+
+ old = SelectObject (FRAME_MSWINDOWS_CDC (f),
+ IMAGE_INSTANCE_MSWINDOWS_MASK (p));
+
+ SetDIBColorTable (FRAME_MSWINDOWS_CDC (f), 1, 1, &col);
+
+ BitBlt (hdc,
+ x,y,
+ width, height,
+ FRAME_MSWINDOWS_CDC (f),
+ xoffset,yoffset,
+ SRCCOPY);
+
+ SelectObject (FRAME_MSWINDOWS_CDC (f), old);
+ }
+
+ /* now blt the bitmap itself. */
+ old = SelectObject (FRAME_MSWINDOWS_CDC (f),
+ IMAGE_INSTANCE_MSWINDOWS_BITMAP (p));
+
+ BitBlt (hdc,
+ x,y,
+ width, height,
+ FRAME_MSWINDOWS_CDC (f),
+ xoffset, yoffset,
+ IMAGE_INSTANCE_MSWINDOWS_MASK (p) ? SRCINVERT : SRCCOPY);
+
+ SelectObject (FRAME_MSWINDOWS_CDC (f),old);
+
+ if (need_clipping)
+ {
+ }
+}
+
+/*
+ * 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
+ */
+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)
+{
+ int pwidth = min (width, IMAGE_INSTANCE_PIXMAP_WIDTH (p));
+ int pheight = min (height, IMAGE_INSTANCE_PIXMAP_HEIGHT (p));
+ int pxoffset = 0, pyoffset = 0;
+
+ /* when doing a bg pixmap do a partial pixmap first so that we
+ blt whole pixmaps thereafter */
+
+ if (offset_bitmap)
+ {
+ pheight = min (pheight, IMAGE_INSTANCE_PIXMAP_HEIGHT (p) -
+ y % IMAGE_INSTANCE_PIXMAP_HEIGHT (p));
+ }
+
+ while (pheight > 0)
+ {
+ if (offset_bitmap)
+ {
+ pwidth = min (min (width, IMAGE_INSTANCE_PIXMAP_WIDTH (p)),
+ IMAGE_INSTANCE_PIXMAP_WIDTH (p) -
+ x % IMAGE_INSTANCE_PIXMAP_WIDTH (p));
+ pxoffset = 0;
+ }
+ 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));
+ }
+}
+
+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)
+{
+ struct frame *f = XFRAME (w->frame);
+ HDC hdc = FRAME_MSWINDOWS_DC (f);
+
+ struct Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance);
+ Lisp_Object window;
+
+ int lheight = dl->ascent + dl->descent - dl->clip;
+ 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
+
+ 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 */
+ mswindows_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,
+ 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);
+}
+
+#ifdef HAVE_SCROLLBARS
+/*
+ * This function paints window's deadbox, a rectangle between window
+ * borders and two short edges of both scrollbars.
+ *
+ * Function checks whether deadbox intersects with the rectangle pointed
+ * to by PRC, and paints only the intersection
+ */
+static void
+mswindows_redisplay_deadbox_maybe (struct window *w, CONST RECT* prc)
+{
+ int sbh = window_scrollbar_height (w);
+ int sbw = window_scrollbar_width (w);
+ RECT rect_dead, rect_paint;
+ if (sbh == 0 || sbw == 0)
+ return;
+
+ if (!NILP (w->scrollbar_on_left_p))
+ rect_dead.left = WINDOW_LEFT (w);
+ else
+ rect_dead.left = WINDOW_TEXT_RIGHT (w);
+ rect_dead.right = rect_dead.left + sbw;
+
+ if (!NILP (w->scrollbar_on_top_p))
+ rect_dead.top = WINDOW_TOP (w);
+ else
+ rect_dead.top = WINDOW_TEXT_BOTTOM (w);
+ rect_dead.bottom = rect_dead.top + sbh;
+
+ if (IntersectRect (&rect_paint, &rect_dead, prc))
+ {
+ struct frame *f = XFRAME (WINDOW_FRAME (w));
+ FillRect (FRAME_MSWINDOWS_DC (f), &rect_paint,
+ (HBRUSH) (COLOR_BTNFACE+1));
+ }
+}
+
+#endif /* HAVE_SCROLLBARS */
+
+/*****************************************************************************
+ mswindows_redraw_exposed_window
+
+ Given a bounding box for an area that needs to be redrawn, determine
+ what parts of what lines are contained within and re-output their
+ contents.
+ Copied from redisplay-x.c
+ ****************************************************************************/
+static void
+mswindows_redraw_exposed_window (struct window *w, int x, int y, int width,
+ int height)
+{
+ struct frame *f = XFRAME (w->frame);
+ int line;
+ int orig_windows_structure_changed;
+ RECT rect_window = { WINDOW_LEFT (w), WINDOW_TOP (w),
+ WINDOW_RIGHT (w), WINDOW_BOTTOM (w) };
+ RECT rect_expose = { x, y, x + width, y + height };
+ RECT rect_draw;
+
+ display_line_dynarr *cdla = window_display_lines (w, CURRENT_DISP);
+
+ if (!NILP (w->vchild))
+ {
+ mswindows_redraw_exposed_windows (w->vchild, x, y, width, height);
+ return;
+ }
+ else if (!NILP (w->hchild))
+ {
+ mswindows_redraw_exposed_windows (w->hchild, x, y, width, height);
+ return;
+ }
+
+ /* If the window doesn't intersect the exposed region, we're done here. */
+ if (!IntersectRect (&rect_draw, &rect_window, &rect_expose))
+ return;
+
+ /* We do this to make sure that the 3D modelines get redrawn if
+ they are in the exposed region. */
+ orig_windows_structure_changed = f->windows_structure_changed;
+ f->windows_structure_changed = 1;
+
+ if (window_needs_vertical_divider (w))
+ {
+ mswindows_output_vertical_divider (w, 0);
+ }
+
+ 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 (top_y > rect_draw.bottom)
+ {
+ if (line == 0)
+ continue;
+ else
+ break;
+ }
+ else
+ {
+ output_display_line (w, 0, cdla, line,
+ rect_draw.left, rect_draw.right);
+ }
+ }
+ }
+
+ f->windows_structure_changed = orig_windows_structure_changed;
+
+ /* If there have never been any face cache_elements created, then this
+ expose event doesn't actually have anything to do. */
+ if (Dynarr_largest (w->face_cachels))
+ redisplay_clear_bottom_of_window (w, cdla, rect_draw.top, rect_draw.bottom);
+
+#ifdef HAVE_SCROLLBARS
+ mswindows_redisplay_deadbox_maybe (w, &rect_expose);
+#endif
+}
+
+/*****************************************************************************
+ mswindows_redraw_exposed_windows
+
+ For each window beneath the given window in the window hierarchy,
+ ensure that it is redrawn if necessary after an Expose event.
+ ****************************************************************************/
+static void
+mswindows_redraw_exposed_windows (Lisp_Object window, int x, int y, int width,
+ int height)
+{
+ for (; !NILP (window); window = XWINDOW (window)->next)
+ mswindows_redraw_exposed_window (XWINDOW (window), x, y, width, height);
+}
+
+/*****************************************************************************
+ mswindows_redraw_exposed_area
+
+ For each window on the given frame, ensure that any area in the
+ Exposed area is redrawn.
+ ****************************************************************************/
+void
+mswindows_redraw_exposed_area (struct frame *f, int x, int y, int width, int height)
+{
+ /* If any window on the frame has had its face cache reset then the
+ redisplay structures are effectively invalid. If we attempt to
+ use them we'll blow up. We mark the frame as changed to ensure
+ that redisplay will do a full update. This probably isn't
+ necessary but it can't hurt. */
+#ifdef HAVE_TOOLBARS
+ /* #### We would rather put these off as well but there is currently
+ no combination of flags which will force an unchanged toolbar to
+ redraw anyhow. */
+ MAYBE_FRAMEMETH (f, redraw_exposed_toolbars, (f, x, y, width, height));
+#endif
+
+ if (!f->window_face_cache_reset)
+ {
+ mswindows_redraw_exposed_windows (f->root_window, x, y, width, height);
+ GdiFlush();
+ }
+ else
+ MARK_FRAME_CHANGED (f);
+}
+
+
+/*****************************************************************************
+ mswindows_bevel_modeline
+
+ Draw a 3d border around the modeline on window W.
+ ****************************************************************************/
+static void
+mswindows_bevel_modeline (struct window *w, struct display_line *dl)
+{
+ 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);
+
+ if (XINT (w->modeline_shadow_thickness) < 0)
+ shadow_width = -shadow_width;
+
+ 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);
+}
+
+\f
+/*****************************************************************************
+ Display methods
+*****************************************************************************/
+
+/*****************************************************************************
+ mswindows_divider_height
+
+ Return the height of the horizontal divider.
+ ****************************************************************************/
+static int
+mswindows_divider_height (void)
+{
+ return 1; /* XXX Copied from redisplay-X.c. What is this? */
+}
+
+/*****************************************************************************
+ mswindows_eol_cursor_width
+
+ Return the width of the end-of-line cursor.
+ ****************************************************************************/
+static int
+mswindows_eol_cursor_width (void)
+{
+ return MSWINDOWS_EOL_CURSOR_WIDTH;
+}
+
+/*****************************************************************************
+ mswindows_output_begin
+
+ Perform any necessary initialization prior to an update.
+ ****************************************************************************/
+static void
+mswindows_output_begin (struct device *d)
+{
+}
+
+/*****************************************************************************
+ mswindows_output_end
+
+ Perform any necessary flushing of queues when an update has completed.
+ ****************************************************************************/
+static void
+mswindows_output_end (struct device *d)
+{
+ GdiFlush();
+}
+
+static int
+mswindows_flash (struct device *d)
+{
+ struct frame *f = device_selected_frame (d);
+ RECT rc;
+
+ GetClientRect (FRAME_MSWINDOWS_HANDLE (f), &rc);
+ InvertRect (FRAME_MSWINDOWS_DC (f), &rc);
+ GdiFlush ();
+ Sleep (25);
+ InvertRect (FRAME_MSWINDOWS_DC (f), &rc);
+
+ return 1;
+}
+
+static void
+mswindows_ring_bell (struct device *d, int volume, int pitch, int duration)
+{
+ /* Beep does not work at all, anyways! -kkm */
+ MessageBeep (MB_OK);
+}
+
+/*****************************************************************************
+ mswindows_output_display_block
+
+ Given a display line, a block number for that start line, output all
+ runes between start and end in the specified display block.
+ Ripped off with mininmal thought from the corresponding X routine.
+ ****************************************************************************/
+static void
+mswindows_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_height)
+{
+ struct frame *f = XFRAME (w->frame);
+ Emchar_dynarr *buf = Dynarr_new (Emchar);
+ Lisp_Object window;
+
+ struct display_block *db = Dynarr_atp (dl->display_blocks, block);
+ rune_dynarr *rba = db->runes;
+ struct rune *rb;
+
+ int elt = start;
+ face_index findex;
+ int xpos, width;
+ Lisp_Object charset = Qunbound; /* Qnil is a valid charset when
+ MULE is not defined */
+ XSETWINDOW (window, w);
+ 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);
+ }
+
+ if (end < 0)
+ end = Dynarr_length (rba);
+ Dynarr_reset (buf);
+
+ while (elt < end)
+ {
+ rb = Dynarr_atp (rba, elt);
+
+ if (rb->findex == findex && rb->type == RUNE_CHAR
+ && rb->object.chr.ch != '\n' && rb->cursor_type != CURSOR_ON
+ && EQ (charset, CHAR_CHARSET (rb->object.chr.ch)))
+ {
+ Dynarr_add (buf, rb->object.chr.ch);
+ width += rb->width;
+ elt++;
+ }
+ else
+ {
+ if (Dynarr_length (buf))
+ {
+ mswindows_output_string (w, dl, buf, xpos, 0, start_pixpos, width,
+ findex);
+ xpos = rb->xpos;
+ width = 0;
+ }
+ Dynarr_reset (buf);
+ width = 0;
+
+ if (rb->type == RUNE_CHAR)
+ {
+ findex = rb->findex;
+ xpos = rb->xpos;
+ charset = CHAR_CHARSET (rb->object.chr.ch);
+
+ if (rb->cursor_type == CURSOR_ON)
+ {
+ if (rb->object.chr.ch == '\n')
+ {
+ mswindows_output_cursor (w, dl, xpos, cursor_width,
+ findex, 0, 0);
+ }
+ else
+ {
+ Dynarr_add (buf, rb->object.chr.ch);
+ mswindows_output_cursor (w, dl, xpos, cursor_width,
+ findex, rb->object.chr.ch, 0);
+ Dynarr_reset (buf);
+ }
+
+ xpos += rb->width;
+ elt++;
+ }
+ else if (rb->object.chr.ch == '\n')
+ {
+ /* Clear in case a cursor was formerly here. */
+ int height = dl->ascent + dl->descent - dl->clip;
+
+ mswindows_clear_region (window, findex, xpos, dl->ypos - dl->ascent,
+ rb->width, height);
+ elt++;
+ }
+ }
+ else if (rb->type == RUNE_BLANK || rb->type == RUNE_HLINE)
+ {
+ if (rb->type == RUNE_BLANK)
+ mswindows_output_blank (w, dl, rb, start_pixpos);
+ else
+ {
+ /* #### Our flagging of when we need to redraw the
+ modeline shadows sucks. Since RUNE_HLINE is only used
+ by the modeline at the moment it is a good bet
+ that if it gets redrawn then we should also
+ redraw the shadows. This won't be true forever.
+ We borrow the shadow_thickness_changed flag for
+ now. */
+ w->shadow_thickness_changed = 1;
+ mswindows_output_hline (w, dl, rb);
+ }
+
+ if (rb->cursor_type == CURSOR_ON)
+ mswindows_output_cursor (w, dl, xpos, cursor_width, rb->findex, 0, 0);
+
+ elt++;
+ if (elt < end)
+ {
+ rb = Dynarr_atp (rba, elt);
+
+ findex = rb->findex;
+ xpos = rb->xpos;
+ }
+ }
+ else if (rb->type == RUNE_DGLYPH)
+ {
+ Lisp_Object instance;
+
+ XSETWINDOW (window, w);
+ instance = glyph_image_instance (rb->object.dglyph.glyph,
+ window, ERROR_ME_NOT, 1);
+ findex = rb->findex;
+
+ if (IMAGE_INSTANCEP (instance))
+ switch (XIMAGE_INSTANCE_TYPE (instance))
+ {
+ case IMAGE_TEXT:
+ {
+ /* #### This is way losing. See the comment in
+ add_glyph_rune(). */
+ Lisp_Object string =
+ XIMAGE_INSTANCE_TEXT_STRING (instance);
+ convert_bufbyte_string_into_emchar_dynarr
+ (XSTRING_DATA (string), XSTRING_LENGTH (string), buf);
+
+ if (rb->cursor_type == CURSOR_ON)
+ mswindows_output_cursor (w, dl, xpos, cursor_width,
+ findex, Dynarr_at (buf, 0), 0);
+ 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);
+ 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);
+ if (rb->cursor_type == CURSOR_ON)
+ mswindows_output_cursor (w, dl, xpos, cursor_width,
+ findex, 0, 1);
+ break;
+
+ case IMAGE_POINTER:
+ abort ();
+
+ case IMAGE_SUBWINDOW:
+ /* #### implement me */
+ break;
+
+ case IMAGE_NOTHING:
+ /* nothing is as nothing does */
+ break;
+
+ default:
+ abort ();
+ }
+
+ xpos += rb->width;
+ elt++;
+ }
+ else
+ abort ();
+ }
+ }
+
+ if (Dynarr_length (buf))
+ mswindows_output_string (w, dl, buf, xpos, 0, start_pixpos, width, findex);
+
+ if (dl->modeline
+ && !EQ (Qzero, w->modeline_shadow_thickness)
+ && (f->clear
+ || f->windows_structure_changed
+ || w->shadow_thickness_changed))
+ mswindows_bevel_modeline (w, dl);
+
+ Dynarr_free (buf);
+}
+
+
+/*****************************************************************************
+ mswindows_output_vertical_divider
+
+ Draw a vertical divider down the right side of the given window.
+ ****************************************************************************/
+static void
+mswindows_output_vertical_divider (struct window *w, int clear_unused)
+{
+ struct frame *f = XFRAME (w->frame);
+ 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);
+
+ /* 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,
+ 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,
+ &rect, NULL, 0, NULL);
+ rect.left = div_left;
+ rect.right = div_left + spacing;
+ ExtTextOut (FRAME_MSWINDOWS_DC (f), 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.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,
+ WINDOW_FACE_CACHEL_BACKGROUND (w, div_face), Qnil);
+ ExtTextOut (FRAME_MSWINDOWS_DC (f), 0, 0, ETO_OPAQUE,
+ &rect, NULL, 0, NULL);
+ }
+
+ /* Draw a shadow around the divider */
+ if (shadow != 0)
+ {
+ /* #### This will be fixed to support arbitrary thichkness */
+ InflateRect (&rect, abs_shadow, abs_shadow);
+ DrawEdge (FRAME_MSWINDOWS_DC (f), &rect,
+ shadow > 0 ? EDGE_RAISED : EDGE_SUNKEN, BF_RECT);
+ }
+}
+
+/****************************************************************************
+ mswindows_text_width
+
+ Given a string and a face, return the string's length in pixels when
+ displayed in the font associated with the face.
+ ****************************************************************************/
+static int
+mswindows_text_width (struct frame *f, struct face_cachel *cachel,
+ CONST Emchar *str, Charcount len)
+{
+ int width_so_far = 0;
+ unsigned char *text_storage = (unsigned char *) alloca (2 * len);
+ textual_run *runs = alloca_array (textual_run, len);
+ int nruns;
+ int i;
+
+ 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),
+ cachel, runs + i);
+
+ return width_so_far;
+}
+
+
+/****************************************************************************
+ mswindows_clear_region
+
+ Clear the area in the box defined by the given parameters using the
+ given face.
+ ****************************************************************************/
+static void
+mswindows_clear_region (Lisp_Object locale, face_index findex, int x, int y,
+ int width, int height)
+{
+ struct window *w;
+ struct frame *f;
+ Lisp_Object background_pixmap = Qunbound;
+ Lisp_Object temp;
+ RECT rect = { x, y, x+width, y+height };
+
+ if (!(width && height)) /* We often seem to get called with width==0 */
+ return;
+
+ if (WINDOWP (locale))
+ {
+ w = XWINDOW (locale);
+ f = XFRAME (w->frame);
+ }
+ else if (FRAMEP (locale))
+ {
+ w = NULL;
+ f = XFRAME (locale);
+ }
+ else
+ abort ();
+
+ if (w)
+ {
+ temp = WINDOW_FACE_CACHEL_BACKGROUND_PIXMAP (w, findex);
+
+ if (IMAGE_INSTANCEP (temp)
+ && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (temp)))
+ {
+ /* #### maybe we could implement such that a string
+ can be a background pixmap? */
+ background_pixmap = temp;
+ }
+ }
+ 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))
+ {
+ Lisp_Object fcolor, bcolor;
+
+ if (w)
+ {
+ fcolor = WINDOW_FACE_CACHEL_FOREGROUND (w, findex);
+ bcolor = WINDOW_FACE_CACHEL_BACKGROUND (w, findex);
+ }
+ else
+ {
+ fcolor = FACE_FOREGROUND (Vdefault_face, locale);
+ bcolor = FACE_BACKGROUND (Vdefault_face, locale);
+ }
+
+ mswindows_update_dc (FRAME_MSWINDOWS_DC (f),
+ Qnil, fcolor, bcolor, background_pixmap);
+
+ mswindows_output_dibitmap_region
+ ( f, XIMAGE_INSTANCE (background_pixmap),
+ x, y, 0, 0, 0, 0, width, height, 0, TRUE);
+ }
+ else
+ {
+ Lisp_Object color = (w ? WINDOW_FACE_CACHEL_BACKGROUND (w, findex) :
+ FACE_BACKGROUND (Vdefault_face, locale));
+ mswindows_update_dc (FRAME_MSWINDOWS_DC (f), Qnil, Qnil, color, Qnil);
+ ExtTextOut (FRAME_MSWINDOWS_DC (f), 0, 0, ETO_OPAQUE, &rect, NULL, 0, NULL);
+ }
+
+#ifdef HAVE_SCROLLBARS
+ if (WINDOWP (locale))
+ mswindows_redisplay_deadbox_maybe (w, &rect);
+#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))
+ mswindows_clear_region (window, DEFAULT_INDEX, FRAME_LEFT_BORDER_START (f),
+ ypos1, FRAME_BORDER_WIDTH (f), height);
+
+ if (bounds.left_in - bounds.left_out > 0)
+ mswindows_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)
+ mswindows_clear_region (window, DEFAULT_INDEX, bounds.left_in, ypos1,
+ bounds.right_in - bounds.left_in, height);
+
+ if (bounds.right_out - bounds.right_in > 0)
+ mswindows_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))
+ mswindows_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)
+{
+ GdiFlush();
+}
+
+
+\f
+/************************************************************************/
+/* initialization */
+/************************************************************************/
+
+void
+console_type_create_redisplay_mswindows (void)
+{
+ /* redisplay methods */
+ 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);
+}
--- /dev/null
+/* Synchronize redisplay structures and output changes.
+ Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
+ Copyright (C) 1995, 1996 Ben Wing.
+ Copyright (C) 1996 Chuck Thompson.
+
+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. */
+
+/* This file has been Mule-ized. */
+
+/* Author: Chuck Thompson */
+
+#include <config.h>
+#include "lisp.h"
+#include "debug.h"
+
+#include "buffer.h"
+#include "window.h"
+#include "frame.h"
+#include "device.h"
+#include "glyphs.h"
+#include "redisplay.h"
+#include "faces.h"
+
+#include "sysdep.h"
+
+static int compare_runes (struct window *w, struct rune *crb,
+ struct rune *drb);
+static void redraw_cursor_in_window (struct window *w,
+ int run_end_begin_glyphs);
+
+/*****************************************************************************
+ sync_rune_structs
+
+ Synchronize the given rune blocks.
+ ****************************************************************************/
+static void
+sync_rune_structs (struct window *w, rune_dynarr *cra, rune_dynarr *dra)
+{
+ int rune_elt;
+ int max_move = ((Dynarr_length (dra) > Dynarr_largest (cra))
+ ? Dynarr_largest (cra)
+ : Dynarr_length (dra));
+
+ if (max_move)
+ {
+ /* #### Doing this directly breaks the encapsulation. But, the
+ running time of this function has a measurable impact on
+ redisplay performance so avoiding all excess overhead is a
+ good thing. Is all of this true? */
+ memcpy (cra->base, dra->base, sizeof (struct rune) * max_move);
+ Dynarr_set_size (cra, max_move);
+ }
+ else
+ Dynarr_reset (cra);
+
+ for (rune_elt = max_move; rune_elt < Dynarr_length (dra); rune_elt++)
+ {
+ struct rune rb, *crb;
+ struct rune *drb = Dynarr_atp (dra, rune_elt);
+
+ crb = &rb;
+ memcpy (crb, drb, sizeof (struct rune));
+ Dynarr_add (cra, *crb);
+ }
+}
+
+/*****************************************************************************
+ sync_display_line_structs
+
+ For the given LINE in window W, make the current display line equal
+ the desired display line.
+ ****************************************************************************/
+static void
+sync_display_line_structs (struct window *w, int line, int do_blocks,
+ display_line_dynarr *cdla,
+ display_line_dynarr *ddla)
+{
+ int cdla_len = Dynarr_length (cdla);
+
+ struct display_line dl, *clp, *dlp;
+ int db_elt;
+
+ dlp = Dynarr_atp (ddla, line);
+ if (line >= Dynarr_largest (cdla))
+ {
+ clp = &dl;
+ clp->display_blocks = Dynarr_new (display_block);
+ }
+ else
+ {
+ clp = Dynarr_atp (cdla, line);
+ if (clp->display_blocks)
+ Dynarr_reset (clp->display_blocks);
+ if (clp->left_glyphs)
+ {
+ Dynarr_free (clp->left_glyphs);
+ clp->left_glyphs = 0;
+ }
+ if (clp->right_glyphs)
+ {
+ Dynarr_free (clp->right_glyphs);
+ clp->right_glyphs = 0;
+ }
+ }
+ {
+ display_block_dynarr *tdb = clp->display_blocks;
+
+ memcpy (clp, dlp, sizeof (struct display_line));
+ clp->display_blocks = tdb;
+ clp->left_glyphs = 0;
+ clp->right_glyphs = 0;
+ }
+
+ if (!do_blocks && line >= cdla_len)
+ {
+ Dynarr_add (cdla, *clp);
+ return;
+ }
+
+ for (db_elt = 0; db_elt < Dynarr_length (dlp->display_blocks); db_elt++)
+ {
+ struct display_block db, *cdb;
+ struct display_block *ddb = Dynarr_atp (dlp->display_blocks, db_elt);
+
+ if (db_elt >= Dynarr_largest (clp->display_blocks))
+ {
+ cdb = &db;
+ memcpy (cdb, ddb, sizeof (struct display_block));
+ cdb->runes = Dynarr_new (rune);
+ Dynarr_add (clp->display_blocks, *cdb);
+ }
+ else
+ {
+ rune_dynarr *tr;
+
+ cdb = Dynarr_atp (clp->display_blocks, db_elt);
+ tr = cdb->runes;
+ memcpy (cdb, ddb, sizeof (struct display_block));
+ cdb->runes = tr;
+ Dynarr_increment (clp->display_blocks);
+ }
+
+ sync_rune_structs (w, cdb->runes, ddb->runes);
+ }
+
+ if (line >= cdla_len)
+ Dynarr_add (cdla, *clp);
+}
+
+/*****************************************************************************
+ compare_runes
+
+ Compare to runes to see if each of their fields is equal. If so,
+ return true otherwise return false.
+ ****************************************************************************/
+static int
+compare_runes (struct window *w, struct rune *crb, struct rune *drb)
+{
+ /* Do not compare the values of bufpos and endpos. They do not
+ affect the display characteristics. */
+
+ if ((crb->findex != drb->findex) ||
+ (WINDOW_FACE_CACHEL_DIRTY (w, drb->findex)))
+ return 0;
+ else if (crb->xpos != drb->xpos)
+ return 0;
+ else if (crb->width != drb->width)
+ return 0;
+ else if (crb->cursor_type != drb->cursor_type)
+ return 0;
+ else if (crb->type != drb->type)
+ return 0;
+ else if (crb->type == RUNE_CHAR &&
+ (crb->object.chr.ch != drb->object.chr.ch))
+ 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;
+ else
+ return 1;
+}
+
+/*****************************************************************************
+ get_next_display_block
+
+ Return the next display starting at or overlapping START_POS. Return
+ the start of the next region in NEXT_START.
+ ****************************************************************************/
+int
+get_next_display_block (layout_bounds bounds, display_block_dynarr *dba,
+ int start_pos, int *next_start)
+{
+ int next_display_block = NO_BLOCK;
+ int priority = -1;
+ int block;
+
+ /* If we don't find a display block covering or starting at
+ start_pos, then we return the starting point of the next display
+ block or the next division boundary, whichever is closer to
+ start_pos. */
+ if (next_start)
+ {
+ if (start_pos >= bounds.left_out && start_pos < bounds.left_in)
+ *next_start = bounds.left_in;
+ else if (start_pos < bounds.left_white)
+ *next_start = bounds.left_white;
+ else if (start_pos < bounds.right_white)
+ *next_start = bounds.right_white;
+ else if (start_pos < bounds.right_in)
+ *next_start = bounds.right_in;
+ else if (start_pos <= bounds.right_out)
+ *next_start = bounds.right_out;
+ else
+ abort ();
+ }
+
+ for (block = 0; block < Dynarr_length (dba); block++)
+ {
+ struct display_block *db = Dynarr_atp (dba, block);
+
+ if (db->start_pos <= start_pos && db->end_pos > start_pos)
+ {
+ if ((int) db->type > priority)
+ {
+ priority = db->type;
+ next_display_block = block;
+ if (next_start)
+ *next_start = db->end_pos;
+ }
+ }
+ else if (next_start && db->start_pos > start_pos)
+ {
+ if (db->start_pos < *next_start)
+ *next_start = db->start_pos;
+ }
+ }
+
+ return next_display_block;
+}
+
+/*****************************************************************************
+ get_cursor_size_and_location
+
+ Return the information defining the pixel location of the cursor.
+ ****************************************************************************/
+static void
+get_cursor_size_and_location (struct window *w, struct display_block *db,
+ int cursor_location,
+ int *cursor_start, int *cursor_width,
+ int *cursor_height)
+{
+ struct rune *rb;
+ Lisp_Object window;
+ int defheight, defwidth;
+
+ if (Dynarr_length (db->runes) <= cursor_location)
+ abort ();
+
+ XSETWINDOW (window, w);
+
+ rb = Dynarr_atp (db->runes, cursor_location);
+ *cursor_start = rb->xpos;
+
+ default_face_height_and_width (window, &defheight, &defwidth);
+ *cursor_height = defheight;
+
+ if (rb->type == RUNE_BLANK)
+ *cursor_width = defwidth;
+ else
+ *cursor_width = rb->width;
+}
+
+/*****************************************************************************
+ compare_display_blocks
+
+ Given two display blocks, output only those areas where they differ.
+ ****************************************************************************/
+static int
+compare_display_blocks (struct window *w, struct display_line *cdl,
+ struct display_line *ddl, int c_block, int d_block,
+ int start_pixpos, int cursor_start, int cursor_width,
+ int cursor_height)
+{
+ struct frame *f = XFRAME (w->frame);
+ struct device *d = XDEVICE (f->device);
+
+ struct display_block *cdb, *ddb;
+ int start_pos;
+ int stop_pos;
+ int force = 0;
+ int block_end;
+
+ cdb = Dynarr_atp (cdl->display_blocks, c_block);
+ ddb = Dynarr_atp (ddl->display_blocks, d_block);
+
+ assert (cdb->type == ddb->type);
+
+ start_pos = -1;
+ stop_pos = min (Dynarr_length (cdb->runes), Dynarr_length (ddb->runes));
+
+ block_end =
+ (!Dynarr_length (ddb->runes)
+ ? 0
+ : (Dynarr_atp (ddb->runes, Dynarr_length (ddb->runes) - 1)->xpos +
+ Dynarr_atp (ddb->runes, Dynarr_length (ddb->runes) - 1)->width));
+
+ /* If the new block type is not text and the cursor status is
+ changing and it overlaps the position of this block then force a
+ full redraw of the block in order to make sure that the cursor is
+ updated properly. */
+ if (ddb->type != TEXT
+#if 0
+ /* I'm not sure exactly what this code wants to do, but it's
+ * not right--it doesn't update when cursor_elt changes from, e.g.,
+ * 0 to 8, and the new or old cursor loc overlaps this block.
+ * I've replaced it with the more conservative test below.
+ * -dkindred@cs.cmu.edu 23-Mar-1997 */
+ && ((cdl->cursor_elt == -1 && ddl->cursor_elt != -1)
+ || (cdl->cursor_elt != -1 && ddl->cursor_elt == -1))
+ && (ddl->cursor_elt == -1 ||
+ (cursor_start
+ && cursor_width
+ && (cursor_start + cursor_width) >= start_pixpos
+ && cursor_start <= block_end))
+#else
+ && (cdl->cursor_elt != ddl->cursor_elt)
+#endif
+ )
+ force = 1;
+
+ if (f->windows_structure_changed ||
+ f->faces_changed ||
+ f->glyphs_changed ||
+ cdl->ypos != ddl->ypos ||
+ cdl->ascent != ddl->ascent ||
+ cdl->descent != ddl->descent ||
+ cdl->clip != ddl->clip ||
+ force)
+ {
+ start_pos = 0;
+ force = 1;
+ }
+ else
+ {
+ int elt = 0;
+
+ while (start_pos < 0 && elt < stop_pos)
+ {
+ if (!compare_runes (w, Dynarr_atp (cdb->runes, elt),
+ Dynarr_atp (ddb->runes, elt)))
+ {
+ start_pos = elt;
+ }
+ else
+ {
+ elt++;
+ }
+ }
+
+ /* If nothing has changed in the area where the blocks overlap, but
+ there are new blocks in the desired block, then adjust the start
+ point accordingly. */
+ if (elt == stop_pos && stop_pos < Dynarr_length (ddb->runes))
+ start_pos = stop_pos;
+ }
+
+ if (start_pos >= 0)
+ {
+ if ((Dynarr_length (ddb->runes) != Dynarr_length (cdb->runes))
+ || force)
+ {
+ stop_pos = Dynarr_length (ddb->runes);
+ }
+ else
+ {
+ /* If the lines have the same number of runes and we are not
+ forcing a full redraw because the display line has
+ changed position then we try and optimize how much of the
+ line we actually redraw by scanning backwards from the
+ end for the first changed rune. This optimization is
+ almost always triggered by face changes. */
+
+ int elt = Dynarr_length (ddb->runes) - 1;
+
+ while (elt > start_pos)
+ {
+ if (!compare_runes (w, Dynarr_atp (cdb->runes, elt),
+ Dynarr_atp (ddb->runes, elt)))
+ break;
+ else
+ elt--;
+ }
+ stop_pos = elt + 1;
+ }
+
+ DEVMETH (d, output_display_block, (w, ddl, d_block, start_pos,
+ stop_pos, start_pixpos,
+ cursor_start, cursor_width,
+ cursor_height));
+ return 1;
+ }
+
+ return 0;
+}
+
+/*****************************************************************************
+ clear_left_border
+
+ Clear the lefthand outside border.
+ ****************************************************************************/
+static void
+clear_left_border (struct window *w, int y, int height)
+{
+ struct frame *f = XFRAME (w->frame);
+ struct device *d = XDEVICE (f->device);
+ Lisp_Object window;
+
+ XSETWINDOW (window, w);
+ DEVMETH (d, clear_region, (window, DEFAULT_INDEX,
+ FRAME_LEFT_BORDER_START (f), y,
+ FRAME_BORDER_WIDTH (f), height));
+}
+
+/*****************************************************************************
+ clear_right_border
+
+ Clear the righthand outside border.
+ ****************************************************************************/
+static void
+clear_right_border (struct window *w, int y, int height)
+{
+ struct frame *f = XFRAME (w->frame);
+ struct device *d = XDEVICE (f->device);
+ Lisp_Object window;
+
+ XSETWINDOW (window, w);
+ DEVMETH (d, clear_region, (window, DEFAULT_INDEX,
+ FRAME_RIGHT_BORDER_START (f),
+ y, FRAME_BORDER_WIDTH (f), height));
+}
+
+/*****************************************************************************
+ output_display_line
+
+ Ensure that the contents of the given display line is correct
+ on-screen. The force_ parameters are used by redisplay_move_cursor
+ to correctly update cursor locations and only cursor locations.
+ ****************************************************************************/
+void
+output_display_line (struct window *w, display_line_dynarr *cdla,
+ display_line_dynarr *ddla, int line, int force_start,
+ int force_end)
+
+{
+ struct frame *f = XFRAME (w->frame);
+ struct device *d = XDEVICE (f->device);
+ struct buffer *b = XBUFFER (w->buffer);
+ struct buffer *old_b = window_display_buffer (w);
+ struct display_line *cdl, *ddl;
+ display_block_dynarr *cdba, *ddba;
+ int start_pixpos, end_pixpos;
+ int cursor_start, cursor_width, cursor_height;
+
+ int force = (force_start >= 0 || force_end >= 0);
+ int clear_border = 0;
+ int must_sync = 0;
+
+ if (cdla && line < Dynarr_length (cdla))
+ {
+ cdl = Dynarr_atp (cdla, line);
+ cdba = cdl->display_blocks;
+ }
+ else
+ {
+ cdl = NULL;
+ cdba = NULL;
+ }
+
+ ddl = Dynarr_atp (ddla, line); /* assert line < Dynarr_length (ddla) */
+ ddba = ddl->display_blocks;
+
+ if (force_start >= 0 && force_start >= ddl->bounds.left_out)
+ start_pixpos = force_start;
+ else
+ start_pixpos = ddl->bounds.left_out;
+
+ if (force_end >= 0 && force_end < ddl->bounds.right_out)
+ end_pixpos = force_end;
+ else
+ end_pixpos = ddl->bounds.right_out;
+
+ /* Get the cursor parameters. */
+ if (ddl->cursor_elt != -1)
+ {
+ struct display_block *db;
+
+ /* If the lines cursor parameter is not -1 then it indicates
+ which rune in the TEXT block contains the cursor. This means
+ that there must be at least one display block. The TEXT
+ block, if present, must always be the first display block. */
+ assert (Dynarr_length (ddba) != 0);
+
+ db = Dynarr_atp (ddba, 0);
+ assert (db->type == TEXT);
+
+ get_cursor_size_and_location (w, db, ddl->cursor_elt, &cursor_start,
+ &cursor_width, &cursor_height);
+ }
+ else
+ {
+ cursor_start = cursor_width = cursor_height = 0;
+ }
+
+ /* The modeline should only have a single block and it had better be
+ a TEXT block. */
+ if (ddl->modeline)
+ {
+ /* The shadow thickness check is necesssary if only the sign of
+ the size changed. */
+ if (cdba && !w->shadow_thickness_changed)
+ {
+ must_sync |= compare_display_blocks (w, cdl, ddl, 0, 0,
+ start_pixpos, 0, 0, 0);
+ }
+ else
+ {
+ DEVMETH (d, output_display_block, (w, ddl, 0, 0, -1, start_pixpos,
+ 0, 0, 0));
+ must_sync = 1;
+ }
+
+ if (must_sync)
+ clear_border = 1;
+ }
+
+ while (!ddl->modeline && start_pixpos < end_pixpos)
+ {
+ int block;
+ int next_start_pixpos;
+
+ block = get_next_display_block (ddl->bounds, ddba, start_pixpos,
+ &next_start_pixpos);
+
+ /* If we didn't find a block then we should blank the area
+ between start_pos and next_start if necessary. */
+ if (block == NO_BLOCK)
+ {
+ /* We only erase those areas which were actually previously
+ covered by a display block unless the window structure
+ changed. In that case we clear all areas since the current
+ structures may actually represent a different buffer. */
+ while (start_pixpos < next_start_pixpos)
+ {
+ int block_end;
+ int old_block;
+
+ if (cdba)
+ old_block = get_next_display_block (ddl->bounds, cdba,
+ start_pixpos, &block_end);
+ else
+ {
+ old_block = NO_BLOCK;
+ block_end = next_start_pixpos;
+ }
+
+ if (!cdba || old_block != NO_BLOCK || b != old_b ||
+ f->windows_structure_changed ||
+ f->faces_changed ||
+ force ||
+ (cdl && (cdl->ypos != ddl->ypos ||
+ cdl->ascent != ddl->ascent ||
+ cdl->descent != ddl->descent ||
+ cdl->clip != ddl->clip)))
+ {
+ int x, y, width, height;
+ Lisp_Object face;
+
+ must_sync = 1;
+ x = start_pixpos;
+ y = ddl->ypos - ddl->ascent;
+ width = min (next_start_pixpos, block_end) - x;
+ height = ddl->ascent + ddl->descent - ddl->clip;
+
+ if (x < ddl->bounds.left_in)
+ face = Vleft_margin_face;
+ else if (x < ddl->bounds.right_in)
+ face = Vdefault_face;
+ else if (x < ddl->bounds.right_out)
+ face = Vright_margin_face;
+ else
+ face = Qnil;
+
+ if (!NILP (face))
+ {
+ Lisp_Object window;
+
+ XSETWINDOW (window, w);
+
+ /* Clear the empty area. */
+ DEVMETH (d, clear_region,
+ (window, get_builtin_face_cache_index (w,
+ face),
+ x, y, width, height));
+
+ /* Mark that we should clear the border. This is
+ necessary because italic fonts may leave
+ droppings in the border. */
+ clear_border = 1;
+ }
+ }
+
+ start_pixpos = min (next_start_pixpos, block_end);
+ }
+ }
+ else
+ {
+ struct display_block *cdb, *ddb;
+ int block_end;
+ int old_block;
+
+ if (cdba)
+ old_block = get_next_display_block (ddl->bounds, cdba,
+ start_pixpos, &block_end);
+ else
+ old_block = NO_BLOCK;
+
+ ddb = Dynarr_atp (ddba, block);
+ cdb = (old_block != NO_BLOCK ? Dynarr_atp (cdba, old_block) : 0);
+
+ /* If there was formerly no block over the current
+ 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)
+ {
+ must_sync |= compare_display_blocks (w, cdl, ddl, old_block,
+ block, start_pixpos,
+ cursor_start, cursor_width,
+ cursor_height);
+ }
+ else
+ {
+ int elt;
+ int first_elt = 0;
+ int last_elt = -1;
+
+ for (elt = 0; elt < Dynarr_length (ddb->runes); elt++)
+ {
+ struct rune *rb = Dynarr_atp (ddb->runes, elt);
+
+ if (start_pixpos >= rb->xpos
+ && start_pixpos < rb->xpos + rb->width)
+ first_elt = elt;
+
+ if (end_pixpos > rb->xpos
+ && end_pixpos <= rb->xpos + rb->width)
+ {
+ last_elt = elt + 1;
+ if (last_elt > Dynarr_length (ddb->runes))
+ last_elt = Dynarr_length (ddb->runes);
+ break;
+ }
+ }
+
+ must_sync = 1;
+ DEVMETH (d, output_display_block, (w, ddl, block, first_elt,
+ last_elt,
+ start_pixpos,
+ cursor_start, cursor_width,
+ cursor_height));
+ }
+
+ start_pixpos = next_start_pixpos;
+ }
+ }
+
+ /* Clear the internal border if we are next to it and the window
+ structure or frame size has changed or if something caused
+ clear_border to be tripped. */
+ /* #### Doing this on f->clear sucks but is necessary because of
+ window-local background values. */
+ 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;
+
+ 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 (cdla)
+ sync_display_line_structs (w, line, must_sync, cdla, ddla);
+}
+
+/*****************************************************************************
+ redisplay_move_cursor
+
+ For the given window W, move the cursor to NEW_POINT. Returns a
+ boolean indicating success or failure.
+ ****************************************************************************/
+
+#define ADJ_BUFPOS (rb->bufpos + dl->offset)
+#define ADJ_ENDPOS (rb->endpos + dl->offset)
+
+int
+redisplay_move_cursor (struct window *w, Bufpos new_point, int no_output_end)
+{
+ struct frame *f = XFRAME (w->frame);
+ struct device *d = XDEVICE (f->device);
+
+ display_line_dynarr *cla = window_display_lines (w, CURRENT_DISP);
+ struct display_line *dl;
+ struct display_block *db;
+ struct rune *rb;
+ int x = w->last_point_x[CURRENT_DISP];
+ int y = w->last_point_y[CURRENT_DISP];
+
+ /*
+ * Bail if cursor_in_echo_area is non-zero and we're fiddling with
+ * the cursor in a non-active minibuffer window, since that is a
+ * special case that is handled elsewhere and this function need
+ * not handle it. Return 1 so the caller will assume we
+ * succeeded.
+ */
+ if (cursor_in_echo_area && MINI_WINDOW_P (w) &&
+ w != XWINDOW (FRAME_SELECTED_WINDOW (f)))
+ return 1;
+
+ if (y < 0 || y >= Dynarr_length (cla))
+ return 0;
+
+ dl = Dynarr_atp (cla, y);
+ db = get_display_block_from_line (dl, TEXT);
+
+ if (x < 0 || x >= Dynarr_length (db->runes))
+ return 0;
+
+ rb = Dynarr_atp (db->runes, x);
+
+ if (rb->cursor_type == CURSOR_OFF)
+ return 0;
+ else if (ADJ_BUFPOS == new_point
+ || (ADJ_ENDPOS && (new_point >= ADJ_BUFPOS)
+ && (new_point <= ADJ_ENDPOS)))
+ {
+ w->last_point_x[CURRENT_DISP] = x;
+ w->last_point_y[CURRENT_DISP] = y;
+ Fset_marker (w->last_point[CURRENT_DISP], make_int (ADJ_BUFPOS),
+ w->buffer);
+ dl->cursor_elt = x;
+ return 1;
+ }
+ else
+ {
+ DEVMETH (d, output_begin, (d));
+
+ /* #### This is a gross kludge. Cursor handling is such a royal
+ pain in the ass. */
+ if (rb->type == RUNE_DGLYPH &&
+ (EQ (rb->object.dglyph.glyph, Vtruncation_glyph) ||
+ EQ (rb->object.dglyph.glyph, Vcontinuation_glyph)))
+ rb->cursor_type = NO_CURSOR;
+ else
+ rb->cursor_type = CURSOR_OFF;
+ dl->cursor_elt = -1;
+ output_display_line (w, 0, cla, y, rb->xpos, rb->xpos + rb->width);
+ }
+
+ w->last_point_x[CURRENT_DISP] = -1;
+ w->last_point_y[CURRENT_DISP] = -1;
+ Fset_marker (w->last_point[CURRENT_DISP], Qnil, w->buffer);
+
+ /* If this isn't the selected frame, then erasing the old cursor is
+ all we actually had to do. */
+ if (w != XWINDOW (FRAME_SELECTED_WINDOW (device_selected_frame (d))))
+ {
+ if (!no_output_end)
+ DEVMETH (d, output_end, (d));
+
+ return 1;
+ }
+
+ /* This should only occur in the minibuffer. */
+ if (new_point == 0)
+ {
+ w->last_point_x[CURRENT_DISP] = 0;
+ w->last_point_y[CURRENT_DISP] = y;
+ Fset_marker (w->last_point[CURRENT_DISP], Qzero, w->buffer);
+
+ rb = Dynarr_atp (db->runes, 0);
+ rb->cursor_type = CURSOR_ON;
+ dl->cursor_elt = 0;
+
+ output_display_line (w, 0, cla, y, rb->xpos, rb->xpos + rb->width);
+
+ if (!no_output_end)
+ DEVMETH (d, output_end, (d));
+ return 1;
+ }
+ else
+ {
+ int cur_rb = 0;
+ int first = 0;
+ int cur_dl, up;
+
+ if (ADJ_BUFPOS < new_point)
+ {
+ up = 1;
+ cur_rb = x + 1;
+ cur_dl = y;
+ }
+ else /* (rb->bufpos + dl->offset) > new_point */
+ {
+ up = 0;
+
+ if (!x)
+ {
+ cur_dl = y - 1;
+ first = 0;
+ }
+ else
+ {
+ cur_rb = x - 1;
+ cur_dl = y;
+ first = 1;
+ }
+ }
+
+ while ((up ? (cur_dl < Dynarr_length (cla)) : (cur_dl >= 0)))
+ {
+ dl = Dynarr_atp (cla, cur_dl);
+ db = get_display_block_from_line (dl, TEXT);
+
+ if (!up && !first)
+ cur_rb = Dynarr_length (db->runes) - 1;
+
+ while ((!scroll_on_clipped_lines || !dl->clip) &&
+ (up ? (cur_rb < Dynarr_length (db->runes)) : (cur_rb >= 0)))
+ {
+ rb = Dynarr_atp (db->runes, cur_rb);
+
+ if (rb->cursor_type != IGNORE_CURSOR
+ && rb->cursor_type != NO_CURSOR &&
+ (ADJ_BUFPOS == new_point
+ || (ADJ_ENDPOS && (new_point >= ADJ_BUFPOS)
+ && (new_point <= ADJ_BUFPOS))))
+ {
+ rb->cursor_type = CURSOR_ON;
+ dl->cursor_elt = cur_rb;
+
+
+ output_display_line (w, 0, cla, cur_dl, rb->xpos,
+ rb->xpos + rb->width);
+
+ w->last_point_x[CURRENT_DISP] = cur_rb;
+ w->last_point_y[CURRENT_DISP] = cur_dl;
+ Fset_marker (w->last_point[CURRENT_DISP],
+ make_int (ADJ_BUFPOS), w->buffer);
+
+ if (!no_output_end)
+ DEVMETH (d, output_end, (d));
+ return 1;
+ }
+
+ (up ? cur_rb++ : cur_rb--);
+ }
+
+ (up ? (cur_rb = 0) : (first = 0));
+ (up ? cur_dl++ : cur_dl--);
+ }
+ }
+
+ if (!no_output_end)
+ DEVMETH (d, output_end, (d));
+ return 0;
+}
+#undef ADJ_BUFPOS
+#undef ADJ_ENDPOS
+
+/*****************************************************************************
+ redraw_cursor_in_window
+
+ For the given window W, redraw the cursor if it is contained within
+ the window.
+ ****************************************************************************/
+static void
+redraw_cursor_in_window (struct window *w, int run_end_begin_meths)
+{
+ struct frame *f = XFRAME (w->frame);
+ struct device *d = XDEVICE (f->device);
+
+ display_line_dynarr *dla = window_display_lines (w, CURRENT_DISP);
+ struct display_line *dl;
+ struct display_block *db;
+ struct rune *rb;
+
+ int x = w->last_point_x[CURRENT_DISP];
+ int y = w->last_point_y[CURRENT_DISP];
+
+ if (cursor_in_echo_area && MINI_WINDOW_P (w) &&
+ !echo_area_active (f) && minibuf_level == 0)
+ {
+ MAYBE_DEVMETH (d, set_final_cursor_coords, (f, w->pixel_top, 0));
+ }
+
+ if (y < 0 || y >= Dynarr_length (dla))
+ return;
+
+ if (MINI_WINDOW_P (w) && f != device_selected_frame (d) &&
+ !is_surrogate_for_selected_frame (f))
+ return;
+
+ dl = Dynarr_atp (dla, y);
+ db = get_display_block_from_line (dl, TEXT);
+
+ if (x < 0 || x >= Dynarr_length (db->runes))
+ return;
+
+ rb = Dynarr_atp (db->runes, x);
+
+ /* Don't call the output routine if the block isn't actually the
+ cursor. */
+ if (rb->cursor_type == CURSOR_ON)
+ {
+ MAYBE_DEVMETH (d, set_final_cursor_coords,
+ (f, dl->ypos - 1, rb->xpos));
+
+ if (run_end_begin_meths)
+ DEVMETH (d, output_begin, (d));
+
+ output_display_line (w, 0, dla, y, rb->xpos, rb->xpos + rb->width);
+
+ if (run_end_begin_meths)
+ DEVMETH (d, output_end, (d));
+ }
+}
+
+/*****************************************************************************
+ redisplay_redraw_cursor
+
+ For the given frame F, redraw the cursor on the selected window.
+ This is used to update the cursor after focus changes.
+ ****************************************************************************/
+void
+redisplay_redraw_cursor (struct frame *f, int run_end_begin_meths)
+{
+ Lisp_Object window;
+
+ if (!cursor_in_echo_area)
+ window = FRAME_SELECTED_WINDOW (f);
+ else if (FRAME_HAS_MINIBUF_P (f))
+ window = FRAME_MINIBUF_WINDOW (f);
+ else
+ return;
+
+ redraw_cursor_in_window (XWINDOW (window), run_end_begin_meths);
+}
+
+/*****************************************************************************
+ redisplay_clear_top_of_window
+
+ If window is topmost, clear the internal border above it.
+ ****************************************************************************/
+static void
+redisplay_clear_top_of_window (struct window *w)
+{
+ Lisp_Object window;
+ XSETWINDOW (window, w);
+
+ if (!NILP (Fwindow_highest_p (window)))
+ {
+ struct frame *f = XFRAME (w->frame);
+ struct device *d = XDEVICE (f->device);
+ int x, y, width, height;
+
+ x = w->pixel_left;
+ width = w->pixel_width;
+
+ if (window_is_leftmost (w))
+ {
+ x -= FRAME_BORDER_WIDTH (f);
+ width += FRAME_BORDER_WIDTH (f);
+ }
+ if (window_is_rightmost (w))
+ width += FRAME_BORDER_WIDTH (f);
+
+ y = FRAME_TOP_BORDER_START (f) - 1;
+ height = FRAME_BORDER_HEIGHT (f) + 1;
+
+ DEVMETH (d, clear_region, (window, DEFAULT_INDEX, x, y, width, height));
+ }
+}
+
+/*****************************************************************************
+ redisplay_clear_bottom_of_window
+
+ Clear window from right below the last display line to right above
+ the modeline. The calling function can limit the area actually
+ erased by setting min_start and/or max_end to positive values.
+ ****************************************************************************/
+void
+redisplay_clear_bottom_of_window (struct window *w, display_line_dynarr *ddla,
+ 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);
+
+ ypos2 = WINDOW_TEXT_BOTTOM (w);
+#ifdef HAVE_SCROLLBARS
+ /* This adjustment is to catch the intersection of any scrollbars. */
+ if (f->windows_structure_changed && NILP (w->scrollbar_on_top_p))
+ ypos2 += window_scrollbar_height (w);
+#endif
+
+ if (ddla_len)
+ {
+ if (ddla_len == 1 && Dynarr_atp (ddla, 0)->modeline)
+ {
+ ypos1 = WINDOW_TEXT_TOP (w);
+#ifdef HAVE_SCROLLBARS
+ /* This adjustment is to catch the intersection of any scrollbars. */
+ if (f->windows_structure_changed && !NILP (w->scrollbar_on_top_p))
+ ypos1 -= window_scrollbar_height (w);
+#endif
+ }
+ else
+ {
+ struct display_line *dl = Dynarr_atp (ddla, ddla_len - 1);
+ ypos1 = dl->ypos + dl->descent - dl->clip;
+ }
+ }
+ else
+ ypos1 = WINDOW_TEXT_TOP (w);
+
+ /* #### See if this can be made conditional on the frame
+ changing size. */
+ if (MINI_WINDOW_P (w))
+ ypos2 += FRAME_BORDER_HEIGHT (f);
+
+ if (min_start >= 0 && ypos1 < min_start)
+ ypos1 = min_start;
+ if (max_end >= 0 && ypos2 > max_end)
+ ypos2 = max_end;
+
+ if (ypos2 <= ypos1)
+ return;
+
+ DEVMETH (d, clear_to_window_end, (w, ypos1, ypos2));
+}
+
+/*****************************************************************************
+ redisplay_update_line
+
+ This is used during incremental updates to update a single line and
+ correct the offsets on all lines below it. At the moment
+ update_values is false if we are only updating the modeline.
+ ****************************************************************************/
+void
+redisplay_update_line (struct window *w, int first_line, int last_line,
+ int update_values)
+{
+ struct frame *f = XFRAME (w->frame);
+ struct device *d = XDEVICE (f->device);
+
+ display_line_dynarr *cdla = window_display_lines (w, CURRENT_DISP);
+ display_line_dynarr *ddla = window_display_lines (w, DESIRED_DISP);
+
+ DEVMETH (d, output_begin, (d));
+
+ while (first_line <= last_line)
+ {
+ Charcount old_len = (Dynarr_atp (cdla, first_line)->end_bufpos -
+ Dynarr_atp (cdla, first_line)->bufpos);
+ Charcount new_len = (Dynarr_atp (ddla, first_line)->end_bufpos -
+ Dynarr_atp (ddla, first_line)->bufpos);
+
+ assert (Dynarr_length (cdla) == Dynarr_length (ddla));
+
+ /* Output the changes. */
+ output_display_line (w, cdla, ddla, first_line, -1, -1);
+
+ /* Update the offsets. */
+ if (update_values)
+ {
+ int cur_line = first_line + 1;
+ while (cur_line < Dynarr_length (cdla))
+ {
+ Dynarr_atp (cdla, cur_line)->offset += (new_len - old_len);
+ Dynarr_atp (ddla, cur_line)->offset += (new_len - old_len);
+ cur_line++;
+ }
+ }
+
+ /* Update the window_end_pos and other settings. */
+ if (update_values)
+ {
+ w->window_end_pos[CURRENT_DISP] -= (new_len - old_len);
+
+ if (Dynarr_atp (ddla, first_line)->cursor_elt != -1)
+ {
+ w->last_point_x[CURRENT_DISP] = w->last_point_x[DESIRED_DISP];
+ w->last_point_y[CURRENT_DISP] = w->last_point_y[DESIRED_DISP];
+ }
+ }
+
+ first_line++;
+ }
+
+ /* Update the window max line length. We have to scan the entire
+ set of display lines otherwise we might not detect if the max is
+ supposed to shrink. */
+ if (update_values)
+ {
+ int line = 0;
+
+ w->max_line_len = 0;
+ while (line < Dynarr_length (ddla))
+ {
+ struct display_line *dl = Dynarr_atp (ddla, line);
+
+ if (!dl->modeline)
+ w->max_line_len = max (dl->num_chars, w->max_line_len);
+
+ line++;
+ }
+ }
+
+ w->last_modified[CURRENT_DISP] = w->last_modified[DESIRED_DISP];
+ w->last_facechange[CURRENT_DISP] = w->last_facechange[DESIRED_DISP];
+ Fset_marker (w->last_point[CURRENT_DISP],
+ Fmarker_position (w->last_point[DESIRED_DISP]), w->buffer);
+ Fset_marker (w->last_start[CURRENT_DISP],
+ Fmarker_position (w->last_start[DESIRED_DISP]), w->buffer);
+
+ /* We don't bother updating the vertical scrollbars here. This
+ gives us a performance increase while having minimal loss of
+ quality to the scrollbar slider size and position since when this
+ function is called we know that the changes to the buffer were
+ very localized. We have to update the horizontal scrollbars,
+ though, because this routine could cause a change which has a
+ larger impact on their sizing. */
+ /* #### See if we can get away with only calling this if
+ max_line_len is greater than the window_char_width. */
+#if defined(HAVE_SCROLLBARS) && defined(HAVE_X_WINDOWS)
+ {
+ extern int stupid_vertical_scrollbar_drag_hack;
+
+ update_window_scrollbars (w, NULL, 1, stupid_vertical_scrollbar_drag_hack);
+ stupid_vertical_scrollbar_drag_hack = 1;
+ }
+#endif
+
+ /* This has to be done after we've updated the values. We don't
+ call output_end for tty frames. Redisplay will do this after all
+ tty windows have been updated. This cuts down on cursor
+ flicker. */
+ if (FRAME_TTY_P (f))
+ redisplay_redraw_cursor (f, 0);
+ else
+ DEVMETH (d, output_end, (d));
+}
+
+/*****************************************************************************
+ redisplay_output_window
+
+ For the given window W, ensure that the current display lines are
+ equal to the desired display lines, outputing changes as necessary.
+
+ #### Fuck me. This just isn't going to cut it for tty's. The output
+ decisions for them must be based on the contents of the entire frame
+ because that is how the available output capabilities think. The
+ solution is relatively simple. Create redisplay_output_frame. This
+ will basically merge all of the separate window display structs into
+ a single one for the frame. This combination structure will be able
+ to be passed to the same output_display_line which works for windows
+ on X frames and the right things will happen. It just takes time to
+ do.
+ ****************************************************************************/
+void
+redisplay_output_window (struct window *w)
+{
+ struct frame *f = XFRAME (w->frame);
+ struct device *d = XDEVICE (f->device);
+
+ display_line_dynarr *cdla = window_display_lines (w, CURRENT_DISP);
+ display_line_dynarr *ddla = window_display_lines (w, DESIRED_DISP);
+
+ int cdla_len = Dynarr_length (cdla);
+ int ddla_len = Dynarr_length (ddla);
+
+ int line;
+ int need_to_clear_bottom = 0;
+ int need_to_clear_start = -1;
+ int need_to_clear_end = -1;
+
+ /* Backgrounds may have changed or windows may have gone away
+ leaving dividers lying around. */
+ if (f->faces_changed
+ || f->windows_structure_changed
+ || w->shadow_thickness_changed)
+ need_to_clear_bottom = 1;
+
+ /* The first thing we do is determine if we are going to need to
+ clear the bottom of the window. We only need to do this if the
+ bottom of the current display lines is below the bottom of the
+ desired display lines. Note that the number of lines is
+ irrelevant. Only the position matters. We also clear to the
+ bottom of the window if the modeline has shifted position. */
+ /* #### We can't blindly not clear the bottom if f->clear is true
+ since there might be a window-local background. However, for
+ those cases where there isn't, clearing the end of the window in
+ this case sucks. */
+ if (!need_to_clear_bottom)
+ {
+ struct display_line *cdl, *ddl;
+
+ /* If the modeline has changed position or size, clear the bottom
+ of the window. */
+ if (!need_to_clear_bottom)
+ {
+ cdl = ddl = 0;
+
+ if (cdla_len)
+ cdl = Dynarr_atp (cdla, 0);
+ if (ddla_len)
+ ddl = Dynarr_atp (ddla, 0);
+
+ if (!cdl || !ddl)
+ need_to_clear_bottom = 1;
+ else if ((!cdl->modeline && ddl->modeline)
+ || (cdl->modeline && !ddl->modeline))
+ need_to_clear_bottom = 1;
+ else if (cdl->ypos != ddl->ypos ||
+ cdl->ascent != ddl->ascent ||
+ cdl->descent != ddl->descent ||
+ cdl->clip != ddl->clip)
+ need_to_clear_bottom = 1;
+
+ /* #### This kludge is to make sure the modeline shadows get
+ redrawn if the modeline position shifts. */
+ if (need_to_clear_bottom)
+ w->shadow_thickness_changed = 1;
+ }
+
+ if (!need_to_clear_bottom)
+ {
+ cdl = ddl = 0;
+
+ if (cdla_len)
+ cdl = Dynarr_atp (cdla, cdla_len - 1);
+ if (ddla_len)
+ ddl = Dynarr_atp (ddla, ddla_len - 1);
+
+ if (!cdl || !ddl)
+ need_to_clear_bottom = 1;
+ else
+ {
+ int cdl_bottom, ddl_bottom;
+
+ cdl_bottom = cdl->ypos + cdl->descent;
+ ddl_bottom = ddl->ypos + ddl->descent;
+
+ if (cdl_bottom > ddl_bottom)
+ {
+ need_to_clear_bottom = 1;
+ need_to_clear_start = ddl_bottom;
+ need_to_clear_end = cdl_bottom;
+ }
+ }
+ }
+ }
+
+ /* Perform any output initialization. */
+ DEVMETH (d, output_begin, (d));
+
+ /* If the window's structure has changed clear the internal border
+ above it if it is topmost (the function will check). */
+ if (f->windows_structure_changed)
+ redisplay_clear_top_of_window (w);
+
+ /* 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 > ddla_len)
+ {
+ Dynarr_length (cdla) = ddla_len;
+ }
+
+ /* Output a vertical divider between windows, if necessary. */
+ if (window_needs_vertical_divider (w)
+ && (f->windows_structure_changed || f->clear))
+ {
+ DEVMETH (d, output_vertical_divider, (w, f->windows_structure_changed));
+ }
+
+ /* Clear the rest of the window, if necessary. */
+ if (need_to_clear_bottom)
+ {
+ redisplay_clear_bottom_of_window (w, ddla, need_to_clear_start,
+ need_to_clear_end);
+ }
+
+ w->window_end_pos[CURRENT_DISP] = w->window_end_pos[DESIRED_DISP];
+ Fset_marker (w->start[CURRENT_DISP],
+ make_int (marker_position (w->start[DESIRED_DISP])),
+ w->buffer);
+ Fset_marker (w->pointm[CURRENT_DISP],
+ make_int (marker_position (w->pointm[DESIRED_DISP])),
+ w->buffer);
+ w->last_modified[CURRENT_DISP] = w->last_modified[DESIRED_DISP];
+ w->last_facechange[CURRENT_DISP] = w->last_facechange[DESIRED_DISP];
+ Fset_marker (w->last_start[CURRENT_DISP],
+ Fmarker_position (w->last_start[DESIRED_DISP]), w->buffer);
+ Fset_marker (w->last_point[CURRENT_DISP],
+ Fmarker_position (w->last_point[DESIRED_DISP]), w->buffer);
+ w->last_point_x[CURRENT_DISP] = w->last_point_x[DESIRED_DISP];
+ w->last_point_y[CURRENT_DISP] = w->last_point_y[DESIRED_DISP];
+ w->shadow_thickness_changed = 0;
+
+ set_window_display_buffer (w, XBUFFER (w->buffer));
+ find_window_mirror (w)->truncate_win = window_truncation_on (w);
+
+ /* Overkill on invalidating the cache. It is very bad for it to not
+ get invalidated when it should be. */
+ INVALIDATE_DEVICE_PIXEL_TO_GLYPH_CACHE (d);
+
+ /* We don't call output_end for tty frames. Redisplay will do this
+ after all tty windows have been updated. This cuts down on
+ cursor flicker. */
+ if (FRAME_TTY_P (f))
+ redisplay_redraw_cursor (f, 0);
+ else
+ DEVMETH (d, output_end, (d));
+
+#ifdef HAVE_SCROLLBARS
+ update_window_scrollbars (w, NULL, !MINI_WINDOW_P (w), 0);
+#endif
+}
--- /dev/null
+/* Communication module for TTY terminals.
+ Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
+ Copyright (C) 1995 Sun Microsystems, Inc.
+ Copyright (C) 1995, 1996 Ben Wing.
+ Copyright (C) 1996 Chuck Thompson.
+
+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 completely synched with FSF. Mostly divergent
+ from FSF. */
+
+/* This file has been Mule-ized. */
+
+/* Written by Chuck Thompson. */
+/* Color support added by Ben Wing. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "console-tty.h"
+#include "events.h"
+#include "faces.h"
+#include "frame.h"
+#include "glyphs.h"
+#include "lstream.h"
+#include "objects-tty.h"
+#include "redisplay.h"
+#include "sysdep.h"
+#include "window.h"
+
+/* These headers #define all kinds of common words like "columns"...
+ What a bunch of losers. If we were to include them, we'd have to
+ include them last to prevent them from messing up our own header
+ files (struct slot names, etc.). But it turns out that there are
+ other conflicts as well on some systems, so screw it: we'll just
+ re-declare the routines we use and assume the code in this file is
+ invoking them correctly. */
+/* # include <curses.h> */
+/* # include <term.h> */
+#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));
+#ifdef __cplusplus
+}
+#endif
+#define FORCE_CURSOR_UPDATE(c) send_string_to_tty_console (c, 0, 0)
+#define OUTPUTN(c, a, n) \
+ do { \
+ cmputc_console = c; \
+ FORCE_CURSOR_UPDATE (c); \
+ tputs (a, n, cmputc); \
+ } while (0)
+#define OUTPUT1(c, a) OUTPUTN (c, a, 1)
+#define OUTPUTN_IF(c, a, n) \
+ do { \
+ cmputc_console = c; \
+ FORCE_CURSOR_UPDATE (c); \
+ if (a) \
+ tputs (a, n, cmputc); \
+ } while (0)
+#define OUTPUT1_IF(c, a) OUTPUTN_IF (c, a, 1)
+
+static void tty_output_emchar_dynarr (struct window *w,
+ struct display_line *dl,
+ Emchar_dynarr *buf, int xpos,
+ face_index findex,
+ int cursor);
+static void tty_output_bufbyte_string (struct window *w,
+ struct display_line *dl,
+ Bufbyte *str, Bytecount len,
+ int xpos, face_index findex,
+ int cursor);
+static void tty_turn_on_face (struct window *w, face_index findex);
+static void tty_turn_off_face (struct window *w, face_index findex);
+static void tty_turn_on_frame_face (struct frame *f, Lisp_Object face);
+static void tty_turn_off_frame_face (struct frame *f, Lisp_Object face);
+
+static void term_get_fkeys (Lisp_Object keymap, char **address);
+
+/*****************************************************************************
+ tty_text_width
+
+ Non-Mule tty's don't have fonts (that we use at least), so everything
+ is considered to be fixed width -- in other words, we return LEN.
+ Under Mule, however, a character can still cover more than one
+ column, so we use emchar_string_displayed_columns().
+ ****************************************************************************/
+static int
+tty_text_width (struct frame *f, struct face_cachel *cachel, CONST Emchar *str,
+ Charcount len)
+{
+ return emchar_string_displayed_columns (str, len);
+}
+
+/*****************************************************************************
+ tty_divider_height
+
+ Return the width of the horizontal divider. This is a function
+ because divider_height is a console method.
+ ****************************************************************************/
+static int
+tty_divider_height (void)
+{
+ return 1;
+}
+
+/*****************************************************************************
+ tty_eol_cursor_width
+
+ Return the width of the end-of-line cursor. This is a function
+ because eol_cursor_width is a console method.
+ ****************************************************************************/
+static int
+tty_eol_cursor_width (void)
+{
+ return 1;
+}
+
+/*****************************************************************************
+ tty_output_begin
+
+ Perform any necessary initialization prior to an update.
+ ****************************************************************************/
+#ifdef DEBUG_XEMACS
+void tty_output_begin (struct device *d);
+void
+#else
+static void
+#endif
+tty_output_begin (struct device *d)
+{
+#ifndef HAVE_TERMIOS
+ /* Termcap requires `ospeed' to be a global variable so we have to
+ always set it for whatever tty console we are actually currently
+ working with. */
+ ospeed = DEVICE_TTY_DATA (d)->ospeed;
+#endif
+}
+
+/*****************************************************************************
+ tty_output_end
+
+ Perform any necessary flushing of queues when an update has completed.
+ ****************************************************************************/
+#ifdef DEBUG_XEMACS
+void tty_output_end (struct device *d);
+void
+#else
+static void
+#endif
+tty_output_end (struct device *d)
+{
+ struct console *c = XCONSOLE (DEVICE_CONSOLE (d));
+
+ CONSOLE_TTY_CURSOR_X (c) = CONSOLE_TTY_FINAL_CURSOR_X (c);
+ CONSOLE_TTY_CURSOR_Y (c) = CONSOLE_TTY_FINAL_CURSOR_Y (c);
+ FORCE_CURSOR_UPDATE (c);
+ Lstream_flush (XLSTREAM (CONSOLE_TTY_DATA (c)->outstream));
+}
+
+static void
+tty_set_final_cursor_coords (struct frame *f, int y, int x)
+{
+ struct console *c = XCONSOLE (FRAME_CONSOLE (f));
+
+ CONSOLE_TTY_FINAL_CURSOR_X (c) = x;
+ CONSOLE_TTY_FINAL_CURSOR_Y (c) = y;
+}
+
+/*****************************************************************************
+ tty_output_display_block
+
+ Given a display line, a block number for that start line, output all
+ runes between start and end in the specified display block.
+ ****************************************************************************/
+static void
+tty_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_height)
+{
+ struct frame *f = XFRAME (w->frame);
+ Emchar_dynarr *buf = Dynarr_new (Emchar);
+
+ struct display_block *db = Dynarr_atp (dl->display_blocks, block);
+ rune_dynarr *rba = db->runes;
+ struct rune *rb;
+
+ int elt = start;
+ face_index findex;
+ int xpos;
+
+ rb = Dynarr_atp (rba, elt);
+
+ if (!rb)
+ {
+ /* Nothing to do so don't do anything. */
+ return;
+ }
+ else
+ {
+ findex = rb->findex;
+ xpos = rb->xpos;
+ }
+
+ if (end < 0)
+ end = Dynarr_length (rba);
+
+ Dynarr_reset (buf);
+
+ while (elt < end && Dynarr_atp (rba, elt)->xpos < start_pixpos)
+ {
+ elt++;
+ findex = Dynarr_atp (rba, elt)->findex;
+ xpos = Dynarr_atp (rba, elt)->xpos;
+ }
+
+ while (elt < end)
+ {
+ rb = Dynarr_atp (rba, elt);
+
+ if (rb->findex == findex && rb->type == RUNE_CHAR
+ && rb->object.chr.ch != '\n'
+ && (rb->cursor_type != CURSOR_ON
+ || NILP (w->text_cursor_visible_p)))
+ {
+ Dynarr_add (buf, rb->object.chr.ch);
+ elt++;
+ }
+ else
+ {
+ if (Dynarr_length (buf))
+ {
+ tty_output_emchar_dynarr (w, dl, buf, xpos, findex, 0);
+ xpos = rb->xpos;
+ }
+ Dynarr_reset (buf);
+
+ if (rb->type == RUNE_CHAR)
+ {
+ findex = rb->findex;
+ xpos = rb->xpos;
+
+ if (rb->object.chr.ch == '\n')
+ {
+ /* Clear in case a cursor was formerly here. */
+
+ Dynarr_add (buf, ' ');
+ tty_output_emchar_dynarr (w, dl, buf, rb->xpos,
+ DEFAULT_INDEX, 0);
+ Dynarr_reset (buf);
+
+ cmgoto (f, dl->ypos - 1, rb->xpos);
+
+ elt++;
+ }
+ else if (rb->cursor_type == CURSOR_ON)
+ {
+ /* There is not a distinct eol cursor on tty's. */
+
+ Dynarr_add (buf, rb->object.chr.ch);
+ tty_output_emchar_dynarr (w, dl, buf, xpos, findex, 0);
+ Dynarr_reset (buf);
+
+ cmgoto (f, dl->ypos - 1, xpos);
+
+ xpos += rb->width;
+ elt++;
+ }
+ }
+ /* #### RUNE_HLINE is actualy a little more complicated than this
+ but at the moment it is only used to draw a turned off
+ modeline and this will suffice for that. */
+ else if (rb->type == RUNE_BLANK || rb->type == RUNE_HLINE)
+ {
+ Emchar ch_to_add;
+ int size = rb->width;
+
+ if (rb->type == RUNE_BLANK)
+ ch_to_add = ' ';
+ else
+ ch_to_add = '-';
+
+ while (size--)
+ Dynarr_add (buf, ch_to_add);
+ tty_output_emchar_dynarr (w, dl, buf, rb->xpos, findex, 0);
+
+ if (xpos >= cursor_start
+ && cursor_start < xpos + Dynarr_length (buf))
+ {
+ cmgoto (f, dl->ypos - 1, cursor_start);
+ }
+
+ Dynarr_reset (buf);
+
+ elt++;
+ if (elt < end)
+ {
+ rb = Dynarr_atp (rba, elt);
+
+ findex = rb->findex;
+ xpos = rb->xpos;
+ }
+ }
+ else if (rb->type == RUNE_DGLYPH)
+ {
+ Lisp_Object window;
+ Lisp_Object instance;
+
+ XSETWINDOW (window, w);
+ instance = glyph_image_instance (rb->object.dglyph.glyph,
+ window, ERROR_ME_NOT, 1);
+
+ if (IMAGE_INSTANCEP (instance))
+ switch (XIMAGE_INSTANCE_TYPE (instance))
+ {
+ case IMAGE_TEXT:
+ {
+ Bufbyte *temptemp;
+ Lisp_Object string =
+ XIMAGE_INSTANCE_TEXT_STRING (instance);
+ Bytecount len = XSTRING_LENGTH (string);
+
+ /* In the unlikely instance that a garbage-collect
+ occurs during encoding, we at least need to
+ copy the string.
+ */
+ temptemp = (Bufbyte *) alloca (len);
+ memcpy (temptemp, XSTRING_DATA (string), len);
+ {
+ int i;
+
+ /* Now truncate the first rb->object.dglyph.xoffset
+ columns. */
+ for (i = 0; i < rb->object.dglyph.xoffset;)
+ {
+#ifdef MULE
+ Emchar ch = charptr_emchar (temptemp);
+ i += XCHARSET_COLUMNS (CHAR_CHARSET (ch));
+#else
+ i++; /* telescope this */
+#endif
+ INC_CHARPTR (temptemp);
+ }
+
+ /* If we truncated one column too many, then
+ add a space at the beginning. */
+ if (i > rb->object.dglyph.xoffset)
+ {
+ assert (i > 0);
+ *--temptemp = ' ';
+ i--;
+ }
+ len -= i;
+ }
+
+ tty_output_bufbyte_string (w, dl, temptemp, len,
+ xpos, findex, 0);
+
+ if (xpos >= cursor_start
+ && (cursor_start <
+ xpos + (bufbyte_string_displayed_columns
+ (temptemp, len))))
+ {
+ cmgoto (f, dl->ypos - 1, cursor_start);
+ }
+ }
+ break;
+
+ case IMAGE_MONO_PIXMAP:
+ case IMAGE_COLOR_PIXMAP:
+ case IMAGE_SUBWINDOW:
+ /* just do nothing here */
+ break;
+
+ case IMAGE_POINTER:
+ abort ();
+
+ case IMAGE_NOTHING:
+ /* nothing is as nothing does */
+ break;
+
+ default:
+ abort ();
+ }
+
+ xpos += rb->width;
+ elt++;
+ }
+ else
+ abort ();
+ }
+ }
+
+ if (Dynarr_length (buf))
+ tty_output_emchar_dynarr (w, dl, buf, xpos, findex, 0);
+ Dynarr_free (buf);
+
+}
+
+
+
+/*****************************************************************************
+ tty_output_vertical_divider
+
+ Draw a vertical divider down the right side of the given window.
+ ****************************************************************************/
+static void
+tty_output_vertical_divider (struct window *w, int clear)
+{
+ /* Divider width can either be 0 or 1 on TTYs */
+ if (window_divider_width (w))
+ {
+ struct frame *f = XFRAME (w->frame);
+ struct console *c = XCONSOLE (FRAME_CONSOLE (f));
+ int line;
+ int y_top = WINDOW_TEXT_TOP (w);
+ int y_bot = WINDOW_TEXT_BOTTOM (w);
+ unsigned char divv = '|';
+
+ tty_turn_on_face (w, MODELINE_INDEX);
+ for (line = y_top; line < y_bot; line++)
+ {
+ cmgoto (f, line, WINDOW_TEXT_RIGHT (w));
+ send_string_to_tty_console (c, &divv, 1);
+ TTY_INC_CURSOR_X (c, 1);
+ }
+
+ /* Draw the divider in the modeline. */
+ cmgoto (f, y_bot, WINDOW_TEXT_RIGHT (w));
+ send_string_to_tty_console (c, &divv, 1);
+ TTY_INC_CURSOR_X (c, 1);
+ tty_turn_off_face (w, MODELINE_INDEX);
+ }
+}
+
+/****************************************************************************
+ tty_clear_region
+
+ Clear the area in the box defined by the given parameters.
+ ****************************************************************************/
+static void
+tty_clear_region (Lisp_Object window, face_index findex, int x, int y,
+ int width, int height)
+{
+ struct window *w = XWINDOW (window);
+ struct frame *f = XFRAME (w->frame);
+ struct console *c = XCONSOLE (FRAME_CONSOLE (f));
+ int line;
+
+ if (!width || !height)
+ return;
+
+ tty_turn_on_face (w, findex);
+ for (line = y; line < y + height; line++)
+ {
+ int col;
+
+ cmgoto (f, line, x);
+
+ if (window_is_leftmost (w)
+ && window_is_rightmost (w)
+ && TTY_SE (c).clr_to_eol)
+ {
+ OUTPUT1 (c, TTY_SE (c).clr_to_eol);
+ }
+ else
+ {
+ unsigned char sp = ' ';
+ /* #### Of course, this is all complete and utter crap. */
+ for (col = x; col < x + width; col++)
+ send_string_to_tty_console (c, &sp, 1);
+ TTY_INC_CURSOR_X (c, width);
+ }
+ }
+ tty_turn_off_face (w, findex);
+ cmgoto (f, y, x);
+}
+
+/*****************************************************************************
+ tty_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
+tty_clear_to_window_end (struct window *w, int ypos1, int ypos2)
+{
+ struct frame *f = XFRAME (w->frame);
+ struct console *c = XCONSOLE (FRAME_CONSOLE (f));
+ int x, width;
+
+ x = WINDOW_TEXT_LEFT (w);
+ width = WINDOW_TEXT_WIDTH (w);
+
+ if (window_is_rightmost (w))
+ {
+ /* #### Optimize to use clr_to_eol function of tty if available, if
+ the window is the entire width of the frame. */
+ /* #### Is this actually an optimization? */
+ int line;
+ tty_turn_on_face (w, DEFAULT_INDEX);
+ for (line = ypos1; line < ypos2; line++)
+ {
+ cmgoto (XFRAME (w->frame), line, x);
+ OUTPUT1 (c, TTY_SE (c).clr_to_eol);
+ }
+ tty_turn_off_face (w, DEFAULT_INDEX);
+ }
+ else
+ {
+ Lisp_Object window;
+
+ XSETWINDOW (window, w);
+ tty_clear_region (window, DEFAULT_INDEX, x, ypos1, width, ypos2 - ypos1);
+ }
+}
+
+/****************************************************************************
+ tty_clear_frame
+
+ Clear the entire frame.
+ ****************************************************************************/
+static void
+tty_clear_frame (struct frame *f)
+{
+ struct console *c = XCONSOLE (FRAME_CONSOLE (f));
+
+ tty_turn_on_frame_face (f, Vdefault_face);
+ if (TTY_SE (c).clr_frame)
+ {
+ OUTPUT1 (c, TTY_SE (c).clr_frame);
+ CONSOLE_TTY_REAL_CURSOR_X (c) = 0;
+ CONSOLE_TTY_REAL_CURSOR_Y (c) = 0;
+#ifdef NOT_SURE
+ FRAME_CURSOR_X (f) = 0;
+ FRAME_CURSOR_Y (f) = 0;
+#endif
+ }
+ else
+ {
+#ifdef NOT_SURE
+ internal_cursor_to (f, 0, 0);
+ clear_to_end (f);
+#else
+ /* #### Not implemented. */
+ fprintf (stderr, "Not yet.\n");
+#endif
+ }
+ tty_turn_off_frame_face (f, Vdefault_face);
+}
+
+static void
+tty_output_bufbyte_string (struct window *w, struct display_line *dl,
+ Bufbyte *str, Bytecount len, int xpos,
+ face_index findex, int cursor)
+{
+ struct frame *f = XFRAME (w->frame);
+ struct console *c = XCONSOLE (FRAME_CONSOLE (f));
+
+ /* First position the cursor. */
+ cmgoto (f, dl->ypos - 1, xpos);
+
+ /* Enable any face properties. */
+ tty_turn_on_face (w, findex);
+
+ send_string_to_tty_console (c, str, len);
+ TTY_INC_CURSOR_X (c, bufbyte_string_displayed_columns (str, len));
+
+ /* Turn the face properties back off. */
+ tty_turn_off_face (w, findex);
+}
+
+static Bufbyte_dynarr *tty_output_emchar_dynarr_dynarr;
+
+/*****************************************************************************
+ tty_output_emchar_dynarr
+
+ Given a string and a starting position, output that string in the
+ given face. If cursor is true, draw a cursor around the string.
+ ****************************************************************************/
+static void
+tty_output_emchar_dynarr (struct window *w, struct display_line *dl,
+ Emchar_dynarr *buf, int xpos, face_index findex,
+ int cursor)
+{
+ if (!tty_output_emchar_dynarr_dynarr)
+ tty_output_emchar_dynarr_dynarr = Dynarr_new (Bufbyte);
+ else
+ Dynarr_reset (tty_output_emchar_dynarr_dynarr);
+
+ convert_emchar_string_into_bufbyte_dynarr (Dynarr_atp (buf, 0),
+ Dynarr_length (buf),
+ tty_output_emchar_dynarr_dynarr);
+
+ tty_output_bufbyte_string (w, dl,
+ Dynarr_atp (tty_output_emchar_dynarr_dynarr, 0),
+ Dynarr_length (tty_output_emchar_dynarr_dynarr),
+ xpos, findex, cursor);
+}
+
+#if 0
+
+static Bufbyte_dynarr *sidcs_dynarr;
+
+static void
+substitute_in_dynamic_color_string (Lisp_Object spec, Lisp_Object string)
+{
+ int i;
+ Bufbyte *specdata = XSTRING_DATA (spec);
+ Bytecount speclen = XSTRING_LENGTH (spec);
+
+ if (!sidcs_dynarr)
+ sidcs_dynarr = Dynarr_new (Bufbyte);
+ else
+ Dynarr_reset (sidcs_dynarr);
+
+ for (i = 0; i < speclen; i++)
+ {
+ if (specdata[i] == '%' && specdata[i+1] == '%')
+ {
+ Dynarr_add (sidcs_dynarr, '%');
+ i++;
+ }
+ else if (specdata[i] == '%' && specdata[i+1] == 's')
+ {
+ Dynarr_add_many (sidcs_dynarr,
+ XSTRING_DATA (string),
+ XSTRING_LENGTH (string));
+ i++;
+ }
+ else
+ Dynarr_add (sidcs_dynarr, specdata[i]);
+ }
+}
+
+#endif
+
+static void
+set_foreground_to (struct console *c, Lisp_Object sym)
+{
+ Lisp_Object result;
+ Bufbyte *escseq = 0;
+ Bytecount escseqlen = 0;
+
+ result = assq_no_quit (sym, Vtty_color_alist);
+ if (!NILP (result))
+ {
+ Lisp_Object esc_seq = XCAR (XCDR (result));
+ escseq = XSTRING_DATA (esc_seq);
+ escseqlen = XSTRING_LENGTH (esc_seq);
+ }
+#if 0
+ else if (STRINGP (Vtty_dynamic_color_fg))
+ {
+ substitute_in_dynamic_color_string (Vtty_dynamic_color_fg,
+ Fsymbol_name (sym));
+ escseq = Dynarr_atp (sidcs_dynarr, 0);
+ escseqlen = Dynarr_length (sidcs_dynarr);
+ }
+#endif
+
+ if (escseq)
+ {
+ send_string_to_tty_console (c, escseq, escseqlen);
+ }
+}
+
+static void
+set_background_to (struct console *c, Lisp_Object sym)
+{
+ Lisp_Object result;
+ Bufbyte *escseq = 0;
+ Bytecount escseqlen = 0;
+
+ result = assq_no_quit (sym, Vtty_color_alist);
+ if (!NILP (result))
+ {
+ Lisp_Object esc_seq = XCDR (XCDR (result));
+ escseq = XSTRING_DATA (esc_seq);
+ escseqlen = XSTRING_LENGTH (esc_seq);
+ }
+#if 0
+ else if (STRINGP (Vtty_dynamic_color_bg))
+ {
+ substitute_in_dynamic_color_string (Vtty_dynamic_color_bg,
+ Fsymbol_name (sym));
+ escseq = Dynarr_atp (sidcs_dynarr, 0);
+ escseqlen = Dynarr_length (sidcs_dynarr);
+ }
+#endif
+
+ if (escseq)
+ {
+ send_string_to_tty_console (c, escseq, escseqlen);
+ }
+}
+
+static void
+tty_turn_on_face_1 (struct console *c, int highlight_p,
+ int blinking_p, int dim_p, int underline_p,
+ int reverse_p, Lisp_Object cinst_fore,
+ Lisp_Object cinst_back)
+{
+ if (highlight_p)
+ {
+ OUTPUT1_IF (c, TTY_SD (c).turn_on_bold);
+ }
+
+ if (blinking_p)
+ {
+ OUTPUT1_IF (c, TTY_SD (c).turn_on_blinking);
+ }
+
+ if (dim_p)
+ {
+ OUTPUT1_IF (c, TTY_SD (c).turn_on_dim);
+ }
+
+ if (underline_p)
+ {
+ /* #### punt for now if underline mode is glitchy */
+ if (!TTY_FLAGS (c).underline_width)
+ {
+ OUTPUT1_IF (c, TTY_SD (c).begin_underline);
+ }
+ }
+
+ if (reverse_p)
+ {
+ /* #### punt for now if standout mode is glitchy */
+ if (!TTY_FLAGS (c).standout_width)
+ {
+ OUTPUT1_IF (c, TTY_SD (c).begin_standout);
+ }
+ else
+ reverse_p = 0;
+ }
+
+ if (reverse_p)
+ {
+ Lisp_Object temp = cinst_fore;
+ cinst_fore = cinst_back;
+ cinst_back = temp;
+ }
+
+ if (COLOR_INSTANCEP (cinst_fore)
+ && !EQ (cinst_fore, Vthe_null_color_instance))
+ set_foreground_to (c, COLOR_INSTANCE_TTY_SYMBOL
+ (XCOLOR_INSTANCE (cinst_fore)));
+
+ if (COLOR_INSTANCEP (cinst_back)
+ && !EQ (cinst_back, Vthe_null_color_instance))
+ set_background_to (c, COLOR_INSTANCE_TTY_SYMBOL
+ (XCOLOR_INSTANCE (cinst_back)));
+}
+
+/*****************************************************************************
+ tty_turn_on_face
+
+ Turn on all set properties of the given face.
+ ****************************************************************************/
+static void
+tty_turn_on_face (struct window *w, face_index findex)
+{
+ struct frame *f = XFRAME (w->frame);
+ struct console *c = XCONSOLE (FRAME_CONSOLE (f));
+
+ tty_turn_on_face_1 (c,
+ WINDOW_FACE_CACHEL_HIGHLIGHT_P (w, findex),
+ WINDOW_FACE_CACHEL_BLINKING_P (w, findex),
+ WINDOW_FACE_CACHEL_DIM_P (w, findex),
+ WINDOW_FACE_CACHEL_UNDERLINE_P (w, findex),
+ WINDOW_FACE_CACHEL_REVERSE_P (w, findex),
+ WINDOW_FACE_CACHEL_FOREGROUND (w, findex),
+ WINDOW_FACE_CACHEL_BACKGROUND (w, findex));
+}
+
+/*****************************************************************************
+ tty_turn_off_face
+
+ Turn off all set properties of the given face (revert to default
+ face). We assume that tty_turn_on_face has been called for the given
+ face so that its properties are actually active.
+ ****************************************************************************/
+static void
+tty_turn_off_face (struct window *w, face_index findex)
+{
+ struct frame *f = XFRAME (w->frame);
+ struct console *c = XCONSOLE (FRAME_CONSOLE (f));
+
+ if (WINDOW_FACE_CACHEL_REVERSE_P (w, findex))
+ {
+ /* #### punt for now if standout mode is glitchy */
+ if (!TTY_FLAGS (c).standout_width)
+ {
+ OUTPUT1_IF (c, TTY_SD (c).end_standout);
+ }
+ }
+
+ if (WINDOW_FACE_CACHEL_UNDERLINE_P (w, findex))
+ {
+ /* #### punt for now if underline mode is glitchy */
+ if (!TTY_FLAGS (c).underline_width)
+ {
+ OUTPUT1_IF (c, TTY_SD (c).end_underline);
+ }
+ }
+
+ if (WINDOW_FACE_CACHEL_HIGHLIGHT_P (w, findex) ||
+ WINDOW_FACE_CACHEL_BLINKING_P (w, findex) ||
+ WINDOW_FACE_CACHEL_DIM_P (w, findex) ||
+ !EQ (WINDOW_FACE_CACHEL_FOREGROUND (w, findex),
+ Vthe_null_color_instance) ||
+ !EQ (WINDOW_FACE_CACHEL_BACKGROUND (w, findex),
+ Vthe_null_color_instance))
+ {
+ OUTPUT1_IF (c, TTY_SD (c).turn_off_attributes);
+ }
+}
+
+/*****************************************************************************
+ tty_turn_on_frame_face
+
+ Turn on all set properties of the given face.
+ ****************************************************************************/
+static void
+tty_turn_on_frame_face (struct frame *f, Lisp_Object face)
+{
+ Lisp_Object frame;
+ struct console *c = XCONSOLE (FRAME_CONSOLE (f));
+
+ XSETFRAME (frame, f);
+ tty_turn_on_face_1 (c,
+ FACE_HIGHLIGHT_P (face, frame),
+ FACE_BLINKING_P (face, frame),
+ FACE_DIM_P (face, frame),
+ FACE_UNDERLINE_P (face, frame),
+ FACE_REVERSE_P (face, frame),
+ FACE_FOREGROUND (face, frame),
+ FACE_BACKGROUND (face, frame));
+}
+
+/*****************************************************************************
+ tty_turn_off_frame_face
+
+ Turn off all set properties of the given face (revert to default
+ face). We assume that tty_turn_on_face has been called for the given
+ face so that its properties are actually active.
+ ****************************************************************************/
+static void
+tty_turn_off_frame_face (struct frame *f, Lisp_Object face)
+{
+ Lisp_Object frame;
+ struct console *c = XCONSOLE (FRAME_CONSOLE (f));
+
+ XSETFRAME (frame, f);
+
+ if (FACE_REVERSE_P (face, frame))
+ {
+ /* #### punt for now if standout mode is glitchy */
+ if (!TTY_FLAGS (c).standout_width)
+ {
+ OUTPUT1_IF (c, TTY_SD (c).end_standout);
+ }
+ }
+
+ if (FACE_UNDERLINE_P (face, frame))
+ {
+ /* #### punt for now if underline mode is glitchy */
+ if (!TTY_FLAGS (c).underline_width)
+ {
+ OUTPUT1_IF (c, TTY_SD (c).end_underline);
+ }
+ }
+
+ if (FACE_HIGHLIGHT_P (face, frame) ||
+ FACE_BLINKING_P (face, frame) ||
+ FACE_DIM_P (face, frame) ||
+ !EQ (FACE_FOREGROUND (face, frame), Vthe_null_color_instance) ||
+ !EQ (FACE_BACKGROUND (face, frame), Vthe_null_color_instance))
+ {
+ OUTPUT1_IF (c, TTY_SD (c).turn_off_attributes);
+ }
+}
+
+/*****************************************************************************
+ set_tty_modes
+
+ Sets up various parameters on tty modes.
+ ****************************************************************************/
+void
+set_tty_modes (struct console *c)
+{
+ if (!CONSOLE_TTY_P (c))
+ return;
+
+ OUTPUT1_IF (c, TTY_SD (c).init_motion);
+ OUTPUT1_IF (c, TTY_SD (c).cursor_visible);
+ OUTPUT1_IF (c, TTY_SD (c).keypad_on);
+}
+
+/*****************************************************************************
+ reset_tty_modes
+
+ Restore default state of tty.
+ ****************************************************************************/
+void
+reset_tty_modes (struct console *c)
+{
+ if (!CONSOLE_TTY_P (c))
+ return;
+
+ OUTPUT1_IF (c, TTY_SD (c).orig_pair);
+ OUTPUT1_IF (c, TTY_SD (c).keypad_off);
+ OUTPUT1_IF (c, TTY_SD (c).cursor_normal);
+ OUTPUT1_IF (c, TTY_SD (c).end_motion);
+ tty_output_end (XDEVICE (CONSOLE_SELECTED_DEVICE (c)));
+}
+
+/*****************************************************************************
+ tty_redisplay_shutdown
+
+ Clear the frame and position the cursor properly for exiting.
+ ****************************************************************************/
+void
+tty_redisplay_shutdown (struct console *c)
+{
+ Lisp_Object dev = CONSOLE_SELECTED_DEVICE (c);
+
+ if (!GC_NILP (dev))
+ {
+ Lisp_Object frm = DEVICE_SELECTED_FRAME (XDEVICE (dev));
+
+ if (!GC_NILP (frm))
+ {
+ struct frame *f = XFRAME (frm);
+
+ /* Clear the bottom line of the frame. */
+ tty_clear_region (FRAME_SELECTED_WINDOW (f), DEFAULT_INDEX, 0,
+ f->height, f->width, 1);
+
+ /* And then stick the cursor there. */
+ tty_set_final_cursor_coords (f, f->height, 0);
+ tty_output_end (XDEVICE (dev));
+ }
+ }
+}
+
+
+/* #### Everything below here is old shit. It should either be moved
+ up or removed. */
+
+
+/* FLAGS - these don't need to be console local since only one console
+ can be being updated at a time. */
+static int insert_mode_on; /* nonzero if in insert mode */
+static int standout_mode_on; /* nonzero if in standout mode */
+static int underline_mode_on; /* nonzero if in underline mode */
+static int alternate_mode_on; /* nonzero if in alternate char set */
+static int attributes_on; /* nonzero if any attributes on */
+
+#ifdef NOT_YET
+static void
+turn_on_insert (struct frame *f)
+{
+ struct console *c = XCONSOLE (FRAME_CONSOLE (f));
+
+ if (!insert_mode_on)
+ OUTPUT1_IF (c, TTY_SE (c).begin_ins_mode);
+ insert_mode_on = 1;
+}
+
+static void
+turn_off_insert (struct frame *f)
+{
+ struct console *c = XCONSOLE (FRAME_CONSOLE (f));
+
+ if (insert_mode_on)
+ OUTPUT1 (c, TTY_SE (c).end_ins_mode);
+ insert_mode_on = 0;
+}
+
+static void
+internal_cursor_to (struct frame *f, int row, int col)
+{
+ struct console *c = XCONSOLE (FRAME_CONSOLE (f));
+
+ if (!TTY_FLAGS (c).insert_mode_motion)
+ turn_off_insert (f);
+ if (!TTY_FLAGS (c).standout_motion)
+ {
+ turn_off_standout (f);
+ turn_off_underline (f);
+ turn_off_alternate (f);
+ }
+
+ cmgoto (f, row, col);
+}
+
+static void
+clear_to_end (struct frame *f)
+{
+ struct console *c = XCONSOLE (FRAME_CONSOLE (f));
+
+ /* assumes cursor is already positioned */
+ if (TTY_SE (c).clr_from_cursor)
+ {
+ OUTPUT1 (c, TTY_SE (c).clr_from_cursor);
+ }
+ else
+ {
+ int line = FRAME_CURSOR_Y (f);
+
+ while (line < FRAME_HEIGHT (f))
+ {
+ internal_cursor_to (f, line, 0);
+ OUTPUT1 (c, TTY_SE (c).clr_to_eol);
+ }
+ }
+}
+#endif /* 0 */
+\f
+#if 0
+/*
+ * clear from last visible line on window to window end (presumably
+ * the line above window's modeline
+ */
+static void
+tty_clear_window_end (struct window *w, int ystart, int yend)
+{
+ struct console *c = XCONSOLE (WINDOW_CONSOLE (w));
+ int line;
+
+ for (line = ystart; line < yend; line++)
+ {
+ cmgoto (XFRAME (w->frame), line, 0);
+ OUTPUT1 (c, TTY_SE (c).clr_to_eol);
+ }
+}
+
+#endif /* 0 */
+
+static int
+tty_flash (struct device *d)
+{
+ struct console *c = XCONSOLE (DEVICE_CONSOLE (d));
+ if (TTY_SD (c).visual_bell)
+ {
+ OUTPUT1 (c, TTY_SD (c).visual_bell);
+ Lstream_flush (XLSTREAM (CONSOLE_TTY_DATA (c)->outstream));
+ return 1;
+ }
+ else
+ return 0;
+}
+
+/*
+ * tty_ring_bell - sound an audio beep.
+ */
+static void
+tty_ring_bell (struct device *d, int volume, int pitch, int duration)
+{
+ struct console *c = XCONSOLE (DEVICE_CONSOLE (d));
+
+ if (volume)
+ {
+ OUTPUT1 (c, TTY_SD (c).audio_bell);
+ Lstream_flush (XLSTREAM (CONSOLE_TTY_DATA (c)->outstream));
+ }
+}
+
+
+int
+init_tty_for_redisplay (struct device *d, char *terminal_type)
+{
+ int status;
+ char entry_buffer[2044];
+ /* char temp_buffer[2044]; */
+ char *bufptr;
+ struct console *c = XCONSOLE (DEVICE_CONSOLE (d));
+
+ /* What we should really do is allocate just enough space for
+ the actual strings that are stored; but this would require
+ doing this after all the tgetstr()s and adjusting all the
+ pointers. */
+ CONSOLE_TTY_DATA (c)->term_entry_buffer = (char *) xmalloc (2044);
+ bufptr = CONSOLE_TTY_DATA (c)->term_entry_buffer;
+
+#if !defined(WIN32)
+ /* SIGTT* don't exist under win32 */
+ EMACS_BLOCK_SIGNAL (SIGTTOU);
+#endif
+ status = tgetent (entry_buffer, terminal_type);
+#if !defined(WIN32)
+ EMACS_UNBLOCK_SIGNAL (SIGTTOU);
+#endif
+#if 0
+ if (status < 0)
+ return TTY_UNABLE_OPEN_DATABASE;
+ else if (status == 0)
+ return TTY_TYPE_UNDEFINED;
+#endif
+ /* Under Linux at least, <0 is returned for TTY_TYPE_UNDEFINED. --ben */
+ if (status <= 0)
+ return TTY_TYPE_UNDEFINED;
+
+ /*
+ * Establish the terminal size.
+ */
+ /* First try to get the info from the system. If that fails, check
+ the termcap entry. */
+ get_tty_device_size (d, &CONSOLE_TTY_DATA (c)->width,
+ &CONSOLE_TTY_DATA (c)->height);
+
+ if (CONSOLE_TTY_DATA (c)->width <= 0)
+ CONSOLE_TTY_DATA (c)->width = tgetnum ("co");
+ if (CONSOLE_TTY_DATA (c)->height <= 0)
+ CONSOLE_TTY_DATA (c)->height = tgetnum ("li");
+
+ if (CONSOLE_TTY_DATA (c)->width <= 0 || CONSOLE_TTY_DATA (c)->height <= 0)
+ return TTY_SIZE_UNSPECIFIED;
+
+ /*
+ * Initialize cursor motion information.
+ */
+
+ /* local cursor movement */
+ TTY_CM (c).up = tgetstr ("up", &bufptr);
+ TTY_CM (c).down = tgetstr ("do", &bufptr);
+ TTY_CM (c).left = tgetstr ("le", &bufptr);
+ TTY_CM (c).right = tgetstr ("nd", &bufptr);
+ TTY_CM (c).home = tgetstr ("ho", &bufptr);
+ TTY_CM (c).low_left = tgetstr ("ll", &bufptr);
+ TTY_CM (c).car_return = tgetstr ("cr", &bufptr);
+
+ /* absolute cursor motion */
+ TTY_CM (c).abs = tgetstr ("cm", &bufptr);
+ TTY_CM (c).hor_abs = tgetstr ("ch", &bufptr);
+ TTY_CM (c).ver_abs = tgetstr ("cv", &bufptr);
+
+ /* Verify that the terminal is powerful enough to run Emacs */
+ if (!TTY_CM (c).abs)
+ {
+ if (!TTY_CM (c).up || !TTY_CM (c).down
+ || !TTY_CM (c).left || !TTY_CM (c).right)
+ return TTY_TYPE_INSUFFICIENT;
+ }
+
+ /* parameterized local cursor movement */
+ TTY_CM (c).multi_up = tgetstr ("UP", &bufptr);
+ TTY_CM (c).multi_down = tgetstr ("DO", &bufptr);
+ TTY_CM (c).multi_left = tgetstr ("LE", &bufptr);
+ TTY_CM (c).multi_right = tgetstr ("RI", &bufptr);
+
+ /* scrolling */
+ TTY_CM (c).scroll_forw = tgetstr ("sf", &bufptr);
+ TTY_CM (c).scroll_back = tgetstr ("sr", &bufptr);
+ TTY_CM (c).multi_scroll_forw = tgetstr ("SF", &bufptr);
+ TTY_CM (c).multi_scroll_back = tgetstr ("SR", &bufptr);
+ TTY_CM (c).set_scroll_region = tgetstr ("cs", &bufptr);
+
+
+ /*
+ * Initialize screen editing information.
+ */
+
+ /* adding to the screen */
+ TTY_SE (c).ins_line = tgetstr ("al", &bufptr);
+ TTY_SE (c).multi_ins_line = tgetstr ("AL", &bufptr);
+ TTY_SE (c).repeat = tgetstr ("rp", &bufptr);
+ TTY_SE (c).begin_ins_mode = tgetstr ("im", &bufptr);
+ TTY_SE (c).end_ins_mode = tgetstr ("ei", &bufptr);
+ TTY_SE (c).ins_char = tgetstr ("ic", &bufptr);
+ TTY_SE (c).multi_ins_char = tgetstr ("IC", &bufptr);
+ TTY_SE (c).insert_pad = tgetstr ("ip", &bufptr);
+
+ /* deleting from the screen */
+ TTY_SE (c).clr_frame = tgetstr ("cl", &bufptr);
+ TTY_SE (c).clr_from_cursor = tgetstr ("cd", &bufptr);
+ TTY_SE (c).clr_to_eol = tgetstr ("ce", &bufptr);
+ TTY_SE (c).del_line = tgetstr ("dl", &bufptr);
+ TTY_SE (c).multi_del_line = tgetstr ("DL", &bufptr);
+ TTY_SE (c).del_char = tgetstr ("dc", &bufptr);
+ TTY_SE (c).multi_del_char = tgetstr ("DC", &bufptr);
+ TTY_SE (c).begin_del_mode = tgetstr ("dm", &bufptr);
+ TTY_SE (c).end_del_mode = tgetstr ("ed", &bufptr);
+ TTY_SE (c).erase_at_cursor = tgetstr ("ec", &bufptr);
+
+
+ /*
+ * Initialize screen display information.
+ */
+ TTY_SD (c).begin_standout = tgetstr ("so", &bufptr);
+ TTY_SD (c).end_standout = tgetstr ("se", &bufptr);
+ TTY_SD (c).begin_underline = tgetstr ("us", &bufptr);
+ TTY_SD (c).end_underline = tgetstr ("ue", &bufptr);
+ TTY_SD (c).begin_alternate = tgetstr ("as", &bufptr);
+ TTY_SD (c).end_alternate = tgetstr ("ae", &bufptr);
+ TTY_SD (c).turn_on_reverse = tgetstr ("mr", &bufptr);
+ TTY_SD (c).turn_on_blinking = tgetstr ("mb", &bufptr);
+ TTY_SD (c).turn_on_bold = tgetstr ("md", &bufptr);
+ TTY_SD (c).turn_on_dim = tgetstr ("mh", &bufptr);
+ TTY_SD (c).turn_off_attributes = tgetstr ("me", &bufptr);
+ TTY_SD (c).orig_pair = tgetstr ("op", &bufptr);
+
+ TTY_SD (c).visual_bell = tgetstr ("vb", &bufptr);
+ TTY_SD (c).audio_bell = tgetstr ("bl", &bufptr);
+ if (!TTY_SD (c).audio_bell)
+ {
+ /* If audio_bell doesn't get set, then assume C-g. This is gross and
+ ugly but is what Emacs has done from time immortal. */
+ TTY_SD (c).audio_bell = "\07";
+ }
+
+ TTY_SD (c).cursor_visible = tgetstr ("ve", &bufptr);
+ TTY_SD (c).cursor_normal = tgetstr ("vs", &bufptr);
+ TTY_SD (c).init_motion = tgetstr ("ti", &bufptr);
+ TTY_SD (c).end_motion = tgetstr ("te", &bufptr);
+ TTY_SD (c).keypad_on = tgetstr ("ks", &bufptr);
+ TTY_SD (c).keypad_off = tgetstr ("ke", &bufptr);
+
+
+ /*
+ * Initialize additional terminal information.
+ */
+ TTY_FLAGS (c).must_write_spaces = tgetflag ("in");
+ TTY_FLAGS (c).insert_mode_motion = tgetflag ("mi");
+ TTY_FLAGS (c).standout_motion = tgetflag ("ms");
+ TTY_FLAGS (c).memory_above_frame = tgetflag ("da");
+ TTY_FLAGS (c).memory_below_frame = tgetflag ("db");
+ TTY_FLAGS (c).standout_width = tgetnum ("sg");
+ TTY_FLAGS (c).underline_width = tgetnum ("ug");
+
+ if (TTY_FLAGS (c).standout_width == -1)
+ TTY_FLAGS (c).standout_width = 0;
+ if (TTY_FLAGS (c).underline_width == -1)
+ TTY_FLAGS (c).underline_width = 0;
+
+ TTY_FLAGS (c).meta_key =
+ eight_bit_tty (d) ? tgetflag ("km") || tgetflag ("MT") ? 1 : 2 : 0;
+
+
+ /*
+ * Setup the costs tables for this tty console.
+ */
+ cm_cost_init (c);
+
+ /*
+ * Initialize local flags.
+ */
+ insert_mode_on = 0;
+ standout_mode_on = 0;
+ underline_mode_on = 0;
+ alternate_mode_on = 0;
+ attributes_on = 0;
+
+ /*
+ * Attempt to initialize the function_key_map to
+ * some kind of sensible value
+ */
+
+ term_get_fkeys (c->function_key_map, &bufptr);
+
+ {
+ /* check for ANSI set-foreground and set-background strings,
+ and assume color if so.
+
+ #### we should support the other (non-ANSI) ways of specifying
+ color, too. */
+ char foobuf[500];
+ char *fooptr = foobuf;
+ if ((tgetstr ("AB", &fooptr) && tgetstr ("AF", &fooptr)) ||
+ (tgetstr ("Sf", &fooptr) && tgetstr ("Sb", &fooptr)) ||
+ ((tgetnum ("Co") > 0) && (tgetnum ("pa") > 0)))
+ DEVICE_CLASS (d) = Qcolor;
+ else
+ DEVICE_CLASS (d) = Qmono;
+ }
+
+ return TTY_INIT_SUCCESS;
+}
+\f
+struct fkey_table
+{
+ CONST char *cap, *name;
+};
+
+ /* Termcap capability names that correspond directly to X keysyms.
+ Some of these (marked "terminfo") aren't supplied by old-style
+ (Berkeley) termcap entries. They're listed in X keysym order;
+ except we put the keypad keys first, so that if they clash with
+ other keys (as on the IBM PC keyboard) they get overridden.
+ */
+
+static struct fkey_table keys[] =
+{
+ {"kh", "home"}, /* termcap */
+ {"kl", "left"}, /* termcap */
+ {"ku", "up"}, /* termcap */
+ {"kr", "right"}, /* termcap */
+ {"kd", "down"}, /* termcap */
+ {"%8", "prior"}, /* terminfo */
+ {"%5", "next"}, /* terminfo */
+ {"@7", "end"}, /* terminfo */
+ {"@1", "begin"}, /* terminfo */
+ {"*6", "select"}, /* terminfo */
+ {"%9", "print"}, /* terminfo */
+ {"@4", "execute"}, /* terminfo --- actually the `command' key */
+ /*
+ * "insert" --- see below
+ */
+ {"&8", "undo"}, /* terminfo */
+ {"%0", "redo"}, /* terminfo */
+ {"%7", "menu"}, /* terminfo --- actually the `options' key */
+ {"@0", "find"}, /* terminfo */
+ {"@2", "cancel"}, /* terminfo */
+ {"%1", "help"}, /* terminfo */
+ /*
+ * "break" goes here, but can't be reliably intercepted with termcap
+ */
+ {"&4", "reset"}, /* terminfo --- actually `restart' */
+ /*
+ * "system" and "user" --- no termcaps
+ */
+ {"kE", "clearline"}, /* terminfo */
+ {"kA", "insertline"}, /* terminfo */
+ {"kL", "deleteline"}, /* terminfo */
+ {"kI", "insertchar"}, /* terminfo */
+ {"kD", "delete"}, /* terminfo */
+ {"kB", "backtab"}, /* terminfo */
+ /*
+ * "kp-backtab", "kp-space", "kp-tab" --- no termcaps
+ */
+ {"@8", "kp-enter"}, /* terminfo */
+ /*
+ * "kp-f1", "kp-f2", "kp-f3" "kp-f4",
+ * "kp-multiply", "kp-add", "kp-separator",
+ * "kp-subtract", "kp-decimal", "kp-divide", "kp-0";
+ * --- no termcaps for any of these.
+ */
+ {"K4", "kp-1"}, /* terminfo */
+ /*
+ * "kp-2" --- no termcap
+ */
+ {"K5", "kp-3"}, /* terminfo */
+ /*
+ * "kp-4" --- no termcap
+ */
+ {"K2", "kp-5"}, /* terminfo */
+ /*
+ * "kp-6" --- no termcap
+ */
+ {"K1", "kp-7"}, /* terminfo */
+ /*
+ * "kp-8" --- no termcap
+ */
+ {"K3", "kp-9"}, /* terminfo */
+ /*
+ * "kp-equal" --- no termcap
+ */
+ {"k1", "f1"},
+ {"k2", "f2"},
+ {"k3", "f3"},
+ {"k4", "f4"},
+ {"k5", "f5"},
+ {"k6", "f6"},
+ {"k7", "f7"},
+ {"k8", "f8"},
+ {"k9", "f9"},
+};
+
+static char **term_get_fkeys_arg;
+
+static Lisp_Object term_get_fkeys_1 (Lisp_Object keymap);
+static Lisp_Object term_get_fkeys_error (Lisp_Object err, Lisp_Object arg);
+
+/* Find the escape codes sent by the function keys for Vfunction_key_map.
+ This function scans the termcap function key sequence entries, and
+ adds entries to Vfunction_key_map for each function key it finds. */
+
+static void
+term_get_fkeys (Lisp_Object keymap, char **address)
+{
+ /* We run the body of the function (term_get_fkeys_1) and ignore all Lisp
+ errors during the call. The only errors should be from Fdefine_key
+ when given a key sequence containing an invalid prefix key. If the
+ termcap defines function keys which use a prefix that is already bound
+ to a command by the default bindings, we should silently ignore that
+ function key specification, rather than giving the user an error and
+ refusing to run at all on such a terminal. */
+
+ term_get_fkeys_arg = address;
+
+ condition_case_1 (Qerror,
+ term_get_fkeys_1, keymap,
+ term_get_fkeys_error, Qnil);
+}
+
+static Lisp_Object
+term_get_fkeys_error (Lisp_Object err, Lisp_Object arg)
+{
+ return arg;
+}
+
+static Lisp_Object
+term_get_fkeys_1 (Lisp_Object function_key_map)
+{
+ int i;
+
+ char **address = term_get_fkeys_arg;
+
+ for (i = 0; i < countof (keys); i++)
+ {
+ char *sequence = tgetstr (keys[i].cap, address);
+ if (sequence)
+ Fdefine_key (function_key_map,
+ build_ext_string (sequence, FORMAT_BINARY),
+ vector1 (intern (keys[i].name)));
+ }
+
+ /* The uses of the "k0" capability are inconsistent; sometimes it
+ 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";
+
+ if (k_semi)
+ {
+ Fdefine_key (function_key_map, build_ext_string (k_semi, FORMAT_BINARY),
+ vector1 (intern ("f10")));
+ k0_name = "f0";
+ }
+
+ if (k0)
+ Fdefine_key (function_key_map, build_ext_string (k0, FORMAT_BINARY),
+ vector1 (intern (k0_name)));
+ }
+
+ /* Set up cookies for numbered function keys above f10. */
+ {
+ char fcap[3], fkey[4];
+
+ fcap[0] = 'F'; fcap[2] = '\0';
+ for (i = 11; i < 64; i++)
+ {
+ if (i <= 19)
+ fcap[1] = '1' + i - 11;
+ else if (i <= 45)
+ fcap[1] = 'A' + i - 20;
+ else
+ fcap[1] = 'a' + i - 46;
+
+ {
+ char *sequence = tgetstr (fcap, address);
+ if (sequence)
+ {
+ sprintf (fkey, "f%d", i);
+ Fdefine_key (function_key_map,
+ build_ext_string (sequence, FORMAT_BINARY),
+ 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))); \
+ }
+
+ /* 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");
+#undef CONDITIONAL_REASSIGN
+ }
+
+ return Qnil;
+}
+
+\f
+/************************************************************************/
+/* initialization */
+/************************************************************************/
+
+void
+console_type_create_redisplay_tty (void)
+{
+ /* redisplay methods */
+ CONSOLE_HAS_METHOD (tty, text_width);
+ CONSOLE_HAS_METHOD (tty, output_display_block);
+ CONSOLE_HAS_METHOD (tty, output_vertical_divider);
+ CONSOLE_HAS_METHOD (tty, divider_height);
+ CONSOLE_HAS_METHOD (tty, eol_cursor_width);
+ CONSOLE_HAS_METHOD (tty, clear_to_window_end);
+ CONSOLE_HAS_METHOD (tty, clear_region);
+ CONSOLE_HAS_METHOD (tty, clear_frame);
+ CONSOLE_HAS_METHOD (tty, output_begin);
+ CONSOLE_HAS_METHOD (tty, output_end);
+ CONSOLE_HAS_METHOD (tty, flash);
+ CONSOLE_HAS_METHOD (tty, ring_bell);
+ CONSOLE_HAS_METHOD (tty, set_final_cursor_coords);
+}
--- /dev/null
+/* X output and frame manipulation routines.
+ Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
+ Copyright (C) 1994 Lucid, 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: Not in FSF. */
+
+/* Author: Chuck Thompson */
+
+/* Lots of work done by Ben Wing for Mule */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "console-x.h"
+#include "EmacsFrame.h"
+#include "EmacsFrameP.h"
+#include "xgccache.h"
+#include "glyphs-x.h"
+#include "objects-x.h"
+
+#include "buffer.h"
+#include "debug.h"
+#include "faces.h"
+#include "frame.h"
+#include "redisplay.h"
+#include "sysdep.h"
+#include "window.h"
+#include <X11/bitmaps/gray>
+
+#include "sysproc.h" /* for select() */
+
+#ifdef MULE
+#include "mule-ccl.h"
+#include "file-coding.h" /* for CCL conversion */
+#endif
+
+/* Number of pixels below each line. */
+/* #### implement me */
+int x_interline_space;
+
+#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,
+ int cursor_start, int cursor_width);
+static void x_output_hline (struct window *w, struct display_line *dl,
+ struct rune *rb);
+static void x_redraw_exposed_window (struct window *w, int x, int y,
+ int width, int height);
+static void x_redraw_exposed_windows (Lisp_Object window, int x, int y,
+ int width, int height);
+static void x_clear_region (Lisp_Object window, face_index findex, int x,
+ int y, int width, int height);
+static void x_output_eol_cursor (struct window *w, struct display_line *dl,
+ 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.
+ Those functions are generally losing for a number of reasons:
+
+ 1) They only support one locale (e.g. you could display
+ Japanese and ASCII text, but not mixed Japanese/Chinese
+ text). You could maybe call setlocale() frequently
+ to try to deal with this, but that would generally
+ fail because an XFontSet is tied to one locale and
+ won't have the other character sets in it.
+ 2) Not all (or even very many) OS's support the useful
+ locales. For example, as far as I know SunOS and
+ Solaris only support the Japanese locale if you get the
+ special Asian-language version of the OS. Yuck yuck
+ yuck. Linux doesn't support the Japanese locale at
+ all.
+ 3) The locale support in X only exists in R5, not in R4.
+ (Not sure how big of a problem this is: how many
+ people are using R4?)
+ 4) Who knows if the multi-byte text format (which is locale-
+ specific) is even the same for the same locale on
+ different OS's? It's not even documented anywhere that
+ I can find what the multi-byte text format for the
+ Japanese locale under SunOS and Solaris is, but I assume
+ it's EUC.
+ */
+
+struct textual_run
+{
+ Lisp_Object charset;
+ unsigned char *ptr;
+ int len;
+ int dimension;
+};
+
+/* Separate out the text in DYN into a series of textual runs of a
+ particular charset. Also convert the characters as necessary into
+ the format needed by XDrawImageString(), XDrawImageString16(), et
+ al. (This means converting to one or two byte format, possibly
+ tweaking the high bits, and possibly running a CCL program.) You
+ must pre-allocate the space used and pass it in. (This is done so
+ you can alloca() the space.) You need to allocate (2 * len) bytes
+ of TEXT_STORAGE and (len * sizeof (struct textual_run)) bytes of
+ RUN_STORAGE, where LEN is the length of the dynarr.
+
+ Returns the number of runs actually used. */
+
+static int
+separate_textual_runs (unsigned char *text_storage,
+ struct textual_run *run_storage,
+ CONST Emchar *str, Charcount len)
+{
+ Lisp_Object prev_charset = Qunbound; /* not Qnil because that is a
+ possible valid charset when
+ MULE is not defined */
+ int runs_so_far = 0;
+ int i;
+#ifdef MULE
+ struct ccl_program char_converter;
+ int need_ccl_conversion = 0;
+#endif
+
+ for (i = 0; i < len; i++)
+ {
+ Emchar ch = str[i];
+ Lisp_Object charset;
+ int byte1, byte2;
+ int dimension;
+ int graphic;
+
+ BREAKUP_CHAR (ch, charset, byte1, byte2);
+ dimension = XCHARSET_DIMENSION (charset);
+ graphic = XCHARSET_GRAPHIC (charset);
+
+ if (!EQ (charset, prev_charset))
+ {
+ run_storage[runs_so_far].ptr = text_storage;
+ run_storage[runs_so_far].charset = charset;
+ run_storage[runs_so_far].dimension = dimension;
+
+ if (runs_so_far)
+ {
+ run_storage[runs_so_far - 1].len =
+ text_storage - run_storage[runs_so_far - 1].ptr;
+ if (run_storage[runs_so_far - 1].dimension == 2)
+ run_storage[runs_so_far - 1].len >>= 1;
+ }
+ runs_so_far++;
+ prev_charset = charset;
+#ifdef MULE
+ {
+ Lisp_Object ccl_prog = XCHARSET_CCL_PROGRAM (charset);
+ need_ccl_conversion = !NILP (ccl_prog);
+ if (need_ccl_conversion)
+ setup_ccl_program (&char_converter, ccl_prog);
+ }
+#endif
+ }
+
+ if (graphic == 0)
+ {
+ byte1 &= 0x7F;
+ byte2 &= 0x7F;
+ }
+ else if (graphic == 1)
+ {
+ byte1 |= 0x80;
+ byte2 |= 0x80;
+ }
+#ifdef MULE
+ if (need_ccl_conversion)
+ {
+ 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);
+ byte1 = char_converter.reg[1];
+ byte2 = char_converter.reg[2];
+ }
+#endif
+ *text_storage++ = (unsigned char) byte1;
+ if (dimension == 2)
+ *text_storage++ = (unsigned char) byte2;
+ }
+
+ if (runs_so_far)
+ {
+ run_storage[runs_so_far - 1].len =
+ text_storage - run_storage[runs_so_far - 1].ptr;
+ if (run_storage[runs_so_far - 1].dimension == 2)
+ run_storage[runs_so_far - 1].len >>= 1;
+ }
+
+ return runs_so_far;
+}
+
+/****************************************************************************/
+/* */
+/* X output routines */
+/* */
+/****************************************************************************/
+
+static int
+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);
+ if (!fi->proportional_p)
+ return fi->width * run->len;
+ else
+ {
+ if (run->dimension == 2)
+ return XTextWidth16 (FONT_INSTANCE_X_FONT (fi),
+ (XChar2b *) run->ptr, run->len);
+ else
+ return XTextWidth (FONT_INSTANCE_X_FONT (fi),
+ (char *) run->ptr, run->len);
+ }
+}
+
+/*
+ x_text_width
+
+ Given a string and a face, return the string's length in pixels when
+ displayed in the font associated with the face.
+ */
+
+static int
+x_text_width (struct frame *f, struct face_cachel *cachel, CONST Emchar *str,
+ Charcount len)
+{
+ int width_so_far = 0;
+ unsigned char *text_storage = (unsigned char *) alloca (2 * len);
+ struct textual_run *runs = alloca_array (struct textual_run, len);
+ int nruns;
+ int i;
+
+ nruns = separate_textual_runs (text_storage, runs, str, len);
+
+ for (i = 0; i < nruns; i++)
+ width_so_far += x_text_width_single_run (cachel, runs + i);
+
+ return width_so_far;
+}
+
+/*****************************************************************************
+ x_divider_height
+
+ Return the height of the horizontal divider. This is a function because
+ divider_height is a device method.
+
+ #### If we add etched horizontal divider lines this will have to get
+ smarter.
+ ****************************************************************************/
+static int
+x_divider_height (void)
+{
+ return 1;
+}
+
+/*****************************************************************************
+ x_eol_cursor_width
+
+ Return the width of the end-of-line cursor. This is a function
+ because eol_cursor_width is a device method.
+ ****************************************************************************/
+static int
+x_eol_cursor_width (void)
+{
+ return EOL_CURSOR_WIDTH;
+}
+
+/*****************************************************************************
+ x_output_begin
+
+ Perform any necessary initialization prior to an update.
+ ****************************************************************************/
+static void
+x_output_begin (struct device *d)
+{
+}
+
+/*****************************************************************************
+ x_output_end
+
+ Perform any necessary flushing of queues when an update has completed.
+ ****************************************************************************/
+static void
+x_output_end (struct device *d)
+{
+ XFlush (DEVICE_X_DISPLAY (d));
+}
+
+/*****************************************************************************
+ x_output_display_block
+
+ Given a display line, a block number for that start line, output all
+ runes between start and end in the specified display block.
+ ****************************************************************************/
+static void
+x_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_height)
+{
+ struct frame *f = XFRAME (w->frame);
+ Emchar_dynarr *buf = Dynarr_new (Emchar);
+ Lisp_Object window;
+
+ struct display_block *db = Dynarr_atp (dl->display_blocks, block);
+ rune_dynarr *rba = db->runes;
+ struct rune *rb;
+
+ int elt = start;
+ face_index findex;
+ int xpos, width;
+ Lisp_Object charset = Qunbound; /* Qnil is a valid charset when
+ MULE is not defined */
+
+ XSETWINDOW (window, w);
+ 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);
+ }
+
+ if (end < 0)
+ end = Dynarr_length (rba);
+ Dynarr_reset (buf);
+
+ while (elt < end)
+ {
+ rb = Dynarr_atp (rba, elt);
+
+ if (rb->findex == findex && rb->type == RUNE_CHAR
+ && rb->object.chr.ch != '\n' && rb->cursor_type != CURSOR_ON
+ && EQ (charset, CHAR_CHARSET (rb->object.chr.ch)))
+ {
+ Dynarr_add (buf, rb->object.chr.ch);
+ width += rb->width;
+ elt++;
+ }
+ else
+ {
+ if (Dynarr_length (buf))
+ {
+ x_output_string (w, dl, buf, xpos, 0, start_pixpos, width,
+ findex, 0, cursor_start, cursor_width,
+ cursor_height);
+ xpos = rb->xpos;
+ width = 0;
+ }
+ Dynarr_reset (buf);
+ width = 0;
+
+ if (rb->type == RUNE_CHAR)
+ {
+ findex = rb->findex;
+ xpos = rb->xpos;
+ charset = CHAR_CHARSET (rb->object.chr.ch);
+
+ if (rb->cursor_type == CURSOR_ON)
+ {
+ if (rb->object.chr.ch == '\n')
+ {
+ x_output_eol_cursor (w, dl, xpos, findex);
+ }
+ else
+ {
+ Dynarr_add (buf, rb->object.chr.ch);
+ x_output_string (w, dl, buf, xpos, 0, start_pixpos,
+ rb->width, findex, 1,
+ cursor_start, cursor_width,
+ cursor_height);
+ Dynarr_reset (buf);
+ }
+
+ xpos += rb->width;
+ elt++;
+ }
+ else if (rb->object.chr.ch == '\n')
+ {
+ /* Clear in case a cursor was formerly here. */
+ int height = dl->ascent + dl->descent - dl->clip;
+
+ x_clear_region (window, findex, xpos, dl->ypos - dl->ascent,
+ rb->width, height);
+ elt++;
+ }
+ }
+ else if (rb->type == RUNE_BLANK || rb->type == RUNE_HLINE)
+ {
+ if (rb->type == RUNE_BLANK)
+ x_output_blank (w, dl, rb, start_pixpos, cursor_start,
+ cursor_width);
+ else
+ {
+ /* #### Our flagging of when we need to redraw the
+ modeline shadows sucks. Since RUNE_HLINE is only used
+ by the modeline at the moment it is a good bet
+ that if it gets redrawn then we should also
+ redraw the shadows. This won't be true forever.
+ We borrow the shadow_thickness_changed flag for
+ now. */
+ w->shadow_thickness_changed = 1;
+ x_output_hline (w, dl, rb);
+ }
+
+ elt++;
+ if (elt < end)
+ {
+ rb = Dynarr_atp (rba, elt);
+
+ findex = rb->findex;
+ xpos = rb->xpos;
+ }
+ }
+ else if (rb->type == RUNE_DGLYPH)
+ {
+ Lisp_Object instance;
+
+ XSETWINDOW (window, w);
+ instance = glyph_image_instance (rb->object.dglyph.glyph,
+ window, ERROR_ME_NOT, 1);
+ findex = rb->findex;
+
+ if (IMAGE_INSTANCEP (instance))
+ switch (XIMAGE_INSTANCE_TYPE (instance))
+ {
+ case IMAGE_TEXT:
+ {
+ /* #### This is way losing. See the comment in
+ add_glyph_rune(). */
+ Lisp_Object string =
+ XIMAGE_INSTANCE_TEXT_STRING (instance);
+ convert_bufbyte_string_into_emchar_dynarr
+ (XSTRING_DATA (string), XSTRING_LENGTH (string), buf);
+
+ x_output_string (w, dl, buf, xpos,
+ rb->object.dglyph.xoffset,
+ start_pixpos, -1, findex,
+ (rb->cursor_type == CURSOR_ON),
+ cursor_start, cursor_width,
+ cursor_height);
+ Dynarr_reset (buf);
+ }
+ break;
+
+ 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);
+ break;
+
+ case IMAGE_POINTER:
+ abort ();
+
+ case IMAGE_SUBWINDOW:
+ /* #### implement me */
+ break;
+
+ case IMAGE_NOTHING:
+ /* nothing is as nothing does */
+ break;
+
+ default:
+ abort ();
+ }
+
+ xpos += rb->width;
+ elt++;
+ }
+ else
+ abort ();
+ }
+ }
+
+ if (Dynarr_length (buf))
+ x_output_string (w, dl, buf, xpos, 0, start_pixpos, width, findex,
+ 0, cursor_start, cursor_width, cursor_height);
+
+ /* #### This is really conditionalized well for optimized
+ performance. */
+ if (dl->modeline
+ && !EQ (Qzero, w->modeline_shadow_thickness)
+ && (f->clear
+ || f->windows_structure_changed
+ || w->shadow_thickness_changed))
+ x_bevel_modeline (w, dl);
+
+ Dynarr_free (buf);
+}
+
+/*****************************************************************************
+ x_bevel_modeline
+
+ Draw a 3d border around the modeline on window W.
+ ****************************************************************************/
+static void
+x_bevel_modeline (struct window *w, struct display_line *dl)
+{
+ struct frame *f = XFRAME (w->frame);
+ struct device *d = XDEVICE (f->device);
+ 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;
+ XColor tmp_color;
+ Lisp_Object tmp_pixel;
+ int x, y, width, height;
+ XGCValues gcv;
+ unsigned long mask;
+ int use_pixmap = 0;
+ int flip_gcs = 0;
+ int shadow_thickness;
+
+ memset (&gcv, ~0, sizeof (XGCValues));
+
+ tmp_pixel = WINDOW_FACE_CACHEL_BACKGROUND (w, MODELINE_INDEX);
+ 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, MODELINE_INDEX);
+ tmp_color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (tmp_pixel));
+ gcv.background = tmp_color.pixel;
+ gcv.graphics_exposures = False;
+ mask = GCForeground | GCBackground | GCGraphicsExposures;
+
+ 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, MODELINE_INDEX);
+ tmp_color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (tmp_pixel));
+ gcv.foreground = tmp_color.pixel;
+ 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_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);
+
+ if (XINT (w->modeline_shadow_thickness) < 0)
+ {
+ GC temp;
+
+ temp = top_shadow_gc;
+ top_shadow_gc = bottom_shadow_gc;
+ bottom_shadow_gc = temp;
+ }
+
+ shadow_thickness = MODELINE_SHADOW_THICKNESS (w);
+
+ 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);
+}
+
+/*****************************************************************************
+ x_get_gc
+
+ Given a number of parameters return a GC with those properties.
+ ****************************************************************************/
+static GC
+x_get_gc (struct device *d, Lisp_Object font, Lisp_Object fg, Lisp_Object bg,
+ Lisp_Object bg_pmap, Lisp_Object lwidth)
+{
+ XGCValues gcv;
+ unsigned long mask;
+
+ memset (&gcv, ~0, sizeof (XGCValues));
+ gcv.graphics_exposures = False;
+ /* Make absolutely sure that we don't pick up a clipping region in
+ the GC returned by this function. */
+ gcv.clip_mask = None;
+ gcv.clip_x_origin = 0;
+ gcv.clip_y_origin = 0;
+ gcv.fill_style = FillSolid;
+ mask = GCGraphicsExposures | GCClipMask | GCClipXOrigin | GCClipYOrigin;
+ mask |= GCFillStyle;
+
+ if (!NILP (font))
+ {
+ gcv.font = FONT_INSTANCE_X_FONT (XFONT_INSTANCE (font))->fid;
+ mask |= GCFont;
+ }
+
+ /* evil kludge! */
+ if (!NILP (fg) && !COLOR_INSTANCEP (fg) && !INTP (fg))
+ {
+ /* #### I fixed once case where this was getting it. It was a
+ bad macro expansion (compiler bug). */
+ fprintf (stderr, "Help! x_get_gc got a bogus fg value! fg = ");
+ debug_print (fg);
+ fg = Qnil;
+ }
+
+ if (!NILP (fg))
+ {
+ if (COLOR_INSTANCEP (fg))
+ gcv.foreground = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (fg)).pixel;
+ else
+ gcv.foreground = XINT (fg);
+ mask |= GCForeground;
+ }
+
+ if (!NILP (bg))
+ {
+ if (COLOR_INSTANCEP (bg))
+ gcv.background = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (bg)).pixel;
+ else
+ gcv.background = XINT (bg);
+ mask |= GCBackground;
+ }
+
+ if (IMAGE_INSTANCEP (bg_pmap)
+ && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap)))
+ {
+ if (XIMAGE_INSTANCE_PIXMAP_DEPTH (bg_pmap) == 0)
+ {
+ gcv.fill_style = FillOpaqueStippled;
+ gcv.stipple = XIMAGE_INSTANCE_X_PIXMAP (bg_pmap);
+ mask |= (GCStipple | GCFillStyle);
+ }
+ else
+ {
+ gcv.fill_style = FillTiled;
+ gcv.tile = XIMAGE_INSTANCE_X_PIXMAP (bg_pmap);
+ mask |= (GCTile | GCFillStyle);
+ }
+ }
+
+ if (!NILP (lwidth))
+ {
+ gcv.line_width = XINT (lwidth);
+ mask |= GCLineWidth;
+ }
+
+ return gc_cache_lookup (DEVICE_X_GC_CACHE (d), &gcv, mask);
+}
+
+/*****************************************************************************
+ x_output_string
+
+ Given a string and a starting position, output that string in the
+ given face. If cursor is true, draw a cursor around the string.
+ Correctly handles multiple charsets in the string.
+
+ The meaning of the parameters is something like this:
+
+ W Window that the text is to be displayed in.
+ DL Display line that this text is on. The values in the
+ structure are used to determine the vertical position and
+ clipping range of the text.
+ BUF Dynamic array of Emchars specifying what is actually to be
+ drawn.
+ XPOS X position in pixels where the text should start being drawn.
+ XOFFSET Number of pixels to be chopped off the left side of the
+ text. The effect is as if the text were shifted to the
+ left this many pixels and clipped at XPOS.
+ CLIP_START Clip everything left of this X position.
+ WIDTH Clip everything right of XPOS + WIDTH.
+ FINDEX Index for the face cache element describing how to display
+ the text.
+ CURSOR #### I don't understand this. There's something
+ strange and overcomplexified with this variable.
+ Chuck, explain please?
+ CURSOR_START Starting X position of cursor.
+ CURSOR_WIDTH Width of cursor in pixels.
+ CURSOR_HEIGHT Height of cursor in pixels.
+
+ Starting Y position of cursor is the top of the text line.
+ The cursor is drawn sometimes whether or not CURSOR is set. ???
+ ****************************************************************************/
+void
+x_output_string (struct window *w, struct display_line *dl,
+ 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)
+{
+ /* General variables */
+ struct frame *f = XFRAME (w->frame);
+ struct device *d = XDEVICE (f->device);
+ Lisp_Object device;
+ Lisp_Object window;
+ Display *dpy = DEVICE_X_DISPLAY (d);
+ Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f));
+
+ int clip_end;
+
+ /* Cursor-related variables */
+ int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d));
+ int cursor_clip;
+ Lisp_Object bar_cursor_value = symbol_value_in_buffer (Qbar_cursor,
+ WINDOW_BUFFER (w));
+ struct face_cachel *cursor_cachel = 0;
+
+ /* Text-related variables */
+ Lisp_Object bg_pmap;
+ GC bgc, gc;
+ int height;
+ int len = Dynarr_length (buf);
+ unsigned char *text_storage = (unsigned char *) alloca (2 * len);
+ struct textual_run *runs = alloca_array (struct textual_run, len);
+ int nruns;
+ int i;
+ struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, findex);
+
+ XSETDEVICE (device, d);
+ XSETWINDOW (window, w);
+
+ if (width < 0)
+ width = x_text_width (f, cachel, Dynarr_atp (buf, 0), Dynarr_length (buf));
+ height = dl->ascent + dl->descent - dl->clip;
+
+ /* Regularize the variables passed in. */
+
+ if (clip_start < xpos)
+ clip_start = xpos;
+ clip_end = xpos + width;
+ if (clip_start >= clip_end)
+ /* It's all clipped out. */
+ return;
+
+ xpos -= xoffset;
+
+ nruns = separate_textual_runs (text_storage, runs, Dynarr_atp (buf, 0),
+ Dynarr_length (buf));
+
+ cursor_clip = (cursor_start >= clip_start &&
+ cursor_start < clip_end);
+
+ /* This cursor code is really a mess. */
+ if (!NILP (w->text_cursor_visible_p)
+ && (cursor
+ || cursor_clip
+ || (cursor_width
+ && (cursor_start + cursor_width >= clip_start)
+ && !NILP (bar_cursor_value))))
+ {
+ /* These have to be in separate statements in order to avoid a
+ compiler bug. */
+ face_index sucks = get_builtin_face_cache_index (w, Vtext_cursor_face);
+ cursor_cachel = WINDOW_FACE_CACHEL (w, sucks);
+
+ /* We have to reset this since any call to WINDOW_FACE_CACHEL
+ may cause the cache to resize and any pointers to it to
+ become invalid. */
+ cachel = WINDOW_FACE_CACHEL (w, findex);
+ }
+
+#ifdef HAVE_XIM
+ if (cursor && focus && (cursor_start == clip_start) && cursor_height)
+ XIM_SetSpotLocation (f, xpos - 2, dl->ypos + dl->descent - 2);
+#endif /* HAVE_XIM */
+
+ bg_pmap = cachel->background_pixmap;
+ if (!IMAGE_INSTANCEP (bg_pmap)
+ || !IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap)))
+ bg_pmap = Qnil;
+
+ if ((cursor && focus && NILP (bar_cursor_value)
+ && !NILP (w->text_cursor_visible_p)) || NILP (bg_pmap))
+ bgc = 0;
+ else
+ bgc = x_get_gc (d, Qnil, cachel->foreground, cachel->background,
+ bg_pmap, Qnil);
+
+ if (bgc)
+ XFillRectangle (dpy, x_win, bgc, clip_start,
+ dl->ypos - dl->ascent, 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);
+ int this_width;
+ int need_clipping;
+
+ if (EQ (font, Vthe_null_font_instance))
+ continue;
+
+ this_width = x_text_width_single_run (cachel, runs + i);
+ need_clipping = (dl->clip || clip_start > xpos ||
+ clip_end < xpos + this_width);
+
+ /* XDrawImageString only clears the area equal to the height of
+ the given font. It is possible that a font is being displayed
+ on a line taller than it is, so this would cause us to fail to
+ clear some areas. */
+ if ((int) fi->height < (int) (height + dl->clip))
+ {
+ int clear_start = max (xpos, clip_start);
+ int clear_end = min (xpos + this_width, clip_end);
+
+ if (cursor)
+ {
+ int ypos1_line, ypos1_string, ypos2_line, ypos2_string;
+
+ 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;
+
+ /* Make sure we don't clear below the real bottom of the
+ line. */
+ if (ypos1_string > ypos2_line)
+ ypos1_string = ypos2_line;
+ if (ypos2_string > ypos2_line)
+ ypos2_string = ypos2_line;
+
+ if (ypos1_line < ypos1_string)
+ {
+ x_clear_region (window, findex, clear_start, ypos1_line,
+ clear_end - clear_start,
+ ypos1_string - ypos1_line);
+ }
+
+ if (ypos2_line > ypos2_string)
+ {
+ x_clear_region (window, findex, clear_start, ypos2_string,
+ clear_end - clear_start,
+ ypos2_line - ypos2_string);
+ }
+ }
+ else
+ {
+ x_clear_region (window, findex, clear_start,
+ dl->ypos - dl->ascent, clear_end - clear_start,
+ height);
+ }
+ }
+
+ if (cursor && cursor_cachel && focus && NILP (bar_cursor_value))
+ gc = x_get_gc (d, font, cursor_cachel->foreground,
+ cursor_cachel->background, Qnil, Qnil);
+ else
+ gc = x_get_gc (d, font, cachel->foreground, cachel->background,
+ Qnil, Qnil);
+
+ if (need_clipping)
+ {
+ XRectangle clip_box[1];
+
+ clip_box[0].x = 0;
+ clip_box[0].y = 0;
+ clip_box[0].width = clip_end - clip_start;
+ clip_box[0].height = height;
+
+ XSetClipRectangles (dpy, gc, clip_start, dl->ypos - dl->ascent,
+ clip_box, 1, Unsorted);
+ }
+
+ if (runs[i].dimension == 1)
+ (bgc ? XDrawString : XDrawImageString) (dpy, x_win, gc, xpos,
+ dl->ypos, (char *) runs[i].ptr,
+ runs[i].len);
+ else
+ (bgc ? XDrawString16 : XDrawImageString16) (dpy, x_win, gc, xpos,
+ dl->ypos,
+ (XChar2b *) runs[i].ptr,
+ runs[i].len);
+
+ /* We draw underlines in the same color as the text. */
+ if (cachel->underline)
+ {
+ unsigned long upos, uthick;
+ XFontStruct *xfont;
+
+ xfont = FONT_INSTANCE_X_FONT (XFONT_INSTANCE (font));
+ if (!XGetFontProperty (xfont, XA_UNDERLINE_POSITION, &upos))
+ upos = dl->descent / 2;
+ if (!XGetFontProperty (xfont, XA_UNDERLINE_THICKNESS, &uthick))
+ uthick = 1;
+
+ if (dl->ypos + upos < dl->ypos + dl->descent - dl->clip)
+ {
+ if (dl->ypos + upos + uthick > dl->ypos + dl->descent - dl->clip)
+ uthick = dl->descent - dl->clip - upos;
+
+ if (uthick == 1)
+ {
+ XDrawLine (dpy, x_win, gc, xpos, dl->ypos + upos,
+ xpos + this_width, dl->ypos + upos);
+ }
+ else if (uthick > 1)
+ {
+ XFillRectangle (dpy, x_win, gc, xpos,
+ dl->ypos + upos, this_width, uthick);
+ }
+ }
+ }
+
+ if (cachel->strikethru) {
+ unsigned long ascent,descent,upos, uthick;
+ XFontStruct *xfont;
+
+ xfont = FONT_INSTANCE_X_FONT (XFONT_INSTANCE (font));
+
+ if (!XGetFontProperty (xfont, XA_STRIKEOUT_ASCENT, &ascent))
+ ascent = xfont->ascent;
+ if (!XGetFontProperty (xfont, XA_STRIKEOUT_DESCENT, &descent))
+ descent = xfont->descent;
+ if (!XGetFontProperty (xfont, XA_UNDERLINE_THICKNESS, &uthick))
+ uthick = 1;
+
+ upos = ascent - ((ascent + descent) / 2) + 1;
+
+ /* Generally, upos will be positive (above the baseline),so subtract */
+ if (dl->ypos - upos < dl->ypos + dl->descent - dl->clip)
+ {
+ if (dl->ypos - upos + uthick > dl->ypos + dl->descent - dl->clip)
+ uthick = dl->descent - dl->clip + upos;
+
+ if (uthick == 1)
+ {
+ XDrawLine (dpy, x_win, gc, xpos, dl->ypos - upos,
+ xpos + this_width, dl->ypos - upos);
+ }
+ else if (uthick > 1)
+ {
+ XFillRectangle (dpy, x_win, gc, xpos, dl->ypos + upos,
+ this_width, uthick);
+ }
+ }
+ }
+
+ /* Restore the GC */
+ if (need_clipping)
+ {
+ XSetClipMask (dpy, gc, None);
+ XSetClipOrigin (dpy, gc, 0, 0);
+ }
+
+ /* If we are actually superimposing the cursor then redraw with just
+ the appropriate section highlighted. */
+ if (cursor_clip && !cursor && focus && cursor_cachel)
+ {
+ GC cgc;
+ XRectangle clip_box[1];
+
+ cgc = x_get_gc (d, font, cursor_cachel->foreground,
+ cursor_cachel->background, Qnil, Qnil);
+
+ clip_box[0].x = 0;
+ clip_box[0].y = 0;
+ clip_box[0].width = cursor_width;
+ clip_box[0].height = height;
+
+ XSetClipRectangles (dpy, cgc, cursor_start, dl->ypos - dl->ascent,
+ clip_box, 1, Unsorted);
+
+ if (runs[i].dimension == 1)
+ XDrawImageString (dpy, x_win, cgc, xpos, dl->ypos,
+ (char *) runs[i].ptr, runs[i].len);
+ else
+ XDrawImageString16 (dpy, x_win, cgc, xpos, dl->ypos,
+ (XChar2b *) runs[i].ptr, runs[i].len);
+
+ XSetClipMask (dpy, cgc, None);
+ XSetClipOrigin (dpy, cgc, 0, 0);
+ }
+
+ xpos += this_width;
+ }
+
+ /* Draw the non-focus box or bar-cursor as needed. */
+ /* Can't this logic be simplified? */
+ if (cursor_cachel
+ && ((cursor && !focus && NILP (bar_cursor_value))
+ || (cursor_width
+ && (cursor_start + cursor_width >= clip_start)
+ && !NILP (bar_cursor_value))))
+ {
+ int tmp_height, tmp_y;
+ int bar_width = EQ (bar_cursor_value, Qt) ? 1 : 2;
+ int need_clipping = (cursor_start < clip_start
+ || clip_end < cursor_start + cursor_width);
+
+ /* #### This value is correct (as far as I know) because
+ all of the times we need to draw this cursor, we will
+ be called with exactly one character, so we know we
+ can always use runs[0].
+
+ This is bogus as all hell, however. The cursor handling in
+ this function is way bogus and desperately needs to be
+ cleaned up. (In particular, the drawing of the cursor should
+ really really be separated out of this function. This may be
+ a bit tricky now because this function itself does way too
+ much stuff, a lot of which needs to be moved into
+ redisplay.c) This is the only way to be able to easily add
+ new cursor types or (e.g.) make the bar cursor be able to
+ span two characters instead of overlaying just one. */
+ int bogusly_obtained_ascent_value =
+ XFONT_INSTANCE (FACE_CACHEL_FONT (cachel, runs[0].charset))->ascent;
+
+ if (!NILP (bar_cursor_value))
+ {
+ gc = x_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil,
+ make_int (bar_width));
+ }
+ else
+ {
+ gc = x_get_gc (d, Qnil, cursor_cachel->background,
+ Qnil, Qnil, Qnil);
+ }
+
+ tmp_y = dl->ypos - bogusly_obtained_ascent_value;
+ tmp_height = cursor_height;
+ if (tmp_y + tmp_height > (int) (dl->ypos - dl->ascent + 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;
+ }
+
+ if (need_clipping)
+ {
+ XRectangle clip_box[1];
+ clip_box[0].x = 0;
+ clip_box[0].y = 0;
+ clip_box[0].width = clip_end - clip_start;
+ clip_box[0].height = tmp_height;
+ XSetClipRectangles (dpy, gc, clip_start, tmp_y,
+ clip_box, 1, Unsorted);
+ }
+
+ if (!focus && NILP (bar_cursor_value))
+ {
+ XDrawRectangle (dpy, x_win, gc, cursor_start, tmp_y,
+ cursor_width - 1, tmp_height - 1);
+ }
+ else if (focus && !NILP (bar_cursor_value))
+ {
+ XDrawLine (dpy, x_win, gc, cursor_start + bar_width - 1, tmp_y,
+ cursor_start + bar_width - 1, tmp_y + tmp_height - 1);
+ }
+
+ /* Restore the GC */
+ if (need_clipping)
+ {
+ XSetClipMask (dpy, gc, None);
+ XSetClipOrigin (dpy, gc, 0, 0);
+ }
+ }
+}
+
+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)
+{
+ struct device *d = XDEVICE (f->device);
+ Display *dpy = DEVICE_X_DISPLAY (d);
+ Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f));
+
+ GC gc;
+ XGCValues gcv;
+ unsigned long pixmap_mask;
+ int need_clipping = (clip_x || clip_y);
+
+ if (!override_gc)
+ {
+ memset (&gcv, ~0, sizeof (XGCValues));
+ gcv.graphics_exposures = False;
+ gcv.foreground = fg;
+ gcv.background = bg;
+ pixmap_mask = GCForeground | GCBackground | GCGraphicsExposures;
+
+ if (IMAGE_INSTANCE_X_MASK (p))
+ {
+ gcv.function = GXcopy;
+ gcv.clip_mask = IMAGE_INSTANCE_X_MASK (p);
+ gcv.clip_x_origin = x;
+ gcv.clip_y_origin = y - pixmap_offset;
+ 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?
+ 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;
+ }
+
+ gc = gc_cache_lookup (DEVICE_X_GC_CACHE (d), &gcv, pixmap_mask);
+ }
+ else
+ {
+ gc = override_gc;
+ /* 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
+ XCopyPlane (1 = current foreground color, 0 = background) instead
+ of XCopyArea, which means that the bits in the pixmap are actual
+ 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,
+ 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);
+ }
+}
+
+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)
+{
+ struct frame *f = XFRAME (w->frame);
+ struct device *d = XDEVICE (f->device);
+ struct Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance);
+ Lisp_Object window;
+
+ 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;
+ }
+
+ x_clear_region (window, findex, clear_x, clear_y,
+ clear_width, clear_height);
+ }
+
+ /* Output the pixmap. */
+ {
+ Lisp_Object tmp_pixel;
+ XColor tmp_bcolor, tmp_fcolor;
+
+ tmp_pixel = WINDOW_FACE_CACHEL_FOREGROUND (w, findex);
+ tmp_fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (tmp_pixel));
+ 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,
+ tmp_fcolor.pixel, tmp_bcolor.pixel, 0);
+ }
+
+ /* Draw a cursor over top of the pixmap. */
+ if (cursor_width && cursor_height && (cursor_start >= xpos)
+ && !NILP (w->text_cursor_visible_p)
+ && (cursor_start < xpos + pwidth))
+ {
+ 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
+ (w, Vtext_cursor_face));
+
+ 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 (focus)
+ {
+ XFillRectangle (dpy, x_win, gc, cursor_start, y, cursor_width,
+ cursor_height);
+ }
+ else
+ {
+ XDrawRectangle (dpy, x_win, gc, cursor_start, y, cursor_width,
+ cursor_height);
+ }
+ }
+}
+
+/*****************************************************************************
+ x_output_vertical_divider
+
+ Draw a vertical divider down the right side of the given window.
+ ****************************************************************************/
+static void
+x_output_vertical_divider (struct window *w, int clear)
+{
+ 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;
+
+ 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);
+
+ width = window_divider_width (w);
+ shadow_thickness = XINT (w->vertical_divider_shadow_thickness);
+ 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);
+
+ memset (&gcv, ~0, sizeof (XGCValues));
+
+ tmp_pixel = WINDOW_FACE_CACHEL_BACKGROUND (w, div_face);
+ 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.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 dithrered 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 Adress XLib error ;-) */
+ shadow_thickness = - shadow_thickness;
+ }
+
+ /* Clear the divider area first. This needs to be done when a
+ window split occurs. */
+ if (clear)
+ XClearArea (dpy, x_win, x, y1, width, y2 - y1, False);
+
+ /* Draw the divider line. */
+ XFillRectangle (dpy, x_win, background_gc,
+ x + spacing + shadow_thickness, y1,
+ line_width, y2 - y1);
+
+ /* 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_output_blank
+
+ Output a blank by clearing the area it covers in the foreground color
+ of its face.
+ ****************************************************************************/
+static void
+x_output_blank (struct window *w, struct display_line *dl, struct rune *rb,
+ int start_pixpos, int cursor_start, int cursor_width)
+{
+ struct frame *f = XFRAME (w->frame);
+ struct device *d = XDEVICE (f->device);
+
+ Display *dpy = DEVICE_X_DISPLAY (d);
+ Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f));
+ GC gc;
+ struct face_cachel *cursor_cachel =
+ WINDOW_FACE_CACHEL (w,
+ get_builtin_face_cache_index
+ (w, Vtext_cursor_face));
+ Lisp_Object bg_pmap;
+ Lisp_Object buffer = WINDOW_BUFFER (w);
+ Lisp_Object bar_cursor_value = symbol_value_in_buffer (Qbar_cursor,
+ buffer);
+
+ int x = rb->xpos;
+ int y = dl->ypos - dl->ascent;
+ int width = rb->width;
+ int height = dl->ascent + dl->descent - dl->clip;
+
+ if (start_pixpos > x)
+ {
+ if (start_pixpos >= (x + width))
+ return;
+ else
+ {
+ width -= (start_pixpos - x);
+ x = start_pixpos;
+ }
+ }
+
+ bg_pmap = WINDOW_FACE_CACHEL_BACKGROUND_PIXMAP (w, rb->findex);
+ if (!IMAGE_INSTANCEP (bg_pmap)
+ || !IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap)))
+ bg_pmap = Qnil;
+
+ if (NILP (bg_pmap))
+ gc = x_get_gc (d, Qnil, WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex),
+ Qnil, Qnil, Qnil);
+ else
+ gc = x_get_gc (d, Qnil, WINDOW_FACE_CACHEL_FOREGROUND (w, rb->findex),
+ WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex), bg_pmap,
+ Qnil);
+
+ XFillRectangle (dpy, x_win, gc, x, y, width, height);
+
+ /* If this rune is marked as having the cursor, then it is actually
+ representing a tab. */
+ if (!NILP (w->text_cursor_visible_p)
+ && (rb->cursor_type == CURSOR_ON
+ || (cursor_width
+ && (cursor_start + cursor_width > x)
+ && cursor_start < (x + width))))
+ {
+ int cursor_height, cursor_y;
+ int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d));
+ struct Lisp_Font_Instance *fi;
+
+ fi = XFONT_INSTANCE (FACE_CACHEL_FONT
+ (WINDOW_FACE_CACHEL (w, rb->findex),
+ Vcharset_ascii));
+
+ gc = x_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, Qnil);
+
+ cursor_y = dl->ypos - fi->ascent;
+ cursor_height = fi->height;
+ if (cursor_y + cursor_height > y + height)
+ cursor_height = y + height - cursor_y;
+
+ if (focus)
+ {
+ if (NILP (bar_cursor_value))
+ {
+ XFillRectangle (dpy, x_win, gc, cursor_start, cursor_y,
+ fi->width, cursor_height);
+ }
+ else
+ {
+ int bar_width = EQ (bar_cursor_value, Qt) ? 1 : 2;
+
+ gc = x_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil,
+ make_int (bar_width));
+ XDrawLine (dpy, x_win, gc, cursor_start + bar_width - 1,
+ cursor_y, cursor_start + bar_width - 1,
+ cursor_y + cursor_height - 1);
+ }
+ }
+ else if (NILP (bar_cursor_value))
+ {
+ XDrawRectangle (dpy, x_win, gc, cursor_start, cursor_y,
+ fi->width - 1, cursor_height - 1);
+ }
+ }
+}
+
+/*****************************************************************************
+ x_output_hline
+
+ Output a horizontal line in the foreground of its face.
+ ****************************************************************************/
+static void
+x_output_hline (struct window *w, struct display_line *dl, struct rune *rb)
+{
+ struct frame *f = XFRAME (w->frame);
+ struct device *d = XDEVICE (f->device);
+
+ Display *dpy = DEVICE_X_DISPLAY (d);
+ Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f));
+ GC gc;
+
+ int x = rb->xpos;
+ int width = rb->width;
+ int height = dl->ascent + dl->descent - dl->clip;
+ int ypos1, ypos2, ypos3, ypos4;
+
+ ypos1 = dl->ypos - dl->ascent;
+ ypos2 = ypos1 + rb->object.hline.yoffset;
+ ypos3 = ypos2 + rb->object.hline.thickness;
+ ypos4 = dl->ypos + dl->descent - dl->clip;
+
+ /* First clear the area not covered by the line. */
+ if (height - rb->object.hline.thickness > 0)
+ {
+ gc = x_get_gc (d, Qnil, WINDOW_FACE_CACHEL_FOREGROUND (w, rb->findex),
+ Qnil, Qnil, Qnil);
+
+ if (ypos2 - ypos1 > 0)
+ XFillRectangle (dpy, x_win, gc, x, ypos1, width, ypos2 - ypos1);
+ if (ypos4 - ypos3 > 0)
+ XFillRectangle (dpy, x_win, gc, x, ypos1, width, ypos2 - ypos1);
+ }
+
+ /* Now draw the line. */
+ gc = x_get_gc (d, Qnil, WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex),
+ Qnil, Qnil, Qnil);
+
+ if (ypos2 < ypos1)
+ ypos2 = ypos1;
+ if (ypos3 > ypos4)
+ ypos3 = ypos4;
+
+ if (ypos3 - ypos2 > 0)
+ XFillRectangle (dpy, x_win, gc, x, ypos2, width, ypos3 - ypos2);
+}
+
+/*****************************************************************************
+ x_output_shadows
+
+ Draw a shadow around the given area using the given GC's. It is the
+ callers responsibility to ste the GC's appropriately.
+ ****************************************************************************/
+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)
+{
+ struct device *d = XDEVICE (f->device);
+
+ Display *dpy = DEVICE_X_DISPLAY (d);
+ Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f));
+
+ XSegment top_shadow[20], bottom_shadow[20];
+ int elt;
+
+ if (shadow_thickness > 10)
+ shadow_thickness = 10;
+ else if (shadow_thickness < 0)
+ shadow_thickness = 0;
+ if (shadow_thickness > (width / 2))
+ shadow_thickness = width / 2;
+ if (shadow_thickness > (height / 2))
+ shadow_thickness = height / 2;
+
+ 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;
+
+ 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;
+ }
+
+ XDrawSegments (dpy, x_win, top_shadow_gc, top_shadow, shadow_thickness * 2);
+ XDrawSegments (dpy, x_win, bottom_shadow_gc, bottom_shadow,
+ shadow_thickness * 2);
+}
+
+/*****************************************************************************
+ x_generate_shadow_pixels
+
+ Given three pixels (top shadow, bottom shadow, background) massage
+ the top and bottom shadow colors to guarantee that they differ. The
+ background pixels are not allowed to be modified.
+
+ This function modifies its parameters.
+
+ This code is modified from code blatantly stolen from lwlib/xlwmenu.c
+ ****************************************************************************/
+#define MINL(x,y) ((((unsigned long) (x)) < ((unsigned long) (y))) \
+ ? ((unsigned long) (x)) : ((unsigned long) (y)))
+
+void
+x_generate_shadow_pixels (struct frame *f, unsigned long *top_shadow,
+ unsigned long *bottom_shadow,
+ unsigned long background,
+ unsigned long core_background)
+{
+ struct device *d = XDEVICE (f->device);
+ Display *dpy = DEVICE_X_DISPLAY (d);
+ Colormap cmap = DEVICE_X_COLORMAP (d);
+ Visual *visual = DEVICE_X_VISUAL (d);
+
+ XColor topc, botc;
+ int top_frobbed = 0, bottom_frobbed = 0;
+
+ /* If the top shadow is the same color as the background, try to
+ adjust it. */
+ if (*top_shadow == background)
+ {
+ topc.pixel = background;
+ XQueryColor (dpy, cmap, &topc);
+ /* don't overflow/wrap! */
+ topc.red = MINL (65535, (unsigned long) topc.red * 6 / 5);
+ topc.green = MINL (65535, (unsigned long) topc.green * 6 / 5);
+ topc.blue = MINL (65535, (unsigned long) topc.blue * 6 / 5);
+ if (allocate_nearest_color (dpy, cmap, visual, &topc))
+ {
+ *top_shadow = topc.pixel;
+ top_frobbed = 1;
+ }
+ }
+
+ /* If the bottom shadow is the same color as the background, try to
+ adjust it. */
+ if (*bottom_shadow == background)
+ {
+ botc.pixel = background;
+ XQueryColor (dpy, cmap, &botc);
+ botc.red = (unsigned short) ((unsigned long) botc.red * 3 / 5);
+ botc.green = (unsigned short) ((unsigned long) botc.green * 3 / 5);
+ botc.blue = (unsigned short) ((unsigned long) botc.blue * 3 / 5);
+ if (allocate_nearest_color (dpy, cmap, visual, &botc))
+ {
+ *bottom_shadow = botc.pixel;
+ bottom_frobbed = 1;
+ }
+ }
+
+ /* If we had to adjust both shadows, then we have to do some
+ additional work. */
+ if (top_frobbed && bottom_frobbed)
+ {
+ int top_avg = ((topc.red / 3) + (topc.green / 3) + (topc.blue / 3));
+ int bot_avg = ((botc.red / 3) + (botc.green / 3) + (botc.blue / 3));
+ if (bot_avg > top_avg)
+ {
+ Pixel tmp = *top_shadow;
+
+ *top_shadow = *bottom_shadow;
+ *bottom_shadow = tmp;
+ }
+ else if (topc.pixel == botc.pixel)
+ {
+ if (botc.pixel == background)
+ *top_shadow = core_background;
+ else
+ *bottom_shadow = background;
+ }
+ }
+}
+
+/*****************************************************************************
+ 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))
+ x_clear_region (window, DEFAULT_INDEX, FRAME_LEFT_BORDER_START (f),
+ ypos1, FRAME_BORDER_WIDTH (f), height);
+
+ if (bounds.left_in - bounds.left_out > 0)
+ x_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)
+ x_clear_region (window, DEFAULT_INDEX, bounds.left_in, ypos1,
+ bounds.right_in - bounds.left_in, height);
+
+ if (bounds.right_out - bounds.right_in > 0)
+ x_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))
+ x_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
+ what parts of what lines are contained within and re-output their
+ contents.
+ ****************************************************************************/
+static void
+x_redraw_exposed_window (struct window *w, int x, int y, int width, int height)
+{
+ struct frame *f = XFRAME (w->frame);
+ int line;
+ int start_x, start_y, end_x, end_y;
+ int orig_windows_structure_changed;
+
+ display_line_dynarr *cdla = window_display_lines (w, CURRENT_DISP);
+
+ if (!NILP (w->vchild))
+ {
+ x_redraw_exposed_windows (w->vchild, x, y, width, height);
+ return;
+ }
+ else if (!NILP (w->hchild))
+ {
+ x_redraw_exposed_windows (w->hchild, x, y, width, height);
+ return;
+ }
+
+ /* If the window doesn't intersect the exposed region, we're done here. */
+ if (x >= WINDOW_RIGHT (w) || (x + width) <= WINDOW_LEFT (w)
+ || y >= WINDOW_BOTTOM (w) || (y + height) <= WINDOW_TOP (w))
+ {
+ return;
+ }
+ else
+ {
+ start_x = max (WINDOW_LEFT (w), x);
+ end_x = min (WINDOW_RIGHT (w), (x + width));
+ start_y = max (WINDOW_TOP (w), y);
+ end_y = min (WINDOW_BOTTOM (w), y + height);
+
+ /* We do this to make sure that the 3D modelines get redrawn if
+ they are in the exposed region. */
+ orig_windows_structure_changed = f->windows_structure_changed;
+ f->windows_structure_changed = 1;
+ }
+
+ if (window_needs_vertical_divider (w))
+ {
+ x_output_vertical_divider (w, 0);
+ }
+
+ 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 >= start_y)
+ {
+ if (top_y > end_y)
+ {
+ if (line == 0)
+ continue;
+ else
+ break;
+ }
+ else
+ {
+ output_display_line (w, 0, cdla, line, start_x, end_x);
+ }
+ }
+ }
+
+ f->windows_structure_changed = orig_windows_structure_changed;
+
+ /* If there have never been any face cache_elements created, then this
+ expose event doesn't actually have anything to do. */
+ if (Dynarr_largest (w->face_cachels))
+ redisplay_clear_bottom_of_window (w, cdla, start_y, end_y);
+}
+
+/*****************************************************************************
+ x_redraw_exposed_windows
+
+ For each window beneath the given window in the window hierarchy,
+ ensure that it is redrawn if necessary after an Expose event.
+ ****************************************************************************/
+static void
+x_redraw_exposed_windows (Lisp_Object window, int x, int y, int width,
+ int height)
+{
+ for (; !NILP (window); window = XWINDOW (window)->next)
+ x_redraw_exposed_window (XWINDOW (window), x, y, width, height);
+}
+
+/*****************************************************************************
+ x_redraw_exposed_area
+
+ For each window on the given frame, ensure that any area in the
+ Exposed area is redrawn.
+ ****************************************************************************/
+void
+x_redraw_exposed_area (struct frame *f, int x, int y, int width, int height)
+{
+ /* If any window on the frame has had its face cache reset then the
+ redisplay structures are effectively invalid. If we attempt to
+ use them we'll blow up. We mark the frame as changed to ensure
+ that redisplay will do a full update. This probably isn't
+ necessary but it can't hurt. */
+
+#ifdef HAVE_TOOLBARS
+ /* #### We would rather put these off as well but there is currently
+ no combination of flags which will force an unchanged toolbar to
+ redraw anyhow. */
+ MAYBE_FRAMEMETH (f, redraw_exposed_toolbars, (f, x, y, width, height));
+#endif
+
+ if (!f->window_face_cache_reset)
+ {
+ x_redraw_exposed_windows (f->root_window, x, y, width, height);
+
+ XFlush (DEVICE_X_DISPLAY (XDEVICE (f->device)));
+ }
+ else
+ MARK_FRAME_CHANGED (f);
+}
+
+/****************************************************************************
+ x_clear_region
+
+ Clear the area in the box defined by the given parameters using the
+ given face.
+ ****************************************************************************/
+static void
+x_clear_region (Lisp_Object locale, face_index findex, int x, int y,
+ int width, int height)
+{
+ struct window *w = NULL;
+ struct frame *f = NULL;
+ struct device *d;
+ Lisp_Object background_pixmap;
+
+ Display *dpy;
+ Window x_win;
+
+ if (WINDOWP (locale))
+ {
+ w = XWINDOW (locale);
+ f = XFRAME (w->frame);
+ }
+ else if (FRAMEP (locale))
+ {
+ w = NULL;
+ f = XFRAME (locale);
+ }
+ else
+ abort ();
+
+ d = XDEVICE (f->device);
+ dpy = DEVICE_X_DISPLAY (d);
+ x_win = XtWindow (FRAME_X_TEXT_WIDGET (f));
+
+ /* #### This function is going to have to be made cursor aware. */
+ if (width && height)
+ {
+ GC gc = NULL;
+
+ /* #### This isn't quite right for when this function is called
+ from the toolbar code. */
+ background_pixmap = Qunbound;
+
+ /* Don't use a backing pixmap in the border area */
+ if (x >= FRAME_LEFT_BORDER_END (f)
+ && x < FRAME_RIGHT_BORDER_START (f)
+ && y >= FRAME_TOP_BORDER_END (f)
+ && 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)))
+ {
+ /* #### maybe we could implement such that a string
+ can be a background pixmap? */
+ background_pixmap = temp;
+ }
+ }
+ 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)
+ {
+ Lisp_Object fcolor, bcolor;
+
+ if (w)
+ {
+ fcolor = WINDOW_FACE_CACHEL_FOREGROUND (w, findex);
+ bcolor = WINDOW_FACE_CACHEL_BACKGROUND (w, findex);
+ }
+ else
+ {
+ fcolor = FACE_FOREGROUND (Vdefault_face, locale);
+ bcolor = FACE_BACKGROUND (Vdefault_face, locale);
+ }
+
+ gc = x_get_gc (d, Qnil, fcolor, bcolor, background_pixmap, Qnil);
+ }
+ else
+ {
+ Lisp_Object color = (w ?
+ WINDOW_FACE_CACHEL_BACKGROUND (w, findex) :
+ FACE_BACKGROUND (Vdefault_face, locale));
+
+ if (UNBOUNDP (background_pixmap))
+ background_pixmap = Qnil;
+
+ gc = x_get_gc (d, Qnil, color, Qnil, background_pixmap, Qnil);
+ }
+ }
+
+ if (gc)
+ XFillRectangle (dpy, x_win, gc, x, y, width, height);
+ else
+ XClearArea (dpy, x_win, x, y, width, height, False);
+ }
+}
+
+/*****************************************************************************
+ x_output_eol_cursor
+
+ Draw a cursor at the end of a line. The end-of-line cursor is
+ narrower than the normal cursor.
+ ****************************************************************************/
+static void
+x_output_eol_cursor (struct window *w, struct display_line *dl, int xpos,
+ face_index findex)
+{
+ struct frame *f = XFRAME (w->frame);
+ struct device *d = XDEVICE (f->device);
+ Lisp_Object window;
+
+ Display *dpy = DEVICE_X_DISPLAY (d);
+ Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f));
+ GC gc;
+ face_index elt = get_builtin_face_cache_index (w, Vtext_cursor_face);
+ struct face_cachel *cursor_cachel = WINDOW_FACE_CACHEL (w, elt);
+
+ int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d));
+ Lisp_Object bar_cursor_value = symbol_value_in_buffer (Qbar_cursor,
+ WINDOW_BUFFER (w));
+
+ int x = xpos;
+ int y = dl->ypos - dl->ascent;
+ int width = EOL_CURSOR_WIDTH;
+ int height = dl->ascent + dl->descent - dl->clip;
+ int cursor_height, cursor_y;
+ int defheight, defascent;
+
+ XSETWINDOW (window, w);
+ x_clear_region (window, findex, x, y, width, height);
+
+ if (NILP (w->text_cursor_visible_p))
+ return;
+
+ gc = x_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, Qnil);
+
+ default_face_font_info (window, &defascent, 0, &defheight, 0, 0);
+
+ /* make sure the cursor is entirely contained between y and y+height */
+ cursor_height = min (defheight, height);
+ cursor_y = max (y, min (y + height - cursor_height,
+ dl->ypos - defascent));
+
+ if (focus)
+ {
+#ifdef HAVE_XIM
+ XIM_SetSpotLocation (f, x - 2 , cursor_y + cursor_height - 2);
+#endif /* HAVE_XIM */
+
+ if (NILP (bar_cursor_value))
+ {
+ XFillRectangle (dpy, x_win, gc, x, cursor_y, width, cursor_height);
+ }
+ else
+ {
+ int bar_width = EQ (bar_cursor_value, Qt) ? 1 : 2;
+
+ gc = x_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil,
+ make_int (bar_width));
+ XDrawLine (dpy, x_win, gc, x + bar_width - 1, cursor_y,
+ x + bar_width - 1, cursor_y + cursor_height - 1);
+ }
+ }
+ else if (NILP (bar_cursor_value))
+ {
+ XDrawRectangle (dpy, x_win, gc, x, cursor_y, width - 1,
+ cursor_height - 1);
+ }
+}
+
+static void
+x_clear_frame_window (Lisp_Object window)
+{
+ struct window *w = XWINDOW (window);
+
+ if (!NILP (w->vchild))
+ {
+ x_clear_frame_windows (w->vchild);
+ return;
+ }
+
+ if (!NILP (w->hchild))
+ {
+ x_clear_frame_windows (w->hchild);
+ return;
+ }
+
+ x_clear_to_window_end (w, WINDOW_TEXT_TOP (w), WINDOW_TEXT_BOTTOM (w));
+}
+
+static void
+x_clear_frame_windows (Lisp_Object window)
+{
+ for (; !NILP (window); window = XWINDOW (window)->next)
+ x_clear_frame_window (window);
+}
+
+static void
+x_clear_frame (struct frame *f)
+{
+ struct device *d = XDEVICE (f->device);
+ Display *dpy = DEVICE_X_DISPLAY (d);
+ Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f));
+ int x, y, width, height;
+ Lisp_Object frame;
+
+ x = FRAME_LEFT_BORDER_START (f);
+ width = (FRAME_PIXWIDTH (f) - FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) -
+ FRAME_REAL_RIGHT_TOOLBAR_WIDTH (f) -
+ 2 * FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f) -
+ 2 * FRAME_REAL_RIGHT_TOOLBAR_BORDER_WIDTH (f));
+ /* #### This adjustment by 1 should be being done in the macros.
+ There is some small differences between when the menubar is on
+ and off that we still need to deal with. */
+ y = FRAME_TOP_BORDER_START (f) - 1;
+ height = (FRAME_PIXHEIGHT (f) - FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) -
+ FRAME_REAL_BOTTOM_TOOLBAR_HEIGHT (f) -
+ 2 * FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f) -
+ 2 * FRAME_REAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f)) + 1;
+
+ XClearArea (dpy, x_win, x, y, width, height, False);
+
+ XSETFRAME (frame, f);
+
+ if (!UNBOUNDP (FACE_BACKGROUND_PIXMAP (Vdefault_face, frame))
+ || !UNBOUNDP (FACE_BACKGROUND_PIXMAP (Vleft_margin_face, frame))
+ || !UNBOUNDP (FACE_BACKGROUND_PIXMAP (Vright_margin_face, frame)))
+ {
+ x_clear_frame_windows (f->root_window);
+ }
+
+ XFlush (DEVICE_X_DISPLAY (d));
+}
+
+/* briefly swap the foreground and background colors.
+ */
+
+static int
+x_flash (struct device *d)
+{
+ Display *dpy;
+ Window win;
+ XGCValues gcv;
+ GC gc;
+ XColor tmp_fcolor, tmp_bcolor;
+ Lisp_Object tmp_pixel, frame;
+ struct frame *f = device_selected_frame (d);
+ struct window *w = XWINDOW (FRAME_ROOT_WINDOW (f));
+ Widget shell = FRAME_X_SHELL_WIDGET (f);
+
+ XSETFRAME (frame, f);
+
+ tmp_pixel = FACE_FOREGROUND (Vdefault_face, frame);
+ tmp_fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (tmp_pixel));
+ tmp_pixel = FACE_BACKGROUND (Vdefault_face, frame);
+ tmp_bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (tmp_pixel));
+
+ dpy = XtDisplay (shell);
+ win = XtWindow (FRAME_X_TEXT_WIDGET (f));
+ memset (&gcv, ~0, sizeof (XGCValues)); /* initialize all slots to ~0 */
+ gcv.foreground = (tmp_fcolor.pixel ^ tmp_bcolor.pixel);
+ gcv.function = GXxor;
+ gcv.graphics_exposures = False;
+ gc = gc_cache_lookup (DEVICE_X_GC_CACHE (XDEVICE (f->device)), &gcv,
+ (GCForeground | GCFunction | GCGraphicsExposures));
+ XFillRectangle (dpy, win, gc, w->pixel_left, w->pixel_top,
+ w->pixel_width, w->pixel_height);
+ XSync (dpy, False);
+
+#ifdef HAVE_SELECT
+ {
+ int usecs = 100000;
+ struct timeval tv;
+ tv.tv_sec = usecs / 1000000L;
+ tv.tv_usec = usecs % 1000000L;
+ /* I'm sure someone is going to complain about this... */
+ select (0, 0, 0, 0, &tv);
+ }
+#else
+#ifdef HAVE_POLL
+ poll (0, 0, 100);
+#else /* !HAVE_POLL */
+ bite me
+#endif /* HAVE_POLL */
+#endif /* HAVE_SELECT */
+
+ XFillRectangle (dpy, win, gc, w->pixel_left, w->pixel_top,
+ w->pixel_width, w->pixel_height);
+ XSync (dpy, False);
+
+ return 1;
+}
+
+/* Make audible bell. */
+
+static void
+x_ring_bell (struct device *d, int volume, int pitch, int duration)
+{
+ Display *display = DEVICE_X_DISPLAY (d);
+
+ if (volume < 0) volume = 0;
+ else if (volume > 100) volume = 100;
+ if (pitch < 0 && duration < 0)
+ {
+ XBell (display, (volume * 2) - 100);
+ XFlush (display);
+ }
+ else
+ {
+ XKeyboardState state;
+ XKeyboardControl ctl;
+ XSync (display, 0);
+ /* #### grab server? */
+ XGetKeyboardControl (display, &state);
+
+ ctl.bell_pitch = (pitch >= 0 ? pitch : state.bell_pitch);
+ ctl.bell_duration = (duration >= 0 ? duration : state.bell_duration);
+ XChangeKeyboardControl (display, KBBellPitch|KBBellDuration, &ctl);
+
+ XBell (display, (volume * 2) - 100);
+
+ ctl.bell_pitch = state.bell_pitch;
+ ctl.bell_duration = state.bell_duration;
+ XChangeKeyboardControl (display, KBBellPitch|KBBellDuration, &ctl);
+
+ /* #### ungrab server? */
+ XSync (display, 0);
+ }
+}
+
+\f
+/************************************************************************/
+/* initialization */
+/************************************************************************/
+
+void
+console_type_create_redisplay_x (void)
+{
+ /* redisplay methods */
+ CONSOLE_HAS_METHOD (x, text_width);
+ CONSOLE_HAS_METHOD (x, output_display_block);
+ 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);
+}
--- /dev/null
+/* Display generation from window structure and buffer text.
+ Copyright (C) 1994, 1995, 1996 Board of Trustees, University of Illinois.
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Copyright (C) 1995, 1996 Ben Wing.
+ Copyright (C) 1995 Sun Microsystems, Inc.
+ Copyright (C) 1996 Chuck Thompson.
+
+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. */
+
+/* Author: Chuck Thompson */
+
+/* Fixed up by Ben Wing for Mule */
+
+/* This file has been Mule-ized. */
+
+/*****************************************************************************
+ The Golden Rules of Redisplay
+
+ First: It Is Better To Be Correct Than Fast
+ Second: Thou Shalt Not Run Elisp From Within Redisplay
+ Third: It Is Better To Be Fast Than Not To Be
+ ****************************************************************************/
+
+#include <config.h>
+#include "lisp.h"
+#include <limits.h>
+
+#include "buffer.h"
+#include "commands.h"
+#include "debug.h"
+#include "device.h"
+#include "extents.h"
+#include "faces.h"
+#include "frame.h"
+#include "glyphs.h"
+#include "insdel.h"
+#include "menubar.h"
+#include "objects.h"
+#include "process.h"
+#include "redisplay.h"
+#include "toolbar.h"
+#include "window.h"
+#include "line-number.h"
+#ifdef FILE_CODING
+#include "file-coding.h"
+#endif
+
+#ifdef HAVE_TTY
+#include "console-tty.h"
+#ifdef HAVE_UNISTD_H
+#include <unistd.h> /* for isatty() */
+#endif
+#endif /* HAVE_TTY */
+
+/* Note: We have to be careful throughout this code to properly handle
+ and differentiate between Bufbytes and Emchars.
+
+ Since strings are generally composed of Bufbytes, I've taken the tack
+ that any contiguous set of Bufbytes is called a "string", while
+ any contiguous set of Emchars is called an "array". */
+
+/* Return value to indicate a failure by an add_*_rune routine to add
+ a rune, but no propagation information needs to be returned. */
+#define ADD_FAILED (prop_block_dynarr *) 1
+
+#define BEGIN_GLYPHS 0
+#define END_GLYPHS 1
+#define LEFT_GLYPHS 2
+#define RIGHT_GLYPHS 3
+
+/* Set the vertical clip to 0 if we are currently updating the line
+ start cache. Otherwise for buffers of line height 1 it may fail to
+ be able to work properly because regenerate_window will not layout
+ a single line. */
+#define VERTICAL_CLIP(w, display) \
+ (updating_line_start_cache \
+ ? 0 \
+ : ((WINDOW_TTY_P (w) | (!display && scroll_on_clipped_lines)) \
+ ? INT_MAX \
+ : vertical_clip))
+
+/* The following structures are completely private to redisplay.c so
+ we put them here instead of in a header file, for modularity. */
+
+/* NOTE: Bytinds not Bufpos's in this structure. */
+
+typedef struct position_redisplay_data_type
+{
+ /* This information is normally filled in by the create_*_block
+ routines and is used by the add_*_rune routines. */
+ Lisp_Object window;
+ struct device *d;
+ struct display_block *db;
+ struct display_line *dl;
+ Emchar ch; /* Character that is to be added. This is
+ used to communicate this information to
+ add_emchar_rune(). */
+ Lisp_Object last_charset; /* The charset of the previous character.
+ Used to optimize some lookups -- we
+ only have to do some things when
+ the charset changes. */
+ face_index last_findex; /* The face index of the previous character.
+ Needed to ensure the validity of the
+ last_charset optimization. */
+
+ int last_char_width; /* The width of the previous character. */
+ int font_is_bogus; /* If true, it means we couldn't instantiate
+ the font for this charset, so we substitute
+ ~'s from the ASCII charset. */
+ Bytind bi_bufpos;
+ Bytind bi_endpos;
+ int pixpos;
+ int max_pixpos;
+ int blank_width; /* Width of the blank that is to be added.
+ This is used to communicate this information
+ to add_blank_rune().
+
+ This is also used rather cheesily to
+ communicate the width of the eol-cursor-size
+ blank that exists at the end of the line.
+ add_emchar_rune() is called cheesily with
+ the non-printing char '\n', which is stuck
+ in the output routines with its width being
+ BLANK_WIDTH. */
+ Bytind bi_cursor_bufpos;/* This stores the buffer position of the cursor. */
+ unsigned int cursor_type :3;
+ int cursor_x; /* rune block cursor is at */
+ int start_col; /* Number of character columns (each column has
+ a width of the default char width) that still
+ need to be skipped. This is used for horizontal
+ scrolling, where a certain number of columns
+ (those off the left side of the screen) need
+ to be skipped before anything is displayed. */
+ Bytind bi_start_col_enabled;
+
+ int hscroll_glyph_width_adjust; /* how much the width of the hscroll
+ glyph differs from space_width (w).
+ 0 if no hscroll glyph was used,
+ i.e. the window is not scrolled
+ horizontally. Used in tab
+ calculations. */
+
+ /* Information about the face the text should be displayed in and
+ any begin-glyphs and end-glyphs. */
+ struct extent_fragment *ef;
+ face_index findex;
+
+ /* The height of a pixmap may either be predetermined if the user
+ has set a baseline value, or it may be dependent on whatever the
+ line ascent and descent values end up being, based just on font
+ information. In the first case we can immediately update the
+ values, thus their inclusion here. In the last case we cannot
+ determine the actual contribution to the line height until we
+ have finished laying out all text on the line. Thus we propagate
+ the max height of such pixmaps and do a final calculation after
+ all text has been added to the line. */
+ int new_ascent;
+ int new_descent;
+ int max_pixmap_height;
+
+ Lisp_Object result_str; /* String where we put the result of
+ generating a formatted string in the modeline. */
+ int is_modeline; /* Non-zero if we're generating the modeline. */
+ Charcount modeline_charpos; /* Number of chars used in result_str so far;
+ corresponds to bytepos. */
+ Bytecount bytepos; /* Number of bytes used in result_str so far.
+ We don't actually copy the bytes into result_str
+ until the end because we don't know how big the
+ string is going to be until then. */
+} pos_data;
+
+enum prop_type
+{
+ PROP_STRING,
+ PROP_CHAR,
+ PROP_MINIBUF_PROMPT,
+ PROP_BLANK
+};
+
+/* Data that should be propagated to the next line. Either a single
+ Emchar or a string of Bufbyte's.
+
+ The actual data that is propagated ends up as a Dynarr of these
+ blocks.
+
+ #### It's unclean that both Emchars and Bufbytes are here.
+ */
+
+typedef struct prop_block prop_block;
+struct prop_block
+{
+ enum prop_type type;
+
+ union data
+ {
+ struct
+ {
+ Bufbyte *str;
+ Bytecount len; /* length of the string. */
+ } p_string;
+
+ struct
+ {
+ Emchar ch;
+ Bytind bi_cursor_bufpos; /* NOTE: is in Bytinds */
+ unsigned int cursor_type :3;
+ } p_char;
+
+ struct
+ {
+ int width;
+ face_index findex;
+ } p_blank;
+ } data;
+};
+
+typedef struct
+{
+ Dynarr_declare (prop_block);
+} 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);
+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, int type);
+static int create_overlay_glyph_block (struct window *w,
+ struct display_line *dl);
+static void create_left_glyph_block (struct window *w,
+ struct display_line *dl,
+ int overlay_width);
+static void create_right_glyph_block (struct window *w,
+ struct display_line *dl);
+static void redisplay_windows (Lisp_Object window, int skip_selected);
+static void decode_mode_spec (struct window *w, Emchar spec, int type);
+static void free_display_line (struct display_line *dl);
+static void update_line_start_cache (struct window *w, Bufpos from, Bufpos to,
+ Bufpos point, int no_regen);
+static int point_visible (struct window *w, Bufpos point, int type);
+
+/* This used to be 10 but 30 seems to give much better performance. */
+#define INIT_MAX_PREEMPTS 30
+static int max_preempts;
+
+#define REDISPLAY_PREEMPTION_CHECK \
+((void) \
+ (preempted = \
+ (!disable_preemption && \
+ ((preemption_count < max_preempts) || !NILP (Vexecuting_macro)) && \
+ (!INTERACTIVE || detect_input_pending ()))))
+
+/*
+ * Redisplay global variables.
+ */
+
+/* We need a third set of display structures for the cursor motion
+ routines. We used to just give each window a third set. However,
+ we always fully regenerate the structures when needed so there
+ 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
+ we don't store the text into the resulting string until we're done
+ (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;
+
+
+/* #### probably temporary */
+int cache_adjustment;
+
+/* This holds a string representing the text corresponding to a single
+ modeline % spec. */
+static Bufbyte_dynarr *mode_spec_bufbyte_string;
+
+int in_display; /* 1 if in redisplay. */
+
+int disable_preemption; /* Used for debugging redisplay and for
+ force-redisplay. */
+
+/* We only allow max_preempts preemptions before we force a redisplay. */
+static int preemption_count;
+
+/* Minimum pixel height of clipped bottom display line. */
+int vertical_clip;
+
+/* Minimum visible pixel width of clipped glyphs at right margin. */
+int horizontal_clip;
+
+/* Set if currently inside update_line_start_cache. */
+int updating_line_start_cache;
+
+/* Nonzero means reading single-character input with prompt
+ so put cursor on minibuffer after the prompt. */
+int cursor_in_echo_area;
+Lisp_Object Qcursor_in_echo_area;
+
+/* Nonzero means truncate lines in all windows less wide than the frame */
+int truncate_partial_width_windows;
+
+/* non-nil if a buffer has changed since the last time redisplay completed */
+int buffers_changed;
+int buffers_changed_set;
+
+/* non-nil if hscroll has changed somewhere or a buffer has been
+ narrowed or widened */
+int clip_changed;
+int clip_changed_set;
+
+/* non-nil if any extent has changed since the last time redisplay completed */
+int extents_changed;
+int extents_changed_set;
+
+/* non-nil if any face has changed since the last time redisplay completed */
+int faces_changed;
+
+/* Nonzero means some frames have been marked as garbaged */
+int frame_changed;
+
+/* non-zero if any of the builtin display glyphs (continuation,
+ hscroll, control-arrow, etc) is in need of updating
+ somewhere. */
+int glyphs_changed;
+int glyphs_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;
+int icon_changed_set;
+
+/* This variable is 1 if the menubar widget has to be updated.
+ It is set to 1 by set-menubar-dirty-flag and cleared when the widget
+ has been updated. */
+int menubar_changed;
+int menubar_changed_set;
+
+/* true iff we should redraw the modelines on the next redisplay */
+int modeline_changed;
+int modeline_changed_set;
+
+/* non-nil if point has changed in some buffer since the last time
+ redisplay completed */
+int point_changed;
+int point_changed_set;
+
+/* non-nil if some frame has changed its size */
+int size_changed;
+
+/* non-nil if some device has signaled that it wants to change size */
+int asynch_device_change_pending;
+
+/* non-nil if any toolbar has changed */
+int toolbar_changed;
+int toolbar_changed_set;
+
+/* non-nil if any window has changed since the last time redisplay completed */
+int windows_changed;
+
+/* non-nil if any frame's window structure has changed since the last
+ time redisplay completed */
+int windows_structure_changed;
+
+/* If non-nil, use vertical bar cursor. */
+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 */
+
+/* Nonzero means no need to redraw the entire frame on resuming
+ a suspended Emacs. This is useful on terminals with multiple pages,
+ where one page is used for Emacs and another for all else. */
+int no_redraw_on_reenter;
+
+Lisp_Object Vwindow_system; /* nil or a symbol naming the window system
+ under which emacs is running
+ ('x is the only current possibility) */
+Lisp_Object Vinitial_window_system;
+
+Lisp_Object Vglobal_mode_string;
+
+/* The number of lines scroll a window by when point leaves the window; if
+ it is <=0 then point is centered in the window */
+int scroll_step;
+
+/* Scroll up to this many lines, to bring point back on screen. */
+int scroll_conservatively;
+
+/* Marker for where to display an arrow on top of the buffer text. */
+Lisp_Object Voverlay_arrow_position;
+/* String to display for the arrow. */
+Lisp_Object Voverlay_arrow_string;
+
+Lisp_Object Vwindow_size_change_functions;
+Lisp_Object Qwindow_scroll_functions, Vwindow_scroll_functions;
+Lisp_Object Qredisplay_end_trigger_functions, Vredisplay_end_trigger_functions;
+
+#define INHIBIT_REDISPLAY_HOOKS /* #### Until we've thought about
+ this more. */
+#ifndef INHIBIT_REDISPLAY_HOOKS
+/* #### Chuck says: I think this needs more thought.
+ Think about this for 19.14. */
+Lisp_Object Vpre_redisplay_hook, Vpost_redisplay_hook;
+Lisp_Object Qpre_redisplay_hook, Qpost_redisplay_hook;
+#endif /* INHIBIT_REDISPLAY_HOOKS */
+
+int last_display_warning_tick, display_warning_tick;
+Lisp_Object Qdisplay_warning_buffer;
+int inhibit_warning_display;
+
+Lisp_Object Vleft_margin_width, Vright_margin_width;
+Lisp_Object Vminimum_line_ascent, Vminimum_line_descent;
+Lisp_Object Vuse_left_overflow, Vuse_right_overflow;
+Lisp_Object Vtext_cursor_visible_p;
+
+int column_number_start_at_one;
+\f
+/***************************************************************************/
+/* */
+/* low-level interfaces onto device routines */
+/* */
+/***************************************************************************/
+
+static int
+redisplay_text_width_emchar_string (struct window *w, int findex,
+ Emchar *str, Charcount len)
+{
+ unsigned char charsets[NUM_LEADING_BYTES];
+ Lisp_Object window;
+
+ find_charsets_in_emchar_string (charsets, str, len);
+ XSETWINDOW (window, w);
+ ensure_face_cachel_complete (WINDOW_FACE_CACHEL (w, findex), window,
+ charsets);
+ return DEVMETH (XDEVICE (FRAME_DEVICE (XFRAME (WINDOW_FRAME (w)))),
+ text_width, (XFRAME (WINDOW_FRAME (w)),
+ WINDOW_FACE_CACHEL (w, findex), str, len));
+}
+
+static Emchar_dynarr *rtw_emchar_dynarr;
+
+int
+redisplay_text_width_string (struct window *w, int findex,
+ Bufbyte *nonreloc, Lisp_Object reloc,
+ Bytecount offset, Bytecount len)
+{
+ if (!rtw_emchar_dynarr)
+ rtw_emchar_dynarr = Dynarr_new (Emchar);
+ Dynarr_reset (rtw_emchar_dynarr);
+
+ fixup_internal_substring (nonreloc, reloc, offset, &len);
+ if (STRINGP (reloc))
+ nonreloc = XSTRING_DATA (reloc);
+ convert_bufbyte_string_into_emchar_dynarr (nonreloc, len, rtw_emchar_dynarr);
+ return redisplay_text_width_emchar_string
+ (w, findex, Dynarr_atp (rtw_emchar_dynarr, 0),
+ Dynarr_length (rtw_emchar_dynarr));
+}
+
+int
+redisplay_frame_text_width_string (struct frame *f, Lisp_Object face,
+ Bufbyte *nonreloc, Lisp_Object reloc,
+ Bytecount offset, Bytecount len)
+{
+ unsigned char charsets[NUM_LEADING_BYTES];
+ Lisp_Object frame;
+ struct face_cachel cachel;
+
+ if (!rtw_emchar_dynarr)
+ rtw_emchar_dynarr = Dynarr_new (Emchar);
+ Dynarr_reset (rtw_emchar_dynarr);
+
+ fixup_internal_substring (nonreloc, reloc, offset, &len);
+ if (STRINGP (reloc))
+ nonreloc = XSTRING_DATA (reloc);
+ convert_bufbyte_string_into_emchar_dynarr (nonreloc, len, rtw_emchar_dynarr);
+ find_charsets_in_bufbyte_string (charsets, nonreloc, len);
+ reset_face_cachel (&cachel);
+ cachel.face = face;
+ XSETFRAME (frame, f);
+ ensure_face_cachel_complete (&cachel, frame, charsets);
+ return DEVMETH (XDEVICE (FRAME_DEVICE (f)),
+ text_width, (f, &cachel, Dynarr_atp (rtw_emchar_dynarr, 0),
+ Dynarr_length (rtw_emchar_dynarr)));
+}
+
+/* Return the display block from DL of the given TYPE. A display line
+ can have only one display block of each possible type. If DL does
+ not have a block of type TYPE, one will be created and added to DL. */
+
+struct display_block *
+get_display_block_from_line (struct display_line *dl, enum display_type type)
+{
+ int elt;
+ struct display_block db;
+
+ /* Check if this display line already has a block of the desired type and
+ if so, return it. */
+ if (dl->display_blocks)
+ {
+ for (elt = 0; elt < Dynarr_length (dl->display_blocks); elt++)
+ {
+ if (Dynarr_at (dl->display_blocks, elt).type == type)
+ return Dynarr_atp (dl->display_blocks, elt);
+ }
+
+ /* There isn't an active block of the desired type, but there
+ might still be allocated blocks we need to reuse. */
+ if (elt < Dynarr_largest (dl->display_blocks))
+ {
+ struct display_block *dbp = Dynarr_atp (dl->display_blocks, elt);
+
+ /* 'add' the block to the list */
+ Dynarr_increment (dl->display_blocks);
+
+ /* initialize and return */
+ dbp->type = type;
+ return dbp;
+ }
+ }
+ else
+ {
+ /* This line doesn't have any display blocks, so initialize the display
+ bock array. */
+ dl->display_blocks = Dynarr_new (display_block);
+ }
+
+ /* The line doesn't have a block of the desired type so go ahead and create
+ one and add it to the line. */
+ xzero (db);
+ db.type = type;
+ db.runes = Dynarr_new (rune);
+ Dynarr_add (dl->display_blocks, db);
+
+ /* Return the newly added display block. */
+ elt = Dynarr_length (dl->display_blocks) - 1;
+
+ return Dynarr_atp (dl->display_blocks, elt);
+}
+
+static int
+tab_char_width (struct window *w)
+{
+ struct buffer *b = XBUFFER (w->buffer);
+ int char_tab_width = XINT (b->tab_width);
+
+ if (char_tab_width <= 0 || char_tab_width > 1000) char_tab_width = 8;
+
+ return char_tab_width;
+}
+
+static int
+space_width (struct window *w)
+{
+ /* While tabs are traditional composed of spaces, for variable-width
+ fonts the space character tends to give too narrow a value. So
+ we use 'n' instead. Except that we don't. We use the default
+ character width for the default face. If this is actually
+ defined by the font then it is probably the best thing to
+ actually use. If it isn't, we have assumed it is 'n' and have
+ already calculated its width. Thus we can avoid a call to
+ XTextWidth on X frames by just querying the default width. */
+ return XFONT_INSTANCE
+ (WINDOW_FACE_CACHEL_FONT (w, DEFAULT_INDEX, Vcharset_ascii))->width;
+}
+
+static int
+tab_pix_width (struct window *w)
+{
+ return space_width (w) * tab_char_width (w);
+}
+
+/* Given a pixel position in a window, return the pixel location of
+ the next tabstop. Tabs are calculated from the left window edge in
+ terms of spaces displayed in the default face. Formerly the space
+ width was determined using the currently active face. That method
+ leads to tabstops which do not line up. */
+
+static int
+next_tab_position (struct window *w, int start_pixpos, int left_pixpos)
+{
+ int n_pos = left_pixpos;
+ 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);
+
+ while (n_pos <= start_pixpos)
+ n_pos += pix_tab_width;
+
+ return n_pos;
+}
+
+/* For the given window, calculate the outside and margin boundaries for a
+ display line. The whitespace boundaries must be calculated by the text
+ layout routines. */
+
+layout_bounds
+calculate_display_line_boundaries (struct window *w, int modeline)
+{
+ layout_bounds bounds;
+
+ /* Set the outermost boundaries which are the boundaries of the
+ window itself minus the gutters (and minus the scrollbars if this
+ is for the modeline). */
+ if (!modeline)
+ {
+ bounds.left_out = WINDOW_TEXT_LEFT (w);
+ bounds.right_out = WINDOW_TEXT_RIGHT (w);
+ }
+ else
+ {
+ bounds.left_out = WINDOW_MODELINE_LEFT (w);
+ bounds.right_out = WINDOW_MODELINE_RIGHT (w);
+ }
+
+ /* 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;
+
+ return bounds;
+}
+
+/* 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. */
+
+static Bufpos
+generate_display_line (struct window *w, struct display_line *dl, int bounds,
+ Bufpos start_pos, int start_col,
+ prop_block_dynarr **prop, int type)
+{
+ Bufpos ret_bufpos;
+ int overlay_width;
+ struct buffer *b = XBUFFER (WINDOW_BUFFER (w));
+
+ /* If our caller hasn't already set the boundaries, then do so now. */
+ if (!bounds)
+ dl->bounds = calculate_display_line_boundaries (w, 0);
+
+ /* 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. */
+ {
+ /* #### 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);
+ if (hacked_up_bytind > BI_BUF_ZV (b))
+ ret_bufpos = BUF_ZV (b) + 1;
+ else
+ ret_bufpos = bytind_to_bufpos (b, hacked_up_bytind);
+ }
+ dl->bufpos = start_pos;
+ if (dl->end_bufpos < dl->bufpos)
+ dl->end_bufpos = dl->bufpos;
+
+ if (MARKERP (Voverlay_arrow_position)
+ && EQ (w->buffer, Fmarker_buffer (Voverlay_arrow_position))
+ && start_pos == marker_position (Voverlay_arrow_position)
+ && (STRINGP (Voverlay_arrow_string)
+ || GLYPHP (Voverlay_arrow_string)))
+ {
+ overlay_width = create_overlay_glyph_block (w, dl);
+ }
+ else
+ overlay_width = 0;
+
+ /* 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, overlay_width);
+
+ /* 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);
+
+ /* In the future additional types of display blocks may be generated
+ here. */
+
+ w->last_redisplay_pos = ret_bufpos;
+
+ return ret_bufpos;
+}
+
+/* Adds an hscroll glyph to a display block. If this is called, then
+ the block had better be empty.
+
+ Yes, there are multiple places where this function is called but
+ that is the way it has to be. Each calling function has to deal
+ with bi_start_col_enabled a little differently depending on the
+ object being worked with. */
+
+static prop_block_dynarr *
+add_hscroll_rune (pos_data *data)
+{
+ struct glyph_block gb;
+ prop_block_dynarr *retval;
+ Bytind bi_old_cursor_bufpos = data->bi_cursor_bufpos;
+ unsigned int old_cursor_type = data->cursor_type;
+ Bytind bi_old_bufpos = data->bi_bufpos;
+
+ if (data->cursor_type == CURSOR_ON
+ && data->bi_cursor_bufpos >= data->bi_start_col_enabled
+ && data->bi_cursor_bufpos <= data->bi_bufpos)
+ {
+ data->bi_cursor_bufpos = data->bi_start_col_enabled;
+ }
+ else
+ {
+ data->cursor_type = NO_CURSOR;
+ }
+
+ data->bi_endpos = data->bi_bufpos;
+ data->bi_bufpos = data->bi_start_col_enabled;
+
+ gb.extent = Qnil;
+ gb.glyph = Vhscroll_glyph;
+ {
+ int oldpixpos = data->pixpos;
+ retval = add_glyph_rune (data, &gb, BEGIN_GLYPHS, 1,
+ GLYPH_CACHEL (XWINDOW (data->window),
+ HSCROLL_GLYPH_INDEX));
+ data->hscroll_glyph_width_adjust =
+ data->pixpos - oldpixpos - space_width (XWINDOW (data->window));
+ }
+ data->bi_endpos = 0;
+ data->bi_cursor_bufpos = bi_old_cursor_bufpos;
+ data->cursor_type = old_cursor_type;
+ data->bi_bufpos = bi_old_bufpos;
+
+ data->bi_start_col_enabled = 0;
+ return retval;
+}
+
+/* Adds a character rune to a display block. If there is not enough
+ room to fit the rune on the display block (as determined by the
+ MAX_PIXPOS) then it adds nothing and returns ADD_FAILED. */
+
+static prop_block_dynarr *
+add_emchar_rune (pos_data *data)
+{
+ struct rune rb, *crb;
+ int width, local;
+
+ if (data->start_col)
+ {
+ data->start_col--;
+
+ if (data->start_col)
+ return NULL;
+ }
+
+ if (data->bi_start_col_enabled)
+ {
+ return add_hscroll_rune (data);
+ }
+
+ if (data->ch == '\n')
+ {
+ data->font_is_bogus = 0;
+ /* Cheesy end-of-line pseudo-character. */
+ width = data->blank_width;
+ }
+ else
+ {
+ Lisp_Object charset = CHAR_CHARSET (data->ch);
+ if (!EQ (charset, data->last_charset) ||
+ data->findex != data->last_findex)
+ {
+ /* OK, we need to do things the hard way. */
+ struct window *w = XWINDOW (data->window);
+ struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, data->findex);
+ Lisp_Object font_instance =
+ ensure_face_cachel_contains_charset (cachel, data->window,
+ charset);
+ struct Lisp_Font_Instance *fi;
+
+ if (EQ (font_instance, Vthe_null_font_instance))
+ {
+ font_instance = FACE_CACHEL_FONT (cachel, Vcharset_ascii);
+ data->font_is_bogus = 1;
+ }
+ else
+ data->font_is_bogus = 0;
+
+ fi = XFONT_INSTANCE (font_instance);
+ if (!fi->proportional_p)
+ /* sweetness and light. */
+ data->last_char_width = fi->width;
+ else
+ data->last_char_width = -1;
+ data->new_ascent = max (data->new_ascent, (int) fi->ascent);
+ data->new_descent = max (data->new_descent, (int) fi->descent);
+ data->last_charset = charset;
+ data->last_findex = data->findex;
+ }
+
+ width = data->last_char_width;
+ if (width < 0)
+ {
+ /* bummer. Proportional fonts. */
+ width = redisplay_text_width_emchar_string (XWINDOW (data->window),
+ data->findex,
+ &data->ch, 1);
+ }
+ }
+
+ if (data->max_pixpos != -1 && (data->pixpos + width > data->max_pixpos))
+ {
+ return ADD_FAILED;
+ }
+
+ if (Dynarr_length (data->db->runes) < Dynarr_largest (data->db->runes))
+ {
+ crb = Dynarr_atp (data->db->runes, Dynarr_length (data->db->runes));
+ local = 0;
+ }
+ else
+ {
+ crb = &rb;
+ local = 1;
+ }
+
+ crb->findex = data->findex;
+ 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);
+ else if (data->is_modeline)
+ crb->bufpos = data->modeline_charpos;
+ else
+ /* fuckme if this shouldn't be an abort. */
+ /* abort (); fuckme harder, this abort gets tripped quite often,
+ in propagation and whatnot. #### fixme */
+ crb->bufpos = 0;
+ crb->type = RUNE_CHAR;
+ crb->object.chr.ch = data->font_is_bogus ? '~' : data->ch;
+ crb->endpos = 0;
+
+ if (data->cursor_type == CURSOR_ON)
+ {
+ if (data->bi_bufpos == data->bi_cursor_bufpos)
+ {
+ crb->cursor_type = CURSOR_ON;
+ data->cursor_x = Dynarr_length (data->db->runes);
+ }
+ else
+ crb->cursor_type = CURSOR_OFF;
+ }
+ else if (data->cursor_type == NEXT_CURSOR)
+ {
+ crb->cursor_type = CURSOR_ON;
+ data->cursor_x = Dynarr_length (data->db->runes);
+ data->cursor_type = NO_CURSOR;
+ }
+ else if (data->cursor_type == IGNORE_CURSOR)
+ crb->cursor_type = IGNORE_CURSOR;
+ else
+ crb->cursor_type = CURSOR_OFF;
+
+ if (local)
+ Dynarr_add (data->db->runes, *crb);
+ else
+ Dynarr_increment (data->db->runes);
+
+ data->pixpos += width;
+
+ return NULL;
+}
+
+/* Given a string C_STRING of length C_LENGTH, call add_emchar_rune
+ for each character in the string. Propagate any left-over data
+ unless NO_PROP is non-zero. */
+
+static prop_block_dynarr *
+add_bufbyte_string_runes (pos_data *data, Bufbyte *c_string,
+ Bytecount c_length, int no_prop)
+{
+ Bufbyte *pos, *end = c_string + c_length;
+ prop_block_dynarr *prop;
+
+ /* #### This function is too simplistic. It needs to do the same
+ sort of character interpretation (display-table lookup,
+ ctl-arrow checking), etc. that create_text_block() does.
+ The functionality to do this in that routine needs to be
+ modularized. */
+
+ for (pos = c_string; pos < end;)
+ {
+ data->ch = charptr_emchar (pos);
+
+ prop = add_emchar_rune (data);
+
+ if (prop)
+ {
+ if (no_prop)
+ return ADD_FAILED;
+ else
+ {
+ struct prop_block pb;
+ Bytecount len = end - pos;
+ prop = Dynarr_new (prop_block);
+
+ pb.type = PROP_STRING;
+ pb.data.p_string.str = xnew_array (Bufbyte, len);
+ strncpy ((char *) pb.data.p_string.str, (char *) pos, len);
+ pb.data.p_string.len = len;
+
+ Dynarr_add (prop, pb);
+ return prop;
+ }
+ }
+ INC_CHARPTR (pos);
+ assert (pos <= end);
+ }
+
+ return NULL;
+}
+
+/* Add a single rune of the specified width. The area covered by this
+ rune will be displayed in the foreground color of the associated
+ face. */
+
+static prop_block_dynarr *
+add_blank_rune (pos_data *data, struct window *w, int char_tab_width)
+{
+ struct rune rb;
+
+ /* If data->start_col is not 0 then this call to add_blank_rune must have
+ been to add it as a tab. */
+ if (data->start_col)
+ {
+ /* assert (w != NULL) */
+ prop_block_dynarr *retval;
+
+ /* If we have still not fully scrolled horizontally, subtract
+ the width of this tab and return. */
+ if (char_tab_width < data->start_col)
+ {
+ data->start_col -= char_tab_width;
+ return NULL;
+ }
+ else if (char_tab_width == data->start_col)
+ data->blank_width = 0;
+ else
+ {
+ int spcwid = space_width (w);
+
+ if (spcwid >= data->blank_width)
+ data->blank_width = 0;
+ else
+ data->blank_width -= spcwid;
+ }
+
+ data->start_col = 0;
+ retval = add_hscroll_rune (data);
+
+ /* Could be caused by the handling of the hscroll rune. */
+ if (retval != NULL || !data->blank_width)
+ return retval;
+ }
+
+ /* Blank runes are always calculated to fit. */
+ assert (data->pixpos + data->blank_width <= data->max_pixpos);
+
+ rb.findex = data->findex;
+ rb.xpos = data->pixpos;
+ rb.width = data->blank_width;
+ if (data->bi_bufpos)
+ rb.bufpos =
+ bytind_to_bufpos (XBUFFER (WINDOW_BUFFER (XWINDOW (data->window))),
+ data->bi_bufpos);
+ else
+ /* #### and this is really correct too? */
+ rb.bufpos = 0;
+ rb.endpos = 0;
+ rb.type = RUNE_BLANK;
+
+ if (data->cursor_type == CURSOR_ON)
+ {
+ if (data->bi_bufpos == data->bi_cursor_bufpos)
+ {
+ rb.cursor_type = CURSOR_ON;
+ data->cursor_x = Dynarr_length (data->db->runes);
+ }
+ else
+ rb.cursor_type = CURSOR_OFF;
+ }
+ else if (data->cursor_type == NEXT_CURSOR)
+ {
+ rb.cursor_type = CURSOR_ON;
+ data->cursor_x = Dynarr_length (data->db->runes);
+ data->cursor_type = NO_CURSOR;
+ }
+ else
+ rb.cursor_type = CURSOR_OFF;
+
+ Dynarr_add (data->db->runes, rb);
+ data->pixpos += data->blank_width;
+
+ return NULL;
+}
+
+/* Add runes representing a character in octal. */
+
+#define ADD_NEXT_OCTAL_RUNE_CHAR do \
+{ \
+ if (add_failed || (add_failed = add_emchar_rune (data))) \
+ { \
+ struct prop_block pb; \
+ if (!prop) \
+ prop = Dynarr_new (prop_block); \
+ \
+ pb.type = PROP_CHAR; \
+ pb.data.p_char.ch = data->ch; \
+ pb.data.p_char.cursor_type = data->cursor_type; \
+ Dynarr_add (prop, pb); \
+ } \
+} while (0)
+
+static prop_block_dynarr *
+add_octal_runes (pos_data *data)
+{
+ prop_block_dynarr *prop, *add_failed;
+ Emchar orig_char = data->ch;
+ unsigned int orig_cursor_type = data->cursor_type;
+
+ /* Initialize */
+ prop = NULL;
+ add_failed = NULL;
+
+ if (data->start_col)
+ data->start_col--;
+
+ if (!data->start_col)
+ {
+ if (data->bi_start_col_enabled)
+ {
+ add_failed = add_hscroll_rune (data);
+ }
+ else
+ {
+ struct glyph_block gb;
+ struct window *w = XWINDOW (data->window);
+
+ gb.extent = Qnil;
+ gb.glyph = Voctal_escape_glyph;
+ add_failed =
+ add_glyph_rune (data, &gb, BEGIN_GLYPHS, 1,
+ GLYPH_CACHEL (w, OCT_ESC_GLYPH_INDEX));
+ }
+ }
+
+ /* We only propagate information if the glyph was partially
+ added. */
+ if (add_failed)
+ return add_failed;
+
+ data->cursor_type = IGNORE_CURSOR;
+
+ if (data->ch >= 0x100)
+ {
+ /* If the character is an extended Mule character, it could have
+ up to 19 bits. For the moment, we treat it as a seven-digit
+ octal number. This is not that pretty, but whatever. */
+ data->ch = (7 & (orig_char >> 18)) + '0';
+ ADD_NEXT_OCTAL_RUNE_CHAR;
+
+ data->ch = (7 & (orig_char >> 15)) + '0';
+ ADD_NEXT_OCTAL_RUNE_CHAR;
+
+ data->ch = (7 & (orig_char >> 12)) + '0';
+ ADD_NEXT_OCTAL_RUNE_CHAR;
+
+ data->ch = (7 & (orig_char >> 9)) + '0';
+ ADD_NEXT_OCTAL_RUNE_CHAR;
+ }
+
+ data->ch = (7 & (orig_char >> 6)) + '0';
+ ADD_NEXT_OCTAL_RUNE_CHAR;
+
+ data->ch = (7 & (orig_char >> 3)) + '0';
+ ADD_NEXT_OCTAL_RUNE_CHAR;
+
+ data->ch = (7 & orig_char) + '0';
+ ADD_NEXT_OCTAL_RUNE_CHAR;
+
+ data->cursor_type = orig_cursor_type;
+ return prop;
+}
+
+#undef ADD_NEXT_OCTAL_RUNE_CHAR
+
+/* Add runes representing a control character to a display block. */
+
+static prop_block_dynarr *
+add_control_char_runes (pos_data *data, struct buffer *b)
+{
+ if (!NILP (b->ctl_arrow))
+ {
+ prop_block_dynarr *prop;
+ Emchar orig_char = data->ch;
+ unsigned int old_cursor_type = data->cursor_type;
+
+ /* Initialize */
+ prop = NULL;
+
+ if (data->start_col)
+ data->start_col--;
+
+ if (!data->start_col)
+ {
+ if (data->bi_start_col_enabled)
+ {
+ prop_block_dynarr *retval;
+
+ retval = add_hscroll_rune (data);
+ if (retval)
+ return retval;
+ }
+ else
+ {
+ struct glyph_block gb;
+ struct window *w = XWINDOW (data->window);
+
+ gb.extent = Qnil;
+ gb.glyph = Vcontrol_arrow_glyph;
+
+ /* We only propagate information if the glyph was partially
+ added. */
+ if (add_glyph_rune (data, &gb, BEGIN_GLYPHS, 1,
+ GLYPH_CACHEL (w, CONTROL_GLYPH_INDEX)))
+ return ADD_FAILED;
+ }
+ }
+
+ if (orig_char == 0177)
+ data->ch = '?';
+ else
+ data->ch = orig_char ^ 0100;
+ data->cursor_type = IGNORE_CURSOR;
+
+ if (add_emchar_rune (data))
+ {
+ struct prop_block pb;
+ if (!prop)
+ prop = Dynarr_new (prop_block);
+
+ pb.type = PROP_CHAR;
+ pb.data.p_char.ch = data->ch;
+ pb.data.p_char.cursor_type = data->cursor_type;
+ Dynarr_add (prop, pb);
+ }
+
+ data->cursor_type = old_cursor_type;
+ return prop;
+ }
+ else
+ {
+ return add_octal_runes (data);
+ }
+}
+
+/* Given a display table entry, call the appropriate functions to
+ display each element of the entry. */
+
+static prop_block_dynarr *
+add_disp_table_entry_runes (pos_data *data, Lisp_Object entry)
+{
+ prop_block_dynarr *prop = NULL;
+
+ if (VECTORP (entry))
+ {
+ struct Lisp_Vector *de = XVECTOR (entry);
+ long len = vector_length (de);
+ int elt;
+
+ for (elt = 0; elt < len; elt++)
+ {
+ if (NILP (de->contents[elt]))
+ continue;
+ else if (STRINGP (de->contents[elt]))
+ {
+ prop =
+ add_bufbyte_string_runes
+ (data,
+ XSTRING_DATA (de->contents[elt]),
+ XSTRING_LENGTH (de->contents[elt]),
+ 0);
+ }
+ else if (GLYPHP (de->contents[elt]))
+ {
+ if (data->start_col)
+ data->start_col--;
+
+ if (!data->start_col && data->bi_start_col_enabled)
+ {
+ prop = add_hscroll_rune (data);
+ }
+ else
+ {
+ struct glyph_block gb;
+
+ gb.glyph = de->contents[elt];
+ gb.extent = Qnil;
+ prop = add_glyph_rune (data, &gb, BEGIN_GLYPHS, 0, 0);
+ }
+ }
+ else if (CHAR_OR_CHAR_INTP (de->contents[elt]))
+ {
+ data->ch = XCHAR_OR_CHAR_INT (de->contents[elt]);
+ prop = add_emchar_rune (data);
+ }
+ /* Else blow it off because someone added a bad entry and we
+ don't have any safe way of signaling an error. */
+
+ /* #### Still need to add any remaining elements to the
+ propagation information. */
+ if (prop)
+ return prop;
+ }
+ }
+ else if (STRINGP (entry))
+ {
+ prop = add_bufbyte_string_runes (data,
+ XSTRING_DATA (entry),
+ XSTRING_LENGTH (entry),
+ 0);
+ }
+ else if (GLYPHP (entry))
+ {
+ if (data->start_col)
+ data->start_col--;
+
+ if (!data->start_col && data->bi_start_col_enabled)
+ {
+ prop = add_hscroll_rune (data);
+ }
+ else
+ {
+ struct glyph_block gb;
+
+ gb.glyph = entry;
+ gb.extent = Qnil;
+ prop = add_glyph_rune (data, &gb, BEGIN_GLYPHS, 0, 0);
+ }
+ }
+ else if (CHAR_OR_CHAR_INTP (entry))
+ {
+ data->ch = XCHAR_OR_CHAR_INT (entry);
+ prop = add_emchar_rune (data);
+ }
+
+ /* Else blow it off because someone added a bad entry and we don't
+ have any safe way of signaling an error. Hey, this comment
+ sounds familiar. */
+ return prop;
+}
+
+/* Add runes which were propagated from the previous line. */
+
+static prop_block_dynarr *
+add_propagation_runes (prop_block_dynarr **prop, pos_data *data)
+{
+ /* #### Remember to handle start_col parameter of data when the rest of
+ this is finished. */
+ /* #### Chuck -- I've redone this function a bit. It looked like the
+ case of not all the propagation blocks being added was not handled
+ well. */
+ /* #### Chuck -- I also think the double indirection of PROP is kind
+ of bogus. A cleaner solution is just to check for
+ Dynarr_length (prop) > 0. */
+ /* #### This function also doesn't even pay attention to ADD_FAILED!
+ This is seriously fucked! Seven ####'s in 130 lines -- is that a
+ record? */
+ int elt;
+ prop_block_dynarr *add_failed;
+ Bytind bi_old_cursor_bufpos = data->bi_cursor_bufpos;
+ unsigned int old_cursor_type = data->cursor_type;
+
+ for (elt = 0; elt < Dynarr_length (*prop); elt++)
+ {
+ struct prop_block *pb = Dynarr_atp (*prop, elt);
+
+ switch (pb->type)
+ {
+ case PROP_CHAR:
+ data->ch = pb->data.p_char.ch;
+ data->bi_cursor_bufpos = pb->data.p_char.bi_cursor_bufpos;
+ data->cursor_type = pb->data.p_char.cursor_type;
+ add_failed = add_emchar_rune (data);
+
+ if (add_failed)
+ goto oops_no_more_space;
+ break;
+ case PROP_STRING:
+ if (pb->data.p_string.str)
+ xfree (pb->data.p_string.str);
+ /* #### bogus bogus -- this doesn't do anything!
+ Should probably call add_bufbyte_string_runes(),
+ once that function is fixed. */
+ break;
+ case PROP_MINIBUF_PROMPT:
+ {
+ face_index old_findex = data->findex;
+ Bytind bi_old_bufpos = data->bi_bufpos;
+
+ data->findex = DEFAULT_INDEX;
+ data->bi_bufpos = 0;
+ data->cursor_type = NO_CURSOR;
+
+ while (pb->data.p_string.len > 0)
+ {
+ data->ch = charptr_emchar (pb->data.p_string.str);
+ add_failed = add_emchar_rune (data);
+
+ if (add_failed)
+ {
+ data->findex = old_findex;
+ data->bi_bufpos = bi_old_bufpos;
+ goto oops_no_more_space;
+ }
+ else
+ {
+ /* Complicated equivalent of ptr++, len-- */
+ Bufbyte *oldpos = pb->data.p_string.str;
+ INC_CHARPTR (pb->data.p_string.str);
+ pb->data.p_string.len -= pb->data.p_string.str - oldpos;
+ }
+ }
+
+ data->findex = old_findex;
+ /* ##### FIXME FIXME FIXME -- Upon successful return from
+ this function, data->bi_bufpos is automatically incremented.
+ However, we don't want that to happen if we were adding
+ the minibuffer prompt. */
+ {
+ struct buffer *buf =
+ XBUFFER (WINDOW_BUFFER (XWINDOW (data->window)));
+ /* #### Chuck fix this shit or I'm gonna scream! */
+ if (bi_old_bufpos > BI_BUF_BEGV (buf))
+ data->bi_bufpos = prev_bytind (buf, bi_old_bufpos);
+ else
+ /* #### is this correct? Does anyone know?
+ Does anyone care? Is this a cheesy hack or what? */
+ data->bi_bufpos = BI_BUF_BEGV (buf) - 1;
+ }
+ }
+ break;
+ case PROP_BLANK:
+ {
+ /* #### I think it's unnecessary and misleading to preserve
+ the blank_width, as it implies that the value carries
+ over from one rune to the next, which is wrong. */
+ int old_width = data->blank_width;
+ face_index old_findex = data->findex;
+
+ data->findex = pb->data.p_blank.findex;
+ data->blank_width = pb->data.p_blank.width;
+ data->bi_cursor_bufpos = 0;
+ data->cursor_type = IGNORE_CURSOR;
+
+ if (data->pixpos + data->blank_width > data->max_pixpos)
+ data->blank_width = data->max_pixpos - data->pixpos;
+
+ /* We pass a bogus value of char_tab_width. It shouldn't
+ matter because unless something is really screwed up
+ this call won't cause that arg to be used. */
+ add_failed = add_blank_rune (data, XWINDOW (data->window), 0);
+
+ /* This can happen in the case where we have a tab which
+ is wider than the window. */
+ if (data->blank_width != pb->data.p_blank.width)
+ {
+ pb->data.p_blank.width -= data->blank_width;
+ add_failed = ADD_FAILED;
+ }
+
+ data->findex = old_findex;
+ data->blank_width = old_width;
+
+ if (add_failed)
+ goto oops_no_more_space;
+ }
+ break;
+ default:
+ abort ();
+ }
+ }
+
+ oops_no_more_space:
+
+ data->bi_cursor_bufpos = bi_old_cursor_bufpos;
+ data->cursor_type = old_cursor_type;
+ if (elt < Dynarr_length (*prop))
+ {
+ Dynarr_delete_many (*prop, 0, elt);
+ return *prop;
+ }
+ else
+ {
+ Dynarr_free (*prop);
+ return NULL;
+ }
+}
+
+/* Add 'text layout glyphs at position POS_TYPE that are contained to
+ the display block, but add all other types to the appropriate list
+ of the display line. They will be added later by different
+ routines. */
+
+static prop_block_dynarr *
+add_glyph_rune (pos_data *data, struct glyph_block *gb, int pos_type,
+ int allow_cursor, struct glyph_cachel *cachel)
+{
+ struct window *w = XWINDOW (data->window);
+
+ /* A nil extent indicates a special glyph (ex. truncator). */
+ if (NILP (gb->extent)
+ || (pos_type == BEGIN_GLYPHS &&
+ extent_begin_glyph_layout (XEXTENT (gb->extent)) == GL_TEXT)
+ || (pos_type == END_GLYPHS &&
+ extent_end_glyph_layout (XEXTENT (gb->extent)) == GL_TEXT))
+ {
+ struct rune rb;
+ int width;
+ int xoffset = 0;
+ int ascent, descent;
+ Lisp_Object baseline;
+ Lisp_Object face;
+
+ if (cachel)
+ width = cachel->width;
+ else
+ width = glyph_width (gb->glyph, Qnil, data->findex, data->window);
+
+ if (!width)
+ return NULL;
+
+ if (data->start_col)
+ {
+ prop_block_dynarr *retval;
+ int glyph_char_width = width / space_width (w);
+
+ /* If we still have not fully scrolled horizontally after
+ taking into account the width of the glyph, subtract its
+ width and return. */
+ if (glyph_char_width < data->start_col)
+ {
+ data->start_col -= glyph_char_width;
+ return NULL;
+ }
+ else if (glyph_char_width == data->start_col)
+ width = 0;
+ else
+ {
+ xoffset = space_width (w) * data->start_col;
+ width -= xoffset;
+
+ /* #### Can this happen? */
+ if (width < 0)
+ width = 0;
+ }
+
+ data->start_col = 0;
+ retval = add_hscroll_rune (data);
+
+ /* Could be caused by the handling of the hscroll rune. */
+ if (retval != NULL || !width)
+ return retval;
+ }
+ else
+ xoffset = 0;
+
+ if (data->pixpos + width > data->max_pixpos)
+ {
+ /* If this is the first object we are attempting to add to
+ the line then we ignore the horizontal_clip threshold.
+ Otherwise we will loop until the bottom of the window
+ continually failing to add this glyph because it is wider
+ than the window. We could alternatively just completely
+ ignore the glyph and proceed from there but I think that
+ this is a better solution. */
+ if (Dynarr_length (data->db->runes)
+ && data->max_pixpos - data->pixpos < horizontal_clip)
+ return ADD_FAILED;
+ else
+ width = data->max_pixpos - data->pixpos;
+ }
+
+ if (cachel)
+ {
+ ascent = cachel->ascent;
+ descent = cachel->descent;
+ }
+ else
+ {
+ ascent = glyph_ascent (gb->glyph, Qnil, data->findex, data->window);
+ descent = glyph_descent (gb->glyph, Qnil, data->findex,
+ data->window);
+ }
+
+ baseline = glyph_baseline (gb->glyph, data->window);
+
+ if (glyph_contrib_p (gb->glyph, data->window))
+ {
+ /* A pixmap that has not had a baseline explicitly set. Its
+ contribution will be determined later. */
+ if (NILP (baseline))
+ {
+ int height = ascent + descent;
+ data->max_pixmap_height = max (data->max_pixmap_height, height);
+ }
+
+ /* A string so determine contribution normally. */
+ else if (EQ (baseline, Qt))
+ {
+ data->new_ascent = max (data->new_ascent, ascent);
+ data->new_descent = max (data->new_descent, descent);
+ }
+
+ /* A pixmap with an explicitly set baseline. We determine the
+ contribution here. */
+ else if (INTP (baseline))
+ {
+ int height = ascent + descent;
+ int pix_ascent, pix_descent;
+
+ pix_ascent = height * XINT (baseline) / 100;
+ pix_descent = height - pix_ascent;
+
+ data->new_ascent = max (data->new_ascent, pix_ascent);
+ data->new_descent = max (data->new_descent, pix_descent);
+ }
+
+ /* Otherwise something is screwed up. */
+ else
+ abort ();
+ }
+
+ face = glyph_face (gb->glyph, data->window);
+ if (NILP (face))
+ rb.findex = data->findex;
+ else
+ rb.findex = get_builtin_face_cache_index (w, face);
+
+ rb.xpos = data->pixpos;
+ rb.width = width;
+ rb.bufpos = 0; /* glyphs are never "at" anywhere */
+ if (data->bi_endpos)
+ /* #### is this necessary at all? */
+ rb.endpos = bytind_to_bufpos (XBUFFER (WINDOW_BUFFER (w)),
+ data->bi_endpos);
+ else
+ rb.endpos = 0;
+ rb.type = RUNE_DGLYPH;
+ /* #### Ben sez: this is way bogus if the glyph is a string.
+ You should not make the output routines have to cope with
+ this. The string could contain Mule characters, or non-
+ printable characters, or characters to be passed through
+ the display table, or non-character objects (when this gets
+ implemented), etc. Instead, this routine here should parse
+ the string into a series of runes. */
+ rb.object.dglyph.glyph = gb->glyph;
+ rb.object.dglyph.extent = gb->extent;
+ rb.object.dglyph.xoffset = xoffset;
+
+ if (allow_cursor)
+ {
+ rb.bufpos = bytind_to_bufpos (XBUFFER (WINDOW_BUFFER (w)),
+ data->bi_bufpos);
+
+ if (data->cursor_type == CURSOR_ON)
+ {
+ if (data->bi_bufpos == data->bi_cursor_bufpos)
+ {
+ rb.cursor_type = CURSOR_ON;
+ data->cursor_x = Dynarr_length (data->db->runes);
+ }
+ else
+ rb.cursor_type = CURSOR_OFF;
+ }
+ else if (data->cursor_type == NEXT_CURSOR)
+ {
+ rb.cursor_type = CURSOR_ON;
+ data->cursor_x = Dynarr_length (data->db->runes);
+ data->cursor_type = NO_CURSOR;
+ }
+ else if (data->cursor_type == IGNORE_CURSOR)
+ rb.cursor_type = IGNORE_CURSOR;
+ else if (data->cursor_type == NO_CURSOR)
+ rb.cursor_type = NO_CURSOR;
+ else
+ rb.cursor_type = CURSOR_OFF;
+ }
+ else
+ rb.cursor_type = CURSOR_OFF;
+
+ Dynarr_add (data->db->runes, rb);
+ data->pixpos += width;
+
+ return NULL;
+ }
+ else
+ {
+ if (!NILP (glyph_face (gb->glyph, data->window)))
+ gb->findex =
+ get_builtin_face_cache_index (w, glyph_face (gb->glyph,
+ data->window));
+ else
+ gb->findex = data->findex;
+
+ if (pos_type == BEGIN_GLYPHS)
+ {
+ if (!data->dl->left_glyphs)
+ data->dl->left_glyphs = Dynarr_new (glyph_block);
+ Dynarr_add (data->dl->left_glyphs, *gb);
+ return NULL;
+ }
+ else if (pos_type == END_GLYPHS)
+ {
+ if (!data->dl->right_glyphs)
+ data->dl->right_glyphs = Dynarr_new (glyph_block);
+ Dynarr_add (data->dl->right_glyphs, *gb);
+ return NULL;
+ }
+ else
+ abort (); /* there are no unknown types */
+ }
+
+ return NULL; /* shut up compiler */
+}
+
+/* Add all glyphs at position POS_TYPE that are contained in the given
+ data. */
+
+static prop_block_dynarr *
+add_glyph_runes (pos_data *data, int pos_type)
+{
+ /* #### This still needs to handle the start_col parameter. Duh, Chuck,
+ why didn't you just modify add_glyph_rune in the first place? */
+ int elt;
+ glyph_block_dynarr *glyph_arr = (pos_type == BEGIN_GLYPHS
+ ? data->ef->begin_glyphs
+ : data->ef->end_glyphs);
+ prop_block_dynarr *prop;
+
+ for (elt = 0; elt < Dynarr_length (glyph_arr); elt++)
+ {
+ prop = add_glyph_rune (data, Dynarr_atp (glyph_arr, elt), pos_type, 0,
+ 0);
+
+ if (prop)
+ {
+ /* #### Add some propagation information. */
+ return prop;
+ }
+ }
+
+ Dynarr_reset (glyph_arr);
+
+ return NULL;
+}
+
+/* Given a position for a buffer in a window, ensure that the given
+ display line DL accurately represents the text on a line starting
+ at the given position.
+
+ NOTE NOTE NOTE NOTE: This function works with and returns Bytinds.
+ You must do appropriate conversion. */
+
+static Bytind
+create_text_block (struct window *w, struct display_line *dl,
+ Bytind bi_start_pos, int start_col,
+ prop_block_dynarr **prop, int type)
+{
+ struct frame *f = XFRAME (w->frame);
+ struct buffer *b = XBUFFER (w->buffer);
+ struct device *d = XDEVICE (f->device);
+
+ pos_data data;
+ struct Lisp_Vector *dt = 0;
+
+ /* Don't display anything in the minibuffer if this window is not on
+ a selected frame. We consider all other windows to be active
+ minibuffers as it simplifies the coding. */
+ int active_minibuffer = (!MINI_WINDOW_P (w) ||
+ (f == device_selected_frame (d)) ||
+ is_surrogate_for_selected_frame (f));
+
+ int truncate_win = window_truncation_on (w);
+ int end_glyph_width;
+
+ /* If the buffer's value of selective_display is an integer then
+ only lines that start with less than selective_display columns of
+ space will be displayed. If selective_display is t then all text
+ after a ^M is invisible. */
+ int selective = (INTP (b->selective_display)
+ ? XINT (b->selective_display)
+ : ((!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.
+ #### 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. An idea I like is to
+ be able 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
+ pre-defined hex display-table (or maybe computes one if
+ you give weird parameters to the function) and adds it
+ to the list of display tables for the current buffer.
+
+ Unfortunately there are still problems dealing with Mule
+ characters. For example, maybe I want to specify that
+ all extended characters (i.e. >= 256) are displayed in hex.
+ It's not reasonable to create a mapping for all possible
+ such characters, because there are about 2^19 of them.
+ One way of dealing with this is to extend the concept
+ of what a display table is. Currently it's only allowed
+ to be a 256-entry vector. Instead, it should be something
+ like:
+
+ a) A 256-entry vector, for backward compatibility
+ b) Some sort of hashtable, mapping characters to values
+ c) A list that specifies a range of values and the
+ mapping to provide for those values.
+
+ Also, extend the concept of "mapping" to include a
+ printf-like spec. Then, you could make all extended
+ characters show up as hex with a display table like
+
+ ((256 . 524288) . "%x")
+
+ Since more than one display table is possible, you have
+ great flexibility in mapping ranges of characters.
+ */
+ Emchar printable_min = (CHAR_OR_CHAR_INTP (b->ctl_arrow)
+ ? XCHAR_OR_CHAR_INT (b->ctl_arrow)
+ : ((EQ (b->ctl_arrow, Qt) || EQ (b->ctl_arrow, Qnil))
+ ? 255 : 160));
+
+ /* 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;
+
+ Lisp_Object synch_minibuffers_value =
+ symbol_value_in_buffer (Qsynchronize_minibuffers, w->buffer);
+
+ dl->used_prop_data = 0;
+ dl->num_chars = 0;
+
+ xzero (data);
+ data.ef = extent_fragment_new (w->buffer, 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_INDEX;
+ data.result_str = Qnil;
+
+ /* 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 (truncate_win)
+ end_glyph_width = GLYPH_CACHEL_WIDTH (w, TRUN_GLYPH_INDEX);
+ else
+ end_glyph_width = GLYPH_CACHEL_WIDTH (w, CONT_GLYPH_INDEX);
+ data.max_pixpos -= end_glyph_width;
+
+ if (cursor_in_echo_area && MINI_WINDOW_P (w) && echo_area_active (f))
+ {
+ data.bi_cursor_bufpos = BI_BUF_ZV (b);
+ data.cursor_type = CURSOR_ON;
+ }
+ else if (MINI_WINDOW_P (w) && !active_minibuffer)
+ data.cursor_type = NO_CURSOR;
+ else if (w == XWINDOW (FRAME_SELECTED_WINDOW (f)) &&
+ EQ(DEVICE_CONSOLE(d), Vselected_console) &&
+ d == XDEVICE(CONSOLE_SELECTED_DEVICE(XCONSOLE(DEVICE_CONSOLE(d))))&&
+ f == XFRAME(DEVICE_SELECTED_FRAME(d)))
+ {
+ data.bi_cursor_bufpos = BI_BUF_PT (b);
+ data.cursor_type = CURSOR_ON;
+ }
+ else if (w == XWINDOW (FRAME_SELECTED_WINDOW (f)))
+ {
+ data.bi_cursor_bufpos = bi_marker_position (w->pointm[type]);
+ data.cursor_type = CURSOR_ON;
+ }
+ else
+ data.cursor_type = NO_CURSOR;
+ data.cursor_x = -1;
+
+ data.start_col = w->hscroll;
+ data.bi_start_col_enabled = (w->hscroll ? bi_start_pos : 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
+ && (active_minibuffer || !NILP (synch_minibuffers_value)))
+ {
+ /* #### This check probably should not be necessary. */
+ if (data.bi_bufpos > BI_BUF_ZV (b))
+ {
+ /* #### urk! More of this lossage! */
+ data.bi_bufpos--;
+ goto done;
+ }
+
+ /* If selective display was an integer and we aren't working on
+ a continuation line then find the next line we are actually
+ supposed to display. */
+ if (selective > 0
+ && (data.bi_bufpos == BI_BUF_BEGV (b)
+ || BUF_FETCH_CHAR (b, prev_bytind (b, data.bi_bufpos)) == '\n'))
+ {
+ while (bi_spaces_at_point (b, data.bi_bufpos) >= selective)
+ {
+ data.bi_bufpos =
+ bi_find_next_newline_no_quit (b, data.bi_bufpos, 1);
+ if (data.bi_bufpos >= BI_BUF_ZV (b))
+ {
+ data.bi_bufpos = BI_BUF_ZV (b);
+ 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);
+
+ if (data.bi_bufpos == data.ef->end)
+ no_more_frags = 1;
+
+ dt = get_display_table (w, data.findex);
+ }
+ 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;
+ }
+
+ /* If point is in an invisible region we place it on the
+ next visible character. */
+ if (data.cursor_type == CURSOR_ON
+ && data.bi_bufpos == data.bi_cursor_bufpos)
+ {
+ data.cursor_type = NEXT_CURSOR;
+ }
+
+ /* #### What if we we're dealing with a display table? */
+ if (data.start_col)
+ data.start_col--;
+
+ if (data.bi_bufpos == BI_BUF_ZV (b))
+ goto done;
+ else
+ INC_BYTIND (b, 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_BUF_ZV (b))
+ goto done;
+ else if (data.bi_bufpos < BI_BUF_BEGV (b))
+ /* #### urk urk urk! Aborts are not very fun! Fix this please! */
+ data.bi_bufpos = BI_BUF_BEGV (b);
+ else
+ INC_BYTIND (b, 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_BUF_ZV (b))
+ goto done;
+
+ else
+ {
+ /* Get the character at the current buffer position. */
+ data.ch = BI_BUF_FETCH_CHAR (b, data.bi_bufpos);
+
+ /* 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 (dt && !NILP (DISP_CHAR_ENTRY (dt, data.ch)))
+ {
+ *prop =
+ add_disp_table_entry_runes (&data,
+ DISP_CHAR_ENTRY (dt, data.ch));
+
+ 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;
+
+ if (selective > 0
+ && (bi_spaces_at_point
+ (b, next_bytind (b, data.bi_bufpos))
+ >= selective))
+ {
+ if (!NILP (b->selective_display_ellipses))
+ {
+ struct glyph_block gb;
+
+ gb.extent = Qnil;
+ gb.glyph = Vinvisible_text_glyph;
+ add_glyph_rune (&data, &gb, BEGIN_GLYPHS, 0,
+ GLYPH_CACHEL (w, INVIS_GLYPH_INDEX));
+ }
+ else
+ {
+ /* Cheesy, cheesy, cheesy. We mark the end of the
+ line with a special "character rune" whose width
+ is the EOL cursor width and whose character is
+ the non-printing character '\n'. */
+ data.blank_width = DEVMETH (d, eol_cursor_width, ());
+ *prop = add_emchar_rune (&data);
+ }
+
+ /* We need to set data.bi_bufpos to the start of the
+ next visible region in order to make this line
+ appear to contain all of the invisible area.
+ Otherwise, the line cache won't work
+ correctly. */
+ INC_BYTIND (b, data.bi_bufpos);
+ while (bi_spaces_at_point (b, data.bi_bufpos) >= selective)
+ {
+ data.bi_bufpos =
+ bi_find_next_newline_no_quit (b, data.bi_bufpos, 1);
+ if (data.bi_bufpos >= BI_BUF_ZV (b))
+ {
+ data.bi_bufpos = BI_BUF_ZV (b);
+ break;
+ }
+ }
+ if (BI_BUF_FETCH_CHAR
+ (b, prev_bytind (b, data.bi_bufpos)) == '\n')
+ DEC_BYTIND (b, data.bi_bufpos);
+ }
+ else
+ {
+ data.blank_width = DEVMETH (d, eol_cursor_width, ());
+ *prop = add_emchar_rune (&data);
+ }
+
+ goto done;
+ }
+
+ /* If the current character is ^M, and selective display is
+ enabled, then add the invisible-text-glyph if
+ selective-display-ellipses is set. In any case, this
+ line is done. */
+ else if (data.ch == (('M' & 037)) && selective == -1)
+ {
+ Bytind bi_next_bufpos;
+
+ /* Find the buffer position at the end of the line. */
+ bi_next_bufpos =
+ bi_find_next_newline_no_quit (b, data.bi_bufpos, 1);
+ if (BI_BUF_FETCH_CHAR (b, prev_bytind (b, bi_next_bufpos))
+ == '\n')
+ DEC_BYTIND (b, bi_next_bufpos);
+
+ /* If the cursor is somewhere in the elided text make
+ sure that the cursor gets drawn appropriately. */
+ if (data.cursor_type == CURSOR_ON
+ && (data.bi_cursor_bufpos >= data.bi_bufpos &&
+ data.bi_cursor_bufpos < bi_next_bufpos))
+ {
+ data.cursor_type = NEXT_CURSOR;
+ }
+
+ /* We won't be adding a truncation or continuation glyph
+ so give up the room allocated for them. */
+ data.max_pixpos += end_glyph_width;
+
+ if (!NILP (b->selective_display_ellipses))
+ {
+ /* We don't propagate anything from the invisible
+ text glyph if it fails to fit. This is
+ intentional. */
+ struct glyph_block gb;
+
+ gb.extent = Qnil;
+ gb.glyph = Vinvisible_text_glyph;
+ add_glyph_rune (&data, &gb, BEGIN_GLYPHS, 1,
+ GLYPH_CACHEL (w, INVIS_GLYPH_INDEX));
+ }
+
+ /* Set the buffer position to the end of the line. We
+ need to do this before potentially adding a newline
+ so that the cursor flag will get set correctly (if
+ needed). */
+ data.bi_bufpos = bi_next_bufpos;
+
+ if (NILP (b->selective_display_ellipses)
+ || data.bi_cursor_bufpos == bi_next_bufpos)
+ {
+ /* We have to at least add a newline character so
+ that the cursor shows up properly. */
+ data.ch = '\n';
+ data.blank_width = DEVMETH (d, eol_cursor_width, ());
+ data.findex = DEFAULT_INDEX;
+ data.start_col = 0;
+ data.bi_start_col_enabled = 0;
+
+ add_emchar_rune (&data);
+ }
+
+ /* This had better be a newline but doing it this way
+ we'll see obvious incorrect results if it isn't. No
+ need to abort here. */
+ data.ch = BI_BUF_FETCH_CHAR (b, data.bi_bufpos);
+
+ 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_BYTIND (b, 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_BUF_ZV (b)
+ && (active_minibuffer || !NILP (synch_minibuffers_value)))
+ {
+ /* #### 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')
+ {
+ /* If data.start_col_enabled is still true, then the window is
+ scrolled far enough so that nothing on this line is visible.
+ We need to stick a trunctation glyph at the beginning of the
+ line in that case unless the line is completely blank. */
+ if (data.bi_start_col_enabled)
+ {
+ if (data.cursor_type == CURSOR_ON)
+ {
+ if (data.bi_cursor_bufpos >= bi_start_pos
+ && data.bi_cursor_bufpos <= data.bi_bufpos)
+ data.bi_cursor_bufpos = data.bi_bufpos;
+ }
+ data.findex = DEFAULT_INDEX;
+ data.start_col = 0;
+ data.bi_start_col_enabled = 0;
+
+ if (data.bi_bufpos != bi_start_pos)
+ {
+ struct glyph_block gb;
+
+ gb.extent = Qnil;
+ gb.glyph = Vhscroll_glyph;
+ add_glyph_rune (&data, &gb, BEGIN_GLYPHS, 0,
+ GLYPH_CACHEL (w, HSCROLL_GLYPH_INDEX));
+ }
+ else
+ {
+ /* This duplicates code down below to add a newline to
+ the end of an otherwise empty line.*/
+ data.ch = '\n';
+ data.blank_width = DEVMETH (d, eol_cursor_width, ());
+
+ add_emchar_rune (&data);
+ }
+ }
+
+ INC_BYTIND (b, 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_INDEX;
+ gb.extent = Qnil;
+
+ if (truncate_win)
+ {
+ Bytind bi_pos;
+
+ /* Now find the start of the next line. */
+ bi_pos = bi_find_next_newline_no_quit (b, data.bi_bufpos, 1);
+
+ /* If the cursor is past the truncation line then we
+ make it appear on the truncation glyph. If we've hit
+ the end of the buffer then we also make the cursor
+ appear unless eob is immediately preceded by a
+ newline. In that case the cursor should actually
+ appear on the next line. */
+ if (data.cursor_type == CURSOR_ON
+ && data.bi_cursor_bufpos >= data.bi_bufpos
+ && (data.bi_cursor_bufpos < bi_pos ||
+ (bi_pos == BI_BUF_ZV (b)
+ && (bi_pos == BI_BUF_BEGV (b)
+ || (BI_BUF_FETCH_CHAR (b, prev_bytind (b, bi_pos))
+ != '\n')))))
+ data.bi_cursor_bufpos = bi_pos;
+ else
+ 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);
+ }
+
+ add_glyph_rune (&data, &gb, BEGIN_GLYPHS, 1, cachel);
+
+ if (truncate_win && data.bi_bufpos == BI_BUF_ZV (b)
+ && BI_BUF_FETCH_CHAR (b, prev_bytind (b, BI_BUF_ZV (b))) != '\n')
+ /* #### Damn this losing shit. */
+ data.bi_bufpos++;
+ }
+ }
+ else if ((active_minibuffer || !NILP (synch_minibuffers_value))
+ && (!echo_area_active (f) || data.bi_bufpos == BI_BUF_ZV (b)))
+ {
+ /* We need to add a marker to the end of the line since there is no
+ newline character in order for the cursor to get drawn. We label
+ it as a newline so that it gets handled correctly by the
+ whitespace routines below. */
+
+ data.ch = '\n';
+ data.blank_width = DEVMETH (d, eol_cursor_width, ());
+ data.findex = DEFAULT_INDEX;
+ data.start_col = 0;
+ data.bi_start_col_enabled = 0;
+
+ data.max_pixpos += data.blank_width;
+ add_emchar_rune (&data);
+ data.max_pixpos -= data.blank_width;
+
+ /* #### urk! Chuck, this shit is bad news. Going around
+ manipulating invalid positions is guaranteed to result in
+ trouble sooner or later. */
+ data.bi_bufpos = BI_BUF_ZV (b) + 1;
+ }
+
+ /* 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_BUF_ZV (b))
+ dl->end_bufpos = BUF_ZV (b);
+ else
+ dl->end_bufpos = bytind_to_bufpos (b, data.bi_bufpos) - 1;
+ if (truncate_win)
+ data.dl->num_chars = column_at_point (b, dl->end_bufpos, 0);
+ 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_BUF_ZV (b) && bi_start_pos == BI_BUF_ZV (b))
+ return data.bi_bufpos + 1; /* Yuck! */
+ else
+ return data.bi_bufpos;
+}
+
+/* Display the overlay arrow at the beginning of the given line. */
+
+static int
+create_overlay_glyph_block (struct window *w, struct display_line *dl)
+{
+ struct frame *f = XFRAME (w->frame);
+ struct device *d = XDEVICE (f->device);
+ pos_data data;
+
+ /* If Voverlay_arrow_string isn't valid then just fail silently. */
+ if (!STRINGP (Voverlay_arrow_string) && !GLYPHP (Voverlay_arrow_string))
+ return 0;
+
+ xzero (data);
+ data.ef = NULL;
+ data.d = d;
+ XSETWINDOW (data.window, w);
+ data.db = get_display_block_from_line (dl, OVERWRITE);
+ data.dl = dl;
+ data.pixpos = dl->bounds.left_in;
+ data.max_pixpos = dl->bounds.right_in;
+ data.cursor_type = NO_CURSOR;
+ data.cursor_x = -1;
+ data.findex = DEFAULT_INDEX;
+ data.last_charset = Qunbound;
+ data.last_findex = DEFAULT_INDEX;
+ data.result_str = Qnil;
+
+ Dynarr_reset (data.db->runes);
+
+ if (STRINGP (Voverlay_arrow_string))
+ {
+ add_bufbyte_string_runes
+ (&data,
+ XSTRING_DATA (Voverlay_arrow_string),
+ XSTRING_LENGTH (Voverlay_arrow_string),
+ 1);
+ }
+ else if (GLYPHP (Voverlay_arrow_string))
+ {
+ struct glyph_block gb;
+
+ gb.glyph = Voverlay_arrow_string;
+ gb.extent = Qnil;
+ add_glyph_rune (&data, &gb, BEGIN_GLYPHS, 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;
+
+ data.db->start_pos = dl->bounds.left_in;
+ data.db->end_pos = data.pixpos;
+
+ return data.pixpos - dl->bounds.left_in;
+}
+
+/* Add a type of glyph to a margin display block. */
+
+static int
+add_margin_runes (struct display_line *dl, struct display_block *db, int start,
+ int count, enum glyph_layout layout, int side, Lisp_Object window)
+{
+ glyph_block_dynarr *gbd = (side == LEFT_GLYPHS
+ ? dl->left_glyphs
+ : dl->right_glyphs);
+ int elt, end;
+ int xpos = start;
+ int reverse;
+
+ if ((layout == GL_WHITESPACE && side == LEFT_GLYPHS)
+ || (layout == GL_INSIDE_MARGIN && side == RIGHT_GLYPHS))
+ {
+ reverse = 1;
+ elt = Dynarr_length (gbd) - 1;
+ end = 0;
+ }
+ else
+ {
+ reverse = 0;
+ elt = 0;
+ end = Dynarr_length (gbd);
+ }
+
+ while (count && ((!reverse && elt < end) || (reverse && elt >= end)))
+ {
+ struct glyph_block *gb = Dynarr_atp (gbd, elt);
+
+ if (NILP (gb->extent))
+ abort (); /* these should have been handled in add_glyph_rune */
+
+ if (gb->active &&
+ ((side == LEFT_GLYPHS &&
+ extent_begin_glyph_layout (XEXTENT (gb->extent)) == layout)
+ || (side == RIGHT_GLYPHS &&
+ extent_end_glyph_layout (XEXTENT (gb->extent)) == layout)))
+ {
+ struct rune rb;
+
+ rb.width = gb->width;
+ rb.findex = gb->findex;
+ rb.xpos = xpos;
+ rb.bufpos = -1;
+ rb.endpos = 0;
+ rb.type = RUNE_DGLYPH;
+ rb.object.dglyph.glyph = gb->glyph;
+ rb.object.dglyph.extent = gb->extent;
+ rb.object.dglyph.xoffset = 0;
+ rb.cursor_type = CURSOR_OFF;
+
+ Dynarr_add (db->runes, rb);
+ xpos += rb.width;
+ count--;
+ gb->active = 0;
+
+ if (glyph_contrib_p (gb->glyph, window))
+ {
+ 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);
+
+ /* A pixmap that has not had a baseline explicitly set.
+ We use the existing ascent / descent ratio of the
+ line. */
+ if (NILP (baseline))
+ {
+ int gheight = ascent + descent;
+ int line_height = dl->ascent + dl->descent;
+ int pix_ascent, pix_descent;
+
+ pix_descent = (int) (gheight * dl->descent) / line_height;
+ pix_ascent = gheight - pix_descent;
+
+ dl->ascent = max ((int) dl->ascent, pix_ascent);
+ dl->descent = max ((int) dl->descent, pix_descent);
+ }
+
+ /* A string so determine contribution normally. */
+ else if (EQ (baseline, Qt))
+ {
+ dl->ascent = max (dl->ascent, ascent);
+ dl->descent = max (dl->descent, descent);
+ }
+
+ /* A pixmap with an explicitly set baseline. We determine the
+ contribution here. */
+ else if (INTP (baseline))
+ {
+ int height = ascent + descent;
+ int pix_ascent, pix_descent;
+
+ pix_ascent = height * XINT (baseline) / 100;
+ pix_descent = height - pix_ascent;
+
+ dl->ascent = max ((int) dl->ascent, pix_ascent);
+ dl->descent = max ((int) dl->descent, pix_descent);
+ }
+
+ /* Otherwise something is screwed up. */
+ else
+ abort ();
+ }
+ }
+
+ (reverse ? elt-- : elt++);
+ }
+
+ return xpos;
+}
+
+/* Add a blank to a margin display block. */
+
+static void
+add_margin_blank (struct display_line *dl, struct display_block *db,
+ struct window *w, int xpos, int width, int side)
+{
+ struct rune rb;
+
+ rb.findex = (side == LEFT_GLYPHS
+ ? get_builtin_face_cache_index (w, Vleft_margin_face)
+ : get_builtin_face_cache_index (w, Vright_margin_face));
+ rb.xpos = xpos;
+ rb.width = width;
+ rb.bufpos = -1;
+ rb.endpos = 0;
+ rb.type = RUNE_BLANK;
+ rb.cursor_type = CURSOR_OFF;
+
+ Dynarr_add (db->runes, rb);
+}
+
+/* Display glyphs in the left outside margin, left inside margin and
+ left whitespace area. */
+
+static void
+create_left_glyph_block (struct window *w, struct display_line *dl,
+ int overlay_width)
+{
+ Lisp_Object window;
+
+ int use_overflow = (NILP (w->use_left_overflow) ? 0 : 1);
+ int elt, end_xpos;
+ int out_end, in_out_start, in_in_end, white_out_start, white_in_start;
+ int out_cnt, in_out_cnt, in_in_cnt, white_out_cnt, white_in_cnt;
+ int left_in_start = dl->bounds.left_in;
+ int left_in_end = dl->bounds.left_in + overlay_width;
+
+ struct display_block *odb, *idb;
+
+ XSETWINDOW (window, w);
+
+ /* We have to add the glyphs to the line in the order outside,
+ inside, whitespace. However the precedence dictates that we
+ determine how many will fit in the reverse order. */
+
+ /* Determine how many whitespace glyphs we can display and where
+ they should start. */
+ white_in_start = dl->bounds.left_white;
+ white_out_start = left_in_start;
+ white_out_cnt = white_in_cnt = 0;
+ elt = 0;
+
+ while (elt < Dynarr_length (dl->left_glyphs))
+ {
+ struct glyph_block *gb = Dynarr_atp (dl->left_glyphs, elt);
+
+ if (NILP (gb->extent))
+ abort (); /* these should have been handled in add_glyph_rune */
+
+ if (extent_begin_glyph_layout (XEXTENT (gb->extent)) == GL_WHITESPACE)
+ {
+ int width;
+
+ width = glyph_width (gb->glyph, Qnil, gb->findex, window);
+
+ if (white_in_start - width >= left_in_end)
+ {
+ white_in_cnt++;
+ white_in_start -= width;
+ gb->width = width;
+ gb->active = 1;
+ }
+ else if (use_overflow
+ && (white_out_start - width > dl->bounds.left_out))
+ {
+ white_out_cnt++;
+ white_out_start -= width;
+ gb->width = width;
+ gb->active = 1;
+ }
+ else
+ gb->active = 0;
+ }
+
+ elt++;
+ }
+
+ /* Determine how many inside margin glyphs we can display and where
+ they should start. The inside margin glyphs get whatever space
+ is left after the whitespace glyphs have been displayed. These
+ are tricky to calculate since if we decide to use the overflow
+ area we basicaly have to start over. So for these we build up a
+ list of just the inside margin glyphs and manipulate it to
+ determine the needed info. */
+ {
+ glyph_block_dynarr *ib;
+ int avail_in, avail_out;
+ int done = 0;
+ int marker = 0;
+ int used_in, used_out;
+
+ elt = 0;
+ used_in = used_out = 0;
+ ib = Dynarr_new (glyph_block);
+ while (elt < Dynarr_length (dl->left_glyphs))
+ {
+ struct glyph_block *gb = Dynarr_atp (dl->left_glyphs, elt);
+
+ if (NILP (gb->extent))
+ abort (); /* these should have been handled in add_glyph_rune */
+
+ if (extent_begin_glyph_layout (XEXTENT (gb->extent)) ==
+ GL_INSIDE_MARGIN)
+ {
+ gb->width = glyph_width (gb->glyph, Qnil, gb->findex, window);
+ used_in += gb->width;
+ Dynarr_add (ib, *gb);
+ }
+
+ elt++;
+ }
+
+ if (white_out_cnt)
+ avail_in = 0;
+ else
+ {
+ avail_in = white_in_start - left_in_end;
+ if (avail_in < 0)
+ avail_in = 0;
+ }
+
+ if (!use_overflow)
+ avail_out = 0;
+ else
+ avail_out = white_out_start - dl->bounds.left_out;
+
+ marker = 0;
+ while (!done && marker < Dynarr_length (ib))
+ {
+ int width = Dynarr_atp (ib, marker)->width;
+
+ /* If everything now fits in the available inside margin
+ space, we're done. */
+ if (used_in <= avail_in)
+ done = 1;
+ else
+ {
+ /* Otherwise see if we have room to move a glyph to the
+ outside. */
+ if (used_out + width <= avail_out)
+ {
+ used_out += width;
+ used_in -= width;
+ }
+ else
+ done = 1;
+ }
+
+ if (!done)
+ marker++;
+ }
+
+ /* At this point we now know that everything from marker on goes in
+ the inside margin and everything before it goes in the outside
+ margin. The stuff going into the outside margin is guaranteed
+ to fit, but we may have to trim some stuff from the inside. */
+
+ in_in_end = left_in_end;
+ in_out_start = white_out_start;
+ in_out_cnt = in_in_cnt = 0;
+
+ Dynarr_free (ib);
+ elt = 0;
+ while (elt < Dynarr_length (dl->left_glyphs))
+ {
+ struct glyph_block *gb = Dynarr_atp (dl->left_glyphs, elt);
+
+ if (NILP (gb->extent))
+ abort (); /* these should have been handled in add_glyph_rune */
+
+ if (extent_begin_glyph_layout (XEXTENT (gb->extent)) ==
+ GL_INSIDE_MARGIN)
+ {
+ int width = glyph_width (gb->glyph, Qnil, gb->findex, window);
+
+ if (used_out)
+ {
+ in_out_cnt++;
+ in_out_start -= width;
+ gb->width = width;
+ gb->active = 1;
+ used_out -= width;
+ }
+ else if (in_in_end + width < white_in_start)
+ {
+ in_in_cnt++;
+ in_in_end += width;
+ gb->width = width;
+ gb->active = 1;
+ }
+ else
+ gb->active = 0;
+ }
+
+ elt++;
+ }
+ }
+
+ /* Determine how many outside margin glyphs we can display. They
+ always start at the left outside margin and can only use the
+ outside margin space. */
+ out_end = dl->bounds.left_out;
+ out_cnt = 0;
+ elt = 0;
+
+ while (elt < Dynarr_length (dl->left_glyphs))
+ {
+ struct glyph_block *gb = Dynarr_atp (dl->left_glyphs, elt);
+
+ if (NILP (gb->extent))
+ abort (); /* these should have beeb handled in add_glyph_rune */
+
+ if (extent_begin_glyph_layout (XEXTENT (gb->extent)) ==
+ GL_OUTSIDE_MARGIN)
+ {
+ int width = glyph_width (gb->glyph, Qnil, gb->findex, window);
+
+ if (out_end + width <= in_out_start)
+ {
+ out_cnt++;
+ out_end += width;
+ gb->width = width;
+ gb->active = 1;
+ }
+ else
+ gb->active = 0;
+ }
+
+ elt++;
+ }
+
+ /* Now that we know where everything goes, we add the glyphs as
+ runes to the appropriate display blocks. */
+ if (out_cnt || in_out_cnt || white_out_cnt)
+ {
+ odb = get_display_block_from_line (dl, LEFT_OUTSIDE_MARGIN);
+ odb->start_pos = dl->bounds.left_out;
+ /* #### We should stop adding a blank to account for the space
+ between the end of the glyphs and the margin and instead set
+ this accordingly. */
+ odb->end_pos = dl->bounds.left_in;
+ Dynarr_reset (odb->runes);
+ }
+ else
+ odb = 0;
+
+ if (in_in_cnt || white_in_cnt)
+ {
+ idb = get_display_block_from_line (dl, LEFT_INSIDE_MARGIN);
+ idb->start_pos = dl->bounds.left_in;
+ /* #### See above comment for odb->end_pos */
+ idb->end_pos = dl->bounds.left_white;
+ Dynarr_reset (idb->runes);
+ }
+ else
+ idb = 0;
+
+ /* First add the outside margin glyphs. */
+ if (out_cnt)
+ end_xpos = add_margin_runes (dl, odb, dl->bounds.left_out, out_cnt,
+ GL_OUTSIDE_MARGIN, LEFT_GLYPHS, window);
+ else
+ end_xpos = dl->bounds.left_out;
+
+ /* There may be blank space between the outside margin glyphs and
+ the inside margin glyphs. If so, add a blank. */
+ if (in_out_cnt && (in_out_start - end_xpos))
+ {
+ add_margin_blank (dl, odb, w, end_xpos, in_out_start - end_xpos,
+ LEFT_GLYPHS);
+ }
+
+ /* Next add the inside margin glyphs which are actually in the
+ outside margin. */
+ if (in_out_cnt)
+ {
+ end_xpos = add_margin_runes (dl, odb, in_out_start, in_out_cnt,
+ GL_INSIDE_MARGIN, LEFT_GLYPHS, window);
+ }
+
+ /* If we didn't add any inside margin glyphs to the outside margin,
+ but are adding whitespace glyphs, then we need to add a blank
+ here. */
+ if (!in_out_cnt && white_out_cnt && (white_out_start - end_xpos))
+ {
+ add_margin_blank (dl, odb, w, end_xpos, white_out_start - end_xpos,
+ LEFT_GLYPHS);
+ }
+
+ /* Next add the whitespace margin glyphs which are actually in the
+ outside margin. */
+ if (white_out_cnt)
+ {
+ end_xpos = add_margin_runes (dl, odb, white_out_start, white_out_cnt,
+ GL_WHITESPACE, LEFT_GLYPHS, window);
+ }
+
+ /* We take care of clearing between the end of the glyphs and the
+ start of the inside margin for lines which have glyphs. */
+ if (odb && (left_in_start - end_xpos))
+ {
+ add_margin_blank (dl, odb, w, end_xpos, left_in_start - end_xpos,
+ LEFT_GLYPHS);
+ }
+
+ /* Next add the inside margin glyphs which are actually in the
+ inside margin. */
+ if (in_in_cnt)
+ {
+ end_xpos = add_margin_runes (dl, idb, left_in_end, in_in_cnt,
+ GL_INSIDE_MARGIN, LEFT_GLYPHS, window);
+ }
+ else
+ end_xpos = left_in_end;
+
+ /* Make sure that the area between the end of the inside margin
+ glyphs and the whitespace glyphs is cleared. */
+ if (idb && (white_in_start - end_xpos > 0))
+ {
+ add_margin_blank (dl, idb, w, end_xpos, white_in_start - end_xpos,
+ LEFT_GLYPHS);
+ }
+
+ /* Next add the whitespace margin glyphs which are actually in the
+ inside margin. */
+ if (white_in_cnt)
+ {
+ add_margin_runes (dl, idb, white_in_start, white_in_cnt, GL_WHITESPACE,
+ LEFT_GLYPHS, window);
+ }
+
+ /* Whitespace glyphs always end right next to the text block so
+ there is nothing we have to make sure is cleared after them. */
+}
+
+/* Display glyphs in the right outside margin, right inside margin and
+ right whitespace area. */
+
+static void
+create_right_glyph_block (struct window *w, struct display_line *dl)
+{
+ Lisp_Object window;
+
+ int use_overflow = (NILP (w->use_right_overflow) ? 0 : 1);
+ int elt, end_xpos;
+ int out_start, in_out_end, in_in_start, white_out_end, white_in_end;
+ int out_cnt, in_out_cnt, in_in_cnt, white_out_cnt, white_in_cnt;
+
+ struct display_block *odb, *idb;
+
+ XSETWINDOW (window, w);
+
+ /* We have to add the glyphs to the line in the order outside,
+ inside, whitespace. However the precedence dictates that we
+ determine how many will fit in the reverse order. */
+
+ /* Determine how many whitespace glyphs we can display and where
+ they should start. */
+ white_in_end = dl->bounds.right_white;
+ white_out_end = dl->bounds.right_in;
+ white_out_cnt = white_in_cnt = 0;
+ elt = 0;
+
+ while (elt < Dynarr_length (dl->right_glyphs))
+ {
+ struct glyph_block *gb = Dynarr_atp (dl->right_glyphs, elt);
+
+ if (NILP (gb->extent))
+ abort (); /* these should have been handled in add_glyph_rune */
+
+ if (extent_end_glyph_layout (XEXTENT (gb->extent)) == GL_WHITESPACE)
+ {
+ int width = glyph_width (gb->glyph, Qnil, gb->findex, window);
+
+ if (white_in_end + width <= dl->bounds.right_in)
+ {
+ white_in_cnt++;
+ white_in_end += width;
+ gb->width = width;
+ gb->active = 1;
+ }
+ else if (use_overflow
+ && (white_out_end + width <= dl->bounds.right_out))
+ {
+ white_out_cnt++;
+ white_out_end += width;
+ gb->width = width;
+ gb->active = 1;
+ }
+ else
+ gb->active = 0;
+ }
+
+ elt++;
+ }
+
+ /* Determine how many inside margin glyphs we can display and where
+ they should start. The inside margin glyphs get whatever space
+ is left after the whitespace glyphs have been displayed. These
+ are tricky to calculate since if we decide to use the overflow
+ area we basicaly have to start over. So for these we build up a
+ list of just the inside margin glyphs and manipulate it to
+ determine the needed info. */
+ {
+ glyph_block_dynarr *ib;
+ int avail_in, avail_out;
+ int done = 0;
+ int marker = 0;
+ int used_in, used_out;
+
+ elt = 0;
+ used_in = used_out = 0;
+ ib = Dynarr_new (glyph_block);
+ while (elt < Dynarr_length (dl->right_glyphs))
+ {
+ struct glyph_block *gb = Dynarr_atp (dl->right_glyphs, elt);
+
+ if (NILP (gb->extent))
+ abort (); /* these should have been handled in add_glyph_rune */
+
+ if (extent_end_glyph_layout (XEXTENT (gb->extent)) == GL_INSIDE_MARGIN)
+ {
+ gb->width = glyph_width (gb->glyph, Qnil, gb->findex, window);
+ used_in += gb->width;
+ Dynarr_add (ib, *gb);
+ }
+
+ elt++;
+ }
+
+ if (white_out_cnt)
+ avail_in = 0;
+ else
+ avail_in = dl->bounds.right_in - white_in_end;
+
+ if (!use_overflow)
+ avail_out = 0;
+ else
+ avail_out = dl->bounds.right_out - white_out_end;
+
+ marker = 0;
+ while (!done && marker < Dynarr_length (ib))
+ {
+ int width = Dynarr_atp (ib, marker)->width;
+
+ /* If everything now fits in the available inside margin
+ space, we're done. */
+ if (used_in <= avail_in)
+ done = 1;
+ else
+ {
+ /* Otherwise see if we have room to move a glyph to the
+ outside. */
+ if (used_out + width <= avail_out)
+ {
+ used_out += width;
+ used_in -= width;
+ }
+ else
+ done = 1;
+ }
+
+ if (!done)
+ marker++;
+ }
+
+ /* At this point we now know that everything from marker on goes in
+ the inside margin and everything before it goes in the outside
+ margin. The stuff going into the outside margin is guaranteed
+ to fit, but we may have to trim some stuff from the inside. */
+
+ in_in_start = dl->bounds.right_in;
+ in_out_end = dl->bounds.right_in;
+ in_out_cnt = in_in_cnt = 0;
+
+ Dynarr_free (ib);
+ elt = 0;
+ while (elt < Dynarr_length (dl->right_glyphs))
+ {
+ struct glyph_block *gb = Dynarr_atp (dl->right_glyphs, elt);
+
+ if (NILP (gb->extent))
+ abort (); /* these should have been handled in add_glyph_rune */
+
+ if (extent_end_glyph_layout (XEXTENT (gb->extent)) == GL_INSIDE_MARGIN)
+ {
+ int width = glyph_width (gb->glyph, Qnil, gb->findex, window);
+
+ if (used_out)
+ {
+ in_out_cnt++;
+ in_out_end += width;
+ gb->width = width;
+ gb->active = 1;
+ used_out -= width;
+ }
+ else if (in_in_start - width >= white_in_end)
+ {
+ in_in_cnt++;
+ in_in_start -= width;
+ gb->width = width;
+ gb->active = 1;
+ }
+ else
+ gb->active = 0;
+ }
+
+ elt++;
+ }
+ }
+
+ /* Determine how many outside margin glyphs we can display. They
+ always start at the right outside margin and can only use the
+ outside margin space. */
+ out_start = dl->bounds.right_out;
+ out_cnt = 0;
+ elt = 0;
+
+ while (elt < Dynarr_length (dl->right_glyphs))
+ {
+ struct glyph_block *gb = Dynarr_atp (dl->right_glyphs, elt);
+
+ if (NILP (gb->extent))
+ abort (); /* these should have beeb handled in add_glyph_rune */
+
+ if (extent_end_glyph_layout (XEXTENT (gb->extent)) == GL_OUTSIDE_MARGIN)
+ {
+ int width = glyph_width (gb->glyph, Qnil, gb->findex, window);
+
+ if (out_start - width >= in_out_end)
+ {
+ out_cnt++;
+ out_start -= width;
+ gb->width = width;
+ gb->active = 1;
+ }
+ else
+ gb->active = 0;
+ }
+
+ elt++;
+ }
+
+ /* Now that we now where everything goes, we add the glyphs as runes
+ to the appropriate display blocks. */
+ if (out_cnt || in_out_cnt || white_out_cnt)
+ {
+ odb = get_display_block_from_line (dl, RIGHT_OUTSIDE_MARGIN);
+ /* #### See comments before odb->start_pos init in
+ create_left_glyph_block */
+ odb->start_pos = dl->bounds.right_in;
+ odb->end_pos = dl->bounds.right_out;
+ Dynarr_reset (odb->runes);
+ }
+ else
+ odb = 0;
+
+ if (in_in_cnt || white_in_cnt)
+ {
+ idb = get_display_block_from_line (dl, RIGHT_INSIDE_MARGIN);
+ idb->start_pos = dl->bounds.right_white;
+ /* #### See comments before odb->start_pos init in
+ create_left_glyph_block */
+ idb->end_pos = dl->bounds.right_in;
+ Dynarr_reset (idb->runes);
+ }
+ else
+ idb = 0;
+
+ /* First add the whitespace margin glyphs which are actually in the
+ inside margin. */
+ if (white_in_cnt)
+ {
+ end_xpos = add_margin_runes (dl, idb, dl->bounds.right_white,
+ white_in_cnt, GL_WHITESPACE, RIGHT_GLYPHS,
+ window);
+ }
+ else
+ end_xpos = dl->bounds.right_white;
+
+ /* Make sure that the area between the end of the whitespace glyphs
+ and the inside margin glyphs is cleared. */
+ if (in_in_cnt && (in_in_start - end_xpos))
+ {
+ add_margin_blank (dl, idb, w, end_xpos, in_in_start - end_xpos,
+ RIGHT_GLYPHS);
+ }
+
+ /* Next add the inside margin glyphs which are actually in the
+ inside margin. */
+ if (in_in_cnt)
+ {
+ end_xpos = add_margin_runes (dl, idb, in_in_start, in_in_cnt,
+ GL_INSIDE_MARGIN, RIGHT_GLYPHS, window);
+ }
+
+ /* If we didn't add any inside margin glyphs then make sure the rest
+ of the inside margin area gets cleared. */
+ if (idb && (dl->bounds.right_in - end_xpos))
+ {
+ add_margin_blank (dl, idb, w, end_xpos, dl->bounds.right_in - end_xpos,
+ RIGHT_GLYPHS);
+ }
+
+ /* Next add any whitespace glyphs in the outside margin. */
+ if (white_out_cnt)
+ {
+ end_xpos = add_margin_runes (dl, odb, dl->bounds.right_in, white_out_cnt,
+ GL_WHITESPACE, RIGHT_GLYPHS, window);
+ }
+ else
+ end_xpos = dl->bounds.right_in;
+
+ /* Next add any inside margin glyphs in the outside margin. */
+ if (in_out_cnt)
+ {
+ end_xpos = add_margin_runes (dl, odb, end_xpos, in_out_cnt,
+ GL_INSIDE_MARGIN, RIGHT_GLYPHS, window);
+ }
+
+ /* There may be space between any whitespace or inside margin glyphs
+ in the outside margin and the actual outside margin glyphs. */
+ if (odb && (out_start - end_xpos))
+ {
+ add_margin_blank (dl, odb, w, end_xpos, out_start - end_xpos,
+ RIGHT_GLYPHS);
+ }
+
+ /* Finally, add the outside margin glyphs. */
+ if (out_cnt)
+ {
+ add_margin_runes (dl, odb, out_start, out_cnt, GL_OUTSIDE_MARGIN,
+ RIGHT_GLYPHS, window);
+ }
+}
+
+\f
+/***************************************************************************/
+/* */
+/* modeline routines */
+/* */
+/***************************************************************************/
+
+/* 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 teh modeline in order to account
+ for any embedded faces. */
+ dl->ypos = WINDOW_BOTTOM (w) - dl->descent - ypos_adj;
+}
+
+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)
+{
+ struct frame *f = XFRAME (w->frame);
+ struct device *d = XDEVICE (f->device);
+
+ pos_data data;
+ int c_pixpos;
+
+ xzero (data);
+ data.d = d;
+ data.db = db;
+ data.dl = dl;
+ data.findex = findex;
+ data.pixpos = min_pixpos;
+ data.max_pixpos = max_pixpos;
+ data.cursor_type = NO_CURSOR;
+ data.last_charset = Qunbound;
+ data.last_findex = DEFAULT_INDEX;
+ data.result_str = result_str;
+ data.is_modeline = 1;
+ 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. */
+ generate_fstring_runes (w, &data, 0, 0, -1, format_str, 0,
+ max_pixpos - min_pixpos, findex, type);
+
+ if (Dynarr_length (db->runes))
+ {
+ struct rune *rb =
+ Dynarr_atp (db->runes, Dynarr_length (db->runes) - 1);
+ c_pixpos = rb->xpos + rb->width;
+ }
+ else
+ c_pixpos = min_pixpos;
+
+ /* If we don't reach the right side of the window, add a blank rune
+ to make up the difference. This usually only occurs if the
+ modeline face is using a proportional width font or a fixed width
+ font of a different size from the default face font. */
+
+ if (c_pixpos < max_pixpos)
+ {
+ data.pixpos = c_pixpos;
+ data.blank_width = max_pixpos - data.pixpos;
+
+ add_blank_rune (&data, NULL, 0);
+ }
+
+ /* Now create the result string and frob the extents into it. */
+ if (!NILP (result_str))
+ {
+ int elt;
+ Bytecount len;
+ Bufbyte *strdata;
+ struct buffer *buf = XBUFFER (WINDOW_BUFFER (w));
+
+ detach_all_extents (result_str);
+ resize_string (XSTRING (result_str), -1,
+ data.bytepos - XSTRING_LENGTH (result_str));
+
+ strdata = XSTRING_DATA (result_str);
+
+ for (elt = 0, len = 0; elt < Dynarr_length (db->runes); elt++)
+ {
+ if (Dynarr_atp (db->runes, elt)->type == RUNE_CHAR)
+ {
+ len += (set_charptr_emchar
+ (strdata + len, Dynarr_atp (db->runes,
+ elt)->object.chr.ch));
+ }
+ }
+
+ for (elt = 0; elt < Dynarr_length (formatted_string_extent_dynarr);
+ elt++)
+ {
+ Lisp_Object extent = Qnil;
+ Lisp_Object child;
+
+ XSETEXTENT (extent, Dynarr_at (formatted_string_extent_dynarr, elt));
+ child = Fgethash (extent, buf->modeline_extent_table, Qnil);
+ if (NILP (child))
+ {
+ child = Fmake_extent (Qnil, Qnil, result_str);
+ Fputhash (extent, child, buf->modeline_extent_table);
+ }
+ Fset_extent_parent (child, extent);
+ set_extent_endpoints
+ (XEXTENT (child),
+ Dynarr_at (formatted_string_extent_start_dynarr, elt),
+ Dynarr_at (formatted_string_extent_end_dynarr, elt),
+ result_str);
+ }
+ }
+}
+
+static Charcount
+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;
+ struct display_block *db = data->db;
+
+ data->blank_width = space_width (XWINDOW (data->window));
+ while (Dynarr_length (db->runes) < pos)
+ add_blank_rune (data, NULL, 0);
+
+ end = (Dynarr_length (db->runes) +
+ 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;
+ int succeeded;
+
+ data->ch = charptr_emchar (cur_pos);
+ succeeded = (add_emchar_rune (data) != ADD_FAILED);
+ INC_CHARPTR (cur_pos);
+ if (succeeded)
+ {
+ pos++;
+ data->modeline_charpos++;
+ data->bytepos += cur_pos - old_cur_pos;
+ }
+ }
+
+ while (Dynarr_length (db->runes) < min_pos &&
+ (data->pixpos + data->blank_width <= data->max_pixpos))
+ add_blank_rune (data, NULL, 0);
+
+ return Dynarr_length (db->runes);
+}
+
+/* #### Urk! Should also handle begin-glyphs and end-glyphs in
+ modeline extents. */
+static Charcount
+add_glyph_to_fstring_db_runes (pos_data *data, Lisp_Object glyph,
+ Charcount pos, Charcount min_pos, Charcount max_pos)
+{
+ /* This function has been Mule-ized. */
+ Charcount end;
+ struct display_block *db = data->db;
+ struct glyph_block gb;
+
+ data->blank_width = space_width (XWINDOW (data->window));
+ while (Dynarr_length (db->runes) < pos)
+ add_blank_rune (data, NULL, 0);
+
+ end = Dynarr_length (db->runes) + 1;
+ if (max_pos != -1)
+ end = min (max_pos, end);
+
+ gb.glyph = glyph;
+ gb.extent = Qnil;
+ add_glyph_rune (data, &gb, BEGIN_GLYPHS, 0, 0);
+ pos++;
+
+ while (Dynarr_length (db->runes) < pos &&
+ (data->pixpos + data->blank_width <= data->max_pixpos))
+ add_blank_rune (data, NULL, 0);
+
+ return Dynarr_length (db->runes);
+}
+
+/* If max_pos is == -1, it is considered to be infinite. The same is
+ true of max_pixsize. */
+#define SET_CURRENT_MODE_CHARS_PIXSIZE \
+ if (Dynarr_length (data->db->runes)) \
+ cur_pixsize = data->pixpos - Dynarr_atp (data->db->runes, 0)->xpos; \
+ else \
+ cur_pixsize = 0;
+
+/* Note that this function does "positions" in terms of characters and
+ not in terms of columns. This is necessary to make the formatting
+ work correctly when proportional width fonts are used in the
+ modeline. */
+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)
+{
+ /* This function has been Mule-ized. */
+ /* #### The other losing things in this function are:
+
+ -- C zero-terminated-string lossage.
+ -- Non-printable characters should be converted into something
+ appropriate (e.g. ^F) instead of blindly being printed anyway.
+ */
+
+tail_recurse:
+ if (depth > 10)
+ goto invalid;
+
+ depth++;
+
+ if (STRINGP (elt))
+ {
+ /* A string. Add to the display line and check for %-constructs
+ within it. */
+
+ Bufbyte *this = XSTRING_DATA (elt);
+
+ while ((pos < max_pos || max_pos == -1) && *this)
+ {
+ Bufbyte *last = this;
+
+ while (*this && *this != '%')
+ this++;
+
+ if (this != last)
+ {
+ /* The string is just a string. */
+ 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);
+ }
+ else /* *this == '%' */
+ {
+ Charcount spec_width = 0;
+
+ this++; /* skip over '%' */
+
+ /* We can't allow -ve args due to the "%-" construct.
+ * Argument specifies minwidth but not maxwidth
+ * (maxwidth can be specified by
+ * (<negative-number> . <stuff>) modeline elements)
+ */
+ while (isdigit (*this))
+ {
+ spec_width = spec_width * 10 + (*this - '0');
+ this++;
+ }
+ spec_width += pos;
+
+ if (*this == 'M')
+ {
+ pos = generate_fstring_runes (w, data, pos, spec_width,
+ max_pos, Vglobal_mode_string,
+ depth, max_pixsize, findex,
+ type);
+ }
+ else if (*this == '-')
+ {
+ Charcount num_to_add;
+
+ if (max_pixsize < 0)
+ num_to_add = 0;
+ else if (max_pos != -1)
+ num_to_add = max_pos - pos;
+ else
+ {
+ int cur_pixsize;
+ int dash_pixsize;
+ Bufbyte ch = '-';
+ SET_CURRENT_MODE_CHARS_PIXSIZE;
+
+ dash_pixsize =
+ redisplay_text_width_string (w, findex, &ch, Qnil, 0,
+ 1);
+
+ num_to_add = (max_pixsize - cur_pixsize) / dash_pixsize;
+ num_to_add++;
+ }
+
+ while (num_to_add--)
+ pos = add_string_to_fstring_db_runes
+ (data, (CONST Bufbyte *) "-", pos, pos, max_pos);
+ }
+ else if (*this != 0)
+ {
+ Bufbyte *str;
+ Emchar ch = charptr_emchar (this);
+ 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);
+ }
+
+ /* NOT this++. There could be any sort of character at
+ the current position. */
+ INC_CHARPTR (this);
+ }
+
+ if (max_pixsize > 0)
+ {
+ int cur_pixsize;
+ SET_CURRENT_MODE_CHARS_PIXSIZE;
+
+ if (cur_pixsize >= max_pixsize)
+ break;
+ }
+ }
+ }
+ else if (SYMBOLP (elt))
+ {
+ /* A symbol: process the value of the symbol recursively
+ as if it appeared here directly. */
+ Lisp_Object tem = symbol_value_in_buffer (elt, w->buffer);
+
+ if (!UNBOUNDP (tem))
+ {
+ /* 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);
+ }
+ /* Give up right away for nil or t. */
+ else if (!EQ (tem, elt))
+ {
+ elt = tem;
+ goto tail_recurse;
+ }
+ }
+ }
+ else if (GENERIC_SPECIFIERP (elt))
+ {
+ Lisp_Object window, tem;
+ XSETWINDOW (window, w);
+ tem = specifier_instance_no_quit (elt, Qunbound, window,
+ ERROR_ME_NOT, 0, Qzero);
+ if (!UNBOUNDP (tem))
+ {
+ elt = tem;
+ goto tail_recurse;
+ }
+ }
+ 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.
+ */
+ 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;
+ }
+ }
+ else if (INTP (car))
+ {
+ Charcount lim = XINT (car);
+
+ elt = XCDR (elt);
+
+ if (lim < 0)
+ {
+ /* Negative int means reduce maximum width.
+ * DO NOT change MIN_PIXPOS here!
+ * (20 -10 . foo) should truncate foo to 10 col
+ * and then pad to 20.
+ */
+ if (max_pos == -1)
+ max_pos = pos - lim;
+ else
+ max_pos = min (max_pos, pos - lim);
+ }
+ else if (lim > 0)
+ {
+ /* Padding specified. Don't let it be more than
+ * current maximum.
+ */
+ lim += pos;
+ if (max_pos != -1 && lim > max_pos)
+ lim = max_pos;
+ /* If that's more padding than already wanted, queue it.
+ * But don't reduce padding already specified even if
+ * that is beyond the current truncation point.
+ */
+ if (lim > min_pos)
+ min_pos = lim;
+ }
+ goto tail_recurse;
+ }
+ 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);
+ elt = XCDR (elt);
+ }
+ }
+ else if (EXTENTP (car))
+ {
+ struct extent *ext = XEXTENT (car);
+
+ if (EXTENT_LIVE_P (ext))
+ {
+ face_index old_findex = data->findex;
+ Lisp_Object face;
+ Lisp_Object font_inst;
+ face_index new_findex;
+ Bytecount start = data->bytepos;
+
+ face = extent_face (ext);
+ if (FACEP (face))
+ {
+ /* #### needs to merge faces, sigh */
+ /* #### needs to handle list of faces */
+ new_findex = get_builtin_face_cache_index (w, face);
+ /* !!#### not right; needs to compute the max height of
+ all the charsets */
+ font_inst = WINDOW_FACE_CACHEL_FONT (w, new_findex,
+ Vcharset_ascii);
+
+ data->dl->ascent = max (data->dl->ascent,
+ XFONT_INSTANCE (font_inst)->ascent);
+ data->dl->descent = max (data->dl->descent,
+ XFONT_INSTANCE (font_inst)->
+ descent);
+ }
+ else
+ new_findex = old_findex;
+
+ data->findex = new_findex;
+ pos = generate_fstring_runes (w, data, pos, pos, max_pos,
+ XCDR (elt), depth - 1,
+ max_pixsize, new_findex, type);
+ data->findex = old_findex;
+ Dynarr_add (formatted_string_extent_dynarr, ext);
+ Dynarr_add (formatted_string_extent_start_dynarr, start);
+ Dynarr_add (formatted_string_extent_end_dynarr, data->bytepos);
+ }
+ }
+ }
+ else if (GLYPHP (elt))
+ {
+ pos = add_glyph_to_fstring_db_runes (data, elt, pos, pos, max_pos);
+ }
+ else
+ {
+ invalid:
+ pos =
+ add_string_to_fstring_db_runes
+ (data, (CONST Bufbyte *) GETTEXT ("*invalid*"), pos, min_pos,
+ max_pos);
+ }
+
+ if (min_pos > pos)
+ {
+ 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
+regenerate_modeline (struct window *w)
+{
+ display_line_dynarr *dla = window_display_lines (w, DESIRED_DISP);
+
+ if (!Dynarr_length (dla) || !Dynarr_atp (dla, 0)->modeline)
+ return;
+ else
+ {
+ generate_modeline (w, Dynarr_atp (dla, 0), DESIRED_DISP);
+ redisplay_update_line (w, 0, 0, 0);
+ }
+}
+
+/* Make sure that modeline display line is present in the given
+ display structs if the window has a modeline and update that
+ line. Returns true if a modeline was needed. */
+static int
+ensure_modeline_generated (struct window *w, int type)
+{
+ int need_modeline;
+
+ /* minibuffer windows don't have modelines */
+ if (MINI_WINDOW_P (w))
+ need_modeline = 0;
+ /* windows which haven't had it turned off do */
+ else if (WINDOW_HAS_MODELINE_P (w))
+ need_modeline = 1;
+ /* windows which have it turned off don't have a divider if there is
+ a horizontal scrollbar */
+ else if (window_scrollbar_height (w))
+ need_modeline = 0;
+ /* and in this case there is none */
+ else
+ need_modeline = 1;
+
+ if (need_modeline)
+ {
+ display_line_dynarr *dla;
+
+ dla = window_display_lines (w, type);
+
+ /* We don't care if there is a display line which is not
+ currently a modeline because it is definitely going to become
+ one if we have gotten to this point. */
+ if (Dynarr_length (dla) == 0)
+ {
+ if (Dynarr_largest (dla) > 0)
+ {
+ struct display_line *mlp = Dynarr_atp (dla, 0);
+ Dynarr_add (dla, *mlp);
+ }
+ else
+ {
+ struct display_line modeline;
+ xzero (modeline);
+ Dynarr_add (dla, modeline);
+ }
+ }
+
+ /* If we're adding a new place marker go ahead and generate the
+ modeline so that it is available for use by
+ window_modeline_height. */
+ generate_modeline (w, Dynarr_atp (dla, 0), type);
+ }
+
+ return need_modeline;
+}
+
+/* #### Kludge or not a kludge. I tend towards the former. */
+int
+real_current_modeline_height (struct window *w)
+{
+ Fset_marker (w->start[CMOTION_DISP], w->start[CURRENT_DISP], w->buffer);
+ Fset_marker (w->pointm[CMOTION_DISP], w->pointm[CURRENT_DISP], w->buffer);
+
+ if (ensure_modeline_generated (w, CMOTION_DISP))
+ {
+ display_line_dynarr *dla = window_display_lines (w, CMOTION_DISP);
+
+ if (Dynarr_length (dla))
+ {
+ if (Dynarr_atp (dla, 0)->modeline)
+ return (Dynarr_atp (dla, 0)->ascent +
+ Dynarr_atp (dla, 0)->descent);
+ }
+ }
+ return 0;
+}
+
+\f
+/***************************************************************************/
+/* */
+/* window-regeneration routines */
+/* */
+/***************************************************************************/
+
+/* For a given window and starting position in the buffer it contains,
+ ensure that the TYPE display lines accurately represent the
+ presentation of the window. We pass the buffer instead of getting
+ it from the window since redisplay_window may have temporarily
+ changed it to the echo area buffer. */
+
+static void
+regenerate_window (struct window *w, Bufpos start_pos, Bufpos point, int type)
+{
+ struct frame *f = XFRAME (w->frame);
+ struct buffer *b = XBUFFER (w->buffer);
+ int ypos = WINDOW_TEXT_TOP (w);
+ int yend; /* set farther down */
+
+ prop_block_dynarr *prop;
+ layout_bounds bounds;
+ display_line_dynarr *dla;
+ int need_modeline;
+
+ /* The lines had better exist by this point. */
+ if (!(dla = window_display_lines (w, type)))
+ abort ();
+ Dynarr_reset (dla);
+ w->max_line_len = 0;
+
+ /* Normally these get updated in redisplay_window but it is possible
+ for this function to get called from some other points where that
+ update may not have occurred. This acts as a safety check. */
+ if (!Dynarr_length (w->face_cachels))
+ reset_face_cachels (w);
+ if (!Dynarr_length (w->glyph_cachels))
+ reset_glyph_cachels (w);
+
+ Fset_marker (w->start[type], make_int (start_pos), w->buffer);
+ Fset_marker (w->pointm[type], make_int (point), w->buffer);
+ w->last_point_x[type] = -1;
+ w->last_point_y[type] = -1;
+
+ /* Make sure a modeline is in the structs if needed. */
+ need_modeline = ensure_modeline_generated (w, type);
+
+ /* Wait until here to set this so that the structs have a modeline
+ generated in the case where one didn't exist. */
+ yend = WINDOW_TEXT_BOTTOM (w);
+
+ bounds = calculate_display_line_boundaries (w, 0);
+
+ /* 97/3/14 jhod: stuff added here to support pre-prompts (used for input systems) */
+ if (MINI_WINDOW_P (w)
+ && (!NILP (Vminibuf_prompt) || !NILP (Vminibuf_preprompt))
+ && !echo_area_active (f)
+ && start_pos == BUF_BEGV (b))
+ {
+ struct prop_block pb;
+ Lisp_Object string;
+ prop = Dynarr_new (prop_block);
+
+ string = concat2(Vminibuf_preprompt, Vminibuf_prompt);
+ pb.type = PROP_MINIBUF_PROMPT;
+ pb.data.p_string.str = XSTRING_DATA(string);
+ pb.data.p_string.len = XSTRING_LENGTH(string);
+ Dynarr_add (prop, pb);
+ }
+ else
+ prop = 0;
+
+ while (ypos < yend)
+ {
+ struct display_line dl;
+ struct display_line *dlp;
+ 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;
+ start_pos = generate_display_line (w, dlp, 1, start_pos,
+ w->hscroll, &prop, type);
+ 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;
+
+ if (dlp->cursor_elt != -1)
+ {
+ /* #### This check is steaming crap. Have to get things
+ fixed so when create_text_block hits EOB, we're done,
+ period. */
+ if (w->last_point_x[type] == -1)
+ {
+ w->last_point_x[type] = dlp->cursor_elt;
+ w->last_point_y[type] = Dynarr_length (dla);
+ }
+ else
+ {
+ /* #### This means that we've added a cursor at EOB
+ twice. Yuck oh yuck. */
+ struct display_block *db =
+ get_display_block_from_line (dlp, TEXT);
+
+ Dynarr_atp (db->runes, dlp->cursor_elt)->cursor_type = NO_CURSOR;
+ dlp->cursor_elt = -1;
+ }
+ }
+
+ if (dlp->num_chars > w->max_line_len)
+ w->max_line_len = dlp->num_chars;
+
+ Dynarr_add (dla, *dlp);
+
+ /* #### This isn't right, but it is close enough for now. */
+ w->window_end_pos[type] = start_pos;
+
+ /* #### This type of check needs to be done down in the
+ generate_display_line call. */
+ if (start_pos > BUF_ZV (b))
+ break;
+ }
+
+ if (prop)
+ Dynarr_free (prop);
+
+ /* #### More not quite right, but close enough. */
+ /* #### Ben sez: apparently window_end_pos[] is measured
+ as the number of characters between the window end and the
+ end of the buffer? This seems rather weirdo. What's
+ the justification for this? */
+ w->window_end_pos[type] = BUF_Z (b) - w->window_end_pos[type];
+
+ if (need_modeline)
+ {
+ /* We know that this is the right thing to use because we put it
+ there when we first started working in this function. */
+ generate_modeline (w, Dynarr_atp (dla, 0), type);
+ }
+}
+
+#define REGEN_INC_FIND_START_END \
+ do { \
+ /* Determine start and end of lines. */ \
+ if (!Dynarr_length (cdla)) \
+ return 0; \
+ else \
+ { \
+ if (Dynarr_atp (cdla, 0)->modeline && Dynarr_atp (ddla, 0)->modeline) \
+ { \
+ dla_start = 1; \
+ } \
+ else if (!Dynarr_atp (cdla, 0)->modeline \
+ && !Dynarr_atp (ddla, 0)->modeline) \
+ { \
+ dla_start = 0; \
+ } \
+ else \
+ abort (); /* structs differ */ \
+ \
+ dla_end = Dynarr_length (cdla) - 1; \
+ } \
+ \
+ start_pos = (Dynarr_atp (cdla, dla_start)->bufpos \
+ + Dynarr_atp (cdla, dla_start)->offset); \
+ /* If this isn't true, then startp has changed and we need to do a \
+ full regen. */ \
+ if (startp != start_pos) \
+ return 0; \
+ \
+ /* Point is outside the visible region so give up. */ \
+ if (pointm < start_pos) \
+ return 0; \
+ \
+ } while (0)
+
+/* This attempts to incrementally update the display structures. It
+ returns a boolean indicating success or failure. This function is
+ very similar to regenerate_window_incrementally and is in fact only
+ called from that function. However, because of the nature of the
+ changes it deals with it sometimes makes different assumptions
+ which can lead to success which are much more difficult to make
+ when dealing with buffer changes. */
+
+static int
+regenerate_window_extents_only_changed (struct window *w, Bufpos startp,
+ Bufpos pointm,
+ Charcount beg_unchanged,
+ Charcount end_unchanged)
+{
+ struct buffer *b = XBUFFER (w->buffer);
+ display_line_dynarr *cdla = window_display_lines (w, CURRENT_DISP);
+ display_line_dynarr *ddla = window_display_lines (w, DESIRED_DISP);
+
+ int dla_start = 0;
+ int dla_end, line;
+ int first_line, last_line;
+ Bufpos start_pos;
+ /* Don't define this in the loop where it is used because we
+ definitely want its value to survive between passes. */
+ prop_block_dynarr *prop = NULL;
+
+ /* If we don't have any buffer change recorded but the modiff flag has
+ been incremented, then fail. I'm not sure of the exact circumstances
+ under which this can happen, but I believe that it is probably a
+ reasonable happening. */
+ if (!point_visible (w, pointm, CURRENT_DISP)
+ || XINT (w->last_modified[CURRENT_DISP]) < BUF_MODIFF (b))
+ return 0;
+
+ /* If the cursor is moved we attempt to update it. If we succeed we
+ go ahead and proceed with the optimization attempt. */
+ if (!EQ (Fmarker_buffer (w->last_point[CURRENT_DISP]), w->buffer)
+ || pointm != marker_position (w->last_point[CURRENT_DISP]))
+ {
+ struct frame *f = XFRAME (w->frame);
+ struct device *d = XDEVICE (f->device);
+ struct frame *sel_f = device_selected_frame (d);
+ int success = 0;
+
+ if (w->last_point_x[CURRENT_DISP] != -1
+ && w->last_point_y[CURRENT_DISP] != -1)
+ {
+
+ if (redisplay_move_cursor (w, pointm, WINDOW_TTY_P (w)))
+ {
+ /* Always regenerate the modeline in case it is
+ displaying the current line or column. */
+ regenerate_modeline (w);
+ success = 1;
+ }
+ }
+ else if (w != XWINDOW (FRAME_SELECTED_WINDOW (sel_f)))
+ {
+ if (f->modeline_changed)
+ regenerate_modeline (w);
+ success = 1;
+ }
+
+ if (!success)
+ return 0;
+ }
+
+ if (beg_unchanged == -1 && end_unchanged == -1)
+ return 1;
+
+ /* assert: There are no buffer modifications or they are all below the
+ visible region. We assume that regenerate_window_incrementally has
+ not called us unless this is true. */
+
+ REGEN_INC_FIND_START_END;
+
+ /* If the changed are starts before the visible area, give up. */
+ if (beg_unchanged < startp)
+ return 0;
+
+ /* Find what display line the extent changes first affect. */
+ line = dla_start;
+ while (line <= dla_end)
+ {
+ struct display_line *dl = Dynarr_atp (cdla, line);
+ Bufpos lstart = dl->bufpos + dl->offset;
+ Bufpos lend = dl->end_bufpos + dl->offset;
+
+ if (beg_unchanged >= lstart && beg_unchanged <= lend)
+ break;
+
+ line++;
+ }
+
+ /* If the changes are below the visible area then if point hasn't
+ moved return success otherwise fail in order to be safe. */
+ if (line > dla_end)
+ {
+ if (EQ (Fmarker_buffer (w->last_point[CURRENT_DISP]), w->buffer)
+ && pointm == marker_position (w->last_point[CURRENT_DISP]))
+ return 1;
+ else
+ return 0;
+ }
+
+ /* At this point we know what line the changes first affect. We now
+ begin redrawing lines as long as we are still in the affected
+ region and the line's size and positioning don't change.
+ Otherwise we fail. If we fail we will have altered the desired
+ structs which could lead to an assertion failure. However, if we
+ fail the next thing that is going to happen is a full regen so we
+ will actually end up being safe. */
+ w->last_modified[DESIRED_DISP] = make_int (BUF_MODIFF (b));
+ w->last_facechange[DESIRED_DISP] = make_int (BUF_FACECHANGE (b));
+ Fset_marker (w->last_start[DESIRED_DISP], make_int (startp), w->buffer);
+ Fset_marker (w->last_point[DESIRED_DISP], make_int (pointm), w->buffer);
+
+ first_line = last_line = line;
+ while (line <= dla_end)
+ {
+ Bufpos old_start, old_end, new_start;
+ struct display_line *cdl = Dynarr_atp (cdla, line);
+ struct display_line *ddl = Dynarr_atp (ddla, line);
+ struct display_block *db;
+ int initial_size;
+
+ assert (cdl->bufpos == ddl->bufpos);
+ assert (cdl->end_bufpos == ddl->end_bufpos);
+ assert (cdl->offset == ddl->offset);
+
+ db = get_display_block_from_line (ddl, TEXT);
+ initial_size = Dynarr_length (db->runes);
+ old_start = ddl->bufpos + ddl->offset;
+ old_end = ddl->end_bufpos + ddl->offset;
+
+ /* If this is the first line being updated and it used
+ propagation data, fail. Otherwise we'll be okay because
+ we'll have the necessary propagation data. */
+ if (line == first_line && ddl->used_prop_data)
+ return 0;
+
+ new_start = generate_display_line (w, ddl, 0, ddl->bufpos + ddl->offset,
+ w->hscroll, &prop, DESIRED_DISP);
+ ddl->offset = 0;
+
+ /* #### If there is propagated stuff the fail. We could
+ probably actually deal with this if the line had propagated
+ information when originally created by a full
+ regeneration. */
+ if (prop)
+ {
+ Dynarr_free (prop);
+ return 0;
+ }
+
+ /* If any line position parameters have changed or a
+ cursor has disappeared or disappeared, fail. */
+ db = get_display_block_from_line (ddl, TEXT);
+ if (cdl->ypos != ddl->ypos
+ || cdl->ascent != ddl->ascent
+ || cdl->descent != ddl->descent
+ || (cdl->cursor_elt != -1 && ddl->cursor_elt == -1)
+ || (cdl->cursor_elt == -1 && ddl->cursor_elt != -1)
+ || old_start != ddl->bufpos
+ || old_end != ddl->end_bufpos
+ || initial_size != Dynarr_length (db->runes))
+ {
+ return 0;
+ }
+
+ if (ddl->cursor_elt != -1)
+ {
+ w->last_point_x[DESIRED_DISP] = ddl->cursor_elt;
+ w->last_point_y[DESIRED_DISP] = line;
+ }
+
+ last_line = line;
+
+ /* If the extent changes end on the line we just updated then
+ we're done. Otherwise go on to the next line. */
+ if (end_unchanged <= ddl->end_bufpos)
+ break;
+ else
+ line++;
+ }
+
+ redisplay_update_line (w, first_line, last_line, 1);
+ return 1;
+}
+
+/* Attempt to update the display data structures based on knowledge of
+ the changed region in the buffer. Returns a boolean indicating
+ success or failure. If this function returns a failure then a
+ regenerate_window _must_ be performed next in order to maintain
+ invariants located here. */
+
+static int
+regenerate_window_incrementally (struct window *w, Bufpos startp,
+ Bufpos pointm)
+{
+ struct buffer *b = XBUFFER (w->buffer);
+ display_line_dynarr *cdla = window_display_lines (w, CURRENT_DISP);
+ display_line_dynarr *ddla = window_display_lines (w, DESIRED_DISP);
+ Charcount beg_unchanged, end_unchanged;
+ Charcount extent_beg_unchanged, extent_end_unchanged;
+
+ int dla_start = 0;
+ int dla_end, line;
+ Bufpos start_pos;
+
+ /* If this function is called, the current and desired structures
+ had better be identical. If they are not, then that is a bug. */
+ assert (Dynarr_length (cdla) == Dynarr_length (ddla));
+
+ /* We don't handle minibuffer windows yet. The minibuffer prompt
+ screws us up. */
+ if (MINI_WINDOW_P (w))
+ return 0;
+
+ extent_beg_unchanged = BUF_EXTENT_BEGIN_UNCHANGED (b);
+ extent_end_unchanged = (BUF_EXTENT_END_UNCHANGED (b) == -1
+ ? -1
+ : BUF_Z (b) - BUF_EXTENT_END_UNCHANGED (b));
+
+ /* If nothing has changed in the buffer, then make sure point is ok
+ and succeed. */
+ if (BUF_BEGIN_UNCHANGED (b) == -1 && BUF_END_UNCHANGED (b) == -1)
+ return regenerate_window_extents_only_changed (w, startp, pointm,
+ extent_beg_unchanged,
+ extent_end_unchanged);
+
+ /* We can't deal with deleted newlines. */
+ if (BUF_NEWLINE_WAS_DELETED (b))
+ return 0;
+
+ beg_unchanged = BUF_BEGIN_UNCHANGED (b);
+ end_unchanged = (BUF_END_UNCHANGED (b) == -1
+ ? -1
+ : BUF_Z (b) - BUF_END_UNCHANGED (b));
+
+ REGEN_INC_FIND_START_END;
+
+ /* If the changed area starts before the visible area, give up. */
+ if (beg_unchanged < startp)
+ return 0;
+
+ /* Find what display line the buffer changes first affect. */
+ line = dla_start;
+ while (line <= dla_end)
+ {
+ struct display_line *dl = Dynarr_atp (cdla, line);
+ Bufpos lstart = dl->bufpos + dl->offset;
+ Bufpos lend = dl->end_bufpos + dl->offset;
+
+ if (beg_unchanged >= lstart && beg_unchanged <= lend)
+ break;
+
+ line++;
+ }
+
+ /* If the changes are below the visible area then if point hasn't
+ moved return success otherwise fail in order to be safe. */
+ if (line > dla_end)
+ {
+ return regenerate_window_extents_only_changed (w, startp, pointm,
+ extent_beg_unchanged,
+ extent_end_unchanged);
+ }
+ else
+ /* At this point we know what line the changes first affect. We
+ now redraw that line. If the changes are contained within it
+ we are going to succeed and can update just that one line.
+ Otherwise we fail. If we fail we will have altered the desired
+ structs which could lead to an assertion failure. However, if
+ we fail the next thing that is going to happen is a full regen
+ so we will actually end up being safe. */
+ {
+ Bufpos new_start;
+ prop_block_dynarr *prop = NULL;
+ struct display_line *cdl = Dynarr_atp (cdla, line);
+ struct display_line *ddl = Dynarr_atp (ddla, line);
+
+ assert (cdl->bufpos == ddl->bufpos);
+ assert (cdl->end_bufpos == ddl->end_bufpos);
+ assert (cdl->offset == ddl->offset);
+
+ /* If the last rune is already a continuation glyph, fail.
+ #### We should be able to handle this better. */
+ {
+ struct display_block *db = get_display_block_from_line (ddl, TEXT);
+ if (Dynarr_length (db->runes))
+ {
+ struct rune *rb =
+ Dynarr_atp (db->runes, Dynarr_length (db->runes) - 1);
+
+ if (rb->type == RUNE_DGLYPH
+ && EQ (rb->object.dglyph.glyph, Vcontinuation_glyph))
+ return 0;
+ }
+ }
+
+ /* If the line was generated using propagation data, fail. */
+ if (ddl->used_prop_data)
+ return 0;
+
+ new_start = generate_display_line (w, ddl, 0, ddl->bufpos + ddl->offset,
+ w->hscroll, &prop, DESIRED_DISP);
+ ddl->offset = 0;
+
+ /* If there is propagated stuff then it is pretty much a
+ guarantee that more than just the one line is affected. */
+ if (prop)
+ {
+ Dynarr_free (prop);
+ return 0;
+ }
+
+ /* If the last rune is now a continuation glyph, fail. */
+ {
+ struct display_block *db = get_display_block_from_line (ddl, TEXT);
+ if (Dynarr_length (db->runes))
+ {
+ struct rune *rb =
+ Dynarr_atp (db->runes, Dynarr_length (db->runes) - 1);
+
+ if (rb->type == RUNE_DGLYPH
+ && EQ (rb->object.dglyph.glyph, Vcontinuation_glyph))
+ return 0;
+ }
+ }
+
+ /* If any line position parameters have changed or a
+ cursor has disappeared or disappeared, fail. */
+ if (cdl->ypos != ddl->ypos
+ || cdl->ascent != ddl->ascent
+ || cdl->descent != ddl->descent
+ || (cdl->cursor_elt != -1 && ddl->cursor_elt == -1)
+ || (cdl->cursor_elt == -1 && ddl->cursor_elt != -1))
+ {
+ return 0;
+ }
+
+ /* If the changed area also ends on this line, then we may be in
+ business. Update everything and return success. */
+ if (end_unchanged >= ddl->bufpos && end_unchanged <= ddl->end_bufpos)
+ {
+ w->last_modified[DESIRED_DISP] = make_int (BUF_MODIFF (b));
+ w->last_facechange[DESIRED_DISP] = make_int (BUF_FACECHANGE (b));
+ Fset_marker (w->last_start[DESIRED_DISP], make_int (startp),
+ w->buffer);
+ Fset_marker (w->last_point[DESIRED_DISP], make_int (pointm),
+ w->buffer);
+
+ if (ddl->cursor_elt != -1)
+ {
+ w->last_point_x[DESIRED_DISP] = ddl->cursor_elt;
+ w->last_point_y[DESIRED_DISP] = line;
+ }
+
+ redisplay_update_line (w, line, line, 1);
+ regenerate_modeline (w);
+
+ /* #### For now we just flush the cache until this has been
+ tested. After that is done, this should correct the
+ cache directly. */
+ Dynarr_reset (w->line_start_cache);
+
+ /* Adjust the extent changed boundaries to remove any
+ overlap with the buffer changes since we've just
+ successfully updated that area. */
+ if (extent_beg_unchanged != -1
+ && extent_beg_unchanged >= beg_unchanged
+ && extent_beg_unchanged < end_unchanged)
+ extent_beg_unchanged = end_unchanged;
+
+ if (extent_end_unchanged != -1
+ && extent_end_unchanged >= beg_unchanged
+ && extent_end_unchanged < end_unchanged)
+ extent_end_unchanged = beg_unchanged - 1;
+
+ if (extent_end_unchanged <= extent_beg_unchanged)
+ extent_beg_unchanged = extent_end_unchanged = -1;
+
+ /* This could lead to odd results if it fails, but since the
+ buffer changes update succeeded this probably will to.
+ We already know that the extent changes start at or after
+ the line because we checked before entering the loop. */
+ if (extent_beg_unchanged != -1
+ && extent_end_unchanged != -1
+ && ((extent_beg_unchanged < ddl->bufpos)
+ || (extent_end_unchanged > ddl->end_bufpos)))
+ {
+ return
+ regenerate_window_extents_only_changed (w, startp, pointm,
+ extent_beg_unchanged,
+ extent_end_unchanged);
+ }
+ else
+ return 1;
+ }
+ }
+
+ /* Oh, well. */
+ return 0;
+}
+
+/* Given a window and a point, update the given display lines such
+ that point is displayed in the middle of the window.
+ Return the window's new start position. */
+
+static Bufpos
+regenerate_window_point_center (struct window *w, Bufpos point, int type)
+{
+ Bufpos startp;
+
+ /* We need to make sure that the modeline is generated so that the
+ window height can be calculated correctly. */
+ ensure_modeline_generated (w, type);
+
+ startp = start_with_line_at_pixpos (w, point, window_half_pixpos (w));
+ regenerate_window (w, startp, point, type);
+ Fset_marker (w->start[type], make_int (startp), w->buffer);
+
+ return startp;
+}
+
+/* Given a window and a set of display lines, return a boolean
+ indicating whether the given point is contained within. */
+
+static int
+point_visible (struct window *w, Bufpos point, int type)
+{
+ struct buffer *b = XBUFFER (w->buffer);
+ display_line_dynarr *dla = window_display_lines (w, type);
+ int first_line;
+
+ if (Dynarr_length (dla) && Dynarr_atp (dla, 0)->modeline)
+ first_line = 1;
+ else
+ first_line = 0;
+
+ if (Dynarr_length (dla) > first_line)
+ {
+ Bufpos start, end;
+ struct display_line *dl = Dynarr_atp (dla, first_line);
+
+ start = dl->bufpos;
+ end = BUF_Z (b) - w->window_end_pos[type] - 1;
+
+ if (point >= start && point <= end)
+ {
+ if (!MINI_WINDOW_P (w) && scroll_on_clipped_lines)
+ {
+ dl = Dynarr_atp (dla, Dynarr_length (dla) - 1);
+
+ if (point >= (dl->bufpos + dl->offset)
+ && point <= (dl->end_bufpos + dl->offset))
+ return !dl->clip;
+ else
+ return 1;
+ }
+ else
+ return 1;
+ }
+ else
+ return 0;
+ }
+ else
+ return 0;
+}
+
+/* Return pixel position the middle of the window, not including the
+ modeline and any potential horizontal scrollbar. */
+
+int
+window_half_pixpos (struct window *w)
+{
+ return WINDOW_TEXT_TOP (w) + (WINDOW_TEXT_HEIGHT (w) >> 1);
+}
+
+/* Return the display line which is currently in the middle of the
+ window W for display lines TYPE. */
+
+int
+line_at_center (struct window *w, int type, Bufpos start, Bufpos point)
+{
+ display_line_dynarr *dla;
+ int half;
+ int elt;
+ int first_elt = (MINI_WINDOW_P (w) ? 0 : 1);
+
+ if (type == CMOTION_DISP)
+ regenerate_window (w, start, point, type);
+
+ dla = window_display_lines (w, type);
+ half = window_half_pixpos (w);
+
+ for (elt = first_elt; elt < Dynarr_length (dla); elt++)
+ {
+ struct display_line *dl = Dynarr_atp (dla, elt);
+ int line_bot = dl->ypos + dl->descent;
+
+ if (line_bot > half)
+ return elt;
+ }
+
+ /* We may not have a line at the middle if the end of the buffer is
+ being displayed. */
+ return -1;
+}
+
+/* Return a value for point that would place it at the beginning of
+ the line which is in the middle of the window. */
+
+Bufpos
+point_at_center (struct window *w, int type, Bufpos start, Bufpos point)
+{
+ /* line_at_center will regenerate the display structures, if necessary. */
+ int line = line_at_center (w, type, start, point);
+
+ if (line == -1)
+ return BUF_ZV (XBUFFER (w->buffer));
+ else
+ {
+ display_line_dynarr *dla = window_display_lines (w, type);
+ struct display_line *dl = Dynarr_atp (dla, line);
+
+ return dl->bufpos;
+ }
+}
+
+/* For a given window, ensure that the current visual representation
+ is accurate. */
+
+static void
+redisplay_window (Lisp_Object window, int skip_selected)
+{
+ struct window *w = XWINDOW (window);
+ struct frame *f = XFRAME (w->frame);
+ struct device *d = XDEVICE (f->device);
+ Lisp_Object old_buffer = w->buffer;
+ Lisp_Object the_buffer = w->buffer;
+ struct buffer *b;
+ int echo_active = 0;
+ int startp = 1;
+ int pointm;
+ int old_startp = 1;
+ int old_pointm = 1;
+ int selected_in_its_frame;
+ int selected_globally;
+ int skip_output = 0;
+ int truncation_changed;
+ int inactive_minibuffer =
+ (MINI_WINDOW_P (w) &&
+ (f != device_selected_frame (d)) &&
+ !is_surrogate_for_selected_frame (f));
+
+ /* #### In the new world this function actually does a bunch of
+ optimizations such as buffer-based scrolling, but none of that is
+ implemented yet. */
+
+ /* If this is a combination window, do its children; that's all.
+ The selected window is always a leaf so we don't check for
+ skip_selected here. */
+ if (!NILP (w->vchild))
+ {
+ redisplay_windows (w->vchild, skip_selected);
+ return;
+ }
+ if (!NILP (w->hchild))
+ {
+ redisplay_windows (w->hchild, skip_selected);
+ return;
+ }
+
+ /* Is this window the selected window on its frame? */
+ selected_in_its_frame = (w == XWINDOW (FRAME_SELECTED_WINDOW (f)));
+ selected_globally =
+ selected_in_its_frame &&
+ EQ(DEVICE_CONSOLE(d), Vselected_console) &&
+ XDEVICE(CONSOLE_SELECTED_DEVICE(XCONSOLE(DEVICE_CONSOLE(d)))) == d &&
+ XFRAME(DEVICE_SELECTED_FRAME(d)) == f;
+ if (skip_selected && selected_in_its_frame)
+ return;
+
+ /* It is possible that the window is not fully initialized yet. */
+ if (NILP (w->buffer))
+ return;
+
+ if (MINI_WINDOW_P (w) && echo_area_active (f))
+ {
+ w->buffer = the_buffer = Vecho_area_buffer;
+ echo_active = 1;
+ }
+
+ b = XBUFFER (w->buffer);
+
+ if (echo_active)
+ {
+ old_pointm = selected_globally
+ ? BUF_PT (b)
+ : marker_position (w->pointm[CURRENT_DISP]);
+ pointm = 1;
+ }
+ else
+ {
+ if (selected_globally)
+ {
+ pointm = BUF_PT (b);
+ }
+ else
+ {
+ pointm = marker_position (w->pointm[CURRENT_DISP]);
+
+ if (pointm < BUF_BEGV (b))
+ pointm = BUF_BEGV (b);
+ else if (pointm > BUF_ZV (b))
+ pointm = BUF_ZV (b);
+ }
+ }
+ Fset_marker (w->pointm[DESIRED_DISP], make_int (pointm), the_buffer);
+
+ /* If the buffer has changed we have to invalid all of our face
+ cache elements. */
+ if ((!echo_active && b != window_display_buffer (w))
+ || !Dynarr_length (w->face_cachels)
+ || f->faces_changed)
+ reset_face_cachels (w);
+ else
+ mark_face_cachels_as_not_updated (w);
+
+ /* Ditto the glyph cache elements. */
+ if ((!echo_active && b != window_display_buffer (w))
+ || !Dynarr_length (w->glyph_cachels)
+ || f->glyphs_changed)
+ reset_glyph_cachels (w);
+ else
+ mark_glyph_cachels_as_not_updated (w);
+
+ /* If the marker's buffer is not the window's buffer, then we need
+ to find a new starting position. */
+ if (!MINI_WINDOW_P (w)
+ && !EQ (Fmarker_buffer (w->start[CURRENT_DISP]), w->buffer))
+ {
+ startp = regenerate_window_point_center (w, pointm, DESIRED_DISP);
+
+ goto regeneration_done;
+ }
+
+ if (echo_active)
+ {
+ old_startp = marker_position (w->start[CURRENT_DISP]);
+ startp = 1;
+ }
+ else
+ {
+ startp = marker_position (w->start[CURRENT_DISP]);
+ if (startp < BUF_BEGV (b))
+ startp = BUF_BEGV (b);
+ else if (startp > BUF_ZV (b))
+ startp = BUF_ZV (b);
+ }
+ Fset_marker (w->start[DESIRED_DISP], make_int (startp), the_buffer);
+
+ truncation_changed = (find_window_mirror (w)->truncate_win !=
+ window_truncation_on (w));
+
+ /* If w->force_start is set, then some function set w->start and we
+ should display from there and change point, if necessary, to
+ ensure that it is visible. */
+ if (w->force_start || inactive_minibuffer)
+ {
+ w->force_start = 0;
+ w->last_modified[DESIRED_DISP] = Qzero;
+ w->last_facechange[DESIRED_DISP] = Qzero;
+
+ regenerate_window (w, startp, pointm, DESIRED_DISP);
+
+ if (!point_visible (w, pointm, DESIRED_DISP) && !inactive_minibuffer)
+ {
+ pointm = point_at_center (w, DESIRED_DISP, 0, 0);
+
+ if (selected_globally)
+ BUF_SET_PT (b, pointm);
+
+ Fset_marker (w->pointm[DESIRED_DISP], make_int (pointm),
+ the_buffer);
+
+ /* #### BUFU amounts of overkil just to get the cursor
+ location marked properly. FIX ME FIX ME FIX ME */
+ regenerate_window (w, startp, pointm, DESIRED_DISP);
+ }
+
+ goto regeneration_done;
+ }
+
+ /* If nothing has changed since the last redisplay, then we just
+ need to make sure that point is still visible. */
+ if (XINT (w->last_modified[CURRENT_DISP]) >= BUF_MODIFF (b)
+ && XINT (w->last_facechange[CURRENT_DISP]) >= BUF_FACECHANGE (b)
+ && pointm >= startp
+ /* This check is to make sure we restore the minibuffer after a
+ temporary change to the echo area. */
+ && !(MINI_WINDOW_P (w) && f->buffers_changed)
+ && !f->frame_changed
+ && !truncation_changed)
+ {
+ /* Check if the cursor has actually moved. */
+ if (EQ (Fmarker_buffer (w->last_point[CURRENT_DISP]), w->buffer)
+ && pointm == marker_position (w->last_point[CURRENT_DISP])
+ && selected_globally
+ && !w->windows_changed
+ && !f->clip_changed
+ && !f->extents_changed
+ && !f->faces_changed
+ && !f->glyphs_changed
+ && !f->point_changed
+ && !f->windows_structure_changed)
+ {
+ /* If not, we're done. */
+ if (f->modeline_changed)
+ regenerate_modeline (w);
+
+ skip_output = 1;
+ goto regeneration_done;
+ }
+ else
+ {
+ /* If the new point is visible in the redisplay structures,
+ then let the output update routines handle it, otherwise
+ do things the hard way. */
+ if (!w->windows_changed
+ && !f->clip_changed
+ && !f->extents_changed
+ && !f->faces_changed
+ && !f->glyphs_changed
+ && !f->windows_structure_changed)
+ {
+ if (point_visible (w, pointm, CURRENT_DISP)
+ && w->last_point_x[CURRENT_DISP] != -1
+ && w->last_point_y[CURRENT_DISP] != -1)
+ {
+ if (redisplay_move_cursor (w, pointm, FRAME_TTY_P (f)))
+ {
+ /* Always regenerate in case it is displaying
+ the current line or column. */
+ regenerate_modeline (w);
+
+ skip_output = 1;
+ goto regeneration_done;
+ }
+ }
+ else if (!selected_in_its_frame && !f->point_changed)
+ {
+ if (f->modeline_changed)
+ regenerate_modeline (w);
+
+ skip_output = 1;
+ goto regeneration_done;
+ }
+ }
+
+ /* If we weren't able to take the shortcut method, then use
+ the brute force method. */
+ regenerate_window (w, startp, pointm, DESIRED_DISP);
+
+ if (point_visible (w, pointm, DESIRED_DISP))
+ goto regeneration_done;
+ }
+ }
+
+ /* Check if the starting point is no longer at the beginning of a
+ line, in which case find a new starting point. We also recenter
+ if our start position is equal to point-max. Otherwise we'll end
+ up with a blank window. */
+ else if (((w->start_at_line_beg || MINI_WINDOW_P (w))
+ && !(startp == BUF_BEGV (b)
+ || BUF_FETCH_CHAR (b, startp - 1) == '\n'))
+ || (pointm == startp &&
+ EQ (Fmarker_buffer (w->last_start[CURRENT_DISP]), w->buffer) &&
+ startp < marker_position (w->last_start[CURRENT_DISP]))
+ || (startp == BUF_ZV (b)))
+ {
+ startp = regenerate_window_point_center (w, pointm, DESIRED_DISP);
+
+ goto regeneration_done;
+ }
+ /* See if we can update the data structures locally based on
+ knowledge of what changed in the buffer. */
+ else if (!w->windows_changed
+ && !f->clip_changed
+ && !f->faces_changed
+ && !f->glyphs_changed
+ && !f->windows_structure_changed
+ && !f->frame_changed
+ && !truncation_changed
+ && pointm >= startp
+ && regenerate_window_incrementally (w, startp, pointm))
+ {
+ if (f->modeline_changed
+ || XINT (w->last_modified[CURRENT_DISP]) < BUF_MODIFF (b)
+ || XINT (w->last_facechange[CURRENT_DISP]) < BUF_FACECHANGE (b))
+ regenerate_modeline (w);
+
+ skip_output = 1;
+ goto regeneration_done;
+ }
+ /* #### This is where a check for structure based scrolling would go. */
+ /* If all else fails, try just regenerating and see what happens. */
+ else
+ {
+ regenerate_window (w, startp, pointm, DESIRED_DISP);
+
+ if (point_visible (w, pointm, DESIRED_DISP))
+ goto regeneration_done;
+ }
+
+ /* We still haven't gotten the window regenerated with point
+ visible. Next we try scrolling a little and see if point comes
+ back onto the screen. */
+ if (scroll_step > 0)
+ {
+ int scrolled = scroll_conservatively;
+ for (; scrolled >= 0; scrolled -= scroll_step)
+ {
+ startp = vmotion (w, startp,
+ (pointm < startp) ? -scroll_step : scroll_step, 0);
+ regenerate_window (w, startp, pointm, DESIRED_DISP);
+
+ if (point_visible (w, pointm, DESIRED_DISP))
+ goto regeneration_done;
+ }
+ }
+
+ /* We still haven't managed to get the screen drawn with point on
+ the screen, so just center it and be done with it. */
+ startp = regenerate_window_point_center (w, pointm, DESIRED_DISP);
+
+
+regeneration_done:
+
+ /* If the window's frame is changed then reset the current display
+ lines in order to force a full repaint. */
+ if (f->frame_changed)
+ {
+ display_line_dynarr *cla = window_display_lines (w, CURRENT_DISP);
+
+ Dynarr_reset (cla);
+ }
+
+ /* Must do this before calling redisplay_output_window because it
+ sets some markers on the window. */
+ if (echo_active)
+ {
+ w->buffer = old_buffer;
+ Fset_marker (w->pointm[DESIRED_DISP], make_int (old_pointm), old_buffer);
+ Fset_marker (w->start[DESIRED_DISP], make_int (old_startp), old_buffer);
+ }
+
+ /* These also have to be set before calling redisplay_output_window
+ since it sets the CURRENT_DISP values based on them. */
+ w->last_modified[DESIRED_DISP] = make_int (BUF_MODIFF (b));
+ w->last_facechange[DESIRED_DISP] = make_int (BUF_FACECHANGE (b));
+ Fset_marker (w->last_start[DESIRED_DISP], make_int (startp), w->buffer);
+ Fset_marker (w->last_point[DESIRED_DISP], make_int (pointm), w->buffer);
+
+ if (!skip_output)
+ {
+ Bufpos start = marker_position (w->start[DESIRED_DISP]);
+ 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);
+ redisplay_output_window (w);
+ /*
+ * If we just displayed the echo area, the line start cache is
+ * no longer valid, because the minibuffer window is assocaited
+ * with the window now.
+ */
+ if (echo_active)
+ w->line_cache_last_updated = make_int (-1);
+ }
+
+ /* #### This should be dependent on face changes and will need to be
+ somewhere else once tty updates occur on a per-frame basis. */
+ mark_face_cachels_as_clean (w);
+
+ w->windows_changed = 0;
+}
+
+/* Call buffer_reset_changes for all buffers present in any window
+ currently visible in all frames on all devices. #### There has to
+ be a better way to do this. */
+
+static int
+reset_buffer_changes_mapfun (struct window *w, void *ignored_closure)
+{
+ buffer_reset_changes (XBUFFER (w->buffer));
+ return 0;
+}
+
+static void
+reset_buffer_changes (void)
+{
+ Lisp_Object frmcons, devcons, concons;
+
+ FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
+ {
+ struct frame *f = XFRAME (XCAR (frmcons));
+
+ if (FRAME_REPAINT_P (f))
+ map_windows (f, reset_buffer_changes_mapfun, 0);
+ }
+}
+
+/* Ensure that all windows underneath the given window in the window
+ hierarchy are correctly displayed. */
+
+static void
+redisplay_windows (Lisp_Object window, int skip_selected)
+{
+ for (; !NILP (window) ; window = XWINDOW (window)->next)
+ {
+ redisplay_window (window, skip_selected);
+ }
+}
+
+static int
+call_redisplay_end_triggers (struct window *w, void *closure)
+{
+ Bufpos lrpos = w->last_redisplay_pos;
+ w->last_redisplay_pos = 0;
+ if (!NILP (w->buffer)
+ && !NILP (w->redisplay_end_trigger)
+ && lrpos > 0)
+ {
+ Bufpos pos;
+
+ if (MARKERP (w->redisplay_end_trigger)
+ && XMARKER (w->redisplay_end_trigger)->buffer != 0)
+ pos = marker_position (w->redisplay_end_trigger);
+ else if (INTP (w->redisplay_end_trigger))
+ pos = XINT (w->redisplay_end_trigger);
+ else
+ {
+ w->redisplay_end_trigger = Qnil;
+ return 0;
+ }
+
+ if (lrpos >= pos)
+ {
+ Lisp_Object window;
+ XSETWINDOW (window, w);
+ va_run_hook_with_args_in_buffer (XBUFFER (w->buffer),
+ Qredisplay_end_trigger_functions,
+ 2, window,
+ w->redisplay_end_trigger);
+ w->redisplay_end_trigger = Qnil;
+ }
+ }
+
+ return 0;
+}
+
+/* Ensure that all windows on the given frame are correctly displayed. */
+
+static int
+redisplay_frame (struct frame *f, int preemption_check)
+{
+ struct device *d = XDEVICE (f->device);
+
+ if (preemption_check)
+ {
+ /* The preemption check itself takes a lot of time,
+ so normally don't do it here. We do it if called
+ from Lisp, though (`redisplay-frame'). */
+ int preempted;
+
+ REDISPLAY_PREEMPTION_CHECK;
+ if (preempted)
+ return 1;
+ }
+
+ /* Before we put a hold on frame size changes, attempt to process
+ any which are already pending. */
+ if (f->size_change_pending)
+ change_frame_size (f, f->new_height, f->new_width, 0);
+
+ /* If frame size might need to be changed, due to changed size
+ of toolbars, scroolabrs etc, change it now */
+ if (f->size_slipped)
+ {
+ adjust_frame_size (f);
+ assert (!f->size_slipped);
+ }
+
+ /* The menubar, toolbar, and icon updates must be done before
+ hold_frame_size_changes is called and we are officially
+ 'in_display'. They may eval lisp code which may call Fsignal.
+ If in_display is set Fsignal will abort. */
+
+#ifdef HAVE_MENUBARS
+ /* Update the menubar. It is done first since it could change
+ the menubar's visibility. This way we avoid having flashing
+ caused by an Expose event generated by the visibility change
+ being handled. */
+ update_frame_menubars (f);
+#endif /* HAVE_MENUBARS */
+
+#ifdef HAVE_TOOLBARS
+ /* Update the toolbars. */
+ update_frame_toolbars (f);
+#endif /* HAVE_TOOLBARS */
+
+ hold_frame_size_changes ();
+
+ /* ----------------- BEGIN CRITICAL REDISPLAY SECTION ---------------- */
+ /* Within this section, we are defenseless and assume that the
+ following cannot happen:
+
+ 1) garbage collection
+ 2) Lisp code evaluation
+ 3) frame size changes
+
+ We ensure (3) by calling hold_frame_size_changes(), which
+ will cause any pending frame size changes to get put on hold
+ till after the end of the critical section. (1) follows
+ automatically if (2) is met. #### Unfortunately, there are
+ some places where Lisp code can be called within this section.
+ We need to remove them.
+
+ If Fsignal() is called during this critical section, we
+ will abort().
+
+ If garbage collection is called during this critical section,
+ we simply return. #### We should abort instead.
+
+ #### 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));
+
+ /* Do the selected window first. */
+ redisplay_window (FRAME_SELECTED_WINDOW (f), 0);
+
+ /* Then do the rest. */
+ redisplay_windows (f->root_window, 1);
+
+ /* 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 (FRAME_TTY_P (f))
+ DEVMETH (d, output_end, (d));
+
+ 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->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;
+ f->window_face_cache_reset = 0;
+ f->echo_area_garbaged = 0;
+
+ f->clear = 0;
+
+ if (!f->size_change_pending)
+ f->size_changed = 0;
+
+ /* ----------------- END CRITICAL REDISPLAY SECTION ---------------- */
+
+ /* Allow frame size changes to occur again.
+
+ #### what happens if changes to other frames happen? */
+ unhold_one_frame_size_changes (f);
+
+ map_windows (f, call_redisplay_end_triggers, 0);
+ return 0;
+}
+
+/* Ensure that all frames on the given device are correctly displayed. */
+
+static int
+redisplay_device (struct device *d)
+{
+ Lisp_Object frame, frmcons;
+ int preempted = 0;
+ int size_change_failed = 0;
+ struct frame *f;
+
+ if (DEVICE_STREAM_P (d)) /* nothing to do */
+ return 0;
+
+ /* It is possible that redisplay has been called before the
+ device is fully initialized. If so then continue with the
+ next device. */
+ if (NILP (DEVICE_SELECTED_FRAME (d)))
+ return 0;
+
+ REDISPLAY_PREEMPTION_CHECK;
+ if (preempted)
+ return 1;
+
+ /* Always do the selected frame first. */
+ frame = DEVICE_SELECTED_FRAME (d);
+
+ f = XFRAME (frame);
+
+ if (f->icon_changed || f->windows_changed)
+ update_frame_icon (f);
+
+ 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)
+ {
+ preempted = redisplay_frame (f, 0);
+ }
+
+ if (preempted)
+ return 1;
+
+ /* If the frame redisplay did not get preempted, then this flag
+ should have gotten set to 0. It might be possible for that
+ not to happen if a size change event were to occur at an odd
+ time. To make sure we don't miss anything we simply don't
+ reset the top level flags until the condition ends up being
+ in the right state. */
+ if (f->size_changed)
+ size_change_failed = 1;
+ }
+
+ DEVICE_FRAME_LOOP (frmcons, d)
+ {
+ f = XFRAME (XCAR (frmcons));
+
+ if (f == XFRAME (DEVICE_SELECTED_FRAME (d)))
+ continue;
+
+ if (f->icon_changed || f->windows_changed)
+ update_frame_icon (f);
+
+ 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)
+ {
+ preempted = redisplay_frame (f, 0);
+ }
+
+ if (preempted)
+ return 1;
+
+ if (f->size_change_pending)
+ size_change_failed = 1;
+ }
+ }
+
+ /* 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->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;
+
+ if (!size_change_failed)
+ d->size_changed = 0;
+
+ return 0;
+}
+
+static Lisp_Object
+restore_profiling_redisplay_flag (Lisp_Object val)
+{
+ profiling_redisplay_flag = XINT (val);
+ return Qnil;
+}
+
+/* Ensure that all windows on all frames on all devices are displaying
+ the current contents of their respective buffers. */
+
+static void
+redisplay_without_hooks (void)
+{
+ Lisp_Object devcons, concons;
+ int size_change_failed = 0;
+ int count = specpdl_depth ();
+
+ if (profiling_active)
+ {
+ record_unwind_protect (restore_profiling_redisplay_flag,
+ make_int (profiling_redisplay_flag));
+ profiling_redisplay_flag = 1;
+ }
+
+ 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 &&
+ !windows_structure_changed && !disable_preemption &&
+ preemption_count < max_preempts)
+ goto done;
+
+ DEVICE_LOOP_NO_BREAK (devcons, concons)
+ {
+ 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)
+ {
+ preempted = redisplay_device (d);
+
+ if (preempted)
+ {
+ preemption_count++;
+ RESET_CHANGED_SET_FLAGS;
+ goto done;
+ }
+
+ /* See comment in redisplay_device. */
+ if (d->size_changed)
+ size_change_failed = 1;
+ }
+ }
+ preemption_count = 0;
+
+ /* Mark redisplay as accurate */
+ buffers_changed = 0;
+ clip_changed = 0;
+ extents_changed = 0;
+ frame_changed = 0;
+ glyphs_changed = 0;
+ icon_changed = 0;
+ menubar_changed = 0;
+ modeline_changed = 0;
+ point_changed = 0;
+ toolbar_changed = 0;
+ windows_changed = 0;
+ windows_structure_changed = 0;
+ RESET_CHANGED_SET_FLAGS;
+
+ if (faces_changed)
+ {
+ mark_all_faces_as_clean ();
+ faces_changed = 0;
+ }
+
+ if (!size_change_failed)
+ size_changed = 0;
+
+ reset_buffer_changes ();
+
+ done:
+ unbind_to (count, Qnil);
+}
+
+void
+redisplay (void)
+{
+ if (last_display_warning_tick != display_warning_tick &&
+ !inhibit_warning_display)
+ {
+ /* If an error occurs during this function, oh well.
+ If we report another warning, we could get stuck in an
+ infinite loop reporting warnings. */
+ call0_trapping_errors (0, Qdisplay_warning_buffer);
+ last_display_warning_tick = display_warning_tick;
+ }
+ /* The run_hook_trapping_errors functions are smart enough not
+ to do any evalling if the hook function is empty, so there
+ should not be any significant time loss. All places in the
+ C code that call redisplay() are prepared to handle GCing,
+ so we should be OK. */
+#ifndef INHIBIT_REDISPLAY_HOOKS
+ run_hook_trapping_errors ("Error in pre-redisplay-hook",
+ Qpre_redisplay_hook);
+#endif /* INHIBIT_REDISPLAY_HOOKS */
+
+ redisplay_without_hooks ();
+
+#ifndef INHIBIT_REDISPLAY_HOOKS
+ run_hook_trapping_errors ("Error in post-redisplay-hook",
+ Qpost_redisplay_hook);
+#endif /* INHIBIT_REDISPLAY_HOOKS */
+}
+
+
+static char window_line_number_buf[32];
+
+/* Efficiently determine the window line number, and return a pointer
+ to its printed representation. Do this regardless of whether
+ line-number-mode is on. The first line in the buffer is counted as
+ 1. If narrowing is in effect, the lines are counted from the
+ beginning of the visible portion of the buffer. */
+static char *
+window_line_number (struct window *w, int type)
+{
+ struct device *d = XDEVICE (XFRAME (w->frame)->device);
+ struct buffer *b = XBUFFER (w->buffer);
+ /* Be careful in the order of these tests. The first clasue will
+ fail if DEVICE_SELECTED_FRAME == Qnil (since w->frame cannot be).
+ This can occur when the frame title is computed really early */
+ Bufpos pos =
+ ((EQ(DEVICE_SELECTED_FRAME(d), w->frame) &&
+ (w == XWINDOW (FRAME_SELECTED_WINDOW (device_selected_frame(d)))) &&
+ EQ(DEVICE_CONSOLE(d), Vselected_console) &&
+ XDEVICE(CONSOLE_SELECTED_DEVICE(XCONSOLE(DEVICE_CONSOLE(d)))) == d )
+ ? BUF_PT (b)
+ : marker_position (w->pointm[type]));
+ EMACS_INT line;
+
+ line = buffer_line_number (b, pos, 1);
+
+ long_to_string (window_line_number_buf, line + 1);
+
+ return window_line_number_buf;
+}
+
+
+/* Given a character representing an object in a modeline
+ specification, return a string (stored into the global array
+ `mode_spec_bufbyte_string') with the information that object
+ represents.
+
+ This function is largely unchanged from previous versions of the
+ redisplay engine.
+
+ Warning! This code is also used for frame titles and can be called
+ very early in the device/frame update process! JV
+*/
+
+static void
+decode_mode_spec (struct window *w, Emchar spec, int type)
+{
+ Lisp_Object obj = Qnil;
+ CONST char *str = NULL;
+ struct buffer *b = XBUFFER (w->buffer);
+
+ Dynarr_reset (mode_spec_bufbyte_string);
+
+ switch (spec)
+ {
+ /* print buffer name */
+ case 'b':
+ obj = b->name;
+ break;
+
+ /* print visited file name */
+ case 'f':
+ obj = b->filename;
+ break;
+
+ /* print the current column */
+ case 'c':
+ {
+ Bufpos pt = (w == XWINDOW (Fselected_window (Qnil)))
+ ? BUF_PT (b)
+ : marker_position (w->pointm[type]);
+ int col = column_at_point (b, pt, 1) + !!column_number_start_at_one;
+ char buf[32];
+
+ long_to_string (buf, col);
+
+ Dynarr_add_many (mode_spec_bufbyte_string,
+ (CONST Bufbyte *) buf, strlen (buf));
+
+ goto decode_mode_spec_done;
+ }
+ /* print the file coding system */
+ case 'C':
+#ifdef FILE_CODING
+ {
+ Lisp_Object codesys = b->buffer_file_coding_system;
+ /* Be very careful here not to get an error. */
+ if (NILP (codesys) || SYMBOLP (codesys) || CODING_SYSTEMP (codesys))
+ {
+ codesys = Ffind_coding_system (codesys);
+ if (CODING_SYSTEMP (codesys))
+ obj = XCODING_SYSTEM_MNEMONIC (codesys);
+ }
+ }
+#endif /* FILE_CODING */
+ break;
+
+ /* print the current line number */
+ case 'l':
+ str = window_line_number (w, type);
+ break;
+
+ /* print value of mode-name (obsolete) */
+ case 'm':
+ obj = b->mode_name;
+ break;
+
+ /* print hyphen and frame number, if != 1 */
+ case 'N':
+#ifdef HAVE_TTY
+ {
+ struct frame *f = XFRAME (w->frame);
+ if (FRAME_TTY_P (f) && f->order_count > 1 && f->order_count <= 99999999)
+ {
+ /* Naughty, naughty */
+ char * writable_str = alloca_array (char, 10);
+ sprintf (writable_str, "-%d", f->order_count);
+ str = writable_str;
+ }
+ }
+#endif /* HAVE_TTY */
+ break;
+
+ /* print Narrow if appropriate */
+ case 'n':
+ if (BUF_BEGV (b) > BUF_BEG (b)
+ || BUF_ZV (b) < BUF_Z (b))
+ str = " Narrow";
+ break;
+
+ /* print %, * or hyphen, if buffer is read-only, modified or neither */
+ case '*':
+ str = (!NILP (b->read_only)
+ ? "%"
+ : ((BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
+ ? "*"
+ : "-"));
+ break;
+
+ /* print * or hyphen -- XEmacs change to allow a buffer to be
+ read-only but still indicate whether it is modified. */
+ case '+':
+ str = ((BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
+ ? "*"
+ : (!NILP (b->read_only)
+ ? "%"
+ : "-"));
+ break;
+
+ /* #### defined in 19.29 decode_mode_spec, but not in
+ modeline-format doc string. */
+ /* This differs from %* in that it ignores read-only-ness. */
+ case '&':
+ str = ((BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
+ ? "*"
+ : "-");
+ break;
+
+ /* print process status */
+ case 's':
+ obj = Fget_buffer_process (w->buffer);
+ if (NILP (obj))
+ str = GETTEXT ("no process");
+ else
+ obj = Fsymbol_name (Fprocess_status (obj));
+ break;
+
+ /* Print name of selected frame. */
+ case 'S':
+ obj = XFRAME (w->frame)->name;
+ break;
+
+ /* indicate TEXT or BINARY */
+ case 't':
+ /* #### NT does not use this any more. Now what? */
+ str = "T";
+ break;
+
+ /* print percent of buffer above top of window, or Top, Bot or All */
+ 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))
+ {
+ if (pos <= BUF_BEGV (b))
+ str = "All";
+ else
+ str = "Bottom";
+ }
+ else if (pos <= BUF_BEGV (b))
+ str = "Top";
+ else
+ {
+ /* 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;
+
+ /* 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);
+ Dynarr_add_many (mode_spec_bufbyte_string, (Bufbyte *) buf,
+ strlen (buf));
+
+ goto decode_mode_spec_done;
+ }
+ break;
+ }
+
+ /* print percent of buffer above bottom of window, perhaps plus
+ Top, or print Bottom or All */
+ case 'P':
+ {
+ 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,
+ botpos may be negative. */
+ if (botpos < toppos)
+ botpos = toppos;
+
+ if (botpos >= BUF_ZV (b))
+ {
+ if (toppos <= BUF_BEGV (b))
+ str = "All";
+ else
+ str = "Bottom";
+ }
+ else
+ {
+ /* 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;
+
+ /* 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 (toppos <= BUF_BEGV (b))
+ sprintf (buf, "Top%2d%%", total);
+ else
+ sprintf (buf, "%2d%%", total);
+
+ Dynarr_add_many (mode_spec_bufbyte_string, (Bufbyte *) buf,
+ strlen (buf));
+
+ goto decode_mode_spec_done;
+ }
+ break;
+ }
+
+ /* print % */
+ case '%':
+ str = "%";
+ break;
+
+ /* print one [ for each recursive editing level. */
+ case '[':
+ {
+ int i;
+
+ if (command_loop_level > 5)
+ {
+ str = "[[[... ";
+ break;
+ }
+
+ for (i = 0; i < command_loop_level; i++)
+ Dynarr_add (mode_spec_bufbyte_string, '[');
+
+ goto decode_mode_spec_done;
+ }
+
+ /* print one ] for each recursive editing level. */
+ case ']':
+ {
+ int i;
+
+ if (command_loop_level > 5)
+ {
+ str = "...]]]";
+ break;
+ }
+
+ for (i = 0; i < command_loop_level; i++)
+ Dynarr_add (mode_spec_bufbyte_string, ']');
+
+ goto decode_mode_spec_done;
+ }
+
+ /* print infinitely many dashes -- handle at top level now */
+ case '-':
+ break;
+
+ }
+
+ if (STRINGP (obj))
+ Dynarr_add_many (mode_spec_bufbyte_string,
+ XSTRING_DATA (obj),
+ XSTRING_LENGTH (obj));
+ else if (str)
+ Dynarr_add_many (mode_spec_bufbyte_string, (Bufbyte *) str, strlen (str));
+
+decode_mode_spec_done:
+ Dynarr_add (mode_spec_bufbyte_string, '\0');
+}
+
+/* Given a display line, free all of its data structures. */
+
+static void
+free_display_line (struct display_line *dl)
+{
+ int block;
+
+ if (dl->display_blocks)
+ {
+ for (block = 0; block < Dynarr_largest (dl->display_blocks); block++)
+ {
+ struct display_block *db = Dynarr_atp (dl->display_blocks, block);
+
+ Dynarr_free (db->runes);
+ }
+
+ Dynarr_free (dl->display_blocks);
+ dl->display_blocks = NULL;
+ }
+
+ if (dl->left_glyphs)
+ {
+ Dynarr_free (dl->left_glyphs);
+ dl->left_glyphs = NULL;
+ }
+
+ if (dl->right_glyphs)
+ {
+ Dynarr_free (dl->right_glyphs);
+ dl->right_glyphs = NULL;
+ }
+}
+
+
+/* Given an array of display lines, free them and all data structures
+ contained within them. */
+
+static void
+free_display_lines (display_line_dynarr *dla)
+{
+ int line;
+
+ for (line = 0; line < Dynarr_largest (dla); line++)
+ {
+ free_display_line (Dynarr_atp (dla, line));
+ }
+
+ Dynarr_free (dla);
+}
+
+/* Call internal free routine for each set of display lines. */
+
+void
+free_display_structs (struct window_mirror *mir)
+{
+ if (mir->current_display_lines)
+ {
+ free_display_lines (mir->current_display_lines);
+ mir->current_display_lines = 0;
+ }
+
+ if (mir->desired_display_lines)
+ {
+ free_display_lines (mir->desired_display_lines);
+ mir->desired_display_lines = 0;
+ }
+}
+\f
+
+static void
+mark_glyph_block_dynarr (glyph_block_dynarr *gba, void (*markobj) (Lisp_Object))
+{
+ if (gba)
+ {
+ glyph_block *gb = Dynarr_atp (gba, 0);
+ glyph_block *gb_last = Dynarr_atp (gba, Dynarr_length (gba));
+
+ for (; gb < gb_last; gb++)
+ {
+ if (!NILP (gb->glyph)) ((markobj) (gb->glyph));
+ if (!NILP (gb->extent)) ((markobj) (gb->extent));
+ }
+ }
+}
+
+static void
+mark_redisplay_structs (display_line_dynarr *dla, void (*markobj) (Lisp_Object))
+{
+ display_line *dl = Dynarr_atp (dla, 0);
+ display_line *dl_last = Dynarr_atp (dla, Dynarr_length (dla));
+
+ for (; dl < dl_last; dl++)
+ {
+ display_block_dynarr *dba = dl->display_blocks;
+ display_block *db = Dynarr_atp (dba, 0);
+ display_block *db_last = Dynarr_atp (dba, Dynarr_length (dba));
+
+ for (; db < db_last; db++)
+ {
+ rune_dynarr *ra = db->runes;
+ rune *r = Dynarr_atp (ra, 0);
+ rune *r_last = Dynarr_atp (ra, Dynarr_length (ra));
+
+ for (; r < r_last; r++)
+ {
+ if (r->type == RUNE_DGLYPH)
+ {
+ if (!NILP (r->object.dglyph.glyph))
+ ((markobj) (r->object.dglyph.glyph));
+ if (!NILP (r->object.dglyph.extent))
+ ((markobj) (r->object.dglyph.extent));
+ }
+ }
+ }
+
+ mark_glyph_block_dynarr (dl->left_glyphs, markobj);
+ mark_glyph_block_dynarr (dl->right_glyphs, markobj);
+ }
+}
+
+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);
+
+ if (mir->next)
+ mark_window_mirror (mir->next, markobj);
+
+ if (mir->hchild)
+ mark_window_mirror (mir->hchild, markobj);
+ else if (mir->vchild)
+ mark_window_mirror (mir->vchild, markobj);
+}
+
+void
+mark_redisplay (void (*markobj)(Lisp_Object))
+{
+ Lisp_Object frmcons, devcons, concons;
+
+ FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
+ {
+ struct frame *f = XFRAME (XCAR (frmcons));
+ update_frame_window_mirror (f);
+ mark_window_mirror (f->root_mirror, markobj);
+ }
+}
+\f
+/*****************************************************************************
+ Line Start Cache Description and Rationale
+
+ The traditional scrolling code in Emacs breaks in a variable height world.
+ It depends on the key assumption that the number of lines that can be
+ displayed at any given time is fixed. This led to a complete separation
+ of the scrolling code from the redisplay code. In order to fully support
+ variable height lines, the scrolling code must actually be tightly
+ integrated with redisplay. Only redisplay can determine how many lines
+ will be displayed on a screen for any given starting point.
+
+ What is ideally wanted is a complete list of the starting buffer position
+ for every possible display line of a buffer along with the height of that
+ display line. Maintaining such a full list would be very expensive. We
+ settle for having it include information for all areas which we happen to
+ generate anyhow (i.e. the region currently being displayed) and for those
+ areas we need to work with.
+
+ In order to ensure that the cache accurately represents what redisplay
+ would actually show, it is necessary to invalidate it in many situations.
+ If the buffer changes, the starting positions may no longer be correct.
+ If a face or an extent has changed then the line heights may have altered.
+ These events happen frequently enough that the cache can end up being
+ constantly disabled. With this potentially constant invalidation when is
+ the cache ever useful?
+
+ Even if the cache is invalidated before every single usage, it is
+ necessary. Scrolling often requires knowledge about display lines which
+ are actually above or below the visible region. The cache provides a
+ convenient light-weight method of storing this information for multiple
+ display regions. This knowledge is necessary for the scrolling code to
+ always obey the First Golden Rule of Redisplay.
+
+ If the cache already contains all of the information that the scrolling
+ routines happen to need so that it doesn't have to go generate it, then we
+ are able to obey the Third Golden Rule of Redisplay. The first thing we
+ do to help out the cache is to always add the displayed region. This
+ region had to be generated anyway, so the cache ends up getting the
+ information basically for free. In those cases where a user is simply
+ scrolling around viewing a buffer there is a high probability that this 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:
+
+ + Insertions at end-of-line which don't cause line-wraps do not alter the
+ starting positions of any display lines. These types of buffer
+ modifications should not invalidate the cache. This is actually a large
+ optimization for redisplay speed as well.
+
+ + Buffer modifications frequently only affect the display of lines at and
+ below where they occur. In these situations we should only invalidate
+ the part of the cache starting at where the modification occurs.
+
+ In case you're wondering, the Second Golden Rule of Redisplay is not
+ applicable.
+ ****************************************************************************/
+
+/* 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;
+
+/* Makes internal_cache represent the TYPE display structs and only
+ the TYPE display structs. */
+
+static void
+update_internal_cache_list (struct window *w, int type)
+{
+ int line;
+ display_line_dynarr *dla = window_display_lines (w, type);
+
+ Dynarr_reset (internal_cache);
+ for (line = 0; line < Dynarr_length (dla); line++)
+ {
+ struct display_line *dl = Dynarr_atp (dla, line);
+
+ if (dl->modeline)
+ continue;
+ else
+ {
+ struct line_start_cache lsc;
+
+ lsc.start = dl->bufpos;
+ lsc.end = dl->end_bufpos;
+ lsc.height = dl->ascent + dl->descent;
+
+ Dynarr_add (internal_cache, lsc);
+ }
+ }
+}
+
+/* Reset the line cache if necessary. This should be run at the
+ beginning of any function which access the cache. */
+
+static void
+validate_line_start_cache (struct window *w)
+{
+ struct buffer *b = XBUFFER (w->buffer);
+ struct frame *f = XFRAME (w->frame);
+
+ if (!w->line_cache_validation_override)
+ {
+ /* f->extents_changed used to be in here because extent face and
+ size changes can cause text shifting. However, the extent
+ covering the region is constantly having its face set and
+ priority altered by the mouse code. This means that the line
+ start cache is constanty being invalidated. This is bad
+ since the mouse code also triggers heavy usage of the cache.
+ Since it is an unlikely that f->extents being changed
+ indicates that the cache really needs to be updated and if it
+ does redisplay will catch it pretty quickly we no longer
+ invalidate the cache if it is set. This greatly speeds up
+ dragging out regions with the mouse. */
+ if (XINT (w->line_cache_last_updated) < BUF_MODIFF (b)
+ || f->faces_changed
+ || f->clip_changed)
+ {
+ Dynarr_reset (w->line_start_cache);
+ }
+ }
+}
+
+/* Return the very first buffer position contained in the given
+ window's cache, or -1 if the cache is empty. Assumes that the
+ cache is valid. */
+
+static Bufpos
+line_start_cache_start (struct window *w)
+{
+ line_start_cache_dynarr *cache = w->line_start_cache;
+
+ if (!Dynarr_length (cache))
+ return -1;
+ else
+ return Dynarr_atp (cache, 0)->start;
+}
+
+/* Return the very last buffer position contained in the given
+ window's cache, or -1 if the cache is empty. Assumes that the
+ cache is valid. */
+
+static Bufpos
+line_start_cache_end (struct window *w)
+{
+ line_start_cache_dynarr *cache = w->line_start_cache;
+
+ if (!Dynarr_length (cache))
+ return -1;
+ else
+ return Dynarr_atp (cache, Dynarr_length (cache) - 1)->end;
+}
+
+/* Return the index of the line POINT is contained within in window
+ W's line start cache. It will enlarge the cache or move the cache
+ window in order to have POINT be present in the cache. MIN_PAST is
+ a guarantee of the number of entries in the cache present on either
+ side of POINT (unless a buffer boundary is hit). If MIN_PAST is -1
+ then it will be treated as 0, but the cache window will not be
+ allowed to shift. Returns -1 if POINT cannot be found in the cache
+ for any reason. */
+
+int
+point_in_line_start_cache (struct window *w, Bufpos point, int min_past)
+{
+ struct buffer *b = XBUFFER (w->buffer);
+ line_start_cache_dynarr *cache = w->line_start_cache;
+ unsigned int top, bottom, pos;
+
+ validate_line_start_cache (w);
+ w->line_cache_validation_override++;
+
+ /* Let functions pass in negative values, but we still treat -1
+ specially. */
+ /* #### bogosity alert */
+ if (min_past < 0 && min_past != -1)
+ min_past = -min_past;
+
+ if (!Dynarr_length (cache) || line_start_cache_start (w) > point
+ || line_start_cache_end (w) < point)
+ {
+ int loop;
+ int win_char_height = window_char_height (w, 1);
+
+ /* Occasionally we get here with a 0 height
+ window. find_next_newline_no_quit will abort if we pass it a
+ count of 0 so handle that case. */
+ if (!win_char_height)
+ win_char_height = 1;
+
+ if (!Dynarr_length (cache))
+ {
+ Bufpos from = find_next_newline_no_quit (b, point, -1);
+ Bufpos to = find_next_newline_no_quit (b, from, win_char_height);
+
+ update_line_start_cache (w, from, to, point, 0);
+
+ if (!Dynarr_length (cache))
+ {
+ w->line_cache_validation_override--;
+ return -1;
+ }
+ }
+
+ assert (Dynarr_length (cache));
+
+ loop = 0;
+ while (line_start_cache_start (w) > point
+ && (loop < cache_adjustment || min_past == -1))
+ {
+ Bufpos from, to;
+
+ from = line_start_cache_start (w);
+ if (from <= BUF_BEGV (b))
+ break;
+
+ from = find_next_newline_no_quit (b, from, -win_char_height);
+ to = line_start_cache_end (w);
+
+ update_line_start_cache (w, from, to, point, 0);
+ loop++;
+ }
+
+ if (line_start_cache_start (w) > point)
+ {
+ Bufpos from, to;
+
+ from = find_next_newline_no_quit (b, point, -1);
+ if (from >= BUF_ZV (b))
+ {
+ to = find_next_newline_no_quit (b, from, -win_char_height);
+ from = to;
+ to = BUF_ZV (b);
+ }
+ else
+ to = find_next_newline_no_quit (b, from, win_char_height);
+
+ update_line_start_cache (w, from, to, point, 0);
+ }
+
+ loop = 0;
+ while (line_start_cache_end (w) < point
+ && (loop < cache_adjustment || min_past == -1))
+ {
+ Bufpos from, to;
+
+ to = line_start_cache_end (w);
+ if (to >= BUF_ZV (b))
+ break;
+
+ from = line_start_cache_end (w);
+ to = find_next_newline_no_quit (b, from, win_char_height);
+
+ update_line_start_cache (w, from, to, point, 0);
+ loop++;
+ }
+
+ if (line_start_cache_end (w) < point)
+ {
+ Bufpos from, to;
+
+ from = find_next_newline_no_quit (b, point, -1);
+ if (from >= BUF_ZV (b))
+ {
+ to = find_next_newline_no_quit (b, from, -win_char_height);
+ from = to;
+ to = BUF_ZV (b);
+ }
+ else
+ to = find_next_newline_no_quit (b, from, win_char_height);
+
+ update_line_start_cache (w, from, to, point, 0);
+ }
+ }
+
+ assert (Dynarr_length (cache));
+
+ if (min_past == -1)
+ min_past = 0;
+
+ /* This could happen if the buffer is narrowed. */
+ if (line_start_cache_start (w) > point
+ || line_start_cache_end (w) < point)
+ {
+ w->line_cache_validation_override--;
+ return -1;
+ }
+
+find_point_loop:
+
+ top = Dynarr_length (cache) - 1;
+ bottom = 0;
+
+ while (1)
+ {
+ unsigned int new_pos;
+ Bufpos start, end;
+
+ pos = (bottom + top + 1) >> 1;
+ start = Dynarr_atp (cache, pos)->start;
+ end = Dynarr_atp (cache, pos)->end;
+
+ if (point >= start && point <= end)
+ {
+ if (pos < min_past && line_start_cache_start (w) > BUF_BEGV (b))
+ {
+ Bufpos from =
+ find_next_newline_no_quit (b, line_start_cache_start (w),
+ -min_past - 1);
+ Bufpos to = line_start_cache_end (w);
+
+ update_line_start_cache (w, from, to, point, 0);
+ goto find_point_loop;
+ }
+ else if ((Dynarr_length (cache) - pos - 1) < min_past
+ && line_start_cache_end (w) < BUF_ZV (b))
+ {
+ Bufpos from = line_start_cache_end (w);
+ Bufpos to = find_next_newline_no_quit (b, from,
+ (min_past
+ ? min_past
+ : 1));
+
+ update_line_start_cache (w, from, to, point, 0);
+ goto find_point_loop;
+ }
+ else
+ {
+ w->line_cache_validation_override--;
+ return pos;
+ }
+ }
+ else if (point > end)
+ bottom = pos + 1;
+ else if (point < start)
+ top = pos - 1;
+ else
+ abort ();
+
+ new_pos = (bottom + top + 1) >> 1;
+ if (pos == new_pos)
+ {
+ w->line_cache_validation_override--;
+ return -1;
+ }
+ }
+}
+
+/* Return a boolean indicating if POINT would be visible in window W
+ if display of the window was to begin at STARTP. */
+
+int
+point_would_be_visible (struct window *w, Bufpos startp, Bufpos point)
+{
+ struct buffer *b = XBUFFER (w->buffer);
+ int pixpos = 0;
+ int bottom = WINDOW_TEXT_HEIGHT (w);
+ int start_elt;
+
+ /* If point is before the intended start it obviously can't be visible. */
+ if (point < startp)
+ return 0;
+
+ /* If point or start are not in the accessible buffer range, then
+ fail. */
+ if (startp < BUF_BEGV (b) || startp > BUF_ZV (b)
+ || point < BUF_BEGV (b) || point > BUF_ZV (b))
+ return 0;
+
+ validate_line_start_cache (w);
+ w->line_cache_validation_override++;
+
+ start_elt = point_in_line_start_cache (w, startp, 0);
+ if (start_elt == -1)
+ {
+ w->line_cache_validation_override--;
+ return 0;
+ }
+
+ assert (line_start_cache_start (w) <= startp
+ && line_start_cache_end (w) >= startp);
+
+ while (1)
+ {
+ int height;
+
+ /* Expand the cache if necessary. */
+ if (start_elt == Dynarr_length (w->line_start_cache))
+ {
+ Bufpos old_startp =
+ Dynarr_atp (w->line_start_cache, start_elt - 1)->start;
+
+ start_elt = point_in_line_start_cache (w, old_startp,
+ window_char_height (w, 0));
+
+ /* We've already actually processed old_startp, so increment
+ immediately. */
+ start_elt++;
+
+ /* If this happens we didn't add any extra elements. Bummer. */
+ if (start_elt == Dynarr_length (w->line_start_cache))
+ {
+ w->line_cache_validation_override--;
+ return 0;
+ }
+ }
+
+ height = Dynarr_atp (w->line_start_cache, start_elt)->height;
+
+ if (pixpos + height > bottom)
+ {
+ if (bottom - pixpos < VERTICAL_CLIP (w, 0))
+ {
+ w->line_cache_validation_override--;
+ return 0;
+ }
+ }
+
+ pixpos += height;
+ if (point <= Dynarr_atp (w->line_start_cache, start_elt)->end)
+ {
+ w->line_cache_validation_override--;
+ return 1;
+ }
+
+ start_elt++;
+ }
+}
+
+/* For the given window W, if display starts at STARTP, what will be
+ the buffer position at the beginning or end of the last line
+ displayed. The end of the last line is also know as the window end
+ position.
+
+ #### With a little work this could probably be reworked as just a
+ call to start_with_line_at_pixpos. */
+
+static Bufpos
+start_end_of_last_line (struct window *w, Bufpos startp, int end)
+{
+ struct buffer *b = XBUFFER (w->buffer);
+ line_start_cache_dynarr *cache = w->line_start_cache;
+ int pixpos = 0;
+ int bottom = WINDOW_TEXT_HEIGHT (w);
+ Bufpos cur_start;
+ int start_elt;
+
+ validate_line_start_cache (w);
+ w->line_cache_validation_override++;
+
+ if (startp < BUF_BEGV (b))
+ startp = BUF_BEGV (b);
+ else if (startp > BUF_ZV (b))
+ startp = BUF_ZV (b);
+ cur_start = startp;
+
+ start_elt = point_in_line_start_cache (w, cur_start, 0);
+ if (start_elt == -1)
+ abort (); /* this had better never happen */
+
+ while (1)
+ {
+ int height = Dynarr_atp (cache, start_elt)->height;
+
+ cur_start = Dynarr_atp (cache, start_elt)->start;
+
+ if (pixpos + height > bottom)
+ {
+ /* Adjust for any possible clip. */
+ if (bottom - pixpos < VERTICAL_CLIP (w, 0))
+ start_elt--;
+
+ if (start_elt < 0)
+ {
+ w->line_cache_validation_override--;
+ if (end)
+ return BUF_ZV (b);
+ else
+ return BUF_BEGV (b);
+ }
+ else
+ {
+ w->line_cache_validation_override--;
+ if (end)
+ return Dynarr_atp (cache, start_elt)->end;
+ else
+ return Dynarr_atp (cache, start_elt)->start;
+ }
+ }
+
+ pixpos += height;
+ start_elt++;
+ if (start_elt == Dynarr_length (cache))
+ {
+ Bufpos from = line_start_cache_end (w);
+ int win_char_height = window_char_height (w, 0);
+ Bufpos to = find_next_newline_no_quit (b, from,
+ (win_char_height
+ ? win_char_height
+ : 1));
+
+ /* We've hit the end of the bottom so that's what it is. */
+ if (from >= BUF_ZV (b))
+ {
+ w->line_cache_validation_override--;
+ return BUF_ZV (b);
+ }
+
+ update_line_start_cache (w, from, to, BUF_PT (b), 0);
+
+ /* Updating the cache invalidates any current indexes. */
+ start_elt = point_in_line_start_cache (w, cur_start, -1) + 1;
+ }
+ }
+}
+
+/* For the given window W, if display starts at STARTP, what will be
+ the buffer position at the beginning of the last line displayed. */
+
+Bufpos
+start_of_last_line (struct window *w, Bufpos startp)
+{
+ return start_end_of_last_line (w, startp, 0);
+}
+
+/* For the given window W, if display starts at STARTP, what will be
+ the buffer position at the end of the last line displayed. This is
+ also know as the window end position. */
+
+Bufpos
+end_of_last_line (struct window *w, Bufpos startp)
+{
+ return start_end_of_last_line (w, startp, 1);
+}
+
+/* For window W, what does the starting position have to be so that
+ the line containing POINT will cover pixel position PIXPOS. */
+
+Bufpos
+start_with_line_at_pixpos (struct window *w, Bufpos point, int pixpos)
+{
+ struct buffer *b = XBUFFER (w->buffer);
+ int cur_elt;
+ Bufpos cur_pos, prev_pos = point;
+ int point_line_height;
+ int pixheight = pixpos - WINDOW_TEXT_TOP (w);
+
+ validate_line_start_cache (w);
+ w->line_cache_validation_override++;
+
+ cur_elt = point_in_line_start_cache (w, point, 0);
+ /* #### See comment in update_line_start_cache about big minibuffers. */
+ if (cur_elt < 0)
+ {
+ w->line_cache_validation_override--;
+ return point;
+ }
+
+ point_line_height = Dynarr_atp (w->line_start_cache, cur_elt)->height;
+
+ while (1)
+ {
+ cur_pos = Dynarr_atp (w->line_start_cache, cur_elt)->start;
+
+ pixheight -= Dynarr_atp (w->line_start_cache, cur_elt)->height;
+
+ /* Do not take into account the value of vertical_clip here.
+ That is the responsibility of the calling functions. */
+ if (pixheight < 0)
+ {
+ w->line_cache_validation_override--;
+ if (-pixheight > point_line_height)
+ /* We can't make the target line cover pixpos, so put it
+ above pixpos. That way it will at least be visible. */
+ return prev_pos;
+ else
+ return cur_pos;
+ }
+
+ cur_elt--;
+ if (cur_elt < 0)
+ {
+ Bufpos from, to;
+ int win_char_height;
+
+ if (cur_pos <= BUF_BEGV (b))
+ {
+ w->line_cache_validation_override--;
+ return BUF_BEGV (b);
+ }
+
+ win_char_height = window_char_height (w, 0);
+ if (!win_char_height)
+ win_char_height = 1;
+
+ from = find_next_newline_no_quit (b, cur_pos, -win_char_height);
+ to = line_start_cache_end (w);
+ 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);
+ }
+ prev_pos = cur_pos;
+ }
+}
+
+/* For window W, what does the starting position have to be so that
+ the line containing point is on display line LINE. If LINE is
+ positive it is considered to be the number of lines from the top of
+ the window (0 is the top line). If it is negative the number is
+ considered to be the number of lines from the bottom (-1 is the
+ bottom line). */
+
+Bufpos
+start_with_point_on_display_line (struct window *w, Bufpos point, int line)
+{
+ validate_line_start_cache (w);
+ w->line_cache_validation_override++;
+
+ if (line >= 0)
+ {
+ int cur_elt = point_in_line_start_cache (w, point, line);
+
+ if (cur_elt - line < 0)
+ cur_elt = 0; /* Hit the top */
+ else
+ cur_elt -= line;
+
+ w->line_cache_validation_override--;
+ return Dynarr_atp (w->line_start_cache, cur_elt)->start;
+ }
+ else
+ {
+ /* The calculated value of pixpos is correct for the bottom line
+ or what we want when line is -1. Therefore we subtract one
+ because we have already handled one line. */
+ int new_line = -line - 1;
+ int cur_elt = point_in_line_start_cache (w, point, new_line);
+ int pixpos = WINDOW_TEXT_BOTTOM (w);
+ Bufpos retval, search_point;
+
+ /* If scroll_on_clipped_lines is false, the last "visible" line of
+ the window covers the pixel at WINDOW_TEXT_BOTTOM (w) - 1.
+ If s_o_c_l is true, then we don't want to count a clipped
+ line, so back up from the bottom by the height of the line
+ containing point. */
+ if (scroll_on_clipped_lines)
+ pixpos -= Dynarr_atp (w->line_start_cache, cur_elt)->height;
+ else
+ pixpos -= 1;
+
+ if (cur_elt + new_line >= Dynarr_length (w->line_start_cache))
+ {
+ /* Hit the bottom of the buffer. */
+ int adjustment =
+ (cur_elt + new_line) - Dynarr_length (w->line_start_cache) + 1;
+ Lisp_Object window;
+ int defheight;
+
+ XSETWINDOW (window, w);
+ default_face_height_and_width (window, &defheight, 0);
+
+ cur_elt = Dynarr_length (w->line_start_cache) - 1;
+
+ pixpos -= (adjustment * defheight);
+ if (pixpos < WINDOW_TEXT_TOP (w))
+ pixpos = WINDOW_TEXT_TOP (w);
+ }
+ else
+ cur_elt = cur_elt + new_line;
+
+ search_point = Dynarr_atp (w->line_start_cache, cur_elt)->start;
+
+ retval = start_with_line_at_pixpos (w, search_point, pixpos);
+ w->line_cache_validation_override--;
+ return retval;
+ }
+}
+
+/* This is used to speed up vertical scrolling by caching the known
+ buffer starting positions for display lines. This allows the
+ scrolling routines to avoid costly calls to regenerate_window. If
+ NO_REGEN is true then it will only add the values in the DESIRED
+ display structs which are in the given range.
+
+ Note also that the FROM/TO values are minimums. It is possible
+ that this function will actually add information outside of the
+ lines containing those positions. This can't hurt but it could
+ possibly help.
+
+ #### We currently force the cache to have only 1 contiguous region.
+ It might help to make the cache a dynarr of caches so that we can
+ cover more areas. This might, however, turn out to be a lot of
+ overhead for too little gain. */
+
+static void
+update_line_start_cache (struct window *w, Bufpos from, Bufpos to,
+ Bufpos point, int no_regen)
+{
+ struct buffer *b = XBUFFER (w->buffer);
+ line_start_cache_dynarr *cache = w->line_start_cache;
+ Bufpos low_bound, high_bound;
+
+ validate_line_start_cache (w);
+ w->line_cache_validation_override++;
+ updating_line_start_cache = 1;
+
+ if (from < BUF_BEGV (b))
+ from = BUF_BEGV (b);
+ if (to > BUF_ZV (b))
+ to = BUF_ZV (b);
+
+ if (from > to)
+ {
+ updating_line_start_cache = 0;
+ w->line_cache_validation_override--;
+ return;
+ }
+
+ if (Dynarr_length (cache))
+ {
+ low_bound = line_start_cache_start (w);
+ high_bound = line_start_cache_end (w);
+
+ /* Check to see if the desired range is already in the cache. */
+ if (from >= low_bound && to <= high_bound)
+ {
+ updating_line_start_cache = 0;
+ w->line_cache_validation_override--;
+ return;
+ }
+
+ /* Check to make sure that the desired range is adjacent to the
+ current cache. If not, invalidate the cache. */
+ if (to < low_bound || from > high_bound)
+ {
+ Dynarr_reset (cache);
+ low_bound = high_bound = -1;
+ }
+ }
+ else
+ {
+ low_bound = high_bound = -1;
+ }
+
+ w->line_cache_last_updated = make_int (BUF_MODIFF (b));
+
+ /* This could be integrated into the next two sections, but it is easier
+ to follow what's going on by having it separate. */
+ if (no_regen)
+ {
+ Bufpos start, end;
+
+ update_internal_cache_list (w, DESIRED_DISP);
+ if (!Dynarr_length (internal_cache))
+ {
+ updating_line_start_cache = 0;
+ w->line_cache_validation_override--;
+ return;
+ }
+
+ start = Dynarr_atp (internal_cache, 0)->start;
+ end =
+ Dynarr_atp (internal_cache, Dynarr_length (internal_cache) - 1)->end;
+
+ /* We aren't allowed to generate additional information to fill in
+ gaps, so if the DESIRED structs don't overlap the cache, reset the
+ cache. */
+ if (Dynarr_length (cache))
+ {
+ if (end < low_bound || start > high_bound)
+ Dynarr_reset (cache);
+
+ /* #### What should really happen if what we are doing is
+ extending a line (the last line)? */
+ if (Dynarr_length (cache) == 1
+ && Dynarr_length (internal_cache) == 1)
+ Dynarr_reset (cache);
+ }
+
+ if (!Dynarr_length (cache))
+ {
+ Dynarr_add_many (cache, Dynarr_atp (internal_cache, 0),
+ Dynarr_length (internal_cache));
+ updating_line_start_cache = 0;
+ w->line_cache_validation_override--;
+ return;
+ }
+
+ /* An extra check just in case the calling function didn't pass in
+ the bounds of the DESIRED structs in the first place. */
+ if (start >= low_bound && end <= high_bound)
+ {
+ updating_line_start_cache = 0;
+ w->line_cache_validation_override--;
+ return;
+ }
+
+ /* At this point we know that the internal cache partially overlaps
+ the main cache. */
+ if (start < low_bound)
+ {
+ int ic_elt = Dynarr_length (internal_cache) - 1;
+ while (ic_elt >= 0)
+ {
+ if (Dynarr_atp (internal_cache, ic_elt)->start < low_bound)
+ break;
+ else
+ ic_elt--;
+ }
+
+ if (!(ic_elt >= 0))
+ {
+ Dynarr_reset (cache);
+ Dynarr_add_many (cache, Dynarr_atp (internal_cache, 0),
+ Dynarr_length (internal_cache));
+ updating_line_start_cache = 0;
+ w->line_cache_validation_override--;
+ return;
+ }
+
+ Dynarr_insert_many_at_start (cache, Dynarr_atp (internal_cache, 0),
+ ic_elt + 1);
+ }
+
+ if (end > high_bound)
+ {
+ int ic_elt = 0;
+
+ while (ic_elt < Dynarr_length (internal_cache))
+ {
+ if (Dynarr_atp (internal_cache, ic_elt)->start > high_bound)
+ break;
+ else
+ ic_elt++;
+ }
+
+ if (!(ic_elt < Dynarr_length (internal_cache)))
+ {
+ Dynarr_reset (cache);
+ Dynarr_add_many (cache, Dynarr_atp (internal_cache, 0),
+ Dynarr_length (internal_cache));
+ updating_line_start_cache = 0;
+ w->line_cache_validation_override--;
+ return;
+ }
+
+ Dynarr_add_many (cache, Dynarr_atp (internal_cache, ic_elt),
+ Dynarr_length (internal_cache) - ic_elt);
+ }
+
+ updating_line_start_cache = 0;
+ w->line_cache_validation_override--;
+ return;
+ }
+
+ if (!Dynarr_length (cache) || from < low_bound)
+ {
+ Bufpos startp = find_next_newline_no_quit (b, from, -1);
+ int marker = 0;
+ int old_lb = low_bound;
+
+ while (startp < old_lb || low_bound == -1)
+ {
+ int ic_elt;
+ Bufpos new_startp;
+
+ regenerate_window (w, startp, point, CMOTION_DISP);
+ update_internal_cache_list (w, CMOTION_DISP);
+
+ /* If this assert is triggered then regenerate_window failed
+ to layout a single line. That is not supposed to be
+ possible because we impose a minimum height on the buffer
+ and override vertical clip when we are in here. */
+ /* #### Ah, but it is because the window may temporarily
+ exist but not have any lines at all if the minibuffer is
+ real big. Look into that situation better. */
+ if (!Dynarr_length (internal_cache))
+ {
+ if (old_lb == -1 && low_bound == -1)
+ {
+ updating_line_start_cache = 0;
+ w->line_cache_validation_override--;
+ return;
+ }
+
+ assert (Dynarr_length (internal_cache));
+ }
+ assert (startp == Dynarr_atp (internal_cache, 0)->start);
+
+ ic_elt = Dynarr_length (internal_cache) - 1;
+ if (low_bound != -1)
+ {
+ while (ic_elt >= 0)
+ {
+ if (Dynarr_atp (internal_cache, ic_elt)->start < old_lb)
+ break;
+ else
+ ic_elt--;
+ }
+ }
+ assert (ic_elt >= 0);
+
+ new_startp = Dynarr_atp (internal_cache, ic_elt)->end + 1;
+
+ /*
+ * Handle invisible text properly:
+ * If the last line we're inserting has the same end as the
+ * line before which it will be added, merge the two lines.
+ */
+ if (Dynarr_length (cache) &&
+ Dynarr_atp (internal_cache, ic_elt)->end ==
+ Dynarr_atp (cache, marker)->end)
+ {
+ Dynarr_atp (cache, marker)->start
+ = Dynarr_atp (internal_cache, ic_elt)->start;
+ Dynarr_atp (cache, marker)->height
+ = Dynarr_atp (internal_cache, ic_elt)->height;
+ ic_elt--;
+ }
+
+ if (ic_elt >= 0) /* we still have lines to add.. */
+ {
+ Dynarr_insert_many (cache, Dynarr_atp (internal_cache, 0),
+ ic_elt + 1, marker);
+ marker += (ic_elt + 1);
+ }
+
+ if (startp < low_bound || low_bound == -1)
+ low_bound = startp;
+ startp = new_startp;
+ if (startp > BUF_ZV (b))
+ {
+ updating_line_start_cache = 0;
+ w->line_cache_validation_override--;
+ return;
+ }
+ }
+ }
+
+ assert (Dynarr_length (cache));
+ assert (from >= low_bound);
+
+ /* Readjust the high_bound to account for any changes made while
+ correcting the low_bound. */
+ high_bound = Dynarr_atp (cache, Dynarr_length (cache) - 1)->end;
+
+ if (to > high_bound)
+ {
+ Bufpos startp = Dynarr_atp (cache, Dynarr_length (cache) - 1)->end + 1;
+
+ do
+ {
+ regenerate_window (w, startp, point, CMOTION_DISP);
+ update_internal_cache_list (w, CMOTION_DISP);
+
+ /* See comment above about regenerate_window failing. */
+ assert (Dynarr_length (internal_cache));
+
+ Dynarr_add_many (cache, Dynarr_atp (internal_cache, 0),
+ Dynarr_length (internal_cache));
+ high_bound = Dynarr_atp (cache, Dynarr_length (cache) - 1)->end;
+ startp = high_bound + 1;
+ }
+ while (to > high_bound);
+ }
+
+ updating_line_start_cache = 0;
+ w->line_cache_validation_override--;
+ assert (to <= high_bound);
+}
+
+\f
+/* Given x and y coordinates in characters, relative to a window,
+ return the pixel location corresponding to those coordinates. The
+ pixel location returned is the center of the given character
+ position. The pixel values are generated relative to the window,
+ not the frame.
+
+ The modeline is considered to be part of the window. */
+
+void
+glyph_to_pixel_translation (struct window *w, int char_x, int char_y,
+ int *pix_x, int *pix_y)
+{
+ display_line_dynarr *dla = window_display_lines (w, CURRENT_DISP);
+ int num_disp_lines, modeline;
+ Lisp_Object window;
+ int defheight, defwidth;
+
+ XSETWINDOW (window, w);
+ default_face_height_and_width (window, &defheight, &defwidth);
+
+ /* If we get a bogus value indicating somewhere above or to the left of
+ the window, use the first window line or character position
+ instead. */
+ if (char_y < 0)
+ char_y = 0;
+ if (char_x < 0)
+ char_x = 0;
+
+ num_disp_lines = Dynarr_length (dla);
+ modeline = 0;
+ if (num_disp_lines)
+ {
+ if (Dynarr_atp (dla, 0)->modeline)
+ {
+ num_disp_lines--;
+ modeline = 1;
+ }
+ }
+
+ /* First check if the y position intersects the display lines. */
+ if (char_y < num_disp_lines)
+ {
+ struct display_line *dl = Dynarr_atp (dla, char_y + modeline);
+ struct display_block *db = get_display_block_from_line (dl, TEXT);
+
+ *pix_y = (dl->ypos - dl->ascent +
+ ((unsigned int) (dl->ascent + dl->descent - dl->clip) >> 1));
+
+ if (char_x < Dynarr_length (db->runes))
+ {
+ struct rune *rb = Dynarr_atp (db->runes, char_x);
+
+ *pix_x = rb->xpos + (rb->width >> 1);
+ }
+ else
+ {
+ int last_rune = Dynarr_length (db->runes) - 1;
+ struct rune *rb = Dynarr_atp (db->runes, last_rune);
+
+ char_x -= last_rune;
+
+ *pix_x = rb->xpos + rb->width;
+ *pix_x += ((char_x - 1) * defwidth);
+ *pix_x += (defwidth >> 1);
+ }
+ }
+ else
+ {
+ /* It didn't intersect, so extrapolate. #### For now, we include the
+ modeline in this since we don't have true character positions in
+ it. */
+
+ if (!Dynarr_length (w->face_cachels))
+ reset_face_cachels (w);
+
+ char_y -= num_disp_lines;
+
+ if (Dynarr_length (dla))
+ {
+ struct display_line *dl = Dynarr_atp (dla, Dynarr_length (dla) - 1);
+ *pix_y = dl->ypos + dl->descent - dl->clip;
+ }
+ else
+ *pix_y = WINDOW_TEXT_TOP (w);
+
+ *pix_y += (char_y * defheight);
+ *pix_y += (defheight >> 1);
+
+ *pix_x = WINDOW_TEXT_LEFT (w);
+ /* Don't adjust by one because this is still the unadjusted value. */
+ *pix_x += (char_x * defwidth);
+ *pix_x += (defwidth >> 1);
+ }
+
+ if (*pix_x > w->pixel_left + w->pixel_width)
+ *pix_x = w->pixel_left + w->pixel_width;
+ if (*pix_y > w->pixel_top + w->pixel_height)
+ *pix_y = w->pixel_top + w->pixel_height;
+
+ *pix_x -= w->pixel_left;
+ *pix_y -= w->pixel_top;
+}
+
+/* Given a display line and a position, determine if there is a glyph
+ there and return information about it if there is. */
+
+static void
+get_position_object (struct display_line *dl, Lisp_Object *obj1,
+ Lisp_Object *obj2, int x_coord, int *low_x_coord,
+ int *high_x_coord)
+{
+ struct display_block *db;
+ int elt;
+ int block =
+ get_next_display_block (dl->bounds, dl->display_blocks, x_coord, 0);
+
+ /* We use get_next_display_block to get the actual display block
+ that would be displayed at x_coord. */
+
+ if (block == NO_BLOCK)
+ return;
+ else
+ db = Dynarr_atp (dl->display_blocks, block);
+
+ for (elt = 0; elt < Dynarr_length (db->runes); elt++)
+ {
+ struct rune *rb = Dynarr_atp (db->runes, elt);
+
+ if (rb->xpos <= x_coord && x_coord < (rb->xpos + rb->width))
+ {
+ if (rb->type == RUNE_DGLYPH)
+ {
+ *obj1 = rb->object.dglyph.glyph;
+ *obj2 = rb->object.dglyph.extent;
+ }
+ else
+ {
+ *obj1 = Qnil;
+ *obj2 = Qnil;
+ }
+
+ if (low_x_coord)
+ *low_x_coord = rb->xpos;
+ if (high_x_coord)
+ *high_x_coord = rb->xpos + rb->width;
+
+ return;
+ }
+ }
+}
+
+#define UPDATE_CACHE_RETURN \
+ do { \
+ d->pixel_to_glyph_cache.valid = 1; \
+ d->pixel_to_glyph_cache.low_x_coord = low_x_coord; \
+ d->pixel_to_glyph_cache.high_x_coord = high_x_coord; \
+ d->pixel_to_glyph_cache.low_y_coord = low_y_coord; \
+ d->pixel_to_glyph_cache.high_y_coord = high_y_coord; \
+ d->pixel_to_glyph_cache.frame = f; \
+ d->pixel_to_glyph_cache.col = *col; \
+ d->pixel_to_glyph_cache.row = *row; \
+ d->pixel_to_glyph_cache.obj_x = *obj_x; \
+ d->pixel_to_glyph_cache.obj_y = *obj_y; \
+ d->pixel_to_glyph_cache.w = *w; \
+ d->pixel_to_glyph_cache.bufpos = *bufpos; \
+ d->pixel_to_glyph_cache.closest = *closest; \
+ d->pixel_to_glyph_cache.modeline_closest = *modeline_closest; \
+ d->pixel_to_glyph_cache.obj1 = *obj1; \
+ d->pixel_to_glyph_cache.obj2 = *obj2; \
+ d->pixel_to_glyph_cache.retval = position; \
+ RETURN__ position; \
+ } while (0)
+
+/* Given x and y coordinates in pixels relative to a frame, return
+ information about what is located under those coordinates.
+
+ The return value will be one of:
+
+ OVER_TOOLBAR: over one of the 4 frame toolbars
+ OVER_MODELINE: over a modeline
+ OVER_BORDER: over an internal border
+ OVER_NOTHING: over the text area, but not over text
+ OVER_OUTSIDE: outside of the frame border
+ OVER_TEXT: over text in the text area
+
+ OBJ1 is one of
+
+ -- a toolbar button
+ -- a glyph
+ -- nil if the coordinates are not over a glyph or a toolbar button.
+
+ OBJ2 is one of
+
+ -- an extent, if the coordinates are over a glyph in the text area
+ -- nil otherwise.
+
+ If the coordinates are over a glyph, OBJ_X and OBJ_Y give the
+ equivalent coordinates relative to the upper-left corner of the glyph.
+
+ If the coordinates are over a character, OBJ_X and OBJ_Y give the
+ equivalent coordinates relative to the upper-left corner of the character.
+
+ Otherwise, OBJ_X and OBJ_Y are undefined.
+ */
+
+int
+pixel_to_glyph_translation (struct frame *f, int x_coord, int y_coord,
+ int *col, int *row, int *obj_x, int *obj_y,
+ struct window **w, Bufpos *bufpos,
+ Bufpos *closest, Charcount *modeline_closest,
+ Lisp_Object *obj1, Lisp_Object *obj2)
+{
+ struct device *d;
+ struct pixel_to_glyph_translation_cache *cache;
+ Lisp_Object window;
+ int frm_left, frm_right, frm_top, frm_bottom;
+ int low_x_coord, high_x_coord, low_y_coord, high_y_coord;
+ int position = OVER_NOTHING;
+ int device_check_failed = 0;
+ display_line_dynarr *dla;
+
+ /* This is a safety valve in case this got called with a frame in
+ the middle of being deleted. */
+ if (!DEVICEP (f->device) || !DEVICE_LIVE_P (XDEVICE (f->device)))
+ {
+ device_check_failed = 1;
+ d = NULL, cache = NULL; /* Warning suppression */
+ }
+ else
+ {
+ d = XDEVICE (f->device);
+ cache = &d->pixel_to_glyph_cache;
+ }
+
+ if (!device_check_failed
+ && cache->valid
+ && cache->frame == f
+ && cache->low_x_coord <= x_coord
+ && cache->high_x_coord > x_coord
+ && cache->low_y_coord <= y_coord
+ && cache->high_y_coord > y_coord)
+ {
+ *col = cache->col;
+ *row = cache->row;
+ *obj_x = cache->obj_x;
+ *obj_y = cache->obj_y;
+ *w = cache->w;
+ *bufpos = cache->bufpos;
+ *closest = cache->closest;
+ *modeline_closest = cache->modeline_closest;
+ *obj1 = cache->obj1;
+ *obj2 = cache->obj2;
+
+ return cache->retval;
+ }
+ else
+ {
+ *col = 0;
+ *row = 0;
+ *obj_x = 0;
+ *obj_y = 0;
+ *w = 0;
+ *bufpos = 0;
+ *closest = 0;
+ *modeline_closest = -1;
+ *obj1 = Qnil;
+ *obj2 = Qnil;
+
+ low_x_coord = x_coord;
+ high_x_coord = x_coord + 1;
+ low_y_coord = y_coord;
+ high_y_coord = y_coord + 1;
+ }
+
+ if (device_check_failed)
+ return OVER_NOTHING;
+
+ frm_left = FRAME_LEFT_BORDER_END (f);
+ frm_right = FRAME_RIGHT_BORDER_START (f);
+ frm_top = FRAME_TOP_BORDER_END (f);
+ frm_bottom = FRAME_BOTTOM_BORDER_START (f);
+
+ /* Check if the mouse is outside of the text area actually used by
+ redisplay. */
+ if (y_coord < frm_top)
+ {
+ if (y_coord >= FRAME_TOP_BORDER_START (f))
+ {
+ low_y_coord = FRAME_TOP_BORDER_START (f);
+ high_y_coord = frm_top;
+ position = OVER_BORDER;
+ }
+ else if (y_coord >= 0)
+ {
+ low_y_coord = 0;
+ high_y_coord = FRAME_TOP_BORDER_START (f);
+ position = OVER_TOOLBAR;
+ }
+ else
+ {
+ low_y_coord = y_coord;
+ high_y_coord = 0;
+ position = OVER_OUTSIDE;
+ }
+ }
+ else if (y_coord >= frm_bottom)
+ {
+ if (y_coord < FRAME_BOTTOM_BORDER_END (f))
+ {
+ low_y_coord = frm_bottom;
+ high_y_coord = FRAME_BOTTOM_BORDER_END (f);
+ position = OVER_BORDER;
+ }
+ else if (y_coord < FRAME_PIXHEIGHT (f))
+ {
+ low_y_coord = FRAME_BOTTOM_BORDER_END (f);
+ high_y_coord = FRAME_PIXHEIGHT (f);
+ position = OVER_TOOLBAR;
+ }
+ else
+ {
+ low_y_coord = FRAME_PIXHEIGHT (f);
+ high_y_coord = y_coord;
+ position = OVER_OUTSIDE;
+ }
+ }
+
+ if (position != OVER_TOOLBAR && position != OVER_BORDER)
+ {
+ if (x_coord < frm_left)
+ {
+ if (x_coord >= FRAME_LEFT_BORDER_START (f))
+ {
+ low_x_coord = FRAME_LEFT_BORDER_START (f);
+ high_x_coord = frm_left;
+ position = OVER_BORDER;
+ }
+ else if (x_coord >= 0)
+ {
+ low_x_coord = 0;
+ high_x_coord = FRAME_LEFT_BORDER_START (f);
+ position = OVER_TOOLBAR;
+ }
+ else
+ {
+ low_x_coord = x_coord;
+ high_x_coord = 0;
+ position = OVER_OUTSIDE;
+ }
+ }
+ else if (x_coord >= frm_right)
+ {
+ if (x_coord < FRAME_RIGHT_BORDER_END (f))
+ {
+ low_x_coord = frm_right;
+ high_x_coord = FRAME_RIGHT_BORDER_END (f);
+ position = OVER_BORDER;
+ }
+ else if (x_coord < FRAME_PIXWIDTH (f))
+ {
+ low_x_coord = FRAME_RIGHT_BORDER_END (f);
+ high_x_coord = FRAME_PIXWIDTH (f);
+ position = OVER_TOOLBAR;
+ }
+ else
+ {
+ low_x_coord = FRAME_PIXWIDTH (f);
+ high_x_coord = x_coord;
+ position = OVER_OUTSIDE;
+ }
+ }
+ }
+
+#ifdef HAVE_TOOLBARS
+ if (position == OVER_TOOLBAR)
+ {
+ *obj1 = toolbar_button_at_pixpos (f, x_coord, y_coord);
+ *obj2 = Qnil;
+ *w = 0;
+ UPDATE_CACHE_RETURN;
+ }
+#endif /* HAVE_TOOLBARS */
+
+ /* We still have to return the window the pointer is next to and its
+ relative y position even if it is outside the x boundary. */
+ if (x_coord < frm_left)
+ x_coord = frm_left;
+ else if (x_coord > frm_right)
+ x_coord = frm_right;
+
+ /* Same in reverse. */
+ if (y_coord < frm_top)
+ y_coord = frm_top;
+ else if (y_coord > frm_bottom)
+ y_coord = frm_bottom;
+
+ /* Find what window the given coordinates are actually in. */
+ window = f->root_window;
+ *w = find_window_by_pixel_pos (x_coord, y_coord, window);
+
+ /* If we didn't find a window, we're done. */
+ if (!*w)
+ {
+ UPDATE_CACHE_RETURN;
+ }
+ else if (position != OVER_NOTHING)
+ {
+ *closest = 0;
+ *modeline_closest = -1;
+
+ if (high_y_coord <= frm_top || high_y_coord >= frm_bottom)
+ {
+ *w = 0;
+ UPDATE_CACHE_RETURN;
+ }
+ }
+
+ /* Check if the window is a minibuffer but isn't active. */
+ if (MINI_WINDOW_P (*w) && !minibuf_level)
+ {
+ /* Must reset the window value since some callers will ignore
+ the return value if it is set. */
+ *w = 0;
+ UPDATE_CACHE_RETURN;
+ }
+
+ /* See if the point is over window vertical divider */
+ if (window_needs_vertical_divider (*w))
+ {
+ int div_x_high = WINDOW_RIGHT (*w);
+ int div_x_low = div_x_high - window_divider_width (*w);
+ int div_y_high = WINDOW_BOTTOM (*w);
+ int div_y_low = WINDOW_TOP (*w);
+
+ if (div_x_low < x_coord && x_coord <= div_x_high &&
+ div_y_low < y_coord && y_coord <= div_y_high)
+ {
+ low_x_coord = div_x_low;
+ high_x_coord = div_x_high;
+ low_y_coord = div_y_low;
+ high_y_coord = div_y_high;
+ position = OVER_V_DIVIDER;
+ UPDATE_CACHE_RETURN;
+ }
+ }
+
+ dla = window_display_lines (*w, CURRENT_DISP);
+
+ for (*row = 0; *row < Dynarr_length (dla); (*row)++)
+ {
+ int really_over_nothing = 0;
+ struct display_line *dl = Dynarr_atp (dla, *row);
+
+ if ((int) (dl->ypos - dl->ascent) <= y_coord
+ && y_coord <= (int) (dl->ypos + dl->descent))
+ {
+ int check_margin_glyphs = 0;
+ struct display_block *db = get_display_block_from_line (dl, TEXT);
+ struct rune *rb = 0;
+
+ if (x_coord < dl->bounds.left_white
+ || x_coord >= dl->bounds.right_white)
+ check_margin_glyphs = 1;
+
+ low_y_coord = dl->ypos - dl->ascent;
+ high_y_coord = dl->ypos + dl->descent + 1;
+
+ if (position == OVER_BORDER
+ || position == OVER_OUTSIDE
+ || check_margin_glyphs)
+ {
+ int x_check, left_bound;
+
+ if (check_margin_glyphs)
+ {
+ x_check = x_coord;
+ left_bound = dl->bounds.left_white;
+ }
+ else
+ {
+ x_check = high_x_coord;
+ left_bound = frm_left;
+ }
+
+ if (Dynarr_length (db->runes))
+ {
+ if (x_check <= left_bound)
+ {
+ if (dl->modeline)
+ *modeline_closest = Dynarr_atp (db->runes, 0)->bufpos;
+ else
+ *closest = Dynarr_atp (db->runes, 0)->bufpos;
+ }
+ else
+ {
+ if (dl->modeline)
+ *modeline_closest =
+ Dynarr_atp (db->runes,
+ Dynarr_length (db->runes) - 1)->bufpos;
+ else
+ *closest =
+ Dynarr_atp (db->runes,
+ Dynarr_length (db->runes) - 1)->bufpos;
+ }
+
+ if (dl->modeline)
+ *modeline_closest += dl->offset;
+ else
+ *closest += dl->offset;
+ }
+ else
+ {
+ /* #### What should be here. */
+ if (dl->modeline)
+ *modeline_closest = 0;
+ else
+ *closest = 0;
+ }
+
+ if (check_margin_glyphs)
+ {
+ if (x_coord < dl->bounds.left_in
+ || x_coord >= dl->bounds.right_in)
+ {
+ /* If we are over the outside margins then we
+ know the loop over the text block isn't going
+ to accomplish anything. So we go ahead and
+ set what information we can right here and
+ return. */
+ (*row)--;
+ *obj_y = y_coord - (dl->ypos - dl->ascent);
+ get_position_object (dl, obj1, obj2, x_coord,
+ &low_x_coord, &high_x_coord);
+
+ UPDATE_CACHE_RETURN;
+ }
+ }
+ else
+ UPDATE_CACHE_RETURN;
+ }
+
+ for (*col = 0; *col <= Dynarr_length (db->runes); (*col)++)
+ {
+ int past_end = (*col == Dynarr_length (db->runes));
+
+ if (!past_end)
+ rb = Dynarr_atp (db->runes, *col);
+
+ if (past_end ||
+ (rb->xpos <= x_coord && x_coord < rb->xpos + rb->width))
+ {
+ if (past_end)
+ {
+ (*col)--;
+ rb = Dynarr_atp (db->runes, *col);
+ }
+
+ *bufpos = rb->bufpos + dl->offset;
+ low_x_coord = rb->xpos;
+ high_x_coord = rb->xpos + rb->width;
+
+ if (rb->type == RUNE_DGLYPH)
+ {
+ int elt = *col + 1;
+
+ /* Find the first character after the glyph. */
+ while (elt < Dynarr_length (db->runes))
+ {
+ if (Dynarr_atp (db->runes, elt)->type != RUNE_DGLYPH)
+ {
+ if (dl->modeline)
+ *modeline_closest =
+ (Dynarr_atp (db->runes, elt)->bufpos +
+ dl->offset);
+ else
+ *closest =
+ (Dynarr_atp (db->runes, elt)->bufpos +
+ dl->offset);
+ break;
+ }
+
+ elt++;
+ }
+
+ /* In this case we failed to find a non-glyph
+ character so we return the last position
+ displayed on the line. */
+ if (elt == Dynarr_length (db->runes))
+ {
+ if (dl->modeline)
+ *modeline_closest = dl->end_bufpos + dl->offset;
+ else
+ *closest = dl->end_bufpos + dl->offset;
+ really_over_nothing = 1;
+ }
+ }
+ else
+ {
+ if (dl->modeline)
+ *modeline_closest = rb->bufpos + dl->offset;
+ else
+ *closest = rb->bufpos + dl->offset;
+ }
+
+ if (dl->modeline)
+ {
+ *row = window_displayed_height (*w);
+
+ if (position == OVER_NOTHING)
+ position = OVER_MODELINE;
+
+ if (rb->type == RUNE_DGLYPH)
+ {
+ *obj1 = rb->object.dglyph.glyph;
+ *obj2 = rb->object.dglyph.extent;
+ }
+ else if (rb->type == RUNE_CHAR)
+ {
+ *obj1 = Qnil;
+ *obj2 = Qnil;
+ }
+ else
+ {
+ *obj1 = Qnil;
+ *obj2 = Qnil;
+ }
+
+ UPDATE_CACHE_RETURN;
+ }
+ else if (past_end
+ || (rb->type == RUNE_CHAR
+ && rb->object.chr.ch == '\n'))
+ {
+ (*row)--;
+ /* At this point we may have glyphs in the right
+ inside margin. */
+ if (check_margin_glyphs)
+ get_position_object (dl, obj1, obj2, x_coord,
+ &low_x_coord, &high_x_coord);
+ UPDATE_CACHE_RETURN;
+ }
+ else
+ {
+ (*row)--;
+ if (rb->type == RUNE_DGLYPH)
+ {
+ *obj1 = rb->object.dglyph.glyph;
+ *obj2 = rb->object.dglyph.extent;
+ }
+ else if (rb->type == RUNE_CHAR)
+ {
+ *obj1 = Qnil;
+ *obj2 = Qnil;
+ }
+ else
+ {
+ *obj1 = Qnil;
+ *obj2 = Qnil;
+ }
+
+ *obj_x = x_coord - rb->xpos;
+ *obj_y = y_coord - (dl->ypos - dl->ascent);
+
+ /* At this point we may have glyphs in the left
+ inside margin. */
+ if (check_margin_glyphs)
+ get_position_object (dl, obj1, obj2, x_coord, 0, 0);
+
+ if (position == OVER_NOTHING && !really_over_nothing)
+ position = OVER_TEXT;
+
+ UPDATE_CACHE_RETURN;
+ }
+ }
+ }
+ }
+ }
+
+ *row = Dynarr_length (dla) - 1;
+ if (FRAME_WIN_P (f))
+ {
+ int bot_elt = Dynarr_length (dla) - 1;
+
+ if (bot_elt >= 0)
+ {
+ struct display_line *dl = Dynarr_atp (dla, bot_elt);
+ int adj_area = y_coord - (dl->ypos + dl->descent);
+ Lisp_Object lwin;
+ int defheight;
+
+ XSETWINDOW (lwin, *w);
+ default_face_height_and_width (lwin, 0, &defheight);
+
+ *row += (adj_area / defheight);
+ }
+ }
+
+ /* #### This should be checked out some more to determine what
+ should really be going on. */
+ if (!MARKERP ((*w)->start[CURRENT_DISP]))
+ *closest = 0;
+ else
+ *closest = end_of_last_line (*w,
+ marker_position ((*w)->start[CURRENT_DISP]));
+ *col = 0;
+ UPDATE_CACHE_RETURN;
+}
+#undef UPDATE_CACHE_RETURN
+
+\f
+/***************************************************************************/
+/* */
+/* Lisp functions */
+/* */
+/***************************************************************************/
+
+DEFUN ("redisplay-echo-area", Fredisplay_echo_area, 0, 0, 0, /*
+Ensure that all minibuffers are correctly showing the echo area.
+*/
+ ())
+{
+ 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) && FRAME_HAS_MINIBUF_P (f))
+ {
+ Lisp_Object window = FRAME_MINIBUF_WINDOW (f);
+ /*
+ * If the frame size has changed, there may be random
+ * chud on the screen left from previous messages
+ * because redisplay_frame hasn't been called yet.
+ * Clear the screen to get rid of the potential mess.
+ */
+ if (f->echo_area_garbaged)
+ {
+ DEVMETH (d, clear_frame, (f));
+ f->echo_area_garbaged = 0;
+ }
+ redisplay_window (window, 0);
+ call_redisplay_end_triggers (XWINDOW (window), 0);
+ }
+ }
+
+ /* 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;
+}
+
+static Lisp_Object
+restore_disable_preemption_value (Lisp_Object value)
+{
+ disable_preemption = XINT (value);
+ return Qnil;
+}
+
+DEFUN ("redraw-frame", Fredraw_frame, 0, 2, 0, /*
+Clear frame FRAME and output again what is supposed to appear on it.
+FRAME defaults to the selected frame if omitted.
+Normally, redisplay is preempted as normal if input arrives. However,
+if optional second arg NO-PREEMPT is non-nil, redisplay will not stop for
+input and is guaranteed to proceed to completion.
+*/
+ (frame, no_preempt))
+{
+ struct frame *f = decode_frame (frame);
+ int count = specpdl_depth ();
+
+ if (!NILP (no_preempt))
+ {
+ record_unwind_protect (restore_disable_preemption_value,
+ make_int (disable_preemption));
+ disable_preemption++;
+ }
+
+ f->clear = 1;
+ redisplay_frame (f, 1);
+
+ return unbind_to (count, Qnil);
+}
+
+DEFUN ("redisplay-frame", Fredisplay_frame, 0, 2, 0, /*
+Ensure that FRAME's contents are correctly displayed.
+This differs from `redraw-frame' in that it only redraws what needs to
+be updated, as opposed to unconditionally clearing and redrawing
+the frame.
+FRAME defaults to the selected frame if omitted.
+Normally, redisplay is preempted as normal if input arrives. However,
+if optional second arg NO-PREEMPT is non-nil, redisplay will not stop for
+input and is guaranteed to proceed to completion.
+*/
+ (frame, no_preempt))
+{
+ struct frame *f = decode_frame (frame);
+ int count = specpdl_depth ();
+
+ if (!NILP (no_preempt))
+ {
+ record_unwind_protect (restore_disable_preemption_value,
+ make_int (disable_preemption));
+ disable_preemption++;
+ }
+
+ redisplay_frame (f, 1);
+
+ return unbind_to (count, Qnil);
+}
+
+DEFUN ("redraw-device", Fredraw_device, 0, 2, 0, /*
+Clear device DEVICE and output again what is supposed to appear on it.
+DEVICE defaults to the selected device if omitted.
+Normally, redisplay is preempted as normal if input arrives. However,
+if optional second arg NO-PREEMPT is non-nil, redisplay will not stop for
+input and is guaranteed to proceed to completion.
+*/
+ (device, no_preempt))
+{
+ struct device *d = decode_device (device);
+ Lisp_Object frmcons;
+ int count = specpdl_depth ();
+
+ if (!NILP (no_preempt))
+ {
+ record_unwind_protect (restore_disable_preemption_value,
+ make_int (disable_preemption));
+ disable_preemption++;
+ }
+
+ DEVICE_FRAME_LOOP (frmcons, d)
+ {
+ XFRAME (XCAR (frmcons))->clear = 1;
+ }
+ redisplay_device (d);
+
+ return unbind_to (count, Qnil);
+}
+
+DEFUN ("redisplay-device", Fredisplay_device, 0, 2, 0, /*
+Ensure that DEVICE's contents are correctly displayed.
+This differs from `redraw-device' in that it only redraws what needs to
+be updated, as opposed to unconditionally clearing and redrawing
+the device.
+DEVICE defaults to the selected device if omitted.
+Normally, redisplay is preempted as normal if input arrives. However,
+if optional second arg NO-PREEMPT is non-nil, redisplay will not stop for
+input and is guaranteed to proceed to completion.
+*/
+ (device, no_preempt))
+{
+ struct device *d = decode_device (device);
+ int count = specpdl_depth ();
+
+ if (!NILP (no_preempt))
+ {
+ record_unwind_protect (restore_disable_preemption_value,
+ make_int (disable_preemption));
+ disable_preemption++;
+ }
+
+ redisplay_device (d);
+
+ return unbind_to (count, Qnil);
+}
+
+/* Big lie. Big lie. This will force all modelines to be updated
+ regardless if the all flag is set or not. It remains in existence
+ solely for backwards compatibility. */
+DEFUN ("redraw-modeline", Fredraw_modeline, 0, 1, 0, /*
+Force the modeline of the current buffer to be redisplayed.
+With optional non-nil ALL, force redisplay of all modelines.
+*/
+ (all))
+{
+ MARK_MODELINE_CHANGED;
+ return Qnil;
+}
+
+DEFUN ("force-cursor-redisplay", Fforce_cursor_redisplay, 0, 1, 0, /*
+Force an immediate update of the cursor on FRAME.
+FRAME defaults to the selected frame if omitted.
+*/
+ (frame))
+{
+ redisplay_redraw_cursor (decode_frame (frame), 1);
+ return Qnil;
+}
+
+\f
+/***************************************************************************/
+/* */
+/* Lisp-variable change triggers */
+/* */
+/***************************************************************************/
+
+static void
+margin_width_changed_in_frame (Lisp_Object specifier, struct frame *f,
+ Lisp_Object oldval)
+{
+ /* Nothing to be done? */
+}
+
+int
+redisplay_variable_changed (Lisp_Object sym, Lisp_Object *val,
+ Lisp_Object in_object, int flags)
+{
+ /* #### clip_changed should really be renamed something like
+ global_redisplay_change. */
+ MARK_CLIP_CHANGED;
+ return 0;
+}
+
+void
+redisplay_glyph_changed (Lisp_Object glyph, Lisp_Object property,
+ Lisp_Object locale)
+{
+ if (WINDOWP (locale))
+ {
+ struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (locale)));
+ MARK_FRAME_GLYPHS_CHANGED (f);
+ }
+ else if (FRAMEP (locale))
+ {
+ struct frame *f = XFRAME (locale);
+ MARK_FRAME_GLYPHS_CHANGED (f);
+ }
+ else if (DEVICEP (locale))
+ {
+ Lisp_Object frmcons;
+ DEVICE_FRAME_LOOP (frmcons, XDEVICE (locale))
+ {
+ struct frame *f = XFRAME (XCAR (frmcons));
+ MARK_FRAME_GLYPHS_CHANGED (f);
+ }
+ }
+ else if (CONSOLEP (locale))
+ {
+ Lisp_Object frmcons, devcons;
+ CONSOLE_FRAME_LOOP_NO_BREAK (frmcons, devcons, XCONSOLE (locale))
+ {
+ struct frame *f = XFRAME (XCAR (frmcons));
+ MARK_FRAME_GLYPHS_CHANGED (f);
+ }
+ }
+ else /* global or buffer */
+ {
+ Lisp_Object frmcons, devcons, concons;
+ FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
+ {
+ struct frame *f = XFRAME (XCAR (frmcons));
+ MARK_FRAME_GLYPHS_CHANGED (f);
+ }
+ }
+}
+
+static void
+text_cursor_visible_p_changed (Lisp_Object specifier, struct window *w,
+ Lisp_Object oldval)
+{
+ if (XFRAME (w->frame)->init_finished)
+ Fforce_cursor_redisplay (w->frame);
+}
+
+#ifdef MEMORY_USAGE_STATS
+
+\f
+/***************************************************************************/
+/* */
+/* memory usage computation */
+/* */
+/***************************************************************************/
+
+static int
+compute_rune_dynarr_usage (rune_dynarr *dyn, struct overhead_stats *ovstats)
+{
+ return dyn ? Dynarr_memory_usage (dyn, ovstats) : 0;
+}
+
+static int
+compute_display_block_dynarr_usage (display_block_dynarr *dyn,
+ struct overhead_stats *ovstats)
+{
+ int total, i;
+
+ if (!dyn)
+ return 0;
+
+ total = Dynarr_memory_usage (dyn, ovstats);
+ for (i = 0; i < Dynarr_largest (dyn); i++)
+ total += compute_rune_dynarr_usage (Dynarr_at (dyn, i).runes, ovstats);
+
+ return total;
+}
+
+static int
+compute_glyph_block_dynarr_usage (glyph_block_dynarr *dyn,
+ struct overhead_stats *ovstats)
+{
+ return dyn ? Dynarr_memory_usage (dyn, ovstats) : 0;
+}
+
+int
+compute_display_line_dynarr_usage (display_line_dynarr *dyn,
+ struct overhead_stats *ovstats)
+{
+ int total, i;
+
+ if (!dyn)
+ return 0;
+
+ total = Dynarr_memory_usage (dyn, ovstats);
+ for (i = 0; i < Dynarr_largest (dyn); i++)
+ {
+ struct display_line *dl = &Dynarr_at (dyn, i);
+ total += compute_display_block_dynarr_usage(dl->display_blocks, ovstats);
+ total += compute_glyph_block_dynarr_usage (dl->left_glyphs, ovstats);
+ total += compute_glyph_block_dynarr_usage (dl->right_glyphs, ovstats);
+ }
+
+ return total;
+}
+
+int
+compute_line_start_cache_dynarr_usage (line_start_cache_dynarr *dyn,
+ struct overhead_stats *ovstats)
+{
+ return dyn ? Dynarr_memory_usage (dyn, ovstats) : 0;
+}
+
+#endif /* MEMORY_USAGE_STATS */
+
+\f
+/***************************************************************************/
+/* */
+/* initialization */
+/* */
+/***************************************************************************/
+
+void
+init_redisplay (void)
+{
+ disable_preemption = 0;
+ preemption_count = 0;
+ max_preempts = INIT_MAX_PREEMPTS;
+
+ 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);
+ }
+
+ /* window system is nil when in -batch mode */
+ if (!initialized || noninteractive)
+ return;
+
+ /* If the user wants to use a window system, we shouldn't bother
+ initializing the terminal. This is especially important when the
+ terminal is so dumb that emacs gives up before and doesn't bother
+ using the window system.
+
+ If the DISPLAY environment variable is set, try to use X, and die
+ with an error message if that doesn't work. */
+
+#ifdef HAVE_X_WINDOWS
+ if (!strcmp (display_use, "x"))
+ {
+ /* Some stuff checks this way early. */
+ Vwindow_system = Qx;
+ Vinitial_window_system = Qx;
+ return;
+ }
+#endif /* HAVE_X_WINDOWS */
+
+#ifdef HAVE_MS_WINDOWS
+ if (!strcmp (display_use, "mswindows"))
+ {
+ /* Some stuff checks this way early. */
+ Vwindow_system = Qmswindows;
+ Vinitial_window_system = Qmswindows;
+ return;
+ }
+#endif /* HAVE_MS_WINDOWS */
+
+#ifdef HAVE_TTY
+ /* If no window system has been specified, try to use the terminal. */
+ if (!isatty (0))
+ {
+ stderr_out ("XEmacs: standard input is not a tty\n");
+ exit (1);
+ }
+
+ /* Look at the TERM variable */
+ if (!getenv ("TERM"))
+ {
+ stderr_out ("Please set the environment variable TERM; see tset(1).\n");
+ exit (1);
+ }
+
+ Vinitial_window_system = Qtty;
+ return;
+#else /* not HAVE_TTY */
+ /* No DISPLAY specified, and no TTY support. */
+ stderr_out ("XEmacs: Cannot open display.\n\
+Please set the environmental variable DISPLAY to an appropriate value.\n");
+ exit (1);
+#endif
+ /* Unreached. */
+}
+
+void
+syms_of_redisplay (void)
+{
+ defsymbol (&Qcursor_in_echo_area, "cursor-in-echo-area");
+#ifndef INHIBIT_REDISPLAY_HOOKS
+ defsymbol (&Qpre_redisplay_hook, "pre-redisplay-hook");
+ defsymbol (&Qpost_redisplay_hook, "post-redisplay-hook");
+#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");
+
+ DEFSUBR (Fredisplay_echo_area);
+ DEFSUBR (Fredraw_frame);
+ DEFSUBR (Fredisplay_frame);
+ DEFSUBR (Fredraw_device);
+ DEFSUBR (Fredisplay_device);
+ DEFSUBR (Fredraw_modeline);
+ DEFSUBR (Fforce_cursor_redisplay);
+}
+
+void
+vars_of_redisplay (void)
+{
+#if 0
+ staticpro (&last_arrow_position);
+ staticpro (&last_arrow_string);
+ last_arrow_position = Qnil;
+ 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
+line start cache.
+*/ );
+ cache_adjustment = 2;
+
+ DEFVAR_INT_MAGIC ("pixel-vertical-clip-threshold", &vertical_clip /*
+Minimum pixel height for clipped bottom display line.
+A clipped line shorter than this won't be displayed.
+*/ ,
+ redisplay_variable_changed);
+ vertical_clip = 5;
+
+ DEFVAR_INT_MAGIC ("pixel-horizontal-clip-threshold", &horizontal_clip /*
+Minimum visible area for clipped glyphs at right boundary.
+Clipped glyphs shorter than this won't be displayed.
+Only pixmap glyph instances are currently allowed to be clipped.
+*/ ,
+ redisplay_variable_changed);
+ horizontal_clip = 5;
+
+ DEFVAR_LISP ("global-mode-string", &Vglobal_mode_string /*
+String displayed by modeline-format's "%m" specification.
+*/ );
+ Vglobal_mode_string = Qnil;
+
+ DEFVAR_LISP_MAGIC ("overlay-arrow-position", &Voverlay_arrow_position /*
+Marker for where to display an arrow on top of the buffer text.
+This must be the beginning of a line in order to work.
+See also `overlay-arrow-string'.
+*/ , redisplay_variable_changed);
+ Voverlay_arrow_position = Qnil;
+
+ DEFVAR_LISP_MAGIC ("overlay-arrow-string", &Voverlay_arrow_string /*
+String to display as an arrow. See also `overlay-arrow-position'.
+*/ ,
+ redisplay_variable_changed);
+ Voverlay_arrow_string = Qnil;
+
+ DEFVAR_INT ("scroll-step", &scroll_step /*
+*The number of lines to try scrolling a window by when point moves out.
+If that fails to bring point back on frame, point is centered instead.
+If this is zero, point is always centered after it moves off screen.
+*/ );
+ scroll_step = 0;
+
+ DEFVAR_INT ("scroll-conservatively", &scroll_conservatively /*
+*Scroll up to this many lines, to bring point back on screen.
+*/ );
+ scroll_conservatively = 0;
+
+ DEFVAR_BOOL_MAGIC ("truncate-partial-width-windows",
+ &truncate_partial_width_windows /*
+*Non-nil means truncate lines in all windows less than full frame wide.
+*/ ,
+ redisplay_variable_changed);
+ truncate_partial_width_windows = 1;
+
+ DEFVAR_BOOL ("visible-bell", &visible_bell /*
+*Non-nil means try to flash the frame to represent a bell.
+*/ );
+ visible_bell = 0;
+
+ DEFVAR_BOOL ("no-redraw-on-reenter", &no_redraw_on_reenter /*
+*Non-nil means no need to redraw entire frame after suspending.
+A non-nil value is useful if the terminal can automatically preserve
+Emacs's frame display when you reenter Emacs.
+It is up to you to set this variable if your terminal can do that.
+*/ );
+ no_redraw_on_reenter = 0;
+
+ DEFVAR_LISP ("window-system", &Vwindow_system /*
+A symbol naming the window-system under which Emacs is running,
+such as `x', or nil if emacs is running on an ordinary terminal.
+
+Do not use this variable, except for GNU Emacs compatibility, as it
+gives wrong values in a multi-device environment. Use `console-type'
+instead.
+*/ );
+ Vwindow_system = Qnil;
+
+ /* #### Temporary shit until window-system is eliminated. */
+ DEFVAR_LISP ("initial-window-system", &Vinitial_window_system /*
+DON'T TOUCH
+*/ );
+ Vinitial_window_system = Qnil;
+
+ DEFVAR_BOOL ("cursor-in-echo-area", &cursor_in_echo_area /*
+Non-nil means put cursor in minibuffer, at end of any message there.
+*/ );
+ cursor_in_echo_area = 0;
+
+ /* #### Shouldn't this be generalized as follows:
+
+ if nil, use block cursor.
+ if a number, use a bar cursor of that width.
+ Otherwise, use a 1-pixel bar cursor.
+
+ #### Or better yet, this variable should be trashed entirely
+ (use a Lisp-magic variable to maintain compatibility)
+ and a specifier `cursor-shape' added, which allows a block
+ cursor, a bar cursor, a flashing block or bar cursor,
+ maybe a caret cursor, etc. */
+
+ DEFVAR_LISP ("bar-cursor", &Vbar_cursor /*
+Use vertical bar cursor if non-nil. If t width is 1 pixel, otherwise 2.
+*/ );
+ Vbar_cursor = Qnil;
+
+#ifndef INHIBIT_REDISPLAY_HOOKS
+ xxDEFVAR_LISP ("pre-redisplay-hook", &Vpre_redisplay_hook /*
+Function or functions to run before every redisplay.
+Functions on this hook must be careful to avoid signalling errors!
+*/ );
+ Vpre_redisplay_hook = Qnil;
+
+ xxDEFVAR_LISP ("post-redisplay-hook", &Vpost_redisplay_hook /*
+Function or functions to run after every redisplay.
+Functions on this hook must be careful to avoid signalling errors!
+*/ );
+ Vpost_redisplay_hook = Qnil;
+#endif /* INHIBIT_REDISPLAY_HOOKS */
+
+ DEFVAR_INT ("display-warning-tick", &display_warning_tick /*
+Bump this to tell the C code to call `display-warning-buffer'
+at next redisplay. You should not normally change this; the function
+`display-warning' automatically does this at appropriate times.
+*/ );
+ display_warning_tick = 0;
+
+ DEFVAR_BOOL ("inhibit-warning-display", &inhibit_warning_display /*
+Non-nil means inhibit display of warning messages.
+You should *bind* this, not set it. Any pending warning messages
+will be displayed when the binding no longer applies.
+*/ );
+ /* reset to 0 by startup.el after the splash screen has displayed.
+ This way, the warnings don't obliterate the splash screen. */
+ inhibit_warning_display = 1;
+
+ DEFVAR_LISP ("window-size-change-functions",
+ &Vwindow_size_change_functions /*
+Not currently implemented.
+Functions called before redisplay, if window sizes have changed.
+The value should be a list of functions that take one argument.
+Just before redisplay, for each frame, if any of its windows have changed
+size since the last redisplay, or have been split or deleted,
+all the functions in the list are called, with the frame as argument.
+*/ );
+ Vwindow_size_change_functions = Qnil;
+
+ DEFVAR_LISP ("window-scroll-functions", &Vwindow_scroll_functions /*
+Not currently implemented.
+Functions to call before redisplaying a window with scrolling.
+Each function is called with two arguments, the window
+and its new display-start position. Note that the value of `window-end'
+is not valid when these functions are called.
+*/ );
+ Vwindow_scroll_functions = Qnil;
+
+ DEFVAR_LISP ("redisplay-end-trigger-functions",
+ &Vredisplay_end_trigger_functions /*
+See `set-window-redisplay-end-trigger'.
+*/ );
+ Vredisplay_end_trigger_functions = Qnil;
+
+ DEFVAR_BOOL ("column-number-start-at-one", &column_number_start_at_one /*
+*Non-nil means column display number starts at 1.
+*/ );
+ column_number_start_at_one = 0;
+}
+
+void
+specifier_vars_of_redisplay (void)
+{
+ DEFVAR_SPECIFIER ("left-margin-width", &Vleft_margin_width /*
+*Width of left margin.
+This is a specifier; use `set-specifier' to change it.
+*/ );
+ 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),
+ some_window_value_changed,
+ slot_offset (struct frame, left_margin_width),
+ margin_width_changed_in_frame);
+
+ DEFVAR_SPECIFIER ("right-margin-width", &Vright_margin_width /*
+*Width of right margin.
+This is a specifier; use `set-specifier' to change it.
+*/ );
+ 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),
+ some_window_value_changed,
+ slot_offset (struct frame, right_margin_width),
+ margin_width_changed_in_frame);
+
+ DEFVAR_SPECIFIER ("minimum-line-ascent", &Vminimum_line_ascent /*
+*Minimum ascent height of lines.
+This is a specifier; use `set-specifier' to change it.
+*/ );
+ 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),
+ some_window_value_changed,
+ 0, 0);
+
+ DEFVAR_SPECIFIER ("minimum-line-descent", &Vminimum_line_descent /*
+*Minimum descent height of lines.
+This is a specifier; use `set-specifier' to change it.
+*/ );
+ 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),
+ some_window_value_changed,
+ 0, 0);
+
+ DEFVAR_SPECIFIER ("use-left-overflow", &Vuse_left_overflow /*
+*Non-nil means use the left outside margin as extra whitespace when
+displaying 'whitespace or 'inside-margin glyphs.
+This is a specifier; use `set-specifier' to change it.
+*/ );
+ 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),
+ some_window_value_changed,
+ 0, 0);
+
+ DEFVAR_SPECIFIER ("use-right-overflow", &Vuse_right_overflow /*
+*Non-nil means use the right outside margin as extra whitespace when
+displaying 'whitespace or 'inside-margin glyphs.
+This is a specifier; use `set-specifier' to change it.
+*/ );
+ 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),
+ some_window_value_changed,
+ 0, 0);
+
+ DEFVAR_SPECIFIER ("text-cursor-visible-p", &Vtext_cursor_visible_p /*
+*Non-nil means the text cursor is visible (this is usually the case).
+This is a specifier; use `set-specifier' to change it.
+*/ );
+ 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),
+ text_cursor_visible_p_changed,
+ 0, 0);
+
+}
--- /dev/null
+/* Redisplay data structures.
+ Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
+ Copyright (C) 1996 Chuck Thompson.
+ 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 _XEMACS_REDISPLAY_H_
+#define _XEMACS_REDISPLAY_H_
+
+/* Redisplay DASSERT types */
+#define DB_DISP_POS 1
+#define DB_DISP_TEXT_LAYOUT 2
+#define DB_DISP_REDISPLAY 4
+
+/* These are the possible return values from pixel_to_glyph_translation. */
+#define OVER_MODELINE 0
+#define OVER_TEXT 1
+#define OVER_OUTSIDE 2
+#define OVER_NOTHING 3
+#define OVER_BORDER 4
+#define OVER_TOOLBAR 5
+#define OVER_V_DIVIDER 6
+
+#define NO_BLOCK -1
+
+/* Imagine that the text in the buffer is displayed on a piece of paper
+ the width of the frame and very very tall. The line start cache is
+ an array of struct line_start_cache's, describing the start and
+ end buffer positions for a contiguous set of lines on that piece
+ of paper. */
+
+typedef struct line_start_cache line_start_cache;
+struct line_start_cache
+{
+ Bufpos start, end;
+ int height;
+};
+
+typedef struct
+{
+ Dynarr_declare (line_start_cache);
+} line_start_cache_dynarr;
+
+/* The possible types of runes.
+
+ #### The Lisp_Glyph type is broken. There should instead be a pixmap
+ type. Currently the device-specific output routines have to worry
+ about whether the glyph is textual or not, etc. For Mule this is
+ a big problem because you might need multiple fonts to display the
+ text. It also eliminates optimizations that could come from glumping
+ the text of multiple text glyphs together -- this makes displaying
+ binary files (with lots of control chars, etc.) very very slow. */
+
+#define RUNE_BLANK 0
+#define RUNE_CHAR 1
+#define RUNE_DGLYPH 2
+#define RUNE_HLINE 3
+#define RUNE_VLINE 4
+
+#define CURSOR_ON 0
+#define CURSOR_OFF 1
+#define NO_CURSOR 2
+#define NEXT_CURSOR 3
+#define IGNORE_CURSOR 4
+
+#define DEFAULT_INDEX (face_index) 0
+#define MODELINE_INDEX (face_index) 1
+
+/* A rune is a single display element, such as a printable character
+ or pixmap. Any single character in a buffer has one or more runes
+ (or zero, if the character is invisible) corresponding to it.
+ (Printable characters typically have one rune associated with them,
+ but control characters have two -- a ^ and a letter -- and other
+ non-printing characters (those displayed in octal) have four. */
+
+typedef struct rune rune;
+struct rune
+{
+ face_index findex; /* face rune is displayed with. The
+ face_index is an index into a
+ window-specific array of face cache
+ elements. Each face cache element
+ corresponds to one "merged face"
+ (the result of merging all the
+ faces that overlap the rune) and
+ contains the instance values for
+ 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? */
+ Bufpos endpos; /* if set this rune covers a range of pos */
+ /* #### 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 */
+
+ union /* Information specific to the type of rune */
+ {
+ /* DGLYPH */
+ struct
+ {
+ Lisp_Object glyph;
+ Lisp_Object extent; /* extent rune is attached to, if any.
+ If this is a rune in the modeline
+ then this might be nil. */
+
+ int xoffset; /* Number of pixels that need to be
+ chopped off the left of the glyph.
+ This has the effect of shifting the
+ glyph to the left while still clipping
+ at XPOS. */
+ } dglyph;
+
+ /* CHAR */
+ struct
+ {
+ Emchar ch; /* Cbaracter of this rune. */
+ } chr;
+
+ /* HLINE */
+ struct
+ {
+ int thickness; /* how thick to make hline */
+ int yoffset; /* how far down from top of line to put top */
+ } hline;
+ } object; /* actual rune object */
+};
+
+typedef struct
+{
+ Dynarr_declare (rune);
+} rune_dynarr;
+
+/* These must have distinct values. Note that the ordering actually
+ represents priority levels. TEXT has the lowest priority level. */
+enum display_type
+{
+ TEXT,
+ LEFT_OUTSIDE_MARGIN,
+ LEFT_INSIDE_MARGIN,
+ RIGHT_INSIDE_MARGIN,
+ RIGHT_OUTSIDE_MARGIN,
+ OVERWRITE
+};
+
+/* A display block represents a run of text on a single line.
+ Apparently there is only one display block per line for each
+ of the types listed in `enum display_type'.
+
+ A display block consists mostly of an array of runes, one per
+ atomic display element (printable character, pixmap, etc.). */
+
+/* #### Yuckity yuckity yuck yuck yuck yuck yuck!!
+
+ Chuck, I think you should redo this. It should not be the
+ responsibility of the device-specific code to worry about
+ the different faces. The generic stuff in redisplay-output.c
+ should glump things up into sub-blocks, each of which
+ corresponds to a single pixmap or a single run of text in
+ the same font.
+
+ It might still make sense for the device-specific output routine
+ to get passed an entire display line. That way, it can make
+ calls to XDrawText() (which draws multiple runs of single-font
+ data) instead of XDrawString(). The reason for this is to
+ reduce the amount of X traffic, which will help things significantly
+ on a slow line. */
+
+typedef struct display_block display_block;
+struct display_block
+{
+ enum display_type type; /* type of display block */
+
+ int start_pos; /* starting pixel position of block */
+ int end_pos; /* ending pixel position of block */
+
+ rune_dynarr *runes; /* Dynamic array of runes */
+};
+
+typedef struct
+{
+ Dynarr_declare (display_block);
+} display_block_dynarr;
+
+typedef struct layout_bounds_type
+{
+ int left_out;
+ int left_in;
+ int left_white;
+ int right_white;
+ int right_in;
+ int right_out;
+} layout_bounds;
+
+typedef struct glyph_block glyph_block;
+struct glyph_block
+{
+ Lisp_Object glyph;
+ Lisp_Object extent;
+ /* The rest are only used by margin routines. */
+ face_index findex;
+ int active;
+ int width;
+};
+
+typedef struct
+{
+ Dynarr_declare (glyph_block);
+} glyph_block_dynarr;
+
+typedef struct display_line display_line;
+struct display_line
+{
+ short ypos; /* vertical position in pixels
+ of the baseline for this line. */
+ unsigned short ascent, descent; /* maximum values for this line.
+ The ascent is the number of
+ pixels above the baseline, and
+ the descent is the number of
+ pixels below the baseline.
+ The descent includes the baseline
+ pixel-row itself, I think. */
+ unsigned short clip; /* amount of bottom 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 */
+ Charcount num_chars; /* # of chars on line
+ including expansion of tabs
+ and control chars */
+ int cursor_elt; /* rune block of TEXT display
+ block cursor is at or -1 */
+ char used_prop_data; /* can't incrementally update if line
+ used propogation data */
+
+ layout_bounds bounds; /* line boundary positions */
+
+ char modeline; /* t if this line is a modeline */
+
+ /* Dynamic array of display blocks */
+ display_block_dynarr *display_blocks;
+
+ /* Dynamic arrays of left and right glyph blocks */
+ glyph_block_dynarr *left_glyphs;
+ glyph_block_dynarr *right_glyphs;
+};
+
+typedef struct
+{
+ Dynarr_declare (display_line);
+} display_line_dynarr;
+
+/* 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. */
+
+typedef struct
+{
+ Dynarr_declare (EXTENT);
+} EXTENT_dynarr;
+
+struct font_metric_info
+{
+ int width;
+ int height; /* always ascent + descent; for convenience */
+ int ascent;
+ int descent;
+
+ int proportional_p;
+};
+
+/* NOTE NOTE NOTE: Currently the positions in an extent fragment
+ structure are Bytind's, not Bufpos's. This could change. */
+
+struct extent_fragment
+{
+ Lisp_Object object; /* buffer or string */
+ struct frame *frm;
+ Bytind pos, end;
+ EXTENT_dynarr *extents;
+ glyph_block_dynarr *begin_glyphs, *end_glyphs;
+ unsigned int invisible:1;
+ unsigned int invisible_ellipses:1;
+ unsigned int previously_invisible:1;
+ unsigned int invisible_ellipses_already_displayed:1;
+};
+
+\f
+/*************************************************************************/
+/* change flags */
+/*************************************************************************/
+
+/* Quick flags to signal redisplay. redisplay() sets them all to 0
+ when it finishes. If none of them are set when it starts, it
+ assumes that nothing needs to be done. Functions that make a change
+ that is (potentially) visible on the screen should set the
+ appropriate flag.
+
+ If any of these flags are set, redisplay will look more carefully
+ to see if anything has really changed. */
+
+/* non-nil if the contents of a buffer have changed since the last time
+ redisplay completed */
+extern int buffers_changed;
+extern int buffers_changed_set;
+
+/* Nonzero if head_clip or tail_clip of a buffer has changed
+ since last redisplay that finished */
+extern int clip_changed;
+extern int clip_changed_set;
+
+/* non-nil if any extent has changed since the last time redisplay completed */
+extern int extents_changed;
+extern int extents_changed_set;
+
+/* non-nil if any face has changed since the last time redisplay completed */
+extern int faces_changed;
+
+/* Nonzero means one or more frames have been marked as garbaged */
+extern int frame_changed;
+
+/* True if any of the builtin display glyphs (continuation,
+ hscroll, control-arrow, etc) is in need of updating
+ somewhere. */
+extern int glyphs_changed;
+extern int glyphs_changed_set;
+
+/* True if an icon is in need of updating somewhere. */
+extern int icon_changed;
+extern int icon_changed_set;
+
+/* True if a menubar is in need of updating somewhere. */
+extern int menubar_changed;
+extern int menubar_changed_set;
+
+/* true iff we should redraw the modelines on the next redisplay */
+extern int modeline_changed;
+extern int modeline_changed_set;
+
+/* non-nil if point has changed in some buffer since the last time
+ redisplay completed */
+extern int point_changed;
+extern int point_changed_set;
+
+/* non-nil if some frame has changed its size */
+extern int size_changed;
+
+/* non-nil if some device has signaled that it wants to change size */
+extern int asynch_device_change_pending;
+
+/* non-nil if any toolbar has changed */
+extern int toolbar_changed;
+extern int toolbar_changed_set;
+
+/* non-nil if any window has changed since the last time redisplay completed */
+extern int windows_changed;
+
+/* non-nil if any frame's window structure has changed since the last
+ time redisplay completed */
+extern int windows_structure_changed;
+
+/* These macros can be relatively expensive. Since they are often
+ called numerous times between each call to redisplay, we keep track
+ if each has already been called and don't bother doing most of the
+ work if it is currently set. */
+
+#define MARK_TYPE_CHANGED(object) do { \
+ if (!object##_changed_set) { \
+ Lisp_Object _devcons_, _concons_; \
+ DEVICE_LOOP_NO_BREAK (_devcons_, _concons_) \
+ { \
+ Lisp_Object _frmcons_; \
+ struct device *_d_ = XDEVICE (XCAR (_devcons_)); \
+ DEVICE_FRAME_LOOP (_frmcons_, _d_) \
+ { \
+ struct frame *_f_ = XFRAME (XCAR (_frmcons_)); \
+ _f_->object##_changed = 1; \
+ _f_->modiff++; \
+ } \
+ _d_->object##_changed = 1; \
+ } \
+ object##_changed = 1; \
+ object##_changed_set = 1; } \
+ } while (0)
+
+#define MARK_BUFFERS_CHANGED MARK_TYPE_CHANGED (buffers)
+#define MARK_CLIP_CHANGED MARK_TYPE_CHANGED (clip)
+#define MARK_EXTENTS_CHANGED MARK_TYPE_CHANGED (extents)
+#define MARK_ICON_CHANGED MARK_TYPE_CHANGED (icon)
+#define MARK_MENUBAR_CHANGED MARK_TYPE_CHANGED (menubar)
+#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_GLYPHS_CHANGED MARK_TYPE_CHANGED (glyphs)
+
+/* 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; \
+ } while (0)
+
+\f
+/*************************************************************************/
+/* redisplay global variables */
+/*************************************************************************/
+
+/* redisplay structre used by various utility routines. */
+extern display_line_dynarr *cmotion_display_lines;
+
+/* Nonzero means truncate lines in all windows less wide than the frame. */
+extern int truncate_partial_width_windows;
+
+/* Nonzero if we're in a display critical section. */
+extern int in_display;
+
+/* Nonzero means no need to redraw the entire frame on resuming
+ a suspended Emacs. This is useful on terminals with multiple pages,
+ where one page is used for Emacs and another for all else. */
+extern int no_redraw_on_reenter;
+
+/* Nonzero means flash the frame instead of ringing the bell. */
+extern int visible_bell;
+
+/* Thickness of shadow border around 3D modelines. */
+extern Lisp_Object Vmodeline_shadow_thickness;
+
+/* Scroll if point lands on the bottom line and that line is partially
+ clipped. */
+extern int scroll_on_clipped_lines;
+
+extern Lisp_Object Vglobal_mode_string;
+
+/* The following two variables are defined in emacs.c and are used
+ to convey information discovered on the command line way early
+ (before *anything* is initialized). */
+
+/* If non-zero, a window-system was specified on the command line.
+ Defined in emacs.c. */
+extern int display_arg;
+
+/* Type of display specified. Defined in emacs.c. */
+extern char *display_use;
+
+/* Nonzero means reading single-character input with prompt
+ so put cursor on minibuffer after the prompt. */
+
+extern int cursor_in_echo_area;
+
+extern Lisp_Object Qbar_cursor, Qcursor_in_echo_area, Vwindow_system;
+
+\f
+/*************************************************************************/
+/* redisplay exported functions */
+/*************************************************************************/
+EXFUN (Fredraw_frame, 2);
+
+int redisplay_text_width_string (struct window *w, int findex,
+ Bufbyte *nonreloc, Lisp_Object reloc,
+ Bytecount offset, Bytecount len);
+int redisplay_frame_text_width_string (struct frame *f,
+ Lisp_Object face,
+ Bufbyte *nonreloc,
+ Lisp_Object reloc,
+ Bytecount offset, Bytecount len);
+void redisplay (void);
+struct display_block *get_display_block_from_line (struct display_line *dl,
+ enum display_type type);
+layout_bounds calculate_display_line_boundaries (struct window *w,
+ int modeline);
+Bufpos point_at_center (struct window *w, int type, Bufpos start,
+ Bufpos point);
+int line_at_center (struct window *w, int type, Bufpos start, Bufpos point);
+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);
+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,
+ int *obj_x, int *obj_y,
+ struct window **w, Bufpos *bufpos,
+ Bufpos *closest, Charcount *modeline_closest,
+ 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));
+int point_in_line_start_cache (struct window *w, Bufpos point,
+ int min_past);
+int point_would_be_visible (struct window *w, Bufpos startp,
+ Bufpos point);
+Bufpos start_of_last_line (struct window *w, Bufpos startp);
+Bufpos end_of_last_line (struct window *w, Bufpos startp);
+Bufpos start_with_line_at_pixpos (struct window *w, Bufpos point,
+ int pixpos);
+Bufpos start_with_point_on_display_line (struct window *w, Bufpos point,
+ int line);
+int redisplay_variable_changed (Lisp_Object sym, Lisp_Object *val,
+ Lisp_Object in_object, int flags);
+void redisplay_glyph_changed (Lisp_Object glyph, Lisp_Object property,
+ Lisp_Object locale);
+
+#ifdef MEMORY_USAGE_STATS
+int compute_display_line_dynarr_usage (display_line_dynarr *dyn,
+ struct overhead_stats *ovstats);
+int compute_line_start_cache_dynarr_usage (line_start_cache_dynarr *dyn,
+ struct overhead_stats *ovstats);
+#endif
+
+
+/* defined in redisplay-output.c */
+int get_next_display_block (layout_bounds bounds,
+ display_block_dynarr *dba, int start_pos,
+ int *next_start);
+void redisplay_clear_bottom_of_window (struct window *w,
+ display_line_dynarr *ddla,
+ int min_start, int max_end);
+void redisplay_update_line (struct window *w, int first_line,
+ int last_line, int update_values);
+void redisplay_output_window (struct window *w);
+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);
+void output_display_line (struct window *w, display_line_dynarr *cdla,
+ display_line_dynarr *ddla, int line,
+ int force_start, int force_end);
+
+#endif /* _XEMACS_REDISPLAY_H_ */
--- /dev/null
+/* Extended regular expression matching and search library,
+ version 0.12, extended for XEmacs.
+ (Implements POSIX draft P10003.2/D11.2, except for
+ internationalization features.)
+
+ Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+ Copyright (C) 1995 Sun Microsystems, Inc.
+ Copyright (C) 1995 Ben Wing.
+
+ This program 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.
+
+ This program 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 this program; 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.29. */
+
+/* Changes made for XEmacs:
+
+ (1) the REGEX_BEGLINE_CHECK code from the XEmacs v18 regex routines
+ was added. This causes a huge speedup in font-locking.
+ (2) Rel-alloc is disabled when the MMAP version of rel-alloc is
+ being used, because it's too slow -- all those calls to mmap()
+ add humongous overhead.
+ (3) Lots and lots of changes for Mule. They are bracketed by
+ `#ifdef MULE' or with comments that have `XEmacs' in them.
+ */
+
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+
+#ifndef REGISTER /* Rigidly enforced as of 20.3 */
+#define REGISTER
+#endif
+
+#ifndef _GNU_SOURCE
+#define _GNU_SOURCE 1
+#endif
+
+/* We assume non-Mule if emacs isn't defined. */
+#ifndef emacs
+#undef MULE
+#endif
+
+/* We need this for `regex.h', and perhaps for the Emacs include files. */
+#include <sys/types.h>
+
+/* This is for other GNU distributions with internationalized messages. */
+#if defined (I18N3) && (defined (HAVE_LIBINTL_H) || defined (_LIBC))
+# include <libintl.h>
+#else
+# define gettext(msgid) (msgid)
+#endif
+
+/* XEmacs: define this to add in a speedup for patterns anchored at
+ the beginning of a line. Keep the ifdefs so that it's easier to
+ tell where/why this code has diverged from v19. */
+#define REGEX_BEGLINE_CHECK
+
+/* XEmacs: the current mmap-based ralloc handles small blocks very
+ poorly, so we disable it here. */
+
+#if (defined (REL_ALLOC) && defined (HAVE_MMAP)) || defined(DOUG_LEA_MALLOC)
+# undef REL_ALLOC
+#endif
+
+/* The `emacs' switch turns on certain matching commands
+ that make sense only in Emacs. */
+#ifdef emacs
+
+#include "lisp.h"
+#include "buffer.h"
+#include "syntax.h"
+
+#if (defined (DEBUG_XEMACS) && !defined (DEBUG))
+#define DEBUG
+#endif
+
+#ifdef MULE
+
+Lisp_Object Vthe_lisp_rangetab;
+
+void
+complex_vars_of_regex (void)
+{
+ Vthe_lisp_rangetab = Fmake_range_table ();
+ staticpro (&Vthe_lisp_rangetab);
+}
+
+#else /* not MULE */
+
+void
+complex_vars_of_regex (void)
+{
+}
+
+#endif /* not MULE */
+
+#else /* not emacs */
+
+/* If we are not linking with Emacs proper,
+ we can't use the relocating allocator
+ even if config.h says that we can. */
+#undef REL_ALLOC
+
+#if defined (STDC_HEADERS) || defined (_LIBC)
+#include <stdlib.h>
+#else
+char *malloc ();
+char *realloc ();
+#endif
+
+#define charptr_emchar(str) ((Emchar) (str)[0])
+
+#if (LONGBITS > INTBITS)
+# define EMACS_INT long
+#else
+# define EMACS_INT int
+#endif
+
+typedef int Emchar;
+
+#define INC_CHARPTR(p) ((p)++)
+#define DEC_CHARPTR(p) ((p)--)
+
+#include <string.h>
+
+/* Define the syntax stuff for \<, \>, etc. */
+
+/* This must be nonzero for the wordchar and notwordchar pattern
+ commands in re_match_2. */
+#ifndef Sword
+#define Sword 1
+#endif
+
+#ifdef SYNTAX_TABLE
+
+extern char *re_syntax_table;
+
+#else /* not SYNTAX_TABLE */
+
+/* How many characters in the character set. */
+#define CHAR_SET_SIZE 256
+
+static char re_syntax_table[CHAR_SET_SIZE];
+
+static void
+init_syntax_once (void)
+{
+ static int done = 0;
+
+ if (!done)
+ {
+ CONST char *word_syntax_chars =
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_";
+
+ memset (re_syntax_table, 0, sizeof (re_syntax_table));
+
+ while (*word_syntax_chars)
+ re_syntax_table[(unsigned int)(*word_syntax_chars++)] = Sword;
+
+ done = 1;
+ }
+}
+
+#endif /* not SYNTAX_TABLE */
+
+#define SYNTAX_UNSAFE(ignored, c) re_syntax_table[c]
+
+#endif /* not emacs */
+
+/* Under XEmacs, this is needed because we don't define it elsewhere. */
+#ifdef SWITCH_ENUM_BUG
+#define SWITCH_ENUM_CAST(x) ((int)(x))
+#else
+#define SWITCH_ENUM_CAST(x) (x)
+#endif
+
+\f
+/* Get the interface, including the syntax bits. */
+#include "regex.h"
+
+/* isalpha etc. are used for the character classes. */
+#include <ctype.h>
+
+/* Jim Meyering writes:
+
+ "... Some ctype macros are valid only for character codes that
+ isascii says are ASCII (SGI's IRIX-4.0.5 is one such system --when
+ using /bin/cc or gcc but without giving an ansi option). So, all
+ ctype uses should be through macros like ISPRINT... If
+ STDC_HEADERS is defined, then autoconf has verified that the ctype
+ macros don't need to be guarded with references to isascii. ...
+ Defining isascii to 1 should let any compiler worth its salt
+ eliminate the && through constant folding." */
+
+#if defined (STDC_HEADERS) || (!defined (isascii) && !defined (HAVE_ISASCII))
+#define ISASCII_1(c) 1
+#else
+#define ISASCII_1(c) isascii(c)
+#endif
+
+#ifdef MULE
+/* The IS*() macros can be passed any character, including an extended
+ one. We need to make sure there are no crashes, which would occur
+ otherwise due to out-of-bounds array references. */
+#define ISASCII(c) (((EMACS_UINT) (c)) < 0x100 && ISASCII_1 (c))
+#else
+#define ISASCII(c) ISASCII_1 (c)
+#endif /* MULE */
+
+#ifdef isblank
+#define ISBLANK(c) (ISASCII (c) && isblank (c))
+#else
+#define ISBLANK(c) ((c) == ' ' || (c) == '\t')
+#endif
+#ifdef isgraph
+#define ISGRAPH(c) (ISASCII (c) && isgraph (c))
+#else
+#define ISGRAPH(c) (ISASCII (c) && isprint (c) && !isspace (c))
+#endif
+
+#define ISPRINT(c) (ISASCII (c) && isprint (c))
+#define ISDIGIT(c) (ISASCII (c) && isdigit (c))
+#define ISALNUM(c) (ISASCII (c) && isalnum (c))
+#define ISALPHA(c) (ISASCII (c) && isalpha (c))
+#define ISCNTRL(c) (ISASCII (c) && iscntrl (c))
+#define ISLOWER(c) (ISASCII (c) && islower (c))
+#define ISPUNCT(c) (ISASCII (c) && ispunct (c))
+#define ISSPACE(c) (ISASCII (c) && isspace (c))
+#define ISUPPER(c) (ISASCII (c) && isupper (c))
+#define ISXDIGIT(c) (ISASCII (c) && isxdigit (c))
+
+#ifndef NULL
+#define NULL (void *)0
+#endif
+
+/* We remove any previous definition of `SIGN_EXTEND_CHAR',
+ since ours (we hope) works properly with all combinations of
+ machines, compilers, `char' and `unsigned char' argument types.
+ (Per Bothner suggested the basic approach.) */
+#undef SIGN_EXTEND_CHAR
+#if __STDC__
+#define SIGN_EXTEND_CHAR(c) ((signed char) (c))
+#else /* not __STDC__ */
+/* As in Harbison and Steele. */
+#define SIGN_EXTEND_CHAR(c) ((((unsigned char) (c)) ^ 128) - 128)
+#endif
+\f
+/* Should we use malloc or alloca? If REGEX_MALLOC is not defined, we
+ use `alloca' instead of `malloc'. This is because using malloc in
+ re_search* or re_match* could cause memory leaks when C-g is used in
+ Emacs; also, malloc is slower and causes storage fragmentation. On
+ the other hand, malloc is more portable, and easier to debug.
+
+ Because we sometimes use alloca, some routines have to be macros,
+ not functions -- `alloca'-allocated space disappears at the end of the
+ function it is called in. */
+
+#ifdef REGEX_MALLOC
+
+#define REGEX_ALLOCATE malloc
+#define REGEX_REALLOCATE(source, osize, nsize) realloc (source, nsize)
+#define REGEX_FREE free
+
+#else /* not REGEX_MALLOC */
+
+/* Emacs already defines alloca, sometimes. */
+#ifndef alloca
+
+/* Make alloca work the best possible way. */
+#ifdef __GNUC__
+#define alloca __builtin_alloca
+#else /* not __GNUC__ */
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#else /* not __GNUC__ or HAVE_ALLOCA_H */
+#ifndef _AIX /* Already did AIX, up at the top. */
+char *alloca ();
+#endif /* not _AIX */
+#endif /* not HAVE_ALLOCA_H */
+#endif /* not __GNUC__ */
+
+#endif /* not alloca */
+
+#define REGEX_ALLOCATE alloca
+
+/* Assumes a `char *destination' variable. */
+#define REGEX_REALLOCATE(source, osize, nsize) \
+ (destination = (char *) alloca (nsize), \
+ memmove (destination, source, osize), \
+ destination)
+
+/* No need to do anything to free, after alloca. */
+#define REGEX_FREE(arg) ((void)0) /* Do nothing! But inhibit gcc warning. */
+
+#endif /* not REGEX_MALLOC */
+
+/* Define how to allocate the failure stack. */
+
+#ifdef REL_ALLOC
+#define REGEX_ALLOCATE_STACK(size) \
+ r_alloc ((char **) &failure_stack_ptr, (size))
+#define REGEX_REALLOCATE_STACK(source, osize, nsize) \
+ r_re_alloc ((char **) &failure_stack_ptr, (nsize))
+#define REGEX_FREE_STACK(ptr) \
+ r_alloc_free ((void **) &failure_stack_ptr)
+
+#else /* not REL_ALLOC */
+
+#ifdef REGEX_MALLOC
+
+#define REGEX_ALLOCATE_STACK malloc
+#define REGEX_REALLOCATE_STACK(source, osize, nsize) realloc (source, nsize)
+#define REGEX_FREE_STACK free
+
+#else /* not REGEX_MALLOC */
+
+#define REGEX_ALLOCATE_STACK alloca
+
+#define REGEX_REALLOCATE_STACK(source, osize, nsize) \
+ REGEX_REALLOCATE (source, osize, nsize)
+/* No need to explicitly free anything. */
+#define REGEX_FREE_STACK(arg)
+
+#endif /* not REGEX_MALLOC */
+#endif /* not REL_ALLOC */
+
+
+/* True if `size1' is non-NULL and PTR is pointing anywhere inside
+ `string1' or just past its end. This works if PTR is NULL, which is
+ a good thing. */
+#define FIRST_STRING_P(ptr) \
+ (size1 && string1 <= (ptr) && (ptr) <= string1 + size1)
+
+/* (Re)Allocate N items of type T using malloc, or fail. */
+#define TALLOC(n, t) ((t *) malloc ((n) * sizeof (t)))
+#define RETALLOC(addr, n, t) ((addr) = (t *) realloc (addr, (n) * sizeof (t)))
+#define RETALLOC_IF(addr, n, t) \
+ if (addr) RETALLOC((addr), (n), t); else (addr) = TALLOC ((n), t)
+#define REGEX_TALLOC(n, t) ((t *) REGEX_ALLOCATE ((n) * sizeof (t)))
+
+#define BYTEWIDTH 8 /* In bits. */
+
+#define STREQ(s1, s2) ((strcmp (s1, s2) == 0))
+
+#undef MAX
+#undef MIN
+#define MAX(a, b) ((a) > (b) ? (a) : (b))
+#define MIN(a, b) ((a) < (b) ? (a) : (b))
+
+typedef char boolean;
+#define false 0
+#define true 1
+
+\f
+/* These are the command codes that appear in compiled regular
+ expressions. Some opcodes are followed by argument bytes. A
+ command code can specify any interpretation whatsoever for its
+ arguments. Zero bytes may appear in the compiled regular expression. */
+
+typedef enum
+{
+ no_op = 0,
+
+ /* Succeed right away--no more backtracking. */
+ succeed,
+
+ /* Followed by one byte giving n, then by n literal bytes. */
+ exactn,
+
+ /* Matches any (more or less) character. */
+ anychar,
+
+ /* Matches any one char belonging to specified set. First
+ following byte is number of bitmap bytes. Then come bytes
+ for a bitmap saying which chars are in. Bits in each byte
+ are ordered low-bit-first. A character is in the set if its
+ bit is 1. A character too large to have a bit in the map is
+ automatically not in the set. */
+ charset,
+
+ /* Same parameters as charset, but match any character that is
+ not one of those specified. */
+ charset_not,
+
+ /* Start remembering the text that is matched, for storing in a
+ register. Followed by one byte with the register number, in
+ the range 0 to one less than the pattern buffer's re_nsub
+ field. Then followed by one byte with the number of groups
+ inner to this one. (This last has to be part of the
+ start_memory only because we need it in the on_failure_jump
+ of re_match_2.) */
+ start_memory,
+
+ /* Stop remembering the text that is matched and store it in a
+ memory register. Followed by one byte with the register
+ number, in the range 0 to one less than `re_nsub' in the
+ pattern buffer, and one byte with the number of inner groups,
+ just like `start_memory'. (We need the number of inner
+ groups here because we don't have any easy way of finding the
+ corresponding start_memory when we're at a stop_memory.) */
+ stop_memory,
+
+ /* Match a duplicate of something remembered. Followed by one
+ byte containing the register number. */
+ duplicate,
+
+ /* Fail unless at beginning of line. */
+ begline,
+
+ /* Fail unless at end of line. */
+ endline,
+
+ /* Succeeds if at beginning of buffer (if emacs) or at beginning
+ of string to be matched (if not). */
+ begbuf,
+
+ /* Analogously, for end of buffer/string. */
+ endbuf,
+
+ /* Followed by two byte relative address to which to jump. */
+ jump,
+
+ /* Same as jump, but marks the end of an alternative. */
+ jump_past_alt,
+
+ /* Followed by two-byte relative address of place to resume at
+ in case of failure. */
+ on_failure_jump,
+
+ /* Like on_failure_jump, but pushes a placeholder instead of the
+ current string position when executed. */
+ on_failure_keep_string_jump,
+
+ /* Throw away latest failure point and then jump to following
+ two-byte relative address. */
+ pop_failure_jump,
+
+ /* Change to pop_failure_jump if know won't have to backtrack to
+ match; otherwise change to jump. This is used to jump
+ back to the beginning of a repeat. If what follows this jump
+ clearly won't match what the repeat does, such that we can be
+ sure that there is no use backtracking out of repetitions
+ already matched, then we change it to a pop_failure_jump.
+ Followed by two-byte address. */
+ maybe_pop_jump,
+
+ /* Jump to following two-byte address, and push a dummy failure
+ point. This failure point will be thrown away if an attempt
+ is made to use it for a failure. A `+' construct makes this
+ before the first repeat. Also used as an intermediary kind
+ of jump when compiling an alternative. */
+ dummy_failure_jump,
+
+ /* Push a dummy failure point and continue. Used at the end of
+ alternatives. */
+ push_dummy_failure,
+
+ /* Followed by two-byte relative address and two-byte number n.
+ After matching N times, jump to the address upon failure. */
+ succeed_n,
+
+ /* Followed by two-byte relative address, and two-byte number n.
+ Jump to the address N times, then fail. */
+ jump_n,
+
+ /* Set the following two-byte relative address to the
+ subsequent two-byte number. The address *includes* the two
+ bytes of number. */
+ set_number_at,
+
+ wordchar, /* Matches any word-constituent character. */
+ notwordchar, /* Matches any char that is not a word-constituent. */
+
+ wordbeg, /* Succeeds if at word beginning. */
+ wordend, /* Succeeds if at word end. */
+
+ wordbound, /* Succeeds if at a word boundary. */
+ notwordbound /* Succeeds if not at a word boundary. */
+
+#ifdef emacs
+ ,before_dot, /* Succeeds if before point. */
+ at_dot, /* Succeeds if at point. */
+ after_dot, /* Succeeds if after point. */
+
+ /* Matches any character whose syntax is specified. Followed by
+ a byte which contains a syntax code, e.g., Sword. */
+ syntaxspec,
+
+ /* Matches any character whose syntax is not that specified. */
+ notsyntaxspec
+
+#endif /* emacs */
+
+#ifdef MULE
+ /* need extra stuff to be able to properly work with XEmacs/Mule
+ characters (which may take up more than one byte) */
+
+ ,charset_mule, /* Matches any character belonging to specified set.
+ The set is stored in "unified range-table
+ format"; see rangetab.c. Unlike the `charset'
+ opcode, this can handle arbitrary characters. */
+
+ charset_mule_not /* Same parameters as charset_mule, but match any
+ character that is not one of those specified. */
+
+ /* 97/2/17 jhod: The following two were merged back in from the Mule
+ 2.3 code to enable some language specific processing */
+ ,categoryspec, /* Matches entries in the character category tables */
+ notcategoryspec /* The opposite of the above */
+#endif /* MULE */
+
+} re_opcode_t;
+\f
+/* Common operations on the compiled pattern. */
+
+/* Store NUMBER in two contiguous bytes starting at DESTINATION. */
+
+#define STORE_NUMBER(destination, number) \
+ do { \
+ (destination)[0] = (number) & 0377; \
+ (destination)[1] = (number) >> 8; \
+ } while (0)
+
+/* Same as STORE_NUMBER, except increment DESTINATION to
+ the byte after where the number is stored. Therefore, DESTINATION
+ must be an lvalue. */
+
+#define STORE_NUMBER_AND_INCR(destination, number) \
+ do { \
+ STORE_NUMBER (destination, number); \
+ (destination) += 2; \
+ } while (0)
+
+/* Put into DESTINATION a number stored in two contiguous bytes starting
+ at SOURCE. */
+
+#define EXTRACT_NUMBER(destination, source) \
+ do { \
+ (destination) = *(source) & 0377; \
+ (destination) += SIGN_EXTEND_CHAR (*((source) + 1)) << 8; \
+ } while (0)
+
+#ifdef DEBUG
+static void
+extract_number (int *dest, unsigned char *source)
+{
+ int temp = SIGN_EXTEND_CHAR (*(source + 1));
+ *dest = *source & 0377;
+ *dest += temp << 8;
+}
+
+#ifndef EXTRACT_MACROS /* To debug the macros. */
+#undef EXTRACT_NUMBER
+#define EXTRACT_NUMBER(dest, src) extract_number (&dest, src)
+#endif /* not EXTRACT_MACROS */
+
+#endif /* DEBUG */
+
+/* Same as EXTRACT_NUMBER, except increment SOURCE to after the number.
+ SOURCE must be an lvalue. */
+
+#define EXTRACT_NUMBER_AND_INCR(destination, source) \
+ do { \
+ EXTRACT_NUMBER (destination, source); \
+ (source) += 2; \
+ } while (0)
+
+#ifdef DEBUG
+static void
+extract_number_and_incr (int *destination, unsigned char **source)
+{
+ extract_number (destination, *source);
+ *source += 2;
+}
+
+#ifndef EXTRACT_MACROS
+#undef EXTRACT_NUMBER_AND_INCR
+#define EXTRACT_NUMBER_AND_INCR(dest, src) \
+ extract_number_and_incr (&dest, &src)
+#endif /* not EXTRACT_MACROS */
+
+#endif /* DEBUG */
+\f
+/* If DEBUG is defined, Regex prints many voluminous messages about what
+ it is doing (if the variable `debug' is nonzero). If linked with the
+ main program in `iregex.c', you can enter patterns and strings
+ interactively. And if linked with the main program in `main.c' and
+ the other test files, you can run the already-written tests. */
+
+#if defined (DEBUG)
+
+/* We use standard I/O for debugging. */
+#include <stdio.h>
+
+#ifndef emacs
+/* XEmacs provides its own version of assert() */
+/* It is useful to test things that ``must'' be true when debugging. */
+#include <assert.h>
+#endif
+
+static int debug = 0;
+
+#define DEBUG_STATEMENT(e) e
+#define DEBUG_PRINT1(x) if (debug) printf (x)
+#define DEBUG_PRINT2(x1, x2) if (debug) printf (x1, x2)
+#define DEBUG_PRINT3(x1, x2, x3) if (debug) printf (x1, x2, x3)
+#define DEBUG_PRINT4(x1, x2, x3, x4) if (debug) printf (x1, x2, x3, x4)
+#define DEBUG_PRINT_COMPILED_PATTERN(p, s, e) \
+ if (debug) print_partial_compiled_pattern (s, e)
+#define DEBUG_PRINT_DOUBLE_STRING(w, s1, sz1, s2, sz2) \
+ if (debug) print_double_string (w, s1, sz1, s2, sz2)
+
+
+/* Print the fastmap in human-readable form. */
+
+static void
+print_fastmap (char *fastmap)
+{
+ unsigned was_a_range = 0;
+ unsigned i = 0;
+
+ while (i < (1 << BYTEWIDTH))
+ {
+ if (fastmap[i++])
+ {
+ was_a_range = 0;
+ putchar (i - 1);
+ while (i < (1 << BYTEWIDTH) && fastmap[i])
+ {
+ was_a_range = 1;
+ i++;
+ }
+ if (was_a_range)
+ {
+ putchar ('-');
+ putchar (i - 1);
+ }
+ }
+ }
+ putchar ('\n');
+}
+
+
+/* Print a compiled pattern string in human-readable form, starting at
+ the START pointer into it and ending just before the pointer END. */
+
+static void
+print_partial_compiled_pattern (unsigned char *start, unsigned char *end)
+{
+ int mcnt, mcnt2;
+ unsigned char *p = start;
+ unsigned char *pend = end;
+
+ if (start == NULL)
+ {
+ puts ("(null)");
+ return;
+ }
+
+ /* Loop over pattern commands. */
+ while (p < pend)
+ {
+ printf ("%ld:\t", (long)(p - start));
+
+ switch ((re_opcode_t) *p++)
+ {
+ case no_op:
+ printf ("/no_op");
+ break;
+
+ case exactn:
+ mcnt = *p++;
+ printf ("/exactn/%d", mcnt);
+ do
+ {
+ putchar ('/');
+ putchar (*p++);
+ }
+ while (--mcnt);
+ break;
+
+ case start_memory:
+ mcnt = *p++;
+ printf ("/start_memory/%d/%d", mcnt, *p++);
+ break;
+
+ case stop_memory:
+ mcnt = *p++;
+ printf ("/stop_memory/%d/%d", mcnt, *p++);
+ break;
+
+ case duplicate:
+ printf ("/duplicate/%d", *p++);
+ break;
+
+ case anychar:
+ printf ("/anychar");
+ break;
+
+ case charset:
+ case charset_not:
+ {
+ REGISTER int c, last = -100;
+ REGISTER int in_range = 0;
+
+ printf ("/charset [%s",
+ (re_opcode_t) *(p - 1) == charset_not ? "^" : "");
+
+ assert (p + *p < pend);
+
+ for (c = 0; c < 256; c++)
+ if (((unsigned char) (c / 8) < *p)
+ && (p[1 + (c/8)] & (1 << (c % 8))))
+ {
+ /* Are we starting a range? */
+ if (last + 1 == c && ! in_range)
+ {
+ putchar ('-');
+ in_range = 1;
+ }
+ /* Have we broken a range? */
+ else if (last + 1 != c && in_range)
+ {
+ putchar (last);
+ in_range = 0;
+ }
+
+ if (! in_range)
+ putchar (c);
+
+ last = c;
+ }
+
+ if (in_range)
+ putchar (last);
+
+ putchar (']');
+
+ p += 1 + *p;
+ }
+ break;
+
+#ifdef MULE
+ case charset_mule:
+ case charset_mule_not:
+ {
+ int nentries, i;
+
+ printf ("/charset_mule [%s",
+ (re_opcode_t) *(p - 1) == charset_mule_not ? "^" : "");
+ nentries = unified_range_table_nentries (p);
+ for (i = 0; i < nentries; i++)
+ {
+ EMACS_INT first, last;
+ Lisp_Object dummy_val;
+
+ unified_range_table_get_range (p, i, &first, &last,
+ &dummy_val);
+ if (first < 0x100)
+ putchar (first);
+ else
+ printf ("(0x%lx)", (long)first);
+ if (first != last)
+ {
+ putchar ('-');
+ if (last < 0x100)
+ putchar (last);
+ else
+ printf ("(0x%lx)", (long)last);
+ }
+ }
+ putchar (']');
+ p += unified_range_table_bytes_used (p);
+ }
+ break;
+#endif
+
+ case begline:
+ printf ("/begline");
+ break;
+
+ case endline:
+ printf ("/endline");
+ break;
+
+ case on_failure_jump:
+ extract_number_and_incr (&mcnt, &p);
+ printf ("/on_failure_jump to %ld", (long)(p + mcnt - start));
+ break;
+
+ case on_failure_keep_string_jump:
+ extract_number_and_incr (&mcnt, &p);
+ printf ("/on_failure_keep_string_jump to %ld", (long)(p + mcnt - start));
+ break;
+
+ case dummy_failure_jump:
+ extract_number_and_incr (&mcnt, &p);
+ printf ("/dummy_failure_jump to %ld", (long)(p + mcnt - start));
+ break;
+
+ case push_dummy_failure:
+ printf ("/push_dummy_failure");
+ break;
+
+ case maybe_pop_jump:
+ extract_number_and_incr (&mcnt, &p);
+ printf ("/maybe_pop_jump to %ld", (long)(p + mcnt - start));
+ break;
+
+ case pop_failure_jump:
+ extract_number_and_incr (&mcnt, &p);
+ printf ("/pop_failure_jump to %ld", (long)(p + mcnt - start));
+ break;
+
+ case jump_past_alt:
+ extract_number_and_incr (&mcnt, &p);
+ printf ("/jump_past_alt to %ld", (long)(p + mcnt - start));
+ break;
+
+ case jump:
+ extract_number_and_incr (&mcnt, &p);
+ printf ("/jump to %ld", (long)(p + mcnt - start));
+ break;
+
+ case succeed_n:
+ extract_number_and_incr (&mcnt, &p);
+ extract_number_and_incr (&mcnt2, &p);
+ printf ("/succeed_n to %ld, %d times", (long)(p + mcnt - start), mcnt2);
+ break;
+
+ case jump_n:
+ extract_number_and_incr (&mcnt, &p);
+ extract_number_and_incr (&mcnt2, &p);
+ printf ("/jump_n to %ld, %d times", (long)(p + mcnt - start), mcnt2);
+ break;
+
+ case set_number_at:
+ extract_number_and_incr (&mcnt, &p);
+ extract_number_and_incr (&mcnt2, &p);
+ printf ("/set_number_at location %ld to %d", (long)(p + mcnt - start), mcnt2);
+ break;
+
+ case wordbound:
+ printf ("/wordbound");
+ break;
+
+ case notwordbound:
+ printf ("/notwordbound");
+ break;
+
+ case wordbeg:
+ printf ("/wordbeg");
+ break;
+
+ case wordend:
+ printf ("/wordend");
+
+#ifdef emacs
+ case before_dot:
+ printf ("/before_dot");
+ break;
+
+ case at_dot:
+ printf ("/at_dot");
+ break;
+
+ case after_dot:
+ printf ("/after_dot");
+ break;
+
+ case syntaxspec:
+ printf ("/syntaxspec");
+ mcnt = *p++;
+ printf ("/%d", mcnt);
+ break;
+
+ case notsyntaxspec:
+ printf ("/notsyntaxspec");
+ mcnt = *p++;
+ printf ("/%d", mcnt);
+ break;
+
+#ifdef MULE
+/* 97/2/17 jhod Mule category patch */
+ case categoryspec:
+ printf ("/categoryspec");
+ mcnt = *p++;
+ printf ("/%d", mcnt);
+ break;
+
+ case notcategoryspec:
+ printf ("/notcategoryspec");
+ mcnt = *p++;
+ printf ("/%d", mcnt);
+ break;
+/* end of category patch */
+#endif /* MULE */
+#endif /* emacs */
+
+ case wordchar:
+ printf ("/wordchar");
+ break;
+
+ case notwordchar:
+ printf ("/notwordchar");
+ break;
+
+ case begbuf:
+ printf ("/begbuf");
+ break;
+
+ case endbuf:
+ printf ("/endbuf");
+ break;
+
+ default:
+ printf ("?%d", *(p-1));
+ }
+
+ putchar ('\n');
+ }
+
+ printf ("%ld:\tend of pattern.\n", (long)(p - start));
+}
+
+
+static void
+print_compiled_pattern (struct re_pattern_buffer *bufp)
+{
+ unsigned char *buffer = bufp->buffer;
+
+ print_partial_compiled_pattern (buffer, buffer + bufp->used);
+ printf ("%ld bytes used/%ld bytes allocated.\n", bufp->used,
+ bufp->allocated);
+
+ if (bufp->fastmap_accurate && bufp->fastmap)
+ {
+ printf ("fastmap: ");
+ print_fastmap (bufp->fastmap);
+ }
+
+ printf ("re_nsub: %ld\t", (long)bufp->re_nsub);
+ printf ("regs_alloc: %d\t", bufp->regs_allocated);
+ printf ("can_be_null: %d\t", bufp->can_be_null);
+ printf ("newline_anchor: %d\n", bufp->newline_anchor);
+ printf ("no_sub: %d\t", bufp->no_sub);
+ printf ("not_bol: %d\t", bufp->not_bol);
+ printf ("not_eol: %d\t", bufp->not_eol);
+ printf ("syntax: %d\n", bufp->syntax);
+ /* Perhaps we should print the translate table? */
+ /* and maybe the category table? */
+}
+
+
+static void
+print_double_string (CONST char *where, CONST char *string1, int size1,
+ CONST char *string2, int size2)
+{
+ if (where == NULL)
+ printf ("(null)");
+ else
+ {
+ unsigned int this_char;
+
+ if (FIRST_STRING_P (where))
+ {
+ for (this_char = where - string1; this_char < size1; this_char++)
+ putchar (string1[this_char]);
+
+ where = string2;
+ }
+
+ for (this_char = where - string2; this_char < size2; this_char++)
+ putchar (string2[this_char]);
+ }
+}
+
+#else /* not DEBUG */
+
+#undef assert
+#define assert(e)
+
+#define DEBUG_STATEMENT(e)
+#define DEBUG_PRINT1(x)
+#define DEBUG_PRINT2(x1, x2)
+#define DEBUG_PRINT3(x1, x2, x3)
+#define DEBUG_PRINT4(x1, x2, x3, x4)
+#define DEBUG_PRINT_COMPILED_PATTERN(p, s, e)
+#define DEBUG_PRINT_DOUBLE_STRING(w, s1, sz1, s2, sz2)
+
+#endif /* not DEBUG */
+\f
+/* Set by `re_set_syntax' to the current regexp syntax to recognize. Can
+ also be assigned to arbitrarily: each pattern buffer stores its own
+ syntax, so it can be changed between regex compilations. */
+/* This has no initializer because initialized variables in Emacs
+ become read-only after dumping. */
+reg_syntax_t re_syntax_options;
+
+
+/* Specify the precise syntax of regexps for compilation. This provides
+ for compatibility for various utilities which historically have
+ different, incompatible syntaxes.
+
+ The argument SYNTAX is a bit mask comprised of the various bits
+ defined in regex.h. We return the old syntax. */
+
+reg_syntax_t
+re_set_syntax (reg_syntax_t syntax)
+{
+ reg_syntax_t ret = re_syntax_options;
+
+ re_syntax_options = syntax;
+ return ret;
+}
+\f
+/* This table gives an error message for each of the error codes listed
+ in regex.h. Obviously the order here has to be same as there.
+ POSIX doesn't require that we do anything for REG_NOERROR,
+ but why not be nice? */
+
+static CONST char *re_error_msgid[] =
+{
+ "Success", /* REG_NOERROR */
+ "No match", /* REG_NOMATCH */
+ "Invalid regular expression", /* REG_BADPAT */
+ "Invalid collation character", /* REG_ECOLLATE */
+ "Invalid character class name", /* REG_ECTYPE */
+ "Trailing backslash", /* REG_EESCAPE */
+ "Invalid back reference", /* REG_ESUBREG */
+ "Unmatched [ or [^", /* REG_EBRACK */
+ "Unmatched ( or \\(", /* REG_EPAREN */
+ "Unmatched \\{", /* REG_EBRACE */
+ "Invalid content of \\{\\}", /* REG_BADBR */
+ "Invalid range end", /* REG_ERANGE */
+ "Memory exhausted", /* REG_ESPACE */
+ "Invalid preceding regular expression", /* REG_BADRPT */
+ "Premature end of regular expression", /* REG_EEND */
+ "Regular expression too big", /* REG_ESIZE */
+ "Unmatched ) or \\)", /* REG_ERPAREN */
+#ifdef emacs
+ "Invalid syntax designator", /* REG_ESYNTAX */
+#endif
+#ifdef MULE
+ "Ranges may not span charsets", /* REG_ERANGESPAN */
+ "Invalid category designator", /* REG_ECATEGORY */
+#endif
+};
+\f
+/* Avoiding alloca during matching, to placate r_alloc. */
+
+/* Define MATCH_MAY_ALLOCATE unless we need to make sure that the
+ searching and matching functions should not call alloca. On some
+ systems, alloca is implemented in terms of malloc, and if we're
+ using the relocating allocator routines, then malloc could cause a
+ relocation, which might (if the strings being searched are in the
+ ralloc heap) shift the data out from underneath the regexp
+ routines.
+
+ Here's another reason to avoid allocation: Emacs
+ processes input from X in a signal handler; processing X input may
+ call malloc; if input arrives while a matching routine is calling
+ malloc, then we're scrod. But Emacs can't just block input while
+ calling matching routines; then we don't notice interrupts when
+ they come in. So, Emacs blocks input around all regexp calls
+ except the matching calls, which it leaves unprotected, in the
+ faith that they will not malloc. */
+
+/* Normally, this is fine. */
+#define MATCH_MAY_ALLOCATE
+
+/* When using GNU C, we are not REALLY using the C alloca, no matter
+ what config.h may say. So don't take precautions for it. */
+#ifdef __GNUC__
+#undef C_ALLOCA
+#endif
+
+/* The match routines may not allocate if (1) they would do it with malloc
+ and (2) it's not safe for them to use malloc.
+ Note that if REL_ALLOC is defined, matching would not use malloc for the
+ failure stack, but we would still use it for the register vectors;
+ so REL_ALLOC should not affect this. */
+#if (defined (C_ALLOCA) || defined (REGEX_MALLOC)) && defined (emacs)
+#undef MATCH_MAY_ALLOCATE
+#endif
+
+\f
+/* Failure stack declarations and macros; both re_compile_fastmap and
+ re_match_2 use a failure stack. These have to be macros because of
+ REGEX_ALLOCATE_STACK. */
+
+
+/* Number of failure points for which to initially allocate space
+ when matching. If this number is exceeded, we allocate more
+ space, so it is not a hard limit. */
+#ifndef INIT_FAILURE_ALLOC
+#define INIT_FAILURE_ALLOC 5
+#endif
+
+/* Roughly the maximum number of failure points on the stack. Would be
+ exactly that if always used MAX_FAILURE_SPACE each time we failed.
+ This is a variable only so users of regex can assign to it; we never
+ change it ourselves. */
+#if defined (MATCH_MAY_ALLOCATE)
+/* 4400 was enough to cause a crash on Alpha OSF/1,
+ whose default stack limit is 2mb. */
+int re_max_failures = 20000;
+#else
+int re_max_failures = 2000;
+#endif
+
+union fail_stack_elt
+{
+ unsigned char *pointer;
+ int integer;
+};
+
+typedef union fail_stack_elt fail_stack_elt_t;
+
+typedef struct
+{
+ fail_stack_elt_t *stack;
+ unsigned size;
+ unsigned avail; /* Offset of next open position. */
+} fail_stack_type;
+
+#define FAIL_STACK_EMPTY() (fail_stack.avail == 0)
+#define FAIL_STACK_PTR_EMPTY() (fail_stack_ptr->avail == 0)
+#define FAIL_STACK_FULL() (fail_stack.avail == fail_stack.size)
+
+
+/* Define macros to initialize and free the failure stack.
+ Do `return -2' if the alloc fails. */
+
+#ifdef MATCH_MAY_ALLOCATE
+#define INIT_FAIL_STACK() \
+ do { \
+ fail_stack.stack = (fail_stack_elt_t *) \
+ REGEX_ALLOCATE_STACK (INIT_FAILURE_ALLOC * sizeof (fail_stack_elt_t)); \
+ \
+ if (fail_stack.stack == NULL) \
+ return -2; \
+ \
+ fail_stack.size = INIT_FAILURE_ALLOC; \
+ fail_stack.avail = 0; \
+ } while (0)
+
+#define RESET_FAIL_STACK() REGEX_FREE_STACK (fail_stack.stack)
+#else
+#define INIT_FAIL_STACK() \
+ do { \
+ fail_stack.avail = 0; \
+ } while (0)
+
+#define RESET_FAIL_STACK()
+#endif
+
+
+/* Double the size of FAIL_STACK, up to approximately `re_max_failures' items.
+
+ Return 1 if succeeds, and 0 if either ran out of memory
+ allocating space for it or it was already too large.
+
+ REGEX_REALLOCATE_STACK requires `destination' be declared. */
+
+#define DOUBLE_FAIL_STACK(fail_stack) \
+ ((fail_stack).size > re_max_failures * MAX_FAILURE_ITEMS \
+ ? 0 \
+ : ((fail_stack).stack = (fail_stack_elt_t *) \
+ REGEX_REALLOCATE_STACK ((fail_stack).stack, \
+ (fail_stack).size * sizeof (fail_stack_elt_t), \
+ ((fail_stack).size << 1) * sizeof (fail_stack_elt_t)), \
+ \
+ (fail_stack).stack == NULL \
+ ? 0 \
+ : ((fail_stack).size <<= 1, \
+ 1)))
+
+
+/* Push pointer POINTER on FAIL_STACK.
+ Return 1 if was able to do so and 0 if ran out of memory allocating
+ space to do so. */
+#define PUSH_PATTERN_OP(POINTER, FAIL_STACK) \
+ ((FAIL_STACK_FULL () \
+ && !DOUBLE_FAIL_STACK (FAIL_STACK)) \
+ ? 0 \
+ : ((FAIL_STACK).stack[(FAIL_STACK).avail++].pointer = POINTER, \
+ 1))
+
+/* Push a pointer value onto the failure stack.
+ Assumes the variable `fail_stack'. Probably should only
+ be called from within `PUSH_FAILURE_POINT'. */
+#define PUSH_FAILURE_POINTER(item) \
+ fail_stack.stack[fail_stack.avail++].pointer = (unsigned char *) (item)
+
+/* This pushes an integer-valued item onto the failure stack.
+ Assumes the variable `fail_stack'. Probably should only
+ be called from within `PUSH_FAILURE_POINT'. */
+#define PUSH_FAILURE_INT(item) \
+ fail_stack.stack[fail_stack.avail++].integer = (item)
+
+/* Push a fail_stack_elt_t value onto the failure stack.
+ Assumes the variable `fail_stack'. Probably should only
+ be called from within `PUSH_FAILURE_POINT'. */
+#define PUSH_FAILURE_ELT(item) \
+ fail_stack.stack[fail_stack.avail++] = (item)
+
+/* These three POP... operations complement the three PUSH... operations.
+ All assume that `fail_stack' is nonempty. */
+#define POP_FAILURE_POINTER() fail_stack.stack[--fail_stack.avail].pointer
+#define POP_FAILURE_INT() fail_stack.stack[--fail_stack.avail].integer
+#define POP_FAILURE_ELT() fail_stack.stack[--fail_stack.avail]
+
+/* Used to omit pushing failure point id's when we're not debugging. */
+#ifdef DEBUG
+#define DEBUG_PUSH PUSH_FAILURE_INT
+#define DEBUG_POP(item_addr) *(item_addr) = POP_FAILURE_INT ()
+#else
+#define DEBUG_PUSH(item)
+#define DEBUG_POP(item_addr)
+#endif
+
+
+/* Push the information about the state we will need
+ if we ever fail back to it.
+
+ Requires variables fail_stack, regstart, regend, reg_info, and
+ num_regs be declared. DOUBLE_FAIL_STACK requires `destination' be
+ declared.
+
+ Does `return FAILURE_CODE' if runs out of memory. */
+
+#if !defined (REGEX_MALLOC) && !defined (REL_ALLOC)
+#define DECLARE_DESTINATION char *destination;
+#else
+#define DECLARE_DESTINATION
+#endif
+
+#define PUSH_FAILURE_POINT(pattern_place, string_place, failure_code) \
+ do { \
+ DECLARE_DESTINATION \
+ /* Must be int, so when we don't save any registers, the arithmetic \
+ of 0 + -1 isn't done as unsigned. */ \
+ int this_reg; \
+ \
+ DEBUG_STATEMENT (failure_id++); \
+ DEBUG_STATEMENT (nfailure_points_pushed++); \
+ DEBUG_PRINT2 ("\nPUSH_FAILURE_POINT #%u:\n", failure_id); \
+ DEBUG_PRINT2 (" Before push, next avail: %d\n", (fail_stack).avail);\
+ DEBUG_PRINT2 (" size: %d\n", (fail_stack).size);\
+ \
+ DEBUG_PRINT2 (" slots needed: %d\n", NUM_FAILURE_ITEMS); \
+ DEBUG_PRINT2 (" available: %d\n", REMAINING_AVAIL_SLOTS); \
+ \
+ /* Ensure we have enough space allocated for what we will push. */ \
+ while (REMAINING_AVAIL_SLOTS < NUM_FAILURE_ITEMS) \
+ { \
+ if (!DOUBLE_FAIL_STACK (fail_stack)) \
+ return failure_code; \
+ \
+ DEBUG_PRINT2 ("\n Doubled stack; size now: %d\n", \
+ (fail_stack).size); \
+ DEBUG_PRINT2 (" slots available: %d\n", REMAINING_AVAIL_SLOTS);\
+ } \
+ \
+ /* Push the info, starting with the registers. */ \
+ DEBUG_PRINT1 ("\n"); \
+ \
+ for (this_reg = lowest_active_reg; this_reg <= highest_active_reg; \
+ this_reg++) \
+ { \
+ DEBUG_PRINT2 (" Pushing reg: %d\n", this_reg); \
+ DEBUG_STATEMENT (num_regs_pushed++); \
+ \
+ DEBUG_PRINT2 (" start: 0x%p\n", regstart[this_reg]); \
+ PUSH_FAILURE_POINTER (regstart[this_reg]); \
+ \
+ DEBUG_PRINT2 (" end: 0x%p\n", regend[this_reg]); \
+ PUSH_FAILURE_POINTER (regend[this_reg]); \
+ \
+ DEBUG_PRINT2 (" info: 0x%lx\n ", \
+ * (unsigned long *) (®_info[this_reg])); \
+ DEBUG_PRINT2 (" match_null=%d", \
+ REG_MATCH_NULL_STRING_P (reg_info[this_reg])); \
+ DEBUG_PRINT2 (" active=%d", IS_ACTIVE (reg_info[this_reg])); \
+ DEBUG_PRINT2 (" matched_something=%d", \
+ MATCHED_SOMETHING (reg_info[this_reg])); \
+ DEBUG_PRINT2 (" ever_matched=%d", \
+ EVER_MATCHED_SOMETHING (reg_info[this_reg])); \
+ DEBUG_PRINT1 ("\n"); \
+ PUSH_FAILURE_ELT (reg_info[this_reg].word); \
+ } \
+ \
+ DEBUG_PRINT2 (" Pushing low active reg: %d\n", lowest_active_reg);\
+ PUSH_FAILURE_INT (lowest_active_reg); \
+ \
+ DEBUG_PRINT2 (" Pushing high active reg: %d\n", highest_active_reg);\
+ PUSH_FAILURE_INT (highest_active_reg); \
+ \
+ DEBUG_PRINT2 (" Pushing pattern 0x%p: ", pattern_place); \
+ DEBUG_PRINT_COMPILED_PATTERN (bufp, pattern_place, pend); \
+ PUSH_FAILURE_POINTER (pattern_place); \
+ \
+ DEBUG_PRINT2 (" Pushing string 0x%p: `", string_place); \
+ DEBUG_PRINT_DOUBLE_STRING (string_place, string1, size1, string2, \
+ size2); \
+ DEBUG_PRINT1 ("'\n"); \
+ PUSH_FAILURE_POINTER (string_place); \
+ \
+ DEBUG_PRINT2 (" Pushing failure id: %u\n", failure_id); \
+ DEBUG_PUSH (failure_id); \
+ } while (0)
+
+/* This is the number of items that are pushed and popped on the stack
+ for each register. */
+#define NUM_REG_ITEMS 3
+
+/* Individual items aside from the registers. */
+#ifdef DEBUG
+#define NUM_NONREG_ITEMS 5 /* Includes failure point id. */
+#else
+#define NUM_NONREG_ITEMS 4
+#endif
+
+/* We push at most this many items on the stack. */
+/* We used to use (num_regs - 1), which is the number of registers
+ this regexp will save; but that was changed to 5
+ to avoid stack overflow for a regexp with lots of parens. */
+#define MAX_FAILURE_ITEMS (5 * NUM_REG_ITEMS + NUM_NONREG_ITEMS)
+
+/* We actually push this many items. */
+#define NUM_FAILURE_ITEMS \
+ ((highest_active_reg - lowest_active_reg + 1) * NUM_REG_ITEMS \
+ + NUM_NONREG_ITEMS)
+
+/* How many items can still be added to the stack without overflowing it. */
+#define REMAINING_AVAIL_SLOTS ((fail_stack).size - (fail_stack).avail)
+
+
+/* Pops what PUSH_FAIL_STACK pushes.
+
+ We restore into the parameters, all of which should be lvalues:
+ STR -- the saved data position.
+ PAT -- the saved pattern position.
+ LOW_REG, HIGH_REG -- the highest and lowest active registers.
+ REGSTART, REGEND -- arrays of string positions.
+ REG_INFO -- array of information about each subexpression.
+
+ Also assumes the variables `fail_stack' and (if debugging), `bufp',
+ `pend', `string1', `size1', `string2', and `size2'. */
+
+#define POP_FAILURE_POINT(str, pat, low_reg, high_reg, regstart, regend, reg_info)\
+{ \
+ DEBUG_STATEMENT (fail_stack_elt_t ffailure_id;) \
+ int this_reg; \
+ CONST unsigned char *string_temp; \
+ \
+ assert (!FAIL_STACK_EMPTY ()); \
+ \
+ /* Remove failure points and point to how many regs pushed. */ \
+ DEBUG_PRINT1 ("POP_FAILURE_POINT:\n"); \
+ DEBUG_PRINT2 (" Before pop, next avail: %d\n", fail_stack.avail); \
+ DEBUG_PRINT2 (" size: %d\n", fail_stack.size); \
+ \
+ assert (fail_stack.avail >= NUM_NONREG_ITEMS); \
+ \
+ DEBUG_POP (&ffailure_id.integer); \
+ DEBUG_PRINT2 (" Popping failure id: %u\n", \
+ * (unsigned int *) &ffailure_id); \
+ \
+ /* If the saved string location is NULL, it came from an \
+ on_failure_keep_string_jump opcode, and we want to throw away the \
+ saved NULL, thus retaining our current position in the string. */ \
+ string_temp = POP_FAILURE_POINTER (); \
+ if (string_temp != NULL) \
+ str = (CONST char *) string_temp; \
+ \
+ DEBUG_PRINT2 (" Popping string 0x%p: `", str); \
+ DEBUG_PRINT_DOUBLE_STRING (str, string1, size1, string2, size2); \
+ DEBUG_PRINT1 ("'\n"); \
+ \
+ pat = (unsigned char *) POP_FAILURE_POINTER (); \
+ DEBUG_PRINT2 (" Popping pattern 0x%p: ", pat); \
+ DEBUG_PRINT_COMPILED_PATTERN (bufp, pat, pend); \
+ \
+ /* Restore register info. */ \
+ high_reg = (unsigned) POP_FAILURE_INT (); \
+ DEBUG_PRINT2 (" Popping high active reg: %d\n", high_reg); \
+ \
+ low_reg = (unsigned) POP_FAILURE_INT (); \
+ DEBUG_PRINT2 (" Popping low active reg: %d\n", low_reg); \
+ \
+ for (this_reg = high_reg; this_reg >= low_reg; this_reg--) \
+ { \
+ DEBUG_PRINT2 (" Popping reg: %d\n", this_reg); \
+ \
+ reg_info[this_reg].word = POP_FAILURE_ELT (); \
+ DEBUG_PRINT2 (" info: 0x%lx\n", \
+ * (unsigned long *) ®_info[this_reg]); \
+ \
+ regend[this_reg] = (CONST char *) POP_FAILURE_POINTER (); \
+ DEBUG_PRINT2 (" end: 0x%p\n", regend[this_reg]); \
+ \
+ regstart[this_reg] = (CONST char *) POP_FAILURE_POINTER (); \
+ DEBUG_PRINT2 (" start: 0x%p\n", regstart[this_reg]); \
+ } \
+ \
+ set_regs_matched_done = 0; \
+ DEBUG_STATEMENT (nfailure_points_popped++); \
+} /* POP_FAILURE_POINT */
+
+
+\f
+/* Structure for per-register (a.k.a. per-group) information.
+ Other register information, such as the
+ starting and ending positions (which are addresses), and the list of
+ inner groups (which is a bits list) are maintained in separate
+ variables.
+
+ We are making a (strictly speaking) nonportable assumption here: that
+ the compiler will pack our bit fields into something that fits into
+ the type of `word', i.e., is something that fits into one item on the
+ failure stack. */
+
+typedef union
+{
+ fail_stack_elt_t word;
+ struct
+ {
+ /* This field is one if this group can match the empty string,
+ zero if not. If not yet determined, `MATCH_NULL_UNSET_VALUE'. */
+#define MATCH_NULL_UNSET_VALUE 3
+ unsigned match_null_string_p : 2;
+ unsigned is_active : 1;
+ unsigned matched_something : 1;
+ unsigned ever_matched_something : 1;
+ } bits;
+} register_info_type;
+
+#define REG_MATCH_NULL_STRING_P(R) ((R).bits.match_null_string_p)
+#define IS_ACTIVE(R) ((R).bits.is_active)
+#define MATCHED_SOMETHING(R) ((R).bits.matched_something)
+#define EVER_MATCHED_SOMETHING(R) ((R).bits.ever_matched_something)
+
+
+/* Call this when have matched a real character; it sets `matched' flags
+ for the subexpressions which we are currently inside. Also records
+ that those subexprs have matched. */
+#define SET_REGS_MATCHED() \
+ do \
+ { \
+ if (!set_regs_matched_done) \
+ { \
+ unsigned r; \
+ set_regs_matched_done = 1; \
+ for (r = lowest_active_reg; r <= highest_active_reg; r++) \
+ { \
+ MATCHED_SOMETHING (reg_info[r]) \
+ = EVER_MATCHED_SOMETHING (reg_info[r]) \
+ = 1; \
+ } \
+ } \
+ } \
+ while (0)
+
+/* Registers are set to a sentinel when they haven't yet matched. */
+static char reg_unset_dummy;
+#define REG_UNSET_VALUE (®_unset_dummy)
+#define REG_UNSET(e) ((e) == REG_UNSET_VALUE)
+\f
+/* Subroutine declarations and macros for regex_compile. */
+
+/* Fetch the next character in the uncompiled pattern---translating it
+ if necessary. Also cast from a signed character in the constant
+ string passed to us by the user to an unsigned char that we can use
+ as an array index (in, e.g., `translate'). */
+#define PATFETCH(c) \
+ do {if (p == pend) return REG_EEND; \
+ assert (p < pend); \
+ c = (unsigned char) *p++; \
+ if (translate) c = (unsigned char) translate[c]; \
+ } while (0)
+
+/* Fetch the next character in the uncompiled pattern, with no
+ translation. */
+#define PATFETCH_RAW(c) \
+ do {if (p == pend) return REG_EEND; \
+ assert (p < pend); \
+ c = (unsigned char) *p++; \
+ } while (0)
+
+/* Go backwards one character in the pattern. */
+#define PATUNFETCH p--
+
+#ifdef MULE
+
+#define PATFETCH_EXTENDED(emch) \
+ do {if (p == pend) return REG_EEND; \
+ assert (p < pend); \
+ emch = charptr_emchar ((CONST Bufbyte *) p); \
+ INC_CHARPTR (p); \
+ if (translate && emch < 0x80) \
+ emch = (Emchar) (unsigned char) translate[emch]; \
+ } while (0)
+
+#define PATFETCH_RAW_EXTENDED(emch) \
+ do {if (p == pend) return REG_EEND; \
+ assert (p < pend); \
+ emch = charptr_emchar ((CONST Bufbyte *) p); \
+ INC_CHARPTR (p); \
+ } while (0)
+
+#define PATUNFETCH_EXTENDED DEC_CHARPTR (p)
+
+#define PATFETCH_EITHER(emch) \
+ do { \
+ if (has_extended_chars) \
+ PATFETCH_EXTENDED (emch); \
+ else \
+ PATFETCH (emch); \
+ } while (0)
+
+#define PATFETCH_RAW_EITHER(emch) \
+ do { \
+ if (has_extended_chars) \
+ PATFETCH_RAW_EXTENDED (emch); \
+ else \
+ PATFETCH_RAW (emch); \
+ } while (0)
+
+#define PATUNFETCH_EITHER \
+ do { \
+ if (has_extended_chars) \
+ PATUNFETCH_EXTENDED (emch); \
+ else \
+ PATUNFETCH (emch); \
+ } while (0)
+
+#else /* not MULE */
+
+#define PATFETCH_EITHER(emch) PATFETCH (emch)
+#define PATFETCH_RAW_EITHER(emch) PATFETCH_RAW (emch)
+#define PATUNFETCH_EITHER PATUNFETCH
+
+#endif /* not MULE */
+
+/* If `translate' is non-null, return translate[D], else just D. We
+ cast the subscript to translate because some data is declared as
+ `char *', to avoid warnings when a string constant is passed. But
+ when we use a character as a subscript we must make it unsigned. */
+#define TRANSLATE(d) (translate ? translate[(unsigned char) (d)] : (d))
+
+#ifdef MULE
+
+#define TRANSLATE_EXTENDED_UNSAFE(emch) \
+ (translate && emch < 0x80 ? translate[emch] : (emch))
+
+#endif
+
+/* Macros for outputting the compiled pattern into `buffer'. */
+
+/* If the buffer isn't allocated when it comes in, use this. */
+#define INIT_BUF_SIZE 32
+
+/* Make sure we have at least N more bytes of space in buffer. */
+#define GET_BUFFER_SPACE(n) \
+ while (b - bufp->buffer + (n) > bufp->allocated) \
+ EXTEND_BUFFER ()
+
+/* Make sure we have one more byte of buffer space and then add C to it. */
+#define BUF_PUSH(c) \
+ do { \
+ GET_BUFFER_SPACE (1); \
+ *b++ = (unsigned char) (c); \
+ } while (0)
+
+
+/* Ensure we have two more bytes of buffer space and then append C1 and C2. */
+#define BUF_PUSH_2(c1, c2) \
+ do { \
+ GET_BUFFER_SPACE (2); \
+ *b++ = (unsigned char) (c1); \
+ *b++ = (unsigned char) (c2); \
+ } while (0)
+
+
+/* As with BUF_PUSH_2, except for three bytes. */
+#define BUF_PUSH_3(c1, c2, c3) \
+ do { \
+ GET_BUFFER_SPACE (3); \
+ *b++ = (unsigned char) (c1); \
+ *b++ = (unsigned char) (c2); \
+ *b++ = (unsigned char) (c3); \
+ } while (0)
+
+
+/* Store a jump with opcode OP at LOC to location TO. We store a
+ relative address offset by the three bytes the jump itself occupies. */
+#define STORE_JUMP(op, loc, to) \
+ store_op1 (op, loc, (to) - (loc) - 3)
+
+/* Likewise, for a two-argument jump. */
+#define STORE_JUMP2(op, loc, to, arg) \
+ store_op2 (op, loc, (to) - (loc) - 3, arg)
+
+/* Like `STORE_JUMP', but for inserting. Assume `b' is the buffer end. */
+#define INSERT_JUMP(op, loc, to) \
+ insert_op1 (op, loc, (to) - (loc) - 3, b)
+
+/* Like `STORE_JUMP2', but for inserting. Assume `b' is the buffer end. */
+#define INSERT_JUMP2(op, loc, to, arg) \
+ insert_op2 (op, loc, (to) - (loc) - 3, arg, b)
+
+
+/* This is not an arbitrary limit: the arguments which represent offsets
+ into the pattern are two bytes long. So if 2^16 bytes turns out to
+ be too small, many things would have to change. */
+#define MAX_BUF_SIZE (1L << 16)
+
+
+/* Extend the buffer by twice its current size via realloc and
+ reset the pointers that pointed into the old block to point to the
+ correct places in the new one. If extending the buffer results in it
+ being larger than MAX_BUF_SIZE, then flag memory exhausted. */
+#define EXTEND_BUFFER() \
+ do { \
+ unsigned char *old_buffer = bufp->buffer; \
+ if (bufp->allocated == MAX_BUF_SIZE) \
+ return REG_ESIZE; \
+ bufp->allocated <<= 1; \
+ if (bufp->allocated > MAX_BUF_SIZE) \
+ bufp->allocated = MAX_BUF_SIZE; \
+ bufp->buffer = (unsigned char *) realloc (bufp->buffer, bufp->allocated);\
+ if (bufp->buffer == NULL) \
+ return REG_ESPACE; \
+ /* If the buffer moved, move all the pointers into it. */ \
+ if (old_buffer != bufp->buffer) \
+ { \
+ b = (b - old_buffer) + bufp->buffer; \
+ begalt = (begalt - old_buffer) + bufp->buffer; \
+ if (fixup_alt_jump) \
+ fixup_alt_jump = (fixup_alt_jump - old_buffer) + bufp->buffer;\
+ if (laststart) \
+ laststart = (laststart - old_buffer) + bufp->buffer; \
+ if (pending_exact) \
+ pending_exact = (pending_exact - old_buffer) + bufp->buffer; \
+ } \
+ } while (0)
+
+
+/* Since we have one byte reserved for the register number argument to
+ {start,stop}_memory, the maximum number of groups we can report
+ things about is what fits in that byte. */
+#define MAX_REGNUM 255
+
+/* But patterns can have more than `MAX_REGNUM' registers. We just
+ ignore the excess. */
+typedef unsigned regnum_t;
+
+
+/* Macros for the compile stack. */
+
+/* Since offsets can go either forwards or backwards, this type needs to
+ be able to hold values from -(MAX_BUF_SIZE - 1) to MAX_BUF_SIZE - 1. */
+typedef int pattern_offset_t;
+
+typedef struct
+{
+ pattern_offset_t begalt_offset;
+ pattern_offset_t fixup_alt_jump;
+ pattern_offset_t inner_group_offset;
+ pattern_offset_t laststart_offset;
+ regnum_t regnum;
+} compile_stack_elt_t;
+
+
+typedef struct
+{
+ compile_stack_elt_t *stack;
+ unsigned size;
+ unsigned avail; /* Offset of next open position. */
+} compile_stack_type;
+
+
+#define INIT_COMPILE_STACK_SIZE 32
+
+#define COMPILE_STACK_EMPTY (compile_stack.avail == 0)
+#define COMPILE_STACK_FULL (compile_stack.avail == compile_stack.size)
+
+/* The next available element. */
+#define COMPILE_STACK_TOP (compile_stack.stack[compile_stack.avail])
+
+
+/* Set the bit for character C in a bit vector. */
+#define SET_LIST_BIT(c) \
+ (b[((unsigned char) (c)) / BYTEWIDTH] \
+ |= 1 << (((unsigned char) c) % BYTEWIDTH))
+
+#ifdef MULE
+
+/* Set the "bit" for character C in a range table. */
+#define SET_RANGETAB_BIT(c) put_range_table (rtab, c, c, Qt)
+
+/* Set the "bit" for character c in the appropriate table. */
+#define SET_EITHER_BIT(c) \
+ do { \
+ if (has_extended_chars) \
+ SET_RANGETAB_BIT (c); \
+ else \
+ SET_LIST_BIT (c); \
+ } while (0)
+
+#else /* not MULE */
+
+#define SET_EITHER_BIT(c) SET_LIST_BIT (c)
+
+#endif
+
+
+/* Get the next unsigned number in the uncompiled pattern. */
+#define GET_UNSIGNED_NUMBER(num) \
+ { if (p != pend) \
+ { \
+ PATFETCH (c); \
+ while (ISDIGIT (c)) \
+ { \
+ if (num < 0) \
+ num = 0; \
+ num = num * 10 + c - '0'; \
+ if (p == pend) \
+ break; \
+ PATFETCH (c); \
+ } \
+ } \
+ }
+
+#define CHAR_CLASS_MAX_LENGTH 6 /* Namely, `xdigit'. */
+
+#define IS_CHAR_CLASS(string) \
+ (STREQ (string, "alpha") || STREQ (string, "upper") \
+ || STREQ (string, "lower") || STREQ (string, "digit") \
+ || STREQ (string, "alnum") || STREQ (string, "xdigit") \
+ || STREQ (string, "space") || STREQ (string, "print") \
+ || STREQ (string, "punct") || STREQ (string, "graph") \
+ || STREQ (string, "cntrl") || STREQ (string, "blank"))
+\f
+static void store_op1 (re_opcode_t op, unsigned char *loc, int arg);
+static void store_op2 (re_opcode_t op, unsigned char *loc, int arg1, int arg2);
+static void insert_op1 (re_opcode_t op, unsigned char *loc, int arg,
+ 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,
+ reg_syntax_t 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,
+ 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,
+ char *translate,
+ reg_syntax_t syntax,
+ Lisp_Object rtab);
+#endif /* MULE */
+static boolean group_match_null_string_p (unsigned char **p,
+ unsigned char *end,
+ register_info_type *reg_info);
+static boolean alt_match_null_string_p (unsigned char *p, unsigned char *end,
+ register_info_type *reg_info);
+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,
+ 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,
+ struct re_registers *regs, int stop);
+\f
+#ifndef MATCH_MAY_ALLOCATE
+
+/* If we cannot allocate large objects within re_match_2_internal,
+ we make the fail stack and register vectors global.
+ The fail stack, we grow to the maximum size when a regexp
+ is compiled.
+ The register vectors, we adjust in size each time we
+ compile a regexp, according to the number of registers it needs. */
+
+static fail_stack_type fail_stack;
+
+/* Size with which the following vectors are currently allocated.
+ That is so we can make them bigger as needed,
+ 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 register_info_type *reg_info;
+static CONST char **reg_dummy;
+static register_info_type *reg_info_dummy;
+
+/* Make the register vectors big enough for NUM_REGS registers,
+ but don't make them smaller. */
+
+static
+regex_grow_registers (int num_regs)
+{
+ 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 (reg_info, num_regs, register_info_type);
+ RETALLOC_IF (reg_dummy, num_regs, CONST char *);
+ RETALLOC_IF (reg_info_dummy, num_regs, register_info_type);
+
+ regs_allocated_size = num_regs;
+ }
+}
+
+#endif /* not MATCH_MAY_ALLOCATE */
+\f
+/* `regex_compile' compiles PATTERN (of length SIZE) according to SYNTAX.
+ Returns one of error codes defined in `regex.h', or zero for success.
+
+ Assumes the `allocated' (and perhaps `buffer') and `translate'
+ fields are set in BUFP on entry.
+
+ If it succeeds, results are put in BUFP (if it returns an error, the
+ contents of BUFP are undefined):
+ `buffer' is the compiled pattern;
+ `syntax' is set to SYNTAX;
+ `used' is set to the length of the compiled pattern;
+ `fastmap_accurate' is zero;
+ `re_nsub' is the number of subexpressions in PATTERN;
+ `not_bol' and `not_eol' are zero;
+
+ The `fastmap' and `newline_anchor' fields are neither
+ examined nor set. */
+
+/* Return, freeing storage we allocated. */
+#define FREE_STACK_RETURN(value) \
+ return (free (compile_stack.stack), value)
+
+static reg_errcode_t
+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
+ (or possibly long) so that chars above 127 can be used as
+ array indices. The macros that fetch a character from the pattern
+ make sure to coerce to unsigned char before assigning, so we won't
+ get bitten by negative numbers here. */
+ /* XEmacs change: used to be unsigned char. */
+ REGISTER EMACS_INT c, c1;
+
+ /* A random temporary spot in PATTERN. */
+ CONST char *p1;
+
+ /* Points to the end of the buffer, where we should append. */
+ REGISTER unsigned char *b;
+
+ /* Keeps track of unclosed groups. */
+ compile_stack_type compile_stack;
+
+ /* Points to the current (ending) position in the pattern. */
+ CONST char *p = pattern;
+ CONST char *pend = pattern + size;
+
+ /* How to translate the characters in the pattern. */
+ char *translate = bufp->translate;
+
+ /* Address of the count-byte of the most recently inserted `exactn'
+ command. This makes it possible to tell if a new exact-match
+ character can be added to that command or if the character requires
+ a new `exactn' command. */
+ unsigned char *pending_exact = 0;
+
+ /* Address of start of the most recently finished expression.
+ This tells, e.g., postfix * where to find the start of its
+ operand. Reset at the beginning of groups and alternatives. */
+ unsigned char *laststart = 0;
+
+ /* Address of beginning of regexp, or inside of last group. */
+ unsigned char *begalt;
+
+ /* Place in the uncompiled pattern (i.e., the {) to
+ which to go back if the interval is invalid. */
+ 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
+ last -- ends with a forward jump of this sort. */
+ unsigned char *fixup_alt_jump = 0;
+
+ /* Counts open-groups as they are encountered. Remembered for the
+ matching close-group on the compile stack, so the same register
+ number is put in the stop_memory as the start_memory. */
+ regnum_t regnum = 0;
+
+#ifdef DEBUG
+ DEBUG_PRINT1 ("\nCompiling pattern: ");
+ if (debug)
+ {
+ unsigned debug_count;
+
+ for (debug_count = 0; debug_count < size; debug_count++)
+ putchar (pattern[debug_count]);
+ putchar ('\n');
+ }
+#endif /* DEBUG */
+
+ /* Initialize the compile stack. */
+ compile_stack.stack = TALLOC (INIT_COMPILE_STACK_SIZE, compile_stack_elt_t);
+ if (compile_stack.stack == NULL)
+ return REG_ESPACE;
+
+ compile_stack.size = INIT_COMPILE_STACK_SIZE;
+ compile_stack.avail = 0;
+
+ /* Initialize the pattern buffer. */
+ bufp->syntax = syntax;
+ bufp->fastmap_accurate = 0;
+ bufp->not_bol = bufp->not_eol = 0;
+
+ /* Set `used' to zero, so that if we return an error, the pattern
+ printer (for debugging) will think there's no pattern. We reset it
+ at the end. */
+ bufp->used = 0;
+
+ /* Always count groups, whether or not bufp->no_sub is set. */
+ bufp->re_nsub = 0;
+
+#if !defined (emacs) && !defined (SYNTAX_TABLE)
+ /* Initialize the syntax table. */
+ init_syntax_once ();
+#endif
+
+ if (bufp->allocated == 0)
+ {
+ if (bufp->buffer)
+ { /* If zero allocated, but buffer is non-null, try to realloc
+ enough space. This loses if buffer's address is bogus, but
+ that is the user's responsibility. */
+ RETALLOC (bufp->buffer, INIT_BUF_SIZE, unsigned char);
+ }
+ else
+ { /* Caller did not allocate a buffer. Do it for them. */
+ bufp->buffer = TALLOC (INIT_BUF_SIZE, unsigned char);
+ }
+ if (!bufp->buffer) FREE_STACK_RETURN (REG_ESPACE);
+
+ bufp->allocated = INIT_BUF_SIZE;
+ }
+
+ begalt = b = bufp->buffer;
+
+ /* Loop through the uncompiled pattern until we're at the end. */
+ while (p != pend)
+ {
+ PATFETCH (c);
+
+ switch (c)
+ {
+ case '^':
+ {
+ if ( /* If at start of pattern, it's an operator. */
+ p == pattern + 1
+ /* If context independent, it's an operator. */
+ || syntax & RE_CONTEXT_INDEP_ANCHORS
+ /* Otherwise, depends on what's come before. */
+ || at_begline_loc_p (pattern, p, syntax))
+ BUF_PUSH (begline);
+ else
+ goto normal_char;
+ }
+ break;
+
+
+ case '$':
+ {
+ if ( /* If at end of pattern, it's an operator. */
+ p == pend
+ /* If context independent, it's an operator. */
+ || syntax & RE_CONTEXT_INDEP_ANCHORS
+ /* Otherwise, depends on what's next. */
+ || at_endline_loc_p (p, pend, syntax))
+ BUF_PUSH (endline);
+ else
+ goto normal_char;
+ }
+ break;
+
+
+ case '+':
+ case '?':
+ if ((syntax & RE_BK_PLUS_QM)
+ || (syntax & RE_LIMITED_OPS))
+ goto normal_char;
+ handle_plus:
+ case '*':
+ /* If there is no previous pattern... */
+ if (!laststart)
+ {
+ if (syntax & RE_CONTEXT_INVALID_OPS)
+ FREE_STACK_RETURN (REG_BADRPT);
+ else if (!(syntax & RE_CONTEXT_INDEP_OPS))
+ goto normal_char;
+ }
+
+ {
+ /* true means zero/many matches are allowed. */
+ boolean zero_times_ok = c != '+';
+ boolean many_times_ok = c != '?';
+
+ /* true means match shortest string possible. */
+ boolean minimal = false;
+
+ /* If there is a sequence of repetition chars, collapse it
+ down to just one (the right one). We can't combine
+ interval operators with these because of, e.g., `a{2}*',
+ which should only match an even number of `a's. */
+ while (p != pend)
+ {
+ PATFETCH (c);
+
+ if (c == '*' || (!(syntax & RE_BK_PLUS_QM)
+ && (c == '+' || c == '?')))
+ ;
+
+ else if (syntax & RE_BK_PLUS_QM && c == '\\')
+ {
+ if (p == pend) FREE_STACK_RETURN (REG_EESCAPE);
+
+ PATFETCH (c1);
+ if (!(c1 == '+' || c1 == '?'))
+ {
+ PATUNFETCH;
+ PATUNFETCH;
+ break;
+ }
+
+ c = c1;
+ }
+ else
+ {
+ PATUNFETCH;
+ break;
+ }
+
+ /* 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). */
+ if (minimal || c != '?')
+ FREE_STACK_RETURN (REG_BADRPT);
+ minimal = true;
+ }
+ else
+ {
+ zero_times_ok |= c != '+';
+ many_times_ok |= c != '?';
+ }
+ }
+
+ /* Star, etc. applied to an empty pattern is equivalent
+ to an empty pattern. */
+ if (!laststart)
+ break;
+
+ /* Now we know whether zero matches is allowed
+ and whether two or more matches is allowed
+ and whether we want minimal or maximal matching. */
+ if (minimal)
+ {
+ if (!many_times_ok)
+ {
+ /* "a??" becomes:
+ 0: /on_failure_jump to 6
+ 3: /jump to 9
+ 6: /exactn/1/A
+ 9: end of pattern.
+ */
+ GET_BUFFER_SPACE (6);
+ INSERT_JUMP (jump, laststart, b + 3);
+ b += 3;
+ INSERT_JUMP (on_failure_jump, laststart, laststart + 6);
+ b += 3;
+ }
+ else if (zero_times_ok)
+ {
+ /* "a*?" becomes:
+ 0: /jump to 6
+ 3: /exactn/1/A
+ 6: /on_failure_jump to 3
+ 9: end of pattern.
+ */
+ GET_BUFFER_SPACE (6);
+ INSERT_JUMP (jump, laststart, b + 3);
+ b += 3;
+ STORE_JUMP (on_failure_jump, b, laststart + 3);
+ b += 3;
+ }
+ else
+ {
+ /* "a+?" becomes:
+ 0: /exactn/1/A
+ 3: /on_failure_jump to 0
+ 6: end of pattern.
+ */
+ GET_BUFFER_SPACE (3);
+ STORE_JUMP (on_failure_jump, b, laststart);
+ b += 3;
+ }
+ }
+ else
+ {
+ /* Are we optimizing this jump? */
+ boolean keep_string_p = false;
+
+ if (many_times_ok)
+ { /* More than one repetition is allowed, so put in at the
+ end a backward relative jump from `b' to before the next
+ jump we're going to put in below (which jumps from
+ laststart to after this jump).
+
+ But if we are at the `*' in the exact sequence `.*\n',
+ insert an unconditional jump backwards to the .,
+ instead of the beginning of the loop. This way we only
+ push a failure point once, instead of every time
+ through the loop. */
+ assert (p - 1 > pattern);
+
+ /* Allocate the space for the jump. */
+ GET_BUFFER_SPACE (3);
+
+ /* We know we are not at the first character of the
+ pattern, because laststart was nonzero. And we've
+ already incremented `p', by the way, to be the
+ character after the `*'. Do we have to do something
+ analogous here for null bytes, because of
+ RE_DOT_NOT_NULL? */
+ if (TRANSLATE (*(p - 2)) == TRANSLATE ('.')
+ && zero_times_ok
+ && p < pend && TRANSLATE (*p) == TRANSLATE ('\n')
+ && !(syntax & RE_DOT_NEWLINE))
+ { /* We have .*\n. */
+ STORE_JUMP (jump, b, laststart);
+ keep_string_p = true;
+ }
+ else
+ /* Anything else. */
+ STORE_JUMP (maybe_pop_jump, b, laststart - 3);
+
+ /* We've added more stuff to the buffer. */
+ b += 3;
+ }
+
+ /* On failure, jump from laststart to b + 3, which will be the
+ end of the buffer after this jump is inserted. */
+ GET_BUFFER_SPACE (3);
+ INSERT_JUMP (keep_string_p ? on_failure_keep_string_jump
+ : on_failure_jump,
+ laststart, b + 3);
+ b += 3;
+
+ if (!zero_times_ok)
+ {
+ /* At least one repetition is required, so insert a
+ `dummy_failure_jump' before the initial
+ `on_failure_jump' instruction of the loop. This
+ effects a skip over that instruction the first time
+ we hit that loop. */
+ GET_BUFFER_SPACE (3);
+ INSERT_JUMP (dummy_failure_jump, laststart, laststart + 6);
+ b += 3;
+ }
+ }
+ pending_exact = 0;
+ }
+ break;
+
+
+ case '.':
+ laststart = b;
+ BUF_PUSH (anychar);
+ break;
+
+
+ case '[':
+ {
+ /* XEmacs change: this whole section */
+ boolean had_char_class = false;
+#ifdef MULE
+ boolean has_extended_chars = false;
+ REGISTER Lisp_Object rtab = Qnil;
+#endif
+
+ if (p == pend) FREE_STACK_RETURN (REG_EBRACK);
+
+ /* Ensure that we have enough space to push a charset: the
+ opcode, the length count, and the bitset; 34 bytes in all. */
+ GET_BUFFER_SPACE (34);
+
+ laststart = b;
+
+ /* We test `*p == '^' twice, instead of using an if
+ statement, so we only need one BUF_PUSH. */
+ BUF_PUSH (*p == '^' ? charset_not : charset);
+ if (*p == '^')
+ p++;
+
+ /* Remember the first position in the bracket expression. */
+ p1 = p;
+
+ /* Push the number of bytes in the bitmap. */
+ BUF_PUSH ((1 << BYTEWIDTH) / BYTEWIDTH);
+
+ /* Clear the whole map. */
+ memset (b, 0, (1 << BYTEWIDTH) / BYTEWIDTH);
+
+ /* charset_not matches newline according to a syntax bit. */
+ if ((re_opcode_t) b[-2] == charset_not
+ && (syntax & RE_HAT_LISTS_NOT_NEWLINE))
+ SET_LIST_BIT ('\n');
+
+#ifdef MULE
+ start_over_with_extended:
+ if (has_extended_chars)
+ {
+ /* There are extended chars here, which means we need to start
+ over and shift to unified range-table format. */
+ if (b[-2] == charset)
+ b[-2] = charset_mule;
+ else
+ b[-2] = charset_mule_not;
+ b--;
+ p = p1; /* go back to the beginning of the charset, after
+ a possible ^. */
+ rtab = Vthe_lisp_rangetab;
+ Fclear_range_table (rtab);
+
+ /* charset_not matches newline according to a syntax bit. */
+ if ((re_opcode_t) b[-1] == charset_mule_not
+ && (syntax & RE_HAT_LISTS_NOT_NEWLINE))
+ SET_EITHER_BIT ('\n');
+ }
+#endif /* MULE */
+
+ /* Read in characters and ranges, setting map bits. */
+ for (;;)
+ {
+ if (p == pend) FREE_STACK_RETURN (REG_EBRACK);
+
+ PATFETCH_EITHER (c);
+
+#ifdef MULE
+ if (c >= 0x80 && !has_extended_chars)
+ {
+ has_extended_chars = 1;
+ /* Frumble-bumble, we've found some extended chars.
+ Need to start over, process everything using
+ the general extended-char mechanism, and need
+ to use charset_mule and charset_mule_not instead
+ of charset and charset_not. */
+ goto start_over_with_extended;
+ }
+#endif /* MULE */
+ /* \ might escape characters inside [...] and [^...]. */
+ if ((syntax & RE_BACKSLASH_ESCAPE_IN_LISTS) && c == '\\')
+ {
+ if (p == pend) FREE_STACK_RETURN (REG_EESCAPE);
+
+ PATFETCH_EITHER (c1);
+#ifdef MULE
+ if (c1 >= 0x80 && !has_extended_chars)
+ {
+ has_extended_chars = 1;
+ goto start_over_with_extended;
+ }
+#endif /* MULE */
+ SET_EITHER_BIT (c1);
+ continue;
+ }
+
+ /* Could be the end of the bracket expression. If it's
+ not (i.e., when the bracket expression is `[]' so
+ far), the ']' character bit gets set way below. */
+ if (c == ']' && p != p1 + 1)
+ break;
+
+ /* Look ahead to see if it's a range when the last thing
+ was a character class. */
+ if (had_char_class && c == '-' && *p != ']')
+ FREE_STACK_RETURN (REG_ERANGE);
+
+ /* Look ahead to see if it's a range when the last thing
+ was a character: if this is a hyphen not at the
+ beginning or the end of a list, then it's the range
+ operator. */
+ if (c == '-'
+ && !(p - 2 >= pattern && p[-2] == '[')
+ && !(p - 3 >= pattern && p[-3] == '[' && p[-2] == '^')
+ && *p != ']')
+ {
+ reg_errcode_t ret;
+
+#ifdef MULE
+ if (* (unsigned char *) p >= 0x80 && !has_extended_chars)
+ {
+ has_extended_chars = 1;
+ goto start_over_with_extended;
+ }
+ if (has_extended_chars)
+ ret = compile_extended_range (&p, pend, translate,
+ syntax, rtab);
+ else
+#endif /* MULE */
+ ret = compile_range (&p, pend, translate, syntax, b);
+ if (ret != REG_NOERROR) FREE_STACK_RETURN (ret);
+ }
+
+ else if (p[0] == '-' && p[1] != ']')
+ { /* This handles ranges made up of characters only. */
+ reg_errcode_t ret;
+
+ /* Move past the `-'. */
+ PATFETCH (c1);
+
+#ifdef MULE
+ if (* (unsigned char *) p >= 0x80 && !has_extended_chars)
+ {
+ has_extended_chars = 1;
+ goto start_over_with_extended;
+ }
+ if (has_extended_chars)
+ ret = compile_extended_range (&p, pend, translate,
+ syntax, rtab);
+ else
+#endif /* MULE */
+ ret = compile_range (&p, pend, translate, syntax, b);
+ if (ret != REG_NOERROR) FREE_STACK_RETURN (ret);
+ }
+
+ /* See if we're at the beginning of a possible character
+ class. */
+
+ else if (syntax & RE_CHAR_CLASSES && c == '[' && *p == ':')
+ { /* Leave room for the null. */
+ char str[CHAR_CLASS_MAX_LENGTH + 1];
+
+ PATFETCH (c);
+ c1 = 0;
+
+ /* If pattern is `[[:'. */
+ if (p == pend) FREE_STACK_RETURN (REG_EBRACK);
+
+ for (;;)
+ {
+ /* Do not do PATFETCH_EITHER() here. We want
+ to just see if the bytes match particular
+ strings, and we put them all back if not.
+
+ #### May need to be changed once trt tables
+ are working. */
+ PATFETCH (c);
+ if (c == ':' || c == ']' || p == pend
+ || c1 == CHAR_CLASS_MAX_LENGTH)
+ break;
+ str[c1++] = c;
+ }
+ str[c1] = '\0';
+
+ /* If isn't a word bracketed by `[:' and:`]':
+ undo the ending character, the letters, and leave
+ the leading `:' and `[' (but set bits for them). */
+ if (c == ':' && *p == ']')
+ {
+ int ch;
+ boolean is_alnum = STREQ (str, "alnum");
+ boolean is_alpha = STREQ (str, "alpha");
+ boolean is_blank = STREQ (str, "blank");
+ boolean is_cntrl = STREQ (str, "cntrl");
+ boolean is_digit = STREQ (str, "digit");
+ boolean is_graph = STREQ (str, "graph");
+ boolean is_lower = STREQ (str, "lower");
+ boolean is_print = STREQ (str, "print");
+ boolean is_punct = STREQ (str, "punct");
+ boolean is_space = STREQ (str, "space");
+ boolean is_upper = STREQ (str, "upper");
+ boolean is_xdigit = STREQ (str, "xdigit");
+
+ if (!IS_CHAR_CLASS (str))
+ FREE_STACK_RETURN (REG_ECTYPE);
+
+ /* Throw away the ] at the end of the character
+ class. */
+ PATFETCH (c);
+
+ if (p == pend) FREE_STACK_RETURN (REG_EBRACK);
+
+ for (ch = 0; ch < 1 << BYTEWIDTH; ch++)
+ {
+ /* This was split into 3 if's to
+ avoid an arbitrary limit in some compiler. */
+ if ( (is_alnum && ISALNUM (ch))
+ || (is_alpha && ISALPHA (ch))
+ || (is_blank && ISBLANK (ch))
+ || (is_cntrl && ISCNTRL (ch)))
+ SET_EITHER_BIT (ch);
+ if ( (is_digit && ISDIGIT (ch))
+ || (is_graph && ISGRAPH (ch))
+ || (is_lower && ISLOWER (ch))
+ || (is_print && ISPRINT (ch)))
+ SET_EITHER_BIT (ch);
+ if ( (is_punct && ISPUNCT (ch))
+ || (is_space && ISSPACE (ch))
+ || (is_upper && ISUPPER (ch))
+ || (is_xdigit && ISXDIGIT (ch)))
+ SET_EITHER_BIT (ch);
+ }
+ had_char_class = true;
+ }
+ else
+ {
+ c1++;
+ while (c1--)
+ PATUNFETCH;
+ SET_EITHER_BIT ('[');
+ SET_EITHER_BIT (':');
+ had_char_class = false;
+ }
+ }
+ else
+ {
+ had_char_class = false;
+ SET_EITHER_BIT (c);
+ }
+ }
+
+#ifdef MULE
+ if (has_extended_chars)
+ {
+ /* We have a range table, not a bit vector. */
+ int bytes_needed =
+ unified_range_table_bytes_needed (rtab);
+ GET_BUFFER_SPACE (bytes_needed);
+ unified_range_table_copy_data (rtab, b);
+ b += unified_range_table_bytes_used (b);
+ break;
+ }
+#endif /* MULE */
+ /* Discard any (non)matching list bytes that are all 0 at the
+ end of the map. Decrease the map-length byte too. */
+ while ((int) b[-1] > 0 && b[b[-1] - 1] == 0)
+ b[-1]--;
+ b += b[-1];
+ }
+ break;
+
+
+ case '(':
+ if (syntax & RE_NO_BK_PARENS)
+ goto handle_open;
+ else
+ goto normal_char;
+
+
+ case ')':
+ if (syntax & RE_NO_BK_PARENS)
+ goto handle_close;
+ else
+ goto normal_char;
+
+
+ case '\n':
+ if (syntax & RE_NEWLINE_ALT)
+ goto handle_alt;
+ else
+ goto normal_char;
+
+
+ case '|':
+ if (syntax & RE_NO_BK_VBAR)
+ goto handle_alt;
+ else
+ goto normal_char;
+
+
+ case '{':
+ if (syntax & RE_INTERVALS && syntax & RE_NO_BK_BRACES)
+ goto handle_interval;
+ else
+ goto normal_char;
+
+
+ case '\\':
+ if (p == pend) FREE_STACK_RETURN (REG_EESCAPE);
+
+ /* Do not translate the character after the \, so that we can
+ distinguish, e.g., \B from \b, even if we normally would
+ translate, e.g., B to b. */
+ PATFETCH_RAW (c);
+
+ switch (c)
+ {
+ case '(':
+ if (syntax & RE_NO_BK_PARENS)
+ goto normal_backslash;
+
+ handle_open:
+ {
+ regnum_t r;
+
+ if (!(syntax & RE_NO_SHY_GROUPS)
+ && p != pend
+ && TRANSLATE(*p) == TRANSLATE('?'))
+ {
+ p++;
+ PATFETCH(c);
+ switch (c)
+ {
+ case ':': /* shy groups */
+ r = MAX_REGNUM + 1;
+ break;
+
+ /* All others are reserved for future constructs. */
+ default:
+ FREE_STACK_RETURN (REG_BADPAT);
+ }
+ }
+ else
+ {
+ bufp->re_nsub++;
+ r = ++regnum;
+ }
+
+ if (COMPILE_STACK_FULL)
+ {
+ RETALLOC (compile_stack.stack, compile_stack.size << 1,
+ compile_stack_elt_t);
+ if (compile_stack.stack == NULL) return REG_ESPACE;
+
+ compile_stack.size <<= 1;
+ }
+
+ /* These are the values to restore when we hit end of this
+ group. They are all relative offsets, so that if the
+ whole pattern moves because of realloc, they will still
+ be valid. */
+ COMPILE_STACK_TOP.begalt_offset = begalt - bufp->buffer;
+ COMPILE_STACK_TOP.fixup_alt_jump
+ = fixup_alt_jump ? fixup_alt_jump - bufp->buffer + 1 : 0;
+ COMPILE_STACK_TOP.laststart_offset = b - bufp->buffer;
+ COMPILE_STACK_TOP.regnum = r;
+
+ /* We will eventually replace the 0 with the number of
+ groups inner to this one. But do not push a
+ start_memory for groups beyond the last one we can
+ represent in the compiled pattern. */
+ if (r <= MAX_REGNUM)
+ {
+ COMPILE_STACK_TOP.inner_group_offset
+ = b - bufp->buffer + 2;
+ BUF_PUSH_3 (start_memory, r, 0);
+ }
+
+ compile_stack.avail++;
+
+ fixup_alt_jump = 0;
+ laststart = 0;
+ begalt = b;
+ /* If we've reached MAX_REGNUM groups, then this open
+ won't actually generate any code, so we'll have to
+ clear pending_exact explicitly. */
+ pending_exact = 0;
+ }
+ break;
+
+
+ case ')':
+ if (syntax & RE_NO_BK_PARENS) goto normal_backslash;
+
+ if (COMPILE_STACK_EMPTY) {
+ if (syntax & RE_UNMATCHED_RIGHT_PAREN_ORD)
+ goto normal_backslash;
+ else
+ FREE_STACK_RETURN (REG_ERPAREN);
+ }
+
+ handle_close:
+ if (fixup_alt_jump)
+ { /* Push a dummy failure point at the end of the
+ alternative for a possible future
+ `pop_failure_jump' to pop. See comments at
+ `push_dummy_failure' in `re_match_2'. */
+ BUF_PUSH (push_dummy_failure);
+
+ /* We allocated space for this jump when we assigned
+ to `fixup_alt_jump', in the `handle_alt' case below. */
+ STORE_JUMP (jump_past_alt, fixup_alt_jump, b - 1);
+ }
+
+ /* See similar code for backslashed left paren above. */
+ if (COMPILE_STACK_EMPTY) {
+ if (syntax & RE_UNMATCHED_RIGHT_PAREN_ORD)
+ goto normal_char;
+ else
+ FREE_STACK_RETURN (REG_ERPAREN);
+ }
+
+ /* Since we just checked for an empty stack above, this
+ ``can't happen''. */
+ assert (compile_stack.avail != 0);
+ {
+ /* We don't just want to restore into `regnum', because
+ later groups should continue to be numbered higher,
+ as in `(ab)c(de)' -- the second group is #2. */
+ regnum_t this_group_regnum;
+
+ compile_stack.avail--;
+ begalt = bufp->buffer + COMPILE_STACK_TOP.begalt_offset;
+ fixup_alt_jump
+ = COMPILE_STACK_TOP.fixup_alt_jump
+ ? bufp->buffer + COMPILE_STACK_TOP.fixup_alt_jump - 1
+ : 0;
+ laststart = bufp->buffer + COMPILE_STACK_TOP.laststart_offset;
+ this_group_regnum = COMPILE_STACK_TOP.regnum;
+ /* If we've reached MAX_REGNUM groups, then this open
+ won't actually generate any code, so we'll have to
+ clear pending_exact explicitly. */
+ pending_exact = 0;
+
+ /* We're at the end of the group, so now we know how many
+ groups were inside this one. */
+ if (this_group_regnum <= MAX_REGNUM)
+ {
+ unsigned char *inner_group_loc
+ = bufp->buffer + COMPILE_STACK_TOP.inner_group_offset;
+
+ *inner_group_loc = regnum - this_group_regnum;
+ BUF_PUSH_3 (stop_memory, this_group_regnum,
+ regnum - this_group_regnum);
+ }
+ }
+ break;
+
+
+ case '|': /* `\|'. */
+ if (syntax & RE_LIMITED_OPS || syntax & RE_NO_BK_VBAR)
+ goto normal_backslash;
+ handle_alt:
+ if (syntax & RE_LIMITED_OPS)
+ goto normal_char;
+
+ /* Insert before the previous alternative a jump which
+ jumps to this alternative if the former fails. */
+ GET_BUFFER_SPACE (3);
+ INSERT_JUMP (on_failure_jump, begalt, b + 6);
+ pending_exact = 0;
+ b += 3;
+
+ /* The alternative before this one has a jump after it
+ which gets executed if it gets matched. Adjust that
+ jump so it will jump to this alternative's analogous
+ jump (put in below, which in turn will jump to the next
+ (if any) alternative's such jump, etc.). The last such
+ jump jumps to the correct final destination. A picture:
+ _____ _____
+ | | | |
+ | v | v
+ a | b | c
+
+ If we are at `b', then fixup_alt_jump right now points to a
+ three-byte space after `a'. We'll put in the jump, set
+ fixup_alt_jump to right after `b', and leave behind three
+ bytes which we'll fill in when we get to after `c'. */
+
+ if (fixup_alt_jump)
+ STORE_JUMP (jump_past_alt, fixup_alt_jump, b);
+
+ /* Mark and leave space for a jump after this alternative,
+ to be filled in later either by next alternative or
+ when know we're at the end of a series of alternatives. */
+ fixup_alt_jump = b;
+ GET_BUFFER_SPACE (3);
+ b += 3;
+
+ laststart = 0;
+ begalt = b;
+ break;
+
+
+ case '{':
+ /* If \{ is a literal. */
+ if (!(syntax & RE_INTERVALS)
+ /* If we're at `\{' and it's not the open-interval
+ operator. */
+ || ((syntax & RE_INTERVALS) && (syntax & RE_NO_BK_BRACES))
+ || (p - 2 == pattern && p == pend))
+ goto normal_backslash;
+
+ handle_interval:
+ {
+ /* If got here, then the syntax allows intervals. */
+
+ /* At least (most) this many matches must be made. */
+ int lower_bound = -1, upper_bound = -1;
+
+ beg_interval = p - 1;
+
+ if (p == pend)
+ {
+ if (syntax & RE_NO_BK_BRACES)
+ goto unfetch_interval;
+ else
+ FREE_STACK_RETURN (REG_EBRACE);
+ }
+
+ GET_UNSIGNED_NUMBER (lower_bound);
+
+ if (c == ',')
+ {
+ GET_UNSIGNED_NUMBER (upper_bound);
+ if (upper_bound < 0) upper_bound = RE_DUP_MAX;
+ }
+ else
+ /* Interval such as `{1}' => match exactly once. */
+ upper_bound = lower_bound;
+
+ if (lower_bound < 0 || upper_bound > RE_DUP_MAX
+ || lower_bound > upper_bound)
+ {
+ if (syntax & RE_NO_BK_BRACES)
+ goto unfetch_interval;
+ else
+ FREE_STACK_RETURN (REG_BADBR);
+ }
+
+ if (!(syntax & RE_NO_BK_BRACES))
+ {
+ if (c != '\\') FREE_STACK_RETURN (REG_EBRACE);
+
+ PATFETCH (c);
+ }
+
+ if (c != '}')
+ {
+ if (syntax & RE_NO_BK_BRACES)
+ goto unfetch_interval;
+ else
+ FREE_STACK_RETURN (REG_BADBR);
+ }
+
+ /* We just parsed a valid interval. */
+
+ /* If it's invalid to have no preceding re. */
+ if (!laststart)
+ {
+ if (syntax & RE_CONTEXT_INVALID_OPS)
+ FREE_STACK_RETURN (REG_BADRPT);
+ else if (syntax & RE_CONTEXT_INDEP_OPS)
+ laststart = b;
+ else
+ goto unfetch_interval;
+ }
+
+ /* If the upper bound is zero, don't want to succeed at
+ all; jump from `laststart' to `b + 3', which will be
+ the end of the buffer after we insert the jump. */
+ if (upper_bound == 0)
+ {
+ GET_BUFFER_SPACE (3);
+ INSERT_JUMP (jump, laststart, b + 3);
+ b += 3;
+ }
+
+ /* Otherwise, we have a nontrivial interval. When
+ we're all done, the pattern will look like:
+ set_number_at <jump count> <upper bound>
+ set_number_at <succeed_n count> <lower bound>
+ succeed_n <after jump addr> <succeed_n count>
+ <body of loop>
+ jump_n <succeed_n addr> <jump count>
+ (The upper bound and `jump_n' are omitted if
+ `upper_bound' is 1, though.) */
+ else
+ { /* If the upper bound is > 1, we need to insert
+ more at the end of the loop. */
+ unsigned nbytes = 10 + (upper_bound > 1) * 10;
+
+ GET_BUFFER_SPACE (nbytes);
+
+ /* Initialize lower bound of the `succeed_n', even
+ though it will be set during matching by its
+ attendant `set_number_at' (inserted next),
+ because `re_compile_fastmap' needs to know.
+ Jump to the `jump_n' we might insert below. */
+ INSERT_JUMP2 (succeed_n, laststart,
+ b + 5 + (upper_bound > 1) * 5,
+ lower_bound);
+ b += 5;
+
+ /* Code to initialize the lower bound. Insert
+ before the `succeed_n'. The `5' is the last two
+ bytes of this `set_number_at', plus 3 bytes of
+ the following `succeed_n'. */
+ insert_op2 (set_number_at, laststart, 5, lower_bound, b);
+ b += 5;
+
+ if (upper_bound > 1)
+ { /* More than one repetition is allowed, so
+ append a backward jump to the `succeed_n'
+ that starts this interval.
+
+ When we've reached this during matching,
+ we'll have matched the interval once, so
+ jump back only `upper_bound - 1' times. */
+ STORE_JUMP2 (jump_n, b, laststart + 5,
+ upper_bound - 1);
+ b += 5;
+
+ /* The location we want to set is the second
+ parameter of the `jump_n'; that is `b-2' as
+ an absolute address. `laststart' will be
+ the `set_number_at' we're about to insert;
+ `laststart+3' the number to set, the source
+ for the relative address. But we are
+ inserting into the middle of the pattern --
+ so everything is getting moved up by 5.
+ Conclusion: (b - 2) - (laststart + 3) + 5,
+ i.e., b - laststart.
+
+ We insert this at the beginning of the loop
+ so that if we fail during matching, we'll
+ reinitialize the bounds. */
+ insert_op2 (set_number_at, laststart, b - laststart,
+ upper_bound - 1, b);
+ b += 5;
+ }
+ }
+ pending_exact = 0;
+ beg_interval = NULL;
+ }
+ break;
+
+ unfetch_interval:
+ /* If an invalid interval, match the characters as literals. */
+ assert (beg_interval);
+ p = beg_interval;
+ beg_interval = NULL;
+
+ /* normal_char and normal_backslash need `c'. */
+ PATFETCH (c);
+
+ if (!(syntax & RE_NO_BK_BRACES))
+ {
+ if (p > pattern && p[-1] == '\\')
+ goto normal_backslash;
+ }
+ goto normal_char;
+
+#ifdef emacs
+ /* There is no way to specify the before_dot and after_dot
+ operators. rms says this is ok. --karl */
+ case '=':
+ BUF_PUSH (at_dot);
+ break;
+
+ case 's':
+ laststart = b;
+ PATFETCH (c);
+ /* XEmacs addition */
+ if (c >= 0x80 || syntax_spec_code[c] == 0377)
+ FREE_STACK_RETURN (REG_ESYNTAX);
+ BUF_PUSH_2 (syntaxspec, syntax_spec_code[c]);
+ break;
+
+ case 'S':
+ laststart = b;
+ PATFETCH (c);
+ /* XEmacs addition */
+ if (c >= 0x80 || syntax_spec_code[c] == 0377)
+ FREE_STACK_RETURN (REG_ESYNTAX);
+ BUF_PUSH_2 (notsyntaxspec, syntax_spec_code[c]);
+ break;
+
+#ifdef MULE
+/* 97.2.17 jhod merged in to XEmacs from mule-2.3 */
+ case 'c':
+ laststart = b;
+ PATFETCH_RAW (c);
+ if (c < 32 || c > 127)
+ FREE_STACK_RETURN (REG_ECATEGORY);
+ BUF_PUSH_2 (categoryspec, c);
+ break;
+
+ case 'C':
+ laststart = b;
+ PATFETCH_RAW (c);
+ if (c < 32 || c > 127)
+ FREE_STACK_RETURN (REG_ECATEGORY);
+ BUF_PUSH_2 (notcategoryspec, c);
+ break;
+/* end of category patch */
+#endif /* MULE */
+#endif /* emacs */
+
+
+ case 'w':
+ laststart = b;
+ BUF_PUSH (wordchar);
+ break;
+
+
+ case 'W':
+ laststart = b;
+ BUF_PUSH (notwordchar);
+ break;
+
+
+ case '<':
+ BUF_PUSH (wordbeg);
+ break;
+
+ case '>':
+ BUF_PUSH (wordend);
+ break;
+
+ case 'b':
+ BUF_PUSH (wordbound);
+ break;
+
+ case 'B':
+ BUF_PUSH (notwordbound);
+ break;
+
+ case '`':
+ BUF_PUSH (begbuf);
+ break;
+
+ case '\'':
+ BUF_PUSH (endbuf);
+ break;
+
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ if (syntax & RE_NO_BK_REFS)
+ goto normal_char;
+
+ c1 = c - '0';
+
+ if (c1 > regnum)
+ FREE_STACK_RETURN (REG_ESUBREG);
+
+ /* Can't back reference to a subexpression if inside of it. */
+ if (group_in_compile_stack (compile_stack, c1))
+ goto normal_char;
+
+ laststart = b;
+ BUF_PUSH_2 (duplicate, c1);
+ break;
+
+
+ case '+':
+ case '?':
+ if (syntax & RE_BK_PLUS_QM)
+ goto handle_plus;
+ else
+ goto normal_backslash;
+
+ default:
+ normal_backslash:
+ /* You might think it would be useful for \ to mean
+ not to translate; but if we don't translate it,
+ it will never match anything. */
+ c = TRANSLATE (c);
+ goto normal_char;
+ }
+ break;
+
+
+ default:
+ /* Expects the character in `c'. */
+ /* `p' points to the location after where `c' came from. */
+ normal_char:
+ {
+ /* XEmacs: modifications here for Mule. */
+ /* `q' points to the beginning of the next char. */
+ CONST char *q = p - 1;
+ INC_CHARPTR (q);
+
+ /* If no exactn currently being built. */
+ if (!pending_exact
+
+ /* If last exactn not at current position. */
+ || pending_exact + *pending_exact + 1 != b
+
+ /* We have only one byte following the exactn for the count. */
+ || ((unsigned int) (*pending_exact + (q - p)) >=
+ ((unsigned int) (1 << BYTEWIDTH) - 1))
+
+ /* If followed by a repetition operator. */
+ || *q == '*' || *q == '^'
+ || ((syntax & RE_BK_PLUS_QM)
+ ? *q == '\\' && (q[1] == '+' || q[1] == '?')
+ : (*q == '+' || *q == '?'))
+ || ((syntax & RE_INTERVALS)
+ && ((syntax & RE_NO_BK_BRACES)
+ ? *q == '{'
+ : (q[0] == '\\' && q[1] == '{'))))
+ {
+ /* Start building a new exactn. */
+
+ laststart = b;
+
+ BUF_PUSH_2 (exactn, 0);
+ pending_exact = b - 1;
+ }
+
+ BUF_PUSH (c);
+ (*pending_exact)++;
+
+ while (p < q)
+ {
+ PATFETCH (c);
+ BUF_PUSH (c);
+ (*pending_exact)++;
+ }
+ break;
+ }
+ } /* switch (c) */
+ } /* while p != pend */
+
+
+ /* Through the pattern now. */
+
+ if (fixup_alt_jump)
+ STORE_JUMP (jump_past_alt, fixup_alt_jump, b);
+
+ if (!COMPILE_STACK_EMPTY)
+ FREE_STACK_RETURN (REG_EPAREN);
+
+ /* If we don't want backtracking, force success
+ the first time we reach the end of the compiled pattern. */
+ if (syntax & RE_NO_POSIX_BACKTRACKING)
+ BUF_PUSH (succeed);
+
+ free (compile_stack.stack);
+
+ /* We have succeeded; set the length of the buffer. */
+ bufp->used = b - bufp->buffer;
+
+#ifdef DEBUG
+ if (debug)
+ {
+ DEBUG_PRINT1 ("\nCompiled pattern: \n");
+ print_compiled_pattern (bufp);
+ }
+#endif /* DEBUG */
+
+#ifndef MATCH_MAY_ALLOCATE
+ /* Initialize the failure stack to the largest possible stack. This
+ isn't necessary unless we're trying to avoid calling alloca in
+ the search and match routines. */
+ {
+ int num_regs = bufp->re_nsub + 1;
+
+ /* Since DOUBLE_FAIL_STACK refuses to double only if the current size
+ is strictly greater than re_max_failures, the largest possible stack
+ is 2 * re_max_failures failure points. */
+ if (fail_stack.size < (2 * re_max_failures * MAX_FAILURE_ITEMS))
+ {
+ fail_stack.size = (2 * re_max_failures * MAX_FAILURE_ITEMS);
+
+#ifdef emacs
+ if (! fail_stack.stack)
+ fail_stack.stack
+ = (fail_stack_elt_t *) xmalloc (fail_stack.size
+ * sizeof (fail_stack_elt_t));
+ else
+ fail_stack.stack
+ = (fail_stack_elt_t *) xrealloc (fail_stack.stack,
+ (fail_stack.size
+ * sizeof (fail_stack_elt_t)));
+#else /* not emacs */
+ if (! fail_stack.stack)
+ fail_stack.stack
+ = (fail_stack_elt_t *) malloc (fail_stack.size
+ * sizeof (fail_stack_elt_t));
+ else
+ fail_stack.stack
+ = (fail_stack_elt_t *) realloc (fail_stack.stack,
+ (fail_stack.size
+ * sizeof (fail_stack_elt_t)));
+#endif /* not emacs */
+ }
+
+ regex_grow_registers (num_regs);
+ }
+#endif /* not MATCH_MAY_ALLOCATE */
+
+ return REG_NOERROR;
+} /* regex_compile */
+\f
+/* Subroutines for `regex_compile'. */
+
+/* Store OP at LOC followed by two-byte integer parameter ARG. */
+
+static void
+store_op1 (re_opcode_t op, unsigned char *loc, int arg)
+{
+ *loc = (unsigned char) op;
+ STORE_NUMBER (loc + 1, arg);
+}
+
+
+/* Like `store_op1', but for two two-byte parameters ARG1 and ARG2. */
+
+static void
+store_op2 (re_opcode_t op, unsigned char *loc, int arg1, int arg2)
+{
+ *loc = (unsigned char) op;
+ STORE_NUMBER (loc + 1, arg1);
+ STORE_NUMBER (loc + 3, arg2);
+}
+
+
+/* Copy the bytes from LOC to END to open up three bytes of space at LOC
+ for OP followed by two-byte integer parameter ARG. */
+
+static void
+insert_op1 (re_opcode_t op, unsigned char *loc, int arg, unsigned char *end)
+{
+ REGISTER unsigned char *pfrom = end;
+ REGISTER unsigned char *pto = end + 3;
+
+ while (pfrom != loc)
+ *--pto = *--pfrom;
+
+ store_op1 (op, loc, arg);
+}
+
+
+/* Like `insert_op1', but for two two-byte parameters ARG1 and ARG2. */
+
+static void
+insert_op2 (re_opcode_t op, unsigned char *loc, int arg1, int arg2,
+ unsigned char *end)
+{
+ REGISTER unsigned char *pfrom = end;
+ REGISTER unsigned char *pto = end + 5;
+
+ while (pfrom != loc)
+ *--pto = *--pfrom;
+
+ store_op2 (op, loc, arg1, arg2);
+}
+
+
+/* P points to just after a ^ in PATTERN. Return true if that ^ comes
+ after an alternative or a begin-subexpression. We assume there is at
+ least one character before the ^. */
+
+static boolean
+at_begline_loc_p (CONST char *pattern, CONST char *p, reg_syntax_t syntax)
+{
+ CONST char *prev = p - 2;
+ boolean prev_prev_backslash = prev > pattern && prev[-1] == '\\';
+
+ return
+ /* After a subexpression? */
+ (*prev == '(' && (syntax & RE_NO_BK_PARENS || prev_prev_backslash))
+ /* After an alternative? */
+ || (*prev == '|' && (syntax & RE_NO_BK_VBAR || prev_prev_backslash));
+}
+
+
+/* The dual of at_begline_loc_p. This one is for $. We assume there is
+ at least one character after the $, i.e., `P < PEND'. */
+
+static boolean
+at_endline_loc_p (CONST char *p, CONST char *pend, int syntax)
+{
+ CONST char *next = p;
+ boolean next_backslash = *next == '\\';
+ CONST char *next_next = p + 1 < pend ? p + 1 : 0;
+
+ return
+ /* Before a subexpression? */
+ (syntax & RE_NO_BK_PARENS ? *next == ')'
+ : next_backslash && next_next && *next_next == ')')
+ /* Before an alternative? */
+ || (syntax & RE_NO_BK_VBAR ? *next == '|'
+ : next_backslash && next_next && *next_next == '|');
+}
+
+
+/* Returns true if REGNUM is in one of COMPILE_STACK's elements and
+ false if it's not. */
+
+static boolean
+group_in_compile_stack (compile_stack_type compile_stack, regnum_t regnum)
+{
+ int this_element;
+
+ for (this_element = compile_stack.avail - 1;
+ this_element >= 0;
+ this_element--)
+ if (compile_stack.stack[this_element].regnum == regnum)
+ return true;
+
+ return false;
+}
+
+
+/* Read the ending character of a range (in a bracket expression) from the
+ uncompiled pattern *P_PTR (which ends at PEND). We assume the
+ starting character is in `P[-2]'. (`P[-1]' is the character `-'.)
+ Then we set the translation of all bits between the starting and
+ ending characters (inclusive) in the compiled pattern B.
+
+ Return an error code.
+
+ We use these short variable names so we can use the same macros as
+ `regex_compile' itself. */
+
+static reg_errcode_t
+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;
+ int range_start, range_end;
+
+ if (p == pend)
+ return REG_ERANGE;
+
+ /* Even though the pattern is a signed `char *', we need to fetch
+ with unsigned char *'s; if the high bit of the pattern character
+ is set, the range endpoints will be negative if we fetch using a
+ signed char *.
+
+ 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];
+
+ /* Have to increment the pointer into the pattern string, so the
+ caller isn't still at the ending character. */
+ (*p_ptr)++;
+
+ /* If the start is after the end, the range is empty. */
+ if (range_start > range_end)
+ return syntax & RE_NO_EMPTY_RANGES ? REG_ERANGE : REG_NOERROR;
+
+ /* Here we see why `this_char' has to be larger than an `unsigned
+ char' -- the range is inclusive, so if `range_end' == 0xff
+ (assuming 8-bit characters), we would otherwise go into an infinite
+ loop, since all characters <= 0xff. */
+ for (this_char = range_start; this_char <= range_end; this_char++)
+ {
+ SET_LIST_BIT (TRANSLATE (this_char));
+ }
+
+ return REG_NOERROR;
+}
+
+#ifdef MULE
+
+static reg_errcode_t
+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;
+
+ if (*p_ptr == pend)
+ return REG_ERANGE;
+
+ p = (CONST Bufbyte *) *p_ptr;
+ range_end = charptr_emchar (p);
+ p--; /* back to '-' */
+ DEC_CHARPTR (p); /* back to start of range */
+ /* We also want to fetch the endpoints without translating them; the
+ appropriate translation is done in the bit-setting loop below. */
+ range_start = charptr_emchar (p);
+ INC_CHARPTR (*p_ptr);
+
+ /* If the start is after the end, the range is empty. */
+ if (range_start > range_end)
+ return syntax & RE_NO_EMPTY_RANGES ? REG_ERANGE : REG_NOERROR;
+
+ /* Can't have ranges spanning different charsets, except maybe for
+ ranges entirely witin the first 256 chars. */
+
+ if ((range_start >= 0x100 || range_end >= 0x100)
+ && CHAR_LEADING_BYTE (range_start) !=
+ CHAR_LEADING_BYTE (range_end))
+ return REG_ERANGESPAN;
+
+ /* As advertised, translations only work over the 0 - 0x7F range.
+ Making this kind of stuff work generally is much harder.
+ Iterating over the whole range like this would be way efficient
+ if the range encompasses 10,000 chars or something. You'd have
+ to do something like this:
+
+ range_table a;
+ range_table b;
+ map over translation table in [range_start, range_end] of
+ (put the mapped range in a;
+ put the translation in b)
+ invert the range in a and truncate to [range_start, range_end]
+ compute the union of a, b
+ union the result into rtab
+ */
+ for (this_char = range_start;
+ this_char <= range_end && this_char < 0x80; this_char++)
+ {
+ SET_RANGETAB_BIT (TRANSLATE (this_char));
+ }
+
+ if (this_char <= range_end)
+ put_range_table (rtab, this_char, range_end, Qt);
+
+ return REG_NOERROR;
+}
+
+#endif /* MULE */
+\f
+/* re_compile_fastmap computes a ``fastmap'' for the compiled pattern in
+ BUFP. A fastmap records which of the (1 << BYTEWIDTH) possible
+ characters can start a string that matches the pattern. This fastmap
+ is used by re_search to skip quickly over impossible starting points.
+
+ The caller must supply the address of a (1 << BYTEWIDTH)-byte data
+ area as BUFP->fastmap.
+
+ We set the `fastmap', `fastmap_accurate', and `can_be_null' fields in
+ the pattern buffer.
+
+ Returns 0 if we succeed, -2 if an internal error. */
+
+int
+re_compile_fastmap (struct re_pattern_buffer *bufp)
+{
+ int j, k;
+#ifdef MATCH_MAY_ALLOCATE
+ fail_stack_type fail_stack;
+#endif
+ DECLARE_DESTINATION
+ /* We don't push any register information onto the failure stack. */
+
+ REGISTER char *fastmap = bufp->fastmap;
+ unsigned char *pattern = bufp->buffer;
+ unsigned long size = bufp->used;
+ unsigned char *p = pattern;
+ REGISTER unsigned char *pend = pattern + size;
+
+#ifdef REL_ALLOC
+ /* This holds the pointer to the failure stack, when
+ it is allocated relocatably. */
+ fail_stack_elt_t *failure_stack_ptr;
+#endif
+
+ /* Assume that each path through the pattern can be null until
+ proven otherwise. We set this false at the bottom of switch
+ statement, to which we get only if a particular path doesn't
+ match the empty string. */
+ boolean path_can_be_null = true;
+
+ /* We aren't doing a `succeed_n' to begin with. */
+ boolean succeed_n_p = false;
+
+ assert (fastmap != NULL && p != NULL);
+
+ INIT_FAIL_STACK ();
+ memset (fastmap, 0, 1 << BYTEWIDTH); /* Assume nothing's valid. */
+ bufp->fastmap_accurate = 1; /* It will be when we're done. */
+ bufp->can_be_null = 0;
+
+ while (1)
+ {
+ if (p == pend || *p == succeed)
+ {
+ /* We have reached the (effective) end of pattern. */
+ if (!FAIL_STACK_EMPTY ())
+ {
+ bufp->can_be_null |= path_can_be_null;
+
+ /* Reset for next path. */
+ path_can_be_null = true;
+
+ p = fail_stack.stack[--fail_stack.avail].pointer;
+
+ continue;
+ }
+ else
+ break;
+ }
+
+ /* We should never be about to go beyond the end of the pattern. */
+ assert (p < pend);
+
+ switch (SWITCH_ENUM_CAST ((re_opcode_t) *p++))
+ {
+
+ /* I guess the idea here is to simply not bother with a fastmap
+ if a backreference is used, since it's too hard to figure out
+ the fastmap for the corresponding group. Setting
+ `can_be_null' stops `re_search_2' from using the fastmap, so
+ that is all we do. */
+ case duplicate:
+ bufp->can_be_null = 1;
+ goto done;
+
+
+ /* Following are the cases which match a character. These end
+ with `break'. */
+
+ case exactn:
+ fastmap[p[1]] = 1;
+ break;
+
+
+ case charset:
+ /* XEmacs: Under Mule, these bit vectors will
+ only contain values for characters below 0x80. */
+ for (j = *p++ * BYTEWIDTH - 1; j >= 0; j--)
+ if (p[j / BYTEWIDTH] & (1 << (j % BYTEWIDTH)))
+ fastmap[j] = 1;
+ break;
+
+
+ case charset_not:
+ /* Chars beyond end of map must be allowed. */
+#ifdef MULE
+ for (j = *p * BYTEWIDTH; j < 0x80; j++)
+ fastmap[j] = 1;
+ /* And all extended characters must be allowed, too. */
+ for (j = 0x80; j < 0xA0; j++)
+ fastmap[j] = 1;
+#else /* ! MULE */
+ for (j = *p * BYTEWIDTH; j < (1 << BYTEWIDTH); j++)
+ fastmap[j] = 1;
+#endif /* ! MULE */
+
+ for (j = *p++ * BYTEWIDTH - 1; j >= 0; j--)
+ if (!(p[j / BYTEWIDTH] & (1 << (j % BYTEWIDTH))))
+ fastmap[j] = 1;
+ break;
+
+#ifdef MULE
+ case charset_mule:
+ {
+ int nentries;
+ int i;
+
+ nentries = unified_range_table_nentries (p);
+ for (i = 0; i < nentries; i++)
+ {
+ EMACS_INT first, last;
+ Lisp_Object dummy_val;
+ int jj;
+ Bufbyte strr[MAX_EMCHAR_LEN];
+
+ unified_range_table_get_range (p, i, &first, &last,
+ &dummy_val);
+ for (jj = first; jj <= last && jj < 0x80; jj++)
+ fastmap[jj] = 1;
+ /* Ranges below 0x100 can span charsets, but there
+ are only two (Control-1 and Latin-1), and
+ either first or last has to be in them. */
+ set_charptr_emchar (strr, first);
+ fastmap[*strr] = 1;
+ if (last < 0x100)
+ {
+ set_charptr_emchar (strr, last);
+ fastmap[*strr] = 1;
+ }
+ }
+ }
+ break;
+
+ case charset_mule_not:
+ {
+ int nentries;
+ int i;
+
+ nentries = unified_range_table_nentries (p);
+ for (i = 0; i < nentries; i++)
+ {
+ EMACS_INT first, last;
+ Lisp_Object dummy_val;
+ int jj;
+ int smallest_prev = 0;
+
+ unified_range_table_get_range (p, i, &first, &last,
+ &dummy_val);
+ for (jj = smallest_prev; jj < first && jj < 0x80; jj++)
+ fastmap[jj] = 1;
+ smallest_prev = last + 1;
+ if (smallest_prev >= 0x80)
+ break;
+ }
+ /* Calculating which leading bytes are actually allowed
+ here is rather difficult, so we just punt and allow
+ all of them. */
+ for (i = 0x80; i < 0xA0; i++)
+ fastmap[i] = 1;
+ }
+ break;
+#endif /* MULE */
+
+
+ case wordchar:
+#ifdef emacs
+ k = (int) Sword;
+ goto matchsyntax;
+#else
+ for (j = 0; j < (1 << BYTEWIDTH); j++)
+ if (SYNTAX_UNSAFE
+ (XCHAR_TABLE
+ (regex_emacs_buffer->mirror_syntax_table), j) == Sword)
+ fastmap[j] = 1;
+ break;
+#endif
+
+
+ case notwordchar:
+#ifdef emacs
+ k = (int) Sword;
+ goto matchnotsyntax;
+#else
+ for (j = 0; j < (1 << BYTEWIDTH); j++)
+ if (SYNTAX_UNSAFE
+ (XCHAR_TABLE
+ (regex_emacs_buffer->mirror_syntax_table), j) != Sword)
+ fastmap[j] = 1;
+ break;
+#endif
+
+
+ case anychar:
+ {
+ int fastmap_newline = fastmap['\n'];
+
+ /* `.' matches anything ... */
+#ifdef MULE
+ /* "anything" only includes bytes that can be the
+ first byte of a character. */
+ for (j = 0; j < 0xA0; j++)
+ fastmap[j] = 1;
+#else
+ for (j = 0; j < (1 << BYTEWIDTH); j++)
+ fastmap[j] = 1;
+#endif
+
+ /* ... except perhaps newline. */
+ if (!(bufp->syntax & RE_DOT_NEWLINE))
+ fastmap['\n'] = fastmap_newline;
+
+ /* Return if we have already set `can_be_null'; if we have,
+ then the fastmap is irrelevant. Something's wrong here. */
+ else if (bufp->can_be_null)
+ goto done;
+
+ /* Otherwise, have to check alternative paths. */
+ break;
+ }
+
+#ifdef emacs
+ case syntaxspec:
+ k = *p++;
+ matchsyntax:
+#ifdef MULE
+ for (j = 0; j < 0x80; j++)
+ if (SYNTAX_UNSAFE
+ (XCHAR_TABLE
+ (regex_emacs_buffer->mirror_syntax_table), j) ==
+ (enum syntaxcode) k)
+ fastmap[j] = 1;
+ for (j = 0x80; j < 0xA0; j++)
+ {
+ if (LEADING_BYTE_PREFIX_P(j))
+ /* too complicated to calculate this right */
+ fastmap[j] = 1;
+ else
+ {
+ int multi_p;
+ Lisp_Object cset;
+
+ cset = CHARSET_BY_LEADING_BYTE (j);
+ if (CHARSETP (cset))
+ {
+ if (charset_syntax (regex_emacs_buffer, cset,
+ &multi_p)
+ == Sword || multi_p)
+ fastmap[j] = 1;
+ }
+ }
+ }
+#else /* ! MULE */
+ for (j = 0; j < (1 << BYTEWIDTH); j++)
+ if (SYNTAX_UNSAFE
+ (XCHAR_TABLE
+ (regex_emacs_buffer->mirror_syntax_table), j) ==
+ (enum syntaxcode) k)
+ fastmap[j] = 1;
+#endif /* ! MULE */
+ break;
+
+
+ case notsyntaxspec:
+ k = *p++;
+ matchnotsyntax:
+#ifdef MULE
+ for (j = 0; j < 0x80; j++)
+ if (SYNTAX_UNSAFE
+ (XCHAR_TABLE
+ (regex_emacs_buffer->mirror_syntax_table), j) !=
+ (enum syntaxcode) k)
+ fastmap[j] = 1;
+ for (j = 0x80; j < 0xA0; j++)
+ {
+ if (LEADING_BYTE_PREFIX_P(j))
+ /* too complicated to calculate this right */
+ fastmap[j] = 1;
+ else
+ {
+ int multi_p;
+ Lisp_Object cset;
+
+ cset = CHARSET_BY_LEADING_BYTE (j);
+ if (CHARSETP (cset))
+ {
+ if (charset_syntax (regex_emacs_buffer, cset,
+ &multi_p)
+ != Sword || multi_p)
+ fastmap[j] = 1;
+ }
+ }
+ }
+#else /* ! MULE */
+ for (j = 0; j < (1 << BYTEWIDTH); j++)
+ if (SYNTAX_UNSAFE
+ (XCHAR_TABLE
+ (regex_emacs_buffer->mirror_syntax_table), j) !=
+ (enum syntaxcode) k)
+ fastmap[j] = 1;
+#endif /* ! MULE */
+ break;
+
+#ifdef MULE
+/* 97/2/17 jhod category patch */
+ case categoryspec:
+ case notcategoryspec:
+ bufp->can_be_null = 1;
+ return 0;
+/* end if category patch */
+#endif /* MULE */
+
+ /* All cases after this match the empty string. These end with
+ `continue'. */
+
+
+ case before_dot:
+ case at_dot:
+ case after_dot:
+ continue;
+#endif /* not emacs */
+
+
+ case no_op:
+ case begline:
+ case endline:
+ case begbuf:
+ case endbuf:
+ case wordbound:
+ case notwordbound:
+ case wordbeg:
+ case wordend:
+ case push_dummy_failure:
+ continue;
+
+
+ case jump_n:
+ case pop_failure_jump:
+ case maybe_pop_jump:
+ case jump:
+ case jump_past_alt:
+ case dummy_failure_jump:
+ EXTRACT_NUMBER_AND_INCR (j, p);
+ p += j;
+ if (j > 0)
+ continue;
+
+ /* Jump backward implies we just went through the body of a
+ loop and matched nothing. Opcode jumped to should be
+ `on_failure_jump' or `succeed_n'. Just treat it like an
+ ordinary jump. For a * loop, it has pushed its failure
+ point already; if so, discard that as redundant. */
+ if ((re_opcode_t) *p != on_failure_jump
+ && (re_opcode_t) *p != succeed_n)
+ continue;
+
+ p++;
+ EXTRACT_NUMBER_AND_INCR (j, p);
+ p += j;
+
+ /* If what's on the stack is where we are now, pop it. */
+ if (!FAIL_STACK_EMPTY ()
+ && fail_stack.stack[fail_stack.avail - 1].pointer == p)
+ fail_stack.avail--;
+
+ continue;
+
+
+ case on_failure_jump:
+ case on_failure_keep_string_jump:
+ handle_on_failure_jump:
+ EXTRACT_NUMBER_AND_INCR (j, p);
+
+ /* For some patterns, e.g., `(a?)?', `p+j' here points to the
+ end of the pattern. We don't want to push such a point,
+ since when we restore it above, entering the switch will
+ increment `p' past the end of the pattern. We don't need
+ to push such a point since we obviously won't find any more
+ fastmap entries beyond `pend'. Such a pattern can match
+ the null string, though. */
+ if (p + j < pend)
+ {
+ if (!PUSH_PATTERN_OP (p + j, fail_stack))
+ {
+ RESET_FAIL_STACK ();
+ return -2;
+ }
+ }
+ else
+ bufp->can_be_null = 1;
+
+ if (succeed_n_p)
+ {
+ EXTRACT_NUMBER_AND_INCR (k, p); /* Skip the n. */
+ succeed_n_p = false;
+ }
+
+ continue;
+
+
+ case succeed_n:
+ /* Get to the number of times to succeed. */
+ p += 2;
+
+ /* Increment p past the n for when k != 0. */
+ EXTRACT_NUMBER_AND_INCR (k, p);
+ if (k == 0)
+ {
+ p -= 4;
+ succeed_n_p = true; /* Spaghetti code alert. */
+ goto handle_on_failure_jump;
+ }
+ continue;
+
+
+ case set_number_at:
+ p += 4;
+ continue;
+
+
+ case start_memory:
+ case stop_memory:
+ p += 2;
+ continue;
+
+
+ default:
+ abort (); /* We have listed all the cases. */
+ } /* switch *p++ */
+
+ /* Getting here means we have found the possible starting
+ characters for one path of the pattern -- and that the empty
+ string does not match. We need not follow this path further.
+ Instead, look at the next alternative (remembered on the
+ stack), or quit if no more. The test at the top of the loop
+ does these things. */
+ path_can_be_null = false;
+ p = pend;
+ } /* while p */
+
+ /* Set `can_be_null' for the last path (also the first path, if the
+ pattern is empty). */
+ bufp->can_be_null |= path_can_be_null;
+
+ done:
+ RESET_FAIL_STACK ();
+ return 0;
+} /* re_compile_fastmap */
+\f
+/* Set REGS to hold NUM_REGS registers, storing them in STARTS and
+ ENDS. Subsequent matches using PATTERN_BUFFER and REGS will use
+ this memory for recording register information. STARTS and ENDS
+ must be allocated using the malloc library routine, and must each
+ be at least NUM_REGS * sizeof (regoff_t) bytes long.
+
+ If NUM_REGS == 0, then subsequent matches should allocate their own
+ register data.
+
+ Unless this function is called, the first search or match using
+ PATTERN_BUFFER will allocate its own register data, without
+ freeing the old data. */
+
+void
+re_set_registers (struct re_pattern_buffer *bufp, struct re_registers *regs,
+ unsigned num_regs, regoff_t *starts, regoff_t *ends)
+{
+ if (num_regs)
+ {
+ bufp->regs_allocated = REGS_REALLOCATE;
+ regs->num_regs = num_regs;
+ regs->start = starts;
+ regs->end = ends;
+ }
+ else
+ {
+ bufp->regs_allocated = REGS_UNALLOCATED;
+ regs->num_regs = 0;
+ regs->start = regs->end = (regoff_t *) 0;
+ }
+}
+\f
+/* Searching routines. */
+
+/* Like re_search_2, below, but only one string is specified, and
+ doesn't let you say where to stop matching. */
+
+int
+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,
+ regs, size);
+}
+
+#ifndef emacs
+/* Snarfed from src/lisp.h, needed for compiling [ce]tags. */
+# define bytecount_to_charcount(ptr, len) (len)
+# define charcount_to_bytecount(ptr, len) (len)
+typedef int Charcount;
+#endif
+
+/* Using the compiled pattern in BUFP->buffer, first tries to match the
+ virtual concatenation of STRING1 and STRING2, starting first at index
+ STARTPOS, then at STARTPOS + 1, and so on.
+
+ With MULE, STARTPOS is a byte position, not a char position. And the
+ search will increment STARTPOS by the width of the current leading
+ character.
+
+ STRING1 and STRING2 have length SIZE1 and SIZE2, respectively.
+
+ RANGE is how far to scan while trying to match. RANGE = 0 means try
+ only at STARTPOS; in general, the last start tried is STARTPOS +
+ RANGE.
+
+ With MULE, RANGE is a byte position, not a char position. The last
+ start tried is the character starting <= STARTPOS + RANGE.
+
+ In REGS, return the indices of the virtual concatenation of STRING1
+ and STRING2 that matched the entire BUFP->buffer and its contained
+ subexpressions.
+
+ Do not consider matching one past the index STOP in the virtual
+ concatenation of STRING1 and STRING2.
+
+ We return either the position in the strings at which the match was
+ found, -1 if no match, or -2 if error (such as failure
+ stack overflow). */
+
+int
+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;
+ REGISTER char *fastmap = bufp->fastmap;
+ REGISTER char *translate = bufp->translate;
+ int total_size = size1 + size2;
+ int endpos = startpos + range;
+#ifdef REGEX_BEGLINE_CHECK
+ int anchored_at_begline = 0;
+#endif
+ CONST unsigned char *d;
+ Charcount d_size;
+
+ /* Check for out-of-range STARTPOS. */
+ if (startpos < 0 || startpos > total_size)
+ return -1;
+
+ /* Fix up RANGE if it might eventually take us outside
+ the virtual concatenation of STRING1 and STRING2. */
+ if (endpos < 0)
+ range = 0 - startpos;
+ else if (endpos > total_size)
+ range = total_size - startpos;
+
+ /* If the search isn't to be a backwards one, don't waste time in a
+ search for a pattern that must be anchored. */
+ if (bufp->used > 0 && (re_opcode_t) bufp->buffer[0] == begbuf && range > 0)
+ {
+ if (startpos > 0)
+ return -1;
+ else
+ {
+ d = ((CONST unsigned char *)
+ (startpos >= size1 ? string2 - size1 : string1) + startpos);
+ range = charcount_to_bytecount (d, 1);
+ }
+ }
+
+ /* Update the fastmap now if not correct already. */
+ if (fastmap && !bufp->fastmap_accurate)
+ if (re_compile_fastmap (bufp) == -2)
+ return -2;
+
+#ifdef REGEX_BEGLINE_CHECK
+ {
+ int i = 0;
+
+ while (i < bufp->used)
+ {
+ if (bufp->buffer[i] == start_memory ||
+ bufp->buffer[i] == stop_memory)
+ i += 2;
+ else
+ break;
+ }
+ anchored_at_begline = i < bufp->used && bufp->buffer[i] == begline;
+ }
+#endif
+
+ /* Loop through the string, looking for a place to start matching. */
+ for (;;)
+ {
+#ifdef REGEX_BEGLINE_CHECK
+ /* If the regex is anchored at the beginning of a line (i.e. with a ^),
+ then we can speed things up by skipping to the next beginning-of-
+ line. */
+ if (anchored_at_begline && startpos > 0 && startpos != size1 &&
+ range > 0)
+ {
+ /* whose stupid idea was it anyway to make this
+ function take two strings to match?? */
+ int lim = 0;
+ int irange = range;
+
+ if (startpos < size1 && startpos + range >= size1)
+ lim = range - (size1 - startpos);
+
+ d = ((CONST unsigned char *)
+ (startpos >= size1 ? string2 - size1 : string1) + startpos);
+ DEC_CHARPTR(d); /* Ok, since startpos != size1. */
+ d_size = charcount_to_bytecount (d, 1);
+
+ if (translate)
+#ifdef MULE
+ while (range > lim && (*d >= 0x80 || translate[*d] != '\n'))
+#else
+ while (range > lim && translate[*d] != '\n')
+#endif
+ {
+ d += d_size; /* Speedier INC_CHARPTR(d) */
+ d_size = charcount_to_bytecount (d, 1);
+ range -= d_size;
+ }
+ else
+ while (range > lim && *d != '\n')
+ {
+ d += d_size; /* Speedier INC_CHARPTR(d) */
+ d_size = charcount_to_bytecount (d, 1);
+ range -= d_size;
+ }
+
+ startpos += irange - range;
+ }
+#endif /* REGEX_BEGLINE_CHECK */
+
+ /* If a fastmap is supplied, skip quickly over characters that
+ cannot be the start of a match. If the pattern can match the
+ null string, however, we don't need to skip characters; we want
+ the first null string. */
+ if (fastmap && startpos < total_size && !bufp->can_be_null)
+ {
+ if (range > 0) /* Searching forwards. */
+ {
+ int lim = 0;
+ int irange = range;
+
+ if (startpos < size1 && startpos + range >= size1)
+ lim = range - (size1 - startpos);
+
+ d = ((CONST unsigned char *)
+ (startpos >= size1 ? string2 - size1 : string1) + startpos);
+
+ /* Written out as an if-else to avoid testing `translate'
+ inside the loop. */
+ if (translate)
+ while (range > lim &&
+#ifdef MULE
+ *d < 0x80 &&
+#endif
+ !fastmap[(unsigned char)translate[*d]])
+ {
+ d_size = charcount_to_bytecount (d, 1);
+ range -= d_size;
+ d += d_size; /* Speedier INC_CHARPTR(d) */
+ }
+ else
+ while (range > lim && !fastmap[*d])
+ {
+ d_size = charcount_to_bytecount (d, 1);
+ range -= d_size;
+ d += d_size; /* Speedier INC_CHARPTR(d) */
+ }
+
+ startpos += irange - range;
+ }
+ else /* Searching backwards. */
+ {
+ unsigned char c = (size1 == 0 || startpos >= size1
+ ? string2[startpos - size1]
+ : string1[startpos]);
+#ifdef MULE
+ if (c < 0x80 && !fastmap[(unsigned char) TRANSLATE (c)])
+#else
+ if (!fastmap[(unsigned char) TRANSLATE (c)])
+#endif
+ goto advance;
+ }
+ }
+
+ /* If can't match the null string, and that's all we have left, fail. */
+ if (range >= 0 && startpos == total_size && fastmap
+ && !bufp->can_be_null)
+ return -1;
+
+#ifdef emacs /* XEmacs added, w/removal of immediate_quit */
+ if (!no_quit_in_re_search)
+ QUIT;
+#endif
+ val = re_match_2_internal (bufp, string1, size1, string2, size2,
+ startpos, regs, stop);
+#ifndef REGEX_MALLOC
+#ifdef C_ALLOCA
+ alloca (0);
+#endif
+#endif
+
+ if (val >= 0)
+ return startpos;
+
+ if (val == -2)
+ return -2;
+
+ advance:
+ if (!range)
+ break;
+ else if (range > 0)
+ {
+ d = ((CONST unsigned char *)
+ (startpos >= size1 ? string2 - size1 : string1) + startpos);
+ d_size = charcount_to_bytecount (d, 1);
+ range -= d_size;
+ startpos += d_size;
+ }
+ else
+ {
+ /* Note startpos > size1 not >=. If we are on the
+ string1/string2 boundary, we want to backup into string1. */
+ d = ((CONST unsigned char *)
+ (startpos > size1 ? string2 - size1 : string1) + startpos);
+ DEC_CHARPTR(d);
+ d_size = charcount_to_bytecount (d, 1);
+ range += d_size;
+ startpos -= d_size;
+ }
+ }
+ return -1;
+} /* re_search_2 */
+\f
+/* Declarations and macros for re_match_2. */
+
+/* This converts PTR, a pointer into one of the search strings `string1'
+ and `string2' into an offset from the beginning of that string. */
+#define POINTER_TO_OFFSET(ptr) \
+ (FIRST_STRING_P (ptr) \
+ ? ((regoff_t) ((ptr) - string1)) \
+ : ((regoff_t) ((ptr) - string2 + size1)))
+
+/* Macros for dealing with the split strings in re_match_2. */
+
+#define MATCHING_IN_FIRST_STRING (dend == end_match_1)
+
+/* Call before fetching a character with *d. This switches over to
+ string2 if necessary. */
+#define PREFETCH() \
+ while (d == dend) \
+ { \
+ /* End of string2 => fail. */ \
+ if (dend == end_match_2) \
+ goto fail; \
+ /* End of string1 => advance to string2. */ \
+ d = string2; \
+ dend = end_match_2; \
+ }
+
+
+/* Test if at very beginning or at very end of the virtual concatenation
+ of `string1' and `string2'. If only one string, it's `string2'. */
+#define AT_STRINGS_BEG(d) ((d) == (size1 ? string1 : string2) || !size2)
+#define AT_STRINGS_END(d) ((d) == end2)
+
+/* XEmacs change:
+ If the given position straddles the string gap, return the equivalent
+ position that is before or after the gap, respectively; otherwise,
+ return the same position. */
+#define POS_BEFORE_GAP_UNSAFE(d) ((d) == string2 ? end1 : (d))
+#define POS_AFTER_GAP_UNSAFE(d) ((d) == end1 ? string2 : (d))
+
+/* Test if CH is a word-constituent character. (XEmacs change) */
+#define WORDCHAR_P_UNSAFE(ch) \
+ (SYNTAX_UNSAFE (XCHAR_TABLE (regex_emacs_buffer->mirror_syntax_table), \
+ ch) == Sword)
+
+/* Free everything we malloc. */
+#ifdef MATCH_MAY_ALLOCATE
+#define FREE_VAR(var) if (var) REGEX_FREE (var); var = NULL
+#define FREE_VARIABLES() \
+ do { \
+ REGEX_FREE_STACK (fail_stack.stack); \
+ FREE_VAR (regstart); \
+ FREE_VAR (regend); \
+ FREE_VAR (old_regstart); \
+ FREE_VAR (old_regend); \
+ FREE_VAR (best_regstart); \
+ FREE_VAR (best_regend); \
+ FREE_VAR (reg_info); \
+ FREE_VAR (reg_dummy); \
+ FREE_VAR (reg_info_dummy); \
+ } while (0)
+#else
+#define FREE_VARIABLES() ((void)0) /* Do nothing! But inhibit gcc warning. */
+#endif /* not MATCH_MAY_ALLOCATE */
+
+/* These values must meet several constraints. They must not be valid
+ register values; since we have a limit of 255 registers (because
+ we use only one byte in the pattern for the register number), we can
+ use numbers larger than 255. They must differ by 1, because of
+ NUM_FAILURE_ITEMS above. And the value for the lowest register must
+ be larger than the value for the highest register, so we do not try
+ to actually save any registers when none are active. */
+#define NO_HIGHEST_ACTIVE_REG (1 << BYTEWIDTH)
+#define NO_LOWEST_ACTIVE_REG (NO_HIGHEST_ACTIVE_REG + 1)
+\f
+/* Matching routines. */
+
+#ifndef emacs /* Emacs never uses this. */
+/* 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,
+ int pos, struct re_registers *regs)
+{
+ int result = re_match_2_internal (bufp, NULL, 0, string, size,
+ pos, regs, size);
+ alloca (0);
+ return result;
+}
+#endif /* not emacs */
+
+
+/* re_match_2 matches the compiled pattern in BUFP against the
+ (virtual) concatenation of STRING1 and STRING2 (of length SIZE1 and
+ SIZE2, respectively). We start matching at POS, and stop matching
+ at STOP.
+
+ If REGS is non-null and the `no_sub' field of BUFP is nonzero, we
+ store offsets for the substring each group matched in REGS. See the
+ documentation for exactly how many groups we fill.
+
+ We return -1 if no match, -2 if an internal error (such as the
+ failure stack overflowing). Otherwise, we return the length of the
+ matched substring. */
+
+int
+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,
+ pos, regs, stop);
+ alloca (0);
+ return result;
+}
+
+/* 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,
+ struct re_registers *regs, int stop)
+{
+ /* General temporaries. */
+ int mcnt;
+ unsigned char *p1;
+ int should_succeed; /* XEmacs change */
+
+ /* Just past the end of the corresponding string. */
+ 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;
+
+ /* Where we are in the data, and the end of the current string. */
+ CONST char *d, *dend;
+
+ /* Where we are in the pattern, and the end of the pattern. */
+ unsigned char *p = bufp->buffer;
+ REGISTER unsigned char *pend = p + bufp->used;
+
+ /* Mark the opcode just after a start_memory, so we can test for an
+ empty subpattern when we get to the stop_memory. */
+ unsigned char *just_past_start_mem = 0;
+
+ /* We use this to map every character in the string. */
+ char *translate = bufp->translate;
+
+ /* Failure point stack. Each place that can handle a failure further
+ down the line pushes a failure point on this stack. It consists of
+ restart, regend, and reg_info for all registers corresponding to
+ the subexpressions we're currently inside, plus the number of such
+ registers, and, finally, two char *'s. The first char * is where
+ to resume scanning the pattern; the second one is where to resume
+ scanning the strings. If the latter is zero, the failure point is
+ a ``dummy''; if a failure happens and the failure point is a dummy,
+ it gets discarded and the next one is tried. */
+#ifdef MATCH_MAY_ALLOCATE /* otherwise, this is global. */
+ fail_stack_type fail_stack;
+#endif
+#ifdef DEBUG
+ static unsigned failure_id;
+ unsigned nfailure_points_pushed = 0, nfailure_points_popped = 0;
+#endif
+
+#ifdef REL_ALLOC
+ /* This holds the pointer to the failure stack, when
+ it is allocated relocatably. */
+ fail_stack_elt_t *failure_stack_ptr;
+#endif
+
+ /* We fill all the registers internally, independent of what we
+ return, for use in backreferences. The number here includes
+ an element for register zero. */
+ unsigned num_regs = bufp->re_nsub + 1;
+
+ /* The currently active registers. */
+ unsigned lowest_active_reg = NO_LOWEST_ACTIVE_REG;
+ unsigned highest_active_reg = NO_HIGHEST_ACTIVE_REG;
+
+ /* Information on the contents of registers. These are pointers into
+ the input strings; they record just what was matched (on this
+ attempt) by a subexpression part of the pattern, that is, the
+ regnum-th regstart pointer points to where in the pattern we began
+ matching and the regnum-th regend points to right after where we
+ 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;
+#endif
+
+ /* If a group that's operated upon by a repetition operator fails to
+ match anything, then the register for its start will need to be
+ restored because it will have been set to wherever in the string we
+ 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;
+#endif
+
+ /* The is_active field of reg_info helps us keep track of which (possibly
+ nested) subexpressions we are currently in. The matched_something
+ field of reg_info[reg_num] helps us tell whether or not we have
+ matched any of the pattern so far this time through the reg_num-th
+ subexpression. These two fields get reset each time through any
+ loop their register is in. */
+#ifdef MATCH_MAY_ALLOCATE /* otherwise, this is global. */
+ register_info_type *reg_info;
+#endif
+
+ /* The following record the register info as found in the above
+ variables when we find a match better than any we've seen before.
+ This happens as we backtrack through the failure points, which in
+ 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;
+#endif
+
+ /* Logically, this is `best_regend[0]'. But we don't want to have to
+ allocate space for that if we're not allocating space for anything
+ else (see below). Also, we never need info about register 0 for
+ any of the other register vectors, and it seems rather a kludge to
+ treat `best_regend' differently than the rest. So we keep track of
+ 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;
+
+ /* 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;
+ register_info_type *reg_info_dummy;
+#endif
+
+#ifdef DEBUG
+ /* Counts the total number of registers pushed. */
+ unsigned num_regs_pushed = 0;
+#endif
+
+ /* 1 if this match ends in the same string (string1 or string2)
+ as the best previous match. */
+ boolean same_str_p;
+
+ /* 1 if this match is the best seen so far. */
+ boolean best_match_p;
+
+ DEBUG_PRINT1 ("\n\nEntering re_match_2.\n");
+
+ INIT_FAIL_STACK ();
+
+#ifdef MATCH_MAY_ALLOCATE
+ /* Do not bother to initialize all the register variables if there are
+ no groups in the pattern, as it takes a fair amount of time. If
+ there are groups, we include space for register 0 (the whole
+ pattern), even though we never use it, since it simplifies the
+ 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 *);
+ reg_info = REGEX_TALLOC (num_regs, register_info_type);
+ 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
+ && best_regstart && best_regend && reg_dummy && reg_info_dummy))
+ {
+ FREE_VARIABLES ();
+ return -2;
+ }
+ }
+ else
+ {
+ /* We must initialize all our variables to NULL, so that
+ `FREE_VARIABLES' doesn't try to free them. */
+ regstart = regend = old_regstart = old_regend = best_regstart
+ = best_regend = reg_dummy = NULL;
+ reg_info = reg_info_dummy = (register_info_type *) NULL;
+ }
+#endif /* MATCH_MAY_ALLOCATE */
+
+ /* The starting position is bogus. */
+ if (pos < 0 || pos > size1 + size2)
+ {
+ FREE_VARIABLES ();
+ return -1;
+ }
+
+ /* Initialize subexpression text positions to -1 to mark ones that no
+ start_memory/stop_memory has been seen for. Also initialize the
+ register information struct. */
+ for (mcnt = 1; mcnt < num_regs; mcnt++)
+ {
+ regstart[mcnt] = regend[mcnt]
+ = old_regstart[mcnt] = old_regend[mcnt] = REG_UNSET_VALUE;
+
+ REG_MATCH_NULL_STRING_P (reg_info[mcnt]) = MATCH_NULL_UNSET_VALUE;
+ IS_ACTIVE (reg_info[mcnt]) = 0;
+ MATCHED_SOMETHING (reg_info[mcnt]) = 0;
+ EVER_MATCHED_SOMETHING (reg_info[mcnt]) = 0;
+ }
+
+ /* We move `string1' into `string2' if the latter's empty -- but not if
+ `string1' is null. */
+ if (size2 == 0 && string1 != NULL)
+ {
+ string2 = string1;
+ size2 = size1;
+ string1 = 0;
+ size1 = 0;
+ }
+ end1 = string1 + size1;
+ end2 = string2 + size2;
+
+ /* Compute where to stop matching, within the two strings. */
+ if (stop <= size1)
+ {
+ end_match_1 = string1 + stop;
+ end_match_2 = string2;
+ }
+ else
+ {
+ end_match_1 = end1;
+ end_match_2 = string2 + stop - size1;
+ }
+
+ /* `p' scans through the pattern as `d' scans through the data.
+ `dend' is the end of the input string that `d' points within. `d'
+ is advanced into the following input string whenever necessary, but
+ this happens before fetching; therefore, at the beginning of the
+ loop, `d' can be pointing at the end of a string, but it cannot
+ equal `string2'. */
+ if (size1 > 0 && pos <= size1)
+ {
+ d = string1 + pos;
+ dend = end_match_1;
+ }
+ else
+ {
+ d = string2 + pos - size1;
+ dend = end_match_2;
+ }
+
+ DEBUG_PRINT1 ("The compiled pattern is: ");
+ DEBUG_PRINT_COMPILED_PATTERN (bufp, p, pend);
+ DEBUG_PRINT1 ("The string to match is: `");
+ DEBUG_PRINT_DOUBLE_STRING (d, string1, size1, string2, size2);
+ DEBUG_PRINT1 ("'\n");
+
+ /* This loops over pattern commands. It exits by returning from the
+ function if the match is complete, or it drops through if the match
+ fails at this starting point in the input data. */
+ for (;;)
+ {
+ DEBUG_PRINT2 ("\n0x%p: ", p);
+#ifdef emacs /* XEmacs added, w/removal of immediate_quit */
+ if (!no_quit_in_re_search)
+ QUIT;
+#endif
+
+ if (p == pend)
+ { /* End of pattern means we might have succeeded. */
+ DEBUG_PRINT1 ("end of pattern ... ");
+
+ /* If we haven't matched the entire string, and we want the
+ longest match, try backtracking. */
+ if (d != end_match_2)
+ {
+ same_str_p = (FIRST_STRING_P (match_end)
+ == MATCHING_IN_FIRST_STRING);
+
+ /* AIX compiler got confused when this was combined
+ with the previous declaration. */
+ if (same_str_p)
+ best_match_p = d > match_end;
+ else
+ best_match_p = !MATCHING_IN_FIRST_STRING;
+
+ DEBUG_PRINT1 ("backtracking.\n");
+
+ if (!FAIL_STACK_EMPTY ())
+ { /* More failure points to try. */
+
+ /* If exceeds best match so far, save it. */
+ if (!best_regs_set || best_match_p)
+ {
+ best_regs_set = true;
+ match_end = d;
+
+ DEBUG_PRINT1 ("\nSAVING match as best so far.\n");
+
+ for (mcnt = 1; mcnt < num_regs; mcnt++)
+ {
+ best_regstart[mcnt] = regstart[mcnt];
+ best_regend[mcnt] = regend[mcnt];
+ }
+ }
+ goto fail;
+ }
+
+ /* If no failure points, don't restore garbage. And if
+ last match is real best match, don't restore second
+ best one. */
+ else if (best_regs_set && !best_match_p)
+ {
+ restore_best_regs:
+ /* Restore best match. It may happen that `dend ==
+ end_match_1' while the restored d is in string2.
+ For example, the pattern `x.*y.*z' against the
+ strings `x-' and `y-z-', if the two strings are
+ not consecutive in memory. */
+ DEBUG_PRINT1 ("Restoring best registers.\n");
+
+ d = match_end;
+ dend = ((d >= string1 && d <= end1)
+ ? end_match_1 : end_match_2);
+
+ for (mcnt = 1; mcnt < num_regs; mcnt++)
+ {
+ regstart[mcnt] = best_regstart[mcnt];
+ regend[mcnt] = best_regend[mcnt];
+ }
+ }
+ } /* d != end_match_2 */
+
+ succeed_label:
+ DEBUG_PRINT1 ("Accepting match.\n");
+
+ /* If caller wants register contents data back, do it. */
+ if (regs && !bufp->no_sub)
+ {
+ /* Have the register data arrays been allocated? */
+ if (bufp->regs_allocated == REGS_UNALLOCATED)
+ { /* No. So allocate them with malloc. We need one
+ extra element beyond `num_regs' for the `-1' marker
+ GNU code uses. */
+ regs->num_regs = MAX (RE_NREGS, num_regs + 1);
+ regs->start = TALLOC (regs->num_regs, regoff_t);
+ regs->end = TALLOC (regs->num_regs, regoff_t);
+ if (regs->start == NULL || regs->end == NULL)
+ {
+ FREE_VARIABLES ();
+ return -2;
+ }
+ bufp->regs_allocated = REGS_REALLOCATE;
+ }
+ else if (bufp->regs_allocated == REGS_REALLOCATE)
+ { /* Yes. If we need more elements than were already
+ allocated, reallocate them. If we need fewer, just
+ leave it alone. */
+ if (regs->num_regs < num_regs + 1)
+ {
+ regs->num_regs = num_regs + 1;
+ RETALLOC (regs->start, regs->num_regs, regoff_t);
+ RETALLOC (regs->end, regs->num_regs, regoff_t);
+ if (regs->start == NULL || regs->end == NULL)
+ {
+ FREE_VARIABLES ();
+ return -2;
+ }
+ }
+ }
+ else
+ {
+ /* These braces fend off a "empty body in an else-statement"
+ warning under GCC when assert expands to nothing. */
+ assert (bufp->regs_allocated == REGS_FIXED);
+ }
+
+ /* Convert the pointer data in `regstart' and `regend' to
+ indices. Register zero has to be set differently,
+ since we haven't kept track of any info for it. */
+ if (regs->num_regs > 0)
+ {
+ regs->start[0] = pos;
+ regs->end[0] = (MATCHING_IN_FIRST_STRING
+ ? ((regoff_t) (d - string1))
+ : ((regoff_t) (d - string2 + size1)));
+ }
+
+ /* Go through the first `min (num_regs, regs->num_regs)'
+ registers, since that is all we initialized. */
+ for (mcnt = 1; mcnt < MIN (num_regs, regs->num_regs); mcnt++)
+ {
+ if (REG_UNSET (regstart[mcnt]) || REG_UNSET (regend[mcnt]))
+ regs->start[mcnt] = regs->end[mcnt] = -1;
+ else
+ {
+ regs->start[mcnt]
+ = (regoff_t) POINTER_TO_OFFSET (regstart[mcnt]);
+ regs->end[mcnt]
+ = (regoff_t) POINTER_TO_OFFSET (regend[mcnt]);
+ }
+ }
+
+ /* If the regs structure we return has more elements than
+ were in the pattern, set the extra elements to -1. If
+ we (re)allocated the registers, this is the case,
+ because we always allocate enough to have at least one
+ -1 at the end. */
+ for (mcnt = num_regs; mcnt < regs->num_regs; mcnt++)
+ regs->start[mcnt] = regs->end[mcnt] = -1;
+ } /* regs && !bufp->no_sub */
+
+ DEBUG_PRINT4 ("%u failure points pushed, %u popped (%u remain).\n",
+ nfailure_points_pushed, nfailure_points_popped,
+ nfailure_points_pushed - nfailure_points_popped);
+ DEBUG_PRINT2 ("%u registers pushed.\n", num_regs_pushed);
+
+ mcnt = d - pos - (MATCHING_IN_FIRST_STRING
+ ? string1
+ : string2 - size1);
+
+ DEBUG_PRINT2 ("Returning %d from re_match_2.\n", mcnt);
+
+ FREE_VARIABLES ();
+ return mcnt;
+ }
+
+ /* Otherwise match next pattern command. */
+ switch (SWITCH_ENUM_CAST ((re_opcode_t) *p++))
+ {
+ /* Ignore these. Used to ignore the n of succeed_n's which
+ currently have n == 0. */
+ case no_op:
+ DEBUG_PRINT1 ("EXECUTING no_op.\n");
+ break;
+
+ case succeed:
+ DEBUG_PRINT1 ("EXECUTING succeed.\n");
+ goto succeed_label;
+
+ /* Match the next n pattern characters exactly. The following
+ byte in the pattern defines n, and the n bytes after that
+ are the characters to match. */
+ case exactn:
+ mcnt = *p++;
+ DEBUG_PRINT2 ("EXECUTING exactn %d.\n", mcnt);
+
+ /* This is written out as an if-else so we don't waste time
+ testing `translate' inside the loop. */
+ if (translate)
+ {
+ do
+ {
+ PREFETCH ();
+ if (translate[(unsigned char) *d++] != (char) *p++)
+ goto fail;
+ }
+ while (--mcnt);
+ }
+ else
+ {
+ do
+ {
+ PREFETCH ();
+ if (*d++ != (char) *p++) goto fail;
+ }
+ while (--mcnt);
+ }
+ SET_REGS_MATCHED ();
+ break;
+
+
+ /* Match any character except possibly a newline or a null. */
+ case anychar:
+ DEBUG_PRINT1 ("EXECUTING anychar.\n");
+
+ PREFETCH ();
+
+ if ((!(bufp->syntax & RE_DOT_NEWLINE) && TRANSLATE (*d) == '\n')
+ || (bufp->syntax & RE_DOT_NOT_NULL && TRANSLATE (*d) == '\000'))
+ goto fail;
+
+ SET_REGS_MATCHED ();
+ DEBUG_PRINT2 (" Matched `%d'.\n", *d);
+ INC_CHARPTR (d); /* XEmacs change */
+ break;
+
+
+ case charset:
+ case charset_not:
+ {
+ REGISTER unsigned char c;
+ boolean not = (re_opcode_t) *(p - 1) == charset_not;
+
+ DEBUG_PRINT2 ("EXECUTING charset%s.\n", not ? "_not" : "");
+
+ PREFETCH ();
+ c = TRANSLATE (*d); /* The character to match. */
+
+ /* Cast to `unsigned' instead of `unsigned char' in case the
+ bit list is a full 32 bytes long. */
+ if (c < (unsigned) (*p * BYTEWIDTH)
+ && p[1 + c / BYTEWIDTH] & (1 << (c % BYTEWIDTH)))
+ not = !not;
+
+ p += 1 + *p;
+
+ if (!not) goto fail;
+
+ SET_REGS_MATCHED ();
+ INC_CHARPTR (d); /* XEmacs change */
+ break;
+ }
+
+#ifdef MULE
+ case charset_mule:
+ case charset_mule_not:
+ {
+ REGISTER Emchar c;
+ boolean not = (re_opcode_t) *(p - 1) == charset_mule_not;
+
+ DEBUG_PRINT2 ("EXECUTING charset_mule%s.\n", not ? "_not" : "");
+
+ PREFETCH ();
+ 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)))
+ not = !not;
+
+ p += unified_range_table_bytes_used (p);
+
+ if (!not) goto fail;
+
+ SET_REGS_MATCHED ();
+ INC_CHARPTR (d);
+ break;
+ }
+#endif /* MULE */
+
+
+ /* The beginning of a group is represented by start_memory.
+ The arguments are the register number in the next byte, and the
+ number of groups inner to this one in the next. The text
+ matched within the group is recorded (in the internal
+ registers data structure) under the register number. */
+ case start_memory:
+ DEBUG_PRINT3 ("EXECUTING start_memory %d (%d):\n", *p, p[1]);
+
+ /* Find out if this group can match the empty string. */
+ p1 = p; /* To send to group_match_null_string_p. */
+
+ if (REG_MATCH_NULL_STRING_P (reg_info[*p]) == MATCH_NULL_UNSET_VALUE)
+ REG_MATCH_NULL_STRING_P (reg_info[*p])
+ = group_match_null_string_p (&p1, pend, reg_info);
+
+ /* Save the position in the string where we were the last time
+ we were at this open-group operator in case the group is
+ operated upon by a repetition operator, e.g., with `(a*)*b'
+ against `ab'; then we want to ignore where we are now in
+ the string in case this attempt to match fails. */
+ old_regstart[*p] = REG_MATCH_NULL_STRING_P (reg_info[*p])
+ ? REG_UNSET (regstart[*p]) ? d : regstart[*p]
+ : regstart[*p];
+ DEBUG_PRINT2 (" old_regstart: %d\n",
+ POINTER_TO_OFFSET (old_regstart[*p]));
+
+ regstart[*p] = d;
+ DEBUG_PRINT2 (" regstart: %d\n", POINTER_TO_OFFSET (regstart[*p]));
+
+ IS_ACTIVE (reg_info[*p]) = 1;
+ MATCHED_SOMETHING (reg_info[*p]) = 0;
+
+ /* Clear this whenever we change the register activity status. */
+ set_regs_matched_done = 0;
+
+ /* This is the new highest active register. */
+ highest_active_reg = *p;
+
+ /* If nothing was active before, this is the new lowest active
+ register. */
+ if (lowest_active_reg == NO_LOWEST_ACTIVE_REG)
+ lowest_active_reg = *p;
+
+ /* Move past the register number and inner group count. */
+ p += 2;
+ just_past_start_mem = p;
+
+ break;
+
+
+ /* The stop_memory opcode represents the end of a group. Its
+ arguments are the same as start_memory's: the register
+ number, and the number of inner groups. */
+ case stop_memory:
+ DEBUG_PRINT3 ("EXECUTING stop_memory %d (%d):\n", *p, p[1]);
+
+ /* We need to save the string position the last time we were at
+ this close-group operator in case the group is operated
+ upon by a repetition operator, e.g., with `((a*)*(b*)*)*'
+ against `aba'; then we want to ignore where we are now in
+ the string in case this attempt to match fails. */
+ old_regend[*p] = REG_MATCH_NULL_STRING_P (reg_info[*p])
+ ? REG_UNSET (regend[*p]) ? d : regend[*p]
+ : regend[*p];
+ DEBUG_PRINT2 (" old_regend: %d\n",
+ POINTER_TO_OFFSET (old_regend[*p]));
+
+ regend[*p] = d;
+ DEBUG_PRINT2 (" regend: %d\n", POINTER_TO_OFFSET (regend[*p]));
+
+ /* This register isn't active anymore. */
+ IS_ACTIVE (reg_info[*p]) = 0;
+
+ /* Clear this whenever we change the register activity status. */
+ set_regs_matched_done = 0;
+
+ /* If this was the only register active, nothing is active
+ anymore. */
+ if (lowest_active_reg == highest_active_reg)
+ {
+ lowest_active_reg = NO_LOWEST_ACTIVE_REG;
+ highest_active_reg = NO_HIGHEST_ACTIVE_REG;
+ }
+ else
+ { /* We must scan for the new highest active register, since
+ it isn't necessarily one less than now: consider
+ (a(b)c(d(e)f)g). When group 3 ends, after the f), the
+ new highest active register is 1. */
+ unsigned char r = *p - 1;
+ while (r > 0 && !IS_ACTIVE (reg_info[r]))
+ r--;
+
+ /* If we end up at register zero, that means that we saved
+ the registers as the result of an `on_failure_jump', not
+ a `start_memory', and we jumped to past the innermost
+ `stop_memory'. For example, in ((.)*) we save
+ registers 1 and 2 as a result of the *, but when we pop
+ back to the second ), we are at the stop_memory 1.
+ Thus, nothing is active. */
+ if (r == 0)
+ {
+ lowest_active_reg = NO_LOWEST_ACTIVE_REG;
+ highest_active_reg = NO_HIGHEST_ACTIVE_REG;
+ }
+ else
+ highest_active_reg = r;
+ }
+
+ /* If just failed to match something this time around with a
+ group that's operated on by a repetition operator, try to
+ force exit from the ``loop'', and restore the register
+ information for this group that we had before trying this
+ last match. */
+ if ((!MATCHED_SOMETHING (reg_info[*p])
+ || just_past_start_mem == p - 1)
+ && (p + 2) < pend)
+ {
+ boolean is_a_jump_n = false;
+
+ p1 = p + 2;
+ mcnt = 0;
+ switch ((re_opcode_t) *p1++)
+ {
+ case jump_n:
+ is_a_jump_n = true;
+ case pop_failure_jump:
+ case maybe_pop_jump:
+ case jump:
+ case dummy_failure_jump:
+ EXTRACT_NUMBER_AND_INCR (mcnt, p1);
+ if (is_a_jump_n)
+ p1 += 2;
+ break;
+
+ default:
+ /* do nothing */ ;
+ }
+ p1 += mcnt;
+
+ /* If the next operation is a jump backwards in the pattern
+ to an on_failure_jump right before the start_memory
+ corresponding to this stop_memory, exit from the loop
+ by forcing a failure after pushing on the stack the
+ on_failure_jump's jump in the pattern, and d. */
+ if (mcnt < 0 && (re_opcode_t) *p1 == on_failure_jump
+ && (re_opcode_t) p1[3] == start_memory && p1[4] == *p)
+ {
+ /* If this group ever matched anything, then restore
+ what its registers were before trying this last
+ failed match, e.g., with `(a*)*b' against `ab' for
+ regstart[1], and, e.g., with `((a*)*(b*)*)*'
+ against `aba' for regend[3].
+
+ Also restore the registers for inner groups for,
+ e.g., `((a*)(b*))*' against `aba' (register 3 would
+ otherwise get trashed). */
+
+ if (EVER_MATCHED_SOMETHING (reg_info[*p]))
+ {
+ unsigned r;
+
+ EVER_MATCHED_SOMETHING (reg_info[*p]) = 0;
+
+ /* Restore this and inner groups' (if any) registers. */
+ for (r = *p; r < *p + *(p + 1); r++)
+ {
+ regstart[r] = old_regstart[r];
+
+ /* xx why this test? */
+ if (old_regend[r] >= regstart[r])
+ regend[r] = old_regend[r];
+ }
+ }
+ p1++;
+ EXTRACT_NUMBER_AND_INCR (mcnt, p1);
+ PUSH_FAILURE_POINT (p1 + mcnt, d, -2);
+
+ goto fail;
+ }
+ }
+
+ /* Move past the register number and the inner group count. */
+ p += 2;
+ break;
+
+
+ /* \<digit> has been turned into a `duplicate' command which is
+ followed by the numeric value of <digit> as the register number. */
+ case duplicate:
+ {
+ REGISTER CONST char *d2, *dend2;
+ int regno = *p++; /* Get which register to match against. */
+ DEBUG_PRINT2 ("EXECUTING duplicate %d.\n", regno);
+
+ /* Can't back reference a group which we've never matched. */
+ if (REG_UNSET (regstart[regno]) || REG_UNSET (regend[regno]))
+ goto fail;
+
+ /* Where in input to try to start matching. */
+ d2 = regstart[regno];
+
+ /* Where to stop matching; if both the place to start and
+ the place to stop matching are in the same string, then
+ set to the place to stop, otherwise, for now have to use
+ the end of the first string. */
+
+ dend2 = ((FIRST_STRING_P (regstart[regno])
+ == FIRST_STRING_P (regend[regno]))
+ ? regend[regno] : end_match_1);
+ for (;;)
+ {
+ /* If necessary, advance to next segment in register
+ contents. */
+ while (d2 == dend2)
+ {
+ if (dend2 == end_match_2) break;
+ if (dend2 == regend[regno]) break;
+
+ /* End of string1 => advance to string2. */
+ d2 = string2;
+ dend2 = regend[regno];
+ }
+ /* At end of register contents => success */
+ if (d2 == dend2) break;
+
+ /* If necessary, advance to next segment in data. */
+ PREFETCH ();
+
+ /* How many characters left in this segment to match. */
+ mcnt = dend - d;
+
+ /* Want how many consecutive characters we can match in
+ one shot, so, if necessary, adjust the count. */
+ if (mcnt > dend2 - d2)
+ mcnt = dend2 - d2;
+
+ /* Compare that many; failure if mismatch, else move
+ past them. */
+ if (translate
+ ? bcmp_translate ((unsigned char *) d,
+ (unsigned char *) d2, mcnt, translate)
+ : memcmp (d, d2, mcnt))
+ goto fail;
+ d += mcnt, d2 += mcnt;
+
+ /* Do this because we've match some characters. */
+ SET_REGS_MATCHED ();
+ }
+ }
+ break;
+
+
+ /* begline matches the empty string at the beginning of the string
+ (unless `not_bol' is set in `bufp'), and, if
+ `newline_anchor' is set, after newlines. */
+ case begline:
+ DEBUG_PRINT1 ("EXECUTING begline.\n");
+
+ if (AT_STRINGS_BEG (d))
+ {
+ if (!bufp->not_bol) break;
+ }
+ else if (d[-1] == '\n' && bufp->newline_anchor)
+ {
+ break;
+ }
+ /* In all other cases, we fail. */
+ goto fail;
+
+
+ /* endline is the dual of begline. */
+ case endline:
+ DEBUG_PRINT1 ("EXECUTING endline.\n");
+
+ if (AT_STRINGS_END (d))
+ {
+ if (!bufp->not_eol) break;
+ }
+
+ /* We have to ``prefetch'' the next character. */
+ else if ((d == end1 ? *string2 : *d) == '\n'
+ && bufp->newline_anchor)
+ {
+ break;
+ }
+ goto fail;
+
+
+ /* Match at the very beginning of the data. */
+ case begbuf:
+ DEBUG_PRINT1 ("EXECUTING begbuf.\n");
+ if (AT_STRINGS_BEG (d))
+ break;
+ goto fail;
+
+
+ /* Match at the very end of the data. */
+ case endbuf:
+ DEBUG_PRINT1 ("EXECUTING endbuf.\n");
+ if (AT_STRINGS_END (d))
+ break;
+ goto fail;
+
+
+ /* on_failure_keep_string_jump is used to optimize `.*\n'. It
+ pushes NULL as the value for the string on the stack. Then
+ `pop_failure_point' will keep the current value for the
+ string, instead of restoring it. To see why, consider
+ matching `foo\nbar' against `.*\n'. The .* matches the foo;
+ then the . fails against the \n. But the next thing we want
+ to do is match the \n against the \n; if we restored the
+ string value, we would be back at the foo.
+
+ Because this is used only in specific cases, we don't need to
+ check all the things that `on_failure_jump' does, to make
+ sure the right things get saved on the stack. Hence we don't
+ share its code. The only reason to push anything on the
+ stack at all is that otherwise we would have to change
+ `anychar's code to do something besides goto fail in this
+ case; that seems worse than this. */
+ case on_failure_keep_string_jump:
+ DEBUG_PRINT1 ("EXECUTING on_failure_keep_string_jump");
+
+ EXTRACT_NUMBER_AND_INCR (mcnt, p);
+ DEBUG_PRINT3 (" %d (to 0x%p):\n", mcnt, p + mcnt);
+
+ PUSH_FAILURE_POINT (p + mcnt, (char *) 0, -2);
+ break;
+
+
+ /* Uses of on_failure_jump:
+
+ Each alternative starts with an on_failure_jump that points
+ to the beginning of the next alternative. Each alternative
+ except the last ends with a jump that in effect jumps past
+ the rest of the alternatives. (They really jump to the
+ ending jump of the following alternative, because tensioning
+ these jumps is a hassle.)
+
+ Repeats start with an on_failure_jump that points past both
+ the repetition text and either the following jump or
+ pop_failure_jump back to this on_failure_jump. */
+ case on_failure_jump:
+ on_failure:
+ DEBUG_PRINT1 ("EXECUTING on_failure_jump");
+
+ EXTRACT_NUMBER_AND_INCR (mcnt, p);
+ DEBUG_PRINT3 (" %d (to 0x%p)", mcnt, p + mcnt);
+
+ /* If this on_failure_jump comes right before a group (i.e.,
+ the original * applied to a group), save the information
+ for that group and all inner ones, so that if we fail back
+ to this point, the group's information will be correct.
+ For example, in \(a*\)*\1, we need the preceding group,
+ and in \(\(a*\)b*\)\2, we need the inner group. */
+
+ /* We can't use `p' to check ahead because we push
+ a failure point to `p + mcnt' after we do this. */
+ p1 = p;
+
+ /* We need to skip no_op's before we look for the
+ start_memory in case this on_failure_jump is happening as
+ the result of a completed succeed_n, as in \(a\)\{1,3\}b\1
+ against aba. */
+ while (p1 < pend && (re_opcode_t) *p1 == no_op)
+ p1++;
+
+ if (p1 < pend && (re_opcode_t) *p1 == start_memory)
+ {
+ /* We have a new highest active register now. This will
+ get reset at the start_memory we are about to get to,
+ but we will have saved all the registers relevant to
+ this repetition op, as described above. */
+ highest_active_reg = *(p1 + 1) + *(p1 + 2);
+ if (lowest_active_reg == NO_LOWEST_ACTIVE_REG)
+ lowest_active_reg = *(p1 + 1);
+ }
+
+ DEBUG_PRINT1 (":\n");
+ PUSH_FAILURE_POINT (p + mcnt, d, -2);
+ break;
+
+
+ /* A smart repeat ends with `maybe_pop_jump'.
+ We change it to either `pop_failure_jump' or `jump'. */
+ case maybe_pop_jump:
+ EXTRACT_NUMBER_AND_INCR (mcnt, p);
+ DEBUG_PRINT2 ("EXECUTING maybe_pop_jump %d.\n", mcnt);
+ {
+ REGISTER unsigned char *p2 = p;
+
+ /* Compare the beginning of the repeat with what in the
+ pattern follows its end. If we can establish that there
+ is nothing that they would both match, i.e., that we
+ would have to backtrack because of (as in, e.g., `a*a')
+ then we can change to pop_failure_jump, because we'll
+ never have to backtrack.
+
+ This is not true in the case of alternatives: in
+ `(a|ab)*' we do need to backtrack to the `ab' alternative
+ (e.g., if the string was `ab'). But instead of trying to
+ detect that here, the alternative has put on a dummy
+ failure point which is what we will end up popping. */
+
+ /* Skip over open/close-group commands.
+ If what follows this loop is a ...+ construct,
+ look at what begins its body, since we will have to
+ match at least one of that. */
+ while (1)
+ {
+ if (p2 + 2 < pend
+ && ((re_opcode_t) *p2 == stop_memory
+ || (re_opcode_t) *p2 == start_memory))
+ p2 += 3;
+ else if (p2 + 6 < pend
+ && (re_opcode_t) *p2 == dummy_failure_jump)
+ p2 += 6;
+ else
+ break;
+ }
+
+ p1 = p + mcnt;
+ /* p1[0] ... p1[2] are the `on_failure_jump' corresponding
+ to the `maybe_finalize_jump' of this case. Examine what
+ follows. */
+
+ /* If we're at the end of the pattern, we can change. */
+ if (p2 == pend)
+ {
+ /* Consider what happens when matching ":\(.*\)"
+ against ":/". I don't really understand this code
+ yet. */
+ p[-3] = (unsigned char) pop_failure_jump;
+ DEBUG_PRINT1
+ (" End of pattern: change to `pop_failure_jump'.\n");
+ }
+
+ else if ((re_opcode_t) *p2 == exactn
+ || (bufp->newline_anchor && (re_opcode_t) *p2 == endline))
+ {
+ REGISTER unsigned char c
+ = *p2 == (unsigned char) endline ? '\n' : p2[2];
+
+ if ((re_opcode_t) p1[3] == exactn && p1[5] != c)
+ {
+ p[-3] = (unsigned char) pop_failure_jump;
+ DEBUG_PRINT3 (" %c != %c => pop_failure_jump.\n",
+ c, p1[5]);
+ }
+
+ else if ((re_opcode_t) p1[3] == charset
+ || (re_opcode_t) p1[3] == charset_not)
+ {
+ int not = (re_opcode_t) p1[3] == charset_not;
+
+ if (c < (unsigned char) (p1[4] * BYTEWIDTH)
+ && p1[5 + c / BYTEWIDTH] & (1 << (c % BYTEWIDTH)))
+ not = !not;
+
+ /* `not' is equal to 1 if c would match, which means
+ that we can't change to pop_failure_jump. */
+ if (!not)
+ {
+ p[-3] = (unsigned char) pop_failure_jump;
+ DEBUG_PRINT1 (" No match => pop_failure_jump.\n");
+ }
+ }
+ }
+ else if ((re_opcode_t) *p2 == charset)
+ {
+#ifdef DEBUG
+ REGISTER unsigned char c
+ = *p2 == (unsigned char) endline ? '\n' : p2[2];
+#endif
+
+ if ((re_opcode_t) p1[3] == exactn
+ && ! ((int) p2[1] * BYTEWIDTH > (int) p1[5]
+ && (p2[2 + p1[5] / BYTEWIDTH]
+ & (1 << (p1[5] % BYTEWIDTH)))))
+ {
+ p[-3] = (unsigned char) pop_failure_jump;
+ DEBUG_PRINT3 (" %c != %c => pop_failure_jump.\n",
+ c, p1[5]);
+ }
+
+ else if ((re_opcode_t) p1[3] == charset_not)
+ {
+ int idx;
+ /* We win if the charset_not inside the loop
+ lists every character listed in the charset after. */
+ for (idx = 0; idx < (int) p2[1]; idx++)
+ if (! (p2[2 + idx] == 0
+ || (idx < (int) p1[4]
+ && ((p2[2 + idx] & ~ p1[5 + idx]) == 0))))
+ break;
+
+ if (idx == p2[1])
+ {
+ p[-3] = (unsigned char) pop_failure_jump;
+ DEBUG_PRINT1 (" No match => pop_failure_jump.\n");
+ }
+ }
+ else if ((re_opcode_t) p1[3] == charset)
+ {
+ int idx;
+ /* We win if the charset inside the loop
+ has no overlap with the one after the loop. */
+ for (idx = 0;
+ idx < (int) p2[1] && idx < (int) p1[4];
+ idx++)
+ if ((p2[2 + idx] & p1[5 + idx]) != 0)
+ break;
+
+ if (idx == p2[1] || idx == p1[4])
+ {
+ p[-3] = (unsigned char) pop_failure_jump;
+ DEBUG_PRINT1 (" No match => pop_failure_jump.\n");
+ }
+ }
+ }
+ }
+ p -= 2; /* Point at relative address again. */
+ if ((re_opcode_t) p[-1] != pop_failure_jump)
+ {
+ p[-1] = (unsigned char) jump;
+ DEBUG_PRINT1 (" Match => jump.\n");
+ goto unconditional_jump;
+ }
+ /* Note fall through. */
+
+
+ /* The end of a simple repeat has a pop_failure_jump back to
+ its matching on_failure_jump, where the latter will push a
+ failure point. The pop_failure_jump takes off failure
+ points put on by this pop_failure_jump's matching
+ on_failure_jump; we got through the pattern to here from the
+ matching on_failure_jump, so didn't fail. */
+ case pop_failure_jump:
+ {
+ /* We need to pass separate storage for the lowest and
+ highest registers, even though we don't care about the
+ actual values. Otherwise, we will restore only one
+ register from the stack, since lowest will == highest in
+ `pop_failure_point'. */
+ unsigned dummy_low_reg, dummy_high_reg;
+ unsigned char *pdummy;
+ CONST char *sdummy = NULL;
+
+ DEBUG_PRINT1 ("EXECUTING pop_failure_jump.\n");
+ POP_FAILURE_POINT (sdummy, pdummy,
+ dummy_low_reg, dummy_high_reg,
+ reg_dummy, reg_dummy, reg_info_dummy);
+ }
+ /* Note fall through. */
+
+
+ /* Unconditionally jump (without popping any failure points). */
+ case jump:
+ unconditional_jump:
+ EXTRACT_NUMBER_AND_INCR (mcnt, p); /* Get the amount to jump. */
+ DEBUG_PRINT2 ("EXECUTING jump %d ", mcnt);
+ p += mcnt; /* Do the jump. */
+ DEBUG_PRINT2 ("(to 0x%p).\n", p);
+ break;
+
+
+ /* We need this opcode so we can detect where alternatives end
+ in `group_match_null_string_p' et al. */
+ case jump_past_alt:
+ DEBUG_PRINT1 ("EXECUTING jump_past_alt.\n");
+ goto unconditional_jump;
+
+
+ /* Normally, the on_failure_jump pushes a failure point, which
+ then gets popped at pop_failure_jump. We will end up at
+ pop_failure_jump, also, and with a pattern of, say, `a+', we
+ are skipping over the on_failure_jump, so we have to push
+ something meaningless for pop_failure_jump to pop. */
+ case dummy_failure_jump:
+ DEBUG_PRINT1 ("EXECUTING dummy_failure_jump.\n");
+ /* It doesn't matter what we push for the string here. What
+ the code at `fail' tests is the value for the pattern. */
+ PUSH_FAILURE_POINT ((unsigned char *) 0, (char *) 0, -2);
+ goto unconditional_jump;
+
+
+ /* At the end of an alternative, we need to push a dummy failure
+ point in case we are followed by a `pop_failure_jump', because
+ we don't want the failure point for the alternative to be
+ popped. For example, matching `(a|ab)*' against `aab'
+ requires that we match the `ab' alternative. */
+ case push_dummy_failure:
+ DEBUG_PRINT1 ("EXECUTING push_dummy_failure.\n");
+ /* See comments just above at `dummy_failure_jump' about the
+ two zeroes. */
+ PUSH_FAILURE_POINT ((unsigned char *) 0, (char *) 0, -2);
+ break;
+
+ /* Have to succeed matching what follows at least n times.
+ After that, handle like `on_failure_jump'. */
+ case succeed_n:
+ EXTRACT_NUMBER (mcnt, p + 2);
+ DEBUG_PRINT2 ("EXECUTING succeed_n %d.\n", mcnt);
+
+ assert (mcnt >= 0);
+ /* Originally, this is how many times we HAVE to succeed. */
+ if (mcnt > 0)
+ {
+ mcnt--;
+ p += 2;
+ STORE_NUMBER_AND_INCR (p, mcnt);
+ DEBUG_PRINT3 (" Setting 0x%p to %d.\n", p, mcnt);
+ }
+ else if (mcnt == 0)
+ {
+ DEBUG_PRINT2 (" Setting two bytes from 0x%p to no_op.\n", p+2);
+ p[2] = (unsigned char) no_op;
+ p[3] = (unsigned char) no_op;
+ goto on_failure;
+ }
+ break;
+
+ case jump_n:
+ EXTRACT_NUMBER (mcnt, p + 2);
+ DEBUG_PRINT2 ("EXECUTING jump_n %d.\n", mcnt);
+
+ /* Originally, this is how many times we CAN jump. */
+ if (mcnt)
+ {
+ mcnt--;
+ STORE_NUMBER (p + 2, mcnt);
+ goto unconditional_jump;
+ }
+ /* If don't have to jump any more, skip over the rest of command. */
+ else
+ p += 4;
+ break;
+
+ case set_number_at:
+ {
+ DEBUG_PRINT1 ("EXECUTING set_number_at.\n");
+
+ EXTRACT_NUMBER_AND_INCR (mcnt, p);
+ p1 = p + mcnt;
+ EXTRACT_NUMBER_AND_INCR (mcnt, p);
+ DEBUG_PRINT3 (" Setting 0x%p to %d.\n", p1, mcnt);
+ STORE_NUMBER (p1, mcnt);
+ break;
+ }
+
+ case wordbound:
+ DEBUG_PRINT1 ("EXECUTING wordbound.\n");
+ should_succeed = 1;
+ matchwordbound:
+ {
+ /* XEmacs change */
+ int result;
+ if (AT_STRINGS_BEG (d) || AT_STRINGS_END (d))
+ 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);
+ Emchar emch1, emch2;
+
+ DEC_CHARPTR (d_before);
+ emch1 = charptr_emchar (d_before);
+ emch2 = charptr_emchar (d_after);
+ result = (WORDCHAR_P_UNSAFE (emch1) !=
+ WORDCHAR_P_UNSAFE (emch2));
+ }
+ if (result == should_succeed)
+ break;
+ goto fail;
+ }
+
+ case notwordbound:
+ DEBUG_PRINT1 ("EXECUTING notwordbound.\n");
+ should_succeed = 0;
+ goto matchwordbound;
+
+ case wordbeg:
+ DEBUG_PRINT1 ("EXECUTING wordbeg.\n");
+ {
+ /* XEmacs: this originally read:
+
+ if (WORDCHAR_P (d) && (AT_STRINGS_BEG (d) || !WORDCHAR_P (d - 1)))
+ break;
+
+ */
+ 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);
+ DEC_CHARPTR (dtmp);
+ emch = charptr_emchar (dtmp);
+ if (!WORDCHAR_P_UNSAFE (emch))
+ break;
+ goto fail;
+ }
+
+ case wordend:
+ DEBUG_PRINT1 ("EXECUTING wordend.\n");
+ {
+ /* XEmacs: this originally read:
+
+ if (!AT_STRINGS_BEG (d) && WORDCHAR_P (d - 1)
+ && (!WORDCHAR_P (d) || AT_STRINGS_END (d)))
+ break;
+
+ The or condition is incorrect (reversed).
+ */
+ CONST unsigned char *dtmp;
+ Emchar emch;
+ if (AT_STRINGS_BEG (d))
+ goto fail;
+ 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);
+ emch = charptr_emchar (dtmp);
+ if (!WORDCHAR_P_UNSAFE (emch))
+ break;
+ goto fail;
+ }
+
+#ifdef emacs
+ case before_dot:
+ DEBUG_PRINT1 ("EXECUTING before_dot.\n");
+ if (BUF_PTR_BYTE_POS (regex_emacs_buffer, (unsigned char *) d) >=
+ BUF_PT (regex_emacs_buffer))
+ goto fail;
+ break;
+
+ case at_dot:
+ DEBUG_PRINT1 ("EXECUTING at_dot.\n");
+ if (BUF_PTR_BYTE_POS (regex_emacs_buffer, (unsigned char *) d)
+ != BUF_PT (regex_emacs_buffer))
+ goto fail;
+ break;
+
+ case after_dot:
+ DEBUG_PRINT1 ("EXECUTING after_dot.\n");
+ if (BUF_PTR_BYTE_POS (regex_emacs_buffer, (unsigned char *) d)
+ <= BUF_PT (regex_emacs_buffer))
+ goto fail;
+ break;
+#if 0 /* not emacs19 */
+ case at_dot:
+ DEBUG_PRINT1 ("EXECUTING at_dot.\n");
+ if (BUF_PTR_BYTE_POS (regex_emacs_buffer, (unsigned char *) d) + 1
+ != BUF_PT (regex_emacs_buffer))
+ goto fail;
+ break;
+#endif /* not emacs19 */
+
+ case syntaxspec:
+ DEBUG_PRINT2 ("EXECUTING syntaxspec %d.\n", mcnt);
+ mcnt = *p++;
+ goto matchsyntax;
+
+ case wordchar:
+ DEBUG_PRINT1 ("EXECUTING Emacs wordchar.\n");
+ mcnt = (int) Sword;
+ matchsyntax:
+ should_succeed = 1;
+ matchornotsyntax:
+ {
+ int matches;
+ Emchar emch;
+
+ PREFETCH ();
+ emch = charptr_emchar ((CONST Bufbyte *) d);
+ matches = (SYNTAX_UNSAFE
+ (XCHAR_TABLE (regex_emacs_buffer->mirror_syntax_table),
+ emch) == (enum syntaxcode) mcnt);
+ INC_CHARPTR (d);
+ if (matches != should_succeed)
+ goto fail;
+ SET_REGS_MATCHED ();
+ }
+ break;
+
+ case notsyntaxspec:
+ DEBUG_PRINT2 ("EXECUTING notsyntaxspec %d.\n", mcnt);
+ mcnt = *p++;
+ goto matchnotsyntax;
+
+ case notwordchar:
+ DEBUG_PRINT1 ("EXECUTING Emacs notwordchar.\n");
+ mcnt = (int) Sword;
+ matchnotsyntax:
+ should_succeed = 0;
+ goto matchornotsyntax;
+
+#ifdef MULE
+/* 97/2/17 jhod Mule category code patch */
+ case categoryspec:
+ should_succeed = 1;
+ matchornotcategory:
+ {
+ Emchar emch;
+
+ mcnt = *p++;
+ PREFETCH ();
+ emch = charptr_emchar ((CONST Bufbyte *) d);
+ INC_CHARPTR (d);
+ if (check_category_char(emch, regex_emacs_buffer->category_table,
+ mcnt, should_succeed))
+ goto fail;
+ SET_REGS_MATCHED ();
+ }
+ break;
+
+ case notcategoryspec:
+ should_succeed = 0;
+ goto matchornotcategory;
+/* end of category patch */
+#endif /* MULE */
+#else /* not emacs */
+ case wordchar:
+ DEBUG_PRINT1 ("EXECUTING non-Emacs wordchar.\n");
+ PREFETCH ();
+ if (!WORDCHAR_P_UNSAFE ((int) (*d)))
+ goto fail;
+ SET_REGS_MATCHED ();
+ d++;
+ break;
+
+ case notwordchar:
+ DEBUG_PRINT1 ("EXECUTING non-Emacs notwordchar.\n");
+ PREFETCH ();
+ if (!WORDCHAR_P_UNSAFE ((int) (*d)))
+ goto fail;
+ SET_REGS_MATCHED ();
+ d++;
+ break;
+#endif /* not emacs */
+
+ default:
+ abort ();
+ }
+ continue; /* Successfully executed one pattern command; keep going. */
+
+
+ /* We goto here if a matching operation fails. */
+ fail:
+ if (!FAIL_STACK_EMPTY ())
+ { /* A restart point is known. Restore to that state. */
+ DEBUG_PRINT1 ("\nFAIL:\n");
+ POP_FAILURE_POINT (d, p,
+ lowest_active_reg, highest_active_reg,
+ regstart, regend, reg_info);
+
+ /* If this failure point is a dummy, try the next one. */
+ if (!p)
+ goto fail;
+
+ /* If we failed to the end of the pattern, don't examine *p. */
+ assert (p <= pend);
+ if (p < pend)
+ {
+ boolean is_a_jump_n = false;
+
+ /* If failed to a backwards jump that's part of a repetition
+ loop, need to pop this failure point and use the next one. */
+ switch ((re_opcode_t) *p)
+ {
+ case jump_n:
+ is_a_jump_n = true;
+ case maybe_pop_jump:
+ case pop_failure_jump:
+ case jump:
+ p1 = p + 1;
+ EXTRACT_NUMBER_AND_INCR (mcnt, p1);
+ p1 += mcnt;
+
+ if ((is_a_jump_n && (re_opcode_t) *p1 == succeed_n)
+ || (!is_a_jump_n
+ && (re_opcode_t) *p1 == on_failure_jump))
+ goto fail;
+ break;
+ default:
+ /* do nothing */ ;
+ }
+ }
+
+ if (d >= string1 && d <= end1)
+ dend = end_match_1;
+ }
+ else
+ break; /* Matching at this starting point really fails. */
+ } /* for (;;) */
+
+ if (best_regs_set)
+ goto restore_best_regs;
+
+ FREE_VARIABLES ();
+
+ return -1; /* Failure to match. */
+} /* re_match_2 */
+\f
+/* Subroutine definitions for re_match_2. */
+
+
+/* We are passed P pointing to a register number after a start_memory.
+
+ Return true if the pattern up to the corresponding stop_memory can
+ match the empty string, and false otherwise.
+
+ If we find the matching stop_memory, sets P to point to one past its number.
+ Otherwise, sets P to an undefined byte less than or equal to END.
+
+ We don't handle duplicates properly (yet). */
+
+static boolean
+group_match_null_string_p (unsigned char **p, unsigned char *end,
+ register_info_type *reg_info)
+{
+ int mcnt;
+ /* Point to after the args to the start_memory. */
+ unsigned char *p1 = *p + 2;
+
+ while (p1 < end)
+ {
+ /* Skip over opcodes that can match nothing, and return true or
+ false, as appropriate, when we get to one that can't, or to the
+ matching stop_memory. */
+
+ switch ((re_opcode_t) *p1)
+ {
+ /* Could be either a loop or a series of alternatives. */
+ case on_failure_jump:
+ p1++;
+ EXTRACT_NUMBER_AND_INCR (mcnt, p1);
+
+ /* If the next operation is not a jump backwards in the
+ pattern. */
+
+ if (mcnt >= 0)
+ {
+ /* Go through the on_failure_jumps of the alternatives,
+ seeing if any of the alternatives cannot match nothing.
+ The last alternative starts with only a jump,
+ whereas the rest start with on_failure_jump and end
+ with a jump, e.g., here is the pattern for `a|b|c':
+
+ /on_failure_jump/0/6/exactn/1/a/jump_past_alt/0/6
+ /on_failure_jump/0/6/exactn/1/b/jump_past_alt/0/3
+ /exactn/1/c
+
+ So, we have to first go through the first (n-1)
+ alternatives and then deal with the last one separately. */
+
+
+ /* Deal with the first (n-1) alternatives, which start
+ with an on_failure_jump (see above) that jumps to right
+ past a jump_past_alt. */
+
+ while ((re_opcode_t) p1[mcnt-3] == jump_past_alt)
+ {
+ /* `mcnt' holds how many bytes long the alternative
+ is, including the ending `jump_past_alt' and
+ its number. */
+
+ if (!alt_match_null_string_p (p1, p1 + mcnt - 3,
+ reg_info))
+ return false;
+
+ /* Move to right after this alternative, including the
+ jump_past_alt. */
+ p1 += mcnt;
+
+ /* Break if it's the beginning of an n-th alternative
+ that doesn't begin with an on_failure_jump. */
+ if ((re_opcode_t) *p1 != on_failure_jump)
+ break;
+
+ /* Still have to check that it's not an n-th
+ alternative that starts with an on_failure_jump. */
+ p1++;
+ EXTRACT_NUMBER_AND_INCR (mcnt, p1);
+ if ((re_opcode_t) p1[mcnt-3] != jump_past_alt)
+ {
+ /* Get to the beginning of the n-th alternative. */
+ p1 -= 3;
+ break;
+ }
+ }
+
+ /* Deal with the last alternative: go back and get number
+ of the `jump_past_alt' just before it. `mcnt' contains
+ the length of the alternative. */
+ EXTRACT_NUMBER (mcnt, p1 - 2);
+
+ if (!alt_match_null_string_p (p1, p1 + mcnt, reg_info))
+ return false;
+
+ p1 += mcnt; /* Get past the n-th alternative. */
+ } /* if mcnt > 0 */
+ break;
+
+
+ case stop_memory:
+ assert (p1[1] == **p);
+ *p = p1 + 2;
+ return true;
+
+
+ default:
+ if (!common_op_match_null_string_p (&p1, end, reg_info))
+ return false;
+ }
+ } /* while p1 < end */
+
+ return false;
+} /* group_match_null_string_p */
+
+
+/* Similar to group_match_null_string_p, but doesn't deal with alternatives:
+ It expects P to be the first byte of a single alternative and END one
+ byte past the last. The alternative can contain groups. */
+
+static boolean
+alt_match_null_string_p (unsigned char *p, unsigned char *end,
+ register_info_type *reg_info)
+{
+ int mcnt;
+ unsigned char *p1 = p;
+
+ while (p1 < end)
+ {
+ /* Skip over opcodes that can match nothing, and break when we get
+ to one that can't. */
+
+ switch ((re_opcode_t) *p1)
+ {
+ /* It's a loop. */
+ case on_failure_jump:
+ p1++;
+ EXTRACT_NUMBER_AND_INCR (mcnt, p1);
+ p1 += mcnt;
+ break;
+
+ default:
+ if (!common_op_match_null_string_p (&p1, end, reg_info))
+ return false;
+ }
+ } /* while p1 < end */
+
+ return true;
+} /* alt_match_null_string_p */
+
+
+/* Deals with the ops common to group_match_null_string_p and
+ alt_match_null_string_p.
+
+ Sets P to one after the op and its arguments, if any. */
+
+static boolean
+common_op_match_null_string_p (unsigned char **p, unsigned char *end,
+ register_info_type *reg_info)
+{
+ int mcnt;
+ boolean ret;
+ int reg_no;
+ unsigned char *p1 = *p;
+
+ switch ((re_opcode_t) *p1++)
+ {
+ case no_op:
+ case begline:
+ case endline:
+ case begbuf:
+ case endbuf:
+ case wordbeg:
+ case wordend:
+ case wordbound:
+ case notwordbound:
+#ifdef emacs
+ case before_dot:
+ case at_dot:
+ case after_dot:
+#endif
+ break;
+
+ case start_memory:
+ reg_no = *p1;
+ assert (reg_no > 0 && reg_no <= MAX_REGNUM);
+ ret = group_match_null_string_p (&p1, end, reg_info);
+
+ /* Have to set this here in case we're checking a group which
+ contains a group and a back reference to it. */
+
+ if (REG_MATCH_NULL_STRING_P (reg_info[reg_no]) == MATCH_NULL_UNSET_VALUE)
+ REG_MATCH_NULL_STRING_P (reg_info[reg_no]) = ret;
+
+ if (!ret)
+ return false;
+ break;
+
+ /* If this is an optimized succeed_n for zero times, make the jump. */
+ case jump:
+ EXTRACT_NUMBER_AND_INCR (mcnt, p1);
+ if (mcnt >= 0)
+ p1 += mcnt;
+ else
+ return false;
+ break;
+
+ case succeed_n:
+ /* Get to the number of times to succeed. */
+ p1 += 2;
+ EXTRACT_NUMBER_AND_INCR (mcnt, p1);
+
+ if (mcnt == 0)
+ {
+ p1 -= 4;
+ EXTRACT_NUMBER_AND_INCR (mcnt, p1);
+ p1 += mcnt;
+ }
+ else
+ return false;
+ break;
+
+ case duplicate:
+ if (!REG_MATCH_NULL_STRING_P (reg_info[*p1]))
+ return false;
+ break;
+
+ case set_number_at:
+ p1 += 4;
+
+ default:
+ /* All other opcodes mean we cannot match the empty string. */
+ return false;
+ }
+
+ *p = p1;
+ return true;
+} /* common_op_match_null_string_p */
+
+
+/* Return zero if TRANSLATE[S1] and TRANSLATE[S2] are identical for LEN
+ bytes; nonzero otherwise. */
+
+static int
+bcmp_translate (CONST unsigned char *s1, CONST unsigned char *s2,
+ REGISTER int len, char *translate)
+{
+ REGISTER CONST unsigned char *p1 = s1, *p2 = s2;
+ while (len)
+ {
+ if (translate[*p1++] != translate[*p2++]) return 1;
+ len--;
+ }
+ return 0;
+}
+\f
+/* Entry points for GNU code. */
+
+/* re_compile_pattern is the GNU regular expression compiler: it
+ compiles PATTERN (of length SIZE) and puts the result in BUFP.
+ Returns 0 if the pattern was valid, otherwise an error string.
+
+ Assumes the `allocated' (and perhaps `buffer') and `translate' fields
+ are set in BUFP on entry.
+
+ We call regex_compile to do the actual compilation. */
+
+CONST char *
+re_compile_pattern (CONST char *pattern, int length,
+ struct re_pattern_buffer *bufp)
+{
+ reg_errcode_t ret;
+
+ /* GNU code is written to assume at least RE_NREGS registers will be set
+ (and at least one extra will be -1). */
+ bufp->regs_allocated = REGS_UNALLOCATED;
+
+ /* And GNU code determines whether or not to get register information
+ by passing null for the REGS argument to re_match, etc., not by
+ setting no_sub. */
+ bufp->no_sub = 0;
+
+ /* Match anchors at newline. */
+ bufp->newline_anchor = 1;
+
+ ret = regex_compile (pattern, length, re_syntax_options, bufp);
+
+ if (!ret)
+ return NULL;
+ return gettext (re_error_msgid[(int) ret]);
+}
+\f
+/* Entry points compatible with 4.2 BSD regex library. We don't define
+ them unless specifically requested. */
+
+#ifdef _REGEX_RE_COMP
+
+/* BSD has one and only one pattern buffer. */
+static struct re_pattern_buffer re_comp_buf;
+
+char *
+re_comp (CONST char *s)
+{
+ reg_errcode_t ret;
+
+ if (!s)
+ {
+ if (!re_comp_buf.buffer)
+ return gettext ("No previous regular expression");
+ return 0;
+ }
+
+ if (!re_comp_buf.buffer)
+ {
+ re_comp_buf.buffer = (unsigned char *) malloc (200);
+ if (re_comp_buf.buffer == NULL)
+ return gettext (re_error_msgid[(int) REG_ESPACE]);
+ re_comp_buf.allocated = 200;
+
+ re_comp_buf.fastmap = (char *) malloc (1 << BYTEWIDTH);
+ if (re_comp_buf.fastmap == NULL)
+ return gettext (re_error_msgid[(int) REG_ESPACE]);
+ }
+
+ /* Since `re_exec' always passes NULL for the `regs' argument, we
+ don't need to initialize the pattern buffer fields which affect it. */
+
+ /* Match anchors at newlines. */
+ re_comp_buf.newline_anchor = 1;
+
+ ret = regex_compile (s, strlen (s), re_syntax_options, &re_comp_buf);
+
+ if (!ret)
+ return NULL;
+
+ /* Yes, we're discarding `CONST' here if !HAVE_LIBINTL. */
+ return (char *) gettext (re_error_msgid[(int) ret]);
+}
+
+
+int
+re_exec (CONST char *s)
+{
+ CONST int len = strlen (s);
+ return
+ 0 <= re_search (&re_comp_buf, s, len, 0, len, (struct re_registers *) 0);
+}
+#endif /* _REGEX_RE_COMP */
+\f
+/* POSIX.2 functions. Don't define these for Emacs. */
+
+#ifndef emacs
+
+/* regcomp takes a regular expression as a string and compiles it.
+
+ PREG is a regex_t *. We do not expect any fields to be initialized,
+ since POSIX says we shouldn't. Thus, we set
+
+ `buffer' to the compiled pattern;
+ `used' to the length of the compiled pattern;
+ `syntax' to RE_SYNTAX_POSIX_EXTENDED if the
+ REG_EXTENDED bit in CFLAGS is set; otherwise, to
+ RE_SYNTAX_POSIX_BASIC;
+ `newline_anchor' to REG_NEWLINE being set in CFLAGS;
+ `fastmap' and `fastmap_accurate' to zero;
+ `re_nsub' to the number of subexpressions in PATTERN.
+
+ PATTERN is the address of the pattern string.
+
+ CFLAGS is a series of bits which affect compilation.
+
+ If REG_EXTENDED is set, we use POSIX extended syntax; otherwise, we
+ use POSIX basic syntax.
+
+ If REG_NEWLINE is set, then . and [^...] don't match newline.
+ Also, regexec will try a match beginning after every newline.
+
+ If REG_ICASE is set, then we considers upper- and lowercase
+ versions of letters to be equivalent when matching.
+
+ If REG_NOSUB is set, then when PREG is passed to regexec, that
+ routine will report only success or failure, and nothing about the
+ registers.
+
+ It returns 0 if it succeeds, nonzero if it doesn't. (See regex.h for
+ the return codes and their meanings.) */
+
+int
+regcomp (regex_t *preg, CONST char *pattern, int cflags)
+{
+ reg_errcode_t ret;
+ unsigned syntax
+ = (cflags & REG_EXTENDED) ?
+ RE_SYNTAX_POSIX_EXTENDED : RE_SYNTAX_POSIX_BASIC;
+
+ /* regex_compile will allocate the space for the compiled pattern. */
+ preg->buffer = 0;
+ preg->allocated = 0;
+ preg->used = 0;
+
+ /* Don't bother to use a fastmap when searching. This simplifies the
+ REG_NEWLINE case: if we used a fastmap, we'd have to put all the
+ characters after newlines into the fastmap. This way, we just try
+ every character. */
+ preg->fastmap = 0;
+
+ if (cflags & REG_ICASE)
+ {
+ unsigned i;
+
+ preg->translate = (char *) malloc (CHAR_SET_SIZE);
+ if (preg->translate == NULL)
+ return (int) REG_ESPACE;
+
+ /* Map uppercase characters to corresponding lowercase ones. */
+ for (i = 0; i < CHAR_SET_SIZE; i++)
+ preg->translate[i] = ISUPPER (i) ? tolower (i) : i;
+ }
+ else
+ preg->translate = NULL;
+
+ /* If REG_NEWLINE is set, newlines are treated differently. */
+ if (cflags & REG_NEWLINE)
+ { /* REG_NEWLINE implies neither . nor [^...] match newline. */
+ syntax &= ~RE_DOT_NEWLINE;
+ syntax |= RE_HAT_LISTS_NOT_NEWLINE;
+ /* It also changes the matching behavior. */
+ preg->newline_anchor = 1;
+ }
+ else
+ preg->newline_anchor = 0;
+
+ preg->no_sub = !!(cflags & REG_NOSUB);
+
+ /* POSIX says a null character in the pattern terminates it, so we
+ can use strlen here in compiling the pattern. */
+ ret = regex_compile (pattern, strlen (pattern), syntax, preg);
+
+ /* POSIX doesn't distinguish between an unmatched open-group and an
+ unmatched close-group: both are REG_EPAREN. */
+ if (ret == REG_ERPAREN) ret = REG_EPAREN;
+
+ return (int) ret;
+}
+
+
+/* regexec searches for a given pattern, specified by PREG, in the
+ string STRING.
+
+ If NMATCH is zero or REG_NOSUB was set in the cflags argument to
+ `regcomp', we ignore PMATCH. Otherwise, we assume PMATCH has at
+ least NMATCH elements, and we set them to the offsets of the
+ corresponding matched substrings.
+
+ EFLAGS specifies `execution flags' which affect matching: if
+ REG_NOTBOL is set, then ^ does not match at the beginning of the
+ string; if REG_NOTEOL is set, then $ does not match at the end.
+
+ 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,
+ regmatch_t pmatch[], int eflags)
+{
+ int ret;
+ struct re_registers regs;
+ regex_t private_preg;
+ int len = strlen (string);
+ boolean want_reg_info = !preg->no_sub && nmatch > 0;
+
+ private_preg = *preg;
+
+ private_preg.not_bol = !!(eflags & REG_NOTBOL);
+ private_preg.not_eol = !!(eflags & REG_NOTEOL);
+
+ /* The user has told us exactly how many registers to return
+ information about, via `nmatch'. We have to pass that on to the
+ matching routines. */
+ private_preg.regs_allocated = REGS_FIXED;
+
+ if (want_reg_info)
+ {
+ regs.num_regs = nmatch;
+ regs.start = TALLOC (nmatch, regoff_t);
+ regs.end = TALLOC (nmatch, regoff_t);
+ if (regs.start == NULL || regs.end == NULL)
+ return (int) REG_NOMATCH;
+ }
+
+ /* Perform the searching operation. */
+ ret = re_search (&private_preg, string, len,
+ /* start: */ 0, /* range: */ len,
+ want_reg_info ? ®s : (struct re_registers *) 0);
+
+ /* Copy the register information to the POSIX structure. */
+ if (want_reg_info)
+ {
+ if (ret >= 0)
+ {
+ unsigned r;
+
+ for (r = 0; r < nmatch; r++)
+ {
+ pmatch[r].rm_so = regs.start[r];
+ pmatch[r].rm_eo = regs.end[r];
+ }
+ }
+
+ /* If we needed the temporary register info, free the space now. */
+ free (regs.start);
+ free (regs.end);
+ }
+
+ /* We want zero return to mean success, unlike `re_search'. */
+ return ret >= 0 ? (int) REG_NOERROR : (int) REG_NOMATCH;
+}
+
+
+/* Returns a message corresponding to an error code, ERRCODE, returned
+ 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)
+{
+ CONST char *msg;
+ size_t msg_size;
+
+ if (errcode < 0
+ || errcode >= (sizeof (re_error_msgid) / sizeof (re_error_msgid[0])))
+ /* Only error codes returned by the rest of the code should be passed
+ to this routine. If we are given anything else, or if other regex
+ code generates an invalid error code, then the program has a bug.
+ Dump core so we can fix it. */
+ abort ();
+
+ msg = gettext (re_error_msgid[errcode]);
+
+ msg_size = strlen (msg) + 1; /* Includes the null. */
+
+ if (errbuf_size != 0)
+ {
+ if (msg_size > errbuf_size)
+ {
+ strncpy (errbuf, msg, errbuf_size - 1);
+ errbuf[errbuf_size - 1] = 0;
+ }
+ else
+ strcpy (errbuf, msg);
+ }
+
+ return msg_size;
+}
+
+
+/* Free dynamically allocated space used by PREG. */
+
+void
+regfree (regex_t *preg)
+{
+ if (preg->buffer != NULL)
+ free (preg->buffer);
+ preg->buffer = NULL;
+
+ preg->allocated = 0;
+ preg->used = 0;
+
+ if (preg->fastmap != NULL)
+ free (preg->fastmap);
+ preg->fastmap = NULL;
+ preg->fastmap_accurate = 0;
+
+ if (preg->translate != NULL)
+ free (preg->translate);
+ preg->translate = NULL;
+}
+
+#endif /* not emacs */
+\f
+/*
+Local variables:
+make-backup-files: t
+version-control: t
+trim-versions-without-asking: nil
+End:
+*/
--- /dev/null
+/* String search routines for XEmacs.
+ Copyright (C) 1985, 1986, 1987, 1992-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: FSF 19.29, except for region-cache stuff. */
+
+/* Hacked on for Mule by Ben Wing, December 1994 and August 1995. */
+
+/* This file has been Mule-ized except for the TRT stuff. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "commands.h"
+#include "insdel.h"
+#include "opaque.h"
+#ifdef REGION_CACHE_NEEDS_WORK
+#include "region-cache.h"
+#endif
+#include "syntax.h"
+
+#include <sys/types.h>
+#include "regex.h"
+
+\f
+#define REGEXP_CACHE_SIZE 20
+
+/* If the regexp is non-nil, then the buffer contains the compiled form
+ of that regexp, suitable for searching. */
+struct regexp_cache {
+ struct regexp_cache *next;
+ Lisp_Object regexp;
+ struct re_pattern_buffer buf;
+ char fastmap[0400];
+ /* Nonzero means regexp was compiled to do full POSIX backtracking. */
+ char posix;
+};
+
+/* The instances of that struct. */
+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;
+
+
+/* Every call to re_match, etc., must pass &search_regs as the regs
+ argument unless you can show it is unnecessary (i.e., if re_match
+ is certainly going to be called again before region-around-match
+ can be called).
+
+ Since the registers are now dynamically allocated, we need to make
+ sure not to refer to the Nth register before checking that it has
+ been allocated by checking search_regs.num_regs.
+
+ The regex code keeps track of whether it has allocated the search
+ buffer using bits in the re_pattern_buffer. This means that whenever
+ you compile a new pattern, it completely forgets whether it has
+ allocated any registers, and will allocate new registers the next
+ time you call a searching or matching function. Therefore, we need
+ to call re_set_registers after compiling a new pattern or after
+ setting the match registers, so that the regex functions will be
+ able to free or re-allocate it properly. */
+
+/* Note: things get trickier under Mule because the values returned from
+ the regexp routines are in Bytinds but we need them to be in Bufpos's.
+ We take the easy way out for the moment and just convert them immediately.
+ We could be more clever by not converting them until necessary, but
+ that gets real ugly real fast since the buffer might have changed and
+ the positions might be out of sync or out of range.
+ */
+static struct re_registers search_regs;
+
+/* The buffer in which the last search was performed, or
+ Qt if the last search was done in a string;
+ Qnil if no searching has been done yet. */
+static Lisp_Object last_thing_searched;
+
+/* error condition signalled when regexp compile_pattern fails */
+
+Lisp_Object Qinvalid_regexp;
+
+/* Regular expressions used in forward/backward-word */
+Lisp_Object Vforward_word_regexp, Vbackward_word_regexp;
+
+/* range table for use with skip_chars. Only needed for Mule. */
+Lisp_Object Vskip_chars_range_table;
+
+static void set_search_regs (struct buffer *buf, Bufpos beg, Charcount len);
+static void save_search_regs (void);
+static Bufpos search_buffer (struct buffer *buf, Lisp_Object str,
+ Bufpos bufpos, Bufpos buflim, EMACS_INT n, int RE,
+ unsigned char *trt, unsigned char *inverse_trt,
+ int posix);
+
+static void
+matcher_overflow (void)
+{
+ error ("Stack overflow in regexp matcher");
+}
+
+/* Compile a regexp and signal a Lisp error if anything goes wrong.
+ PATTERN is the pattern to compile.
+ CP is the place to put the result.
+ TRANSLATE is a translation table for ignoring case, or NULL for none.
+ REGP is the structure that says where to store the "register"
+ values that will result from matching this pattern.
+ If it is 0, we should compile the pattern not to record any
+ subexpression bounds.
+ POSIX is nonzero if we want full backtracking (POSIX style)
+ for this pattern. 0 means backtrack only enough to get a valid match. */
+
+static int
+compile_pattern_1 (struct regexp_cache *cp, Lisp_Object pattern,
+ char *translate, struct re_registers *regp, int posix,
+ Error_behavior errb)
+{
+ CONST char *val;
+ reg_syntax_t old;
+
+ cp->regexp = Qnil;
+ cp->buf.translate = translate;
+ cp->posix = posix;
+ old = re_set_syntax (RE_SYNTAX_EMACS
+ | (posix ? 0 : RE_NO_POSIX_BACKTRACKING));
+ val = (CONST char *)
+ re_compile_pattern ((char *) XSTRING_DATA (pattern),
+ XSTRING_LENGTH (pattern), &cp->buf);
+ re_set_syntax (old);
+ if (val)
+ {
+ maybe_signal_error (Qinvalid_regexp, list1 (build_string (val)),
+ Qsearch, errb);
+ return 0;
+ }
+
+ cp->regexp = Fcopy_sequence (pattern);
+ return 1;
+}
+
+/* Compile a regexp if necessary, but first check to see if there's one in
+ the cache.
+ PATTERN is the pattern to compile.
+ TRANSLATE is a translation table for ignoring case, or NULL for none.
+ REGP is the structure that says where to store the "register"
+ values that will result from matching this pattern.
+ If it is 0, we should compile the pattern not to record any
+ subexpression bounds.
+ POSIX is nonzero if we want full backtracking (POSIX style)
+ for this pattern. 0 means backtrack only enough to get a valid match. */
+
+struct re_pattern_buffer *
+compile_pattern (Lisp_Object pattern, struct re_registers *regp,
+ char *translate, int posix, Error_behavior errb)
+{
+ struct regexp_cache *cp, **cpp;
+
+ for (cpp = &searchbuf_head; ; cpp = &cp->next)
+ {
+ cp = *cpp;
+ if (!NILP (Fstring_equal (cp->regexp, pattern))
+ && cp->buf.translate == translate
+ && cp->posix == posix)
+ break;
+
+ /* If we're at the end of the cache, compile into the last cell. */
+ if (cp->next == 0)
+ {
+ if (!compile_pattern_1 (cp, pattern, translate, regp, posix,
+ errb))
+ return 0;
+ break;
+ }
+ }
+
+ /* When we get here, cp (aka *cpp) contains the compiled pattern,
+ either because we found it in the cache or because we just compiled it.
+ Move it to the front of the queue to mark it as most recently used. */
+ *cpp = cp->next;
+ cp->next = searchbuf_head;
+ searchbuf_head = cp;
+
+ /* Advise the searching functions about the space we have allocated
+ for register data. */
+ if (regp)
+ re_set_registers (&cp->buf, regp, regp->num_regs, regp->start, regp->end);
+
+ return &cp->buf;
+}
+
+/* Error condition used for failing searches */
+Lisp_Object Qsearch_failed;
+
+static Lisp_Object
+signal_failure (Lisp_Object arg)
+{
+ Fsignal (Qsearch_failed, list1 (arg));
+ return Qnil;
+}
+
+/* Convert the search registers from Bytinds to Bufpos's. Needs to be
+ done after each regexp match that uses the search regs.
+
+ We could get a potential speedup by not converting the search registers
+ until it's really necessary, e.g. when match-data or replace-match is
+ called. However, this complexifies the code a lot (e.g. the buffer
+ could have changed and the Bytinds stored might be invalid) and is
+ probably not a great time-saver. */
+
+static void
+fixup_search_regs_for_buffer (struct buffer *buf)
+{
+ int i;
+ int num_regs = search_regs.num_regs;
+
+ for (i = 0; i < num_regs; i++)
+ {
+ if (search_regs.start[i] >= 0)
+ search_regs.start[i] = bytind_to_bufpos (buf, search_regs.start[i]);
+ if (search_regs.end[i] >= 0)
+ search_regs.end[i] = bytind_to_bufpos (buf, search_regs.end[i]);
+ }
+}
+
+/* Similar but for strings. */
+static void
+fixup_search_regs_for_string (Lisp_Object string)
+{
+ int i;
+ int num_regs = search_regs.num_regs;
+
+ /* #### bytecount_to_charcount() is not that efficient. This function
+ could be faster if it did its own conversion (using INC_CHARPTR()
+ and such), because the register ends are likely to be somewhat ordered.
+ (Even if not, you could sort them.)
+
+ Think about this if this function is a time hog, which it's probably
+ not. */
+ for (i = 0; i < num_regs; i++)
+ {
+ if (search_regs.start[i] > 0)
+ {
+ search_regs.start[i] =
+ bytecount_to_charcount (XSTRING_DATA (string),
+ search_regs.start[i]);
+ }
+ if (search_regs.end[i] > 0)
+ {
+ search_regs.end[i] =
+ bytecount_to_charcount (XSTRING_DATA (string),
+ search_regs.end[i]);
+ }
+ }
+}
+
+\f
+static Lisp_Object
+looking_at_1 (Lisp_Object string, struct buffer *buf, int posix)
+{
+ /* This function has been Mule-ized, except for the trt table handling. */
+ Lisp_Object val;
+ Bytind p1, p2;
+ Bytecount s1, s2;
+ REGISTER int i;
+ struct re_pattern_buffer *bufp;
+
+ if (running_asynch_code)
+ save_search_regs ();
+
+ CHECK_STRING (string);
+ bufp = compile_pattern (string, &search_regs,
+ (!NILP (buf->case_fold_search)
+ ? (char *) MIRROR_DOWNCASE_TABLE_AS_STRING (buf)
+ : 0),
+ posix, ERROR_ME);
+
+ QUIT;
+
+ /* Get pointers and sizes of the two strings
+ that make up the visible portion of the buffer. */
+
+ p1 = BI_BUF_BEGV (buf);
+ p2 = BI_BUF_CEILING_OF (buf, p1);
+ s1 = p2 - p1;
+ s2 = BI_BUF_ZV (buf) - p2;
+
+ regex_emacs_buffer = buf;
+ i = re_match_2 (bufp, (char *) BI_BUF_BYTE_ADDRESS (buf, p1),
+ s1, (char *) BI_BUF_BYTE_ADDRESS (buf, p2), s2,
+ BI_BUF_PT (buf) - BI_BUF_BEGV (buf), &search_regs,
+ BI_BUF_ZV (buf) - BI_BUF_BEGV (buf));
+
+ if (i == -2)
+ matcher_overflow ();
+
+ val = (0 <= i ? Qt : Qnil);
+ if (NILP (val))
+ return Qnil;
+ {
+ int num_regs = search_regs.num_regs;
+ for (i = 0; i < num_regs; i++)
+ if (search_regs.start[i] >= 0)
+ {
+ search_regs.start[i] += BI_BUF_BEGV (buf);
+ search_regs.end[i] += BI_BUF_BEGV (buf);
+ }
+ }
+ XSETBUFFER (last_thing_searched, buf);
+ fixup_search_regs_for_buffer (buf);
+ return val;
+}
+
+DEFUN ("looking-at", Flooking_at, 1, 2, 0, /*
+Return t if text after point matches regular expression REGEXP.
+This function modifies the match data that `match-beginning',
+`match-end' and `match-data' access; save and restore the match
+data if you want to preserve them.
+
+Optional argument BUFFER defaults to the current buffer.
+*/
+ (regexp, buffer))
+{
+ return looking_at_1 (regexp, decode_buffer (buffer, 0), 0);
+}
+
+DEFUN ("posix-looking-at", Fposix_looking_at, 1, 2, 0, /*
+Return t if text after point matches regular expression REGEXP.
+Find the longest match, in accord with Posix regular expression rules.
+This function modifies the match data that `match-beginning',
+`match-end' and `match-data' access; save and restore the match
+data if you want to preserve them.
+
+Optional argument BUFFER defaults to the current buffer.
+*/
+ (regexp, buffer))
+{
+ return looking_at_1 (regexp, decode_buffer (buffer, 0), 1);
+}
+\f
+static Lisp_Object
+string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start,
+ struct buffer *buf, int posix)
+{
+ /* This function has been Mule-ized, except for the trt table handling. */
+ Bytecount val;
+ Charcount s;
+ struct re_pattern_buffer *bufp;
+
+ if (running_asynch_code)
+ save_search_regs ();
+
+ CHECK_STRING (regexp);
+ CHECK_STRING (string);
+
+ if (NILP (start))
+ s = 0;
+ else
+ {
+ Charcount len = XSTRING_CHAR_LENGTH (string);
+
+ CHECK_INT (start);
+ s = XINT (start);
+ if (s < 0 && -s <= len)
+ s = len + s;
+ else if (0 > s || s > len)
+ args_out_of_range (string, start);
+ }
+
+
+ bufp = compile_pattern (regexp, &search_regs,
+ (!NILP (buf->case_fold_search)
+ ? (char *) MIRROR_DOWNCASE_TABLE_AS_STRING (buf)
+ : 0), 0, ERROR_ME);
+ QUIT;
+ {
+ Bytecount bis = charcount_to_bytecount (XSTRING_DATA (string), s);
+ regex_emacs_buffer = buf;
+ val = re_search (bufp, (char *) XSTRING_DATA (string),
+ XSTRING_LENGTH (string), bis,
+ XSTRING_LENGTH (string) - bis,
+ &search_regs);
+ }
+ if (val == -2)
+ matcher_overflow ();
+ if (val < 0) return Qnil;
+ last_thing_searched = Qt;
+ fixup_search_regs_for_string (string);
+ return make_int (bytecount_to_charcount (XSTRING_DATA (string), val));
+}
+
+DEFUN ("string-match", Fstring_match, 2, 4, 0, /*
+Return index of start of first match for REGEXP in STRING, or nil.
+If third arg START is non-nil, start search at that index in STRING.
+For index of first char beyond the match, do (match-end 0).
+`match-end' and `match-beginning' also give indices of substrings
+matched by parenthesis constructs in the pattern.
+
+Optional arg BUFFER controls how case folding is done (according to
+the value of `case-fold-search' in that buffer and that buffer's case
+tables) and defaults to the current buffer.
+*/
+ (regexp, string, start, buffer))
+{
+ return string_match_1 (regexp, string, start, decode_buffer (buffer, 0), 0);
+}
+
+DEFUN ("posix-string-match", Fposix_string_match, 2, 4, 0, /*
+Return index of start of first match for REGEXP in STRING, or nil.
+Find the longest match, in accord with Posix regular expression rules.
+If third arg START is non-nil, start search at that index in STRING.
+For index of first char beyond the match, do (match-end 0).
+`match-end' and `match-beginning' also give indices of substrings
+matched by parenthesis constructs in the pattern.
+
+Optional arg BUFFER controls how case folding is done (according to
+the value of `case-fold-search' in that buffer and that buffer's case
+tables) and defaults to the current buffer.
+*/
+ (regexp, string, start, buffer))
+{
+ return string_match_1 (regexp, string, start, decode_buffer (buffer, 0), 1);
+}
+
+/* Match REGEXP against STRING, searching all of STRING,
+ and return the index of the match, or negative on failure.
+ This does not clobber the match data. */
+
+Bytecount
+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)
+{
+ /* This function has been Mule-ized, except for the trt table handling. */
+ Bytecount val;
+ Bufbyte *newnonreloc = (Bufbyte *) nonreloc;
+ struct re_pattern_buffer *bufp;
+
+ bufp = compile_pattern (regexp, 0,
+ (case_fold_search
+ ? (char *)
+ /* #### evil current-buffer dependency */
+ MIRROR_DOWNCASE_TABLE_AS_STRING (current_buffer)
+ : 0),
+ 0, errb);
+ if (!bufp)
+ return -1; /* will only do this when errb != ERROR_ME */
+ if (!no_quit)
+ QUIT;
+ else
+ no_quit_in_re_search = 1;
+
+ fixup_internal_substring (nonreloc, reloc, offset, &length);
+
+ if (!NILP (reloc))
+ {
+ if (no_quit)
+ newnonreloc = XSTRING_DATA (reloc);
+ else
+ {
+ /* QUIT could relocate RELOC. Therefore we must alloca()
+ and copy. No way around this except some serious
+ rewriting of re_search(). */
+ newnonreloc = (Bufbyte *) alloca (length);
+ memcpy (newnonreloc, XSTRING_DATA (reloc), length);
+ }
+ }
+
+ /* #### evil current-buffer dependency */
+ regex_emacs_buffer = current_buffer;
+ val = re_search (bufp, (char *) newnonreloc + offset, length, 0,
+ length, 0);
+
+ no_quit_in_re_search = 0;
+ return val;
+}
+
+Bytecount
+fast_lisp_string_match (Lisp_Object regex, Lisp_Object string)
+{
+ return fast_string_match (regex, 0, string, 0, -1, 0, ERROR_ME, 0);
+}
+
+\f
+#ifdef REGION_CACHE_NEEDS_WORK
+/* The newline cache: remembering which sections of text have no newlines. */
+
+/* If the user has requested newline caching, make sure it's on.
+ Otherwise, make sure it's off.
+ This is our cheezy way of associating an action with the change of
+ state of a buffer-local variable. */
+static void
+newline_cache_on_off (struct buffer *buf)
+{
+ if (NILP (buf->cache_long_line_scans))
+ {
+ /* It should be off. */
+ if (buf->newline_cache)
+ {
+ free_region_cache (buf->newline_cache);
+ buf->newline_cache = 0;
+ }
+ }
+ else
+ {
+ /* It should be on. */
+ if (buf->newline_cache == 0)
+ buf->newline_cache = new_region_cache ();
+ }
+}
+#endif
+\f
+/* Search in BUF for COUNT instances of the character TARGET between
+ START and END.
+
+ If COUNT is positive, search forwards; END must be >= START.
+ If COUNT is negative, search backwards for the -COUNTth instance;
+ END must be <= START.
+ If COUNT is zero, do anything you please; run rogue, for all I care.
+
+ If END is zero, use BEGV or ZV instead, as appropriate for the
+ direction indicated by COUNT.
+
+ If we find COUNT instances, set *SHORTAGE to zero, and return the
+ position after the COUNTth match. Note that for reverse motion
+ this is not the same as the usual convention for Emacs motion commands.
+
+ If we don't find COUNT instances before reaching END, set *SHORTAGE
+ to the number of TARGETs left unfound, and return END.
+
+ If ALLOW_QUIT is non-zero, call QUIT periodically. */
+
+static Bytind
+bi_scan_buffer (struct buffer *buf, Emchar target, Bytind st, Bytind en,
+ EMACS_INT count, EMACS_INT *shortage, int allow_quit)
+{
+ /* This function has been Mule-ized. */
+ Bytind lim = en > 0 ? en :
+ ((count > 0) ? BI_BUF_ZV (buf) : BI_BUF_BEGV (buf));
+
+ /* #### newline cache stuff in this function not yet ported */
+
+ assert (count != 0);
+
+ if (shortage)
+ *shortage = 0;
+
+ if (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 (BI_BUF_FETCH_CHAR (buf, st) == target)
+ count--;
+ INC_BYTIND (buf, st);
+ }
+ }
+ else
+#endif
+ {
+ while (st < lim && count > 0)
+ {
+ Bytind ceil;
+ Bufbyte *bufptr;
+
+ ceil = BI_BUF_CEILING_OF (buf, st);
+ ceil = min (lim, ceil);
+ bufptr = (Bufbyte *) memchr (BI_BUF_BYTE_ADDRESS (buf, st),
+ (int) target, ceil - st);
+ if (bufptr)
+ {
+ count--;
+ st = BI_BUF_PTR_BYTE_POS (buf, bufptr) + 1;
+ }
+ else
+ st = ceil;
+ }
+ }
+
+ if (shortage)
+ *shortage = count;
+ if (allow_quit)
+ QUIT;
+ return st;
+ }
+ else
+ {
+#ifdef MULE
+ if (target >= 0200)
+ {
+ while (st > lim && count < 0)
+ {
+ DEC_BYTIND (buf, st);
+ if (BI_BUF_FETCH_CHAR (buf, st) == target)
+ count++;
+ }
+ }
+ else
+#endif
+ {
+ while (st > lim && count < 0)
+ {
+ Bytind floor;
+ Bufbyte *bufptr;
+ Bufbyte *floorptr;
+
+ floor = BI_BUF_FLOOR_OF (buf, st);
+ floor = max (lim, floor);
+ /* No memrchr() ... */
+ bufptr = BI_BUF_BYTE_ADDRESS_BEFORE (buf, st);
+ floorptr = BI_BUF_BYTE_ADDRESS (buf, floor);
+ while (bufptr >= floorptr)
+ {
+ st--;
+ /* At this point, both ST and BUFPTR refer to the same
+ character. When the loop terminates, ST will
+ always point to the last character we tried. */
+ if (* (unsigned char *) bufptr == (unsigned char) target)
+ {
+ count++;
+ break;
+ }
+ bufptr--;
+ }
+ }
+ }
+
+ if (shortage)
+ *shortage = -count;
+ if (allow_quit)
+ QUIT;
+ if (count)
+ return st;
+ else
+ {
+ /* We found the character we were looking for; we have to return
+ the position *after* it due to the strange way that the return
+ value is defined. */
+ INC_BYTIND (buf, st);
+ return st;
+ }
+ }
+}
+
+Bufpos
+scan_buffer (struct buffer *buf, Emchar target, Bufpos start, Bufpos end,
+ EMACS_INT count, EMACS_INT *shortage, int allow_quit)
+{
+ Bytind bi_retval;
+ Bytind bi_start, bi_end;
+
+ bi_start = bufpos_to_bytind (buf, start);
+ if (end)
+ bi_end = bufpos_to_bytind (buf, end);
+ else
+ bi_end = 0;
+ bi_retval = bi_scan_buffer (buf, target, bi_start, bi_end, count,
+ shortage, allow_quit);
+ return bytind_to_bufpos (buf, bi_retval);
+}
+
+Bytind
+bi_find_next_newline_no_quit (struct buffer *buf, Bytind from, int cnt)
+{
+ return bi_scan_buffer (buf, '\n', from, 0, cnt, 0, 0);
+}
+
+Bufpos
+find_next_newline_no_quit (struct buffer *buf, Bufpos from, int cnt)
+{
+ return scan_buffer (buf, '\n', from, 0, cnt, 0, 0);
+}
+
+Bufpos
+find_next_newline (struct buffer *buf, Bufpos from, int cnt)
+{
+ return scan_buffer (buf, '\n', from, 0, cnt, 0, 1);
+}
+
+/* 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. */
+Bufpos
+find_before_next_newline (struct buffer *buf, Bufpos from, Bufpos to, int cnt)
+{
+ EMACS_INT shortage;
+ Bufpos pos = scan_buffer (buf, '\n', from, to, cnt, &shortage, 1);
+
+ if (shortage == 0)
+ pos--;
+
+ return pos;
+}
+\f
+static Lisp_Object
+skip_chars (struct buffer *buf, int forwardp, int syntaxp,
+ Lisp_Object string, Lisp_Object lim)
+{
+ /* This function has been Mule-ized. */
+ REGISTER Bufbyte *p, *pend;
+ REGISTER Emchar c;
+ /* We store the first 256 chars in an array here and the rest in
+ a range table. */
+ unsigned char fastmap[0400];
+ int negate = 0;
+ REGISTER int i;
+ struct Lisp_Char_Table *syntax_table =
+ XCHAR_TABLE (buf->mirror_syntax_table);
+
+ CHECK_STRING (string);
+
+ if (NILP (lim))
+ XSETINT (lim, forwardp ? BUF_ZV (buf) : BUF_BEGV (buf));
+ else
+ CHECK_INT_COERCE_MARKER (lim);
+
+ /* In any case, don't allow scan outside bounds of buffer. */
+ if (XINT (lim) > BUF_ZV (buf))
+ lim = make_int (BUF_ZV (buf));
+ if (XINT (lim) < BUF_BEGV (buf))
+ lim = make_int (BUF_BEGV (buf));
+
+ p = XSTRING_DATA (string);
+ pend = p + XSTRING_LENGTH (string);
+ memset (fastmap, 0, sizeof (fastmap));
+
+ Fclear_range_table (Vskip_chars_range_table);
+
+ if (p != pend && *p == '^')
+ {
+ negate = 1;
+ p++;
+ }
+
+ /* Find the characters specified and set their elements of fastmap.
+ If syntaxp, each character counts as itself.
+ Otherwise, handle backslashes and ranges specially */
+
+ while (p != pend)
+ {
+ c = charptr_emchar (p);
+ INC_CHARPTR (p);
+ if (syntaxp)
+ {
+ if (c < 0400 && syntax_spec_code[c] < (unsigned char) Smax)
+ fastmap[c] = 1;
+ else
+ signal_simple_error ("Invalid syntax designator",
+ make_char (c));
+ }
+ else
+ {
+ if (c == '\\')
+ {
+ if (p == pend) break;
+ c = charptr_emchar (p);
+ INC_CHARPTR (p);
+ }
+ if (p != pend && *p == '-')
+ {
+ Emchar cend;
+
+ p++;
+ if (p == pend) break;
+ cend = charptr_emchar (p);
+ while (c <= cend && c < 0400)
+ {
+ fastmap[c] = 1;
+ c++;
+ }
+ if (c <= cend)
+ Fput_range_table (make_int (c), make_int (cend), Qt,
+ Vskip_chars_range_table);
+ INC_CHARPTR (p);
+ }
+ else
+ {
+ if (c < 0400)
+ fastmap[c] = 1;
+ else
+ Fput_range_table (make_int (c), make_int (c), Qt,
+ Vskip_chars_range_table);
+ }
+ }
+ }
+
+ if (syntaxp && fastmap['-'] != 0)
+ fastmap[' '] = 1;
+
+ /* If ^ was the first character, complement the fastmap.
+ We don't complement the range table, however; we just use negate
+ in the comparisons below. */
+
+ if (negate)
+ for (i = 0; i < (int) (sizeof fastmap); i++)
+ fastmap[i] ^= 1;
+
+ {
+ Bufpos start_point = BUF_PT (buf);
+
+ if (syntaxp)
+ {
+ /* All syntax designators are normal chars so nothing strange
+ to worry about */
+ if (forwardp)
+ {
+ while (BUF_PT (buf) < XINT (lim)
+ && fastmap[(unsigned char)
+ syntax_code_spec
+ [(int) SYNTAX (syntax_table,
+ BUF_FETCH_CHAR
+ (buf, BUF_PT (buf)))]])
+ BUF_SET_PT (buf, BUF_PT (buf) + 1);
+ }
+ else
+ {
+ while (BUF_PT (buf) > XINT (lim)
+ && fastmap[(unsigned char)
+ syntax_code_spec
+ [(int) SYNTAX (syntax_table,
+ BUF_FETCH_CHAR
+ (buf, BUF_PT (buf) - 1))]])
+ BUF_SET_PT (buf, BUF_PT (buf) - 1);
+ }
+ }
+ else
+ {
+ if (forwardp)
+ {
+ while (BUF_PT (buf) < XINT (lim))
+ {
+ Emchar ch = BUF_FETCH_CHAR (buf, BUF_PT (buf));
+ if ((ch < 0400) ? fastmap[ch] :
+ (NILP (Fget_range_table (make_int (ch),
+ Vskip_chars_range_table,
+ Qnil))
+ == negate))
+ BUF_SET_PT (buf, BUF_PT (buf) + 1);
+ else
+ break;
+ }
+ }
+ else
+ {
+ while (BUF_PT (buf) > XINT (lim))
+ {
+ Emchar ch = BUF_FETCH_CHAR (buf, BUF_PT (buf) - 1);
+ if ((ch < 0400) ? fastmap[ch] :
+ (NILP (Fget_range_table (make_int (ch),
+ Vskip_chars_range_table,
+ Qnil))
+ == negate))
+ BUF_SET_PT (buf, BUF_PT (buf) - 1);
+ else
+ break;
+ }
+ }
+ }
+ QUIT;
+ return make_int (BUF_PT (buf) - start_point);
+ }
+}
+
+DEFUN ("skip-chars-forward", Fskip_chars_forward, 1, 3, 0, /*
+Move point forward, stopping before a char not in STRING, or at pos LIM.
+STRING is like the inside of a `[...]' in a regular expression
+except that `]' is never special and `\\' quotes `^', `-' or `\\'.
+Thus, with arg "a-zA-Z", this skips letters stopping before first nonletter.
+With arg "^a-zA-Z", skips nonletters stopping before first letter.
+Returns the distance traveled, either zero or positive.
+
+Optional argument BUFFER defaults to the current buffer.
+*/
+ (string, lim, buffer))
+{
+ return skip_chars (decode_buffer (buffer, 0), 1, 0, string, lim);
+}
+
+DEFUN ("skip-chars-backward", Fskip_chars_backward, 1, 3, 0, /*
+Move point backward, stopping after a char not in STRING, or at pos LIM.
+See `skip-chars-forward' for details.
+Returns the distance traveled, either zero or negative.
+
+Optional argument BUFFER defaults to the current buffer.
+*/
+ (string, lim, buffer))
+{
+ return skip_chars (decode_buffer (buffer, 0), 0, 0, string, lim);
+}
+
+
+DEFUN ("skip-syntax-forward", Fskip_syntax_forward, 1, 3, 0, /*
+Move point forward across chars in specified syntax classes.
+SYNTAX is a string of syntax code characters.
+Stop before a char whose syntax is not in SYNTAX, or at position LIM.
+If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.
+This function returns the distance traveled, either zero or positive.
+
+Optional argument BUFFER defaults to the current buffer.
+*/
+ (syntax, lim, buffer))
+{
+ return skip_chars (decode_buffer (buffer, 0), 1, 1, syntax, lim);
+}
+
+DEFUN ("skip-syntax-backward", Fskip_syntax_backward, 1, 3, 0, /*
+Move point backward across chars in specified syntax classes.
+SYNTAX is a string of syntax code characters.
+Stop on reaching a char whose syntax is not in SYNTAX, or at position LIM.
+If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.
+This function returns the distance traveled, either zero or negative.
+
+Optional argument BUFFER defaults to the current buffer.
+*/
+ (syntax, lim, buffer))
+{
+ return skip_chars (decode_buffer (buffer, 0), 0, 1, syntax, lim);
+}
+
+\f
+/* Subroutines of Lisp buffer search functions. */
+
+static Lisp_Object
+search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object no_error,
+ Lisp_Object count, Lisp_Object buffer, int direction,
+ int RE, int posix)
+{
+ /* This function has been Mule-ized, except for the trt table handling. */
+ REGISTER Bufpos np;
+ Bufpos lim;
+ EMACS_INT n = direction;
+ struct buffer *buf;
+
+ if (!NILP (count))
+ {
+ CHECK_INT (count);
+ n *= XINT (count);
+ }
+
+ buf = decode_buffer (buffer, 0);
+ CHECK_STRING (string);
+ if (NILP (bound))
+ lim = n > 0 ? BUF_ZV (buf) : BUF_BEGV (buf);
+ else
+ {
+ CHECK_INT_COERCE_MARKER (bound);
+ lim = XINT (bound);
+ if (n > 0 ? lim < BUF_PT (buf) : lim > BUF_PT (buf))
+ error ("Invalid search bound (wrong side of point)");
+ if (lim > BUF_ZV (buf))
+ lim = BUF_ZV (buf);
+ if (lim < BUF_BEGV (buf))
+ lim = BUF_BEGV (buf);
+ }
+
+ np = search_buffer (buf, string, BUF_PT (buf), lim, n, RE,
+ (!NILP (buf->case_fold_search)
+ ? MIRROR_CANON_TABLE_AS_STRING (buf)
+ : 0),
+ (!NILP (buf->case_fold_search)
+ ? MIRROR_EQV_TABLE_AS_STRING (buf)
+ : 0), posix);
+
+ if (np <= 0)
+ {
+ if (NILP (no_error))
+ return signal_failure (string);
+ if (!EQ (no_error, Qt))
+ {
+ if (lim < BUF_BEGV (buf) || lim > BUF_ZV (buf))
+ abort ();
+ BUF_SET_PT (buf, lim);
+ return Qnil;
+#if 0 /* This would be clean, but maybe programs depend on
+ a value of nil here. */
+ np = lim;
+#endif
+ }
+ else
+ return Qnil;
+ }
+
+ if (np < BUF_BEGV (buf) || np > BUF_ZV (buf))
+ abort ();
+
+ BUF_SET_PT (buf, np);
+
+ return make_int (np);
+}
+\f
+static int
+trivial_regexp_p (Lisp_Object regexp)
+{
+ /* This function has been Mule-ized. */
+ Bytecount len = XSTRING_LENGTH (regexp);
+ Bufbyte *s = XSTRING_DATA (regexp);
+ while (--len >= 0)
+ {
+ switch (*s++)
+ {
+ case '.': case '*': case '+': case '?': case '[': case '^': case '$':
+ return 0;
+ case '\\':
+ if (--len < 0)
+ return 0;
+ switch (*s++)
+ {
+ case '|': case '(': case ')': case '`': case '\'': case 'b':
+ case 'B': case '<': case '>': case 'w': case 'W': case 's':
+ case 'S': case '=':
+#ifdef MULE
+ /* 97/2/25 jhod Added for category matches */
+ case 'c': case 'C':
+#endif /* MULE */
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ return 0;
+ }
+ }
+ }
+ return 1;
+}
+
+/* Search for the n'th occurrence of STRING in BUF,
+ starting at position BUFPOS and stopping at position BUFLIM,
+ treating PAT as a literal string if RE is false or as
+ a regular expression if RE is true.
+
+ If N is positive, searching is forward and BUFLIM must be greater
+ than BUFPOS.
+ If N is negative, searching is backward and BUFLIM must be less
+ than BUFPOS.
+
+ Returns -x if only N-x occurrences found (x > 0),
+ or else the position at the beginning of the Nth occurrence
+ (if searching backward) or the end (if searching forward).
+
+ POSIX is nonzero if we want full backtracking (POSIX style)
+ for this pattern. 0 means backtrack only enough to get a valid match. */
+
+static Bufpos
+search_buffer (struct buffer *buf, Lisp_Object string, Bufpos bufpos,
+ Bufpos buflim, EMACS_INT n, int RE, unsigned char *trt,
+ unsigned char *inverse_trt, int posix)
+{
+ /* This function has been Mule-ized, except for the trt table handling. */
+ Bytecount len = XSTRING_LENGTH (string);
+ Bufbyte *base_pat = XSTRING_DATA (string);
+ REGISTER EMACS_INT *BM_tab;
+ EMACS_INT *BM_tab_base;
+ REGISTER int direction = ((n > 0) ? 1 : -1);
+ REGISTER Bytecount dirlen;
+ EMACS_INT infinity;
+ Bytind limit;
+ EMACS_INT k;
+ Bytecount stride_for_teases = 0;
+ REGISTER Bufbyte *pat = 0;
+ REGISTER Bufbyte *cursor, *p_limit, *ptr2;
+ REGISTER EMACS_INT i, j;
+ Bytind p1, p2;
+ Bytecount s1, s2;
+ Bytind pos, lim;
+
+ if (running_asynch_code)
+ save_search_regs ();
+
+ /* Null string is found at starting position. */
+ if (len == 0)
+ {
+ set_search_regs (buf, bufpos, 0);
+ return bufpos;
+ }
+
+ /* Searching 0 times means don't move. */
+ if (n == 0)
+ return bufpos;
+
+ pos = bufpos_to_bytind (buf, bufpos);
+ lim = bufpos_to_bytind (buf, buflim);
+ if (RE && !trivial_regexp_p (string))
+ {
+ struct re_pattern_buffer *bufp;
+
+ bufp = compile_pattern (string, &search_regs, (char *) trt, posix,
+ ERROR_ME);
+
+ /* Get pointers and sizes of the two strings
+ that make up the visible portion of the buffer. */
+
+ p1 = BI_BUF_BEGV (buf);
+ p2 = BI_BUF_CEILING_OF (buf, p1);
+ s1 = p2 - p1;
+ s2 = BI_BUF_ZV (buf) - p2;
+
+ while (n < 0)
+ {
+ Bytecount val;
+ QUIT;
+ regex_emacs_buffer = buf;
+ val = re_search_2 (bufp,
+ (char *) BI_BUF_BYTE_ADDRESS (buf, p1), s1,
+ (char *) BI_BUF_BYTE_ADDRESS (buf, p2), s2,
+ pos - BI_BUF_BEGV (buf), lim - pos, &search_regs,
+ pos - BI_BUF_BEGV (buf));
+
+ if (val == -2)
+ {
+ matcher_overflow ();
+ }
+ if (val >= 0)
+ {
+ int num_regs = search_regs.num_regs;
+ j = BI_BUF_BEGV (buf);
+ for (i = 0; i < num_regs; i++)
+ if (search_regs.start[i] >= 0)
+ {
+ search_regs.start[i] += j;
+ search_regs.end[i] += j;
+ }
+ XSETBUFFER (last_thing_searched, buf);
+ /* Set pos to the new position. */
+ pos = search_regs.start[0];
+ fixup_search_regs_for_buffer (buf);
+ /* And bufpos too. */
+ bufpos = search_regs.start[0];
+ }
+ else
+ {
+ return n;
+ }
+ n++;
+ }
+ while (n > 0)
+ {
+ Bytecount val;
+ QUIT;
+ regex_emacs_buffer = buf;
+ val = re_search_2 (bufp,
+ (char *) BI_BUF_BYTE_ADDRESS (buf, p1), s1,
+ (char *) BI_BUF_BYTE_ADDRESS (buf, p2), s2,
+ pos - BI_BUF_BEGV (buf), lim - pos, &search_regs,
+ lim - BI_BUF_BEGV (buf));
+ if (val == -2)
+ {
+ matcher_overflow ();
+ }
+ if (val >= 0)
+ {
+ int num_regs = search_regs.num_regs;
+ j = BI_BUF_BEGV (buf);
+ for (i = 0; i < num_regs; i++)
+ if (search_regs.start[i] >= 0)
+ {
+ search_regs.start[i] += j;
+ search_regs.end[i] += j;
+ }
+ XSETBUFFER (last_thing_searched, buf);
+ /* Set pos to the new position. */
+ pos = search_regs.end[0];
+ fixup_search_regs_for_buffer (buf);
+ /* And bufpos too. */
+ bufpos = search_regs.end[0];
+ }
+ else
+ {
+ return 0 - n;
+ }
+ n--;
+ }
+ return bufpos;
+ }
+ else /* non-RE case */
+ /* #### Someone really really really needs to comment the workings
+ of this junk somewhat better.
+
+ BTW "BM" stands for Boyer-Moore, which is one of the standard
+ string-searching algorithms. It's the best string-searching
+ algorithm out there provided
+
+ a) You're not fazed by algorithm complexity. (Rabin-Karp, which
+ uses hashing, is much much easier to code but not as fast.)
+ b) You can freely move backwards in the string that you're
+ searching through.
+
+ As the comment below tries to explain (but garbles in typical
+ programmer-ese), the idea is that you don't have to do a
+ string match at every successive position in the text. For
+ example, let's say the pattern is "a very long string". We
+ compare the last character in the string (`g') with the
+ corresponding character in the text. If it mismatches, and
+ it is, say, `z', then we can skip forward by the entire
+ length of the pattern because `z' does not occur anywhere
+ in the pattern. If the mismatching character does occur
+ in the pattern, we can usually still skip forward by more
+ than one: e.g. if it is `l', then we can skip forward
+ by the length of the substring "ong string" -- i.e. the
+ largest end section of the pattern that does not contain
+ the mismatched character. So what we do is compute, for
+ each possible character, the distance we can skip forward
+ (the "stride") and use it in the string matching. This
+ is what the BM_tab holds. */
+ {
+#ifdef C_ALLOCA
+ EMACS_INT BM_tab_space[0400];
+ BM_tab = &BM_tab_space[0];
+#else
+ BM_tab = alloca_array (EMACS_INT, 256);
+#endif
+ {
+ Bufbyte *patbuf = alloca_array (Bufbyte, len);
+ pat = patbuf;
+ while (--len >= 0)
+ {
+ /* If we got here and the RE flag is set, it's because we're
+ dealing with a regexp known to be trivial, so the backslash
+ just quotes the next character. */
+ if (RE && *base_pat == '\\')
+ {
+ len--;
+ base_pat++;
+ }
+ *pat++ = (trt ? trt[*base_pat++] : *base_pat++);
+ }
+ len = pat - patbuf;
+ pat = base_pat = patbuf;
+ }
+ /* The general approach is that we are going to maintain that we know */
+ /* the first (closest to the present position, in whatever direction */
+ /* we're searching) character that could possibly be the last */
+ /* (furthest from present position) character of a valid match. We */
+ /* advance the state of our knowledge by looking at that character */
+ /* and seeing whether it indeed matches the last character of the */
+ /* pattern. If it does, we take a closer look. If it does not, we */
+ /* move our pointer (to putative last characters) as far as is */
+ /* logically possible. This amount of movement, which I call a */
+ /* stride, will be the length of the pattern if the actual character */
+ /* appears nowhere in the pattern, otherwise it will be the distance */
+ /* from the last occurrence of that character to the end of the */
+ /* pattern. */
+ /* As a coding trick, an enormous stride is coded into the table for */
+ /* characters that match the last character. This allows use of only */
+ /* a single test, a test for having gone past the end of the */
+ /* permissible match region, to test for both possible matches (when */
+ /* the stride goes past the end immediately) and failure to */
+ /* match (where you get nudged past the end one stride at a time). */
+
+ /* Here we make a "mickey mouse" BM table. The stride of the search */
+ /* is determined only by the last character of the putative match. */
+ /* If that character does not match, we will stride the proper */
+ /* distance to propose a match that superimposes it on the last */
+ /* instance of a character that matches it (per trt), or misses */
+ /* it entirely if there is none. */
+
+ dirlen = len * direction;
+ infinity = dirlen - (lim + pos + len + len) * direction;
+ if (direction < 0)
+ pat = (base_pat += len - 1);
+ BM_tab_base = BM_tab;
+ BM_tab += 0400;
+ j = dirlen; /* to get it in a register */
+ /* A character that does not appear in the pattern induces a */
+ /* stride equal to the pattern length. */
+ while (BM_tab_base != BM_tab)
+ {
+ *--BM_tab = j;
+ *--BM_tab = j;
+ *--BM_tab = j;
+ *--BM_tab = j;
+ }
+ i = 0;
+ while (i != infinity)
+ {
+ j = pat[i]; i += direction;
+ if (i == dirlen) i = infinity;
+ if (trt != 0)
+ {
+ k = (j = trt[j]);
+ if (i == infinity)
+ stride_for_teases = BM_tab[j];
+ BM_tab[j] = dirlen - i;
+ /* A translation table is accompanied by its inverse -- see */
+ /* comment following downcase_table for details */
+
+ while ((j = inverse_trt[j]) != k)
+ BM_tab[j] = dirlen - i;
+ }
+ else
+ {
+ if (i == infinity)
+ stride_for_teases = BM_tab[j];
+ BM_tab[j] = dirlen - i;
+ }
+ /* stride_for_teases tells how much to stride if we get a */
+ /* match on the far character but are subsequently */
+ /* disappointed, by recording what the stride would have been */
+ /* for that character if the last character had been */
+ /* different. */
+ }
+ infinity = dirlen - infinity;
+ pos += dirlen - ((direction > 0) ? direction : 0);
+ /* loop invariant - pos points at where last char (first char if reverse)
+ of pattern would align in a possible match. */
+ while (n != 0)
+ {
+ /* It's been reported that some (broken) compiler thinks that
+ Boolean expressions in an arithmetic context are unsigned.
+ Using an explicit ?1:0 prevents this. */
+ if ((lim - pos - ((direction > 0) ? 1 : 0)) * direction < 0)
+ return n * (0 - direction);
+ /* First we do the part we can by pointers (maybe nothing) */
+ QUIT;
+ pat = base_pat;
+ limit = pos - dirlen + direction;
+ /* XEmacs change: definitions of CEILING_OF and FLOOR_OF
+ have changed. See buffer.h. */
+ limit = ((direction > 0)
+ ? BI_BUF_CEILING_OF (buf, limit) - 1
+ : BI_BUF_FLOOR_OF (buf, limit + 1));
+ /* LIMIT is now the last (not beyond-last!) value
+ POS can take on without hitting edge of buffer or the gap. */
+ limit = ((direction > 0)
+ ? min (lim - 1, min (limit, pos + 20000))
+ : max (lim, max (limit, pos - 20000)));
+ if ((limit - pos) * direction > 20)
+ {
+ p_limit = BI_BUF_BYTE_ADDRESS (buf, limit);
+ ptr2 = (cursor = BI_BUF_BYTE_ADDRESS (buf, pos));
+ /* In this loop, pos + cursor - ptr2 is the surrogate for pos */
+ while (1) /* use one cursor setting as long as i can */
+ {
+ if (direction > 0) /* worth duplicating */
+ {
+ /* Use signed comparison if appropriate
+ to make cursor+infinity sure to be > p_limit.
+ Assuming that the buffer lies in a range of addresses
+ that are all "positive" (as ints) or all "negative",
+ either kind of comparison will work as long
+ as we don't step by infinity. So pick the kind
+ that works when we do step by infinity. */
+ if ((EMACS_INT) (p_limit + infinity) >
+ (EMACS_INT) p_limit)
+ while ((EMACS_INT) cursor <=
+ (EMACS_INT) p_limit)
+ cursor += BM_tab[*cursor];
+ else
+ while ((EMACS_UINT) cursor <=
+ (EMACS_UINT) p_limit)
+ cursor += BM_tab[*cursor];
+ }
+ else
+ {
+ if ((EMACS_INT) (p_limit + infinity) <
+ (EMACS_INT) p_limit)
+ while ((EMACS_INT) cursor >=
+ (EMACS_INT) p_limit)
+ cursor += BM_tab[*cursor];
+ else
+ while ((EMACS_UINT) cursor >=
+ (EMACS_UINT) p_limit)
+ cursor += BM_tab[*cursor];
+ }
+/* If you are here, cursor is beyond the end of the searched region. */
+ /* This can happen if you match on the far character of the pattern, */
+ /* because the "stride" of that character is infinity, a number able */
+ /* to throw you well beyond the end of the search. It can also */
+ /* happen if you fail to match within the permitted region and would */
+ /* otherwise try a character beyond that region */
+ if ((cursor - p_limit) * direction <= len)
+ break; /* a small overrun is genuine */
+ cursor -= infinity; /* large overrun = hit */
+ i = dirlen - direction;
+ if (trt != 0)
+ {
+ while ((i -= direction) + direction != 0)
+ if (pat[i] != trt[*(cursor -= direction)])
+ break;
+ }
+ else
+ {
+ while ((i -= direction) + direction != 0)
+ if (pat[i] != *(cursor -= direction))
+ break;
+ }
+ cursor += dirlen - i - direction; /* fix cursor */
+ if (i + direction == 0)
+ {
+ cursor -= direction;
+
+ {
+ Bytind bytstart = (pos + cursor - ptr2 +
+ ((direction > 0)
+ ? 1 - len : 0));
+ Bufpos bufstart = bytind_to_bufpos (buf, bytstart);
+ Bufpos bufend = bytind_to_bufpos (buf, bytstart + len);
+
+ set_search_regs (buf, bufstart, bufend - bufstart);
+ }
+
+ if ((n -= direction) != 0)
+ cursor += dirlen; /* to resume search */
+ else
+ return ((direction > 0)
+ ? search_regs.end[0] : search_regs.start[0]);
+ }
+ else
+ cursor += stride_for_teases; /* <sigh> we lose - */
+ }
+ pos += cursor - ptr2;
+ }
+ else
+ /* Now we'll pick up a clump that has to be done the hard */
+ /* way because it covers a discontinuity */
+ {
+ /* XEmacs change: definitions of CEILING_OF and FLOOR_OF
+ have changed. See buffer.h. */
+ limit = ((direction > 0)
+ ? BI_BUF_CEILING_OF (buf, pos - dirlen + 1) - 1
+ : BI_BUF_FLOOR_OF (buf, pos - dirlen));
+ limit = ((direction > 0)
+ ? min (limit + len, lim - 1)
+ : max (limit - len, lim));
+ /* LIMIT is now the last value POS can have
+ and still be valid for a possible match. */
+ while (1)
+ {
+ /* This loop can be coded for space rather than */
+ /* speed because it will usually run only once. */
+ /* (the reach is at most len + 21, and typically */
+ /* does not exceed len) */
+ while ((limit - pos) * direction >= 0)
+ /* *not* BI_BUF_FETCH_CHAR. We are working here
+ with bytes, not characters. */
+ pos += BM_tab[*BI_BUF_BYTE_ADDRESS (buf, pos)];
+ /* now run the same tests to distinguish going off the */
+ /* end, a match or a phony match. */
+ if ((pos - limit) * direction <= len)
+ break; /* ran off the end */
+ /* Found what might be a match.
+ Set POS back to last (first if reverse) char pos. */
+ pos -= infinity;
+ i = dirlen - direction;
+ while ((i -= direction) + direction != 0)
+ {
+ pos -= direction;
+ if (pat[i] != (((Bufbyte *) trt)
+ /* #### Does not handle TRT right */
+ ? trt[*BI_BUF_BYTE_ADDRESS (buf, pos)]
+ : *BI_BUF_BYTE_ADDRESS (buf, pos)))
+ break;
+ }
+ /* Above loop has moved POS part or all the way
+ back to the first char pos (last char pos if reverse).
+ Set it once again at the last (first if reverse) char. */
+ pos += dirlen - i- direction;
+ if (i + direction == 0)
+ {
+ pos -= direction;
+
+ {
+ Bytind bytstart = (pos +
+ ((direction > 0)
+ ? 1 - len : 0));
+ Bufpos bufstart = bytind_to_bufpos (buf, bytstart);
+ Bufpos bufend = bytind_to_bufpos (buf, bytstart + len);
+
+ set_search_regs (buf, bufstart, bufend - bufstart);
+ }
+
+ if ((n -= direction) != 0)
+ pos += dirlen; /* to resume search */
+ else
+ return ((direction > 0)
+ ? search_regs.end[0] : search_regs.start[0]);
+ }
+ else
+ pos += stride_for_teases;
+ }
+ }
+ /* We have done one clump. Can we continue? */
+ if ((lim - pos) * direction < 0)
+ return (0 - n) * direction;
+ }
+ return bytind_to_bufpos (buf, pos);
+ }
+}
+
+/* Record beginning BEG and end BEG + LEN
+ for a match just found in the current buffer. */
+
+static void
+set_search_regs (struct buffer *buf, Bufpos beg, Charcount len)
+{
+ /* This function has been Mule-ized. */
+ /* Make sure we have registers in which to store
+ the match position. */
+ if (search_regs.num_regs == 0)
+ {
+ search_regs.start = xnew (regoff_t);
+ search_regs.end = xnew (regoff_t);
+ search_regs.num_regs = 1;
+ }
+
+ search_regs.start[0] = beg;
+ search_regs.end[0] = beg + len;
+ XSETBUFFER (last_thing_searched, buf);
+}
+
+\f
+/* Given a string of words separated by word delimiters,
+ compute a regexp that matches those exact words
+ separated by arbitrary punctuation. */
+
+static Lisp_Object
+wordify (Lisp_Object buffer, Lisp_Object string)
+{
+ 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);
+
+ CHECK_STRING (string);
+ len = XSTRING_CHAR_LENGTH (string);
+
+ for (i = 0; i < len; i++)
+ if (!WORD_SYNTAX_P (syntax_table, string_char (XSTRING (string), i)))
+ {
+ punct_count++;
+ if (i > 0 && WORD_SYNTAX_P (syntax_table,
+ string_char (XSTRING (string), i - 1)))
+ word_count++;
+ }
+ if (WORD_SYNTAX_P (syntax_table, string_char (XSTRING (string), len - 1)))
+ word_count++;
+ if (!word_count) return build_string ("");
+
+ {
+ /* The following value is an upper bound on the amount of storage we
+ need. In non-Mule, it is exact. */
+ Bufbyte *storage =
+ (Bufbyte *) alloca (XSTRING_LENGTH (string) - punct_count +
+ 5 * (word_count - 1) + 4);
+ Bufbyte *o = storage;
+
+ *o++ = '\\';
+ *o++ = 'b';
+
+ for (i = 0; i < len; i++)
+ {
+ Emchar ch = string_char (XSTRING (string), i);
+
+ if (WORD_SYNTAX_P (syntax_table, ch))
+ o += set_charptr_emchar (o, ch);
+ else if (i > 0
+ && WORD_SYNTAX_P (syntax_table,
+ string_char (XSTRING (string), i - 1))
+ && --word_count)
+ {
+ *o++ = '\\';
+ *o++ = 'W';
+ *o++ = '\\';
+ *o++ = 'W';
+ *o++ = '*';
+ }
+ }
+
+ *o++ = '\\';
+ *o++ = 'b';
+
+ return make_string (storage, o - storage);
+ }
+}
+\f
+DEFUN ("search-backward", Fsearch_backward, 1, 5, "sSearch backward: ", /*
+Search backward from point for STRING.
+Set point to the beginning of the occurrence found, and return point.
+An optional second argument bounds the search; it is a buffer position.
+The match found must not extend before that position.
+Optional third argument, if t, means if fail just return nil (no error).
+ If not nil and not t, position at limit of search and return nil.
+Optional fourth argument is repeat count--search for successive occurrences.
+Optional fifth argument BUFFER specifies the buffer to search in and
+ defaults to the current buffer.
+See also the functions `match-beginning', `match-end' and `replace-match'.
+*/
+ (string, bound, no_error, count, buffer))
+{
+ return search_command (string, bound, no_error, count, buffer, -1, 0, 0);
+}
+
+DEFUN ("search-forward", Fsearch_forward, 1, 5, "sSearch: ", /*
+Search forward from point for STRING.
+Set point to the end of the occurrence found, and return point.
+An optional second argument bounds the search; it is a buffer position.
+The match found must not extend after that position. nil is equivalent
+ to (point-max).
+Optional third argument, if t, means if fail just return nil (no error).
+ If not nil and not t, move to limit of search and return nil.
+Optional fourth argument is repeat count--search for successive occurrences.
+Optional fifth argument BUFFER specifies the buffer to search in and
+ defaults to the current buffer.
+See also the functions `match-beginning', `match-end' and `replace-match'.
+*/
+ (string, bound, no_error, count, buffer))
+{
+ return search_command (string, bound, no_error, count, buffer, 1, 0, 0);
+}
+
+DEFUN ("word-search-backward", Fword_search_backward, 1, 5,
+ "sWord search backward: ", /*
+Search backward from point for STRING, ignoring differences in punctuation.
+Set point to the beginning of the occurrence found, and return point.
+An optional second argument bounds the search; it is a buffer position.
+The match found must not extend before that position.
+Optional third argument, if t, means if fail just return nil (no error).
+ If not nil and not t, move to limit of search and return nil.
+Optional fourth argument is repeat count--search for successive occurrences.
+Optional fifth argument BUFFER specifies the buffer to search in and
+ defaults to the current buffer.
+*/
+ (string, bound, no_error, count, buffer))
+{
+ return search_command (wordify (buffer, string), bound, no_error, count,
+ buffer, -1, 1, 0);
+}
+
+DEFUN ("word-search-forward", Fword_search_forward, 1, 5, "sWord search: ", /*
+Search forward from point for STRING, ignoring differences in punctuation.
+Set point to the end of the occurrence found, and return point.
+An optional second argument bounds the search; it is a buffer position.
+The match found must not extend after that position.
+Optional third argument, if t, means if fail just return nil (no error).
+ If not nil and not t, move to limit of search and return nil.
+Optional fourth argument is repeat count--search for successive occurrences.
+Optional fifth argument BUFFER specifies the buffer to search in and
+ defaults to the current buffer.
+*/
+ (string, bound, no_error, count, buffer))
+{
+ return search_command (wordify (buffer, string), bound, no_error, count,
+ buffer, 1, 1, 0);
+}
+
+DEFUN ("re-search-backward", Fre_search_backward, 1, 5,
+ "sRE search backward: ", /*
+Search backward from point for match for regular expression REGEXP.
+Set point to the beginning of the match, and return point.
+The match found is the one starting last in the buffer
+and yet ending before the origin of the search.
+An optional second argument bounds the search; it is a buffer position.
+The match found must start at or after that position.
+Optional third argument, if t, means if fail just return nil (no error).
+ If not nil and not t, move to limit of search and return nil.
+Optional fourth argument is repeat count--search for successive occurrences.
+Optional fifth argument BUFFER specifies the buffer to search in and
+ defaults to the current buffer.
+See also the functions `match-beginning', `match-end' and `replace-match'.
+*/
+ (regexp, bound, no_error, count, buffer))
+{
+ return search_command (regexp, bound, no_error, count, buffer, -1, 1, 0);
+}
+
+DEFUN ("re-search-forward", Fre_search_forward, 1, 5, "sRE search: ", /*
+Search forward from point for regular expression REGEXP.
+Set point to the end of the occurrence found, and return point.
+An optional second argument bounds the search; it is a buffer position.
+The match found must not extend after that position.
+Optional third argument, if t, means if fail just return nil (no error).
+ If not nil and not t, move to limit of search and return nil.
+Optional fourth argument is repeat count--search for successive occurrences.
+Optional fifth argument BUFFER specifies the buffer to search in and
+ defaults to the current buffer.
+See also the functions `match-beginning', `match-end' and `replace-match'.
+*/
+ (regexp, bound, no_error, count, buffer))
+{
+ return search_command (regexp, bound, no_error, count, buffer, 1, 1, 0);
+}
+
+DEFUN ("posix-search-backward", Fposix_search_backward, 1, 5,
+ "sPosix search backward: ", /*
+Search backward from point for match for regular expression REGEXP.
+Find the longest match in accord with Posix regular expression rules.
+Set point to the beginning of the match, and return point.
+The match found is the one starting last in the buffer
+and yet ending before the origin of the search.
+An optional second argument bounds the search; it is a buffer position.
+The match found must start at or after that position.
+Optional third argument, if t, means if fail just return nil (no error).
+ If not nil and not t, move to limit of search and return nil.
+Optional fourth argument is repeat count--search for successive occurrences.
+Optional fifth argument BUFFER specifies the buffer to search in and
+ defaults to the current buffer.
+See also the functions `match-beginning', `match-end' and `replace-match'.
+*/
+ (regexp, bound, no_error, count, buffer))
+{
+ return search_command (regexp, bound, no_error, count, buffer, -1, 1, 1);
+}
+
+DEFUN ("posix-search-forward", Fposix_search_forward, 1, 5, "sPosix search: ", /*
+Search forward from point for regular expression REGEXP.
+Find the longest match in accord with Posix regular expression rules.
+Set point to the end of the occurrence found, and return point.
+An optional second argument bounds the search; it is a buffer position.
+The match found must not extend after that position.
+Optional third argument, if t, means if fail just return nil (no error).
+ If not nil and not t, move to limit of search and return nil.
+Optional fourth argument is repeat count--search for successive occurrences.
+Optional fifth argument BUFFER specifies the buffer to search in and
+ defaults to the current buffer.
+See also the functions `match-beginning', `match-end' and `replace-match'.
+*/
+ (regexp, bound, no_error, count, buffer))
+{
+ return search_command (regexp, bound, no_error, count, buffer, 1, 1, 1);
+}
+
+\f
+static Lisp_Object
+free_created_dynarrs (Lisp_Object cons)
+{
+ Dynarr_free (get_opaque_ptr (XCAR (cons)));
+ Dynarr_free (get_opaque_ptr (XCDR (cons)));
+ free_opaque_ptr (XCAR (cons));
+ free_opaque_ptr (XCDR (cons));
+ free_cons (XCONS (cons));
+ return Qnil;
+}
+
+DEFUN ("replace-match", Freplace_match, 1, 5, 0, /*
+Replace text matched by last search with NEWTEXT.
+If second arg FIXEDCASE is non-nil, do not alter case of replacement text.
+Otherwise maybe capitalize the whole text, or maybe just word initials,
+based on the replaced text.
+If the replaced text has only capital letters
+and has at least one multiletter word, convert NEWTEXT to all caps.
+If the replaced text has at least one word starting with a capital letter,
+then capitalize each word in NEWTEXT.
+
+If third arg LITERAL is non-nil, insert NEWTEXT literally.
+Otherwise treat `\\' as special:
+ `\\&' in NEWTEXT means substitute original matched text.
+ `\\N' means substitute what matched the Nth `\\(...\\)'.
+ If Nth parens didn't match, substitute nothing.
+ `\\\\' means insert one `\\'.
+ `\\u' means upcase the next character.
+ `\\l' means downcase the next character.
+ `\\U' means begin upcasing all following characters.
+ `\\L' means begin downcasing all following characters.
+ `\\E' means terminate the effect of any `\\U' or `\\L'.
+ Case changes made with `\\u', `\\l', `\\U', and `\\L' override
+ all other case changes that may be made in the replaced text.
+FIXEDCASE and LITERAL are optional arguments.
+Leaves point at end of replacement text.
+
+The optional fourth argument STRING can be a string to modify.
+In that case, this function creates and returns a new string
+which is made by replacing the part of STRING that was matched.
+When fourth argument is a string, fifth argument STRBUFFER specifies
+the buffer to be used for syntax-table and case-table lookup and
+defaults to the current buffer. (When fourth argument is not a string,
+the buffer that the match occurred in has automatically been remembered
+and you do not need to specify it.)
+*/
+ (newtext, fixedcase, literal, string, strbuffer))
+{
+ /* This function has been Mule-ized. */
+ /* This function can GC */
+ enum { nochange, all_caps, cap_initial } case_action;
+ Bufpos pos, last;
+ int some_multiletter_word;
+ int some_lowercase;
+ int some_uppercase;
+ int some_nonuppercase_initial;
+ Emchar c, prevc;
+ Charcount inslen;
+ struct buffer *buf;
+ struct Lisp_Char_Table *syntax_table;
+ int mc_count;
+ Lisp_Object buffer;
+ int_dynarr *ul_action_dynarr = 0;
+ int_dynarr *ul_pos_dynarr = 0;
+ int speccount;
+
+ CHECK_STRING (newtext);
+
+ if (! NILP (string))
+ {
+ CHECK_STRING (string);
+ if (!EQ (last_thing_searched, Qt))
+ error ("last thing matched was not a string");
+ /* If the match data
+ were abstracted into a special "match data" type instead
+ of the typical half-assed "let the implementation be
+ visible" form it's in, we could extend it to include
+ the last string matched and the buffer used for that
+ matching. But of course we can't change it as it is. */
+ buf = decode_buffer (strbuffer, 0);
+ XSETBUFFER (buffer, buf);
+ }
+ else
+ {
+ if (!BUFFERP (last_thing_searched))
+ error ("last thing matched was not a buffer");
+ buffer = last_thing_searched;
+ buf = XBUFFER (buffer);
+ }
+
+ syntax_table = XCHAR_TABLE (buf->mirror_syntax_table);
+
+ case_action = nochange; /* We tried an initialization */
+ /* but some C compilers blew it */
+
+ if (search_regs.num_regs <= 0)
+ error ("replace-match called before any match found");
+
+ if (NILP (string))
+ {
+ if (search_regs.start[0] < BUF_BEGV (buf)
+ || search_regs.start[0] > search_regs.end[0]
+ || search_regs.end[0] > BUF_ZV (buf))
+ args_out_of_range (make_int (search_regs.start[0]),
+ make_int (search_regs.end[0]));
+ }
+ else
+ {
+ if (search_regs.start[0] < 0
+ || search_regs.start[0] > search_regs.end[0]
+ || search_regs.end[0] > XSTRING_CHAR_LENGTH (string))
+ args_out_of_range (make_int (search_regs.start[0]),
+ make_int (search_regs.end[0]));
+ }
+
+ if (NILP (fixedcase))
+ {
+ /* Decide how to casify by examining the matched text. */
+
+ last = search_regs.end[0];
+ prevc = '\n';
+ case_action = all_caps;
+
+ /* some_multiletter_word is set nonzero if any original word
+ is more than one letter long. */
+ some_multiletter_word = 0;
+ some_lowercase = 0;
+ some_nonuppercase_initial = 0;
+ some_uppercase = 0;
+
+ for (pos = search_regs.start[0]; pos < last; pos++)
+ {
+ if (NILP (string))
+ c = BUF_FETCH_CHAR (buf, pos);
+ else
+ c = string_char (XSTRING (string), pos);
+
+ if (LOWERCASEP (buf, c))
+ {
+ /* Cannot be all caps if any original char is lower case */
+
+ some_lowercase = 1;
+ if (!WORD_SYNTAX_P (syntax_table, prevc))
+ some_nonuppercase_initial = 1;
+ else
+ some_multiletter_word = 1;
+ }
+ else if (!NOCASEP (buf, c))
+ {
+ some_uppercase = 1;
+ if (!WORD_SYNTAX_P (syntax_table, prevc))
+ ;
+ else
+ some_multiletter_word = 1;
+ }
+ else
+ {
+ /* If the initial is a caseless word constituent,
+ treat that like a lowercase initial. */
+ if (!WORD_SYNTAX_P (syntax_table, prevc))
+ some_nonuppercase_initial = 1;
+ }
+
+ prevc = c;
+ }
+
+ /* Convert to all caps if the old text is all caps
+ and has at least one multiletter word. */
+ if (! some_lowercase && some_multiletter_word)
+ case_action = all_caps;
+ /* Capitalize each word, if the old text has all capitalized words. */
+ else if (!some_nonuppercase_initial && some_multiletter_word)
+ case_action = cap_initial;
+ else if (!some_nonuppercase_initial && some_uppercase)
+ /* Should x -> yz, operating on X, give Yz or YZ?
+ We'll assume the latter. */
+ case_action = all_caps;
+ else
+ case_action = nochange;
+ }
+
+ /* Do replacement in a string. */
+ if (!NILP (string))
+ {
+ Lisp_Object before, after;
+
+ speccount = specpdl_depth ();
+ before = Fsubstring (string, Qzero, make_int (search_regs.start[0]));
+ after = Fsubstring (string, make_int (search_regs.end[0]), Qnil);
+
+ /* Do case substitution into NEWTEXT if desired. */
+ if (NILP (literal))
+ {
+ Charcount stlen = XSTRING_CHAR_LENGTH (newtext);
+ Charcount strpos;
+ /* XEmacs change: rewrote this loop somewhat to make it
+ cleaner. Also added \U, \E, etc. */
+ Charcount literal_start = 0;
+ /* We build up the substituted string in ACCUM. */
+ Lisp_Object accum;
+
+ accum = Qnil;
+
+ /* OK, the basic idea here is that we scan through the
+ replacement string until we find a backslash, which
+ represents a substring of the original string to be
+ substituted. We then append onto ACCUM the literal
+ text before the backslash (LASTPOS marks the
+ beginning of this) followed by the substring of the
+ original string that needs to be inserted. */
+ for (strpos = 0; strpos < stlen; strpos++)
+ {
+ /* If LITERAL_END is set, we've encountered a backslash
+ (the end of literal text to be inserted). */
+ Charcount literal_end = -1;
+ /* If SUBSTART is set, we need to also insert the
+ text from SUBSTART to SUBEND in the original string. */
+ Charcount substart = -1;
+ Charcount subend = -1;
+
+ c = string_char (XSTRING (newtext), strpos);
+ if (c == '\\')
+ {
+ c = string_char (XSTRING (newtext), ++strpos);
+ if (c == '&')
+ {
+ literal_end = strpos - 1;
+ substart = search_regs.start[0];
+ subend = search_regs.end[0];
+ }
+ else if (c >= '1' && c <= '9' &&
+ c <= search_regs.num_regs + '0')
+ {
+ if (search_regs.start[c - '0'] >= 0)
+ {
+ literal_end = strpos - 1;
+ substart = search_regs.start[c - '0'];
+ subend = search_regs.end[c - '0'];
+ }
+ }
+ else if (c == 'U' || c == 'u' || c == 'L' || c == 'l' ||
+ c == 'E')
+ {
+ /* Keep track of all case changes requested, but don't
+ make them now. Do them later so we override
+ everything else. */
+ if (!ul_pos_dynarr)
+ {
+ ul_pos_dynarr = Dynarr_new (int);
+ ul_action_dynarr = Dynarr_new (int);
+ record_unwind_protect
+ (free_created_dynarrs,
+ noseeum_cons
+ (make_opaque_ptr (ul_pos_dynarr),
+ make_opaque_ptr (ul_action_dynarr)));
+ }
+ literal_end = strpos - 1;
+ Dynarr_add (ul_pos_dynarr,
+ (!NILP (accum)
+ ? XSTRING_CHAR_LENGTH (accum)
+ : 0) + (literal_end - literal_start));
+ Dynarr_add (ul_action_dynarr, c);
+ }
+ else if (c == '\\')
+ /* So we get just one backslash. */
+ literal_end = strpos;
+ }
+ if (literal_end >= 0)
+ {
+ Lisp_Object literal_text = Qnil;
+ Lisp_Object substring = Qnil;
+ if (literal_end != literal_start)
+ literal_text = Fsubstring (newtext,
+ make_int (literal_start),
+ make_int (literal_end));
+ if (substart >= 0 && subend != substart)
+ substring = Fsubstring (string,
+ make_int (substart),
+ make_int (subend));
+ if (!NILP (literal_text) || !NILP (substring))
+ accum = concat3 (accum, literal_text, substring);
+ literal_start = strpos + 1;
+ }
+ }
+
+ if (strpos != literal_start)
+ /* some literal text at end to be inserted */
+ newtext = concat2 (accum, Fsubstring (newtext,
+ make_int (literal_start),
+ make_int (strpos)));
+ else
+ newtext = accum;
+ }
+
+ if (case_action == all_caps)
+ newtext = Fupcase (newtext, buffer);
+ else if (case_action == cap_initial)
+ newtext = Fupcase_initials (newtext, buffer);
+
+ /* Now finally, we need to process the \U's, \E's, etc. */
+ if (ul_pos_dynarr)
+ {
+ int i = 0;
+ int cur_action = 'E';
+ Charcount stlen = XSTRING_CHAR_LENGTH (newtext);
+ Charcount strpos;
+
+ for (strpos = 0; strpos < stlen; strpos++)
+ {
+ Emchar curchar = string_char (XSTRING (newtext), strpos);
+ Emchar newchar = -1;
+ if (i < Dynarr_length (ul_pos_dynarr) &&
+ strpos == Dynarr_at (ul_pos_dynarr, i))
+ {
+ int new_action = Dynarr_at (ul_action_dynarr, i);
+ i++;
+ if (new_action == 'u')
+ newchar = UPCASE (buf, curchar);
+ else if (new_action == 'l')
+ newchar = DOWNCASE (buf, curchar);
+ else
+ cur_action = new_action;
+ }
+ if (newchar == -1)
+ {
+ if (cur_action == 'U')
+ newchar = UPCASE (buf, curchar);
+ else if (cur_action == 'L')
+ newchar = DOWNCASE (buf, curchar);
+ else
+ newchar = curchar;
+ }
+ if (newchar != curchar)
+ set_string_char (XSTRING (newtext), strpos, newchar);
+ }
+ }
+
+ /* frees the Dynarrs if necessary. */
+ unbind_to (speccount, Qnil);
+ return concat3 (before, newtext, after);
+ }
+
+ mc_count = begin_multiple_change (buf, search_regs.start[0],
+ search_regs.end[0]);
+
+ /* begin_multiple_change() records an unwind-protect, so we need to
+ record this value now. */
+ speccount = specpdl_depth ();
+
+ /* We insert the replacement text before the old text, and then
+ delete the original text. This means that markers at the
+ beginning or end of the original will float to the corresponding
+ position in the replacement. */
+ BUF_SET_PT (buf, search_regs.start[0]);
+ if (!NILP (literal))
+ Finsert (1, &newtext);
+ else
+ {
+ Charcount stlen = XSTRING_CHAR_LENGTH (newtext);
+ Charcount strpos;
+ struct gcpro gcpro1;
+ GCPRO1 (newtext);
+ for (strpos = 0; strpos < stlen; strpos++)
+ {
+ Charcount offset = BUF_PT (buf) - search_regs.start[0];
+
+ c = string_char (XSTRING (newtext), strpos);
+ if (c == '\\')
+ {
+ c = string_char (XSTRING (newtext), ++strpos);
+ if (c == '&')
+ Finsert_buffer_substring
+ (buffer,
+ make_int (search_regs.start[0] + offset),
+ make_int (search_regs.end[0] + offset));
+ else if (c >= '1' && c <= '9' &&
+ c <= search_regs.num_regs + '0')
+ {
+ if (search_regs.start[c - '0'] >= 1)
+ Finsert_buffer_substring
+ (buffer,
+ make_int (search_regs.start[c - '0'] + offset),
+ make_int (search_regs.end[c - '0'] + offset));
+ }
+ else if (c == 'U' || c == 'u' || c == 'L' || c == 'l' ||
+ c == 'E')
+ {
+ /* Keep track of all case changes requested, but don't
+ make them now. Do them later so we override
+ everything else. */
+ if (!ul_pos_dynarr)
+ {
+ ul_pos_dynarr = Dynarr_new (int);
+ ul_action_dynarr = Dynarr_new (int);
+ record_unwind_protect
+ (free_created_dynarrs,
+ Fcons (make_opaque_ptr (ul_pos_dynarr),
+ make_opaque_ptr (ul_action_dynarr)));
+ }
+ Dynarr_add (ul_pos_dynarr, BUF_PT (buf));
+ Dynarr_add (ul_action_dynarr, c);
+ }
+ else
+ buffer_insert_emacs_char (buf, c);
+ }
+ else
+ buffer_insert_emacs_char (buf, c);
+ }
+ UNGCPRO;
+ }
+
+ inslen = BUF_PT (buf) - (search_regs.start[0]);
+ buffer_delete_range (buf, search_regs.start[0] + inslen, search_regs.end[0] +
+ inslen, 0);
+
+ if (case_action == all_caps)
+ Fupcase_region (make_int (BUF_PT (buf) - inslen),
+ make_int (BUF_PT (buf)), buffer);
+ else if (case_action == cap_initial)
+ Fupcase_initials_region (make_int (BUF_PT (buf) - inslen),
+ make_int (BUF_PT (buf)), buffer);
+
+ /* Now go through and make all the case changes that were requested
+ in the replacement string. */
+ if (ul_pos_dynarr)
+ {
+ Bufpos eend = BUF_PT (buf);
+ int i = 0;
+ int cur_action = 'E';
+
+ for (pos = BUF_PT (buf) - inslen; pos < eend; pos++)
+ {
+ Emchar curchar = BUF_FETCH_CHAR (buf, pos);
+ Emchar newchar = -1;
+ if (i < Dynarr_length (ul_pos_dynarr) &&
+ pos == Dynarr_at (ul_pos_dynarr, i))
+ {
+ int new_action = Dynarr_at (ul_action_dynarr, i);
+ i++;
+ if (new_action == 'u')
+ newchar = UPCASE (buf, curchar);
+ else if (new_action == 'l')
+ newchar = DOWNCASE (buf, curchar);
+ else
+ cur_action = new_action;
+ }
+ if (newchar == -1)
+ {
+ if (cur_action == 'U')
+ newchar = UPCASE (buf, curchar);
+ else if (cur_action == 'L')
+ newchar = DOWNCASE (buf, curchar);
+ else
+ newchar = curchar;
+ }
+ if (newchar != curchar)
+ buffer_replace_char (buf, pos, newchar, 0, 0);
+ }
+ }
+
+ /* frees the Dynarrs if necessary. */
+ unbind_to (speccount, Qnil);
+ end_multiple_change (buf, mc_count);
+
+ return Qnil;
+}
+\f
+static Lisp_Object
+match_limit (Lisp_Object num, int beginningp)
+{
+ /* This function has been Mule-ized. */
+ int n;
+
+ CHECK_INT (num);
+ n = XINT (num);
+ if (n < 0 || n >= search_regs.num_regs)
+ args_out_of_range (num, make_int (search_regs.num_regs));
+ if (search_regs.num_regs <= 0 ||
+ search_regs.start[n] < 0)
+ return Qnil;
+ return make_int (beginningp ? search_regs.start[n] : search_regs.end[n]);
+}
+
+DEFUN ("match-beginning", Fmatch_beginning, 1, 1, 0, /*
+Return position of start of text matched by last regexp search.
+NUM, specifies which parenthesized expression in the last regexp.
+ Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
+Zero means the entire text matched by the whole regexp or whole string.
+*/
+ (num))
+{
+ return match_limit (num, 1);
+}
+
+DEFUN ("match-end", Fmatch_end, 1, 1, 0, /*
+Return position of end of text matched by last regexp search.
+NUM specifies which parenthesized expression in the last regexp.
+ Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
+Zero means the entire text matched by the whole regexp or whole string.
+*/
+ (num))
+{
+ return match_limit (num, 0);
+}
+
+DEFUN ("match-data", Fmatch_data, 0, 2, 0, /*
+Return a list containing all info on what the last regexp search matched.
+Element 2N is `(match-beginning N)'; element 2N + 1 is `(match-end N)'.
+All the elements are markers or nil (nil if the Nth pair didn't match)
+if the last match was on a buffer; integers or nil if a string was matched.
+Use `store-match-data' to reinstate the data in this list.
+
+If INTEGERS (the optional first argument) is non-nil, always use integers
+\(rather than markers) to represent buffer positions.
+If REUSE is a list, reuse it as part of the value. If REUSE is long enough
+to hold all the values, and if INTEGERS is non-nil, no consing is done.
+*/
+ (integers, reuse))
+{
+ /* This function has been Mule-ized. */
+ Lisp_Object tail, prev;
+ Lisp_Object *data;
+ int i;
+ Charcount len;
+
+ if (NILP (last_thing_searched))
+ /*error ("match-data called before any match found");*/
+ return Qnil;
+
+ data = alloca_array (Lisp_Object, 2 * search_regs.num_regs);
+
+ len = -1;
+ for (i = 0; i < search_regs.num_regs; i++)
+ {
+ Bufpos start = search_regs.start[i];
+ if (start >= 0)
+ {
+ if (EQ (last_thing_searched, Qt)
+ || !NILP (integers))
+ {
+ data[2 * i] = make_int (start);
+ data[2 * i + 1] = make_int (search_regs.end[i]);
+ }
+ else if (BUFFERP (last_thing_searched))
+ {
+ data[2 * i] = Fmake_marker ();
+ Fset_marker (data[2 * i],
+ make_int (start),
+ last_thing_searched);
+ data[2 * i + 1] = Fmake_marker ();
+ Fset_marker (data[2 * i + 1],
+ make_int (search_regs.end[i]),
+ last_thing_searched);
+ }
+ else
+ /* last_thing_searched must always be Qt, a buffer, or Qnil. */
+ abort ();
+
+ len = i;
+ }
+ else
+ data[2 * i] = data [2 * i + 1] = Qnil;
+ }
+ if (!CONSP (reuse))
+ return Flist (2 * len + 2, data);
+
+ /* If REUSE is a list, store as many value elements as will fit
+ into the elements of REUSE. */
+ for (i = 0, tail = reuse; CONSP (tail); i++, tail = XCDR (tail))
+ {
+ if (i < 2 * len + 2)
+ XCAR (tail) = data[i];
+ else
+ XCAR (tail) = Qnil;
+ prev = tail;
+ }
+
+ /* If we couldn't fit all value elements into REUSE,
+ cons up the rest of them and add them to the end of REUSE. */
+ if (i < 2 * len + 2)
+ XCDR (prev) = Flist (2 * len + 2 - i, data + i);
+
+ return reuse;
+}
+
+
+DEFUN ("store-match-data", Fstore_match_data, 1, 1, 0, /*
+Set internal data on last search match from elements of LIST.
+LIST should have been created by calling `match-data' previously.
+*/
+ (list))
+{
+ /* This function has been Mule-ized. */
+ REGISTER int i;
+ REGISTER Lisp_Object marker;
+ int num_regs;
+ int length;
+
+ if (running_asynch_code)
+ save_search_regs ();
+
+ CONCHECK_LIST (list);
+
+ /* Unless we find a marker with a buffer in LIST, assume that this
+ match data came from a string. */
+ last_thing_searched = Qt;
+
+ /* Allocate registers if they don't already exist. */
+ length = XINT (Flength (list)) / 2;
+ num_regs = search_regs.num_regs;
+
+ if (length > num_regs)
+ {
+ if (search_regs.num_regs == 0)
+ {
+ search_regs.start = xnew_array (regoff_t, length);
+ search_regs.end = xnew_array (regoff_t, length);
+ }
+ else
+ {
+ XREALLOC_ARRAY (search_regs.start, regoff_t, length);
+ XREALLOC_ARRAY (search_regs.end, regoff_t, length);
+ }
+
+ search_regs.num_regs = length;
+ }
+
+ for (i = 0; i < num_regs; i++)
+ {
+ marker = Fcar (list);
+ if (NILP (marker))
+ {
+ search_regs.start[i] = -1;
+ list = Fcdr (list);
+ }
+ else
+ {
+ if (MARKERP (marker))
+ {
+ if (XMARKER (marker)->buffer == 0)
+ marker = Qzero;
+ else
+ XSETBUFFER (last_thing_searched, XMARKER (marker)->buffer);
+ }
+
+ CHECK_INT_COERCE_MARKER (marker);
+ search_regs.start[i] = XINT (marker);
+ list = Fcdr (list);
+
+ marker = Fcar (list);
+ if (MARKERP (marker) && XMARKER (marker)->buffer == 0)
+ marker = Qzero;
+
+ CHECK_INT_COERCE_MARKER (marker);
+ search_regs.end[i] = XINT (marker);
+ }
+ list = Fcdr (list);
+ }
+
+ return Qnil;
+}
+
+/* If non-zero the match data have been saved in saved_search_regs
+ during the execution of a sentinel or filter. */
+static int search_regs_saved;
+static struct re_registers saved_search_regs;
+
+/* Called from Flooking_at, Fstring_match, search_buffer, Fstore_match_data
+ if asynchronous code (filter or sentinel) is running. */
+static void
+save_search_regs (void)
+{
+ if (!search_regs_saved)
+ {
+ saved_search_regs.num_regs = search_regs.num_regs;
+ saved_search_regs.start = search_regs.start;
+ saved_search_regs.end = search_regs.end;
+ search_regs.num_regs = 0;
+ search_regs.start = 0;
+ search_regs.end = 0;
+
+ search_regs_saved = 1;
+ }
+}
+
+/* Called upon exit from filters and sentinels. */
+void
+restore_match_data (void)
+{
+ if (search_regs_saved)
+ {
+ if (search_regs.num_regs > 0)
+ {
+ xfree (search_regs.start);
+ xfree (search_regs.end);
+ }
+ search_regs.num_regs = saved_search_regs.num_regs;
+ search_regs.start = saved_search_regs.start;
+ search_regs.end = saved_search_regs.end;
+
+ search_regs_saved = 0;
+ }
+}
+
+/* Quote a string to inactivate reg-expr chars */
+
+DEFUN ("regexp-quote", Fregexp_quote, 1, 1, 0, /*
+Return a regexp string which matches exactly STRING and nothing else.
+*/
+ (str))
+{
+ REGISTER Bufbyte *in, *out, *end;
+ REGISTER Bufbyte *temp;
+
+ CHECK_STRING (str);
+
+ temp = (Bufbyte *) alloca (XSTRING_LENGTH (str) * 2);
+
+ /* Now copy the data into the new string, inserting escapes. */
+
+ in = XSTRING_DATA (str);
+ end = in + XSTRING_LENGTH (str);
+ out = temp;
+
+ while (in < end)
+ {
+ Emchar c = charptr_emchar (in);
+
+ if (c == '[' || c == ']'
+ || c == '*' || c == '.' || c == '\\'
+ || c == '?' || c == '+'
+ || c == '^' || c == '$')
+ *out++ = '\\';
+ out += set_charptr_emchar (out, c);
+ INC_CHARPTR (in);
+ }
+
+ return make_string (temp, out - temp);
+}
+
+DEFUN ("set-word-regexp", Fset_word_regexp, 1, 1, 0, /*
+Set the regexp to be used to match a word in regular-expression searching.
+#### Not yet implemented. Currently does nothing.
+#### Do not use this yet. Its calling interface is likely to change.
+*/
+ (regexp))
+{
+ return Qnil;
+}
+
+\f
+/************************************************************************/
+/* initialization */
+/************************************************************************/
+
+void
+syms_of_search (void)
+{
+
+ deferror (&Qsearch_failed, "search-failed", "Search failed", Qerror);
+ deferror (&Qinvalid_regexp, "invalid-regexp", "Invalid regexp", Qerror);
+
+ DEFSUBR (Flooking_at);
+ DEFSUBR (Fposix_looking_at);
+ DEFSUBR (Fstring_match);
+ DEFSUBR (Fposix_string_match);
+ DEFSUBR (Fskip_chars_forward);
+ DEFSUBR (Fskip_chars_backward);
+ DEFSUBR (Fskip_syntax_forward);
+ DEFSUBR (Fskip_syntax_backward);
+ DEFSUBR (Fsearch_forward);
+ DEFSUBR (Fsearch_backward);
+ DEFSUBR (Fword_search_forward);
+ DEFSUBR (Fword_search_backward);
+ DEFSUBR (Fre_search_forward);
+ DEFSUBR (Fre_search_backward);
+ DEFSUBR (Fposix_search_forward);
+ DEFSUBR (Fposix_search_backward);
+ DEFSUBR (Freplace_match);
+ DEFSUBR (Fmatch_beginning);
+ DEFSUBR (Fmatch_end);
+ DEFSUBR (Fmatch_data);
+ DEFSUBR (Fstore_match_data);
+ DEFSUBR (Fregexp_quote);
+ DEFSUBR (Fset_word_regexp);
+}
+
+void
+vars_of_search (void)
+{
+ REGISTER int i;
+
+ for (i = 0; i < REGEXP_CACHE_SIZE; ++i)
+ {
+ searchbufs[i].buf.allocated = 100;
+ searchbufs[i].buf.buffer = (unsigned char *) xmalloc (100);
+ searchbufs[i].buf.fastmap = searchbufs[i].fastmap;
+ searchbufs[i].regexp = Qnil;
+ staticpro (&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);
+
+ DEFVAR_LISP ("forward-word-regexp", &Vforward_word_regexp /*
+*Regular expression to be used in `forward-word'.
+#### Not yet implemented.
+*/ );
+ Vforward_word_regexp = Qnil;
+
+ DEFVAR_LISP ("backward-word-regexp", &Vbackward_word_regexp /*
+*Regular expression to be used in `backward-word'.
+#### Not yet implemented.
+*/ );
+ Vbackward_word_regexp = Qnil;
+}
+
+void
+complex_vars_of_search (void)
+{
+ Vskip_chars_range_table = Fmake_range_table ();
+ staticpro (&Vskip_chars_range_table);
+}
--- /dev/null
+/* "intern" and friends -- moved here from lread.c and data.c
+ Copyright (C) 1985-1989, 1992-1994 Free Software Foundation, Inc.
+ Copyright (C) 1995 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: FSF 19.30. */
+
+/* This file has been Mule-ized. */
+
+/* NOTE:
+
+ The value cell of a symbol can contain a simple value or one of
+ various symbol-value-magic objects. Some of these objects can
+ chain into other kinds of objects. Here is a table of possibilities:
+
+ 1a) simple value
+ 1b) Qunbound
+ 1c) symbol-value-forward, excluding Qunbound
+ 2) symbol-value-buffer-local -> 1a or 1b or 1c
+ 3) symbol-value-lisp-magic -> 1a or 1b or 1c
+ 4) symbol-value-lisp-magic -> symbol-value-buffer-local -> 1a or 1b or 1c
+ 5) symbol-value-varalias
+ 6) symbol-value-lisp-magic -> symbol-value-varalias
+
+ The "chain" of a symbol-value-buffer-local is its current_value slot.
+
+ The "chain" of a symbol-value-lisp-magic is its shadowed slot, which
+ applies for handler types without associated handlers.
+
+ All other fields in all the structures (including the "shadowed" slot
+ in a symbol-value-varalias) can *only* contain a simple value or Qunbound.
+
+*/
+
+/* #### Ugh, though, this file does awful things with symbol-value-magic
+ objects. This ought to be cleaned up. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h" /* for Vbuffer_defaults */
+#include "console.h"
+
+#include "elhash.h" /* for HASHTABLE_NONWEAK and HASHTABLE_EQ */
+
+Lisp_Object Qad_advice_info, Qad_activate;
+
+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 Qsymbol_value, Qset, Qdefault_boundp, Qdefault_value;
+Lisp_Object Qset_default, Qmake_variable_buffer_local, Qmake_local_variable;
+Lisp_Object Qkill_local_variable, Qkill_console_local_variable;
+Lisp_Object Qsymbol_value_in_buffer, Qsymbol_value_in_console;
+Lisp_Object Qlocal_variable_p;
+
+Lisp_Object Qconst_integer, Qconst_boolean, Qconst_object;
+Lisp_Object Qconst_specifier;
+Lisp_Object Qdefault_buffer, Qcurrent_buffer, Qconst_current_buffer;
+Lisp_Object Qdefault_console, Qselected_console, Qconst_selected_console;
+
+static Lisp_Object maybe_call_magic_handler (Lisp_Object sym,
+ Lisp_Object funsym,
+ int nargs, ...);
+static Lisp_Object fetch_value_maybe_past_magic (Lisp_Object sym,
+ Lisp_Object
+ follow_past_lisp_magic);
+static Lisp_Object *value_slot_past_magic (Lisp_Object sym);
+static Lisp_Object follow_varalias_pointers (Lisp_Object object,
+ Lisp_Object
+ follow_past_lisp_magic);
+
+\f
+#ifdef LRECORD_SYMBOL
+
+static Lisp_Object
+mark_symbol (Lisp_Object obj, void (*markobj) (Lisp_Object))
+{
+ struct 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));*/
+ XSETSTRING (pname, sym->name);
+ ((markobj) (pname));
+ if (!symbol_next (sym))
+ return sym->plist;
+ else
+ {
+ ((markobj) (sym->plist));
+ /* Mark the rest of the symbols in the obarray hash-chain */
+ sym = symbol_next (sym);
+ XSETSYMBOL (obj, sym);
+ return obj;
+ }
+}
+
+DEFINE_BASIC_LRECORD_IMPLEMENTATION ("symbol", symbol,
+ mark_symbol, print_symbol, 0, 0, 0,
+ struct Lisp_Symbol);
+#endif /* LRECORD_SYMBOL */
+
+\f
+/**********************************************************************/
+/* Intern */
+/**********************************************************************/
+
+/* #### using a vector here is way bogus. Use a hash table instead. */
+
+Lisp_Object Vobarray;
+
+static Lisp_Object initial_obarray;
+
+/* oblookup stores the bucket number here, for the sake of Funintern. */
+
+static int oblookup_last_bucket_number;
+
+static Lisp_Object
+check_obarray (Lisp_Object obarray)
+{
+ while (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
+ {
+ /* If Vobarray is now invalid, force it to be valid. */
+ if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
+
+ obarray = wrong_type_argument (Qvectorp, obarray);
+ }
+ return obarray;
+}
+
+Lisp_Object
+intern (CONST char *str)
+{
+ Lisp_Object tem;
+ Bytecount len = strlen (str);
+ Lisp_Object obarray = Vobarray;
+ if (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
+ obarray = check_obarray (obarray);
+ tem = oblookup (obarray, (CONST Bufbyte *) str, len);
+
+ if (SYMBOLP (tem))
+ return tem;
+ return Fintern (((purify_flag)
+ ? make_pure_pname ((CONST Bufbyte *) str, len, 0)
+ : make_string ((CONST Bufbyte *) str, len)),
+ obarray);
+}
+
+DEFUN ("intern", Fintern, 1, 2, 0, /*
+Return the canonical symbol whose name is STRING.
+If there is none, one is created by this function and returned.
+A second optional argument specifies the obarray to use;
+it defaults to the value of `obarray'.
+*/
+ (str, obarray))
+{
+ Lisp_Object sym, *ptr;
+ Bytecount len;
+
+ if (NILP (obarray)) obarray = Vobarray;
+ obarray = check_obarray (obarray);
+
+ CHECK_STRING (str);
+
+ len = XSTRING_LENGTH (str);
+ sym = oblookup (obarray, XSTRING_DATA (str), len);
+ if (!INTP (sym))
+ /* Found it */
+ return sym;
+
+ ptr = &XVECTOR_DATA (obarray)[XINT (sym)];
+
+ if (purify_flag && ! purified (str))
+ str = make_pure_pname (XSTRING_DATA (str), len, 0);
+ sym = Fmake_symbol (str);
+ /* 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;
+
+ if (SYMBOLP (*ptr))
+ symbol_next (XSYMBOL (sym)) = XSYMBOL (*ptr);
+ else
+ symbol_next (XSYMBOL (sym)) = 0;
+ *ptr = sym;
+ return sym;
+}
+
+DEFUN ("intern-soft", Fintern_soft, 1, 2, 0, /*
+Return the canonical symbol whose name is STRING, or nil if none exists.
+A second optional argument specifies the obarray to use;
+it defaults to the value of `obarray'.
+*/
+ (str, obarray))
+{
+ Lisp_Object tem;
+
+ if (NILP (obarray)) obarray = Vobarray;
+ obarray = check_obarray (obarray);
+
+ CHECK_STRING (str);
+
+ tem = oblookup (obarray, XSTRING_DATA (str), XSTRING_LENGTH (str));
+ if (!INTP (tem))
+ return tem;
+ return Qnil;
+}
+\f
+DEFUN ("unintern", Funintern, 1, 2, 0, /*
+Delete the symbol named NAME, if any, from OBARRAY.
+The value is t if a symbol was found and deleted, nil otherwise.
+NAME may be a string or a symbol. If it is a symbol, that symbol
+is deleted, if it belongs to OBARRAY--no other symbol is deleted.
+OBARRAY defaults to the value of the variable `obarray'
+*/
+ (name, obarray))
+{
+ Lisp_Object string, tem;
+ int hash;
+
+ if (NILP (obarray)) obarray = Vobarray;
+ obarray = check_obarray (obarray);
+
+ if (SYMBOLP (name))
+ XSETSTRING (string, XSYMBOL (name)->name);
+ else
+ {
+ CHECK_STRING (name);
+ string = name;
+ }
+
+ tem = oblookup (obarray, XSTRING_DATA (string), XSTRING_LENGTH (string));
+ if (INTP (tem))
+ return Qnil;
+ /* If arg was a symbol, don't delete anything but that symbol itself. */
+ if (SYMBOLP (name) && !EQ (name, tem))
+ return Qnil;
+
+ hash = oblookup_last_bucket_number;
+
+ if (EQ (XVECTOR_DATA (obarray)[hash], tem))
+ {
+ if (XSYMBOL (tem)->next)
+ XSETSYMBOL (XVECTOR_DATA (obarray)[hash], XSYMBOL (tem)->next);
+ else
+ XVECTOR_DATA (obarray)[hash] = Qzero;
+ }
+ else
+ {
+ Lisp_Object tail, following;
+
+ for (tail = XVECTOR_DATA (obarray)[hash];
+ XSYMBOL (tail)->next;
+ tail = following)
+ {
+ XSETSYMBOL (following, XSYMBOL (tail)->next);
+ if (EQ (following, tem))
+ {
+ XSYMBOL (tail)->next = XSYMBOL (following)->next;
+ break;
+ }
+ }
+ }
+ XSYMBOL (tem)->obarray = Qnil;
+ return Qt;
+}
+\f
+/* Return the symbol in OBARRAY whose names matches the string
+ of SIZE characters at PTR. If there is no such symbol in OBARRAY,
+ return nil.
+
+ Also store the bucket number in oblookup_last_bucket_number. */
+
+Lisp_Object
+oblookup (Lisp_Object obarray, CONST Bufbyte *ptr, Bytecount size)
+{
+ int hash, obsize;
+ struct Lisp_Symbol *tail;
+ Lisp_Object bucket;
+
+ if (!VECTORP (obarray) ||
+ (obsize = XVECTOR_LENGTH (obarray)) == 0)
+ {
+ 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
+ /* Combining next two lines breaks VMS C 2.3. */
+ hash = hash_string (ptr, size);
+ hash %= obsize;
+ bucket = XVECTOR_DATA (obarray)[hash];
+ oblookup_last_bucket_number = hash;
+ if (ZEROP (bucket))
+ ;
+ else if (!SYMBOLP (bucket))
+ error ("Bad data in guts of obarray"); /* Like CADR error message */
+ else
+ for (tail = XSYMBOL (bucket); ;)
+ {
+ if (string_length (tail->name) == size &&
+ !memcmp (string_data (tail->name), ptr, size))
+ {
+ XSETSYMBOL (bucket, tail);
+ return bucket;
+ }
+ tail = symbol_next (tail);
+ if (!tail)
+ break;
+ }
+ return make_int (hash);
+}
+
+#if 0 /* Emacs 19.34 */
+int
+hash_string (CONST Bufbyte *ptr, Bytecount len)
+{
+ CONST Bufbyte *p = ptr;
+ CONST Bufbyte *end = p + len;
+ Bufbyte c;
+ int hash = 0;
+
+ while (p != end)
+ {
+ c = *p++;
+ if (c >= 0140) c -= 40;
+ hash = ((hash<<3) + (hash>>28) + c);
+ }
+ return hash & 07777777777;
+}
+#endif
+
+/* derived from hashpjw, Dragon Book P436. */
+int
+hash_string (CONST Bufbyte *ptr, Bytecount len)
+{
+ int hash = 0;
+
+ while (len-- > 0)
+ {
+ int g;
+ hash = (hash << 4) + *ptr++;
+ g = hash & 0xf0000000;
+ if (g)
+ hash = (hash ^ (g >> 24)) ^ g;
+ }
+ return hash & 07777777777;
+}
+
+/* Map FN over OBARRAY. The mapping is stopped when FN returns a
+ non-zero value. */
+void
+map_obarray (Lisp_Object obarray,
+ int (*fn) (Lisp_Object, void *), void *arg)
+{
+ REGISTER int i;
+
+ CHECK_VECTOR (obarray);
+ for (i = XVECTOR_LENGTH (obarray) - 1; i >= 0; i--)
+ {
+ Lisp_Object tail = XVECTOR_DATA (obarray)[i];
+ if (SYMBOLP (tail))
+ while (1)
+ {
+ struct Lisp_Symbol *next;
+ if ((*fn) (tail, arg))
+ return;
+ next = symbol_next (XSYMBOL (tail));
+ if (!next)
+ break;
+ XSETSYMBOL (tail, next);
+ }
+ }
+}
+
+static int
+mapatoms_1 (Lisp_Object sym, void *arg)
+{
+ call1 (*(Lisp_Object *)arg, sym);
+ return 0;
+}
+
+DEFUN ("mapatoms", Fmapatoms, 1, 2, 0, /*
+Call FUNCTION on every symbol in OBARRAY.
+OBARRAY defaults to the value of `obarray'.
+*/
+ (function, obarray))
+{
+ if (NILP (obarray))
+ obarray = Vobarray;
+ obarray = check_obarray (obarray);
+
+ map_obarray (obarray, mapatoms_1, &function);
+ return Qnil;
+}
+
+\f
+/**********************************************************************/
+/* Apropos */
+/**********************************************************************/
+
+struct appropos_mapper_closure
+{
+ Lisp_Object regexp;
+ Lisp_Object predicate;
+ Lisp_Object accumulation;
+};
+
+static int
+apropos_mapper (Lisp_Object symbol, void *arg)
+{
+ struct appropos_mapper_closure *closure =
+ (struct appropos_mapper_closure *) arg;
+ Bytecount match = fast_lisp_string_match (closure->regexp,
+ Fsymbol_name (symbol));
+
+ if (match >= 0 &&
+ (NILP (closure->predicate) ||
+ !NILP (call1 (closure->predicate, symbol))))
+ closure->accumulation = Fcons (symbol, closure->accumulation);
+
+ return 0;
+}
+
+DEFUN ("apropos-internal", Fapropos_internal, 1, 2, 0, /*
+Show all symbols whose names contain match for REGEXP.
+If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL)
+ is done for each symbol and a symbol is mentioned only if that
+ returns non-nil.
+Return list of symbols found.
+*/
+ (regexp, predicate))
+{
+ struct appropos_mapper_closure closure;
+
+ CHECK_STRING (regexp);
+
+ closure.regexp = regexp;
+ closure.predicate = predicate;
+ closure.accumulation = Qnil;
+ map_obarray (Vobarray, apropos_mapper, &closure);
+ closure.accumulation = Fsort (closure.accumulation, Qstring_lessp);
+ return closure.accumulation;
+}
+
+\f
+/* Extract and set components of symbols */
+
+static void set_up_buffer_local_cache (Lisp_Object sym,
+ struct symbol_value_buffer_local *bfwd,
+ struct buffer *buf,
+ Lisp_Object new_alist_el,
+ int set_it_p);
+
+DEFUN ("boundp", Fboundp, 1, 1, 0, /*
+Return t if SYMBOL's value is not void.
+*/
+ (sym))
+{
+ CHECK_SYMBOL (sym);
+ return UNBOUNDP (find_symbol_value (sym)) ? Qnil : Qt;
+}
+
+DEFUN ("globally-boundp", Fglobally_boundp, 1, 1, 0, /*
+Return t if SYMBOL has a global (non-bound) value.
+This is for the byte-compiler; you really shouldn't be using this.
+*/
+ (sym))
+{
+ CHECK_SYMBOL (sym);
+ return UNBOUNDP (top_level_value (sym)) ? Qnil : Qt;
+}
+
+DEFUN ("fboundp", Ffboundp, 1, 1, 0, /*
+Return t if SYMBOL's function definition is not void.
+*/
+ (sym))
+{
+ CHECK_SYMBOL (sym);
+ return UNBOUNDP (XSYMBOL (sym)->function) ? Qnil : Qt;
+}
+
+/* Return non-zero if SYM's value or function (the current contents of
+ which should be passed in as VAL) is constant, i.e. unsettable. */
+
+static int
+symbol_is_constant (Lisp_Object sym, Lisp_Object val)
+{
+ /* #### - I wonder if it would be better to just have a new magic value
+ type and make nil, t, and all keywords have that same magic
+ constant_symbol value. This test is awfully specific about what is
+ constant and what isn't. --Stig */
+ if (EQ (sym, Qnil) ||
+ EQ (sym, Qt))
+ return 1;
+
+ if (SYMBOL_VALUE_MAGIC_P (val))
+ switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
+ {
+ case SYMVAL_CONST_OBJECT_FORWARD:
+ case SYMVAL_CONST_SPECIFIER_FORWARD:
+ case SYMVAL_CONST_FIXNUM_FORWARD:
+ case SYMVAL_CONST_BOOLEAN_FORWARD:
+ case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
+ case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
+ return 1;
+ default: break; /* Warning suppression */
+ }
+
+ /* We don't return true for keywords here because they are handled
+ specially by reject_constant_symbols(). */
+ return 0;
+}
+
+/* We are setting SYM's value slot (or function slot, if FUNCTION_P is
+ non-zero) to NEWVAL. Make sure this is allowed.
+ FOLLOW_PAST_LISP_MAGIC specifies whether we delve past
+ symbol-value-lisp-magic objects. */
+
+static void
+reject_constant_symbols (Lisp_Object sym, Lisp_Object newval, int function_p,
+ Lisp_Object follow_past_lisp_magic)
+{
+ Lisp_Object val =
+ (function_p ? XSYMBOL (sym)->function
+ : fetch_value_maybe_past_magic (sym, follow_past_lisp_magic));
+
+ if (SYMBOL_VALUE_MAGIC_P (val) &&
+ XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD)
+ signal_simple_error ("Use `set-specifier' to change a specifier's value",
+ sym);
+
+ if (symbol_is_constant (sym, val)
+ || (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym)
+ && !NILP (XSYMBOL (sym)->obarray)))
+ signal_error (Qsetting_constant,
+ UNBOUNDP (newval) ? list1 (sym) : list2 (sym, newval));
+}
+
+/* Verify that it's ok to make SYM buffer-local. This rejects
+ constants and default-buffer-local variables. FOLLOW_PAST_LISP_MAGIC
+ specifies whether we delve into symbol-value-lisp-magic objects.
+ (Should be a symbol indicating what action is being taken; that way,
+ we don't delve if there's a handler for that action, but do otherwise.) */
+
+static void
+verify_ok_for_buffer_local (Lisp_Object sym,
+ Lisp_Object follow_past_lisp_magic)
+{
+ Lisp_Object val = fetch_value_maybe_past_magic (sym, follow_past_lisp_magic);
+
+ if (symbol_is_constant (sym, val))
+ goto not_ok;
+ if (SYMBOL_VALUE_MAGIC_P (val))
+ switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
+ {
+ case SYMVAL_DEFAULT_BUFFER_FORWARD:
+ case SYMVAL_DEFAULT_CONSOLE_FORWARD:
+ /* #### It's theoretically possible for it to be reasonable
+ to have both console-local and buffer-local variables,
+ but I don't want to consider that right now. */
+ case SYMVAL_SELECTED_CONSOLE_FORWARD:
+ goto not_ok;
+ default: break; /* Warning suppression */
+ }
+
+ return;
+
+ not_ok:
+ signal_error (Qerror,
+ list2 (build_string ("Symbol may not be buffer-local"), sym));
+}
+
+DEFUN ("makunbound", Fmakunbound, 1, 1, 0, /*
+Make SYMBOL's value be void.
+*/
+ (sym))
+{
+ Fset (sym, Qunbound);
+ return sym;
+}
+
+DEFUN ("fmakunbound", Ffmakunbound, 1, 1, 0, /*
+Make SYMBOL's function definition be void.
+*/
+ (sym))
+{
+ CHECK_SYMBOL (sym);
+ reject_constant_symbols (sym, Qunbound, 1, Qt);
+ XSYMBOL (sym)->function = Qunbound;
+ return sym;
+}
+
+DEFUN ("symbol-function", Fsymbol_function, 1, 1, 0, /*
+Return SYMBOL's function definition. Error if that is void.
+*/
+ (symbol))
+{
+ CHECK_SYMBOL (symbol);
+ if (UNBOUNDP (XSYMBOL (symbol)->function))
+ return Fsignal (Qvoid_function, list1 (symbol));
+ return XSYMBOL (symbol)->function;
+}
+
+DEFUN ("symbol-plist", Fsymbol_plist, 1, 1, 0, /*
+Return SYMBOL's property list.
+*/
+ (sym))
+{
+ CHECK_SYMBOL (sym);
+ return XSYMBOL (sym)->plist;
+}
+
+DEFUN ("symbol-name", Fsymbol_name, 1, 1, 0, /*
+Return SYMBOL's name, a string.
+*/
+ (sym))
+{
+ Lisp_Object name;
+
+ CHECK_SYMBOL (sym);
+ XSETSTRING (name, XSYMBOL (sym)->name);
+ return name;
+}
+
+DEFUN ("fset", Ffset, 2, 2, 0, /*
+Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
+*/
+ (sym, newdef))
+{
+ /* This function can GC */
+ CHECK_SYMBOL (sym);
+ reject_constant_symbols (sym, newdef, 1, Qt);
+ if (!NILP (Vautoload_queue) && !UNBOUNDP (XSYMBOL (sym)->function))
+ Vautoload_queue = Fcons (Fcons (sym, XSYMBOL (sym)->function),
+ Vautoload_queue);
+ XSYMBOL (sym)->function = newdef;
+ /* Handle automatic advice activation */
+ if (CONSP (XSYMBOL (sym)->plist) && !NILP (Fget (sym, Qad_advice_info,
+ Qnil)))
+ {
+ call2 (Qad_activate, sym, Qnil);
+ newdef = XSYMBOL (sym)->function;
+ }
+ return newdef;
+}
+
+/* FSFmacs */
+DEFUN ("define-function", Fdefine_function, 2, 2, 0, /*
+Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
+Associates the function with the current load file, if any.
+*/
+ (sym, newdef))
+{
+ /* This function can GC */
+ CHECK_SYMBOL (sym);
+ Ffset (sym, newdef);
+ LOADHIST_ATTACH (sym);
+ return newdef;
+}
+
+
+DEFUN ("setplist", Fsetplist, 2, 2, 0, /*
+Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.
+*/
+ (sym, newplist))
+{
+ CHECK_SYMBOL (sym);
+#if 0 /* Inserted for debugging 6/28/1997 -slb */
+ /* Somebody is setting a property list of integer 0, who? */
+ /* Not this way apparently. */
+ if (EQ(newplist, Qzero)) abort();
+#endif
+
+ XSYMBOL (sym)->plist = newplist;
+ return newplist;
+}
+
+\f
+/**********************************************************************/
+/* symbol-value */
+/**********************************************************************/
+
+/* If the contents of the value cell of a symbol is one of the following
+ three types of objects, then the symbol is "magic" in that setting
+ and retrieving its value doesn't just set or retrieve the raw
+ contents of the value cell. None of these objects can escape to
+ the user level, so there is no loss of generality.
+
+ If a symbol is "unbound", then the contents of its value cell is
+ Qunbound. Despite appearances, this is *not* a symbol, but is a
+ symbol-value-forward object. This is so that printing it results
+ in "INTERNAL EMACS BUG", in case it leaks to Lisp, somehow.
+
+ Logically all of the following objects are "symbol-value-magic"
+ objects, and there are some games played w.r.t. this (#### this
+ should be cleaned up). SYMBOL_VALUE_MAGIC_P is true for all of
+ the object types. XSYMBOL_VALUE_MAGIC_TYPE returns the type of
+ symbol-value-magic object. There are more than three types
+ returned by this macro: in particular, symbol-value-forward
+ has eight subtypes, and symbol-value-buffer-local has two. See
+ symeval.h.
+
+ 1. symbol-value-forward
+
+ symbol-value-forward is used for variables whose actual contents
+ are stored in a C variable of some sort, and for Qunbound. The
+ lcheader.next field (which is only used to chain together free
+ lcrecords) holds a pointer to the actual C variable. Included
+ in this type are "buffer-local" variables that are actually
+ stored in the buffer object itself; in this case, the "pointer"
+ is an offset into the struct buffer structure.
+
+ The subtypes are as follows:
+
+ SYMVAL_OBJECT_FORWARD:
+ (declare with DEFVAR_LISP)
+ The value of this variable is stored in a C variable of type
+ "Lisp_Object". Setting this variable sets the C variable.
+ Accessing this variable retrieves a value from the C variable.
+ These variables can be buffer-local -- in this case, the
+ raw symbol-value field gets converted into a
+ symbol-value-buffer-local, whose "current_value" slot contains
+ the symbol-value-forward. (See below.)
+
+ SYMVAL_FIXNUM_FORWARD:
+ SYMVAL_BOOLEAN_FORWARD:
+ (declare with DEFVAR_INT or DEFVAR_BOOL)
+ Similar to SYMVAL_OBJECT_FORWARD except that the C variable
+ is of type "int" and is an integer or boolean, respectively.
+
+ SYMVAL_CONST_OBJECT_FORWARD:
+ SYMVAL_CONST_FIXNUM_FORWARD:
+ SYMVAL_CONST_BOOLEAN_FORWARD:
+ (declare with DEFVAR_CONST_LISP, DEFVAR_CONST_INT, or
+ DEFVAR_CONST_BOOL)
+ Similar to SYMVAL_OBJECT_FORWARD, SYMVAL_FIXNUM_FORWARD, or
+ SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot
+ be changed.
+
+ 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
+ `set-specifier' instead.
+
+ SYMVAL_CURRENT_BUFFER_FORWARD:
+ (declare with DEFVAR_BUFFER_LOCAL)
+ This is used for built-in buffer-local variables -- i.e.
+ Lisp variables whose value is stored in the "struct buffer".
+ Variables of this sort always forward into C "Lisp_Object"
+ fields (although there's no reason in principle that other
+ types for ints and booleans couldn't be added). Note that
+ some of these variables are automatically local in each
+ buffer, while some are only local when they become set
+ (similar to `make-variable-buffer-local'). In these latter
+ cases, of course, the default value shows through in all
+ buffers in which the variable doesn't have a local value.
+ This is implemented by making sure the "struct buffer" field
+ always contains the correct value (whether it's local or
+ a default) and maintaining a mask in the "struct buffer"
+ indicating which fields are local. When `set-default' is
+ called on a variable that's not always local to all buffers,
+ it loops through each buffer and sets the corresponding
+ field in each buffer without a local value for the field,
+ according to the mask.
+
+ Calling `make-local-variable' on a variable of this sort
+ only has the effect of maybe changing the current buffer's mask.
+ Calling `make-variable-buffer-local' on a variable of this
+ sort has no effect at all.
+
+ SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
+ (declare with DEFVAR_CONST_BUFFER_LOCAL)
+ Same as SYMVAL_CURRENT_BUFFER_FORWARD except that the
+ value cannot be set.
+
+ SYMVAL_DEFAULT_BUFFER_FORWARD:
+ (declare with DEFVAR_BUFFER_DEFAULTS)
+ This is used for the Lisp variables that contain the
+ default values of built-in buffer-local variables. Setting
+ or referencing one of these variables forwards into a slot
+ in the special struct buffer Vbuffer_defaults.
+
+ SYMVAL_UNBOUND_MARKER:
+ This is used for only one object, Qunbound.
+
+ SYMVAL_SELECTED_CONSOLE_FORWARD:
+ (declare with DEFVAR_CONSOLE_LOCAL)
+ This is used for built-in console-local variables -- i.e.
+ Lisp variables whose value is stored in the "struct console".
+ These work just like built-in buffer-local variables.
+ However, calling `make-local-variable' or
+ `make-variable-buffer-local' on one of these variables
+ is currently disallowed because that would entail having
+ both console-local and buffer-local variables, which is
+ trickier to implement.
+
+ SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
+ (declare with DEFVAR_CONST_CONSOLE_LOCAL)
+ Same as SYMVAL_SELECTED_CONSOLE_FORWARD except that the
+ value cannot be set.
+
+ SYMVAL_DEFAULT_CONSOLE_FORWARD:
+ (declare with DEFVAR_CONSOLE_DEFAULTS)
+ This is used for the Lisp variables that contain the
+ default values of built-in console-local variables. Setting
+ or referencing one of these variables forwards into a slot
+ in the special struct console Vconsole_defaults.
+
+
+ 2. symbol-value-buffer-local
+
+ symbol-value-buffer-local is used for variables that have had
+ `make-local-variable' or `make-variable-buffer-local' applied
+ to them. This object contains an alist mapping buffers to
+ values. In addition, the object contains a "current value",
+ which is the value in some buffer. Whenever you access the
+ variable with `symbol-value' or set it with `set' or `setq',
+ things are switched around so that the "current value"
+ refers to the current buffer, if it wasn't already. This
+ way, repeated references to a variable in the same buffer
+ are almost as efficient as if the variable weren't buffer
+ local. Note that the alist may not be up-to-date w.r.t.
+ the buffer whose value is current, as the "current value"
+ cache is normally only flushed into the alist when the
+ buffer it refers to changes.
+
+ Note also that it is possible for `make-local-variable'
+ or `make-variable-buffer-local' to be called on a variable
+ that forwards into a C variable (i.e. a variable whose
+ value cell is a symbol-value-forward). In this case,
+ the value cell becomes a symbol-value-buffer-local (as
+ always), and the symbol-value-forward moves into
+ the "current value" cell in this object. Also, in
+ this case the "current value" *always* refers to the
+ current buffer, so that the values of the C variable
+ always is the correct value for the current buffer.
+ set_buffer_internal() automatically updates the current-value
+ cells of all buffer-local variables that forward into C
+ variables. (There is a list of all buffer-local variables
+ that is maintained for this and other purposes.)
+
+ Note that only certain types of `symbol-value-forward' objects
+ can find their way into the "current value" cell of a
+ `symbol-value-buffer-local' object: SYMVAL_OBJECT_FORWARD,
+ SYMVAL_FIXNUM_FORWARD, SYMVAL_BOOLEAN_FORWARD, and
+ SYMVAL_UNBOUND_MARKER. The SYMVAL_CONST_*_FORWARD cannot
+ be buffer-local because they are unsettable;
+ SYMVAL_DEFAULT_*_FORWARD cannot be buffer-local because that
+ makes no sense; making SYMVAL_CURRENT_BUFFER_FORWARD buffer-local
+ does not have much of an effect (it's already buffer-local); and
+ SYMVAL_SELECTED_CONSOLE_FORWARD cannot be buffer-local because
+ that's not currently implemented.
+
+
+ 3. symbol-value-varalias
+
+ A symbol-value-varalias object is used for variables that
+ are aliases for other variables. This object contains
+ the symbol that this variable is aliased to.
+ symbol-value-varalias objects cannot occur anywhere within
+ a symbol-value-buffer-local object, and most of the
+ low-level functions below do not accept them; you need
+ to call follow_varalias_pointers to get the actual
+ symbol to operate on. */
+
+static Lisp_Object
+mark_symbol_value_buffer_local (Lisp_Object obj,
+ void (*markobj) (Lisp_Object))
+{
+ struct symbol_value_buffer_local *bfwd;
+
+ assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_BUFFER_LOCAL ||
+ XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_SOME_BUFFER_LOCAL);
+
+ bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (obj);
+ ((markobj) (bfwd->default_value));
+ ((markobj) (bfwd->current_value));
+ ((markobj) (bfwd->current_buffer));
+ return bfwd->current_alist_element;
+}
+
+static Lisp_Object
+mark_symbol_value_lisp_magic (Lisp_Object obj,
+ void (*markobj) (Lisp_Object))
+{
+ struct symbol_value_lisp_magic *bfwd;
+ int i;
+
+ assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_LISP_MAGIC);
+
+ bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj);
+ for (i = 0; i < MAGIC_HANDLER_MAX; i++)
+ {
+ ((markobj) (bfwd->handler[i]));
+ ((markobj) (bfwd->harg[i]));
+ }
+ return bfwd->shadowed;
+}
+
+static Lisp_Object
+mark_symbol_value_varalias (Lisp_Object obj,
+ void (*markobj) (Lisp_Object))
+{
+ struct symbol_value_varalias *bfwd;
+
+ assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS);
+
+ bfwd = XSYMBOL_VALUE_VARALIAS (obj);
+ ((markobj) (bfwd->shadowed));
+ return bfwd->aliasee;
+}
+
+/* Should never, ever be called. (except by an external debugger) */
+void
+print_symbol_value_magic (Lisp_Object obj,
+ Lisp_Object printcharfun, int escapeflag)
+{
+ char buf[200];
+ sprintf (buf, "#<INTERNAL EMACS BUG (%s type %d) 0x%p>",
+ XRECORD_LHEADER_IMPLEMENTATION (obj)->name,
+ XSYMBOL_VALUE_MAGIC_TYPE (obj),
+ (void *) XPNTR (obj));
+ write_c_string (buf, printcharfun);
+}
+
+DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward",
+ symbol_value_forward,
+ this_one_is_unmarkable,
+ print_symbol_value_magic, 0, 0, 0,
+ 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,
+ 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,
+ 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,
+ struct symbol_value_varalias);
+
+\f
+/* Getting and setting values of symbols */
+
+/* Given the raw contents of a symbol value cell, return the Lisp value of
+ the symbol. However, VALCONTENTS cannot be a symbol-value-buffer-local,
+ symbol-value-lisp-magic, or symbol-value-varalias.
+
+ BUFFER specifies a buffer, and is used for built-in buffer-local
+ variables, which are of type SYMVAL_CURRENT_BUFFER_FORWARD.
+ Note that such variables are never encapsulated in a
+ symbol-value-buffer-local structure.
+
+ CONSOLE specifies a console, and is used for built-in console-local
+ variables, which are of type SYMVAL_SELECTED_CONSOLE_FORWARD.
+ Note that such variables are (currently) never encapsulated in a
+ symbol-value-buffer-local structure.
+ */
+
+static Lisp_Object
+do_symval_forwarding (Lisp_Object valcontents, struct buffer *buffer,
+ struct console *console)
+{
+ CONST struct symbol_value_forward *fwd;
+
+ if (!SYMBOL_VALUE_MAGIC_P (valcontents))
+ return valcontents;
+
+ fwd = XSYMBOL_VALUE_FORWARD (valcontents);
+ switch (fwd->magic.type)
+ {
+ case SYMVAL_FIXNUM_FORWARD:
+ case SYMVAL_CONST_FIXNUM_FORWARD:
+ return make_int (*((int *)symbol_value_forward_forward (fwd)));
+
+ case SYMVAL_BOOLEAN_FORWARD:
+ case SYMVAL_CONST_BOOLEAN_FORWARD:
+ return *((int *)symbol_value_forward_forward (fwd)) ? Qt : Qnil;
+
+ case SYMVAL_OBJECT_FORWARD:
+ case SYMVAL_CONST_OBJECT_FORWARD:
+ case SYMVAL_CONST_SPECIFIER_FORWARD:
+ return *((Lisp_Object *)symbol_value_forward_forward (fwd));
+
+ case SYMVAL_DEFAULT_BUFFER_FORWARD:
+ return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
+ + ((char *)symbol_value_forward_forward (fwd)
+ - (char *)&buffer_local_flags))));
+
+
+ case SYMVAL_CURRENT_BUFFER_FORWARD:
+ case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
+ assert (buffer);
+ return (*((Lisp_Object *)((char *)buffer
+ + ((char *)symbol_value_forward_forward (fwd)
+ - (char *)&buffer_local_flags))));
+
+ case SYMVAL_DEFAULT_CONSOLE_FORWARD:
+ return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
+ + ((char *)symbol_value_forward_forward (fwd)
+ - (char *)&console_local_flags))));
+
+ case SYMVAL_SELECTED_CONSOLE_FORWARD:
+ case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
+ assert (console);
+ return (*((Lisp_Object *)((char *)console
+ + ((char *)symbol_value_forward_forward (fwd)
+ - (char *)&console_local_flags))));
+
+ case SYMVAL_UNBOUND_MARKER:
+ return valcontents;
+
+ default:
+ abort ();
+ }
+ return Qnil; /* suppress compiler warning */
+}
+
+/* Set the value of default-buffer-local variable SYM to VALUE. */
+
+static void
+set_default_buffer_slot_variable (Lisp_Object sym,
+ Lisp_Object value)
+{
+ /* Handle variables like case-fold-search that have special slots in
+ the buffer. Make them work apparently like buffer_local variables.
+ */
+ /* At this point, the value cell may not contain a symbol-value-varalias
+ 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
+ = XSYMBOL_VALUE_FORWARD (valcontents);
+ int offset = ((char *) symbol_value_forward_forward (fwd)
+ - (char *) &buffer_local_flags);
+ int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
+ int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
+ int flags) = symbol_value_forward_magicfun (fwd);
+
+ *((Lisp_Object *) (offset + (char *) XBUFFER (Vbuffer_defaults)))
+ = value;
+
+ if (mask > 0) /* Not always per-buffer */
+ {
+ Lisp_Object tail;
+
+ /* Set value in each buffer which hasn't shadowed the default */
+ LIST_LOOP (tail, Vbuffer_alist)
+ {
+ struct buffer *b = XBUFFER (XCDR (XCAR (tail)));
+ if (!(b->local_var_flags & mask))
+ {
+ if (magicfun)
+ (magicfun) (sym, &value, make_buffer (b), 0);
+ *((Lisp_Object *) (offset + (char *) b)) = value;
+ }
+ }
+ }
+}
+
+/* Set the value of default-console-local variable SYM to VALUE. */
+
+static void
+set_default_console_slot_variable (Lisp_Object sym,
+ Lisp_Object value)
+{
+ /* Handle variables like case-fold-search that have special slots in
+ the console. Make them work apparently like console_local variables.
+ */
+ /* At this point, the value cell may not contain a symbol-value-varalias
+ 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
+ = XSYMBOL_VALUE_FORWARD (valcontents);
+ int offset = ((char *) symbol_value_forward_forward (fwd)
+ - (char *) &console_local_flags);
+ int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
+ int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
+ int flags) = symbol_value_forward_magicfun (fwd);
+
+ *((Lisp_Object *) (offset + (char *) XCONSOLE (Vconsole_defaults)))
+ = value;
+
+ if (mask > 0) /* Not always per-console */
+ {
+ Lisp_Object tail;
+
+ /* Set value in each console which hasn't shadowed the default */
+ LIST_LOOP (tail, Vconsole_list)
+ {
+ Lisp_Object dev = XCAR (tail);
+ struct console *d = XCONSOLE (dev);
+ if (!(d->local_var_flags & mask))
+ {
+ if (magicfun)
+ (magicfun) (sym, &value, dev, 0);
+ *((Lisp_Object *) (offset + (char *) d)) = value;
+ }
+ }
+ }
+}
+
+/* Store NEWVAL into SYM.
+
+ SYM's value slot may *not* be types (5) or (6) above,
+ i.e. no symbol-value-varalias objects. (You should have
+ forwarded past all of these.)
+
+ SYM should not be an unsettable symbol or a symbol with
+ a magic `set-value' handler (unless you want to explicitly
+ ignore this handler).
+
+ OVALUE is the current value of SYM, but forwarded past any
+ symbol-value-buffer-local and symbol-value-lisp-magic objects.
+ (i.e. if SYM is a symbol-value-buffer-local, OVALUE should be
+ the contents of its current-value cell.) NEWVAL may only be
+ a simple value or Qunbound. If SYM is a symbol-value-buffer-local,
+ this function will only modify its current-value cell, which should
+ already be set up to point to the current buffer.
+ */
+
+static void
+store_symval_forwarding (Lisp_Object sym, Lisp_Object ovalue,
+ Lisp_Object newval)
+{
+ if (!SYMBOL_VALUE_MAGIC_P (ovalue) || UNBOUNDP (ovalue))
+ {
+ Lisp_Object *store_pointer = value_slot_past_magic (sym);
+
+ if (SYMBOL_VALUE_BUFFER_LOCAL_P (*store_pointer))
+ store_pointer =
+ &XSYMBOL_VALUE_BUFFER_LOCAL (*store_pointer)->current_value;
+
+ assert (UNBOUNDP (*store_pointer)
+ || !SYMBOL_VALUE_MAGIC_P (*store_pointer));
+ *store_pointer = newval;
+ }
+
+ else
+ {
+ CONST struct symbol_value_forward *fwd
+ = XSYMBOL_VALUE_FORWARD (ovalue);
+ int type = XSYMBOL_VALUE_MAGIC_TYPE (ovalue);
+ int (*magicfun) (Lisp_Object simm, Lisp_Object *val,
+ Lisp_Object in_object, int flags) =
+ symbol_value_forward_magicfun (fwd);
+
+ switch (type)
+ {
+ case SYMVAL_FIXNUM_FORWARD:
+ {
+ CHECK_INT (newval);
+ if (magicfun)
+ (magicfun) (sym, &newval, Qnil, 0);
+ *((int *) symbol_value_forward_forward (fwd)) = XINT (newval);
+ return;
+ }
+
+ case SYMVAL_BOOLEAN_FORWARD:
+ {
+ if (magicfun)
+ (magicfun) (sym, &newval, Qnil, 0);
+ *((int *) symbol_value_forward_forward (fwd))
+ = ((NILP (newval)) ? 0 : 1);
+ return;
+ }
+
+ case SYMVAL_OBJECT_FORWARD:
+ {
+ if (magicfun)
+ (magicfun) (sym, &newval, Qnil, 0);
+ *((Lisp_Object *) symbol_value_forward_forward (fwd)) = newval;
+ return;
+ }
+
+ case SYMVAL_DEFAULT_BUFFER_FORWARD:
+ {
+ set_default_buffer_slot_variable (sym, newval);
+ return;
+ }
+
+ case SYMVAL_CURRENT_BUFFER_FORWARD:
+ {
+ if (magicfun)
+ (magicfun) (sym, &newval, make_buffer (current_buffer), 0);
+ *((Lisp_Object *) ((char *) current_buffer
+ + ((char *) symbol_value_forward_forward (fwd)
+ - (char *) &buffer_local_flags)))
+ = newval;
+ return;
+ }
+
+ case SYMVAL_DEFAULT_CONSOLE_FORWARD:
+ {
+ set_default_console_slot_variable (sym, newval);
+ return;
+ }
+
+ case SYMVAL_SELECTED_CONSOLE_FORWARD:
+ {
+ if (magicfun)
+ (magicfun) (sym, &newval, Vselected_console, 0);
+ *((Lisp_Object *) ((char *) XCONSOLE (Vselected_console)
+ + ((char *) symbol_value_forward_forward (fwd)
+ - (char *) &console_local_flags)))
+ = newval;
+ return;
+ }
+
+ default:
+ abort ();
+ }
+ }
+}
+
+/* Given a per-buffer variable SYMBOL and its raw value-cell contents
+ BFWD, locate and return a pointer to the element in BUFFER's
+ local_var_alist for SYMBOL. The return value will be Qnil if
+ BUFFER does not have its own value for SYMBOL (i.e. the default
+ value is seen in that buffer).
+ */
+
+static Lisp_Object
+buffer_local_alist_element (struct buffer *buffer, Lisp_Object symbol,
+ struct symbol_value_buffer_local *bfwd)
+{
+ if (!NILP (bfwd->current_buffer) &&
+ XBUFFER (bfwd->current_buffer) == buffer)
+ /* This is just an optimization of the below. */
+ return bfwd->current_alist_element;
+ else
+ return assq_no_quit (symbol, buffer->local_var_alist);
+}
+
+/* [Remember that the slot that mirrors CURRENT-VALUE in the
+ symbol-value-buffer-local of a per-buffer variable -- i.e. the
+ slot in CURRENT-BUFFER's local_var_alist, or the DEFAULT-VALUE
+ slot -- may be out of date.]
+
+ Write out any cached value in buffer-local variable SYMBOL's
+ buffer-local structure, which is passed in as BFWD.
+*/
+
+static void
+write_out_buffer_local_cache (Lisp_Object symbol,
+ struct symbol_value_buffer_local *bfwd)
+{
+ if (!NILP (bfwd->current_buffer))
+ {
+ /* We pass 0 for BUFFER because only SYMVAL_CURRENT_BUFFER_FORWARD
+ uses it, and that type cannot be inside a symbol-value-buffer-local */
+ Lisp_Object cval = do_symval_forwarding (bfwd->current_value, 0, 0);
+ if (NILP (bfwd->current_alist_element))
+ /* current_value may be updated more recently than default_value */
+ bfwd->default_value = cval;
+ else
+ Fsetcdr (bfwd->current_alist_element, cval);
+ }
+}
+
+/* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
+ Set up BFWD's cache for validity in buffer BUF. This assumes that
+ the cache is currently in a consistent state (this can include
+ not having any value cached, if BFWD->CURRENT_BUFFER is nil).
+
+ If the cache is already set up for BUF, this function does nothing
+ at all.
+
+ Otherwise, if SYM forwards out to a C variable, this also forwards
+ SYM's value in BUF out to the variable. Therefore, you generally
+ only want to call this when BUF is, or is about to become, the
+ current buffer.
+
+ (Otherwise, you can just retrieve the value without changing the
+ cache, at the expense of slower retrieval.)
+*/
+
+static void
+set_up_buffer_local_cache (Lisp_Object sym,
+ struct symbol_value_buffer_local *bfwd,
+ struct buffer *buf,
+ Lisp_Object new_alist_el,
+ int set_it_p)
+{
+ Lisp_Object new_val;
+
+ if (!NILP (bfwd->current_buffer)
+ && buf == XBUFFER (bfwd->current_buffer))
+ /* Cache is already set up. */
+ return;
+
+ /* Flush out the old cache. */
+ write_out_buffer_local_cache (sym, bfwd);
+
+ /* Retrieve the new alist element and new value. */
+ if (NILP (new_alist_el)
+ && set_it_p)
+ new_alist_el = buffer_local_alist_element (buf, sym, bfwd);
+
+ if (NILP (new_alist_el))
+ new_val = bfwd->default_value;
+ else
+ new_val = Fcdr (new_alist_el);
+
+ bfwd->current_alist_element = new_alist_el;
+ XSETBUFFER (bfwd->current_buffer, buf);
+
+ /* Now store the value into the current-value slot.
+ We don't simply write it there, because the current-value
+ slot might be a forwarding pointer, in which case we need
+ to instead write the value into the C variable.
+
+ We might also want to call a magic function.
+
+ So instead, we call this function. */
+ store_symval_forwarding (sym, bfwd->current_value, new_val);
+}
+
+\f
+void
+kill_buffer_local_variables (struct buffer *buf)
+{
+ Lisp_Object prev = Qnil;
+ Lisp_Object alist;
+
+ /* Any which are supposed to be permanent,
+ make local again, with the same values they had. */
+
+ for (alist = buf->local_var_alist; !NILP (alist); alist = XCDR (alist))
+ {
+ Lisp_Object sym = XCAR (XCAR (alist));
+ struct symbol_value_buffer_local *bfwd;
+ /* Variables with a symbol-value-varalias should not be here
+ (we should have forwarded past them) and there must be a
+ symbol-value-buffer-local. If there's a symbol-value-lisp-magic,
+ just forward past it; if the variable has a handler, it was
+ already called. */
+ Lisp_Object value = fetch_value_maybe_past_magic (sym, Qt);
+
+ assert (SYMBOL_VALUE_BUFFER_LOCAL_P (value));
+ bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (value);
+
+ if (!NILP (Fget (sym, Qpermanent_local, Qnil)))
+ /* prev points to the last alist element that is still
+ staying around, so *only* update it now. This didn't
+ used to be the case; this bug has been around since
+ mly's rewrite two years ago! */
+ prev = alist;
+ else
+ {
+ /* Really truly kill it. */
+ if (!NILP (prev))
+ XCDR (prev) = XCDR (alist);
+ else
+ buf->local_var_alist = XCDR (alist);
+
+ /* We just effectively changed the value for this variable
+ in BUF. So: */
+
+ /* (1) If the cache is caching BUF, invalidate the cache. */
+ if (!NILP (bfwd->current_buffer) &&
+ buf == XBUFFER (bfwd->current_buffer))
+ bfwd->current_buffer = Qnil;
+
+ /* (2) If we changed the value in current_buffer and this
+ variable forwards to a C variable, we need to change the
+ value of the C variable. set_up_buffer_local_cache()
+ will do this. It doesn't hurt to do it whenever
+ BUF == current_buffer, so just go ahead and do that. */
+ if (buf == current_buffer)
+ set_up_buffer_local_cache (sym, bfwd, buf, Qnil, 0);
+ }
+ }
+}
+\f
+static Lisp_Object
+find_symbol_value_1 (Lisp_Object sym, struct buffer *buf,
+ struct console *con, int swap_it_in,
+ Lisp_Object symcons, int set_it_p)
+{
+ Lisp_Object valcontents;
+
+ retry:
+ valcontents = XSYMBOL (sym)->value;
+
+ retry_2:
+ if (!SYMBOL_VALUE_MAGIC_P (valcontents))
+ return valcontents;
+
+ switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
+ {
+ case SYMVAL_LISP_MAGIC:
+ /* #### kludge */
+ valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
+ /* semi-change-o */
+ goto retry_2;
+
+ case SYMVAL_VARALIAS:
+ sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
+ symcons = Qnil;
+ /* presto change-o! */
+ goto retry;
+
+ case SYMVAL_BUFFER_LOCAL:
+ case SYMVAL_SOME_BUFFER_LOCAL:
+ {
+ struct symbol_value_buffer_local *bfwd
+ = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
+
+ if (swap_it_in)
+ {
+ set_up_buffer_local_cache (sym, bfwd, buf, symcons, set_it_p);
+ valcontents = bfwd->current_value;
+ }
+ else
+ {
+ if (!NILP (bfwd->current_buffer) &&
+ buf == XBUFFER (bfwd->current_buffer))
+ valcontents = bfwd->current_value;
+ else if (NILP (symcons))
+ {
+ if (set_it_p)
+ valcontents = assq_no_quit (sym, buf->local_var_alist);
+ if (NILP (valcontents))
+ valcontents = bfwd->default_value;
+ else
+ valcontents = XCDR (valcontents);
+ }
+ else
+ valcontents = XCDR (symcons);
+ }
+ break;
+ }
+
+ default:
+ break;
+ }
+ return do_symval_forwarding (valcontents, buf, con);
+}
+
+
+/* Find the value of a symbol in BUFFER, returning Qunbound if it's not
+ bound. Note that it must not be possible to QUIT within this
+ function. */
+
+Lisp_Object
+symbol_value_in_buffer (Lisp_Object sym, Lisp_Object buffer)
+{
+ struct buffer *buf;
+
+ CHECK_SYMBOL (sym);
+
+ if (!NILP (buffer))
+ {
+ CHECK_BUFFER (buffer);
+ buf = XBUFFER (buffer);
+ }
+ else
+ buf = current_buffer;
+
+ return find_symbol_value_1 (sym, buf,
+ /* If it bombs out at startup due to a
+ Lisp error, this may be nil. */
+ CONSOLEP (Vselected_console)
+ ? XCONSOLE (Vselected_console) : 0, 0, Qnil, 1);
+}
+
+static Lisp_Object
+symbol_value_in_console (Lisp_Object sym, Lisp_Object console)
+{
+ CHECK_SYMBOL (sym);
+
+ if (!NILP (console))
+ CHECK_CONSOLE (console);
+ else
+ console = Vselected_console;
+
+ return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0,
+ Qnil, 1);
+}
+
+/* Return the current value of SYM. The difference between this function
+ and calling symbol_value_in_buffer with a BUFFER of Qnil is that
+ this updates the CURRENT_VALUE slot of buffer-local variables to
+ point to the current buffer, while symbol_value_in_buffer doesn't. */
+
+Lisp_Object
+find_symbol_value (Lisp_Object sym)
+{
+ /* WARNING: This function can be called when current_buffer is 0
+ and Vselected_console is Qnil, early in initialization. */
+ struct console *dev;
+ Lisp_Object valcontents;
+
+ CHECK_SYMBOL (sym);
+
+ valcontents = XSYMBOL (sym)->value;
+ if (!SYMBOL_VALUE_MAGIC_P (valcontents))
+ return valcontents;
+
+ if (CONSOLEP (Vselected_console))
+ dev = XCONSOLE (Vselected_console);
+ else
+ {
+ /* 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? */
+ assert (!initialized || preparing_for_armageddon);
+ dev = 0;
+ }
+
+ return find_symbol_value_1 (sym, current_buffer, dev, 1, Qnil, 1);
+}
+
+/* This is an optimized function for quick lookup of buffer local symbols
+ by avoiding O(n) search. This will work when either:
+ a) We have already found the symbol e.g. by traversing local_var_alist.
+ or
+ b) We know that the symbol will not be found in the current buffer's
+ list of local variables.
+ In the former case, find_it_p is 1 and symbol_cons is the element from
+ local_var_alist. In the latter case, find_it_p is 0 and symbol_cons
+ is the symbol.
+
+ This function is called from set_buffer_internal which does both of these
+ things. */
+
+Lisp_Object
+find_symbol_value_quickly (Lisp_Object symbol_cons, int find_it_p)
+{
+ /* WARNING: This function can be called when current_buffer is 0
+ and Vselected_console is Qnil, early in initialization. */
+ struct console *dev;
+ Lisp_Object sym = find_it_p ? XCAR (symbol_cons) : symbol_cons;
+
+ CHECK_SYMBOL (sym);
+ if (CONSOLEP (Vselected_console))
+ dev = XCONSOLE (Vselected_console);
+ else
+ {
+ /* 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? */
+ assert (!initialized || preparing_for_armageddon);
+ dev = 0;
+ }
+
+ return find_symbol_value_1 (sym, current_buffer, dev, 1,
+ find_it_p ? symbol_cons : Qnil,
+ find_it_p);
+}
+
+DEFUN ("symbol-value", Fsymbol_value, 1, 1, 0, /*
+Return SYMBOL's value. Error if that is void.
+*/
+ (sym))
+{
+ Lisp_Object val = find_symbol_value (sym);
+
+ if (UNBOUNDP (val))
+ return Fsignal (Qvoid_variable, list1 (sym));
+ else
+ return val;
+}
+
+DEFUN ("set", Fset, 2, 2, 0, /*
+Set SYMBOL's value to NEWVAL, and return NEWVAL.
+*/
+ (sym, newval))
+{
+ REGISTER Lisp_Object valcontents;
+ /* remember, we're called by Fmakunbound() as well */
+
+ CHECK_SYMBOL (sym);
+
+ retry:
+ valcontents = XSYMBOL (sym)->value;
+ if (NILP (sym) || EQ (sym, Qt) || SYMBOL_VALUE_MAGIC_P (valcontents)
+ || SYMBOL_IS_KEYWORD (sym))
+ reject_constant_symbols (sym, newval, 0,
+ UNBOUNDP (newval) ? Qmakunbound : Qset);
+ else
+ {
+ XSYMBOL (sym)->value = newval;
+ return newval;
+ }
+
+ retry_2:
+
+ if (SYMBOL_VALUE_MAGIC_P (valcontents))
+ {
+ switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
+ {
+ case SYMVAL_LISP_MAGIC:
+ {
+ Lisp_Object retval;
+
+ if (UNBOUNDP (newval))
+ retval = maybe_call_magic_handler (sym, Qmakunbound, 0);
+ else
+ retval = maybe_call_magic_handler (sym, Qset, 1, newval);
+ if (!UNBOUNDP (retval))
+ return newval;
+ valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
+ /* semi-change-o */
+ goto retry_2;
+ }
+
+ case SYMVAL_VARALIAS:
+ sym = follow_varalias_pointers (sym,
+ UNBOUNDP (newval)
+ ? Qmakunbound : Qset);
+ /* presto change-o! */
+ goto retry;
+
+ case SYMVAL_FIXNUM_FORWARD:
+ case SYMVAL_BOOLEAN_FORWARD:
+ case SYMVAL_OBJECT_FORWARD:
+ case SYMVAL_DEFAULT_BUFFER_FORWARD:
+ case SYMVAL_DEFAULT_CONSOLE_FORWARD:
+ if (UNBOUNDP (newval))
+ signal_error (Qerror,
+ list2 (build_string ("Cannot makunbound"), sym));
+ break;
+
+ case SYMVAL_UNBOUND_MARKER:
+ break;
+
+ case SYMVAL_CURRENT_BUFFER_FORWARD:
+ {
+ CONST struct symbol_value_forward *fwd
+ = XSYMBOL_VALUE_FORWARD (valcontents);
+ int mask = XINT (*((Lisp_Object *)
+ symbol_value_forward_forward (fwd)));
+ if (mask > 0)
+ /* Setting this variable makes it buffer-local */
+ current_buffer->local_var_flags |= mask;
+ break;
+ }
+
+ case SYMVAL_SELECTED_CONSOLE_FORWARD:
+ {
+ CONST struct symbol_value_forward *fwd
+ = XSYMBOL_VALUE_FORWARD (valcontents);
+ int mask = XINT (*((Lisp_Object *)
+ symbol_value_forward_forward (fwd)));
+ if (mask > 0)
+ /* Setting this variable makes it console-local */
+ XCONSOLE (Vselected_console)->local_var_flags |= mask;
+ break;
+ }
+
+ case SYMVAL_BUFFER_LOCAL:
+ case SYMVAL_SOME_BUFFER_LOCAL:
+ {
+ /* If we want to examine or set the value and
+ CURRENT-BUFFER is current, we just examine or set
+ CURRENT-VALUE. If CURRENT-BUFFER is not current, we
+ store the current CURRENT-VALUE value into
+ CURRENT-ALIST- ELEMENT, then find the appropriate alist
+ element for the buffer now current and set up
+ CURRENT-ALIST-ELEMENT. Then we set CURRENT-VALUE out
+ of that element, and store into CURRENT-BUFFER.
+
+ If we are setting the variable and the current buffer does
+ not have an alist entry for this variable, an alist entry is
+ created.
+
+ Note that CURRENT-VALUE can be a forwarding pointer.
+ Each time it is examined or set, forwarding must be
+ done. */
+ struct symbol_value_buffer_local *bfwd
+ = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
+ int some_buffer_local_p =
+ (bfwd->magic.type == SYMVAL_SOME_BUFFER_LOCAL);
+ /* What value are we caching right now? */
+ Lisp_Object aelt = bfwd->current_alist_element;
+
+ if (!NILP (bfwd->current_buffer) &&
+ current_buffer == XBUFFER (bfwd->current_buffer)
+ && ((some_buffer_local_p)
+ ? 1 /* doesn't automatically become local */
+ : !NILP (aelt) /* already local */
+ ))
+ {
+ /* Cache is valid */
+ valcontents = bfwd->current_value;
+ }
+ else
+ {
+ /* If the current buffer is not the buffer whose binding is
+ currently cached, or if it's a SYMVAL_BUFFER_LOCAL and
+ we're looking at the default value, the cache is invalid; we
+ need to write it out, and find the new CURRENT-ALIST-ELEMENT
+ */
+
+ /* Write out the cached value for the old buffer; copy it
+ back to its alist element. This works if the current
+ buffer only sees the default value, too. */
+ write_out_buffer_local_cache (sym, bfwd);
+
+ /* Find the new value for CURRENT-ALIST-ELEMENT. */
+ aelt = buffer_local_alist_element (current_buffer, sym, bfwd);
+ if (NILP (aelt))
+ {
+ /* This buffer is still seeing the default value. */
+ if (!some_buffer_local_p)
+ {
+ /* If it's a SYMVAL_BUFFER_LOCAL, give this buffer a
+ new assoc for a local value and set
+ CURRENT-ALIST-ELEMENT to point to that. */
+ aelt =
+ do_symval_forwarding (bfwd->current_value,
+ current_buffer,
+ XCONSOLE (Vselected_console));
+ aelt = Fcons (sym, aelt);
+ current_buffer->local_var_alist
+ = Fcons (aelt, current_buffer->local_var_alist);
+ }
+ else
+ {
+ /* If the variable is a SYMVAL_SOME_BUFFER_LOCAL,
+ we're currently seeing the default value. */
+ ;
+ }
+ }
+ /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
+ bfwd->current_alist_element = aelt;
+ /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */
+ XSETBUFFER (bfwd->current_buffer, current_buffer);
+ valcontents = bfwd->current_value;
+ }
+ break;
+ }
+ default:
+ abort ();
+ }
+ }
+ store_symval_forwarding (sym, valcontents, newval);
+
+ return newval;
+}
+
+\f
+/* Access or set a buffer-local symbol's default value. */
+
+/* Return the default value of SYM, but don't check for voidness.
+ Return Qunbound if it is void. */
+
+static Lisp_Object
+default_value (Lisp_Object sym)
+{
+ Lisp_Object valcontents;
+
+ CHECK_SYMBOL (sym);
+
+ retry:
+ valcontents = XSYMBOL (sym)->value;
+
+ retry_2:
+ if (!SYMBOL_VALUE_MAGIC_P (valcontents))
+ return valcontents;
+
+ switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
+ {
+ case SYMVAL_LISP_MAGIC:
+ /* #### kludge */
+ valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
+ /* semi-change-o */
+ goto retry_2;
+
+ case SYMVAL_VARALIAS:
+ sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
+ /* presto change-o! */
+ goto retry;
+
+ case SYMVAL_UNBOUND_MARKER:
+ return valcontents;
+
+ case SYMVAL_CURRENT_BUFFER_FORWARD:
+ {
+ CONST struct symbol_value_forward *fwd
+ = XSYMBOL_VALUE_FORWARD (valcontents);
+ return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
+ + ((char *)symbol_value_forward_forward (fwd)
+ - (char *)&buffer_local_flags))));
+ }
+
+ case SYMVAL_SELECTED_CONSOLE_FORWARD:
+ {
+ CONST struct symbol_value_forward *fwd
+ = XSYMBOL_VALUE_FORWARD (valcontents);
+ return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
+ + ((char *)symbol_value_forward_forward (fwd)
+ - (char *)&console_local_flags))));
+ }
+
+ case SYMVAL_BUFFER_LOCAL:
+ case SYMVAL_SOME_BUFFER_LOCAL:
+ {
+ struct symbol_value_buffer_local *bfwd =
+ XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
+
+ /* Handle user-created local variables. */
+ /* If var is set up for a buffer that lacks a local value for it,
+ the current value is nominally the default value.
+ But the current value slot may be more up to date, since
+ ordinary setq stores just that slot. So use that. */
+ if (NILP (bfwd->current_alist_element))
+ return do_symval_forwarding (bfwd->current_value, current_buffer,
+ XCONSOLE (Vselected_console));
+ else
+ return bfwd->default_value;
+ }
+ default:
+ /* For other variables, get the current value. */
+ return do_symval_forwarding (valcontents, current_buffer,
+ XCONSOLE (Vselected_console));
+ }
+
+ RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
+}
+
+DEFUN ("default-boundp", Fdefault_boundp, 1, 1, 0, /*
+Return t if SYMBOL has a non-void default value.
+This is the value that is seen in buffers that do not have their own values
+for this variable.
+*/
+ (sym))
+{
+ return UNBOUNDP (default_value (sym)) ? Qnil : Qt;
+}
+
+DEFUN ("default-value", Fdefault_value, 1, 1, 0, /*
+Return SYMBOL's default value.
+This is the value that is seen in buffers that do not have their own values
+for this variable. The default value is meaningful for variables with
+local bindings in certain buffers.
+*/
+ (sym))
+{
+ Lisp_Object value = default_value (sym);
+
+ return UNBOUNDP (value) ? Fsignal (Qvoid_variable, list1 (sym)) : value;
+}
+
+DEFUN ("set-default", Fset_default, 2, 2, 0, /*
+Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated.
+The default value is seen in buffers that do not have their own values
+for this variable.
+*/
+ (sym, value))
+{
+ Lisp_Object valcontents;
+
+ CHECK_SYMBOL (sym);
+
+ retry:
+ valcontents = XSYMBOL (sym)->value;
+
+ retry_2:
+ if (!SYMBOL_VALUE_MAGIC_P (valcontents))
+ return Fset (sym, value);
+
+ switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
+ {
+ case SYMVAL_LISP_MAGIC:
+ RETURN_IF_NOT_UNBOUND (maybe_call_magic_handler (sym, Qset_default, 1,
+ value));
+ valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
+ /* semi-change-o */
+ goto retry_2;
+
+ case SYMVAL_VARALIAS:
+ sym = follow_varalias_pointers (sym, Qset_default);
+ /* presto change-o! */
+ goto retry;
+
+ case SYMVAL_CURRENT_BUFFER_FORWARD:
+ set_default_buffer_slot_variable (sym, value);
+ return value;
+
+ case SYMVAL_SELECTED_CONSOLE_FORWARD:
+ set_default_console_slot_variable (sym, value);
+ return value;
+
+ case SYMVAL_BUFFER_LOCAL:
+ case SYMVAL_SOME_BUFFER_LOCAL:
+ {
+ /* Store new value into the DEFAULT-VALUE slot */
+ struct symbol_value_buffer_local *bfwd
+ = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
+
+ bfwd->default_value = value;
+ /* If current-buffer doesn't shadow default_value,
+ * we must set the CURRENT-VALUE slot too */
+ if (NILP (bfwd->current_alist_element))
+ store_symval_forwarding (sym, bfwd->current_value, value);
+ return value;
+ }
+
+ default:
+ return Fset (sym, value);
+ }
+ RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
+}
+
+DEFUN ("setq-default", Fsetq_default, 2, UNEVALLED, 0, /*
+Set the default value of variable SYM to VALUE.
+SYM, the variable name, is literal (not evaluated);
+VALUE is an expression and it is evaluated.
+The default value of a variable is seen in buffers
+that do not have their own values for the variable.
+
+More generally, you can use multiple variables and values, as in
+ (setq-default SYM VALUE SYM VALUE...)
+This sets each SYM's default value to the corresponding VALUE.
+The VALUE for the Nth SYM can refer to the new default values
+of previous SYMs.
+*/
+ (args))
+{
+ /* This function can GC */
+ Lisp_Object args_left;
+ Lisp_Object val, sym;
+ struct gcpro gcpro1;
+
+ if (NILP (args))
+ return Qnil;
+
+ args_left = args;
+ GCPRO1 (args);
+
+ do
+ {
+ val = Feval (Fcar (Fcdr (args_left)));
+ sym = Fcar (args_left);
+ Fset_default (sym, val);
+ args_left = Fcdr (Fcdr (args_left));
+ }
+ while (!NILP (args_left));
+
+ UNGCPRO;
+ return val;
+}
+\f
+/* Lisp functions for creating and removing buffer-local variables. */
+
+DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, 1, 1,
+ "vMake Variable Buffer Local: ", /*
+Make VARIABLE have a separate value for each buffer.
+At any time, the value for the current buffer is in effect.
+There is also a default value which is seen in any buffer which has not yet
+set its own value.
+Using `set' or `setq' to set the variable causes it to have a separate value
+for the current buffer if it was previously using the default value.
+The function `default-value' gets the default value and `set-default'
+sets it.
+*/
+ (variable))
+{
+ Lisp_Object valcontents;
+
+ CHECK_SYMBOL (variable);
+
+ retry:
+ verify_ok_for_buffer_local (variable, Qmake_variable_buffer_local);
+
+ valcontents = XSYMBOL (variable)->value;
+
+ retry_2:
+ if (SYMBOL_VALUE_MAGIC_P (valcontents))
+ {
+ switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
+ {
+ case SYMVAL_LISP_MAGIC:
+ if (!UNBOUNDP (maybe_call_magic_handler
+ (variable, Qmake_variable_buffer_local, 0)))
+ return variable;
+ valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
+ /* semi-change-o */
+ goto retry_2;
+
+ case SYMVAL_VARALIAS:
+ variable = follow_varalias_pointers (variable,
+ Qmake_variable_buffer_local);
+ /* presto change-o! */
+ goto retry;
+
+ case SYMVAL_FIXNUM_FORWARD:
+ case SYMVAL_BOOLEAN_FORWARD:
+ case SYMVAL_OBJECT_FORWARD:
+ case SYMVAL_UNBOUND_MARKER:
+ break;
+
+ case SYMVAL_CURRENT_BUFFER_FORWARD:
+ case SYMVAL_BUFFER_LOCAL:
+ /* Already per-each-buffer */
+ return variable;
+
+ case SYMVAL_SOME_BUFFER_LOCAL:
+ /* Transmogrify */
+ XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->magic.type =
+ SYMVAL_BUFFER_LOCAL;
+ return variable;
+
+ default:
+ abort ();
+ }
+ }
+
+ {
+ struct symbol_value_buffer_local *bfwd
+ = alloc_lcrecord_type (struct symbol_value_buffer_local,
+ lrecord_symbol_value_buffer_local);
+ Lisp_Object foo;
+ bfwd->magic.type = SYMVAL_BUFFER_LOCAL;
+
+ bfwd->default_value = find_symbol_value (variable);
+ bfwd->current_value = valcontents;
+ bfwd->current_alist_element = Qnil;
+ bfwd->current_buffer = Fcurrent_buffer ();
+ XSETSYMBOL_VALUE_MAGIC (foo, bfwd);
+ *value_slot_past_magic (variable) = foo;
+#if 1 /* #### Yuck! FSFmacs bug-compatibility*/
+ /* This sets the default-value of any make-variable-buffer-local to nil.
+ That just sucks. User can just use setq-default to effect that,
+ but there's no way to do makunbound-default to undo this lossage. */
+ if (UNBOUNDP (valcontents))
+ bfwd->default_value = Qnil;
+#endif
+#if 0 /* #### Yuck! */
+ /* This sets the value to nil in this buffer.
+ User could use (setq variable nil) to do this.
+ It isn't as egregious to do this automatically
+ as it is to do so to the default-value, but it's
+ still really dubious. */
+ if (UNBOUNDP (valcontents))
+ Fset (variable, Qnil);
+#endif
+ return variable;
+ }
+}
+
+DEFUN ("make-local-variable", Fmake_local_variable, 1, 1,
+ "vMake Local Variable: ", /*
+Make VARIABLE have a separate value in the current buffer.
+Other buffers will continue to share a common default value.
+\(The buffer-local value of VARIABLE starts out as the same value
+VARIABLE previously had. If VARIABLE was void, it remains void.)
+See also `make-variable-buffer-local'.
+
+If the variable is already arranged to become local when set,
+this function causes a local value to exist for this buffer,
+just as setting the variable would do.
+
+Do not use `make-local-variable' to make a hook variable buffer-local.
+Use `make-local-hook' instead.
+*/
+ (variable))
+{
+ Lisp_Object valcontents;
+ struct symbol_value_buffer_local *bfwd;
+
+ CHECK_SYMBOL (variable);
+
+ retry:
+ verify_ok_for_buffer_local (variable, Qmake_local_variable);
+
+ valcontents = XSYMBOL (variable)->value;
+
+ retry_2:
+ if (SYMBOL_VALUE_MAGIC_P (valcontents))
+ {
+ switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
+ {
+ case SYMVAL_LISP_MAGIC:
+ if (!UNBOUNDP (maybe_call_magic_handler
+ (variable, Qmake_local_variable, 0)))
+ return variable;
+ valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
+ /* semi-change-o */
+ goto retry_2;
+
+ case SYMVAL_VARALIAS:
+ variable = follow_varalias_pointers (variable, Qmake_local_variable);
+ /* presto change-o! */
+ goto retry;
+
+ case SYMVAL_FIXNUM_FORWARD:
+ case SYMVAL_BOOLEAN_FORWARD:
+ case SYMVAL_OBJECT_FORWARD:
+ case SYMVAL_UNBOUND_MARKER:
+ break;
+
+ case SYMVAL_BUFFER_LOCAL:
+ case SYMVAL_CURRENT_BUFFER_FORWARD:
+ {
+ /* Make sure the symbol has a local value in this particular
+ buffer, by setting it to the same value it already has. */
+ Fset (variable, find_symbol_value (variable));
+ return variable;
+ }
+
+ case SYMVAL_SOME_BUFFER_LOCAL:
+ {
+ if (!NILP (buffer_local_alist_element (current_buffer,
+ variable,
+ (XSYMBOL_VALUE_BUFFER_LOCAL
+ (valcontents)))))
+ goto already_local_to_current_buffer;
+ else
+ goto already_local_to_some_other_buffer;
+ }
+
+ default:
+ abort ();
+ }
+ }
+
+ /* 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);
+ bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL;
+
+ bfwd->current_buffer = Qnil;
+ bfwd->current_alist_element = Qnil;
+ bfwd->current_value = valcontents;
+ /* passing 0 is OK because this should never be a
+ SYMVAL_CURRENT_BUFFER_FORWARD or SYMVAL_SELECTED_CONSOLE_FORWARD
+ variable. */
+ bfwd->default_value = do_symval_forwarding (valcontents, 0, 0);
+
+#if 0
+ if (UNBOUNDP (bfwd->default_value))
+ bfwd->default_value = Qnil; /* Yuck! */
+#endif
+
+ XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
+ *value_slot_past_magic (variable) = valcontents;
+
+ already_local_to_some_other_buffer:
+
+ /* Make sure this buffer has its own value of variable */
+ bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
+
+ if (UNBOUNDP (bfwd->default_value))
+ {
+ /* If default value is unbound, set local value to nil. */
+ XSETBUFFER (bfwd->current_buffer, current_buffer);
+ bfwd->current_alist_element = Fcons (variable, Qnil);
+ current_buffer->local_var_alist =
+ Fcons (bfwd->current_alist_element, current_buffer->local_var_alist);
+ store_symval_forwarding (variable, bfwd->current_value, Qnil);
+ return variable;
+ }
+
+ current_buffer->local_var_alist
+ = Fcons (Fcons (variable, bfwd->default_value),
+ current_buffer->local_var_alist);
+
+ /* Make sure symbol does not think it is set up for this buffer;
+ force it to look once again for this buffer's value */
+ if (!NILP (bfwd->current_buffer) &&
+ current_buffer == XBUFFER (bfwd->current_buffer))
+ bfwd->current_buffer = Qnil;
+
+ already_local_to_current_buffer:
+
+ /* If the symbol forwards into a C variable, then swap in the
+ variable for this buffer immediately. If C code modifies the
+ variable before we swap in, then that new value will clobber the
+ default value the next time we swap. */
+ bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
+ if (SYMBOL_VALUE_MAGIC_P (bfwd->current_value))
+ {
+ switch (XSYMBOL_VALUE_MAGIC_TYPE (bfwd->current_value))
+ {
+ case SYMVAL_FIXNUM_FORWARD:
+ case SYMVAL_BOOLEAN_FORWARD:
+ case SYMVAL_OBJECT_FORWARD:
+ case SYMVAL_DEFAULT_BUFFER_FORWARD:
+ set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
+ break;
+
+ case SYMVAL_UNBOUND_MARKER:
+ case SYMVAL_CURRENT_BUFFER_FORWARD:
+ break;
+
+ default:
+ abort ();
+ }
+ }
+
+ return variable;
+}
+
+DEFUN ("kill-local-variable", Fkill_local_variable, 1, 1,
+ "vKill Local Variable: ", /*
+Make VARIABLE no longer have a separate value in the current buffer.
+From now on the default value will apply in this buffer.
+*/
+ (variable))
+{
+ Lisp_Object valcontents;
+
+ CHECK_SYMBOL (variable);
+
+ retry:
+ valcontents = XSYMBOL (variable)->value;
+
+ retry_2:
+ if (!SYMBOL_VALUE_MAGIC_P (valcontents))
+ return variable;
+
+ switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
+ {
+ case SYMVAL_LISP_MAGIC:
+ if (!UNBOUNDP (maybe_call_magic_handler
+ (variable, Qkill_local_variable, 0)))
+ return variable;
+ valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
+ /* semi-change-o */
+ goto retry_2;
+
+ case SYMVAL_VARALIAS:
+ variable = follow_varalias_pointers (variable, Qkill_local_variable);
+ /* presto change-o! */
+ goto retry;
+
+ case SYMVAL_CURRENT_BUFFER_FORWARD:
+ {
+ CONST struct symbol_value_forward *fwd
+ = XSYMBOL_VALUE_FORWARD (valcontents);
+ int offset = ((char *) symbol_value_forward_forward (fwd)
+ - (char *) &buffer_local_flags);
+ int mask =
+ XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
+
+ if (mask > 0)
+ {
+ int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
+ Lisp_Object in_object, int flags) =
+ symbol_value_forward_magicfun (fwd);
+ Lisp_Object oldval = * (Lisp_Object *)
+ (offset + (char *) XBUFFER (Vbuffer_defaults));
+ if (magicfun)
+ (magicfun) (variable, &oldval, make_buffer (current_buffer), 0);
+ *(Lisp_Object *) (offset + (char *) current_buffer)
+ = oldval;
+ current_buffer->local_var_flags &= ~mask;
+ }
+ return variable;
+ }
+
+ case SYMVAL_BUFFER_LOCAL:
+ case SYMVAL_SOME_BUFFER_LOCAL:
+ {
+ /* Get rid of this buffer's alist element, if any */
+ struct symbol_value_buffer_local *bfwd
+ = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
+ Lisp_Object alist = current_buffer->local_var_alist;
+ Lisp_Object alist_element
+ = buffer_local_alist_element (current_buffer, variable, bfwd);
+
+ if (!NILP (alist_element))
+ current_buffer->local_var_alist = Fdelq (alist_element, alist);
+
+ /* Make sure symbol does not think it is set up for this buffer;
+ force it to look once again for this buffer's value */
+ if (!NILP (bfwd->current_buffer) &&
+ current_buffer == XBUFFER (bfwd->current_buffer))
+ bfwd->current_buffer = Qnil;
+
+ /* We just changed the value in the current_buffer. If this
+ variable forwards to a C variable, we need to change the
+ value of the C variable. set_up_buffer_local_cache()
+ will do this. It doesn't hurt to do it always,
+ so just go ahead and do that. */
+ set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
+ }
+ return variable;
+
+ default:
+ return variable;
+ }
+ RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
+}
+
+
+DEFUN ("kill-console-local-variable", Fkill_console_local_variable, 1, 1,
+ "vKill Console Local Variable: ", /*
+Make VARIABLE no longer have a separate value in the selected console.
+From now on the default value will apply in this console.
+*/
+ (variable))
+{
+ Lisp_Object valcontents;
+
+ CHECK_SYMBOL (variable);
+
+ retry:
+ valcontents = XSYMBOL (variable)->value;
+
+ retry_2:
+ if (!SYMBOL_VALUE_MAGIC_P (valcontents))
+ return variable;
+
+ switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
+ {
+ case SYMVAL_LISP_MAGIC:
+ if (!UNBOUNDP (maybe_call_magic_handler
+ (variable, Qkill_console_local_variable, 0)))
+ return variable;
+ valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
+ /* semi-change-o */
+ goto retry_2;
+
+ case SYMVAL_VARALIAS:
+ variable = follow_varalias_pointers (variable,
+ Qkill_console_local_variable);
+ /* presto change-o! */
+ goto retry;
+
+ case SYMVAL_SELECTED_CONSOLE_FORWARD:
+ {
+ CONST struct symbol_value_forward *fwd
+ = XSYMBOL_VALUE_FORWARD (valcontents);
+ int offset = ((char *) symbol_value_forward_forward (fwd)
+ - (char *) &console_local_flags);
+ int mask =
+ XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
+
+ if (mask > 0)
+ {
+ int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
+ Lisp_Object in_object, int flags) =
+ symbol_value_forward_magicfun (fwd);
+ Lisp_Object oldval = * (Lisp_Object *)
+ (offset + (char *) XCONSOLE (Vconsole_defaults));
+ if (magicfun)
+ (magicfun) (variable, &oldval, Vselected_console, 0);
+ *(Lisp_Object *) (offset + (char *) XCONSOLE (Vselected_console))
+ = oldval;
+ XCONSOLE (Vselected_console)->local_var_flags &= ~mask;
+ }
+ return variable;
+ }
+
+ default:
+ return variable;
+ }
+ RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
+}
+
+/* Used by specbind to determine what effects it might have. Returns:
+ * 0 if symbol isn't buffer-local, and wouldn't be after it is set
+ * <0 if symbol isn't presently buffer-local, but set would make it so
+ * >0 if symbol is presently buffer-local
+ */
+int
+symbol_value_buffer_local_info (Lisp_Object symbol, struct buffer *buffer)
+{
+ Lisp_Object valcontents;
+
+ retry:
+ valcontents = XSYMBOL (symbol)->value;
+
+ retry_2:
+ if (SYMBOL_VALUE_MAGIC_P (valcontents))
+ {
+ switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
+ {
+ case SYMVAL_LISP_MAGIC:
+ /* #### kludge */
+ valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
+ /* semi-change-o */
+ goto retry_2;
+
+ case SYMVAL_VARALIAS:
+ symbol = follow_varalias_pointers (symbol, Qt /* #### kludge */);
+ /* presto change-o! */
+ goto retry;
+
+ case SYMVAL_CURRENT_BUFFER_FORWARD:
+ {
+ CONST struct symbol_value_forward *fwd
+ = XSYMBOL_VALUE_FORWARD (valcontents);
+ int mask = XINT (*((Lisp_Object *)
+ symbol_value_forward_forward (fwd)));
+ if ((mask <= 0) || (buffer && (buffer->local_var_flags & mask)))
+ /* Already buffer-local */
+ return 1;
+ else
+ /* Would be buffer-local after set */
+ return -1;
+ }
+ case SYMVAL_BUFFER_LOCAL:
+ case SYMVAL_SOME_BUFFER_LOCAL:
+ {
+ struct symbol_value_buffer_local *bfwd
+ = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
+ if (buffer
+ && !NILP (buffer_local_alist_element (buffer, symbol, bfwd)))
+ return 1;
+ else
+ /* Automatically becomes local when set */
+ return bfwd->magic.type == SYMVAL_BUFFER_LOCAL ? -1 : 0;
+ }
+ default:
+ return 0;
+ }
+ }
+ return 0;
+}
+
+
+DEFUN ("symbol-value-in-buffer", Fsymbol_value_in_buffer, 2, 3, 0, /*
+Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound.
+*/
+ (symbol, buffer, unbound_value))
+{
+ Lisp_Object value;
+ CHECK_SYMBOL (symbol);
+ CHECK_BUFFER (buffer);
+ value = symbol_value_in_buffer (symbol, buffer);
+ if (UNBOUNDP (value))
+ return unbound_value;
+ else
+ return value;
+}
+
+DEFUN ("symbol-value-in-console", Fsymbol_value_in_console, 2, 3, 0, /*
+Return the value of SYMBOL in CONSOLE, or UNBOUND-VALUE if it is unbound.
+*/
+ (symbol, console, unbound_value))
+{
+ Lisp_Object value;
+ CHECK_SYMBOL (symbol);
+ CHECK_CONSOLE (console);
+ value = symbol_value_in_console (symbol, console);
+ if (UNBOUNDP (value))
+ return unbound_value;
+ else
+ return value;
+}
+
+DEFUN ("built-in-variable-type", Fbuilt_in_variable_type, 1, 1, 0, /*
+If SYM is a built-in variable, return info about this; else return nil.
+The returned info will be a symbol, one of
+
+`object' A simple built-in variable.
+`const-object' Same, but cannot be set.
+`integer' A built-in integer variable.
+`const-integer' Same, but cannot be set.
+`boolean' A built-in boolean variable.
+`const-boolean' Same, but cannot be set.
+`const-specifier' Always contains a specifier; e.g. `has-modeline-p'.
+`current-buffer' A built-in buffer-local variable.
+`const-current-buffer' Same, but cannot be set.
+`default-buffer' Forwards to the default value of a built-in
+ buffer-local variable.
+`selected-console' A built-in console-local variable.
+`const-selected-console' Same, but cannot be set.
+`default-console' Forwards to the default value of a built-in
+ console-local variable.
+*/
+ (sym))
+{
+ REGISTER Lisp_Object valcontents;
+
+ CHECK_SYMBOL (sym);
+
+ retry:
+ valcontents = XSYMBOL (sym)->value;
+ retry_2:
+
+ if (SYMBOL_VALUE_MAGIC_P (valcontents))
+ {
+ switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
+ {
+ case SYMVAL_LISP_MAGIC:
+ valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
+ /* semi-change-o */
+ goto retry_2;
+
+ case SYMVAL_VARALIAS:
+ sym = follow_varalias_pointers (sym, Qt);
+ /* presto change-o! */
+ goto retry;
+
+ case SYMVAL_BUFFER_LOCAL:
+ case SYMVAL_SOME_BUFFER_LOCAL:
+ valcontents =
+ XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->current_value;
+ /* semi-change-o */
+ goto retry_2;
+
+ case SYMVAL_FIXNUM_FORWARD:
+ return Qinteger;
+
+ case SYMVAL_CONST_FIXNUM_FORWARD:
+ return Qconst_integer;
+
+ case SYMVAL_BOOLEAN_FORWARD:
+ return Qboolean;
+
+ case SYMVAL_CONST_BOOLEAN_FORWARD:
+ return Qconst_boolean;
+
+ case SYMVAL_OBJECT_FORWARD:
+ return Qobject;
+
+ case SYMVAL_CONST_OBJECT_FORWARD:
+ return Qconst_object;
+
+ case SYMVAL_CONST_SPECIFIER_FORWARD:
+ return Qconst_specifier;
+
+ case SYMVAL_DEFAULT_BUFFER_FORWARD:
+ return Qdefault_buffer;
+
+ case SYMVAL_CURRENT_BUFFER_FORWARD:
+ return Qcurrent_buffer;
+
+ case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
+ return Qconst_current_buffer;
+
+ case SYMVAL_DEFAULT_CONSOLE_FORWARD:
+ return Qdefault_console;
+
+ case SYMVAL_SELECTED_CONSOLE_FORWARD:
+ return Qselected_console;
+
+ case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
+ return Qconst_selected_console;
+
+ case SYMVAL_UNBOUND_MARKER:
+ return Qnil;
+
+ default:
+ abort ();
+ }
+ }
+
+ return Qnil;
+}
+
+
+DEFUN ("local-variable-p", Flocal_variable_p, 2, 3, 0, /*
+Return t if SYMBOL's value is local to BUFFER.
+If optional third arg AFTER-SET is true, return t if SYMBOL would be
+buffer-local after it is set, regardless of whether it is so presently.
+A nil value for BUFFER is *not* the same as (current-buffer), but means
+"no buffer". Specifically:
+
+-- If BUFFER is nil and AFTER-SET is nil, a return value of t indicates that
+ the variable is one of the special built-in variables that is always
+ buffer-local. (This includes `buffer-file-name', `buffer-read-only',
+ `buffer-undo-list', and others.)
+
+-- If BUFFER is nil and AFTER-SET is t, a return value of t indicates that
+ the variable has had `make-variable-buffer-local' applied to it.
+*/
+ (symbol, buffer, after_set))
+{
+ int local_info;
+
+ CHECK_SYMBOL (symbol);
+ if (!NILP (buffer))
+ {
+ buffer = get_buffer (buffer, 1);
+ local_info = symbol_value_buffer_local_info (symbol, XBUFFER (buffer));
+ }
+ else
+ {
+ local_info = symbol_value_buffer_local_info (symbol, 0);
+ }
+
+ if (NILP (after_set))
+ return local_info > 0 ? Qt : Qnil;
+ else
+ return local_info != 0 ? Qt : Qnil;
+}
+\f
+
+/*
+I've gone ahead and partially implemented this because it's
+super-useful for dealing with the compatibility problems in supporting
+the old pointer-shape variables, and preventing people from `setq'ing
+the new variables. Any other way of handling this problem is way
+ugly, likely to be slow, and generally not something I want to waste
+my time worrying about.
+
+The interface and/or function name is sure to change before this
+gets into its final form. I currently like the way everything is
+set up and it has all the features I want it to have, except for
+one: I really want to be able to have multiple nested handlers,
+to implement an `advice'-like capabiility. This would allow,
+for example, a clean way of implementing `debug-if-set' or
+`debug-if-referenced' and such.
+
+NOTE NOTE NOTE NOTE NOTE NOTE NOTE:
+************************************************************
+**Only** the `set-value', `make-unbound', and `make-local'
+handler types are currently implemented. Implementing the
+get-value and bound-predicate handlers is somewhat tricky
+because there are lots of subfunctions (e.g. find_symbol_value()).
+find_symbol_value(), in fact, is called from outside of
+this module. You'd have to have it do this:
+
+-- check for a `bound-predicate' handler, call that if so;
+ if it returns nil, return Qunbound
+-- check for a `get-value' handler and call it and return
+ that value
+
+It gets even trickier when you have to deal with
+sub-subfunctions like find_symbol_value_1(), and esp.
+when you have to properly handle variable aliases, which
+can lead to lots of tricky situations. So I've just
+punted on this, since the interface isn't officially
+exported and we can get by with just a `set-value'
+handler.
+
+Actions in unimplemented handler types will correctly
+ignore any handlers, and will not fuck anything up or
+go awry.
+
+WARNING WARNING: If you do go and implement another
+type of handler, make *sure* to change
+would_be_magic_handled() so it knows about this,
+or dire things could result.
+************************************************************
+NOTE NOTE NOTE NOTE NOTE NOTE NOTE
+
+Real documentation is as follows.
+
+Set a magic handler for VARIABLE.
+This allows you to specify arbitrary behavior that results from
+accessing or setting a variable. For example, retrieving the
+variable's value might actually retrieve the first element off of
+a list stored in another variable, and setting the variable's value
+might add an element to the front of that list. (This is how the
+obsolete variable `unread-command-event' is implemented.)
+
+In general it is NOT good programming practice to use magic variables
+in a new package that you are designing. If you feel the need to
+do this, it's almost certainly a sign that you should be using a
+function instead of a variable. This facility is provided to allow
+a package to support obsolete variables and provide compatibility
+with similar packages with different variable names and semantics.
+By using magic handlers, you can cleanly provide obsoleteness and
+compatibility support and separate this support from the core
+routines in a package.
+
+VARIABLE should be a symbol naming the variable for which the
+magic behavior is provided. HANDLER-TYPE is a symbol specifying
+which behavior is being controlled, and HANDLER is the function
+that will be called to control this behavior. HARG is a
+value that will be passed to HANDLER but is otherwise
+uninterpreted. KEEP-EXISTING specifies what to do with existing
+handlers of the same type; nil means "erase them all", t means
+"keep them but insert at the beginning", the list (t) means
+"keep them but insert at the end", a function means "keep
+them but insert before the specified function", a list containing
+a function means "keep them but insert after the specified
+function".
+
+You can specify magic behavior for any type of variable at all,
+and for any handler types that are unspecified, the standard
+behavior applies. This allows you, for example, to use
+`defvaralias' in conjunction with this function. (For that
+matter, `defvaralias' could be implemented using this function.)
+
+The behaviors that can be specified in HANDLER-TYPE are
+
+get-value (SYM ARGS FUN HARG HANDLERS)
+ This means that one of the functions `symbol-value',
+ `default-value', `symbol-value-in-buffer', or
+ `symbol-value-in-console' was called on SYM.
+
+set-value (SYM ARGS FUN HARG HANDLERS)
+ This means that one of the functions `set' or `set-default'
+ was called on SYM.
+
+bound-predicate (SYM ARGS FUN HARG HANDLERS)
+ This means that one of the functions `boundp', `globally-boundp',
+ or `default-boundp' was called on SYM.
+
+make-unbound (SYM ARGS FUN HARG HANDLERS)
+ This means that the function `makunbound' was called on SYM.
+
+local-predicate (SYM ARGS FUN HARG HANDLERS)
+ This means that the function `local-variable-p' was called
+ on SYM.
+
+make-local (SYM ARGS FUN HARG HANDLERS)
+ This means that one of the functions `make-local-variable',
+ `make-variable-buffer-local', `kill-local-variable',
+ or `kill-console-local-variable' was called on SYM.
+
+The meanings of the arguments are as follows:
+
+ SYM is the symbol on which the function was called, and is always
+ the first argument to the function.
+
+ ARGS are the remaining arguments in the original call (i.e. all
+ but the first). In the case of `set-value' in particular,
+ the first element of ARGS is the value to which the variable
+ is being set. In some cases, ARGS is sanitized from what was
+ actually given. For example, whenever `nil' is passed to an
+ argument and it means `current-buffer', the current buffer is
+ substituted instead.
+
+ FUN is a symbol indicating which function is being called.
+ For many of the functions, you can determine the corresponding
+ function of a different class using
+ `symbol-function-corresponding-function'.
+
+ HARG is the argument that was given in the call
+ to `set-symbol-value-handler' for SYM and HANDLER-TYPE.
+
+ HANDLERS is a structure containing the remaining handlers
+ for the variable; to call one of them, use
+ `chain-to-symbol-value-handler'.
+
+NOTE: You may *not* modify the list in ARGS, and if you want to
+keep it around after the handler function exits, you must make
+a copy using `copy-sequence'. (Same caveats for HANDLERS also.)
+*/
+
+static enum lisp_magic_handler
+decode_magic_handler_type (Lisp_Object symbol)
+{
+ if (EQ (symbol, Qget_value)) return MAGIC_HANDLER_GET_VALUE;
+ if (EQ (symbol, Qset_value)) return MAGIC_HANDLER_SET_VALUE;
+ if (EQ (symbol, Qbound_predicate)) return MAGIC_HANDLER_BOUND_PREDICATE;
+ if (EQ (symbol, Qmake_unbound)) return MAGIC_HANDLER_MAKE_UNBOUND;
+ if (EQ (symbol, Qlocal_predicate)) return MAGIC_HANDLER_LOCAL_PREDICATE;
+ if (EQ (symbol, Qmake_local)) return MAGIC_HANDLER_MAKE_LOCAL;
+
+ signal_simple_error ("Unrecognized symbol value handler type", symbol);
+ abort ();
+ return MAGIC_HANDLER_MAX;
+}
+
+static enum lisp_magic_handler
+handler_type_from_function_symbol (Lisp_Object funsym, int abort_if_not_found)
+{
+ if (EQ (funsym, Qsymbol_value)
+ || EQ (funsym, Qdefault_value)
+ || EQ (funsym, Qsymbol_value_in_buffer)
+ || EQ (funsym, Qsymbol_value_in_console))
+ return MAGIC_HANDLER_GET_VALUE;
+
+ if (EQ (funsym, Qset)
+ || EQ (funsym, Qset_default))
+ return MAGIC_HANDLER_SET_VALUE;
+
+ if (EQ (funsym, Qboundp)
+ || EQ (funsym, Qglobally_boundp)
+ || EQ (funsym, Qdefault_boundp))
+ return MAGIC_HANDLER_BOUND_PREDICATE;
+
+ if (EQ (funsym, Qmakunbound))
+ return MAGIC_HANDLER_MAKE_UNBOUND;
+
+ if (EQ (funsym, Qlocal_variable_p))
+ return MAGIC_HANDLER_LOCAL_PREDICATE;
+
+ if (EQ (funsym, Qmake_variable_buffer_local)
+ || EQ (funsym, Qmake_local_variable))
+ return MAGIC_HANDLER_MAKE_LOCAL;
+
+ if (abort_if_not_found)
+ abort ();
+ signal_simple_error ("Unrecognized symbol-value function", funsym);
+ return MAGIC_HANDLER_MAX;
+}
+
+static int
+would_be_magic_handled (Lisp_Object sym, Lisp_Object funsym)
+{
+ /* does not take into account variable aliasing. */
+ Lisp_Object valcontents = XSYMBOL (sym)->value;
+ enum lisp_magic_handler slot;
+
+ if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
+ return 0;
+ slot = handler_type_from_function_symbol (funsym, 1);
+ if (slot != MAGIC_HANDLER_SET_VALUE && slot != MAGIC_HANDLER_MAKE_UNBOUND
+ && slot != MAGIC_HANDLER_MAKE_LOCAL)
+ /* #### temporary kludge because we haven't implemented
+ lisp-magic variables completely */
+ return 0;
+ return !NILP (XSYMBOL_VALUE_LISP_MAGIC (valcontents)->handler[slot]);
+}
+
+static Lisp_Object
+fetch_value_maybe_past_magic (Lisp_Object sym,
+ Lisp_Object follow_past_lisp_magic)
+{
+ Lisp_Object value = XSYMBOL (sym)->value;
+ if (SYMBOL_VALUE_LISP_MAGIC_P (value)
+ && (EQ (follow_past_lisp_magic, Qt)
+ || (!NILP (follow_past_lisp_magic)
+ && !would_be_magic_handled (sym, follow_past_lisp_magic))))
+ value = XSYMBOL_VALUE_LISP_MAGIC (value)->shadowed;
+ return value;
+}
+
+static Lisp_Object *
+value_slot_past_magic (Lisp_Object sym)
+{
+ Lisp_Object *store_pointer = &XSYMBOL (sym)->value;
+
+ if (SYMBOL_VALUE_LISP_MAGIC_P (*store_pointer))
+ store_pointer = &XSYMBOL_VALUE_LISP_MAGIC (sym)->shadowed;
+ return store_pointer;
+}
+
+static Lisp_Object
+maybe_call_magic_handler (Lisp_Object sym, Lisp_Object funsym, int nargs, ...)
+{
+ va_list vargs;
+ Lisp_Object args[20]; /* should be enough ... */
+ int i;
+ enum lisp_magic_handler htype;
+ Lisp_Object legerdemain;
+ struct symbol_value_lisp_magic *bfwd;
+
+ assert (nargs >= 0 && nargs < 20);
+ legerdemain = XSYMBOL (sym)->value;
+ assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain));
+ bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain);
+
+ va_start (vargs, nargs);
+ for (i = 0; i < nargs; i++)
+ args[i] = va_arg (vargs, Lisp_Object);
+ va_end (vargs);
+
+ htype = handler_type_from_function_symbol (funsym, 1);
+ if (NILP (bfwd->handler[htype]))
+ return Qunbound;
+ /* #### should be reusing the arglist, not always consing anew.
+ Repeated handler invocations should not cause repeated consing.
+ Doesn't matter for now, because this is just a quick implementation
+ for obsolescence support. */
+ return call5 (bfwd->handler[htype], sym, Flist (nargs, args), funsym,
+ bfwd->harg[htype], Qnil);
+}
+
+DEFUN ("dontusethis-set-symbol-value-handler", Fdontusethis_set_symbol_value_handler,
+ 3, 5, 0, /*
+Don't you dare use this.
+If you do, suffer the wrath of Ben, who is likely to rename
+this function (or change the semantics of its arguments) without
+pity, thereby invalidating your code.
+*/
+ (variable, handler_type, handler, harg, keep_existing))
+{
+ Lisp_Object valcontents;
+ struct symbol_value_lisp_magic *bfwd;
+ enum lisp_magic_handler htype;
+ int i;
+
+ /* #### WARNING, only some handler types are implemented. See above.
+ Actions of other types will ignore a handler if it's there.
+
+ #### Also, `chain-to-symbol-value-handler' and
+ `symbol-function-corresponding-function' are not implemented. */
+ CHECK_SYMBOL (variable);
+ CHECK_SYMBOL (handler_type);
+ htype = decode_magic_handler_type (handler_type);
+ valcontents = XSYMBOL (variable)->value;
+ if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
+ {
+ bfwd = alloc_lcrecord_type (struct symbol_value_lisp_magic,
+ lrecord_symbol_value_lisp_magic);
+ bfwd->magic.type = SYMVAL_LISP_MAGIC;
+ for (i = 0; i < MAGIC_HANDLER_MAX; i++)
+ {
+ bfwd->handler[i] = Qnil;
+ bfwd->harg[i] = Qnil;
+ }
+ bfwd->shadowed = valcontents;
+ XSETSYMBOL_VALUE_MAGIC (XSYMBOL (variable)->value, bfwd);
+ }
+ else
+ bfwd = XSYMBOL_VALUE_LISP_MAGIC (valcontents);
+ bfwd->handler[htype] = handler;
+ bfwd->harg[htype] = harg;
+
+ for (i = 0; i < MAGIC_HANDLER_MAX; i++)
+ if (!NILP (bfwd->handler[i]))
+ break;
+
+ if (i == MAGIC_HANDLER_MAX)
+ /* there are no remaining handlers, so remove the structure. */
+ XSYMBOL (variable)->value = bfwd->shadowed;
+
+ return Qnil;
+}
+
+\f
+/* functions for working with variable aliases. */
+
+/* Follow the chain of variable aliases for OBJECT. Return the
+ resulting symbol, whose value cell is guaranteed not to be a
+ symbol-value-varalias.
+
+ Also maybe follow past symbol-value-lisp-magic -> symbol-value-varalias.
+ If FUNSYM is t, always follow in such a case. If FUNSYM is nil,
+ never follow; stop right there. Otherwise FUNSYM should be a
+ recognized symbol-value function symbol; this means, follow
+ unless there is a special handler for the named function.
+
+ OK, there is at least one reason why it's necessary for
+ FOLLOW-PAST-LISP-MAGIC to be specified correctly: So that we
+ can always be sure to catch cyclic variable aliasing. If we never
+ follow past Lisp magic, then if the following is done:
+
+ (defvaralias 'a 'b)
+ add some magic behavior to a, but not a "get-value" handler
+ (defvaralias 'b 'a)
+
+ then an attempt to retrieve a's or b's value would cause infinite
+ looping in `symbol-value'.
+
+ We (of course) can't always follow past Lisp magic, because then
+ we make any variable that is lisp-magic -> varalias behave as if
+ the lisp-magic is not present at all.
+ */
+
+static Lisp_Object
+follow_varalias_pointers (Lisp_Object object,
+ Lisp_Object follow_past_lisp_magic)
+{
+ Lisp_Object tortoise = object;
+ Lisp_Object hare = object;
+
+ /* quick out just in case */
+ if (!SYMBOL_VALUE_MAGIC_P (XSYMBOL (object)->value))
+ return object;
+
+ /* based off of indirect_function() */
+ for (;;)
+ {
+ Lisp_Object value;
+
+ value = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic);
+ if (!SYMBOL_VALUE_VARALIAS_P (value))
+ break;
+ hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (value));
+ value = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic);
+ if (!SYMBOL_VALUE_VARALIAS_P (value))
+ break;
+ hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (value));
+
+ value = fetch_value_maybe_past_magic (tortoise, follow_past_lisp_magic);
+ tortoise = symbol_value_varalias_aliasee
+ (XSYMBOL_VALUE_VARALIAS (value));
+
+ if (EQ (hare, tortoise))
+ return Fsignal (Qcyclic_variable_indirection, list1 (object));
+ }
+
+ return hare;
+}
+
+DEFUN ("defvaralias", Fdefvaralias, 2, 2, 0, /*
+Define a variable as an alias for another variable.
+Thenceforth, any operations performed on VARIABLE will actually be
+performed on ALIAS. Both VARIABLE and ALIAS should be symbols.
+If ALIAS is nil, remove any aliases for VARIABLE.
+ALIAS can itself be aliased, and the chain of variable aliases
+will be followed appropriately.
+If VARIABLE already has a value, this value will be shadowed
+until the alias is removed, at which point it will be restored.
+Currently VARIABLE cannot be a built-in variable, a variable that
+has a buffer-local value in any buffer, or the symbols nil or t.
+\(ALIAS, however, can be any type of variable.)
+*/
+ (variable, alias))
+{
+ struct symbol_value_varalias *bfwd;
+ Lisp_Object valcontents;
+
+ CHECK_SYMBOL (variable);
+ reject_constant_symbols (variable, Qunbound, 0, Qt);
+
+ valcontents = XSYMBOL (variable)->value;
+
+ if (NILP (alias))
+ {
+ if (SYMBOL_VALUE_VARALIAS_P (valcontents))
+ {
+ XSYMBOL (variable)->value =
+ symbol_value_varalias_shadowed
+ (XSYMBOL_VALUE_VARALIAS (valcontents));
+ }
+ return Qnil;
+ }
+
+ CHECK_SYMBOL (alias);
+ if (SYMBOL_VALUE_VARALIAS_P (valcontents))
+ {
+ /* transmogrify */
+ XSYMBOL_VALUE_VARALIAS (valcontents)->aliasee = alias;
+ return Qnil;
+ }
+
+ if (SYMBOL_VALUE_MAGIC_P (valcontents)
+ && !UNBOUNDP (valcontents))
+ signal_simple_error ("Variable is magic and cannot be aliased", variable);
+ reject_constant_symbols (variable, Qunbound, 0, Qt);
+
+ bfwd = alloc_lcrecord_type (struct symbol_value_varalias,
+ lrecord_symbol_value_varalias);
+ bfwd->magic.type = SYMVAL_VARALIAS;
+ bfwd->aliasee = alias;
+ bfwd->shadowed = valcontents;
+
+ XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
+ XSYMBOL (variable)->value = valcontents;
+ return Qnil;
+}
+
+DEFUN ("variable-alias", Fvariable_alias, 1, 2, 0, /*
+If VARIABLE is aliased to another variable, return that variable.
+VARIABLE should be a symbol. If VARIABLE is not aliased, return nil.
+Variable aliases are created with `defvaralias'. See also
+`indirect-variable'.
+*/
+ (variable, follow_past_lisp_magic))
+{
+ Lisp_Object valcontents;
+
+ CHECK_SYMBOL (variable);
+ if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
+ {
+ CHECK_SYMBOL (follow_past_lisp_magic);
+ handler_type_from_function_symbol (follow_past_lisp_magic, 0);
+ }
+
+ valcontents = fetch_value_maybe_past_magic (variable,
+ follow_past_lisp_magic);
+
+ if (SYMBOL_VALUE_VARALIAS_P (valcontents))
+ return symbol_value_varalias_aliasee
+ (XSYMBOL_VALUE_VARALIAS (valcontents));
+ else
+ return Qnil;
+}
+
+DEFUN ("indirect-variable", Findirect_variable, 1, 2, 0, /*
+Return the variable at the end of OBJECT's variable-alias chain.
+If OBJECT is a symbol, follow all variable aliases and return
+the final (non-aliased) symbol. Variable aliases are created with
+the function `defvaralias'.
+If OBJECT is not a symbol, just return it.
+Signal a cyclic-variable-indirection error if there is a loop in the
+variable chain of symbols.
+*/
+ (object, follow_past_lisp_magic))
+{
+ if (!SYMBOLP (object))
+ return object;
+ if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
+ {
+ CHECK_SYMBOL (follow_past_lisp_magic);
+ handler_type_from_function_symbol (follow_past_lisp_magic, 0);
+ }
+ return follow_varalias_pointers (object, follow_past_lisp_magic);
+}
+
+\f
+/************************************************************************/
+/* initialization */
+/************************************************************************/
+
+/* A dumped XEmacs image has a lot more than 1511 symbols. Last
+ estimate was that there were actually around 6300. So let's try
+ making this bigger and see if we get better hashing behavior. */
+#define OBARRAY_SIZE 16411
+
+#ifndef Qzero
+Lisp_Object Qzero;
+#endif
+#ifndef Qnull_pointer
+Lisp_Object Qnull_pointer;
+#endif
+
+/* 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;
+
+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 a actually a no-op. */
+ XSETOBJ (Qnull_pointer, (enum Lisp_Type) 0, 0);
+#endif
+
+ /* see comment in Fpurecopy() */
+ Vpure_uninterned_symbol_table =
+ make_lisp_hashtable (50, HASHTABLE_NONWEAK, HASHTABLE_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
+ called the first time. */
+ XSYMBOL (Qnil)->name->plist = Qnil;
+ XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihil */
+ XSYMBOL (Qnil)->plist = Qnil;
+
+ Vobarray = make_vector (OBARRAY_SIZE, Qzero);
+ initial_obarray = Vobarray;
+ staticpro (&initial_obarray);
+ /* Intern nil in the obarray */
+ {
+ int hash = hash_string (string_data (XSYMBOL (Qnil)->name), 3);
+ XVECTOR_DATA (Vobarray)[hash % OBARRAY_SIZE] = Qnil;
+ XSYMBOL (Qnil)->obarray = Qt;
+ }
+
+ {
+ /* Required to get around a GCC syntax error on certain
+ architectures */
+ struct symbol_value_magic *tem = &guts_of_unbound_marker;
+
+ XSETSYMBOL_VALUE_MAGIC (Qunbound, tem);
+ }
+ if ((CONST void *) XPNTR (Qunbound) !=
+ (CONST void *)&guts_of_unbound_marker)
+ {
+ /* This might happen on DATA_SEG_BITS machines. */
+ /* abort (); */
+ /* Can't represent a pointer to constant C data using a Lisp_Object.
+ So heap-allocate it. */
+ struct symbol_value_magic *urk = xnew (struct symbol_value_magic);
+ memcpy (urk, &guts_of_unbound_marker, sizeof (*urk));
+ XSETSYMBOL_VALUE_MAGIC (Qunbound, urk);
+ }
+
+ XSYMBOL (Qnil)->function = Qunbound;
+
+ defsymbol (&Qt, "t");
+ XSYMBOL (Qt)->value = Qt; /* Veritas aetera */
+ Vquit_flag = Qnil;
+}
+
+void
+defsymbol (Lisp_Object *location, CONST char *name)
+{
+ *location = Fintern (make_pure_pname ((CONST Bufbyte *) name,
+ strlen (name), 1),
+ Qnil);
+ staticpro (location);
+}
+
+void
+defkeyword (Lisp_Object *location, CONST char *name)
+{
+ defsymbol (location, name);
+ Fset (*location, *location);
+}
+
+void
+defsubr (struct Lisp_Subr *subr)
+{
+ Lisp_Object sym = intern (subr_name (subr));
+
+#ifdef DEBUG_XEMACS
+ /* Check that nobody spazzed writing a DEFUN. */
+ assert (subr->min_args >= 0);
+ assert (subr->min_args <= SUBR_MAX_ARGS);
+
+ if (subr->max_args != MANY && subr->max_args != UNEVALLED)
+ {
+ /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */
+ assert (subr->max_args <= SUBR_MAX_ARGS);
+ assert (subr->min_args <= subr->max_args);
+ }
+
+ assert (UNBOUNDP (XSYMBOL (sym)->function));
+#endif /* DEBUG_XEMACS */
+
+ XSETSUBR (XSYMBOL (sym)->function, subr);
+}
+
+void
+deferror (Lisp_Object *symbol, CONST char *name, CONST char *messuhhj,
+ Lisp_Object inherits_from)
+{
+ Lisp_Object conds;
+ defsymbol (symbol, name);
+
+ assert (SYMBOLP (inherits_from));
+ conds = Fget (inherits_from, Qerror_conditions, Qnil);
+ pure_put (*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));
+}
+
+void
+syms_of_symbols (void)
+{
+ defsymbol (&Qvariable_documentation, "variable-documentation");
+ defsymbol (&Qvariable_domain, "variable-domain"); /* I18N3 */
+ defsymbol (&Qad_advice_info, "ad-advice-info");
+ defsymbol (&Qad_activate, "ad-activate");
+
+ defsymbol (&Qget_value, "get-value");
+ defsymbol (&Qset_value, "set-value");
+ defsymbol (&Qbound_predicate, "bound-predicate");
+ defsymbol (&Qmake_unbound, "make-unbound");
+ defsymbol (&Qlocal_predicate, "local-predicate");
+ defsymbol (&Qmake_local, "make-local");
+
+ defsymbol (&Qboundp, "boundp");
+ defsymbol (&Qfboundp, "fboundp");
+ defsymbol (&Qglobally_boundp, "globally-boundp");
+ defsymbol (&Qmakunbound, "makunbound");
+ defsymbol (&Qsymbol_value, "symbol-value");
+ defsymbol (&Qset, "set");
+ defsymbol (&Qdefault_boundp, "default-boundp");
+ defsymbol (&Qdefault_value, "default-value");
+ defsymbol (&Qset_default, "set-default");
+ defsymbol (&Qmake_variable_buffer_local, "make-variable-buffer-local");
+ defsymbol (&Qmake_local_variable, "make-local-variable");
+ defsymbol (&Qkill_local_variable, "kill-local-variable");
+ defsymbol (&Qkill_console_local_variable, "kill-console-local-variable");
+ defsymbol (&Qsymbol_value_in_buffer, "symbol-value-in-buffer");
+ defsymbol (&Qsymbol_value_in_console, "symbol-value-in-console");
+ defsymbol (&Qlocal_variable_p, "local-variable-p");
+
+ defsymbol (&Qconst_integer, "const-integer");
+ defsymbol (&Qconst_boolean, "const-boolean");
+ defsymbol (&Qconst_object, "const-object");
+ defsymbol (&Qconst_specifier, "const-specifier");
+ defsymbol (&Qdefault_buffer, "default-buffer");
+ defsymbol (&Qcurrent_buffer, "current-buffer");
+ defsymbol (&Qconst_current_buffer, "const-current-buffer");
+ defsymbol (&Qdefault_console, "default-console");
+ defsymbol (&Qselected_console, "selected-console");
+ defsymbol (&Qconst_selected_console, "const-selected-console");
+
+ DEFSUBR (Fintern);
+ DEFSUBR (Fintern_soft);
+ DEFSUBR (Funintern);
+ DEFSUBR (Fmapatoms);
+ DEFSUBR (Fapropos_internal);
+
+ DEFSUBR (Fsymbol_function);
+ DEFSUBR (Fsymbol_plist);
+ DEFSUBR (Fsymbol_name);
+ DEFSUBR (Fmakunbound);
+ DEFSUBR (Ffmakunbound);
+ DEFSUBR (Fboundp);
+ DEFSUBR (Fglobally_boundp);
+ DEFSUBR (Ffboundp);
+ DEFSUBR (Ffset);
+ DEFSUBR (Fdefine_function);
+ DEFSUBR (Fsetplist);
+ DEFSUBR (Fsymbol_value_in_buffer);
+ DEFSUBR (Fsymbol_value_in_console);
+ DEFSUBR (Fbuilt_in_variable_type);
+ DEFSUBR (Fsymbol_value);
+ DEFSUBR (Fset);
+ DEFSUBR (Fdefault_boundp);
+ DEFSUBR (Fdefault_value);
+ DEFSUBR (Fset_default);
+ DEFSUBR (Fsetq_default);
+ DEFSUBR (Fmake_variable_buffer_local);
+ DEFSUBR (Fmake_local_variable);
+ DEFSUBR (Fkill_local_variable);
+ DEFSUBR (Fkill_console_local_variable);
+ DEFSUBR (Flocal_variable_p);
+ DEFSUBR (Fdefvaralias);
+ DEFSUBR (Fvariable_alias);
+ DEFSUBR (Findirect_variable);
+ DEFSUBR (Fdontusethis_set_symbol_value_handler);
+}
+
+/* Create and initialize a variable whose value is forwarded to C data */
+void
+defvar_mumble (CONST char *namestring, CONST void *magic, size_t sizeof_magic)
+{
+ Lisp_Object kludge;
+ Lisp_Object sym = Fintern (make_pure_pname ((CONST Bufbyte *) namestring,
+ strlen (namestring),
+ 1),
+ Qnil);
+
+ /* Check that magic points somewhere we can represent as a Lisp pointer */
+ XSETOBJ (kludge, Lisp_Type_Record, magic);
+ if (magic != (CONST void *) XPNTR (kludge))
+ {
+ /* This might happen on DATA_SEG_BITS machines. */
+ /* abort (); */
+ /* Copy it to somewhere which is representable. */
+ void *f = xmalloc (sizeof_magic);
+ memcpy (f, magic, sizeof_magic);
+ XSETOBJ (XSYMBOL (sym)->value, Lisp_Type_Record, f);
+ }
+ else
+ XSETOBJ (XSYMBOL (sym)->value, Lisp_Type_Record, magic);
+}
+
+void
+vars_of_symbols (void)
+{
+ DEFVAR_LISP ("obarray", &Vobarray /*
+Symbol table for use by `intern' and `read'.
+It is a vector whose length ought to be prime for best results.
+The vector's contents don't make sense if examined from Lisp programs;
+to find all the symbols in an obarray, use `mapatoms'.
+*/ );
+ /* obarray has been initialized long before */
+}
--- /dev/null
+/* Various initialization function prototypes.
+ Copyright (C) 1995 Board of Trustees, University of Illinois.
+
+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 _XEMACS_SYMSINIT_H_
+#define _XEMACS_SYMSINIT_H_
+
+/* Earliest environment initializations (dump-time and run-time). */
+
+void init_data_very_early (void);
+void init_floatfns_very_early (void);
+void init_free_hook (void);
+void init_intl_very_early (void);
+void init_process_times_very_early (void);
+void init_ralloc (void);
+void init_signals_very_early (void);
+
+/* Early Lisp-engine initialization (dump-time only). */
+
+void init_alloc_once_early (void);
+void init_symbols_once_early (void);
+void init_errors_once_early (void);
+void init_opaque_once_early (void);
+
+/* Declare the built-in symbols and primitives (dump-time only). */
+
+void syms_of_abbrev (void);
+void syms_of_alloc (void);
+void syms_of_balloon_x (void);
+void syms_of_buffer (void);
+void syms_of_bytecode (void);
+void syms_of_callint (void);
+void syms_of_callproc (void);
+void syms_of_casefiddle (void);
+void syms_of_casetab (void);
+void syms_of_chartab (void);
+void syms_of_cmdloop (void);
+void syms_of_cmds (void);
+void syms_of_console_tty (void);
+void syms_of_console_mswindows (void);
+void syms_of_console (void);
+void syms_of_data (void);
+void syms_of_database (void);
+void syms_of_debug (void);
+void syms_of_device_tty (void);
+void syms_of_device_mswindows (void);
+void syms_of_device_x (void);
+void syms_of_device (void);
+void syms_of_dialog_x (void);
+void syms_of_dialog (void);
+void syms_of_dired (void);
+void syms_of_dired_mswindows (void);
+void syms_of_dll (void);
+void syms_of_doc (void);
+void syms_of_dragdrop (void);
+void syms_of_editfns (void);
+void syms_of_elhash (void);
+void syms_of_emacs (void);
+void syms_of_eval (void);
+void syms_of_event_stream (void);
+void syms_of_event_mswindows (void);
+void syms_of_event_Xt (void);
+void syms_of_events (void);
+void syms_of_extents (void);
+void syms_of_faces (void);
+void syms_of_fileio (void);
+void syms_of_filelock (void);
+void syms_of_floatfns (void);
+void syms_of_fns (void);
+void syms_of_font_lock (void);
+void syms_of_frame (void);
+void syms_of_frame_mswindows (void);
+void syms_of_frame_x (void);
+void syms_of_free_hook (void);
+void syms_of_general (void);
+void syms_of_glyphs_x (void);
+void syms_of_glyphs_eimage (void);
+void syms_of_glyphs_mswindows (void);
+void syms_of_glyphs (void);
+void syms_of_gui_x (void);
+void syms_of_gui (void);
+void syms_of_indent (void);
+void syms_of_intl (void);
+void syms_of_keymap (void);
+void syms_of_lread (void);
+void syms_of_macros (void);
+void syms_of_marker (void);
+void syms_of_md5 (void);
+void syms_of_menubar_x (void);
+void syms_of_menubar (void);
+void syms_of_menubar_mswindows (void);
+void syms_of_minibuf (void);
+void syms_of_mule (void);
+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_mule_wnn (void);
+void syms_of_objects_tty (void);
+void syms_of_objects_x (void);
+void syms_of_objects_mswindows (void);
+void syms_of_objects (void);
+void syms_of_print (void);
+void syms_of_process (void);
+void syms_of_process_nt (void);
+void syms_of_profile (void);
+void syms_of_ralloc (void);
+void syms_of_rangetab (void);
+void syms_of_redisplay (void);
+void syms_of_scrollbar (void);
+void syms_of_scrollbar_mswindows(void);
+void syms_of_search (void);
+void syms_of_select_mswindows (void);
+void syms_of_signal (void);
+void syms_of_sound (void);
+void syms_of_specifier (void);
+void syms_of_sunpro (void);
+void syms_of_symbols (void);
+void syms_of_syntax (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_eldap (void);
+
+/* Initialize the console types (dump-time only). */
+
+void console_type_create (void);
+void console_type_create_stream (void);
+void 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 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_toolbar_x (void);
+void console_type_create_dialog_x (void);
+void 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);
+void console_type_create_objects_mswindows (void);
+void console_type_create_redisplay_mswindows (void);
+void console_type_create_scrollbar_mswindows (void);
+void console_type_create_toolbar_mswindows (void);
+void console_type_create_glyphs_mswindows (void);
+void console_type_create_dialog_mswindows (void);
+
+/* Initialize the specifier types (dump-time only). */
+
+void specifier_type_create (void);
+void specifier_type_create_image (void);
+void specifier_type_create_objects (void);
+void specifier_type_create_toolbar (void);
+
+/* Initialize the structure types (dump-time only). */
+
+void structure_type_create (void);
+void structure_type_create_chartab (void);
+void structure_type_create_faces (void);
+void structure_type_create_rangetab (void);
+void structure_type_create_hashtable (void);
+
+/* Initialize the image instantiator types (dump-time only). */
+
+void image_instantiator_format_create (void);
+void image_instantiator_format_create_glyphs_eimage (void);
+void image_instantiator_format_create_glyphs_x (void);
+void image_instantiator_format_create_glyphs_mswindows (void);
+
+/* Initialize the lstream types (dump-time only). */
+
+void lstream_type_create (void);
+void lstream_type_create_mule_coding (void);
+void lstream_type_create_print (void);
+void lstream_type_create_mswindows_selectable (void);
+
+/* Initialize process types */
+
+void process_type_create_nt (void);
+void process_type_create_unix (void);
+
+/* Allow for Fprovide() (dump-time only). */
+
+void init_provide_once (void);
+
+/* Initialize most variables (dump-time only). */
+
+void vars_of_abbrev (void);
+void vars_of_alloc (void);
+void vars_of_balloon_x (void);
+void vars_of_buffer (void);
+void vars_of_bytecode (void);
+void vars_of_callint (void);
+void vars_of_callproc (void);
+void vars_of_cmdloop (void);
+void vars_of_cmds (void);
+void 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 vars_of_device (void);
+void vars_of_device_mswindows (void);
+void vars_of_device_x (void);
+void vars_of_dialog (void);
+void vars_of_dialog_x (void);
+void vars_of_dialog_mswindows (void);
+void vars_of_dired (void);
+void vars_of_dired_mswindows (void);
+void vars_of_doc (void);
+void vars_of_dragdrop (void);
+void vars_of_editfns (void);
+void vars_of_elhash (void);
+void vars_of_emacs (void);
+void vars_of_eval (void);
+void vars_of_event_stream (void);
+void vars_of_event_tty (void);
+void vars_of_event_mswindows (void);
+void vars_of_event_Xt (void);
+void vars_of_events (void);
+void 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 vars_of_frame_tty (void);
+void 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_mswindows (void);
+void vars_of_glyphs (void);
+void vars_of_gui_x (void);
+void vars_of_gui (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 vars_of_intl (void);
+void vars_of_keymap (void);
+void vars_of_lread (void);
+void vars_of_lstream (void);
+void vars_of_macros (void);
+void vars_of_md5 (void);
+void vars_of_menubar_x (void);
+void vars_of_menubar (void);
+void vars_of_menubar_mswindows (void);
+void vars_of_minibuf (void);
+void vars_of_mule (void);
+void vars_of_mule_canna (void);
+void vars_of_mule_charset (void);
+void vars_of_mule_coding (void);
+void vars_of_mule_wnn (void);
+void 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 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 vars_of_scrollbar_x (void);
+void vars_of_scrollbar (void);
+void vars_of_scrollbar_mswindows (void);
+void vars_of_search (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_toolbar (void);
+void vars_of_tooltalk (void);
+void vars_of_undo (void);
+void vars_of_window (void);
+void vars_of_xselect (void);
+void vars_of_eldap (void);
+
+/* Initialize specifier variables (dump-time only). */
+
+void specifier_vars_of_glyphs (void);
+void specifier_vars_of_menubar (void);
+void specifier_vars_of_redisplay (void);
+void specifier_vars_of_scrollbar (void);
+void specifier_vars_of_toolbar (void);
+void specifier_vars_of_window (void);
+
+/* Initialize variables with complex dependencies
+ on other variables (dump-time only). */
+
+void complex_vars_of_regex (void);
+void complex_vars_of_search (void);
+void complex_vars_of_event_stream (void);
+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_glyphs (void);
+void complex_vars_of_glyphs_x (void);
+void complex_vars_of_glyphs_mswindows (void);
+void complex_vars_of_alloc (void);
+void complex_vars_of_menubar (void);
+void complex_vars_of_scrollbar (void);
+void complex_vars_of_frame (void);
+void complex_vars_of_casetab (void);
+void complex_vars_of_syntax (void);
+void complex_vars_of_chartab (void);
+void complex_vars_of_buffer (void);
+void complex_vars_of_console (void);
+void complex_vars_of_emacs (void);
+void 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). */
+
+void reinit_alloc (void);
+void reinit_eval (void);
+
+/* Late initialization -- stuff pertaining only to interactive usage,
+ I/O, or Lisp reading. (Dump-time and run-time.) */
+
+void init_buffer (void);
+void init_callproc (void);
+void init_console_stream (void);
+void init_device_tty (void);
+void init_dosfns (void);
+void init_editfns (void);
+void init_environment (void);
+void init_event_Xt_late (void);
+void init_event_stream (void);
+void init_event_tty_late (void);
+void init_event_mswindows_late (void);
+void init_event_unixoid (void);
+void init_hpplay (void);
+void init_lread (void);
+void init_macros (void);
+void init_ntproc (void); /* #### delete me, please! */
+/* Not named init_process in order to avoid conflict with NS 3.3 */
+void init_xemacs_process (void);
+void init_redisplay (void);
+void init_sunpro (void);
+
+#endif /* _XEMACS_SYMSINIT_H_ */
--- /dev/null
+/* XEmacs routines to deal with syntax tables; also word and list parsing.
+ Copyright (C) 1985-1994 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: FSF 19.28. */
+
+/* This file has been Mule-ized. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "commands.h"
+#include "insdel.h"
+#include "syntax.h"
+
+/* Here is a comment from Ken'ichi HANDA <handa@etl.go.jp>
+ explaining the purpose of the Sextword syntax category:
+
+Japanese words are not separated by spaces, which makes finding word
+boundaries very difficult. Theoretically it's impossible without
+using natural language processing techniques. But, by defining
+pseudo-words as below (much simplified for letting you understand it
+easily) for Japanese, we can have a convenient forward-word function
+for Japanese.
+
+ A Japanese word is a sequence of characters that consists of
+ zero or more Kanji characters followed by zero or more
+ Hiragana characters.
+
+Then, the problem is that now we can't say that a sequence of
+word-constituents makes up a WORD. For instance, both Hiragana "A"
+and Kanji "KAN" are word-constituents but the sequence of these two
+letters can't be a single word.
+
+So, we introduced Sextword for Japanese letters. A character of
+Sextword is a word-constituent but a word boundary may exist between
+two such characters. */
+
+/* Mule 2.4 doesn't seem to have Sextword - I'm removing it -- mrb */
+
+Lisp_Object Qsyntax_table_p;
+
+int words_include_escapes;
+
+int parse_sexp_ignore_comments;
+
+/* The following two variables are provided to tell additional information
+ to the regex routines. We do it this way rather than change the
+ arguments to re_search_2() in an attempt to maintain some call
+ compatibility with other versions of the regex code. */
+
+/* Tell the regex routines not to QUIT. Normally there is a QUIT
+ each iteration in re_search_2(). */
+int no_quit_in_re_search;
+
+/* Tell the regex routines which buffer to access for SYNTAX() lookups
+ and the like. */
+struct buffer *regex_emacs_buffer;
+
+Lisp_Object Vstandard_syntax_table;
+
+Lisp_Object Vsyntax_designator_chars_string;
+
+/* This is the internal form of the parse state used in parse-partial-sexp. */
+
+struct lisp_parse_state
+{
+ int depth; /* Depth at end of parsing */
+ Emchar instring; /* -1 if not within string, else desired terminator */
+ int incomment; /* Nonzero if within a comment at end of parsing */
+ int comstyle; /* comment style a=0, or b=1 */
+ int quoted; /* Nonzero if just after an escape char at end of
+ parsing */
+ Bufpos thislevelstart;/* Char number of most recent start-of-expression
+ at current level */
+ Bufpos prevlevelstart;/* Char number of start of containing expression */
+ Bufpos location; /* Char number at which parsing stopped */
+ int mindepth; /* Minimum depth seen while scanning */
+ Bufpos comstart; /* Position just after last comment starter */
+};
+\f
+/* These variables are a cache for finding the start of a defun.
+ find_start_pos is the place for which the defun start was found.
+ find_start_value is the defun start position found for it.
+ find_start_buffer is the buffer it was found in.
+ find_start_begv is the BEGV value when it was found.
+ find_start_modiff is the value of MODIFF when it was found. */
+
+static Bufpos find_start_pos;
+static Bufpos find_start_value;
+static struct buffer *find_start_buffer;
+static Bufpos find_start_begv;
+static int find_start_modiff;
+
+/* Find a defun-start that is the last one before POS (or nearly the last).
+ We record what we find, so that another call in the same area
+ can return the same value right away. */
+
+static Bufpos
+find_defun_start (struct buffer *buf, Bufpos pos)
+{
+ Bufpos tem;
+ struct 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
+ /* Reuse the defun-start even if POS is a little farther on.
+ POS might be in the next defun, but that's ok.
+ Our value may not be the best possible, but will still be usable. */
+ && pos <= find_start_pos + 1000
+ && pos >= find_start_value
+ && BUF_BEGV (buf) == find_start_begv
+ && BUF_MODIFF (buf) == find_start_modiff)
+ return find_start_value;
+
+ /* Back up to start of line. */
+ tem = find_next_newline (buf, pos, -1);
+
+ while (tem > BUF_BEGV (buf))
+ {
+ /* Open-paren at start of line means we found our defun-start. */
+ if (SYNTAX (mirrortab, BUF_FETCH_CHAR (buf, tem)) == Sopen)
+ break;
+ /* Move to beg of previous line. */
+ tem = find_next_newline (buf, tem, -2);
+ }
+
+ /* Record what we found, for the next try. */
+ find_start_value = tem;
+ find_start_buffer = buf;
+ find_start_modiff = BUF_MODIFF (buf);
+ find_start_begv = BUF_BEGV (buf);
+ find_start_pos = pos;
+
+ return find_start_value;
+}
+\f
+DEFUN ("syntax-table-p", Fsyntax_table_p, 1, 1, 0, /*
+Return t if ARG is a syntax table.
+Any vector of 256 elements will do.
+*/
+ (obj))
+{
+ return CHAR_TABLEP (obj) && XCHAR_TABLE_TYPE (obj) == CHAR_TABLE_TYPE_SYNTAX
+ ? Qt : Qnil;
+}
+
+static Lisp_Object
+check_syntax_table (Lisp_Object obj, Lisp_Object default_)
+{
+ if (NILP (obj))
+ obj = default_;
+ while (NILP (Fsyntax_table_p (obj)))
+ obj = wrong_type_argument (Qsyntax_table_p, obj);
+ return obj;
+}
+
+DEFUN ("syntax-table", Fsyntax_table, 0, 1, 0, /*
+Return the current syntax table.
+This is the one specified by the current buffer, or by BUFFER if it
+is non-nil.
+*/
+ (buffer))
+{
+ return decode_buffer (buffer, 0)->syntax_table;
+}
+
+DEFUN ("standard-syntax-table", Fstandard_syntax_table, 0, 0, 0, /*
+Return the standard syntax table.
+This is the one used for new buffers.
+*/
+ ())
+{
+ return Vstandard_syntax_table;
+}
+
+DEFUN ("copy-syntax-table", Fcopy_syntax_table, 0, 1, 0, /*
+Construct a new syntax table and return it.
+It is a copy of the TABLE, which defaults to the standard syntax table.
+*/
+ (table))
+{
+ if (NILP (Vstandard_syntax_table))
+ return Fmake_char_table (Qsyntax);
+
+ table = check_syntax_table (table, Vstandard_syntax_table);
+ return Fcopy_char_table (table);
+}
+
+DEFUN ("set-syntax-table", Fset_syntax_table, 1, 2, 0, /*
+Select a new syntax table for BUFFER.
+One argument, a syntax table.
+BUFFER defaults to the current buffer if omitted.
+*/
+ (table, buffer))
+{
+ struct buffer *buf = decode_buffer (buffer, 0);
+ table = check_syntax_table (table, Qnil);
+ buf->syntax_table = table;
+ buf->mirror_syntax_table = XCHAR_TABLE (table)->mirror_table;
+ /* Indicate that this buffer now has a specified syntax table. */
+ buf->local_var_flags |= XINT (buffer_local_flags.syntax_table);
+ return table;
+}
+\f
+/* Convert a letter which signifies a syntax code
+ into the code it signifies.
+ This is used by modify-syntax-entry, and other things. */
+
+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,
+ 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
+ (char) Swhitespace, 0377, (char) Sstring, 0377,
+ (char) Smath, 0377, 0377, (char) Squote,
+ (char) Sopen, (char) Sclose, 0377, 0377,
+ 0377, (char) Swhitespace, (char) Spunct, (char) Scharquote,
+ 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
+ 0377, 0377, 0377, 0377,
+ (char) Scomment, 0377, (char) Sendcomment, 0377,
+ (char) Sinherit, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* @, A ... */
+ 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
+ 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
+ 0377, 0377, 0377, 0377, (char) Sescape, 0377, 0377, (char) Ssymbol,
+ 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* `, a, ... */
+ 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
+ 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
+ 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377
+};
+
+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.
+The chars are ordered by their internal syntax codes, which are
+numbered starting at 0.
+*/
+ ())
+{
+ return Vsyntax_designator_chars_string;
+}
+
+DEFUN ("char-syntax", Fchar_syntax, 1, 2, 0, /*
+Return the syntax code of CHAR, described by a character.
+For example, if CHAR is a word constituent, the character `?w' is returned.
+The characters that correspond to various syntax codes
+are listed in the documentation of `modify-syntax-entry'.
+Optional second argument TABLE defaults to the current buffer's
+syntax table.
+*/
+ (ch, table))
+{
+ struct Lisp_Char_Table *mirrortab;
+
+ if (NILP(ch))
+ {
+ ch = make_char('\000');
+ }
+ CHECK_CHAR_COERCE_INT (ch);
+ table = check_syntax_table (table, current_buffer->syntax_table);
+ mirrortab = XCHAR_TABLE (XCHAR_TABLE (table)->mirror_table);
+ return make_char (syntax_code_spec[(int) SYNTAX (mirrortab, XCHAR (ch))]);
+}
+
+#ifdef MULE
+
+enum syntaxcode
+charset_syntax (struct buffer *buf, Lisp_Object charset, int *multi_p_out)
+{
+ *multi_p_out = 1;
+ /* #### get this right */
+ return Spunct;
+}
+
+#endif
+
+Lisp_Object
+syntax_match (Lisp_Object table, Emchar ch)
+{
+ Lisp_Object code = CHAR_TABLE_VALUE_UNSAFE (XCHAR_TABLE (table), ch);
+ Lisp_Object code2 = code;
+
+ if (CONSP (code))
+ code2 = XCAR (code);
+ if (SYNTAX_FROM_CODE (XINT (code2)) == Sinherit)
+ code = CHAR_TABLE_VALUE_UNSAFE (XCHAR_TABLE (Vstandard_syntax_table),
+ ch);
+
+ return CONSP (code) ? XCDR (code) : Qnil;
+}
+
+DEFUN ("matching-paren", Fmatching_paren, 1, 2, 0, /*
+Return the matching parenthesis of CHAR, or nil if none.
+Optional second argument TABLE defaults to the current buffer's
+syntax table.
+*/
+ (ch, table))
+{
+ struct Lisp_Char_Table *mirrortab;
+ int code;
+
+ CHECK_CHAR_COERCE_INT (ch);
+ table = check_syntax_table (table, current_buffer->syntax_table);
+ mirrortab = XCHAR_TABLE (XCHAR_TABLE (table)->mirror_table);
+ code = SYNTAX (mirrortab, XCHAR (ch));
+ if (code == Sopen || code == Sclose || code == Sstring)
+ return syntax_match (table, XCHAR (ch));
+ return Qnil;
+}
+
+\f
+
+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));
+}
+
+/* Return the position across COUNT words from FROM.
+ If that many words cannot be found before the end of the buffer, return 0.
+ COUNT negative means scan backward and stop at word beginning. */
+
+Bufpos
+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);
+ while (count > 0)
+ {
+ QUIT;
+
+ while (1)
+ {
+ if (from == limit)
+ return 0;
+ if (word_constituent_p (buf, from, mirrortab))
+ break;
+ from++;
+ }
+
+ QUIT;
+
+ while ((from != limit) && word_constituent_p (buf, from, mirrortab))
+ {
+ from++;
+ }
+ count--;
+ }
+
+ while (count < 0)
+ {
+ QUIT;
+
+ while (1)
+ {
+ if (from == limit)
+ return 0;
+ if (word_constituent_p (buf, from - 1, mirrortab))
+ break;
+ from--;
+ }
+
+ QUIT;
+
+ while ((from != limit) && word_constituent_p (buf, from - 1, mirrortab))
+ {
+ from--;
+ }
+ count++;
+ }
+
+ return from;
+}
+
+DEFUN ("forward-word", Fforward_word, 1, 2, "_p", /*
+Move point forward ARG words (backward if ARG is negative).
+Normally returns t.
+If an edge of the buffer is reached, point is left there
+and nil is returned.
+*/
+ (count, buffer))
+{
+ Bufpos val;
+ struct buffer *buf = decode_buffer (buffer, 0);
+ CHECK_INT (count);
+
+ if (!(val = scan_words (buf, BUF_PT (buf), XINT (count))))
+ {
+ BUF_SET_PT (buf, XINT (count) > 0 ? BUF_ZV (buf) : BUF_BEGV (buf));
+ return Qnil;
+ }
+ BUF_SET_PT (buf, val);
+ return Qt;
+}
+\f
+static void scan_sexps_forward (struct buffer *buf,
+ struct lisp_parse_state *,
+ Bufpos from, Bufpos end,
+ int targetdepth, int stopbefore,
+ Lisp_Object oldstate,
+ int commentstop);
+
+static int
+find_start_of_comment (struct buffer *buf, Bufpos from, Bufpos stop, int mask)
+{
+ Emchar c;
+ enum syntaxcode code;
+ struct Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table);
+
+ /* Look back, counting the parity of string-quotes,
+ and recording the comment-starters seen.
+ When we reach a safe place, assume that's not in a string;
+ then step the main scan to the earliest comment-starter seen
+ an even number of string quotes away from the safe place.
+
+ OFROM[I] is position of the earliest comment-starter seen
+ which is I+2X quotes from the comment-end.
+ PARITY is current parity of quotes from the comment end. */
+ int parity = 0;
+ Emchar my_stringend = 0;
+ int string_lossage = 0;
+ Bufpos comment_end = from;
+ Bufpos comstart_pos = 0;
+ int comstart_parity = 0;
+ int styles_match_p = 0;
+
+ /* At beginning of range to scan, we're outside of strings;
+ that determines quote parity to the comment-end. */
+ while (from != stop)
+ {
+ /* Move back and examine a character. */
+ from--;
+
+ c = BUF_FETCH_CHAR (buf, from);
+ code = SYNTAX_UNSAFE (mirrortab, c);
+
+ /* is this a 1-char comment end sequence? if so, try
+ to see if style matches previously extracted mask */
+ if (code == Sendcomment)
+ {
+ styles_match_p = SYNTAX_STYLES_MATCH_1CHAR_P (mirrortab, c, mask);
+ }
+
+ /* otherwise, is this a 2-char comment end sequence? */
+ else if (from >= stop
+ && SYNTAX_END_P (mirrortab, c, BUF_FETCH_CHAR (buf, from+1)))
+ {
+ code = Sendcomment;
+ styles_match_p =
+ SYNTAX_STYLES_MATCH_END_P (mirrortab, c,
+ BUF_FETCH_CHAR (buf, from+1),
+ mask);
+ }
+
+ /* or are we looking at a 1-char comment start sequence
+ of the style matching mask? */
+ else if (code == Scomment
+ && SYNTAX_STYLES_MATCH_1CHAR_P (mirrortab, c, mask))
+ {
+ styles_match_p = 1;
+ }
+
+ /* or possibly, a 2-char comment start sequence */
+ else if (from >= stop
+ && SYNTAX_STYLES_MATCH_START_P (mirrortab, c,
+ BUF_FETCH_CHAR (buf, from+1),
+ mask))
+ {
+ code = Scomment;
+ styles_match_p = 1;
+ }
+
+ /* Ignore escaped characters. */
+ if (char_quoted (buf, from))
+ continue;
+
+ /* Track parity of quotes. */
+ if (code == Sstring)
+ {
+ parity ^= 1;
+ if (my_stringend == 0)
+ my_stringend = c;
+ /* If we have two kinds of string delimiters.
+ There's no way to grok this scanning backwards. */
+ else if (my_stringend != c)
+ string_lossage = 1;
+ }
+
+ /* Record comment-starters according to that
+ quote-parity to the comment-end. */
+ if (code == Scomment && styles_match_p)
+ {
+ comstart_parity = parity;
+ comstart_pos = from;
+ }
+
+ /* If we find another earlier comment-ender,
+ any comment-starts earlier than that don't count
+ (because they go with the earlier comment-ender). */
+ if (code == Sendcomment && styles_match_p)
+ break;
+
+ /* Assume a defun-start point is outside of strings. */
+ if (code == Sopen
+ && (from == stop || BUF_FETCH_CHAR (buf, from - 1) == '\n'))
+ break;
+ }
+
+ if (comstart_pos == 0)
+ from = comment_end;
+ /* If the earliest comment starter
+ is followed by uniform paired string quotes or none,
+ we know it can't be inside a string
+ since if it were then the comment ender would be inside one.
+ So it does start a comment. Skip back to it. */
+ else if (comstart_parity == 0 && !string_lossage)
+ from = comstart_pos;
+ else
+ {
+ /* We had two kinds of string delimiters mixed up
+ together. Decode this going forwards.
+ Scan fwd from the previous comment ender
+ to the one in question; this records where we
+ last passed a comment starter. */
+
+ struct lisp_parse_state state;
+ scan_sexps_forward (buf, &state, find_defun_start (buf, comment_end),
+ comment_end - 1, -10000, 0, Qnil, 0);
+ if (state.incomment)
+ from = state.comstart;
+ else
+ /* We can't grok this as a comment; scan it normally. */
+ from = comment_end;
+ }
+ return from;
+}
+
+static Bufpos
+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);
+
+ while (1)
+ {
+ if (from == stop)
+ {
+ return -1;
+ }
+ c = BUF_FETCH_CHAR (buf, from);
+ if (SYNTAX_UNSAFE (mirrortab, c) == Sendcomment
+ && SYNTAX_STYLES_MATCH_1CHAR_P (mirrortab, c, mask))
+ /* we have encountered a comment end of the same style
+ as the comment sequence which began this comment
+ section */
+ break;
+
+ from++;
+ if (from < stop
+ && SYNTAX_STYLES_MATCH_END_P (mirrortab, c,
+ BUF_FETCH_CHAR (buf, from), mask))
+ /* we have encountered a comment end of the same style
+ as the comment sequence which began this comment
+ section */
+ { from++; break; }
+ }
+ return from;
+}
+
+\f
+/* #### between FSF 19.23 and 19.28 there are some changes to the logic
+ in this function (and minor changes to find_start_of_comment(),
+ above, which is part of Fforward_comment() in FSF). Attempts to port
+ that logic made this function break, so I'm leaving it out. If anyone
+ ever complains about this function not working properly, take a look
+ at those changes. --ben */
+
+DEFUN ("forward-comment", Fforward_comment, 1, 2, 0, /*
+Move forward across up to N comments. If N is negative, move backward.
+Stop scanning if we find something other than a comment or whitespace.
+Set point to where scanning stops.
+If N comments are found as expected, with nothing except whitespace
+between them, return t; otherwise return nil.
+Point is set in either case.
+Optional argument BUFFER defaults to the current buffer.
+*/
+ (n, buffer))
+{
+ Bufpos from;
+ Bufpos stop;
+ Emchar c;
+ enum syntaxcode code;
+ int count;
+ struct buffer *buf = decode_buffer (buffer, 0);
+ struct Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table);
+
+ CHECK_INT (n);
+ count = XINT (n);
+
+ from = BUF_PT (buf);
+
+ while (count > 0)
+ {
+ QUIT;
+
+ stop = BUF_ZV (buf);
+ while (from < stop)
+ {
+ int mask = 0; /* mask for finding matching comment style */
+
+ if (char_quoted (buf, from))
+ {
+ from++;
+ continue;
+ }
+
+ c = BUF_FETCH_CHAR (buf, from);
+ code = SYNTAX (mirrortab, c);
+
+ if (code == Scomment)
+ {
+ /* we have encountered a single character comment start
+ sequence, and we are ignoring all text inside comments.
+ we must record the comment style this character begins
+ so that later, only a comment end of the same style actually
+ ends the comment section */
+ mask = SYNTAX_COMMENT_1CHAR_MASK (mirrortab, c);
+ }
+
+ else if (from < stop
+ && SYNTAX_START_P (mirrortab, c, BUF_FETCH_CHAR (buf, from+1)))
+ {
+ /* we have encountered a 2char comment start sequence and we
+ are ignoring all text inside comments. we must record
+ the comment style this sequence begins so that later,
+ only a comment end of the same style actually ends
+ the comment section */
+ code = Scomment;
+ mask = SYNTAX_COMMENT_MASK_START (mirrortab, c,
+ BUF_FETCH_CHAR (buf, from+1));
+ from++;
+ }
+
+ if (code == Scomment)
+ {
+ Bufpos newfrom;
+
+ newfrom = find_end_of_comment (buf, from, stop, mask);
+ if (newfrom < 0)
+ {
+ /* we stopped because from==stop */
+ BUF_SET_PT (buf, stop);
+ return Qnil;
+ }
+ from = newfrom;
+
+ /* We have skipped one comment. */
+ break;
+ }
+ else if (code != Swhitespace
+ && code != Sendcomment
+ && code != Scomment )
+ {
+ BUF_SET_PT (buf, from);
+ return Qnil;
+ }
+ from++;
+ }
+
+ /* End of comment reached */
+ count--;
+ }
+
+ while (count < 0)
+ {
+ QUIT;
+
+ stop = BUF_BEGV (buf);
+ while (from > stop)
+ {
+ int mask = 0; /* mask for finding matching comment style */
+
+ from--;
+ if (char_quoted (buf, from))
+ {
+ from--;
+ continue;
+ }
+
+ c = BUF_FETCH_CHAR (buf, from);
+ code = SYNTAX (mirrortab, c);
+
+ if (code == Sendcomment)
+ {
+ /* we have found a single char end comment. we must record
+ the comment style encountered so that later, we can match
+ only the proper comment begin sequence of the same style */
+ mask = SYNTAX_COMMENT_1CHAR_MASK (mirrortab, c);
+ }
+
+ else if (from > stop
+ && SYNTAX_END_P (mirrortab, BUF_FETCH_CHAR (buf, from - 1), c)
+ && !char_quoted (buf, from - 1))
+ {
+ /* We must record the comment style encountered so that
+ later, we can match only the proper comment begin
+ sequence of the same style. */
+ code = Sendcomment;
+ mask = SYNTAX_COMMENT_MASK_END (mirrortab,
+ BUF_FETCH_CHAR (buf, from - 1),
+ c);
+ from--;
+ }
+
+ if (code == Sendcomment)
+ {
+ from = find_start_of_comment (buf, from, stop, mask);
+ break;
+ }
+
+ else if (code != Swhitespace
+ && SYNTAX (mirrortab, c) != Scomment
+ && SYNTAX (mirrortab, c) != Sendcomment)
+ {
+ BUF_SET_PT (buf, from + 1);
+ return Qnil;
+ }
+ }
+
+ count++;
+ }
+
+ BUF_SET_PT (buf, from);
+ return Qt;
+}
+
+\f
+Lisp_Object
+scan_lists (struct buffer *buf, Bufpos from, int count, int depth,
+ int sexpflag, int no_error)
+{
+ Bufpos stop;
+ Emchar c;
+ int quoted;
+ int mathexit = 0;
+ 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);
+
+ if (depth > 0) min_depth = 0;
+
+ while (count > 0)
+ {
+ QUIT;
+
+ stop = BUF_ZV (buf);
+ while (from < stop)
+ {
+ int mask = 0; /* mask for finding matching comment style */
+
+ c = BUF_FETCH_CHAR (buf, from);
+ code = SYNTAX_UNSAFE (mirrortab, c);
+ from++;
+
+ /* a 1-char comment start sequence */
+ if (code == Scomment && parse_sexp_ignore_comments)
+ {
+ mask = SYNTAX_COMMENT_1CHAR_MASK (mirrortab, c);
+ }
+
+ /* else, a 2-char comment start sequence? */
+ else if (from < stop
+ && SYNTAX_START_P (mirrortab, c, BUF_FETCH_CHAR (buf, from))
+ && parse_sexp_ignore_comments)
+ {
+ /* we have encountered a comment start sequence and we
+ are ignoring all text inside comments. we must record
+ the comment style this sequence begins so that later,
+ only a comment end of the same style actually ends
+ the comment section */
+ code = Scomment;
+ mask = SYNTAX_COMMENT_MASK_START (mirrortab, c,
+ BUF_FETCH_CHAR (buf, from));
+ from++;
+ }
+
+ if (SYNTAX_PREFIX_UNSAFE (mirrortab, c))
+ continue;
+
+ switch (code)
+ {
+ case Sescape:
+ case Scharquote:
+ if (from == stop) goto lose;
+ from++;
+ /* treat following character as a word constituent */
+ case Sword:
+ case Ssymbol:
+ if (depth || !sexpflag) break;
+ /* This word counts as a sexp; return at end of it. */
+ while (from < stop)
+ {
+ switch (SYNTAX (mirrortab, BUF_FETCH_CHAR (buf, from)))
+ {
+ case Scharquote:
+ case Sescape:
+ from++;
+ if (from == stop) goto lose;
+ break;
+ case Sword:
+ case Ssymbol:
+ case Squote:
+ break;
+ default:
+ goto done;
+ }
+ from++;
+ }
+ goto done;
+
+ case Scomment:
+ if (!parse_sexp_ignore_comments)
+ break;
+ {
+ Bufpos newfrom = find_end_of_comment (buf, from, stop, mask);
+ if (newfrom < 0)
+ {
+ /* we stopped because from == stop in search forward */
+ from = stop;
+ if (depth == 0)
+ goto done;
+ goto lose;
+ }
+ from = newfrom;
+ }
+ break;
+
+ case Smath:
+ if (!sexpflag)
+ break;
+ if (from != stop && c == BUF_FETCH_CHAR (buf, from))
+ from++;
+ if (mathexit)
+ {
+ mathexit = 0;
+ goto close1;
+ }
+ mathexit = 1;
+
+ case Sopen:
+ if (!++depth) goto done;
+ break;
+
+ case Sclose:
+ close1:
+ if (!--depth) goto done;
+ if (depth < min_depth)
+ {
+ if (no_error)
+ return Qnil;
+ error ("Containing expression ends prematurely");
+ }
+ break;
+
+ case Sstring:
+ {
+ /* XEmacs change: call syntax_match on character */
+ Emchar ch = BUF_FETCH_CHAR (buf, from - 1);
+ Lisp_Object stermobj = syntax_match (syntaxtab, ch);
+ Emchar stringterm;
+
+ if (CHARP (stermobj))
+ stringterm = XCHAR (stermobj);
+ else
+ stringterm = ch;
+
+ while (1)
+ {
+ if (from >= stop)
+ goto lose;
+ if (BUF_FETCH_CHAR (buf, from) == stringterm)
+ break;
+ switch (SYNTAX (mirrortab, BUF_FETCH_CHAR (buf, from)))
+ {
+ case Scharquote:
+ case Sescape:
+ from++;
+ break;
+ default:
+ break;
+ }
+ from++;
+ }
+ from++;
+ if (!depth && sexpflag) goto done;
+ break;
+ }
+
+ default:
+ break;
+ }
+ }
+
+ /* Reached end of buffer. Error if within object,
+ return nil if between */
+ if (depth) goto lose;
+
+ return Qnil;
+
+ /* End of object reached */
+ done:
+ count--;
+ }
+
+ while (count < 0)
+ {
+ QUIT;
+
+ stop = BUF_BEGV (buf);
+ while (from > stop)
+ {
+ int mask = 0; /* mask for finding matching comment style */
+
+ from--;
+ quoted = char_quoted (buf, from);
+ if (quoted)
+ from--;
+
+ c = BUF_FETCH_CHAR (buf, from);
+ code = SYNTAX_UNSAFE (mirrortab, c);
+
+ if (code == Sendcomment && parse_sexp_ignore_comments)
+ {
+ /* we have found a single char end comment. we must record
+ the comment style encountered so that later, we can match
+ only the proper comment begin sequence of the same style */
+ mask = SYNTAX_COMMENT_1CHAR_MASK (mirrortab, c);
+ }
+
+ else if (from > stop
+ && SYNTAX_END_P (mirrortab, BUF_FETCH_CHAR (buf, from-1), c)
+ && !char_quoted (buf, from - 1)
+ && parse_sexp_ignore_comments)
+ {
+ /* we must record the comment style encountered so that
+ later, we can match only the proper comment begin
+ sequence of the same style */
+ code = Sendcomment;
+ mask = SYNTAX_COMMENT_MASK_END (mirrortab,
+ BUF_FETCH_CHAR (buf, from - 1),
+ c);
+ from--;
+ }
+
+ if (SYNTAX_PREFIX_UNSAFE (mirrortab, c))
+ continue;
+
+ switch (((quoted) ? Sword : code))
+ {
+ case Sword:
+ case Ssymbol:
+ if (depth || !sexpflag) break;
+ /* This word counts as a sexp; count object finished after
+ passing it. */
+ while (from > stop)
+ {
+ enum syntaxcode syncode;
+ quoted = char_quoted (buf, from - 1);
+
+ if (quoted)
+ from--;
+ if (! (quoted
+ || (syncode =
+ SYNTAX (mirrortab, BUF_FETCH_CHAR (buf, from - 1)))
+ == Sword
+ || syncode == Ssymbol
+ || syncode == Squote))
+ goto done2;
+ from--;
+ }
+ goto done2;
+
+ case Smath:
+ if (!sexpflag)
+ break;
+ if (from != stop && c == BUF_FETCH_CHAR (buf, from - 1))
+ from--;
+ if (mathexit)
+ {
+ mathexit = 0;
+ goto open2;
+ }
+ mathexit = 1;
+
+ case Sclose:
+ if (!++depth) goto done2;
+ break;
+
+ case Sopen:
+ open2:
+ if (!--depth) goto done2;
+ if (depth < min_depth)
+ {
+ if (no_error)
+ return Qnil;
+ error ("Containing expression ends prematurely");
+ }
+ break;
+
+ case Sendcomment:
+ if (parse_sexp_ignore_comments)
+ from = find_start_of_comment (buf, from, stop, mask);
+ break;
+
+ case Sstring:
+ {
+ /* XEmacs change: call syntax_match() on character */
+ Emchar ch = BUF_FETCH_CHAR (buf, from);
+ Lisp_Object stermobj = syntax_match (syntaxtab, ch);
+ Emchar stringterm;
+
+ if (CHARP (stermobj))
+ stringterm = XCHAR (stermobj);
+ else
+ stringterm = ch;
+
+ while (1)
+ {
+ if (from == stop) goto lose;
+ if (!char_quoted (buf, from - 1)
+ && stringterm == BUF_FETCH_CHAR (buf, from - 1))
+ break;
+ from--;
+ }
+ from--;
+ if (!depth && sexpflag) goto done2;
+ break;
+ }
+ }
+ }
+
+ /* Reached start of buffer. Error if within object,
+ return nil if between */
+ if (depth) goto lose;
+
+ return Qnil;
+
+ done2:
+ count++;
+ }
+
+
+ return (make_int (from));
+
+lose:
+ if (!no_error)
+ error ("Unbalanced parentheses");
+ return Qnil;
+}
+
+int
+char_quoted (struct buffer *buf, Bufpos pos)
+{
+ enum syntaxcode code;
+ Bufpos beg = BUF_BEGV (buf);
+ int quoted = 0;
+ struct Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table);
+
+ while (pos > beg
+ && ((code = SYNTAX (mirrortab, BUF_FETCH_CHAR (buf, pos - 1)))
+ == Scharquote
+ || code == Sescape))
+ pos--, quoted = !quoted;
+ return quoted;
+}
+
+DEFUN ("scan-lists", Fscan_lists, 3, 5, 0, /*
+Scan from character number FROM by COUNT lists.
+Returns the character number of the position thus found.
+
+If DEPTH is nonzero, paren depth begins counting from that value,
+only places where the depth in parentheses becomes zero
+are candidates for stopping; COUNT such places are counted.
+Thus, a positive value for DEPTH means go out levels.
+
+Comments are ignored if `parse-sexp-ignore-comments' is non-nil.
+
+If the beginning or end of (the accessible part of) the buffer is reached
+and the depth is wrong, an error is signaled.
+If the depth is right but the count is not used up, nil is returned.
+
+If optional arg BUFFER is non-nil, scanning occurs in that buffer instead
+of in the current buffer.
+
+If optional arg NOERROR is non-nil, scan-lists will return nil instead of
+signalling an error.
+*/
+ (from, count, depth, buffer, no_error))
+{
+ struct buffer *buf;
+
+ CHECK_INT (from);
+ CHECK_INT (count);
+ CHECK_INT (depth);
+ buf = decode_buffer (buffer, 0);
+
+ return scan_lists (buf, XINT (from), XINT (count), XINT (depth), 0,
+ !NILP (no_error));
+}
+
+DEFUN ("scan-sexps", Fscan_sexps, 2, 4, 0, /*
+Scan from character number FROM by COUNT balanced expressions.
+If COUNT is negative, scan backwards.
+Returns the character number of the position thus found.
+
+Comments are ignored if `parse-sexp-ignore-comments' is non-nil.
+
+If the beginning or end of (the accessible part of) the buffer is reached
+in the middle of a parenthetical grouping, an error is signaled.
+If the beginning or end is reached between groupings
+but before count is used up, nil is returned.
+
+If optional arg BUFFER is non-nil, scanning occurs in that buffer instead
+of in the current buffer.
+
+If optional arg NOERROR is non-nil, scan-sexps will return nil instead of
+signalling an error.
+*/
+ (from, count, buffer, no_error))
+{
+ struct buffer *buf = decode_buffer (buffer, 0);
+ CHECK_INT (from);
+ CHECK_INT (count);
+
+ return scan_lists (buf, XINT (from), XINT (count), 0, 1, !NILP (no_error));
+}
+
+DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, 0, 1, 0, /*
+Move point backward over any number of chars with prefix syntax.
+This includes chars with "quote" or "prefix" syntax (' or p).
+
+Optional arg BUFFER defaults to the current buffer.
+*/
+ (buffer))
+{
+ 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);
+
+ while (pos > beg && !char_quoted (buf, pos - 1)
+ && (SYNTAX (mirrortab, BUF_FETCH_CHAR (buf, pos - 1)) == Squote
+ || SYNTAX_PREFIX (mirrortab, BUF_FETCH_CHAR (buf, pos - 1))))
+ pos--;
+
+ BUF_SET_PT (buf, pos);
+
+ return Qnil;
+}
+\f
+/* Parse forward from FROM to END,
+ assuming that FROM has state OLDSTATE (nil means FROM is start of function),
+ and return a description of the state of the parse at END.
+ If STOPBEFORE is nonzero, stop at the start of an atom.
+ If COMMENTSTOP is nonzero, stop at the start of a comment. */
+
+static void
+scan_sexps_forward (struct buffer *buf, struct lisp_parse_state *stateptr,
+ Bufpos from, Bufpos end,
+ int targetdepth, int stopbefore,
+ Lisp_Object oldstate,
+ int commentstop)
+{
+ struct lisp_parse_state state;
+
+ enum syntaxcode code;
+ struct level { int last, prev; };
+ struct level levelstart[100];
+ struct level *curlevel = levelstart;
+ struct level *endlevel = levelstart + 100;
+ int depth; /* Paren depth of current scanning location.
+ level - levelstart equals this except
+ when the depth becomes negative. */
+ int mindepth; /* Lowest DEPTH value seen. */
+ int start_quoted = 0; /* Nonzero means starting after a char quote */
+ Lisp_Object tem;
+ int mask; /* comment mask */
+ Lisp_Object syntaxtab = buf->syntax_table;
+ struct Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table);
+
+ if (NILP (oldstate))
+ {
+ depth = 0;
+ state.instring = -1;
+ state.incomment = 0;
+ state.comstyle = 0; /* comment style a by default */
+ mask = SYNTAX_COMMENT_STYLE_A;
+ }
+ else
+ {
+ tem = Fcar (oldstate); /* elt 0, depth */
+ if (!NILP (tem))
+ depth = XINT (tem);
+ else
+ depth = 0;
+
+ oldstate = Fcdr (oldstate);
+ oldstate = Fcdr (oldstate);
+ oldstate = Fcdr (oldstate);
+ tem = Fcar (oldstate); /* elt 3, instring */
+ state.instring = !NILP (tem) ? XINT (tem) : -1;
+
+ oldstate = Fcdr (oldstate); /* elt 4, incomment */
+ tem = Fcar (oldstate);
+ state.incomment = !NILP (tem);
+
+ oldstate = Fcdr (oldstate);
+ tem = Fcar (oldstate); /* elt 5, follows-quote */
+ start_quoted = !NILP (tem);
+
+ /* if the eighth element of the list is nil, we are in comment style
+ a. if it is non-nil, we are in comment style b */
+ oldstate = Fcdr (oldstate);
+ oldstate = Fcdr (oldstate);
+ oldstate = Fcdr (oldstate);
+ tem = Fcar (oldstate); /* elt 8, comment style a */
+ state.comstyle = !NILP (tem);
+ mask = state.comstyle ? SYNTAX_COMMENT_STYLE_B : SYNTAX_COMMENT_STYLE_A;
+ }
+ state.quoted = 0;
+ mindepth = depth;
+
+ curlevel->prev = -1;
+ curlevel->last = -1;
+
+ /* Enter the loop at a place appropriate for initial state. */
+
+ if (state.incomment) goto startincomment;
+ if (state.instring >= 0)
+ {
+ if (start_quoted) goto startquotedinstring;
+ goto startinstring;
+ }
+ if (start_quoted) goto startquoted;
+
+ while (from < end)
+ {
+ QUIT;
+
+ code = SYNTAX (mirrortab, BUF_FETCH_CHAR (buf, from));
+ from++;
+
+ if (code == Scomment)
+ {
+ /* record the comment style we have entered so that only the
+ comment-ender sequence (or single char) of the same style
+ actually terminates the comment section. */
+ mask = SYNTAX_COMMENT_1CHAR_MASK (mirrortab,
+ BUF_FETCH_CHAR (buf, from-1));
+ state.comstyle = (mask == SYNTAX_COMMENT_STYLE_B);
+ state.comstart = from - 1;
+ }
+
+ else if (from < end &&
+ SYNTAX_START_P (mirrortab, BUF_FETCH_CHAR (buf, from-1),
+ BUF_FETCH_CHAR (buf, from)))
+ {
+ /* Record the comment style we have entered so that only
+ the comment-end sequence of the same style actually
+ terminates the comment section. */
+ code = Scomment;
+ mask = SYNTAX_COMMENT_MASK_START (mirrortab,
+ BUF_FETCH_CHAR (buf, from-1),
+ BUF_FETCH_CHAR (buf, from));
+ state.comstyle = (mask == SYNTAX_COMMENT_STYLE_B);
+ state.comstart = from-1;
+ from++;
+ }
+
+ if (SYNTAX_PREFIX (mirrortab, BUF_FETCH_CHAR (buf, from - 1)))
+ continue;
+ switch (code)
+ {
+ case Sescape:
+ case Scharquote:
+ if (stopbefore) goto stop; /* this arg means stop at sexp start */
+ curlevel->last = from - 1;
+ startquoted:
+ if (from == end) goto endquoted;
+ from++;
+ goto symstarted;
+ /* treat following character as a word constituent */
+ case Sword:
+ case Ssymbol:
+ if (stopbefore) goto stop; /* this arg means stop at sexp start */
+ curlevel->last = from - 1;
+ symstarted:
+ while (from < end)
+ {
+ switch (SYNTAX (mirrortab, BUF_FETCH_CHAR (buf, from)))
+ {
+ case Scharquote:
+ case Sescape:
+ from++;
+ if (from == end) goto endquoted;
+ break;
+ case Sword:
+ case Ssymbol:
+ case Squote:
+ break;
+ default:
+ goto symdone;
+ }
+ from++;
+ }
+ symdone:
+ curlevel->prev = curlevel->last;
+ break;
+
+ case Scomment:
+ state.incomment = 1;
+ startincomment:
+ if (commentstop)
+ goto done;
+ {
+ Bufpos newfrom = find_end_of_comment (buf, from, end, mask);
+ if (newfrom < 0)
+ {
+ /* we terminated search because from == end */
+ from = end;
+ goto done;
+ }
+ from = newfrom;
+ }
+ state.incomment = 0;
+ state.comstyle = 0; /* reset the comment style */
+ mask = 0;
+ break;
+
+ case Sopen:
+ if (stopbefore) goto stop; /* this arg means stop at sexp start */
+ depth++;
+ /* curlevel++->last ran into compiler bug on Apollo */
+ curlevel->last = from - 1;
+ if (++curlevel == endlevel)
+ error ("Nesting too deep for parser");
+ curlevel->prev = -1;
+ curlevel->last = -1;
+ if (targetdepth == depth) goto done;
+ break;
+
+ case Sclose:
+ depth--;
+ if (depth < mindepth)
+ mindepth = depth;
+ if (curlevel != levelstart)
+ curlevel--;
+ curlevel->prev = curlevel->last;
+ if (targetdepth == depth) goto done;
+ break;
+
+ case Sstring:
+ {
+ Emchar ch;
+ if (stopbefore) goto stop; /* this arg means stop at sexp start */
+ curlevel->last = from - 1;
+ /* XEmacs change: call syntax_match() on character */
+ ch = BUF_FETCH_CHAR (buf, from - 1);
+ {
+ Lisp_Object stermobj = syntax_match (syntaxtab, ch);
+
+ if (CHARP (stermobj))
+ state.instring = XCHAR (stermobj);
+ else
+ state.instring = ch;
+ }
+ }
+ startinstring:
+ while (1)
+ {
+ if (from >= end) goto done;
+ if (BUF_FETCH_CHAR (buf, from) == state.instring) break;
+ switch (SYNTAX (mirrortab, BUF_FETCH_CHAR (buf, from)))
+ {
+ case Scharquote:
+ case Sescape:
+ {
+ from++;
+ startquotedinstring:
+ if (from >= end) goto endquoted;
+ break;
+ }
+ default:
+ break;
+ }
+ from++;
+ }
+ state.instring = -1;
+ curlevel->prev = curlevel->last;
+ from++;
+ break;
+
+ case Smath:
+ break;
+
+ case Swhitespace:
+ case Spunct:
+ case Squote:
+ case Sendcomment:
+ case Sinherit:
+ case Smax:
+ break;
+ }
+ }
+ goto done;
+
+ stop: /* Here if stopping before start of sexp. */
+ from--; /* We have just fetched the char that starts it; */
+ goto done; /* but return the position before it. */
+
+ endquoted:
+ state.quoted = 1;
+ done:
+ state.depth = depth;
+ state.mindepth = mindepth;
+ state.thislevelstart = curlevel->prev;
+ state.prevlevelstart
+ = (curlevel == levelstart) ? -1 : (curlevel - 1)->last;
+ state.location = from;
+
+ *stateptr = state;
+}
+
+DEFUN ("parse-partial-sexp", Fparse_partial_sexp, 2, 7, 0, /*
+Parse Lisp syntax starting at FROM until TO; return status of parse at TO.
+Parsing stops at TO or when certain criteria are met;
+ point is set to where parsing stops.
+If fifth arg STATE is omitted or nil,
+ parsing assumes that FROM is the beginning of a function.
+Value is a list of eight elements describing final state of parsing:
+ 0. depth in parens.
+ 1. character address of start of innermost containing list; nil if none.
+ 2. character address of start of last complete sexp terminated.
+ 3. non-nil if inside a string.
+ (It is the character that will terminate the string.)
+ 4. t if inside a comment.
+ 5. t if following a quote character.
+ 6. the minimum paren-depth encountered during this scan.
+ 7. nil if in comment style a, or not in a comment; t if in comment style b
+If third arg TARGETDEPTH is non-nil, parsing stops if the depth
+in parentheses becomes equal to TARGETDEPTH.
+Fourth arg STOPBEFORE non-nil means stop when come to
+ any character that starts a sexp.
+Fifth arg STATE is an eight-element list like what this function returns.
+It is used to initialize the state of the parse. Its second and third
+elements are ignored.
+Sixth arg COMMENTSTOP non-nil means stop at the start of a comment.
+*/
+ (from, to, targetdepth, stopbefore, oldstate, commentstop, buffer))
+{
+ struct lisp_parse_state state;
+ int target;
+ Bufpos start, end;
+ struct buffer *buf = decode_buffer (buffer, 0);
+ Lisp_Object val;
+
+ if (!NILP (targetdepth))
+ {
+ CHECK_INT (targetdepth);
+ target = XINT (targetdepth);
+ }
+ else
+ target = -100000; /* We won't reach this depth */
+
+ get_buffer_range_char (buf, from, to, &start, &end, 0);
+ scan_sexps_forward (buf, &state, start, end,
+ target, !NILP (stopbefore), oldstate,
+ !NILP (commentstop));
+
+ BUF_SET_PT (buf, state.location);
+
+ /* reverse order */
+ val = Qnil;
+ val = Fcons (state.comstyle ? Qt : Qnil, val);
+ val = Fcons (make_int (state.mindepth), val);
+ val = Fcons (state.quoted ? Qt : Qnil, val);
+ val = Fcons (state.incomment ? Qt : Qnil, val);
+ val = Fcons (state.instring < 0 ? Qnil : make_int (state.instring), val);
+ val = Fcons (state.thislevelstart < 0 ? Qnil : make_int (state.thislevelstart), val);
+ val = Fcons (state.prevlevelstart < 0 ? Qnil : make_int (state.prevlevelstart), val);
+ val = Fcons (make_int (state.depth), val);
+
+ return val;
+}
+
+
+/* Updating of the mirror syntax table.
+
+ Each syntax table has a corresponding mirror table in it.
+ Whenever we make a change to a syntax table, we call
+ update_syntax_table() on it.
+
+ #### We really only need to map over the changed range.
+
+ If we change the standard syntax table, we need to map over
+ all tables because any of them could be inheriting from the
+ standard syntax table.
+
+ When `set-syntax-table' is called, we set the buffer's mirror
+ syntax table as well.
+ */
+
+struct cmst_arg
+{
+ Lisp_Object mirrortab;
+ int check_inherit;
+};
+
+static int
+cmst_mapfun (struct chartab_range *range, Lisp_Object val, void *arg)
+{
+ struct cmst_arg *closure = (struct cmst_arg *) arg;
+
+ if (CONSP (val))
+ val = XCAR (val);
+ if (SYNTAX_FROM_CODE (XINT (val)) == Sinherit
+ && closure->check_inherit)
+ {
+ struct cmst_arg recursive;
+
+ recursive.mirrortab = closure->mirrortab;
+ recursive.check_inherit = 0;
+ map_char_table (XCHAR_TABLE (Vstandard_syntax_table), range,
+ cmst_mapfun, &recursive);
+ }
+ else
+ put_char_table (XCHAR_TABLE (closure->mirrortab), range, val);
+ return 0;
+}
+
+static void
+update_just_this_syntax_table (struct Lisp_Char_Table *ct)
+{
+ struct chartab_range range;
+ struct cmst_arg arg;
+
+ arg.mirrortab = ct->mirror_table;
+ arg.check_inherit = (CHAR_TABLEP (Vstandard_syntax_table)
+ && ct != XCHAR_TABLE (Vstandard_syntax_table));
+ range.type = CHARTAB_RANGE_ALL;
+ map_char_table (ct, &range, cmst_mapfun, &arg);
+}
+
+/* Called from chartab.c when a change is made to a syntax table.
+ If this is the standard syntax table, we need to recompute
+ *all* syntax tables (yuck). Otherwise we just recompute this
+ one. */
+
+void
+update_syntax_table (struct Lisp_Char_Table *ct)
+{
+ /* Don't be stymied at startup. */
+ if (CHAR_TABLEP (Vstandard_syntax_table)
+ && ct == XCHAR_TABLE (Vstandard_syntax_table))
+ {
+ Lisp_Object syntab;
+
+ for (syntab = Vall_syntax_tables; !NILP (syntab);
+ syntab = XCHAR_TABLE (syntab)->next_table)
+ update_just_this_syntax_table (XCHAR_TABLE (syntab));
+ }
+ else
+ update_just_this_syntax_table (ct);
+}
+
+\f
+/************************************************************************/
+/* initialization */
+/************************************************************************/
+
+void
+syms_of_syntax (void)
+{
+ defsymbol (&Qsyntax_table_p, "syntax-table-p");
+
+ DEFSUBR (Fsyntax_table_p);
+ DEFSUBR (Fsyntax_table);
+ DEFSUBR (Fstandard_syntax_table);
+ DEFSUBR (Fcopy_syntax_table);
+ DEFSUBR (Fset_syntax_table);
+ DEFSUBR (Fsyntax_designator_chars);
+ DEFSUBR (Fchar_syntax);
+ DEFSUBR (Fmatching_paren);
+ /* DEFSUBR (Fmodify_syntax_entry); now in Lisp. */
+ /* DEFSUBR (Fdescribe_syntax); now in Lisp. */
+
+ DEFSUBR (Fforward_word);
+
+ DEFSUBR (Fforward_comment);
+ DEFSUBR (Fscan_lists);
+ DEFSUBR (Fscan_sexps);
+ DEFSUBR (Fbackward_prefix_chars);
+ DEFSUBR (Fparse_partial_sexp);
+}
+
+void
+vars_of_syntax (void)
+{
+ DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments /*
+Non-nil means `forward-sexp', etc., should treat comments as whitespace.
+*/ );
+
+ 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.
+*/ );
+
+ no_quit_in_re_search = 0;
+}
+
+void
+complex_vars_of_syntax (void)
+{
+ /* 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 */
+ Vstandard_syntax_table = Qnil;
+ Vstandard_syntax_table = Fcopy_syntax_table (Qnil);
+ staticpro (&Vstandard_syntax_table);
+
+ Vsyntax_designator_chars_string = make_pure_string (syntax_code_spec,
+ Smax, Qnil, 1);
+ 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);
+
+ 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),
+ Vstandard_syntax_table);
+ Fput_char_table (make_char ('%'), make_int ((int) Sword),
+ 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 ('[')),
+ 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 ('"'), 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);
+ }
+ }
+}
--- /dev/null
+/* Declarations having to do with XEmacs syntax tables.
+ Copyright (C) 1985, 1992, 1993 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: FSF 19.28. */
+
+#ifndef _XEMACS_SYNTAX_H_
+#define _XEMACS_SYNTAX_H_
+
+#include "chartab.h"
+
+/* A syntax table is a type of char table.
+
+The low 7 bits of the integer is a code, as follows. The 8th bit is
+used as the prefix bit flag (see below).
+
+The values in a syntax table are either integers or conses of
+integers and chars. The lowest 7 bits of the integer are the syntax
+class. If this is Sinherit, then the actual syntax value needs to
+be retrieved from the standard syntax table.
+
+Since the logic involved in finding the actual integer isn't very
+complex, you'd think the time required to retrieve it is not a
+factor. If you thought that, however, you'd be wrong, due to the
+high number of times (many per character) that the syntax value is
+accessed in functions such as scan_lists(). To speed this up,
+we maintain a mirror syntax table that contains the actual
+integers. We can do this successfully because syntax tables are
+now an abstract type, where we control all access.
+*/
+
+enum syntaxcode
+{
+ Swhitespace, /* whitespace character */
+ Spunct, /* random punctuation character */
+ Sword, /* word constituent */
+ Ssymbol, /* symbol constituent but not word constituent */
+ Sopen, /* a beginning delimiter */
+ Sclose, /* an ending delimiter */
+ Squote, /* a prefix character like Lisp ' */
+ Sstring, /* a string-grouping character like Lisp " */
+ Smath, /* delimiters like $ in TeX. */
+ Sescape, /* a character that begins a C-style escape */
+ Scharquote, /* a character that quotes the following character */
+ Scomment, /* a comment-starting character */
+ Sendcomment, /* a comment-ending character */
+ Sinherit, /* use the standard syntax table for this character */
+ Smax /* Upper bound on codes that are meaningful */
+};
+
+enum syntaxcode charset_syntax (struct buffer *buf, Lisp_Object charset,
+ int *multi_p_out);
+
+/* Return the syntax code for a particular character and mirror table. */
+
+#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 (struct Lisp_Char_Table *table, Emchar c)
+{
+ return SYNTAX_CODE_UNSAFE (table, c);
+}
+
+#define SYNTAX_UNSAFE(table, c) \
+ ((enum syntaxcode) (SYNTAX_CODE_UNSAFE (table, c) & 0177))
+
+#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 (struct Lisp_Char_Table *table, Emchar c)
+{
+ int syncode = SYNTAX (table, c);
+ return syncode == Sword;
+}
+
+/* OK, here's a graphic diagram of the format of the syntax values:
+
+ Bit number:
+
+ [ 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 ]
+ [ 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 ]
+
+ <-----> <-----> <-------------> <-------------> ^ <----------->
+ ELisp unused |comment bits | unused | syntax code
+ tag | | | | | | | | |
+ stuff | | | | | | | | |
+ | | | | | | | | |
+ | | | | | | | | `--> prefix flag
+ | | | | | | | |
+ | | | | | | | `--> comment end style B, second char
+ | | | | | | `----> comment end style A, second char
+ | | | | | `------> comment end style B, first char
+ | | | | `--------> comment end style A, first char
+ | | | `----------> comment start style B, second char
+ | | `------------> comment start style A, second char
+ | `--------------> comment start style B, first char
+ `----------------> comment start style A, first char
+
+ In a 64-bit integer, there would be 32 more unused bits between
+ the tag and the comment bits.
+
+ Clearly, such a scheme will not work for Mule, because the matching
+ paren could be any character and as such requires 19 bits, which
+ we don't got.
+
+ Remember that under Mule we use char tables instead of vectors.
+ So what we do is use another char table for the matching paren
+ and store a pointer to it in the first char table. (This frees
+ code from having to worry about passing two tables around.)
+*/
+
+
+/* The prefix flag bit for backward-prefix-chars is now put into bit 7. */
+
+#define SYNTAX_PREFIX_UNSAFE(table, c) \
+ ((SYNTAX_CODE_UNSAFE (table, c) >> 7) & 1)
+#define SYNTAX_PREFIX(table, c) \
+ ((SYNTAX_CODE (table, c) >> 7) & 1)
+
+/* Bits 23-16 are used to implement up to two comment styles
+ in a single buffer. They have the following meanings:
+
+ 1. first of a one or two character comment-start sequence of style a.
+ 2. first of a one or two character comment-start sequence of style b.
+ 3. second of a two-character comment-start sequence of style a.
+ 4. second of a two-character comment-start sequence of style b.
+ 5. first of a one or two character comment-end sequence of style a.
+ 6. first of a one or two character comment-end sequence of style b.
+ 7. second of a two-character comment-end sequence of style a.
+ 8. second of a two-character comment-end sequence of style b.
+ */
+
+#define SYNTAX_COMMENT_BITS(table, c) \
+ ((SYNTAX_CODE (table, c) >> 16) &0xff)
+
+#define SYNTAX_FIRST_OF_START_A 0x80
+#define SYNTAX_FIRST_OF_START_B 0x40
+#define SYNTAX_SECOND_OF_START_A 0x20
+#define SYNTAX_SECOND_OF_START_B 0x10
+#define SYNTAX_FIRST_OF_END_A 0x08
+#define SYNTAX_FIRST_OF_END_B 0x04
+#define SYNTAX_SECOND_OF_END_A 0x02
+#define SYNTAX_SECOND_OF_END_B 0x01
+
+#define SYNTAX_COMMENT_STYLE_A 0xaa
+#define SYNTAX_COMMENT_STYLE_B 0x55
+#define SYNTAX_FIRST_CHAR_START 0xc0
+#define SYNTAX_FIRST_CHAR_END 0x0c
+#define SYNTAX_FIRST_CHAR 0xcc
+#define SYNTAX_SECOND_CHAR_START 0x30
+#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))
+
+#define SYNTAX_STYLES_MATCH_START_P(table, a, b, mask) \
+ ((SYNTAX_COMMENT_BITS (table, a) & SYNTAX_FIRST_CHAR_START & (mask)) \
+ && (SYNTAX_COMMENT_BITS (table, b) & SYNTAX_SECOND_CHAR_START & (mask)))
+
+#define SYNTAX_STYLES_MATCH_END_P(table, a, b, mask) \
+ ((SYNTAX_COMMENT_BITS (table, a) & SYNTAX_FIRST_CHAR_END & (mask)) \
+ && (SYNTAX_COMMENT_BITS (table, b) & SYNTAX_SECOND_CHAR_END & (mask)))
+
+#define SYNTAX_STYLES_MATCH_1CHAR_P(table, a, mask) \
+ ((SYNTAX_COMMENT_BITS (table, a) & (mask)))
+
+#define STYLE_FOUND_P(table, a, b, startp, style) \
+ ((SYNTAX_COMMENT_BITS (table, a) & \
+ ((startp) ? SYNTAX_FIRST_CHAR_START : \
+ SYNTAX_FIRST_CHAR_END) & (style)) \
+ && (SYNTAX_COMMENT_BITS (table, b) & \
+ ((startp) ? SYNTAX_SECOND_CHAR_START : \
+ SYNTAX_SECOND_CHAR_END) & (style)))
+
+#define SYNTAX_COMMENT_MASK_START(table, a, b) \
+ ((STYLE_FOUND_P (table, a, b, 1, SYNTAX_COMMENT_STYLE_A) \
+ ? SYNTAX_COMMENT_STYLE_A \
+ : (STYLE_FOUND_P (table, a, b, 1, SYNTAX_COMMENT_STYLE_B) \
+ ? SYNTAX_COMMENT_STYLE_B \
+ : 0)))
+
+#define SYNTAX_COMMENT_MASK_END(table, a, b) \
+ ((STYLE_FOUND_P (table, a, b, 0, SYNTAX_COMMENT_STYLE_A) \
+ ? SYNTAX_COMMENT_STYLE_A \
+ : (STYLE_FOUND_P (table, a, b, 0, SYNTAX_COMMENT_STYLE_B) \
+ ? SYNTAX_COMMENT_STYLE_B \
+ : 0)))
+
+#define STYLE_FOUND_1CHAR_P(table, a, style) \
+ ((SYNTAX_COMMENT_BITS (table, a) & (style)))
+
+#define SYNTAX_COMMENT_1CHAR_MASK(table, a) \
+ ((STYLE_FOUND_1CHAR_P (table, a, SYNTAX_COMMENT_STYLE_A) \
+ ? SYNTAX_COMMENT_STYLE_A \
+ : (STYLE_FOUND_1CHAR_P (table, a, SYNTAX_COMMENT_STYLE_B) \
+ ? SYNTAX_COMMENT_STYLE_B \
+ : 0)))
+
+EXFUN (Fchar_syntax, 2);
+EXFUN (Fforward_word, 2);
+
+/* The standard syntax table is stored where it will automatically
+ be used in all new buffers. */
+extern Lisp_Object Vstandard_syntax_table;
+
+/* This array, indexed by a character, contains the syntax code which
+ that character signifies (as a char).
+ For example, (enum syntaxcode) syntax_spec_code['w'] is Sword. */
+
+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[];
+
+Lisp_Object scan_lists (struct buffer *buf, int from, int count,
+ int depth, int sexpflag, int no_error);
+int char_quoted (struct buffer *buf, int pos);
+
+/* NOTE: This does not refer to the mirror table, but to the
+ syntax table itself. */
+Lisp_Object syntax_match (Lisp_Object table, Emchar ch);
+
+extern int no_quit_in_re_search;
+extern struct buffer *regex_emacs_buffer;
+
+void update_syntax_table (struct Lisp_Char_Table *ct);
+
+#endif /* _XEMACS_SYNTAX_H_ */
--- /dev/null
+/* toolbar implementation -- X interface.
+ Copyright (C) 1995 Board of Trustees, University of Illinois.
+ Copyright (C) 1995 Sun Microsystems, Inc.
+ Copyright (C) 1995, 1996 Ben Wing.
+ Copyright (C) 1996 Chuck Thompson.
+
+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. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "console-x.h"
+#include "glyphs-x.h"
+#include "objects-x.h"
+#include "xgccache.h"
+#include "EmacsFrame.h"
+#include "EmacsFrameP.h"
+#include "EmacsManager.h"
+
+#include "faces.h"
+#include "frame.h"
+#include "toolbar.h"
+#include "window.h"
+
+static void
+x_draw_blank_toolbar_button (struct frame *f, int x, int y, int width,
+ int height, int threed, int border_width,
+ int vertical)
+{
+ struct device *d = XDEVICE (f->device);
+ EmacsFrame ef = (EmacsFrame) FRAME_X_TEXT_WIDGET (f);
+ int shadow_thickness = ef->emacs_frame.toolbar_shadow_thickness;
+ int sx = x, sy = y, swidth = width, sheight = height;
+
+ Display *dpy = DEVICE_X_DISPLAY (d);
+ Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f));
+ GC top_shadow_gc, bottom_shadow_gc, background_gc;
+
+ background_gc = FRAME_X_TOOLBAR_BLANK_BACKGROUND_GC (f);
+
+ if (threed)
+ {
+ top_shadow_gc = FRAME_X_TOOLBAR_TOP_SHADOW_GC (f);
+ bottom_shadow_gc = FRAME_X_TOOLBAR_BOTTOM_SHADOW_GC (f);
+ }
+ else
+ {
+ top_shadow_gc = background_gc;
+ bottom_shadow_gc = background_gc;
+ }
+
+ if (vertical)
+ {
+ sx += border_width;
+ swidth -= 2 * border_width;
+ }
+ else
+ {
+ sy += border_width;
+ sheight -= 2 * border_width;
+ }
+
+ /* Draw the outline. */
+ x_output_shadows (f, sx, sy, swidth, sheight, top_shadow_gc,
+ bottom_shadow_gc, background_gc, shadow_thickness);
+
+ /* Blank the middle. */
+ XFillRectangle (dpy, x_win, background_gc, sx + shadow_thickness,
+ sy + shadow_thickness, swidth - shadow_thickness * 2,
+ sheight - shadow_thickness * 2);
+
+ /* Do the border */
+ XFillRectangle (dpy, x_win, background_gc, x, y,
+ (vertical ? border_width : width),
+ (vertical ? height : border_width));
+ XFillRectangle (dpy, x_win, background_gc,
+ (vertical ? sx + swidth : x),
+ (vertical ? y : sy + sheight),
+ (vertical ? border_width : width),
+ (vertical ? height : border_width));
+}
+
+static void
+x_output_toolbar_button (struct frame *f, Lisp_Object button)
+{
+ struct device *d = XDEVICE (f->device);
+ EmacsFrame ef = (EmacsFrame) FRAME_X_TEXT_WIDGET (f);
+ int shadow_thickness = ef->emacs_frame.toolbar_shadow_thickness;
+ int x_adj, y_adj, width_adj, height_adj;
+
+ Display *dpy = DEVICE_X_DISPLAY (d);
+ Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f));
+ 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;
+ struct window *w;
+ int vertical = tb->vertical;
+ int border_width = tb->border_width;
+
+ if (vertical)
+ {
+ x_adj = border_width;
+ width_adj = - 2 * border_width;
+ y_adj = 0;
+ height_adj = 0;
+ }
+ else
+ {
+ x_adj = 0;
+ width_adj = 0;
+ y_adj = border_width;
+ height_adj = - 2 * border_width;
+ }
+
+ XSETFRAME (frame, f);
+ window = FRAME_LAST_NONMINIBUF_WINDOW (f);
+ w = XWINDOW (window);
+
+ glyph = get_toolbar_button_glyph (w, tb);
+
+ if (tb->enabled)
+ {
+ if (tb->down)
+ {
+ top_shadow_gc = FRAME_X_TOOLBAR_BOTTOM_SHADOW_GC (f);
+ bottom_shadow_gc = FRAME_X_TOOLBAR_TOP_SHADOW_GC (f);
+ }
+ else
+ {
+ top_shadow_gc = FRAME_X_TOOLBAR_TOP_SHADOW_GC (f);
+ bottom_shadow_gc = FRAME_X_TOOLBAR_BOTTOM_SHADOW_GC (f);
+ }
+ }
+ else
+ {
+ top_shadow_gc = FRAME_X_TOOLBAR_BLANK_BACKGROUND_GC (f);
+ bottom_shadow_gc = FRAME_X_TOOLBAR_BLANK_BACKGROUND_GC (f);
+ }
+ background_gc = FRAME_X_TOOLBAR_BLANK_BACKGROUND_GC (f);
+
+ /* Draw the outline. */
+ 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);
+
+ /* Clear the pixmap area. */
+ XFillRectangle (dpy, x_win, background_gc, tb->x + x_adj + shadow_thickness,
+ tb->y + y_adj + shadow_thickness,
+ tb->width + width_adj - shadow_thickness * 2,
+ tb->height + height_adj - shadow_thickness * 2);
+
+ /* Do the border. */
+ XFillRectangle (dpy, x_win, background_gc, tb->x, tb->y,
+ (vertical ? border_width : tb->width),
+ (vertical ? tb->height : border_width));
+
+ XFillRectangle (dpy, x_win, background_gc,
+ (vertical ? tb->x + tb->width - border_width : tb->x),
+ (vertical ? tb->y : tb->y + tb->height - border_width),
+ (vertical ? border_width : tb->width),
+ (vertical ? tb->height : border_width));
+
+ background_gc = FRAME_X_TOOLBAR_PIXMAP_BACKGROUND_GC (f);
+
+ /* #### It is currently possible for users to trash us by directly
+ changing the toolbar glyphs. Avoid crashing in that case. */
+ if (GLYPHP (glyph))
+ instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
+ else
+ instance = Qnil;
+
+ if (IMAGE_INSTANCEP (instance))
+ {
+ int width = tb->width + width_adj - shadow_thickness * 2;
+ int height = tb->height + height_adj - shadow_thickness * 2;
+ int x_offset = x_adj + shadow_thickness;
+ int y_offset = y_adj + shadow_thickness;
+
+ p = XIMAGE_INSTANCE (instance);
+
+ if (IMAGE_INSTANCE_PIXMAP_TYPE_P (p))
+ {
+ if (width > (int) IMAGE_INSTANCE_PIXMAP_WIDTH (p))
+ {
+ x_offset += ((int) (width - IMAGE_INSTANCE_PIXMAP_WIDTH (p))
+ / 2);
+ width = IMAGE_INSTANCE_PIXMAP_WIDTH (p);
+ }
+ if (height > (int) IMAGE_INSTANCE_PIXMAP_HEIGHT (p))
+ {
+ y_offset += ((int) (height - IMAGE_INSTANCE_PIXMAP_HEIGHT (p))
+ / 2);
+ height = IMAGE_INSTANCE_PIXMAP_HEIGHT (p);
+ }
+
+ 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);
+ }
+ else if (IMAGE_INSTANCE_TYPE (p) == IMAGE_TEXT)
+ {
+ /* #### We need to make the face used configurable. */
+ struct face_cachel *cachel =
+ WINDOW_FACE_CACHEL (w, DEFAULT_INDEX);
+ struct display_line dl;
+ Lisp_Object string = IMAGE_INSTANCE_TEXT_STRING (p);
+ unsigned char charsets[NUM_LEADING_BYTES];
+ Emchar_dynarr *buf;
+ struct font_metric_info fm;
+
+ /* This could be true if we were called via the Expose event
+ handler. Mark the button as dirty and return
+ immediately. */
+ if (f->window_face_cache_reset)
+ {
+ tb->dirty = 1;
+ MARK_TOOLBAR_CHANGED;
+ return;
+ }
+ buf = Dynarr_new (Emchar);
+ convert_bufbyte_string_into_emchar_dynarr
+ (XSTRING_DATA (string), XSTRING_LENGTH (string), buf);
+ find_charsets_in_emchar_string (charsets, Dynarr_atp (buf, 0),
+ Dynarr_length (buf));
+ ensure_face_cachel_complete (cachel, window, charsets);
+ face_cachel_charset_font_metric_info (cachel, charsets, &fm);
+
+ dl.ascent = fm.ascent;
+ dl.descent = fm.descent;
+ dl.ypos = tb->y + y_offset + fm.ascent;
+
+ if (fm.ascent + fm.descent <= height)
+ {
+ dl.ypos += (height - fm.ascent - fm.descent) / 2;
+ dl.clip = 0;
+ }
+ else
+ {
+ dl.clip = fm.ascent + fm.descent - height;
+ }
+
+ x_output_string (w, &dl, buf, tb->x + x_offset, 0, 0, width,
+ DEFAULT_INDEX, 0, 0, 0, 0);
+ Dynarr_free (buf);
+ }
+
+ /* We silently ignore the image if it isn't a pixmap or text. */
+ }
+
+ tb->dirty = 0;
+}
+
+static int
+x_get_button_size (struct frame *f, Lisp_Object window,
+ struct toolbar_button *tb, int vert, int pos)
+{
+ EmacsFrame ef = (EmacsFrame) FRAME_X_TEXT_WIDGET (f);
+ int shadow_thickness = ef->emacs_frame.toolbar_shadow_thickness;
+ int size;
+
+ if (tb->blank)
+ {
+ if (!NILP (tb->down_glyph))
+ size = XINT (tb->down_glyph);
+ else
+ size = DEFAULT_TOOLBAR_BLANK_SIZE;
+ }
+ else
+ {
+ struct window *w = XWINDOW (window);
+ Lisp_Object glyph = get_toolbar_button_glyph (w, tb);
+
+ /* Unless, of course, the user has done something stupid like
+ change the glyph out from under us. Use a blank placeholder
+ in that case. */
+ if (NILP (glyph))
+ return XINT (f->toolbar_size[pos]);
+
+ if (vert)
+ size = glyph_height (glyph, Vdefault_face, 0, window);
+ else
+ size = glyph_width (glyph, Vdefault_face, 0, window);
+ }
+
+ if (!size)
+ {
+ /* If the glyph doesn't have a size we'll insert a blank
+ placeholder instead. */
+ return XINT (f->toolbar_size[pos]);
+ }
+
+ size += shadow_thickness * 2;
+
+ return (size);
+}
+
+#define X_OUTPUT_BUTTONS_LOOP(left) \
+ do { \
+ while (!NILP (button)) \
+ { \
+ struct toolbar_button *tb = XTOOLBAR_BUTTON (button); \
+ int size, height, width; \
+ \
+ if (left && tb->pushright) \
+ break; \
+ \
+ size = x_get_button_size (f, window, tb, vert, pos); \
+ \
+ if (vert) \
+ { \
+ width = bar_width; \
+ if (y + size > max_pixpos) \
+ height = max_pixpos - y; \
+ else \
+ height = size; \
+ } \
+ else \
+ { \
+ if (x + size > max_pixpos) \
+ width = max_pixpos - x; \
+ else \
+ width = size; \
+ height = bar_height; \
+ } \
+ \
+ if (tb->x != x \
+ || tb->y != y \
+ || tb->width != width \
+ || tb->height != height \
+ || tb->dirty) \
+ { \
+ if (width && height) \
+ { \
+ tb->x = x; \
+ tb->y = y; \
+ tb->width = width; \
+ tb->height = height; \
+ tb->border_width = border_width; \
+ tb->vertical = vert; \
+ \
+ if (tb->blank || NILP (tb->up_glyph)) \
+ { \
+ int threed = (EQ (Qt, tb->up_glyph) ? 1 : 0); \
+ x_draw_blank_toolbar_button (f, x, y, width, \
+ height, threed, \
+ border_width, vert); \
+ } \
+ else \
+ x_output_toolbar_button (f, button); \
+ } \
+ } \
+ \
+ if (vert) \
+ y += height; \
+ else \
+ x += width; \
+ \
+ if ((vert && y == max_pixpos) || (!vert && x == max_pixpos)) \
+ button = Qnil; \
+ else \
+ button = tb->next; \
+ } \
+ } while (0)
+
+#define SET_TOOLBAR_WAS_VISIBLE_FLAG(frame, pos, flag) \
+ do { \
+ switch (pos) \
+ { \
+ case TOP_TOOLBAR: \
+ (frame)->top_toolbar_was_visible = flag; \
+ break; \
+ case BOTTOM_TOOLBAR: \
+ (frame)->bottom_toolbar_was_visible = flag; \
+ break; \
+ case LEFT_TOOLBAR: \
+ (frame)->left_toolbar_was_visible = flag; \
+ break; \
+ case RIGHT_TOOLBAR: \
+ (frame)->right_toolbar_was_visible = flag; \
+ break; \
+ default: \
+ abort (); \
+ } \
+ } while (0)
+
+static void
+x_output_toolbar (struct frame *f, enum toolbar_pos pos)
+{
+ struct device *d = XDEVICE (f->device);
+ int x, y, bar_width, bar_height, vert;
+ int max_pixpos, right_size, right_start, blank_size;
+ int border_width = FRAME_REAL_TOOLBAR_BORDER_WIDTH (f, pos);
+ Lisp_Object button, window;
+ Display *dpy = DEVICE_X_DISPLAY (d);
+ Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f));
+ GC background_gc = FRAME_X_TOOLBAR_BLANK_BACKGROUND_GC (f);
+
+ get_toolbar_coords (f, pos, &x, &y, &bar_width, &bar_height, &vert, 1);
+ window = FRAME_LAST_NONMINIBUF_WINDOW (f);
+
+ /* Do the border */
+ XFillRectangle (dpy, x_win, background_gc, x, y,
+ (vert ? bar_width : border_width),
+ (vert ? border_width : bar_height));
+ XFillRectangle (dpy, x_win, background_gc,
+ (vert ? x : x + bar_width - border_width),
+ (vert ? y + bar_height - border_width : y),
+ (vert ? bar_width : border_width),
+ (vert ? border_width : bar_height));
+
+ if (vert)
+ {
+ max_pixpos = y + bar_height - border_width;
+ y += border_width;
+ }
+ else
+ {
+ max_pixpos = x + bar_width - border_width;
+ x += border_width;
+ }
+
+ button = FRAME_TOOLBAR_BUTTONS (f, pos);
+ right_size = 0;
+
+ /* First loop over all of the buttons to determine how much room we
+ need for left hand and right hand buttons. This loop will also
+ make sure that all instances are instantiated so when we actually
+ output them they will come up immediately. */
+ while (!NILP (button))
+ {
+ struct toolbar_button *tb = XTOOLBAR_BUTTON (button);
+ int size = x_get_button_size (f, window, tb, vert, pos);
+
+ if (tb->pushright)
+ right_size += size;
+
+ button = tb->next;
+ }
+
+ button = FRAME_TOOLBAR_BUTTONS (f, pos);
+
+ /* Loop over the left buttons, updating and outputting them. */
+ X_OUTPUT_BUTTONS_LOOP (1);
+
+ /* Now determine where the right buttons start. */
+ right_start = max_pixpos - right_size;
+ if (right_start < (vert ? y : x))
+ right_start = (vert ? y : x);
+
+ /* Output the blank which goes from the end of the left buttons to
+ the start of the right. */
+ blank_size = right_start - (vert ? y : x);
+ if (blank_size)
+ {
+ int height, width;
+
+ if (vert)
+ {
+ width = bar_width;
+ height = blank_size;
+ }
+ else
+ {
+ width = blank_size;
+ height = bar_height;
+ }
+
+ /*
+ * Use a 3D pushright separator only if there isn't a toolbar
+ * border. A flat separator meshes with the border and looks
+ * better.
+ */
+ x_draw_blank_toolbar_button (f, x, y, width, height, !border_width,
+ border_width, vert);
+
+ if (vert)
+ y += height;
+ else
+ x += width;
+ }
+
+ /* Loop over the right buttons, updating and outputting them. */
+ X_OUTPUT_BUTTONS_LOOP (0);
+
+ if (!vert)
+ {
+ Lisp_Object frame;
+
+ XSETFRAME (frame, f);
+ DEVMETH (d, clear_region, (frame,
+ DEFAULT_INDEX, FRAME_PIXWIDTH (f) - 1, y, 1,
+ bar_height));
+ }
+
+ SET_TOOLBAR_WAS_VISIBLE_FLAG (f, pos, 1);
+
+ XFlush (DEVICE_X_DISPLAY (d));
+}
+
+static void
+x_clear_toolbar (struct frame *f, enum toolbar_pos pos, int thickness_change)
+{
+ Lisp_Object frame;
+ struct device *d = XDEVICE (f->device);
+ int x, y, width, height, vert;
+
+ get_toolbar_coords (f, pos, &x, &y, &width, &height, &vert, 1);
+ XSETFRAME (frame, f);
+
+ /* The thickness_change parameter is used by the toolbar resize routines
+ to clear any excess toolbar if the size shrinks. */
+ if (thickness_change < 0)
+ {
+ if (pos == LEFT_TOOLBAR || pos == RIGHT_TOOLBAR)
+ {
+ x = x + width + thickness_change;
+ width = -thickness_change;
+ }
+ else
+ {
+ y = y + height + thickness_change;
+ height = -thickness_change;
+ }
+ }
+
+ SET_TOOLBAR_WAS_VISIBLE_FLAG (f, pos, 0);
+
+ DEVMETH (d, clear_region, (frame, DEFAULT_INDEX, x, y, width, height));
+ XFlush (DEVICE_X_DISPLAY (d));
+}
+
+static void
+x_output_frame_toolbars (struct frame *f)
+{
+ assert (FRAME_X_P (f));
+
+ if (FRAME_REAL_TOP_TOOLBAR_VISIBLE (f))
+ x_output_toolbar (f, TOP_TOOLBAR);
+ else if (f->top_toolbar_was_visible)
+ x_clear_toolbar (f, TOP_TOOLBAR, 0);
+
+ if (FRAME_REAL_BOTTOM_TOOLBAR_VISIBLE (f))
+ x_output_toolbar (f, BOTTOM_TOOLBAR);
+ else if (f->bottom_toolbar_was_visible)
+ x_clear_toolbar (f, BOTTOM_TOOLBAR, 0);
+
+ if (FRAME_REAL_LEFT_TOOLBAR_VISIBLE (f))
+ x_output_toolbar (f, LEFT_TOOLBAR);
+ else if (f->left_toolbar_was_visible)
+ x_clear_toolbar (f, LEFT_TOOLBAR, 0);
+
+ if (FRAME_REAL_RIGHT_TOOLBAR_VISIBLE (f))
+ x_output_toolbar (f, RIGHT_TOOLBAR);
+ else if (f->right_toolbar_was_visible)
+ x_clear_toolbar (f, RIGHT_TOOLBAR, 0);
+}
+
+static void
+x_redraw_exposed_toolbar (struct frame *f, enum toolbar_pos pos, int x, int y,
+ int width, int height)
+{
+ int bar_x, bar_y, bar_width, bar_height, vert;
+ Lisp_Object button = FRAME_TOOLBAR_BUTTONS (f, pos);
+
+ get_toolbar_coords (f, pos, &bar_x, &bar_y, &bar_width, &bar_height,
+ &vert, 1);
+
+ if (((y + height) < bar_y) || (y > (bar_y + bar_height)))
+ return;
+ if (((x + width) < bar_x) || (x > (bar_x + bar_width)))
+ return;
+
+ while (!NILP (button))
+ {
+ struct toolbar_button *tb = XTOOLBAR_BUTTON (button);
+
+ if (vert)
+ {
+ if (((tb->y + tb->height) > y) && (tb->y < (y + height)))
+ tb->dirty = 1;
+
+ /* If this is true we have gone past the exposed region. */
+ if (tb->y > (y + height))
+ break;
+ }
+ else
+ {
+ if (((tb->x + tb->width) > x) && (tb->x < (x + width)))
+ tb->dirty = 1;
+
+ /* If this is true we have gone past the exposed region. */
+ if (tb->x > (x + width))
+ break;
+ }
+
+ button = tb->next;
+ }
+
+ /* Even if none of the buttons 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 toolbar is in the exposed region. */
+ x_output_toolbar (f, pos);
+}
+
+static void
+x_redraw_exposed_toolbars (struct frame *f, int x, int y, int width,
+ int height)
+{
+ assert (FRAME_X_P (f));
+
+ if (FRAME_REAL_TOP_TOOLBAR_VISIBLE (f))
+ x_redraw_exposed_toolbar (f, TOP_TOOLBAR, x, y, width, height);
+
+ if (FRAME_REAL_BOTTOM_TOOLBAR_VISIBLE (f))
+ x_redraw_exposed_toolbar (f, BOTTOM_TOOLBAR, x, y, width, height);
+
+ if (FRAME_REAL_LEFT_TOOLBAR_VISIBLE (f))
+ x_redraw_exposed_toolbar (f, LEFT_TOOLBAR, x, y, width, height);
+
+ if (FRAME_REAL_RIGHT_TOOLBAR_VISIBLE (f))
+ x_redraw_exposed_toolbar (f, RIGHT_TOOLBAR, x, y, width, height);
+}
+
+static void
+x_redraw_frame_toolbars (struct frame *f)
+{
+ /* There are certain startup paths that lead to update_EmacsFrame in
+ faces.c being called before a new frame is fully initialized. In
+ particular before we have actually mapped it. That routine can
+ call this one. So, we need to make sure that the frame is
+ actually ready before we try and draw all over it. */
+
+ if (XtIsRealized (FRAME_X_SHELL_WIDGET (f)))
+ x_redraw_exposed_toolbars (f, 0, 0, FRAME_PIXWIDTH (f),
+ FRAME_PIXHEIGHT (f));
+}
+
+\f
+static void
+x_initialize_frame_toolbar_gcs (struct frame *f)
+{
+ EmacsFrame ef = (EmacsFrame) FRAME_X_TEXT_WIDGET (f);
+ EmacsFramePart *efp = &(ef->emacs_frame);
+ XGCValues gcv;
+ unsigned long flags = (GCForeground | GCBackground | GCGraphicsExposures);
+
+ /*
+ * If backgroundToolBarColor is specified, use it.
+ * Otherwise use the background resource.
+ */
+ if (efp->background_toolbar_pixel == (Pixel) (-1))
+ efp->background_toolbar_pixel = efp->background_pixel;
+
+ /*
+ * ####
+ * If foregroundToolBarColor is specified, use it.
+ * Otherwise use the foreground resource.
+ *
+ * The foreground pixel is currently unused, but will likely be
+ * used when toolbar captions are generated by the toolbar code
+ * instead being incorporated into the icon image.
+ */
+ if (efp->foreground_toolbar_pixel == (Pixel) (-1))
+ efp->foreground_toolbar_pixel = efp->foreground_pixel;
+
+ gcv.foreground = efp->background_toolbar_pixel;
+ gcv.background = ef->core.background_pixel;
+ gcv.graphics_exposures = False;
+ FRAME_X_TOOLBAR_BLANK_BACKGROUND_GC (f) =
+ XtGetGC ((Widget) ef, flags, &gcv);
+
+ if (efp->top_toolbar_shadow_pixel == efp->bottom_toolbar_shadow_pixel)
+ {
+ efp->top_toolbar_shadow_pixel = efp->background_toolbar_pixel;
+ efp->bottom_toolbar_shadow_pixel = efp->background_toolbar_pixel;
+ }
+
+ x_generate_shadow_pixels (f, &efp->top_toolbar_shadow_pixel,
+ &efp->bottom_toolbar_shadow_pixel,
+ efp->background_toolbar_pixel,
+ ef->core.background_pixel);
+
+ gcv.foreground = efp->top_toolbar_shadow_pixel;
+ gcv.background = ef->core.background_pixel;
+ gcv.graphics_exposures = False;
+ flags = GCForeground | GCBackground | GCGraphicsExposures;
+ if (efp->top_toolbar_shadow_pixmap)
+ {
+ gcv.fill_style = FillOpaqueStippled;
+ gcv.stipple = efp->top_toolbar_shadow_pixmap;
+ flags |= GCStipple | GCFillStyle;
+ }
+ FRAME_X_TOOLBAR_TOP_SHADOW_GC (f) = XtGetGC ((Widget) ef, flags, &gcv);
+
+ gcv.foreground = efp->bottom_toolbar_shadow_pixel;
+ gcv.background = ef->core.background_pixel;
+ gcv.graphics_exposures = False;
+ flags = GCForeground | GCBackground | GCGraphicsExposures;
+ if (efp->bottom_toolbar_shadow_pixmap)
+ {
+ gcv.fill_style = FillOpaqueStippled;
+ gcv.stipple = efp->bottom_toolbar_shadow_pixmap;
+ flags |= GCStipple | GCFillStyle;
+ }
+ FRAME_X_TOOLBAR_BOTTOM_SHADOW_GC (f) = XtGetGC ((Widget) ef, flags, &gcv);
+
+#ifdef HAVE_XPM
+ FRAME_X_TOOLBAR_PIXMAP_BACKGROUND_GC (f) =
+ FRAME_X_TOOLBAR_BLANK_BACKGROUND_GC (f);
+#else
+ {
+ struct device *d = XDEVICE (f->device);
+ Display *dpy = DEVICE_X_DISPLAY (d);
+
+ gcv.background = WhitePixelOfScreen (DefaultScreenOfDisplay (dpy));
+ gcv.foreground = BlackPixelOfScreen (DefaultScreenOfDisplay (dpy));
+ gcv.graphics_exposures = False;
+ flags = GCForeground | GCBackground | GCGraphicsExposures;
+ FRAME_X_TOOLBAR_PIXMAP_BACKGROUND_GC (f) =
+ XtGetGC ((Widget) ef, flags, &gcv);
+ }
+#endif
+}
+
+static void
+x_release_frame_toolbar_gcs (struct frame *f)
+{
+ Widget ew = (Widget) FRAME_X_TEXT_WIDGET (f);
+ XtReleaseGC (ew, FRAME_X_TOOLBAR_BLANK_BACKGROUND_GC (f));
+ /* If compiled with XPM support, this is a pointer to the same GC as
+ FRAME_X_BLANK_BACKGROUND_GC so we need to make sure we don't
+ release it twice. */
+#ifndef HAVE_XPM
+ XtReleaseGC (ew, FRAME_X_TOOLBAR_PIXMAP_BACKGROUND_GC (f));
+#endif
+ XtReleaseGC (ew, FRAME_X_TOOLBAR_TOP_SHADOW_GC (f));
+ XtReleaseGC (ew, FRAME_X_TOOLBAR_BOTTOM_SHADOW_GC (f));
+
+ /* Seg fault if we try and use these again. */
+ FRAME_X_TOOLBAR_BLANK_BACKGROUND_GC (f) = (GC) - 1;
+ FRAME_X_TOOLBAR_PIXMAP_BACKGROUND_GC (f) = (GC) - 1;
+ FRAME_X_TOOLBAR_TOP_SHADOW_GC (f) = (GC) - 1;
+ FRAME_X_TOOLBAR_BOTTOM_SHADOW_GC (f) = (GC) - 1;
+}
+
+static void
+x_initialize_frame_toolbars (struct frame *f)
+{
+ EmacsFrame ef = (EmacsFrame) FRAME_X_TEXT_WIDGET (f);
+
+ if (ef->emacs_frame.toolbar_shadow_thickness < MINIMUM_SHADOW_THICKNESS)
+ Xt_SET_VALUE (FRAME_X_TEXT_WIDGET (f),
+ XtNtoolBarShadowThickness, MINIMUM_SHADOW_THICKNESS);
+
+ x_initialize_frame_toolbar_gcs (f);
+}
+
+/* This only calls one function but we go ahead and create this in
+ case we ever do decide that we need to do more work. */
+static void
+x_free_frame_toolbars (struct frame *f)
+{
+ x_release_frame_toolbar_gcs (f);
+}
+
+\f
+/************************************************************************/
+/* initialization */
+/************************************************************************/
+
+void
+console_type_create_toolbar_x (void)
+{
+ CONSOLE_HAS_METHOD (x, output_frame_toolbars);
+ CONSOLE_HAS_METHOD (x, initialize_frame_toolbars);
+ CONSOLE_HAS_METHOD (x, free_frame_toolbars);
+ CONSOLE_HAS_METHOD (x, output_toolbar_button);
+ CONSOLE_HAS_METHOD (x, redraw_exposed_toolbars);
+ CONSOLE_HAS_METHOD (x, redraw_frame_toolbars);
+}
projects / chise / xemacs-chise.git.1 / commitdiff