From: tomo Date: Wed, 10 May 2000 03:32:05 +0000 (+0000) Subject: This commit was generated by cvs2svn to compensate for changes in r1398, X-Git-Tag: r21-2-33~2^2~1 X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=commitdiff_plain;h=e7db60a88bd8d75328c4ec843460d38906d7f504;hp=a92fd34d4e19af388237a0913a5c30ddbcfdde7a This commit was generated by cvs2svn to compensate for changes in r1398, which included commits to RCS files with non-trunk default branches. --- diff --git a/INSTALL b/INSTALL index d00a221..4019235 100644 --- a/INSTALL +++ b/INSTALL @@ -2,8 +2,6 @@ XEmacs Installation Guide Copyright (c) 1994, 1995, 1996 Board of Trustees, University of Illinois Copyright (c) 1994-1999 Free Software Foundation, Inc. -Synched up with: FSF 19.30. - Permission is granted to anyone to make or distribute verbatim copies of this document as received, in any medium, provided that the copyright notice and permission notice are preserved, @@ -18,20 +16,24 @@ Synched up with: FSF 19.30. of the Free Software Foundation are approved by the Foundation. -BUILDING AND INSTALLATION (Unix and Cygwin, see the file nt/README -for instructions on building under Microsoft Windows): +BUILDING AND INSTALLATION FOR UNIX AND CYGWIN + +(for Microsoft Windows, see nt/README also.) -1) Make sure your system has enough swapping space allocated to handle - a program whose pure code is 900k bytes and whose data area is at - least 400k and can reach 8Mb or more. Note that a typical XEmacs - build is much bigger. If the swapping space is - insufficient, you will get an error in the command `temacs -batch - -l loadup dump', found in `./src/Makefile.in.in', or possibly when - running the final dumped XEmacs. +PREREQUISITES +============= - Verify that your users have a high enough stack limit. On some - systems such as OpenBSD and OSF/Tru64 the default is 2MB which is - too low. See 'PROBLEMS' for details. +Make sure your system has enough swapping space allocated to handle a +program whose pure code is 900k bytes and whose data area is at least +400k and can reach 8Mb or more. Note that a typical XEmacs build is +much bigger. If the swapping space is insufficient, you will get an +error in the command `temacs -batch -l loadup dump', found in +`./src/Makefile.in.in', or possibly when running the final dumped +XEmacs. + +Verify that your users have a high enough stack limit. On some systems +such as OpenBSD and OSF/Tru64 the default is 2MB which is too low. See +'PROBLEMS' for details. Building XEmacs requires about 100 Mb of disk space (including the XEmacs sources). Once installed, XEmacs occupies between 20 and 100 Mb @@ -44,8 +46,10 @@ XEmacs requires an ANSI C compiler, such as GCC. If you wish to build the documentation yourself, you will need at least version 1.68 of makeinfo (GNU texinfo-3.11). +ADD-ON LIBRARIES +================ -2) Decide on what other software packages you would like to use with +Decide on what other software packages you would like to use with XEmacs, but are not yet available on your system. On some systems, Motif and CDE are optional additions. On Solaris, the SUNWaudmo package enables native sound support. There are also a number of free @@ -72,37 +76,19 @@ be set together by using the --with-site-prefix command. This will set these variables as needed assuming your libraries are organised as a typical /usr tree. -3) [N.B. Most of this section can be done during or after the -compilation of the core source code, but is present early to catch -your attention.] - -Decide what Initial Lisp you need with XEmacs. XEmacs is -distributed separately from most of its runtime environment. This is -done to make it easier for administrators to tune an installation for -what the local users need. Note that while XEmacs will compile and -install without any packages present at least some additional lisp -packages are needed to bring XEmacs up to "normal" editor -functionality. Installation and upgrading of the packages can be done -almost automatically when from inside XEmacs when it has been compiled -and installed. - -More information and suggestions for which packages to install see the -file README.packages. - -IMPORTANT! The file README.packages contain information vital to have -a fully working XEmacs. This information was not included in this file -only because it is too large for this terse INSTALL. Please read -README.packages now! - -By default, packages will be searched for in the path +PACKAGE SYSTEM +============== -~/.xemacs::$prefix/lib/xemacs-${version}/mule-packages:$prefix/lib/xemacs/mule-packages:$prefix/lib/xemacs-${version}/xemacs-packages:$prefix/lib/xemacs/xemacs-packages +The file README.packages contain information vital to have a fully +working XEmacs. This information was not included in this file only +because it is too large for this terse INSTALL. Please read +README.packages now! -This may be changed by specifying a different value with the ---package-path configuration option. +CONFIGURATION OPTIONS +===================== -4) In the top level directory of the XEmacs distribution, run the - program `configure' as follows: +In the top level directory of the XEmacs distribution, run the +program `configure' as follows: ./configure [CONFIGURATION-NAME] [--OPTION[=VALUE]] ... @@ -202,12 +188,17 @@ files, like executables and utility programs. If specified, EXECDIR/lib/xemacs-VERSION/CONFIGURATION-NAME. EXECDIR/bin should be a directory that is normally in users' PATHs. -For example, the command - - ./configure mips-dec-ultrix --with-x11=yes - -configures XEmacs to build for a DECstation running Ultrix, with -support for the X11 window system. +If you specify --prefix (or any of the other installation directory +options), they will get compiled into the xemacs executable so it will +be able to find its various associated file. However, XEmacs has +quite elaborate logic to find out the locations of these directories +dynamically. Sometimes, it is desirable *not* to compile these +directories into the executable so you can move the XEmacs +installation around (as whole) at will. This is true for binary kits, +for instance. Therefore, you can specify --without-prefix on the +configure command line to prevent the installation prefix to become +part of the generated executable; everything else will continue to +work as usual. The `--with-menubars=TYPE' option allows you to specify which X toolkit you wish to use for the menubar. The valid options are @@ -379,24 +370,35 @@ Please note that it is safe to build with as many of the options `--with-xim', `--with-canna' and `--with-wnn' as your system supports. +MAIL LOCKING +============ + +Find out what the preferred method for locking mail spool files is in +your environment. Presently, XEmacs supports lockf, flock, and dot +locking. Specify the locking method via the --mail-locking=METHOD +option to configure. Valid values for METHOD are --mail-locking are +`lockf', `flock', and `dot'. + +RUNNING CONFIGURE +================= + `configure' doesn't do any compilation or installation itself. It just creates the files that influence those things: `./src/config.h', and all the Makefile's in the build tree. -The `--with-pop', `--with-hesiod', and `--with-kerberos' options are used -in conjunction with movemail. As of XEmacs 20.1, movemail is identical -to the one used in Emacs. - When it is done, `configure' prints a description of what it did and creates a shell script `config.status' which, when run, recreates the same configuration. If `configure' exits with an error after disturbing the status quo, it removes `config.status'. -5) Look at `./lisp/paths.el'; if some of those values are not right -for your system, set up the file `./lisp/site-init.el' with XEmacs -Lisp code to override them; it is not a good idea to edit paths.el -itself. YOU MUST USE THE LISP FUNCTION `setq' TO ASSIGN VALUES, -rather than `defvar', as used by `./lisp/paths.el'. For example, +AUXILIARY PATHS +=============== + +Look at `./lisp/paths.el'; if some of those values are not right for +your system, set up the file `./lisp/site-init.el' with XEmacs Lisp +code to override them; it is not a good idea to edit paths.el itself. +YOU MUST USE THE LISP FUNCTION `setq' TO ASSIGN VALUES, rather than +`defvar', as used by `./lisp/paths.el'. For example, (setq news-inews-program "/usr/bin/inews") @@ -415,17 +417,16 @@ configured. If you have an unusual automounter configuration that XEmacs cannot detect, you may need to change the value of `directory-abbrev-alist'. -6) Put into `./lisp/site-init.el' or `./lisp/site-load.el' any Emacs -Lisp code you want XEmacs to load before it is dumped out. Use +SITE-SPECIFIC STARTUP CODE +========================== + +Put into `./lisp/site-init.el' or `./lisp/site-load.el' any Emacs Lisp +code you want XEmacs to load before it is dumped out. Use site-load.el for additional libraries if you arrange for their documentation strings to be in the lib-src/DOC file (see src/Makefile.in.in if you wish to figure out how to do that). For all else, use site-init.el. -If you set load-path to a different value in site-init.el or -site-load.el, XEmacs will use *precisely* that value when it starts up -again. If you do this, you are on your own! - Note that, on some systems, the code you place in site-init.el must not use expand-file-name or any other function which may look something up in the system's password and user information database. @@ -434,12 +435,18 @@ See `./PROBLEMS' for more details on which systems this affects. The `site-*.el' files are nonexistent in the distribution. You do not need to create them if you have nothing to put in them. -7) Refer to the file `./etc/TERMS' for information on fields you may +TERMCAP CONFIGURATION +===================== + +Refer to the file `./etc/TERMS' for information on fields you may wish to add to various termcap entries. The files `./etc/termcap.ucb' and `./etc/termcap.dat' may already contain appropriately-modified entries. -8) Run `make' in the top directory of the XEmacs distribution to finish +RUNNING MAKE +============ + +Run `make' in the top directory of the XEmacs distribution to finish building XEmacs in the standard way. The final executable file is named `src/emacs'. You can execute this file "in place" without copying it, if you wish; then it automatically uses the sibling @@ -511,27 +518,7 @@ By default, XEmacs installs its files in the following directories: If these directories are not what you want, you can specify where to install XEmacs's libraries and data files or where XEmacs should search for its lisp files by giving values for `make' variables as part of -the command. See the section below called `MAKE VARIABLES' for more -information on this. - -Using GNU Make allows for simultaneous builds with and without the ---srcdir option. - -9) If your system uses lock files to interlock access to mailer inbox -files, then you might need to make the movemail program setuid or -setgid to enable it to write the lock files. We believe this is safe. -The setuid/setgid bits need not be set on any other XEmacs-related -executables. - -10) You are done with the hard part! You can remove executables and -object files from the build directory by typing `make clean'. To also -remove the files that `configure' created (so you can compile XEmacs -for a different configuration), type `make distclean'. - -11) You should now go to the XEmacs web page at http://www.xemacs.org/ -and decide what additional Lisp support you wish to have. - -MAKE VARIABLES +the command. You can change where the build process installs XEmacs and its data files by specifying values for `make' variables as part of the `make' @@ -643,7 +630,7 @@ GNU software; here are some variables specific to XEmacs. (where VERSION and CONFIGURATION-NAME are as described above). `docdir' indicates where to put Lisp documentation strings that XEmacs - refers to as it runs. It defaults the value of `archlibdir' + refers to as it runs. It defaults to the value of `archlibdir' (see above). `moduledir' indicates where XEmacs installs and expects to find @@ -667,126 +654,33 @@ The top-level Makefile stores the variable settings it used in the Makefiles for the subdirectories, so you don't have to specify them when running make in the subdirectories. +Using GNU Make allows for simultaneous builds with and without the +--srcdir option. -CONFIGURATION BY HAND - -Instead of running the `configure' program, you have to perform the -following steps. - -1) Copy `./src/config.h.in' to `./src/config.h'. - -2) Consult `./etc/MACHINES' to see what configuration name you should -use for your system. Look at the code of the `configure' script to -see which operating system and architecture description files from -`src/s' and `src/m' should be used for that configuration name. Edit -`src/config.h', and change the two `#include' directives to include -the appropriate system and architecture description files. - -3) Edit `./src/config.h' to set the right options for your system. If -you need to override any of the definitions in the s/*.h and m/*.h -files for your system and machine, do so by editing config.h, not by -changing the s/*.h and m/*.h files. Occasionally you may need to -redefine parameters used in `./lib-src/movemail.c'. - -4) If you're going to use the make utility to build XEmacs, you will -still need to run `configure' first, giving the appropriate values for -the variables in the sections entitled "Things `configure' Might Edit" -and "Where To Install Things." Note that you may only need to change -the variables `prefix' and `exec_prefix', since the rest of the -variables have reasonable defaults based on them. For each Makefile -variable of this type, there is a corresponding configure option; for -example, to change the location of the lock directory, you might use - - ./configure --lockdir=/nfs/xemacslock - -The `configure' script is built from `configure.in' by the `autoconf' -program. However, since XEmacs has configuration requirements that -autoconf can't meet, `configure.in' uses a marriage of custom-baked -configuration code and autoconf macros. New versions of autoconf -could very well break this arrangement, so it may be wise to avoid -rebuilding `configure' from `configure.in' when possible. - - -BUILDING XEMACS BY HAND - -Once XEmacs is configured, running `make' in the top directory performs -the following steps. - -1) Run `make src/paths.h' in the top directory. This produces -`./src/paths.h' from the template file `./src/paths.h.in', changing -the paths to the values specified in `./Makefile'. - -2) Cd to `./lib-src' and run `make'. This creates executables named -`ctags' and `etags' and `wakeup' and `make-docfile' and `digest-doc' -and `test-distrib'. And others. - -3) Cd to `./src' and Run `make'. This refers to files in the `./lisp' -and `./lib-src' subdirectories using names `../lisp' and -`../lib-src'. - -This creates a file `./src/xemacs' which is the runnable XEmacs, -assigning it a new build version number by incrementing the build -version stored in `./lisp/version.el'. - -It also creates a file in `./lib-src' whose name is `DOC' followed by -the current XEmacs version. This file contains documentation strings -for all the functions in XEmacs. Each time you run make to make a new -xemacs, a new DOC file with a new name is made. You must keep the DOC -file for an XEmacs version as long as you keep using that XEmacs -version. - - -INSTALLATION BY HAND - -The steps below are done by running `make install' in the main -directory of the XEmacs distribution. - -1) Copy `./lisp' and its subdirectories, `./etc', and the executables -in `./lib-src' to their final destinations, as selected in `./src/paths.h'. - -Strictly speaking, not all of the executables in `./lib-src' need be copied. -- The programs `cvtmail', `emacsserver', `env', `fakemail', `hexl', - `movemail', `timer', `vcdiff', `wakeup', and `yow' are used by - XEmacs; they do need to be copied. -- The programs `etags', `ctags', `emacsclient', `b2m', `rcs2log', - `gnuclient', `gnudoit', and `gnuattach' are intended to be run - by users; they are handled below. -- The programs `make-docfile' and `test-distrib' were - used in building XEmacs, and are not needed any more. -- The programs `digest-doc' and `sorted-doc' convert a `DOC' file into - a file for users to read. There is no important reason to move them. - -2) Copy the files in `./info' to the place specified in -`./lisp/site-init.el' or `./lisp/paths.el'. Note that if the -destination directory already contains a file named `dir', you -probably don't want to replace it with the `dir' file in the XEmacs -distribution. Instead, you should make sure that the existing `dir' -file contains an appropriate menu entry for the XEmacs info. +MAIL-LOCKING POST-INSTALLATION +============================== -3) Create a directory for XEmacs to use for clash detection, named as -indicated by the PATH_LOCK macro in `./src/paths.h'. +If your system uses dot-locking to interlock access to mailer inbox +files, then you might need to make the movemail program setuid or +setgid to enable it to write the lock files. We believe this is safe. +The setuid/setgid bits need not be set on any other XEmacs-related +executables. -4) Copy `./src/xemacs' to `/usr/local/bin', or to some other directory -in users' search paths. `./src/xemacs' has an alternate name -`./src/emacs-EMACSVERSION'; you may wish to make a symbolic link named -`/usr/local/bin/xemacs' pointing to that alternate name, as an easy way -of installing different versions. +CLEANING UP +========== -You can delete `./src/temacs'. - -5) Copy the programs `b2m', `emacsclient', `ctags', `etags', `rcs2log', -`gnuclient', `gnudoit', and `gnuattach' from `./lib-src' to -`/usr/local/bin'. These programs are intended for users to run. - -6) Copy the man pages in `./etc' for xemacs, ctags, etags, and gnuserv -into the appropriate man directories. +You are done with the hard part! You can remove executables and +object files from the build directory by typing `make clean'. To also +remove the files that `configure' created (so you can compile XEmacs +for a different configuration), type `make distclean'. -7) The files in the `./src' subdirectory, except for `xemacs', are not -used by XEmacs once it is built. The source would be handy for -debugging. +READ README.packages +==================== +Do it! PROBLEMS +======== The most likely problem is that you forgot to read and follow the directions in README.packages. You can not have a working XEmacs @@ -794,7 +688,3 @@ without downloading some additional packages. See the file PROBLEMS in this directory for a list of various problems sometimes encountered, and what to do about them. - - -If all else fails, please see etc/InstallGuide courtesy -of Jonathan Seth Hayward. diff --git a/PROBLEMS b/PROBLEMS index b5414a5..f3ab159 100644 --- a/PROBLEMS +++ b/PROBLEMS @@ -144,9 +144,15 @@ libz.a in the X11 binary directory. ** AIX *** On AIX 4.3, you must specify --with-dialogs=athena with configure -*** The libXt shipped with AIX 4.3 is broken. This causes xemacs -nw - to fail in various ways. The solution is to build against stock - X11R6. +*** The libXt shipped with AIX 4.3 up to 4.3.2 is broken. This causes + xemacs -nw to fail in various ways. The official APAR is this: + +APAR NUMBER: RESOLVED AS: PROGRAM ERROR + +ABSTRACT: +: LIBXT.A INCORRECT HANDLING OF EXCEPTIONS IN XTAPPADDINPUT + + The solution is to install X11.base.lib at version >=4.3.2.5. *** On AIX, you get this compiler error message: diff --git a/aclocal.m4 b/aclocal.m4 index 721d768..48afe84 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -386,6 +386,7 @@ if test "$cc_produces_so" = "yes"; then dll_ld=$CC dll_ldflags=$xcldf can_build_shared=yes + ld_shlibs=yes else # OK - only NOW do we futz about with ld. # See if the linker supports building shared libraries. diff --git a/configure.usage b/configure.usage index a6e9c6b..6b95066 100644 --- a/configure.usage +++ b/configure.usage @@ -139,6 +139,8 @@ Additional features: --with-dnet (*) Compile with support for DECnet. --with-ldap (*) Compile with support for the LDAP protocol (requires installed LDAP libraries on the system). +--with-postgresql (*) Compile with support for the PostgreSQL RDBMS (requires + installed PostreSQL libraries on the system). --mail-locking=TYPE (*) Specify the locking to be used by movemail to prevent concurrent updates of mail spool files. Valid types are `lockf', `flock', and `dot'. diff --git a/etc/NEWS b/etc/NEWS index ee6e827..9425a05 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -47,6 +47,28 @@ to set `delete-key-deletes-forward' to nil is if you want to use the Delete key to delete backwards, despite the presence (according to Xlib) of a BackSpace key on the keyboard. +** Shifted motion keys now select text by default. You can turn this +off by setting `shifted-motion-keys-select-region' to nil. + +** You can now set the variable `kill-whole-line' to `always', which +makes `kill-line' (C-k) delete the entire line always, not just when +the cursor is at the beginning of the line. This behavior, as well as +the existing kill-whole-line behavior, now only take effect when +kill-line is called interactively, although this is a departure from a +previous behavior in the case of setting this variable kill-whole-line +to t. It is almost certainly what has always been intended, and most +likely the old way of doing things introduced bugs. + +The new function `historical-kill-line' ignores the `kill-whole-line' +setting and always gives the historical behavior of only killing to +the end of the line. This function is bound to Sh-C-k, so that the +kill to end of line behavior is available, even when `kill-whole-line' +has been customized. + +** XEmacs menus now have accelerators by default. If a menu item does +not have an accelerator specified, one is created dynamically, using +numbers 1-9 and letters. + ** Interactive searching and matching case improvements. Case sensitiveness in searching operations is normally controlled by @@ -68,13 +90,20 @@ point. If you want to disable the feature, set ** You can now use the buffer tabs to switch between buffers. The tabs are located between the toolbar and the uppermost window, in a location called "gutter". If you dislike the buffer tabs, you can -disable them by specifying: +disable them by customizing `gutter-buffers-tab-visible-p', or by +placing this in your .emacs: - (set-specifier default-gutter-visible-p nil) + (set-gutter-element-visible-p default-gutter-visible-p 'buffers-tab nil) -in your `.emacs'. You can change the location of the gutter with +You can change the location of the gutter with `set-default-gutter-position', however currently only MS-Windows -supports tab widgets with orientations other than vertical.. +supports tab widgets with orientations other than vertical. + +** Kill and yank now interact with the clipboard by default under +Windows. This was done by changing the default value of +`interprogram-cut-function' and `interprogram-paste-function'. You +can get the old behavior by setting these to nil, and there is an +option on the options menu to do this. ** When you press RET at a minibuffer prompt that provides a default value, the value is stored in history instead of an empty line. Also, @@ -91,6 +120,13 @@ the left side. All functions have been rewritten to avoid inserting unwanted spaces, and an optional prefix now allows them to behave the old way. +Also, the behavior of `string-rectangle' is now compliant with +`pending-delete-mode': if this mode is active, then the string +replaces the region rectangle. Otherwise, the command does not delete +or overwrite any existing text. For those who want that feature but do +not use pending-delete-mode, a new function, `replace-rectangle', is +available. + As a side effect, the FORCE argument to `move-to-column' now understands the special value `coerce', which means that the line should not be filled if it is too short to reach the desired column. @@ -177,17 +213,40 @@ Moreover, -user (which used to only work in unpredictable ways) is now equivalent to -user-init-file ~/.emacs -user-init-directory ~/.xemacs. +** Init file may be called .emacs.el. + +Like in GNU Emacs 20.4 and on, you can now name the XEmacs init file +`.emacs.el'. Formerly the name had to be `.emacs'. If you use the +name `.emacs.el', you can byte-compile the file in the usual way. + +If both `.emacs' and `.emacs.el' exist, the latter file is the one +that is used. + ** New variable `mswindows-meta-activates-menu'. -If you set this variable to nil then pressing the Alt key under -MS-Windows will no longer activate the menubar. The default is t. +If you set this variable to nil then pressing and releasing the Alt +key under MS-Windows will no longer activate the menubar. The default +is t. This is not to be confused with `menu-accelerator-enabled', +which enables the use of Alt+ accelerators to invoke the +menus. -** Pixel-based scrolling has been implemented. +** Pixel-based scrolling has been implemented. By default this will attempt to scroll in increments equal to the -height of the default face. Set `window-pixel-scroll-increment' to +height of the default face. Set `window-pixel-scroll-increment' to modify this behaviour. +** Operation progress can be displayed using graphical widgets. +See `lprogress-display' for details. This support has been switched +on by default for font-lock and some web browsing functions. If you +do not like this behaviour set `progress-display-use-echo-area'. + ** Etags changes. +** The PostgreSQL Relational Database Management System is now supported. +It is now possible to build XEmacs so that the programming interface +to the PostgreSQL RDBMS (libpq) is available in XEmacs Lisp. +Supported versions of PostgreSQL are 6.5.3 (earlier versions may work, +but have not been tested) and 7.0-beta1. + *** In DOS, etags looks for file.cgz if it cannot find file.c. *** New option --ignore-case-regex is an alternative to --regex. It is now @@ -241,15 +300,7 @@ get to the initialized data. In that scheme, there is no difference between `temacs' and `xemacs'. This is all very experimental, though. Configure with `--pdump' to -try testing it. NOTE: it is expected that `make' will fail after -dumping `xemacs.dmp'. This is because Makefiles have not yet been -modified to not expect `temacs' producing an `xemacs' executable. You -can try it out by simply running `src/temacs'. If it starts without -failure, the portable dumping worked. - -#### NOTE: the portable dumper is not really usable yet, because the -state of built-in variables is not yet saved. Olivier promised to fix -it. Nag, nag. +try testing it. ** Much effort has been invested to make XEmacs Lisp faster: @@ -295,8 +346,8 @@ buttons, scrollbars, combo boxes, edit fields and progress gauges in a buffer. As a side effect subwindow support now works once again. All of this is still fairly experimental and there is no -documentation. The current APIs might change in a future version of -XEmacs. Some widgets are only available under MS-Windows. See the +documentation. The current APIs might change in a future version of +XEmacs. Some widgets are only available under MS-Windows. See the file glyphs-test.el in the XEmacs src distribution for examples of usage. @@ -443,6 +494,21 @@ beginning with colon as keywords only if they are interned in the global obarray. `keywordp' used to wrongly return t in both cases above. +** New variables `this-command-properties' and +`last-command-properties' are now available for communication between +consecutive commands. Commands should use these to communicate with +the pre/post-command hooks, subsequent commands, wrapping commands, +etc. in preference to looking at and/or setting `this-command'. + +** New functions `add-one-shot-hook' and `add-local-one-shot-hook' make +it possible to add a "one-shot" hook, which is to say a hook that runs +only once, and automatically removes itself after the first time it +has run. + +** The descriptor that specifies the text of a menu item can now be an +evaluated expression. This makes this descriptor parallel with +others, which can also be expressions. + * Changes in XEmacs 21.0 ======================== diff --git a/etc/TUTORIAL.fr b/etc/TUTORIAL.fr index 4a0d27c..e78ae19 100644 --- a/etc/TUTORIAL.fr +++ b/etc/TUTORIAL.fr @@ -1,9 +1,9 @@ -Copyright (c) 1997, Didier Verna . +Copyright (c) 1997-2000, Didier Verna . Se reporter à la fin du document pour les conditions. Vous lisez actuellement la version française du tutoriel d'Emacs. -Cette version a été produite à partir de la version anglaise, qui est +Cette version a été produite à partir de la version anglaise, qui est Copyright (c) 1985, 1996 Free Software Foundation, Inc. @@ -29,7 +29,7 @@ disponibles dans Emacs, les conventions suivantes sont utilis NOTE IMPORTANTE: pour quitter Emacs, tapez C-x C-c (deux caractères). -Quand vous trouvez les caractères >> au début d'une ligne, cette ligne +Quand vous trouvez les caractères >> au début d'une ligne, cette ligne vous donne des directives pour essayer une commande. Par exemple: <> >> Maintenant, tapez C-v («view next screen») pour passer à l'écran @@ -37,7 +37,7 @@ vous donne des directives pour essayer une commande. Par exemple: enfoncée et tapez 'v'). À partir de maintenant, refaites la même chose quand vous avez fini de lire tout l'écran. -Remarquez que quand vous changez d'écran, les deux dernières lignes de +Remarquez que quand vous changez d'écran, les deux dernières lignes de l'écran précédent sont conservées, ceci afin de conserver un minimum de continuité dans la lecture. @@ -70,7 +70,7 @@ Les commandes suivantes sont utiles pour voir des * MOUVEMENTS DE BASE DU CURSEUR ------------------------------- -Passer d'un écran à l'autre, c'est bien ... mais comment faire pour se +Passer d'un écran à l'autre, c'est bien ... mais comment faire pour se déplacer dans le texte d'un seul écran? Il existe plusieurs manières de faire. La plus simple est d'utiliser @@ -98,8 +98,8 @@ car vous vous en servirez tr >> Amenez le curseur sur cette ligne avec quelques C-n. ->> Déplacez vous sur la ligne avec des C-f, puis vers le haut avec des - C-p. Remarquez ce que fait C-p quand le curseur est au milieu de la +>> Déplacez vous sur la ligne avec des C-f, puis vers le haut avec des + C-p. Remarquez ce que fait C-p quand le curseur est au milieu de la ligne. Chaque ligne de texte se termine avec un caractère nommé Newline, qui @@ -125,7 +125,7 @@ op se passe. Si vous trouvez que le déplacement caractère par caractère est trop -lent, vous pouvez vous déplacer mot par mot. M-f et M-b vous déplacent +lent, vous pouvez vous déplacer mot par mot. M-f et M-b vous déplacent respectivement d'un mot en avant et en arrière. >> Tapez quelques M-f et M-b. @@ -143,7 +143,7 @@ unit commandes Control agissent sur des unités plus primaires (caractères, lignes etc.). -Ce parallèle existe encore entre les lignes et les phrases: C-a et C-e +Ce parallèle existe encore entre les lignes et les phrases: C-a et C-e vous positionnent au début ou à la fin d'une ligne, tandis que M-a et M-e vous déplacent au début ou à la fin d'une phrase. @@ -157,7 +157,7 @@ La position du curseur sur dans le texte est aussi appel «point». En d'autres termes, le curseur à l'écran se trouve où le point est dans le texte. -Voici un résumé des commandes simples de déplacement, y compris celles +Voici un résumé des commandes simples de déplacement, y compris celles relatives aux mots et aux phrases: C-f En avant d'un caractère @@ -203,21 +203,21 @@ clavier. Enfin, quand vous aurez l'habitude d'utiliser la touche déplacement plus complexes. La plupart des commandes d'Emacs acceptent un argument numérique, qui -sert souvent comme compteur de répétition. Pour donner un tel argument +sert souvent comme compteur de répétition. Pour donner un tel argument à une fonction, tapez C-u puis les chiffres, et enfin entrez la commande. Si vous disposez de la touche (ou ou ), vous pouvez aussi tapez directement les chiffres tout en maintenant la -touche enfoncée. Il est préférable d'apprendre la méthode C-u car +touche enfoncée. Il est préférable d'apprendre la méthode C-u car elle fonctionne sur tous les terminaux. Par exemple, C-u 8 C-f vous déplace de huit caractères en avant. - + >> Essayez d'utiliser C-n avec un argument numérique pour vous déplacer d'un seul coup sur une autre ligne. Certaines commandes n'interprètent pas leur argument numérique comme -un compteur de répétition. C'est le cas de C-v et M-v qui déplacent le -texte d'autant de lignes plutôt que d'écrans entiers. Par exemple, C-u +un compteur de répétition. C'est le cas de C-v et M-v qui déplacent le +texte d'autant de lignes plutôt que d'écrans entiers. Par exemple, C-u 4 C-v déroulera l'écran de 4 lignes. >> Essayez C-u 8 C-v. @@ -253,14 +253,14 @@ fichier. Si enfin votre pav , celles-ci vous déplaceront d'écran en écran comme C-v et M-v. Toutes ces commandes acceptent des arguments numériques comme décrit -précédemment. +précédemment. * QUAND EMACS EST BLOQUÉ ------------------------ Si jamais Emacs ne répond plus à vos ordres, vous pouvez l'arrêter en -toute sécurité en tapant C-g. C-g peut aussi être utilisé pour stopper +toute sécurité en tapant C-g. C-g peut aussi être utilisé pour stopper une commande qui met trop de temps à s'exécuter. C-g sert également à annuler un argument numérique, ou une commande @@ -271,7 +271,7 @@ que vous ne voulez plus mener Maintenant, tapez C-f. Le curseur doit finalement ne bouger que d'un seul caractère, puisque vous avez annulé l'argument. -Si vous avez tapé un par erreur, vous pourrez toujours l'annuler +Si vous avez tapé un par erreur, vous pourrez toujours l'annuler avec C-g. @@ -296,12 +296,12 @@ espace. Sinon, r Emacs peut afficher plusieurs fenêtres, chacune avec un texte différent. Le terme «fenêtre» signifie ici une zone particulière dans -la fenêtre d'Emacs; il ne s'agit pas de fenêtres pouvant se superposer +la fenêtre d'Emacs; il ne s'agit pas de fenêtres pouvant se superposer dans votre système de multifenétrage. Emacs peut aussi ouvrir -plusieurs fenêtres X (appelées «frames» en jargon Emacsien), mais ceci +plusieurs fenêtres X (appelées «frames» en jargon Emacsien), mais ceci est décrit ultérieurement. -Pour l'instant, mieux vaut ne pas trop s'occuper de plusieurs fenêtres +Pour l'instant, mieux vaut ne pas trop s'occuper de plusieurs fenêtres simultanées, sauf peut-être pour savoir les éliminer toutes sauf une. Ceci est effectué par la commande C-x 1 ('un', pas 'L'). Cette commande tue toutes les fenêtres sauf celle dans laquelle vous vous @@ -335,7 +335,7 @@ quelques fois temps! Plus généralement, efface le caractère situé juste avant le -curseur. +curseur. >> Maintenant, tapez quelques caractères, puis effacez-les avec . Ne vous inquiétez pas pour le contenu de ce tutoriel, ce @@ -364,11 +364,11 @@ pr >> Tapez pour réinsérer le Newline que vous avez effacé. Rappelez-vous bien que la plupart des commandes acceptent un argument -numérique, y compris l'insertion de caractères: +numérique, y compris l'insertion de caractères: >> Tapez C-u 8 *, vous obtiendrez "********". -Vous connaissez maintenant les commandes de base pour insérer du texte +Vous connaissez maintenant les commandes de base pour insérer du texte et corriger des erreurs. Toujours grâce aux touches et , vous pouvez aussi effacer du texte par mot ou par ligne: @@ -386,7 +386,7 @@ Quand vous supprimez plus d'un caract texte pour vous donner la possibilité de le réintroduire. L'opération de réintroduction s'appelle le «yanking». Vous pouvez réintroduire le texte à la même place ou ailleurs. Vous pouvez même le réintroduire -plusieurs fois, pourquoi pas à des endroits différents. La commande de +plusieurs fois, pourquoi pas à des endroits différents. La commande de «yanking» est C-y. Notez bien la différence entre «effacer» et «supprimer». Un texte @@ -396,7 +396,7 @@ vides ne sauvegardent rien. >> Placez le curseur au début d'une ligne non vide. Tapez C-k pour supprimer le texte sur cette ligne. ->> Tapez C-k une deuxième fois. Vous remarquerez que cette fois-ci, la +>> Tapez C-k une deuxième fois. Vous remarquerez que cette fois-ci, la ligne elle-même est supprimée (le caractère Newline). C-k traite son argument numérique de manière spéciale: il supprime @@ -455,7 +455,7 @@ de C-x u Une alternative à C-x u est C-_. C-x u existe car c'est plus facile à taper sur certains claviers. Sur d'autres vous pouvez également -obtenir C-_ en tapant C-/. +obtenir C-_ en tapant C-/. Enfin, la commande d'annulation accepte les argument numériques. @@ -466,18 +466,18 @@ Enfin, la commande d'annulation accepte les argument num Pour sauver votre texte, vous avez besoin de le mettre dans un fichier, sans quoi il disparaîtra quand vous quitterez Emacs. On dit «trouver» un fichier («finding»), ou encore «visiter» un fichier -(«visiting»), ou bien «ouvrir». +(«visiting»), ou bien «ouvrir». Visiter un fichier revient à voir son contenu dans Emacs. Si vous -modifiez le texte du fichier dans Emacs, ces changements ne deviennent -pas permanent, sauf si vous «sauvez» le fichier. Cela permet de ne pas +modifiez le texte du fichier dans Emacs, ces changements ne deviennent +pas permanent, sauf si vous «sauvez» le fichier. Cela permet de ne pas avoir des fichiers à moitié modifiés sur votre système, à moins que vous ne le souhaitiez vraiment. D'autre part, quand Emacs «sauve» un -fichier, il commence par copier l'ancienne version sous un nouveau nom +fichier, il commence par copier l'ancienne version sous un nouveau nom afin que vous puissiez toujours revenir en arrière. Regardez en bas de la fenêtre d'Emacs. Vous trouverez une ligne -contenant des tirets '-', et la chaîne de caractères +contenant des tirets '-', et la chaîne de caractères «Emacs: TUTORIAL.FRANCAIS». Cela vous donne le nom du fichier que vous êtes en train de visiter. En ce moment, vous visitez le fichier «TUTORIAL.FRANCAIS» qui correspond au Tutoriel d'Emacs, version @@ -501,14 +501,14 @@ de la fen manière, on l'appelle «minibuffer». Les commandes d'édition ordinaires peuvent être utilisées pour éditer le nom du fichier. -Pendant que vous êtes en train de taper le nom du fichier, vous pouvez +Pendant que vous êtes en train de taper le nom du fichier, vous pouvez annuler la commande grâce à C-g. >> Tapez C-x C-f puis C-g. Cela annule le minibuffer ainsi que la commande C-x C-f. Vous n'allez finalement pas visiter de fichier. Quand le nom du fichier est correct, tapez . La commande -prendra alors effet et ira chercher le fichier. Après avoir terminé la +prendra alors effet et ira chercher le fichier. Après avoir terminé la saisie du nom, le minibuffer disparaît. Au bout d'un petit moment, le contenu du fichier apparaît et vous @@ -519,7 +519,7 @@ C-x C-s ( Cette commande copie le texte contenu dans Emacs vers le fichier lui-même. La première fois que vous le faites, Emacs sauvegarde la -version initiale du fichier sous un autre nom, en ajoutant un '~' à la +version initiale du fichier sous un autre nom, en ajoutant un '~' à la fin du nom. Quand la sauvegarde est terminée, Emacs affiche le nom du fichier dans @@ -528,17 +528,17 @@ souvent les fichiers pour système (non pas qu'Emacs ne puisse jamais crasher lui-même ...). >> Tapez C-x C-s pour sauver votre copie du tutoriel. - Vous devriez voir apparaître «Wrote ...TUTORIAL.FRANCAIS" tout en bas + Vous devriez voir apparaître «Wrote ...TUTORIAL.FRANCAIS" tout en bas de la fenêtre. NOTE: Sur certains systèmes, C-x C-s bloque l'écran et Emacs ne dit plus rien. Cela signifie qu'une «fonctionnalité» système que l'on -appelle le «flow control» intercepte le C-s et l'empêche de parvenir à +appelle le «flow control» intercepte le C-s et l'empêche de parvenir à Emacs. Pour débloquer la situation, tapez C-q. Reportez-vous dans ce cas à la section «Spontaneous Entry to Incremental Search» du manuel -d'Emacs pour plus d'information sur cette ... «particularité». +d'Emacs pour plus d'information sur cette ... «particularité». -Vous pouvez visiter des fichiers existant, mais aussi des fichiers qui +Vous pouvez visiter des fichiers existant, mais aussi des fichiers qui n'existent pas. C'est en fait comme cela que l'on crée un nouveau fichier dans Emacs. Initialement, le fichier sera inexistant, et la première fois que vous demanderez à Emacs de le sauver, il créera @@ -572,7 +572,7 @@ buffers non attach C-b. Par contre, TOUT texte que vous pouvez voir dans Emacs appartient à un buffer. ->> Tapez C-x 1 pour faire disparaître le buffer contenant la liste des +>> Tapez C-x 1 pour faire disparaître le buffer contenant la liste des buffers. Quand vous éditez un fichier, puis que vous en ouvrez un autre, le @@ -608,7 +608,7 @@ son Remarquez qu'il existe des boutons n'ayant aucun équivalent clavier. Par exemple, le menu «Buffers» donne la liste de tous les -buffers par ordre de plus récente utilisation. Vous pouvez passer d'un +buffers par ordre de plus récente utilisation. Vous pouvez passer d'un buffer à l'autre en les sélectionnant par leur nom dans ce menu. @@ -622,12 +622,12 @@ d cliquant le bouton de gauche au début de la portion à sélectionner, puis en Shift-cliquant à l'autre bout. -Pour supprimer un morceau de texte, utilisez C-w ou le bouton «Cut» du +Pour supprimer un morceau de texte, utilisez C-w ou le bouton «Cut» du menu «Edit». Notez bien que ces deux commandes ne sont pas -équivalentes: C-w ne fait que supprimer le texte en le sauvegardant de +équivalentes: C-w ne fait que supprimer le texte en le sauvegardant de manière interne (comme C-k), mais «Cut» sauvegarde en plus le texte dans le clipboard de X Window, où il pourra être accédé par d'autres -applications. +applications. Pour récupérer du texte en provenance d'autres applications, utilisez «Paste» du menu «Edit». @@ -664,11 +664,11 @@ utilise la commande X (eXtension) qui se pr Ces commandes, bien que très utiles, sont utilisées moins souvent que celles que vous avez déjà apprises. Vous en connaissez déjà deux: les commandes relatives aux fichiers (C-x C-f et C-x C-s). Un autre -exemple est la commande pour quitter définitivement Emacs, C-x C-c (ne +exemple est la commande pour quitter définitivement Emacs, C-x C-c (ne vous inquiétez pas des éventuels changements qui seraient perdus, C-x C-c vous propose de sauver ces changements avant de tuer Emacs). -C-z est la commande qui vous permet de quitter Emacs «temporairement», +C-z est la commande qui vous permet de quitter Emacs «temporairement», pour que vous puissiez y revenir plus tard. Sur les systèmes le permettant, C-z «suspend» Emacs, ce qui signifie @@ -688,7 +688,7 @@ ceux-ci ne sachant pas forc des circonstances où vous ne vous déloguez pas, mieux vaut suspendre par C-z au lieu de sortir véritablement d'Emacs. -Il existe de nombreuses commandes sous C-x. Voici celles que vous avez +Il existe de nombreuses commandes sous C-x. Voici celles que vous avez apprises jusque là: C-x C-f Visiter un fichier (Find File). @@ -702,7 +702,7 @@ souvent, ou disponibles seulement sous certains modes. Par exemple, la commande «replace-string» substitue globalement une chaîne de caractères par une autre. Si vous tapez M-x, Emacs vous affichera M-x en bas de la fenêtre et vous pourrez alors taper le nom d'une -commande, ici replace-string. Tapez simplement 'repl s ' +commande, ici replace-string. Tapez simplement 'repl s ' et Emacs complétera le nom pour vous. Terminez le nom avec La commande replace-string requiert deux arguments: la chaîne à @@ -710,12 +710,12 @@ remplacer et la cha chaînes par . >> Déplacez le curseur sur la ligne blanche en dessous de ce - paragraphe, puis tapez - M-x replsRemarquezNotez. + paragraphe, puis tapez + M-x replsRemarquezNotez. Remarquez comme cette ligne a changé: le mot R-e-m-a-r-q-u-e-z a été remplacé par N-o-t-e-z partout où il est apparu après le - curseur. + curseur. * SAUVEGARDE AUTOMATIQUE @@ -749,15 +749,15 @@ area La ligne juste au dessus de la zone d'écho s'appelle ligne de mode («modeline»). Elle dit actuellement quelque chose comme ça: ---**-XEmacs: TUTORIAL.FRANCAIS (Fundamental)--L752--67%--------- +--**-XEmacs: TUTORIAL.FRANCAIS (Fundamental)--L752--67%--------- -Cette ligne fournit des renseignements utiles sur le status d'Emacs et +Cette ligne fournit des renseignements utiles sur le status d'Emacs et le texte que vous éditez. Vous connaissez déjà la signification du nom de fichier: c'est celui -que vous êtes en train d'éditer. -xx%- indique le pourcentage de texte +que vous êtes en train d'éditer. -xx%- indique le pourcentage de texte situé au dessus du curseur. Si vous pouvez voir le début du fichier à -l'écran, --Top-- sera indiqué au lieu de --00%--. Si le bas du fichier +l'écran, --Top-- sera indiqué au lieu de --00%--. Si le bas du fichier est visible, il y aura --Bot-- à la place. Si votre texte est tout entier contenu dans la fenêtre, vous verrez --All--. @@ -793,7 +793,7 @@ pouvez constater par exemple que M-b et M-f traitent les apostrophes comme faisant partie des mots. Auparavant, ces caractères étaient considérés comme des séparateurs de mots. En général, les modes majeurs ne changent que très peu le comportement des commandes -habituelles. +habituelles. Pour voir la documentation du mode majeur courant, tapez C-h m. @@ -808,7 +808,7 @@ comportement de tel ou tel mode majeur. Ils peuvent désactivés indépendamment du mode majeur courant. Vous pouvez en utiliser autant que possible en même temps. -Un mode mineur très utile pour éditer du texte est le mode +Un mode mineur très utile pour éditer du texte est le mode «Auto Fill». Quand ce mode est activé, Emacs coupe lui-même les lignes si vous tapez du texte trop long pour être contenu sur une seule. @@ -828,7 +828,7 @@ num Tapez du texte jusqu'à ce que la ligne soit coupée, puis replacez la marge à 70. -Si vous faites des changements au milieu d'un paragraphe, le mode Auto +Si vous faites des changements au milieu d'un paragraphe, le mode Auto Fill ne recoupera pas les lignes tout seul. Pour réajuster les lignes d'un tel paragraphe, tapez M-q avec le curseur n'importe où dans le paragraphe. @@ -847,7 +847,7 @@ prochain (ou pr La commande de recherche d'Emacs est un peu différente de celle des autres éditeurs de texte dans la mesure où elle est incrémentale: la recherche intervient au fur et à mesure que vous tapez la chaîne à -rechercher. +rechercher. Pour démarrer une recherche, tapez C-s (en avant) ou C-r (en arrière). MAIS PAS TOUT DE SUITE !! Attendez un peu pour tester ... @@ -872,10 +872,10 @@ n'existe, C-s produira un NOTE: Sur certains systèmes, C-x C-s bloque l'écran et Emacs ne dit plus rien. Cela signifie qu'une «fonctionnalité» système que l'on -appelle le «flow control» intercepte le C-s et l'empêche de parvenir à +appelle le «flow control» intercepte le C-s et l'empêche de parvenir à Emacs. Pour débloquer la situation, tapez C-q. Reportez-vous dans ce cas à la section «Spontaneous Entry to Incremental Search» du manuel -d'Emacs pour plus d'information sur cette ... «particularité». +d'Emacs pour plus d'information sur cette ... «particularité». Si vous êtes au milieu d'une recherche incrémentale et que vous tapez , vous constaterez que le dernier caractère de la chaîne est @@ -923,7 +923,7 @@ r C-M-v (ou C-v si vous n'avez pas de touche ) est un exemple de Control-Méta caractère. L'ordre dans lequel les touches - et sont enfoncées n'a pas d'importance. Ce sont juste + et sont enfoncées n'a pas d'importance. Ce sont juste des modificateurs. Par contre, n'est pas un modificateur, donc vous êtes obligés de taper d'abord , et C-v ensuite. @@ -959,7 +959,7 @@ Pour sortir d'un niveau r l'utiliser pour sortir du minibuffer ou éliminer des fenêtres superflues. ->> Tapez M-x pour vous rendre dans le minibuffer, puis tapez +>> Tapez M-x pour vous rendre dans le minibuffer, puis tapez pour en sortir. Il n'est pas possible d'utiliser C-g pour sortir d'un niveau récursif @@ -985,7 +985,7 @@ Emacs vous indiquera quelles sortes d'aide il peut vous fournir. Si vous ne désirez finalement pas d'aide après avoir tapé C-h, tapez simplement C-g. -(Quelques sites redéfinissent la commande C-h. Cela ne devrait vraiment +(Quelques sites redéfinissent la commande C-h. Cela ne devrait vraiment pas être fait, donc allez vous plaindre à votre administrateur système. Si C-h ne marche pas, tapez M-x help.) @@ -994,7 +994,7 @@ s la commande en question. >> Tapez C-h c C-p. - Le message doit ressembler à quelque chose comme + Le message doit ressembler à quelque chose comme C-p runs the command previous-line @@ -1041,11 +1041,11 @@ C-c. Pour quitter temporairement (et pour pouvoir revenir), tapez C-z Ce tutoriel est fait pour être compréhensible par tout nouvel utilisateur. Donc si quelque chose n'est pas clair, n'hésitez pas à -vous plaindre !! +vous plaindre !! Si vous avez plus particulièrement des remarques à faire sur la version française, vous pouvez aussi me contacter directement -(Didier Verna ). +(Didier Verna ). COPIES / DISTRIBUTION @@ -1057,7 +1057,7 @@ Un peu d'histoire ... Cracraft. * Ben Wing l'a mis à jour pour X Windows. * Martin Buchholz et Hrvoje Niksic y ont apporté des corrections pour - XEmacs. + XEmacs. * J'en (Didier Verna) ai fait une version française un beau jour de 1997. Cette version du tutoriel, tout comme Emacs, est copyrightée, et vous @@ -1082,4 +1082,3 @@ dans le m COPYING et à distribuer Emacs à vos amis. Aidez-nous à tuer l'obstructionnisme logiciel en utilisant, écrivant et partageant du logiciel libre! - diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 968f40e..2615c4a 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,22 @@ +2000-03-20 Martin Buchholz + + * XEmacs 21.2.32 is released. + +2000-03-20 Martin Buchholz + + * make-dump-id.c: Use config.h and systime.h for portability. + +2000-02-20 Olivier Galibert + + * make-dump-id.c: Added. + + * Makefile.in.in: Add support for make-dump-id. + +2000-03-12 Ben Wing + + * etags.c (canonicalize_filename): fixed a problem with gratuitous + capitalization of file names under MS Windows. + 2000-02-23 Martin Buchholz * XEmacs 21.2.31 is released. diff --git a/lib-src/Makefile.in.in b/lib-src/Makefile.in.in index d926072..44195bd 100644 --- a/lib-src/Makefile.in.in +++ b/lib-src/Makefile.in.in @@ -375,6 +375,9 @@ make-msgfile: ${srcdir}/make-msgfile.c make-po: ${srcdir}/make-po.c $(CC) $(cflags) ${srcdir}/make-po.c $(ldflags) -o $@ +make-dump-id: ${srcdir}/make-dump-id.c + $(CC) $(cflags) ${srcdir}/make-dump-id.c $(ldflags) -o $@ + cflags_gnuserv = $(CFLAGS) $(cppflags) $(c_switch_all) ldflags_gnuserv = $(LDFLAGS) $(ld_switch_all) @libs_xauth@ $(ld_libs_general) gnuslib.o: ${srcdir}/gnuslib.c ${srcdir}/gnuserv.h ../src/config.h diff --git a/lib-src/etags.c b/lib-src/etags.c index 680f145..6aa6055 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -5457,7 +5457,7 @@ canonicalize_filename (fn) { #ifdef DOS_NT /* Canonicalize drive letter case. */ - if (islower (fn[0])) + if (islower (fn[0]) && fn[1] == ':') fn[0] = toupper (fn[0]); /* Convert backslashes to slashes. */ for (; *fn != '\0'; fn++) diff --git a/lisp/ChangeLog.1 b/lisp/ChangeLog.1 index f72e3c1..df5627e 100644 --- a/lisp/ChangeLog.1 +++ b/lisp/ChangeLog.1 @@ -130,7 +130,7 @@ 1997-12-07 Hrvoje Niksic - * wid-edit.el (widget-prettyprint-to-string): Nix cl-prettyprint's + * wid-edit.el (widget-prettyprint-to-string): Nix cl-prettyprint's newlines. 1997-12-06 Hrvoje Niksic @@ -151,7 +151,7 @@ 1997-12-07 SL Baur - * egg/egg-cwnn-leim.el (egg-pinyin-activate): New file. Interface + * egg/egg-cwnn-leim.el (egg-pinyin-activate): New file. Interface to Chinese Wnn server. * egg/egg-kwnn-leim.el: New file. Interface to Korean Wnn @@ -237,10 +237,10 @@ 1997-12-05 Mark Borges * mail/mail-extr.el (all-top-level-domains): - Two letter country codes synched with + Two letter country codes synched with http://www.iana.org/in-notes/iana/assignments/country-codes as updated by the RIPE Network Coordination Centre. - Source: ISO 3166 Maintenance Agency + Source: ISO 3166 Maintenance Agency Latest change: Thu Aug 7 17:59:51 MET DST 1997 1997-12-03 Eric Eide @@ -331,7 +331,7 @@ 1997-11-29 SL Baur - * update-elc.el ((preloaded-file-list site-load-packages)): Modify + * update-elc.el ((preloaded-file-list site-load-packages)): Modify error message to be more build-report.el friendly. * dumped-lisp.el (preloaded-file-list): Remove tooltalk/ prefix @@ -367,7 +367,7 @@ * x-menubar.el (default-menubar): Disable WWW items in help menu if no browse-url. - * help.el (xemacs-www-page): Print error message intead of bombing + * help.el (xemacs-www-page): Print error message intead of bombing if not browse-url. (xemacs-www-faq): Ditto. @@ -389,14 +389,14 @@ * x-toolbar.el (pending-delete): Don't (require 'pending-del). * x-menubar.el (pending-delete): Don't (require 'pending-del). - * x-menubar.el (bookmark-menu-filter): Add guards against bookmark + * x-menubar.el (bookmark-menu-filter): Add guards against bookmark package not being loaded. * mule/char-table.el: Imported from tm. * mule/chartblxmas.el: Ditto. * alist.el: Ditto. * overlay.el: Unpackaged for Quail. - + * x-menubar.el (default-menubar): Put guard on evaluation of `ps-paper-type'. (default-menubar): Put guard on `paren-mode'. @@ -427,7 +427,7 @@ * packages.el (packages-useful-lisp): advice.el is a package. - * x-menubar.el (default-menubar): Make `Options ... Color Printing' + * x-menubar.el (default-menubar): Make `Options ... Color Printing' a toggle. 1997-11-26 Kyle Jones @@ -448,7 +448,7 @@ 1997-11-25 Hrvoje Niksic - * custom.el (custom-declare-variable): Attach the symbol to + * custom.el (custom-declare-variable): Attach the symbol to load history. 1997-11-23 SL Baur @@ -505,7 +505,7 @@ 1997-11-17 Marc Paquette * efs/dired.el: Removed special case for windows-nt in - dired-get-filename(); no longer needed because we now do + dired-get-filename(); no longer needed because we now do CRLF->LF conversion upstream. 1997-11-18 Jonathan Harris @@ -657,9 +657,9 @@ 1997-11-12 Greg Klanderman - * packages/compile.el (compilation-build-compilation-error-regexp-alist): + * packages/compile.el (compilation-build-compilation-error-regexp-alist): Added documentation for this function. - + ** (compilation-error-regexp-systems-list): Update documentation to note that `compilation-build-compilation-error-regexp-alist' must be called after changing the value. Update customization to @@ -751,7 +751,7 @@ * utils/shadow.el (list-load-path-shadows): Supress message when no shadowings are found. - * loadup.el: Modify algorithm for finding initial lisp directories + * loadup.el: Modify algorithm for finding initial lisp directories since the search now starts from lisp/ not lisp/prim/. * update-elc.el: Ditto. * make-docfile.el: Ditto. @@ -856,7 +856,7 @@ Wed Nov 05 23:40:00 1997 Jonathan Harris Reinstated code that uses (mono x) as a specifer tag, but conditioned it on (featurep 'x) because x is not a valid specifier tag under native-win32. - + * Added file headers to: w32-faces.el, w32-init.el @@ -937,7 +937,7 @@ Sun Nov 01 12:00:00 1997 Jonathan Harris 1997-11-07 Kyle Jones * prim/modeline.el (mouse-drag-modeline): Don't - allow the window size to shrink to a size that is not a + allow the window size to shrink to a size that is not a multiple of the height of the default face's font. * prim/modeline.el (mouse-drag-modeline): Don't @@ -961,12 +961,12 @@ Sun Nov 01 12:00:00 1997 Jonathan Harris 1997-11-05 Jens-Ulrik Holger Petersen * mule/mule-cmds.el (set-default-coding-systems): Make - add-hook to `comint-exec-hook' be an append, for when the user + add-hook to `comint-exec-hook' be an append, for when the user changes language environment say. 1997-11-05 SL Baur - * prim/winnt.el: Use a cleaner method for getting Text/Binary file + * prim/winnt.el: Use a cleaner method for getting Text/Binary file type in the mode-line for MS Windows. 1997-11-06 Hrvoje Niksic @@ -1005,7 +1005,7 @@ Sun Nov 01 12:00:00 1997 Jonathan Harris fontifying after fontify-buffer. (lazy-shot-unstall): Make sure buffer is left in a fontified state if needed. Take optional argument. - + * packages/ps-print.el (ps-print-ensure-fontified): Added temporary support for lazy-shot. @@ -1014,10 +1014,10 @@ Sun Nov 01 12:00:00 1997 Jonathan Harris * utils/text-props.el (set-text-properties): Updated docstring. -1997-11-04 Didier Verna +1997-11-04 Didier Verna - * mule/mule-cmds.el (set-default-coding-systems): - The coding-system argument to comint-exec-hook wasn't evaluated + * mule/mule-cmds.el (set-default-coding-systems): + The coding-system argument to comint-exec-hook wasn't evaluated before building the lambda expression. 1997-11-04 Jens-Ulrik Holger Petersen @@ -1088,7 +1088,7 @@ Sun Nov 01 12:00:00 1997 Jonathan Harris * shell.el (shell-chdrive-regexp): New for DOS/NT (shell-mode): Added shell-font-lock-keywrods (shell-mode): Use $PWD for ksh - (shell-directory-tracker): Use dirs and dirtrack-toggle. This may + (shell-directory-tracker): Use dirs and dirtrack-toggle. This may cause problems at is interferes with "dired" (shell-snarf-envar): NEW (shell-copy-environment-variable): NEW @@ -1165,7 +1165,7 @@ Sun Nov 01 12:00:00 1997 Jonathan Harris characters, instead of consing a string each time. (synthesize-keysym): Better error checking. - * prim/keymap.el (synthesize-keysym): Don't bug out when reading a + * prim/keymap.el (synthesize-keysym): Don't bug out when reading a non-character event. 1997-11-02 Tomasz Cholewo @@ -1191,7 +1191,7 @@ Sun Nov 01 12:00:00 1997 Jonathan Harris * prim/packages.el: Updated commentary. (packages-useful-lisp): Added `cl-macs'. -1997-10-27 Didier Verna +1997-10-27 Didier Verna * prim/help-nomule.el (help-with-tutorial): The 'didactic' blank lines message is now taken directly from each tutorial, and thus @@ -1213,7 +1213,7 @@ Sun Nov 01 12:00:00 1997 Jonathan Harris Suggested by Michael Kifer * mule/mule-init.el: Remove `help-with-tutorial-for-mule'. - Suggested by Didier Verna + Suggested by Didier Verna * Disable Cyrillic CCL until CCL engine gets fixed. From: Martin Buchholz @@ -1230,7 +1230,7 @@ Sun Nov 01 12:00:00 1997 Jonathan Harris 1997-10-30 SL Baur - * vm/vm-vars.el (vm-image-directory): Use locate-data-directory if + * vm/vm-vars.el (vm-image-directory): Use locate-data-directory if it exists. * language/european.el: Remove erroneous references to @@ -1438,7 +1438,7 @@ Sun Nov 01 12:00:00 1997 Jonathan Harris * modes/enriched.el (enriched-face-ans): Use color-name instead of color-instance-name. - color-instance-name will not handle the specifiers that + color-instance-name will not handle the specifiers that are passed as arguments. 1997-10-28 Tomasz Cholewo @@ -1451,14 +1451,14 @@ Sun Nov 01 12:00:00 1997 Jonathan Harris * pcl-cvs/pcl-cvs-xemacs.el: Add `cvs-mode-update-no-prompt' to menu. From Stig Bjorlykke -1997-10-28 Didier Verna +1997-10-28 Didier Verna * packages/man.el (manual-entry): corrected the `when' form to include 'section' in the buffer name. 1997-10-28 SL Baur - * prim/packages (packages-find-pacakges): Fix test on + * prim/packages (packages-find-pacakges): Fix test on inhibit-package-init 1997-10-27 Tomasz Cholewo @@ -1488,7 +1488,7 @@ Sun Nov 01 12:00:00 1997 Jonathan Harris * egg/egg-leim.el: Registers EGG/Wnn with LEIM when loaded * egg/egg.el: Bind `toggle-egg-mode' to "\C-\" only if LEIM is - not present when loaded + not present when loaded 1997-10-27 SL Baur @@ -1610,7 +1610,7 @@ Fri Aug 8 12:58:00 1997 David Byers 1997-10-23 Per Abrahamsen * custom/cus-edit.el (hook): Use `widget-group-match' instead of - `widget-editable-list-match'. + `widget-editable-list-match'. 1997-10-23 SL Baur @@ -1626,7 +1626,7 @@ Fri Aug 8 12:58:00 1997 David Byers 1997-10-20 Jan Vroonhof * extents.c: Renamed shot property to initial-redisplay-function - (extent_fragment_update): Changed the bookkeeping whether an event + (extent_fragment_update): Changed the bookkeeping whether an event has been spawned. The initial-redisplay-function property is no longer set to nil. @@ -1641,7 +1641,7 @@ Fri Aug 8 12:58:00 1997 David Byers 1997-10-22 Hrvoje Niksic - * prim/startup.el (command-line-1): Run term-setup-hook regardless + * prim/startup.el (command-line-1): Run term-setup-hook regardless of `input-pending-p'. * custom/cus-edit.el (custom-split-regexp-maybe): Use `split-string'. @@ -1681,7 +1681,7 @@ Fri Aug 8 12:58:00 1997 David Byers 1997-10-21 SL Baur - * prim/about.el (about-maintainer-glyph): Pictures have been moved + * prim/about.el (about-maintainer-glyph): Pictures have been moved to photos subdirectory. 1997-10-21 Hrvoje Niksic @@ -1696,7 +1696,7 @@ Fri Aug 8 12:58:00 1997 David Byers 1997-10-21 Colin Rafferty * x11/x-menubar.el (default-menubar): Made it use lazy-shot - instead of lazy-lock in "Syntax Highlighting->Lazy". + instead of lazy-lock in "Syntax Highlighting->Lazy". (options-menu-saved-forms): Made it save lazy-shot instead of lazy-lock in the options. @@ -1778,12 +1778,12 @@ Fri Aug 8 12:58:00 1997 David Byers * help.el (function-at-point): Use `function-at-point-function'. (function-at-point-function): New variable, formerly - `find-function-function'. + `find-function-function'. (describe-function): Use `function-at-point'. (where-is): Ditto. * find-func.el (find-function-read-function): Use - `function-at-point'. + `function-at-point'. * packages/info.el (Info-elisp-ref): Use `function-at-point'. @@ -1806,7 +1806,7 @@ Fri Aug 8 12:58:00 1997 David Byers * prim/packages.el (packages-find-packages-1): New argument: `user-package' non-nil when searching user packages. - Load any autoloads found in user packages. - + 1997-10-17 Karl M. Hegbloom * packages/info.el (Info-insert-dir): Also kill the localdir temp @@ -1817,7 +1817,7 @@ Fri Aug 8 12:58:00 1997 David Byers * utils/facemenu.el: autoload the `facemenu-keymap' properly. * mule/mule-cmds.el (read-language-name): Fix typo. - From Didier Verna + From Didier Verna 1997-10-15 Adrian Aichner @@ -1886,7 +1886,7 @@ Fri Aug 8 12:58:00 1997 David Byers From Hrvoje Niksic * prim/glyphs.el (init-glyphs): Use different logo for beta XEmacsen. - From Didier Verna + From Didier Verna 1997-10-15 Hrvoje Niksic @@ -1915,7 +1915,7 @@ Fri Aug 8 12:58:00 1997 David Byers * custom/wid-edit.el: (widget-glyph-insert-glyph): Use `widget-mouse-help' if necessary. - (widget-documentation-string-value-create): Don't coerce help-echo + (widget-documentation-string-value-create): Don't coerce help-echo WIDGET to widget. (widget-button-keymap): New keymap. (widget-specify-button): Use it. @@ -1985,7 +1985,7 @@ Fri Aug 8 12:58:00 1997 David Byers 1997-10-14 SL Baur * default.el: New file. - * site-start.el: New file. XEmacs starts faster if dummy versions + * site-start.el: New file. XEmacs starts faster if dummy versions of these files are found early in the `load-path'. Suggested by Kyle Jones @@ -2049,7 +2049,7 @@ Fri Aug 8 12:58:00 1997 David Byers * custom/cus-face.el (custom-face-attributes): Support inverse-video for TTY-s. - * prim/cmdloop.el (keyboard-escape-quit): Abort recursive edit, as + * prim/cmdloop.el (keyboard-escape-quit): Abort recursive edit, as documented. 1997-10-12 Hrvoje Niksic @@ -2103,7 +2103,7 @@ Fri Aug 8 12:58:00 1997 David Byers * '' Added toplevel block (when (fboundp 'load-gc) ...to init the Info-def..list from the environment variable INFOPATH at dump time. - + * prim/packages.el (packages-find-packages-1): append the list of packages info directories to `Info-default-directory-list' rather than prepending them. Don't add them if they're already in the @@ -2112,7 +2112,7 @@ Fri Aug 8 12:58:00 1997 David Byers * packages/info.el (Info-directory-list): various fixes to the directory list handling. * (Info-localdir-heading-regexp) added. - + * '' removed the unrequired defcustom of `Info-default-directory- list' @@ -2153,7 +2153,7 @@ Fri Aug 8 12:58:00 1997 David Byers * packages/bookmark.el: * packages/iswitchb.el: * utils/speedbar.el: - * utils/xemacs-build-report.el: + * utils/xemacs-build-report.el: - change Xemacs --> XEmacs 1997-10-09 Colin Rafferty @@ -2167,7 +2167,7 @@ Fri Aug 8 12:58:00 1997 David Byers (describe-function-arglist): Commented out -- seems unused. (find-function): ALL find-function stuff moved to "find-func.el" - * prim/find-func.el: new file created from functions previously in + * prim/find-func.el: new file created from functions previously in "help.el". 1997-10-09 SL Baur @@ -2203,7 +2203,7 @@ Fri Oct 3 23:10:04 1997 Barry A. Warsaw Fri Sep 26 23:30:58 1997 Barry A. Warsaw - * cc-mode/cc-menus.el: Patches to Imenu support given by + * cc-mode/cc-menus.el: Patches to Imenu support given by "Masatake (jet) YAMATO" . (Jan Dubois) jan.dubois@ibm.net @@ -2226,9 +2226,9 @@ Mon Sep 22 15:47:02 1997 Barry A. Warsaw * x11/x-menubar.el (file-menu-filter): Reverse sense of bounds test. - From: Didier Verna + From: Didier Verna - * prim/format.el (format-annotate-function): Reverse sync to Emacs + * prim/format.el (format-annotate-function): Reverse sync to Emacs 19. 1997-10-08 Hrvoje Niksic @@ -2316,7 +2316,7 @@ Mon Sep 22 15:47:02 1997 Barry A. Warsaw * mule/mule-cmds.el (read-input-method-name): Use a default if available. - From Didier Verna + From Didier Verna * prim/about.el (about-url-alist): Update jwz's home page. @@ -2346,7 +2346,7 @@ Mon Sep 22 15:47:02 1997 Barry A. Warsaw 1997-10-05 Hrvoje Niksic - * prim/simple.el: Minor docstring and comment changes. Customized + * prim/simple.el: Minor docstring and comment changes. Customized some more. 1997-10-04 Hrvoje Niksic @@ -2386,7 +2386,7 @@ Mon Sep 22 15:47:02 1997 Barry A. Warsaw * cl/cl-seq.el (remq): Reformat and add doc-string. Suggested by: Karl M. Hegbloom - + 1997-10-03 Karl M. Hegbloom * packages/func-menu.el: change the countups from message's to @@ -2432,7 +2432,7 @@ Mon Sep 22 15:47:02 1997 Barry A. Warsaw (custom-declare-face): Don't invoke init-face-from-resources explicitly. - * prim/profile.el (pretty-print-profiling-info): When interactive, + * prim/profile.el (pretty-print-profiling-info): When interactive, use a separate buffer instead of current-buffer. (pretty-print-profiling-info): Prettified output. @@ -2984,7 +2984,7 @@ Mon Sep 29 02:11:35 1997 Kyle Jones (widget-text-keymap): Use it. (widget-princ-to-string): Use `with-current-buffer'. (widget-map-buttons): Ditto. - (widget-push-button-gui): Set to value of `widget-glyph-enable' by + (widget-push-button-gui): Set to value of `widget-glyph-enable' by default. (widget-push-button-value-create): Call `widget-specify-button'. @@ -3007,7 +3007,7 @@ Mon Sep 29 02:11:35 1997 Kyle Jones * x11/x-menubar.el: Customized. - * custom/cus-face.el (face-spec-set-match-display): Use `warn' for + * custom/cus-face.el (face-spec-set-match-display): Use `warn' for warnings. * x11/x-font-menu.el: Customized. @@ -3123,7 +3123,7 @@ Mon Sep 29 02:11:35 1997 Kyle Jones 1997-09-18 Jens-Ulrik Holger Petersen * prim/isearch-mode.el (isearch-message): Display-message as - progress (this way isearch message won't appear in the message + progress (this way isearch message won't appear in the message log). 1997-09-18 Jens-Ulrik Holger Petersen @@ -3149,7 +3149,7 @@ Mon Sep 29 02:11:35 1997 Kyle Jones * prim/packages.el (locate-library): Simplify regexp for compression suffixes. Suggested by: Hrvoje Niksic - + 1997-09-17 Karl M. Hegbloom * ilisp/ilisp-out.el (ilisp-scroll-output): bind `scroll-in-place' @@ -3220,7 +3220,7 @@ Fri Sep 5 04:47:03 1997 Barry A. Warsaw I don't know if this breaks something else, because I can't figure out why it was commented out in the first place. - + * cc-mode/cc-langs.el: Define `/' in c-mode-base-map since all modes now support c-electric-slash. @@ -3389,7 +3389,7 @@ Fri Sep 5 04:47:03 1997 Barry A. Warsaw 1997-09-11 Jens-Ulrik Holger Petersen - * packages/vc.el (vc-default-init-version): Make the default value + * packages/vc.el (vc-default-init-version): Make the default value be `nil'. Improve the docstring. 1997-09-12 SL Baur @@ -3508,7 +3508,7 @@ Fri Aug 15 18:39:10 1997 Barry A. Warsaw 1997-09-09 Jens-Ulrik Holger Petersen - * packages/vc.el (vc-register): make the second option arg COMMENT + * packages/vc.el (vc-register): make the second option arg COMMENT do something * packages/vc.el (vc-register): Make the default initial @@ -3522,7 +3522,7 @@ Fri Aug 15 18:39:10 1997 Barry A. Warsaw 1997-09-07 Hrvoje Niksic - * utils/edmacro.el (edmacro-parse-word): Accept ^foo (would signal + * utils/edmacro.el (edmacro-parse-word): Accept ^foo (would signal error). (edmacro-format-1): Add SPC after ^. @@ -3535,7 +3535,7 @@ Fri Aug 15 18:39:10 1997 Barry A. Warsaw always has directories ending with trailing `/'s. * version.el (emacs-version): Preserve previous matching info. - From Didier Verna + From Didier Verna Wed Sep 3 13:53:10 1997 SL Baur @@ -3571,7 +3571,7 @@ Wed Sep 3 13:53:10 1997 SL Baur 1997-09-01 SL Baur - * x11/x-menubar.el (default-menubar): Put tetris in the game menu, + * x11/x-menubar.el (default-menubar): Put tetris in the game menu, and move it and the mine game to the top of the menu. 1997-08-29 SL Baur @@ -3881,28 +3881,28 @@ Sat Jul 26 16:03:33 1997 Barry A. Warsaw * support for "dir" merging 'ala Emacs-19.34, with fallback to cheap localdir files in the secondary info directories. - + * changed default `Info-annotations-path' from ~/.infonotes to ~/.xemacs/info.notes - + * added `Info-additional-directory-list' - + * changed a call to w3-fetch to browse-url - + * added new variables and functions from GNU Emacs 19.34: `Info-dir-contents', `Info-dir-contents-directory', `Info-dir-file-attributes', and the function `Info-insert-dir' - + * rewrote `Info-suffixed-file' to a cond block rather than nested if's for aesthetic reasons. - + * made the top line get split if it's longer than 79 characters and tweaked fontification to handle that. - + * changed the look of the pop-up mouse menus by utilizing the "--:etchedThing" dividers. - + * several docstring reformats and typo fixes, a few comments deleted. @@ -4006,7 +4006,7 @@ Thu Jul 17 03:36:22 1997 Barry A. Warsaw 1997-07-24 SL Baur - * prim/make-docfile.el (docfile-out-of-date): Workaround for NEWOS + * prim/make-docfile.el (docfile-out-of-date): Workaround for NEWOS process exit handling bug. Suggested by Katsumi Yamaoka @@ -4036,7 +4036,7 @@ Thu Jul 17 03:36:22 1997 Barry A. Warsaw 1997-07-21 SL Baur - * prim/packages.el (locate-data-directory): New function to search + * prim/packages.el (locate-data-directory): New function to search for directories in the data-directory-list. 1997-07-21 Karl M. Hegbloom @@ -4079,7 +4079,7 @@ Thu Jul 17 03:36:22 1997 Barry A. Warsaw (speedbar-get-focus): Autoload. (speedbar): Autoload (correctly). - (speedbar-frame-width): Test liveness of frame + (speedbar-frame-width): Test liveness of frame too. (speedbar-frame-mode): Avoid some Emacs 20 code. From Markus Linnala @@ -4115,7 +4115,7 @@ Thu Jul 17 03:36:22 1997 Barry A. Warsaw 1997-07-16 Steven L Baur - * utils/crontab.el (crontab-get): Check for `no crontab for' as an + * utils/crontab.el (crontab-get): Check for `no crontab for' as an error return. Suggested by Jeff Miller @@ -4247,7 +4247,7 @@ Wed Jul 9 22:08:58 1997 Barry A. Warsaw * prim/files.el: Use `files' group. - * prim/disp-table.el (describe-display-table): Made it work; don't + * prim/disp-table.el (describe-display-table): Made it work; don't use `describe-vector'. * prim/gui.el: Customized. @@ -4273,7 +4273,7 @@ Wed Jul 9 22:08:58 1997 Barry A. Warsaw * packages/igrep.el: Don't insinuate XEmacs when loading. (igrep-insinuate): New function. - * packages/blink-cursor.el (blink-cursor-callback): Don't blink on + * packages/blink-cursor.el (blink-cursor-callback): Don't blink on TTY-s. * prim/console.el (resume-pid-console): Use `eql'. @@ -4342,7 +4342,7 @@ Wed Jul 9 22:08:58 1997 Barry A. Warsaw * packages/pending-del.el (pending-delete-pre-hook): Don't quote lambda. (pending-delete-pre-hook): Use `error-message-string'. - (pending-delete): Treat as minor mode; define the standard turn-on + (pending-delete): Treat as minor mode; define the standard turn-on and turn-off functions. (delete-active-region): Simplified. @@ -4353,10 +4353,10 @@ Wed Jul 9 22:08:58 1997 Barry A. Warsaw * packages/pending-del.el: Correct typo in Hrvoje's upgrade. * mel/mel-u.el (uuencode-external-decode-region): Force - buffer-read-only nil because it gets changed magically to t during + buffer-read-only nil because it gets changed magically to t during the call to `insert-file-contents'. - * tm/tm-image.el (mime-preview/filter-for-image): Comment out test + * tm/tm-image.el (mime-preview/filter-for-image): Comment out test for invalid glyph. It appears to be non-functional. * modes/lisp-mode.el (lisp-interaction-mode-popup-menu-1): Add @@ -4542,7 +4542,7 @@ Fri Jun 20 20:40:33 1997 Barry A. Warsaw * hypberbole/hact.el (action:commandp): Don't reference bytecode objects as vectors. (action:params): Ditto. - + * hyperbole/hypb.el (hypb:function-copy): Don't reference byte code objects as vectors. (hypb:function-symbol-replace): Document as broken. The @@ -4567,7 +4567,7 @@ Fri Jun 20 20:40:33 1997 Barry A. Warsaw * utils/easymenu.el (easy-menu-add): Oops, wrong sense in comparison. - * comint/gdb.el (gdb-mode-syntax-table): New variable. Initialize + * comint/gdb.el (gdb-mode-syntax-table): New variable. Initialize with the logic currently in CC Mode 5.11. (gdb-mode): Use it. @@ -4620,7 +4620,7 @@ Fri Jun 20 20:40:33 1997 Barry A. Warsaw * prim/cmdloop.el (errors-deactivate-region): Default to existing behavior. - * leim/quail.el (quail-mode): Correct addition of quail minor mode + * leim/quail.el (quail-mode): Correct addition of quail minor mode info to minor-mode-map-alist. (top-level): Ditto. @@ -4678,7 +4678,7 @@ Fri Jun 20 20:40:33 1997 Barry A. Warsaw make it look better (and will prevent some consing, but that's being anal). From Hrvoje Niksic - + * prim/simple.el (delete-key-deletes-forward): Mark docstring as an user option. From Gary D. Foster @@ -4688,10 +4688,10 @@ Fri Jun 20 20:40:33 1997 Barry A. Warsaw * efs/efs-ovwrt.el (efs-overwrite-fn): efs is manufacturing its own byte code. Whee. - * utils/advice.el (ad-interactive-form): Don't treat bytecode as a + * utils/advice.el (ad-interactive-form): Don't treat bytecode as a vector if it can be avoided. From Kyle Jones - + 1997-06-30 Steven L Baur * prim/files.el (auto-mode-alist): Don't set image-mode by default @@ -4699,7 +4699,7 @@ Fri Jun 20 20:40:33 1997 Barry A. Warsaw Sun Jun 29 20:57:15 1997 Kyle Jones - * prim/simple.el: bind inhibit-read-only to t before + * prim/simple.el: bind inhibit-read-only to t before trying to erase or otherwise modify the echo area buffer. 1997-07-01 MORIOKA Tomohiko @@ -4728,7 +4728,7 @@ Sun Jun 29 03:02:10 1997 Kyle Jones * src/undo.c (record_extent): If the extent's object is a string, just return. We can't record undo information for strings, and it is - very bad to reference through a string pointer as if it + very bad to reference through a string pointer as if it were a buffer pointer. 1997-06-28 Steven L Baur @@ -4775,7 +4775,7 @@ Sun Jun 29 03:02:10 1997 Kyle Jones * utils/autoload.el (batch-update-directory): Kill command line args when done. (autoload-save-customization): Print a warning message with the - offending symbol when we run across the elusive malformed property + offending symbol when we run across the elusive malformed property list ((0 0)). 1997-06-26 Hrvoje Niksic @@ -4784,7 +4784,7 @@ Sun Jun 29 03:02:10 1997 Kyle Jones (pretty-print-profiling-info): Allow interactive calls. * prim/overlay.el: Make more FSF compatible. - + 1997-06-27 Steven L Baur * prim/loaddefs.el (debug-ignored-errors): Fix regexps. @@ -4893,7 +4893,7 @@ Sun Jun 29 03:02:10 1997 Kyle Jones Mule menu because they bombed after recompilation. * packages/hyper-apropos.el - (hyper-apropos-toggle-programming-flag): Use `with-current-buffer' + (hyper-apropos-toggle-programming-flag): Use `with-current-buffer' instead of `eval-in-buffer'. * term/sun-mouse.el: Remove bogus redefinition of @@ -4904,7 +4904,7 @@ Sun Jun 29 03:02:10 1997 Kyle Jones * prim/make-docfile.el: Use princ not print. Suggested by Hrvoje Niksic. - * packages/info.el (Info-select-node): Desensitive case search for + * packages/info.el (Info-select-node): Desensitive case search for Note:. (Info-next-reference): Ditto. * prim/simple.el (kill-region): Adjust endpoints of extent to @@ -4915,7 +4915,7 @@ Sun Jun 29 03:02:10 1997 Kyle Jones * prim/subr.el (eval-in-buffer): Make obsolete. Suggested by Hrvoje Niksic. - * packages/hyper-apropos.el (hyper-apropos-faces): Change group to + * packages/hyper-apropos.el (hyper-apropos-faces): Change group to 'faces. Suggested by Per Abrahamsen. @@ -4926,7 +4926,7 @@ Sun Jun 29 03:02:10 1997 Kyle Jones - Get keybinding before command is executed. Suggested by Kyle Jones and Steve Baur. - + 1997-06-24 Steven L Baur * packages/gnuserv.el: Make old symbols Obsolete. @@ -4936,7 +4936,7 @@ Sun Jun 29 03:02:10 1997 Kyle Jones minibuffer. * prim/minibuf.el (minibuffer-keyboard-quit): Ditto. From Hrvoje Niksic - + * prim/help.el (help-mode-quit): Bury buffer when quitting. From Hrvoje Niksic @@ -4964,7 +4964,7 @@ Mon Jun 23 12:33:52 1997 Per Abrahamsen 1997-06-23 Hrvoje Niksic - * packages/info.el (Info-next-reference): Fix up for M-TAB to work + * packages/info.el (Info-next-reference): Fix up for M-TAB to work correctly. * utils/live-icon.el (live-icon-one-frame): Don't set glyphs to @@ -4990,7 +4990,7 @@ Mon Jun 23 12:33:52 1997 Per Abrahamsen 1997-06-22 Steven L Baur - * x11/x-menubar.el (default-menubar): Make `Jump to bookmark' menu + * x11/x-menubar.el (default-menubar): Make `Jump to bookmark' menu dynamic. From Gary D. Foster @@ -5061,7 +5061,7 @@ Mon Jun 23 12:33:52 1997 Per Abrahamsen * prim/tabify.el (untabify): Return nil. From contributor name lost. - * prim/packages.el (packages-hardcoded-lisp): startup.elc needs to + * prim/packages.el (packages-hardcoded-lisp): startup.elc needs to be scanned for docstrings. 1997-06-21 Hrvoje Niksic @@ -5088,7 +5088,7 @@ Mon Jun 23 12:33:52 1997 Per Abrahamsen 1997-06-20 Steven L Baur - * utils/autoload.el (fixup-autoload-buffer): New function. Insert + * utils/autoload.el (fixup-autoload-buffer): New function. Insert guards so a (load "auto-autoloads") works the same as require. (batch-update-directory): Use it. @@ -5142,11 +5142,11 @@ Mon Jun 23 12:33:52 1997 Per Abrahamsen From Karl M. Hegbloom (archive-mode-map): Bind it to `q'. - * utils/autoload.el (cusload-file-name): Default to custom-load.el + * utils/autoload.el (cusload-file-name): Default to custom-load.el for each individual file. * prim/minibuf.el (minibuffer-max-depth-exceeded): Use - `custom-file' as a location for saving enable multiple minibuffers + `custom-file' as a location for saving enable multiple minibuffers option. * packages/man.el (manual-entry): Don't leave empty buffer if @@ -5168,14 +5168,14 @@ Mon Jun 23 12:33:52 1997 Per Abrahamsen 1997-06-17 Steven L Baur - * prim/files.el (auto-mode-alist): Add /app-defaults/ as candidate + * prim/files.el (auto-mode-alist): Add /app-defaults/ as candidate for xrdb-mode. Suggested by Karl Hegbloom, Regexp by David Moore. - * version.el: Remove variables emacs-version, emacs-major-version, + * version.el: Remove variables emacs-version, emacs-major-version, and emacs-minor-version. - * tooltalk/tooltalk-load.el: Comment as obsolete and move contents + * tooltalk/tooltalk-load.el: Comment as obsolete and move contents to dumped-lisp.el. * prim/make-docfile.el: New file. @@ -5199,7 +5199,7 @@ Mon Jun 23 12:33:52 1997 Per Abrahamsen * prim/dumped-lisp.el: New file. - * prim/update-elc.el (toplevel): Rework using a better function to + * prim/update-elc.el (toplevel): Rework using a better function to determine autoload file locations. * prim/packages.el: New file. @@ -5240,16 +5240,16 @@ Mon Jun 23 12:33:52 1997 Per Abrahamsen as an option. Eliminate XEmacs specific autoloads. From Hrvoje Niksic - + * efs/dired.el (dired-save-excursion): Ebola cleanup. * packages/hyper-apropos.el: Massive cleanup, Customize. - From Hrvoje Niksic + From Hrvoje Niksic Fri Jun 13 13:20:39 1997 Kyle Jones * prim/syntax.el (symbol-near-point): - Check for bobp and avoid (char-syntax (char-before)) if + Check for bobp and avoid (char-syntax (char-before)) if there. 1997-06-13 Steven L Baur @@ -5267,7 +5267,7 @@ Fri Jun 13 13:20:39 1997 Kyle Jones * modes/make-mode.el (makefile-browse): Shouldn't be interactive. From Hrvoje Niksic - * prim/files.el (interpreter-mode-alist): ksh-mode is obsoleted by + * prim/files.el (interpreter-mode-alist): ksh-mode is obsoleted by sh-script. From Hrvoje Niksic @@ -5276,7 +5276,7 @@ Fri Jun 13 13:20:39 1997 Kyle Jones * prim/subr.el (with-current-buffer): New macro. (with-temp-file): Ditto. - * bytecomp/byte-optimize.el (byte-optimize-form-code-walker): Test + * bytecomp/byte-optimize.el (byte-optimize-form-code-walker): Test for `save-current-buffer'. * bytecomp/bytecomp.el: Recognize `save-current-buffer'. @@ -5358,7 +5358,7 @@ Fri Jun 13 13:20:39 1997 Kyle Jones From Heiko Muenkel 1997-06-10 Gary D. Foster - + * modes/view-less.el: Changed \177 bindings to 'delete * modes/help.el: Changed \177 bindings to 'delete @@ -5378,7 +5378,7 @@ Fri Jun 13 13:20:39 1997 Kyle Jones * modes/cc-mode.el: * modes/cperl-mode.el: Fixed references to delete functions to use the new names. - + 1997-06-11 Karl M Hegbloom * ilisp/ilisp-def.el (toplevel): Changed `ilisp-prefix' from @@ -5462,7 +5462,7 @@ Fri Jun 13 13:20:39 1997 Kyle Jones Change usage of \177 to use keysym 'delete. From Gary D. Foster - * packages/etags.el (tags-loop-scan): Don't pass a straight string + * packages/etags.el (tags-loop-scan): Don't pass a straight string to error as a format string. Reported by Miles Duke @@ -5487,9 +5487,9 @@ Fri Jun 13 13:20:39 1997 Kyle Jones 1997-06-04 Gary D. Foster - * modes/cc-mode.el: Modified `c-electric-delete' to honor the + * modes/cc-mode.el: Modified `c-electric-delete' to honor the desired delete direction in both normal and "hungry" modes. - * modes/cperl-mode.el: Modified `cperl-electric-backspace' to + * modes/cperl-mode.el: Modified `cperl-electric-backspace' to honor the desired delete direction. 1997-06-03 MORIOKA Tomohiko @@ -5512,9 +5512,9 @@ Fri Jun 13 13:20:39 1997 Kyle Jones * modes/*.el: Removed conflicting \177 bindings. * modes/cc-mode.el: Modified `c-electric-delete' to use new delete bindings. - * modes/cperl-mode.el: Modified `cperl-electric-backspace' to + * modes/cperl-mode.el: Modified `cperl-electric-backspace' to use new delete bindings. - + 1997-06-03 MORIOKA Tomohiko * leim/quail.el: to sync with quail.el of Emacs-19.34.94-epsilon. @@ -5540,7 +5540,7 @@ Fri Jun 13 13:20:39 1997 Kyle Jones * prim/about.el: Installed new version 2.1. From Hrvoje Niksic - + * prim/profile.el (pretty-print-profiling-info): Autoload don't dump. Clean up comments. @@ -5586,7 +5586,7 @@ Fri Jun 13 13:20:39 1997 Kyle Jones as toolbar callbacks. From weiner@altrasoft.com - * prim/mouse.el (default-mouse-track-cleanup-extent): Correct test + * prim/mouse.el (default-mouse-track-cleanup-extent): Correct test on dead-func extent. * prim/help.el (view-emacs-news): outl-mouse turned off in @@ -5750,7 +5750,7 @@ Tue May 27 13:42:57 1997 Ken Manheimer `icomplete-max-delay-chars' - Maximum number of initial chars to apply icomplete compute delay. - + `icomplete-compute-delay' - Completions-computation stall, used only with large-number completions @@ -5802,7 +5802,7 @@ Fri May 30 18:39:01 1997 Hrvoje Niksic (insert-parentheses): Let a negative argument enclose preceding sexps. From Erik Naggum - + * prim/window-xemacs.el: New file, split from window.el with XEmacs-specific stuff. @@ -5814,12 +5814,12 @@ Fri May 30 18:39:01 1997 Hrvoje Niksic * prim/window.el (kill-buffer-and-window): New command. Bind it to C-x 4 0. From Richard Stallman - + * prim/window.el (split-window-vertically): Don't change point in old window if both the original point and the end of the buffer are visible after splitting, when split-window-keep-point is nil. From Noah Friedman - + * prim/files.el (revert-buffer-internal-hook): Declare. * utils/map-ynp.el: Synch with Emacs 19.34.94. @@ -5877,7 +5877,7 @@ Thu May 29 19:03:52 1997 Per Abrahamsen standard-value for Custom-1.98. 1997-05-26 Steven L Baur - + * prim/help.el (view-lossage-key-count): New variable. (view-lossage-message-count): New variable. (view-lossage): Use them. @@ -5999,7 +5999,7 @@ Mon Sep 25 17:19:51 1995 Per Bothner Tue May 20 20:32:59 1997 Steven L Baur - * prim/subr.el (buffer-substring-no-properties): Clean out extents + * prim/subr.el (buffer-substring-no-properties): Clean out extents too. Mon May 19 19:48:35 1997 Steven L Baur @@ -6018,10 +6018,10 @@ Sun May 18 09:11:50 1997 Steven L Baur * prim/files.el (revert-buffer): Add optional third parameter to preserve buffer modes (from Emacs 19.34.94). - (after-find-file): Add optional fifth parameter to preserve buffer + (after-find-file): Add optional fifth parameter to preserve buffer modes (from Emacs 19.34.94). - * packages/vc.el: Synch with Emacs 19.34.94 because our version was + * packages/vc.el: Synch with Emacs 19.34.94 because our version was hopeless. (vc-checkout): Autoload. (vc-find-binary): Ditto. @@ -6031,7 +6031,7 @@ Sun May 18 09:11:50 1997 Steven L Baur Fri Apr 25 13:21:46 1997 Per Abrahamsen - * apropos.el (apropos): Add support for customization groups. + * apropos.el (apropos): Add support for customization groups. (apropos-print): Ditto. Sat May 17 19:56:31 1997 Glynn Clements @@ -6066,7 +6066,7 @@ Mon May 12 13:47:37 1997 Oscar Figueiredo * tm/tm-vm.el: Provide for vm-unsaved-message having been removed in recent versions of VM. - + Fri May 9 10:41:44 1997 Steven L Baur * iso/iso-acc.el (iso-accents-compose): Fix XEmacs 19.14 @@ -6085,10 +6085,10 @@ Thu May 8 14:35:34 1997 Steven L Baur * hm--html-menus/hm--html.el: Define obsolete aliases for the previous function spellings. - * hm--html-menus/hm--html-keys.el: Define obsolete aliases for the + * hm--html-menus/hm--html-keys.el: Define obsolete aliases for the previous variable spellings. - * prim/obsolete.el (define-obsolete-variable-alias): Fix docstring + * prim/obsolete.el (define-obsolete-variable-alias): Fix docstring spelling. (define-compatible-variable-alias): Ditto. @@ -6128,7 +6128,7 @@ Wed Apr 30 18:06:35 1997 Steven L Baur Tue Apr 29 18:51:31 1997 Steven L Baur - * mule/mule-files.el (buffer-file-coding-system-alist): Regexp for + * mule/mule-files.el (buffer-file-coding-system-alist): Regexp for handling info files didn't match the right pattern. Sun Apr 27 18:09:48 1997 Steven L Baur @@ -6142,7 +6142,7 @@ Sat Apr 26 16:25:49 1997 Steven L Baur Fri Apr 25 08:39:50 1997 Steven L Baur - * modes/sh-script.el (sh-indent-line): Deal with pathological case + * modes/sh-script.el (sh-indent-line): Deal with pathological case of indenting a first line containing a `#' as first non-white space character. @@ -6333,12 +6333,12 @@ Sat Apr 12 05:27:56 1997 Steven L Baur * packages/vc.el (vc-directory): Dired requires a list not a string of space separated names. - * utils/live-icon.el (live-icon-colour-name-from-face): `face' may + * utils/live-icon.el (live-icon-colour-name-from-face): `face' may be a list of faces since it is generated by `extent-face'. Fri Apr 11 21:12:57 1997 Steven L Baur - * packages/ispell.el: Don't attempt creation of the menubar unless + * packages/ispell.el: Don't attempt creation of the menubar unless XEmacs has been compiled with menubars. * prim/simple.el (yank-pop): mark-marker needs optional force @@ -6384,7 +6384,7 @@ Wed Apr 9 10:45:54 1997 Steven L Baur Tue Apr 8 12:57:05 1997 Steven L Baur * modes/lisp-mode.el (eval-defun): Evaluate defcustom in defconst - style instead of defvar style (patch derived from Emacs 19.35/Lars + style instead of defvar style (patch derived from Emacs 19.35/Lars Magne Ingebrigtsen). Mon Apr 7 16:38:43 1997 Steven L Baur @@ -6402,7 +6402,7 @@ Sun Apr 6 06:56:03 1997 Steven L Baur * x11/x-menubar.el (default-menubar): Use xmine not mine. - * prim/help.el (describe-variable): Some doc strings weren't being + * prim/help.el (describe-variable): Some doc strings weren't being terminated with a newline. Sat Apr 5 20:20:00 1997 Steven L Baur @@ -6411,7 +6411,7 @@ Sat Apr 5 20:20:00 1997 Steven L Baur Sat Apr 5 13:18:05 1997 Tomasz J. Cholewo - * packages/etags.el (tags-query-replace): Fixed DELIMITED argument + * packages/etags.el (tags-query-replace): Fixed DELIMITED argument bug. `with-caps-disable-folding' moved to isearch-mode.el. * packages/info.el (Info-search): Use `with-caps-disable-folding'. @@ -6506,8 +6506,8 @@ Sat Mar 22 14:25:47 1997 Tomasz J. Cholewo (fancy-diary-display): Use modeline-buffer-identification. * calendar/appt.el (appt-diary-entries): Do not display diary. - (appt-check): Display diary buffer at midnight. - + (appt-check): Display diary buffer at midnight. + Fri Mar 21 19:16:46 1997 Steven L Baur * mule/mule-coding.el (enable-multibyte-characters): MULE @@ -6636,7 +6636,7 @@ Sun Mar 9 12:38:53 1997 Noah Friedman * utils/eldoc.el (eldoc-pre-command-refresh-echo-area): Use eldoc-display-message-p, not eldoc-display-message-no-interference-p. - + Sat Mar 8 11:20:47 1997 Steven L Baur * prim/startup.el (startup-splash-frame-body): More text tweaking. @@ -6687,7 +6687,7 @@ Fri Mar 7 10:44:48 1997 Steven L Baur * x11/x-menubar.el (default-menubar): Reorganize again undoing previous change. Customize submenu moved to top of options menu. Edit faces restored to edit-faces and renamed to Browse faces. - + Thu Mar 6 08:43:27 1997 Steven L Baur * x11/x-menubar.el (options-menu): New variable. @@ -6743,7 +6743,7 @@ Sun Mar 2 10:10:31 1997 Steven L Baur * site-load.el: Move site-packages to the top level. Sun Mar 2 01:37:04 1997 Hrvoje Niksic - + * utils/mail-extr.el (all-top-level-domains): Added "hr" domain. * packages/ps-print.el (ps-print-color-p): Default to nil. @@ -7030,13 +7030,13 @@ Sat Feb 15 12:07:46 1997 Steven L Baur Sat Feb 15 11:05:29 1997 Kyle Jones * utils/redo.el: made before and after status messages so that the user is aware if a long action is still being processed. - + rolled version number up to 1.00, since the package seems to be stable. cosmetic changes so the file could be included in the XEmacs distribution. - + Sat Feb 15 11:13:05 1997 Hrvoje Niksic * prim/simple.el (line-move-ignore-invisible): Change default to @@ -7172,7 +7172,7 @@ Thu Feb 6 17:14:32 1997 Steven L Baur * packages/ps-print.el: Update maintainer address. Thu Feb 6 12:35:39 1997 Bill Dubuque - + * cl/cl-macs.el (cl-do-proclaim): Correct addition of bound variables to `byte-compile-bound-variables'. @@ -7222,7 +7222,7 @@ Fri Jan 31 09:50:51 1997 Hrvoje Niksic * x11/x-toolbar.el (toolbar-mail-commands-alist): Updated with a lot of new mailer possiblities. - + Fri Jan 31 09:28:49 1997 Martin Buchholz * x11/x-font-menu.el (reset-device-font-menus): Correct guard on @@ -7238,7 +7238,7 @@ Thu Jan 30 22:43:43 1997 David Moore * packages/compile.el: Speed up regexps. (compilation-parse-errors): replace re-search-forward with something faster. - + Thu Jan 30 20:33:56 1997 Hvoje Niksic * x11/x-toolbar.el @@ -7248,7 +7248,7 @@ Thu Jan 30 20:33:56 1997 Hvoje Niksic (toolbar-mail-commands-alist): New variable. (toolbar-mail-reader): Ditto. (toolbar-mail): Use them. - + * x11/x-menubar.el: Shorten help menu item names. Thu Jan 30 17:22:15 1997 Alexandre Oliva @@ -7306,15 +7306,15 @@ Thu Jan 9 13:32:01 1997 Jacques Duthen Prestataire (ps-print-version): Fix value. (cl lisp-float-type): Require them. (ps-number-of-columns ps-*-font-size): Try to select defaults - better suited when `ps-landscape-mode' is non-nil. + better suited when `ps-landscape-mode' is non-nil. (ps-*-faces): Change default for Font Lock mode faces when - `ps-print-color-p' is nil. + `ps-print-color-p' is nil. (ps-right-header): Replace `time-stamp-yy/mm/dd' - by `time-stamp-mon-dd-yyyy'. - (ps-end-file ps-begin-page): Fix bug in page count for Ghostview. + by `time-stamp-mon-dd-yyyy'. + (ps-end-file ps-begin-page): Fix bug in page count for Ghostview. (ps-generate-postscript-with-faces): Replace `ps-sorter' by - `car-less-than-car'. - (ps-plot ps-generate): Replace `%d' by `%3d'. + `car-less-than-car'. + (ps-plot ps-generate): Replace `%d' by `%3d'. Wed Jan 22 15:32:39 1997 Greg Klanderman @@ -7336,7 +7336,7 @@ Tue Jan 21 19:56:26 1997 Martin Buchholz * mule/mule-init.el (init-mule): Get Japanese man pages working. Fri Jan 17 17:22:54 1997 Hrvoje Niksic - + * man.el (Manual-mode): Don't mess with scrollbars if they aren't present. @@ -7806,7 +7806,7 @@ Thu Dec 12 14:46:47 1996 Christoph Wedler Let `buffers-menu-submenus-for-groups-p' be an integer : if there are more buffers than this value, use submenus, otherwise not. - + * packages/vc.el (vc-rename-this-file): New function (was missing, but referred to on the menubar). @@ -7871,7 +7871,7 @@ Tue Dec 10 10:11:55 1996 Steven L Baur * electric/ebuff-menu.el (electric-buffer-menu-mode-map): Correct bad 19.34 synch patch. - + * utils/pretty-print.el: New File. Sun Dec 8 13:59:40 1996 Steven L Baur @@ -8029,7 +8029,7 @@ Wed Dec 4 22:00:49 1996 Steven L Baur evaluated more than once. Comment formatting changes. - + * edebug/advise-eval-region.el: New File. Separate out advise for eval-region so it is only evaluated once. @@ -8037,7 +8037,7 @@ Wed Dec 4 22:00:49 1996 Steven L Baur icomplete-exhibit needs to be called in the setup-hook. - * packages/apropos.el: Correct a typo in button binding. + * packages/apropos.el: Correct a typo in button binding. Fixes the bug where if apropos-label-face is actually defined as face, apropos bombs with an error @@ -8050,7 +8050,5 @@ Wed Dec 4 22:00:49 1996 Steven L Baur Redefines the default faces for the various apropos faces so they come out in color by default (defaults are based on various standard font-lock faces). - - * version.el: Bumped up to b31. - + * version.el: Bumped up to b31. diff --git a/lisp/abbrev.el b/lisp/abbrev.el index dec62a1..110de33 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -419,6 +419,17 @@ The argument FILE is the file name to write." (write-region 1 (point-max) file) (erase-buffer))) +(defun abbrev-string-to-be-defined (arg) + "Return the string for which an abbrev will be defined. +ARG is the argument to `add-global-abbrev' or `add-mode-abbrev'." + (if (and (not arg) (region-active-p)) (setq arg 0) + (setq arg (prefix-numeric-value arg))) + (and (>= arg 0) + (buffer-substring + (point) + (if (= arg 0) (mark) + (save-excursion (forward-word (- arg)) (point)))))) + (defun add-mode-abbrev (arg) "Define mode-specific abbrev for last word(s) before point. Argument is how many words before point form the expansion; @@ -450,13 +461,7 @@ Don't use this function in a Lisp program; use `define-abbrev' instead." (defun add-abbrev (table type arg) ;; XEmacs change: - (if (and (not arg) (region-active-p)) (setq arg 0) - (setq arg (prefix-numeric-value arg))) - (let ((exp (and (>= arg 0) - (buffer-substring - (point) - (if (= arg 0) (mark) - (save-excursion (forward-word (- arg)) (point)))))) + (let ((exp (abbrev-string-to-be-defined arg)) name) (setq name (read-string (format (if exp "%s abbrev for \"%s\": " @@ -469,6 +474,14 @@ Don't use this function in a Lisp program; use `define-abbrev' instead." name (abbrev-expansion name table)))) (define-abbrev table (downcase name) exp)))) +(defun inverse-abbrev-string-to-be-defined (arg) + "Return the string for which an inverse abbrev will be defined. +ARG is the argument to `inverse-add-global-abbrev' or +`inverse-add-mode-abbrev'." + (save-excursion + (forward-word (- arg)) + (buffer-substring (point) (progn (forward-word 1) (point))))) + (defun inverse-add-mode-abbrev (arg) "Define last word before point as a mode-specific abbrev. With prefix argument N, defines the Nth word before point. diff --git a/lisp/alist.el b/lisp/alist.el index fbd409a..05d1267 100644 --- a/lisp/alist.el +++ b/lisp/alist.el @@ -22,7 +22,18 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;;; Code: + +;;;###autoload +(defun vassoc (key valist) + "Search VALIST for a vector whose first element is equal to KEY. +See also `assoc'." + ;; by Stig@hackvan.com + (let (el) + (catch 'done + (while (setq el (pop valist)) + (and (equal key (aref el 0)) + (throw 'done el)))))) + ;;;###autoload (defun put-alist (item value alist) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index b93feb4..3a6df7b 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -634,6 +634,11 @@ The R column contains a % for buffers that are read-only." files-only)) buffer)) +(defun buffers-menu-omit-invisible-buffers (buf) + "For use as a value of `buffers-menu-omit-function'. +Omits normally invisible buffers (those whose name begins with a space)." + (not (null (string-match "\\` " (buffer-name buf))))) + (provide 'buff-menu) ;;; buff-menu.el ends here diff --git a/lisp/buffer.el b/lisp/buffer.el index 002ce0d..983a55e 100644 --- a/lisp/buffer.el +++ b/lisp/buffer.el @@ -60,10 +60,7 @@ the window-buffer correspondences." (set-buffer-major-mode buf)))) (push-window-configuration) (set-buffer buf) - (set-window-buffer (if (eq (selected-window) (minibuffer-window)) - (next-window (minibuffer-window)) - (selected-window)) - buf norecord) + (set-window-buffer (last-nonminibuf-window) buf norecord) buf)) (defun pop-to-buffer (bufname &optional not-this-window-p on-frame) diff --git a/lisp/build-report.el b/lisp/build-report.el index 66ef27f..3f89157 100644 --- a/lisp/build-report.el +++ b/lisp/build-report.el @@ -138,7 +138,7 @@ available." ;; Bandaid (when (featurep 'mime-setup) ;; No (defvaralias ...) so far. Thanks to "Didier Verna" - ;; for reporting my incorrect defvaraliasing of + ;; for reporting my incorrect defvaraliasing of ;; `mime-editor/insert-tag'. ;; Thanks to Jens-Ulrik Holger Petersen ;; for suggesting the conditional @@ -213,7 +213,7 @@ The make process output must have been saved in (progn (mime-edit-insert-tag "text" - "plain" + "plain" (concat "\nContent-Disposition: attachment;" " filename=\"" @@ -229,7 +229,7 @@ The make process output must have been saved in (goto-char (point-min)) (delete-matching-lines (build-report-delete)) (goto-char (point-min)) - (insert "> Contents of " + (insert "> Contents of " build-report-make-output-file "\n> keeping lines matching\n> \"" (build-report-keep) @@ -239,7 +239,7 @@ The make process output must have been saved in (insert "> " build-report-make-output-file " does not exist!\n\n")) (buffer-string))) - + (defun build-report-insert-installation-file (where all) "Inserts the contents of the `build-report-installation-file' created by the XEmacs Beta configure process." @@ -258,7 +258,7 @@ created by the XEmacs Beta configure process." (progn (mime-edit-insert-tag "text" - "plain" + "plain" (concat "\nContent-Disposition: attachment;" " filename=\"" diff --git a/lisp/cl-macs.el b/lisp/cl-macs.el index 841d5e0..b66b4ea 100644 --- a/lisp/cl-macs.el +++ b/lisp/cl-macs.el @@ -106,31 +106,6 @@ (run-hooks 'cl-hack-bytecomp-hook)) -;;; Symbols. - -(defvar *gensym-counter*) - -;;;###autoload -(defun gensym (&optional arg) - "Generate a new uninterned symbol. -The name is made by appending a number to PREFIX, default \"G\"." - (let ((prefix (if (stringp arg) arg "G")) - (num (if (integerp arg) arg - (prog1 *gensym-counter* - (setq *gensym-counter* (1+ *gensym-counter*)))))) - (make-symbol (format "%s%d" prefix num)))) - -;;;###autoload -(defun gentemp (&optional arg) - "Generate a new interned symbol with a unique name. -The name is made by appending a number to PREFIX, default \"G\"." - (let ((prefix (if (stringp arg) arg "G")) - name) - (while (intern-soft (setq name (format "%s%d" prefix *gensym-counter*))) - (setq *gensym-counter* (1+ *gensym-counter*))) - (intern name))) - - ;;; Program structure. ;;;###autoload diff --git a/lisp/cl.el b/lisp/cl.el index 4bddff6..db01cd2 100644 --- a/lisp/cl.el +++ b/lisp/cl.el @@ -317,6 +317,23 @@ definitions to shadow the loaded ones for use in file byte-compilation." (defvar *gensym-counter* (* (logand (cl-random-time) 1023) 100)) +(defun gensym (&optional arg) + "Generate a new uninterned symbol. +The name is made by appending a number to PREFIX, default \"G\"." + (let ((prefix (if (stringp arg) arg "G")) + (num (if (integerp arg) arg + (prog1 *gensym-counter* + (setq *gensym-counter* (1+ *gensym-counter*)))))) + (make-symbol (format "%s%d" prefix num)))) + +(defun gentemp (&optional arg) + "Generate a new interned symbol with a unique name. +The name is made by appending a number to PREFIX, default \"G\"." + (let ((prefix (if (stringp arg) arg "G")) + name) + (while (intern-soft (setq name (format "%s%d" prefix *gensym-counter*))) + (setq *gensym-counter* (1+ *gensym-counter*))) + (intern name))) ;;; Numbers. diff --git a/lisp/coding.el b/lisp/coding.el index 96056d4..30e4036 100644 --- a/lisp/coding.el +++ b/lisp/coding.el @@ -104,6 +104,9 @@ or a function symbol which, when called, returns such a cons cell." (interactive "zkeyboard-coding-system: ") (get-coding-system coding-system) ; correctness check (setq keyboard-coding-system coding-system) + (if (eq (device-type) 'tty) + (set-console-tty-input-coding-system + (device-console) keyboard-coding-system)) (redraw-modeline t)) (defsubst terminal-coding-system () @@ -117,7 +120,8 @@ or a function symbol which, when called, returns such a cons cell." (setq terminal-coding-system coding-system) ; #### should this affect all current tty consoles ? (if (eq (device-type) 'tty) - (set-console-tty-coding-system (device-console) terminal-coding-system)) + (set-console-tty-output-coding-system + (device-console) terminal-coding-system)) (redraw-modeline t)) (defun set-pathname-coding-system (coding-system) diff --git a/lisp/custom.el b/lisp/custom.el index fa7d2b1..49616dc 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -227,7 +227,7 @@ For the DISPLAY to match a FRAME, the REQ property of the frame must match one of the ITEM. The following REQ are defined: `type' (the value of `window-system') - Should be one of `x' or `tty'. + Should be one of `x', `mswindows', or `tty'. `class' (the frame's color support) Should be one of `color', `grayscale', or `mono'. diff --git a/lisp/dialog.el b/lisp/dialog.el index 740ff72..32f6e01 100644 --- a/lisp/dialog.el +++ b/lisp/dialog.el @@ -37,8 +37,8 @@ Takes one argument, which is the string to display to ask the question." event) (popup-dialog-box ;; "Non-violent language please!" says Robin. - (cons prompt '(["Yes" yes t] ["No" no t] nil ["Cancel" abort t]))) -; (cons prompt '(["Yes" yes t] ["No" no t] nil ["Abort" abort t]))) + (cons prompt '(["%_Yes" yes t] ["%_No" no t] nil ["%_Cancel" abort t]))) +; (cons prompt '(["%_Yes" yes t] ["%_No" no t] nil ["A%_bort" abort t]))) (catch 'ynp-done (while t (setq event (next-command-event event)) @@ -138,7 +138,7 @@ minibuffer contents show." nil) (let ((str (apply 'format fmt args))) (if (device-on-window-system-p) - (get-dialog-box-response nil (list str (cons "OK" t))) + (get-dialog-box-response nil (list str (cons "%_OK" t))) (display-message 'message str)) str))) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index b942db4..d5e26d8 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -584,11 +584,10 @@ This is normally set via `font-lock-defaults'.") font-lock-preprocessor-face font-lock-warning-face)) -;; #### There should be an emulation for the old font-lock-use-* -;; settings! - (defface font-lock-comment-face '((((class color) (background dark)) (:foreground "gray80")) + ;; blue4 is hardly different from black on windows. + (((class color) (background light) (type mswindows)) (:foreground "blue")) (((class color) (background light)) (:foreground "blue4")) (((class grayscale) (background light)) (:foreground "DimGray" :bold t :italic t)) @@ -620,6 +619,8 @@ on the major mode's symbol." (defface font-lock-keyword-face '((((class color) (background dark)) (:foreground "cyan")) + ;; red4 is hardly different from black on windows. + (((class color) (background light) (type mswindows)) (:foreground "red")) (((class color) (background light)) (:foreground "red4")) (((class grayscale) (background light)) (:foreground "LightGray" :bold t)) (((class grayscale) (background dark)) (:foreground "DimGray" :bold t)) @@ -629,6 +630,11 @@ on the major mode's symbol." (defface font-lock-function-name-face '((((class color) (background dark)) (:foreground "aquamarine")) + ;; brown4 is hardly different from black on windows. + ;; I changed it to red because IMO it's pointless and ugly to + ;; use a million slightly different colors for niggly syntactic + ;; differences. --ben + (((class color) (background light) (type mswindows)) (:foreground "red")) (((class color) (background light)) (:foreground "brown4")) (t (:bold t :underline t))) "Font Lock mode face used to highlight function names." @@ -834,8 +840,9 @@ See the variable `font-lock-keywords' for customization." ((or (null maximum-size) (<= (buffer-size) maximum-size)) (font-lock-fontify-buffer)) (font-lock-verbose - (lmessage 'command "Fontifying %s... buffer too big." - (buffer-name))))) + (lprogress-display 'font-lock + "Fontifying %s... buffer too big." 'abort + (buffer-name))))) (font-lock-fontified (setq font-lock-fontified nil) (remove-hook 'before-revert-hook 'font-lock-revert-setup t) @@ -996,7 +1003,7 @@ This can take a while for large buffers." (condition-case nil (save-excursion (font-lock-fontify-region (point-min) (point-max))) - (quit + (t (setq aborted t))) (or was-on ; turn it off if it was off. @@ -1004,7 +1011,7 @@ This can take a while for large buffers." (font-lock-mode 0))) (set (make-local-variable 'font-lock-fontified) t) (when (and aborted font-lock-verbose) - (lmessage 'command "Fontifying %s... aborted." (buffer-name)))) + (lprogress-display 'font-lock "Fontifying %s... aborted." 'abort (buffer-name)))) (run-hooks 'font-lock-after-fontify-buffer-hook)) (defun font-lock-default-unfontify-buffer () @@ -1043,7 +1050,7 @@ This can take a while for large buffers." (defun font-lock-default-unfontify-region (beg end &optional maybe-loudly) (when (and maybe-loudly font-lock-verbose (>= (- end beg) font-lock-message-threshold)) - (lmessage 'progress "Fontifying %s..." (buffer-name))) + (lprogress-display 'font-lock "Fontifying %s..." 0 (buffer-name))) (let ((modified (buffer-modified-p)) (buffer-undo-list t) (inhibit-read-only t) buffer-file-name buffer-file-truename) @@ -1305,8 +1312,8 @@ START should be at the beginning of a line." nil (when (and font-lock-verbose (>= (- end start) font-lock-message-threshold)) - (lmessage 'progress "Fontifying %s... (syntactically...)" - (buffer-name))) + (lprogress-display 'font-lock "Fontifying %s... (syntactically)" 5 + (buffer-name))) (font-lock-unfontify-region start end loudly) (goto-char start) (if (> end (point-max)) (setq end (point-max))) @@ -1493,14 +1500,13 @@ START should be at the beginning of a line." (keywords (cdr (if (eq (car-safe font-lock-keywords) t) font-lock-keywords (font-lock-compile-keywords)))) - (bufname (buffer-name)) (count 0) + (bufname (buffer-name)) (count 5) keyword matcher highlights) ;; ;; Fontify each item in `font-lock-keywords' from `start' to `end'. (while keywords - (when loudly (lmessage 'progress "Fontifying %s... (regexps..%s)" - bufname - (make-string (setq count (1+ count)) ?.))) + (when loudly (lprogress-display 'font-lock "Fontifying %s... (regexps)" + (setq count (+ count 5)) bufname)) ;; ;; Find an occurrence of `matcher' from `start' to `end'. (setq keyword (car keywords) matcher (car keyword)) @@ -1523,7 +1529,7 @@ START should be at the beginning of a line." (font-lock-fontify-anchored-keywords (car highlights) end)) (setq highlights (cdr highlights)))) (setq keywords (cdr keywords)))) - (if loudly (lmessage 'progress "Fontifying %s... done." (buffer-name))))) + (if loudly (lprogress-display 'font-lock "Fontifying %s... " 100 (buffer-name))))) ;; Various functions. @@ -1548,17 +1554,26 @@ START should be at the beginning of a line." (lazy-lock-after-fontify-buffer)))) ;; If the buffer is about to be reverted, it won't be fontified afterward. -(defun font-lock-revert-setup () - (setq font-lock-fontified nil)) +;(defun font-lock-revert-setup () +; (setq font-lock-fontified nil)) ;; If the buffer has just been reverted, normally that turns off ;; Font Lock mode. So turn the mode back on if necessary. ;; sb 1999-03-03 -- The above comment no longer appears to be operative as ;; the first call to normal-mode *will* restore the font-lock state and ;; this call forces a second font-locking to occur when reverting a buffer, -;; which is wasteful at best. -;(defalias 'font-lock-revert-cleanup 'turn-on-font-lock) -(defun font-lock-revert-cleanup ()) +;; which is wasteful at best. +;;(defun font-lock-revert-cleanup ()) + +;; 12-10-99. This still does not work right, I think +;; after change functions will still get us. The simplest thing to do +;; is unconditionally turn-off font-lock before revert (and thus nuke +;; all hooks) and then turn it on again afterwards. This also happens +;; to be much faster because fontifying from scratch is better than +;; trying to do incremental changes for the whole buffer. + +(defalias 'font-lock-revert-cleanup 'turn-on-font-lock) +(defalias 'font-lock-revert-setup 'turn-off-font-lock) ;; Various functions. diff --git a/lisp/info.el b/lisp/info.el index 0bcda60..a4a6df3 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -22,7 +22,7 @@ ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the +;; along with XEmacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. @@ -308,7 +308,7 @@ ;; contain none or when it has become older than info files in the same ;; directory. -;; Modified 1998-09-23 by Didier Verna +;; Modified 1998-09-23 by Didier Verna ;; ;; Use the new macro `with-search-caps-disable-folding' @@ -402,10 +402,10 @@ nil or `never' never auto-generate a directory listing, `always' auto-generate a directory listing ignoring existing `dir' and `localdir' files `if-missing', the default, auto-generates a directory listing - if no `dir' or `localdir' file is present. Otherwise the + if no `dir' or `localdir' file is present. Otherwise the contents of any of these files is used instead. `if-outdated' auto-generates a directory listing if the `dir' - and `localdir' are either inexistent or outdated (touched + and `localdir' are either inexistent or outdated (touched less recently than an info file in the same directory)." :type '(choice (const :tag "never" never) (const :tag "always" always) @@ -416,12 +416,12 @@ nil or `never' never auto-generate a directory listing, (defcustom Info-save-auto-generated-dir 'never "*Whether an auto-generated info directory listing should be saved. Possible values are: -nil or `never', the default, auto-generated info directory +nil or `never', the default, auto-generated info directory information will never be saved. `always', auto-generated info directory information will be saved to a `dir' file in the same directory overwriting it if it exists `conservative', auto-generated info directory information will be saved - to a `dir' file in the same directory but the user is asked before + to a `dir' file in the same directory but the user is asked before overwriting any existing file." :type '(choice (const :tag "never" never) (const :tag "always" always) @@ -463,7 +463,7 @@ heading." :group 'info-faces) ;; Is this right for NT? .zip, with -c for to stdout, right? -(defvar Info-suffix-list '( ("" . nil) +(defvar Info-suffix-list '( ("" . nil) (".info" . nil) (".info.bz2" . "bzip2 -dc %s") (".info.gz" . "gzip -dc %s") @@ -537,7 +537,7 @@ Info hierarchy. The first time you invoke Info you start off looking at that node, which is (dir)Top.  File: dir Node: Top This is the top of the INFO tree - This (the Directory node) gives a menu of major topics. + This (the Directory node) gives a menu of major topics. * Menu: The list of major topics begins on the next line. @@ -607,7 +607,7 @@ further (recursive) error recovery. TRYFILE is ??" (Info-find-file-node nil nodename no-going-back tryfile line)) ;; Convert filename to lower case if not found as specified. ;; Expand it, look harder... - ((let (temp temp-downcase found + ((let (temp temp-downcase found (fname (substitute-in-file-name filename))) (let ((dirs (cond ((string-match "^\\./" fname) ; If specified name starts with `./' @@ -628,7 +628,7 @@ further (recursive) error recovery. TRYFILE is ??" ;; Try downcasing, appending a suffix, or both. (setq found (Info-suffixed-file temp temp-downcase)) (setq dirs (cdr dirs))) - (if found + (if found (progn (setq filename (expand-file-name found)) t)))) (Info-find-file-node filename nodename no-going-back tryfile line)) @@ -870,7 +870,7 @@ actually get any text from." (if (string-match "localdir" file) "localdir" "info dir")))) - (if (not buf) + (if (not buf) (insert-file-contents file)) (if (string-match "localdir" (buffer-name)) (setq lbuffers (cons (current-buffer) lbuffers)) @@ -881,13 +881,13 @@ actually get any text from." Info-dir-file-attributes))))))) (or (cdr dirs) (setq Info-dir-contents-directory (car dirs))) (setq dirs (cdr dirs)))) - + ;; ensure that the localdir files are inserted last, and reverse ;; the list of them so that when they get pushed in, they appear ;; in the same order they got specified in the path, from top to ;; bottom. (nconc buffers (reverse lbuffers)) - + (or buffers (error "Can't find the Info directory node")) ;; Distinguish the dir file that comes with Emacs from all the @@ -956,7 +956,7 @@ actually get any text from." (setq end (point)) (setq nodes (cons (list nodename other beg end) nodes)))))) (setq others (cdr others)))) - + ;; Add to the main menu a menu item for each other node. (re-search-forward "^\\* Menu:" nil t) (forward-line 1) @@ -1016,7 +1016,7 @@ actually get any text from." (if (not (find-buffer-visiting file)) (if (not (file-exists-p file)) (if (or (eq Info-auto-generate-directory 'always) - (eq Info-auto-generate-directory 'if-missing)) + (eq Info-auto-generate-directory 'if-missing)) (Info-build-dir-anew (file-name-directory file))) (if (or (eq Info-auto-generate-directory 'always) (and (eq Info-auto-generate-directory 'if-outdated) @@ -1034,7 +1034,7 @@ directory has been modified more recently." f-mod-time newer) (setq Info-dir-newer-info-files nil) - (mapcar + (mapcar #'(lambda (f) (prog2 (setq f-mod-time (nth 5 (file-attributes f))) @@ -1043,7 +1043,7 @@ directory has been modified more recently." (> (car (cdr f-mod-time)) (car (cdr dir-mod-time)))))) (if (and (file-readable-p f) newer) - (setq Info-dir-newer-info-files + (setq Info-dir-newer-info-files (cons f Info-dir-newer-info-files))))) (directory-files (file-name-directory file) 'fullname @@ -1082,12 +1082,12 @@ and `END-INFO-DIR-ENTRY'" (match-string 1) (downcase (or (match-string 3) (match-string 1))))) - (setq entry - (cons (nreverse - (cdr - (nreverse - (split-string - (buffer-substring + (setq entry + (cons (nreverse + (cdr + (nreverse + (split-string + (buffer-substring (re-search-forward "[ \t]*" nil t) (or (and (re-search-forward "^[^ \t]" nil t) (goto-char (match-beginning 0))) @@ -1108,7 +1108,7 @@ and `END-INFO-DIR-ENTRY'" (if (> len description-col) (setq description-col len))) entries) - (setq description-col (+ 5 description-col)) + (setq description-col (+ 5 description-col)) (mapcar #'(lambda (e) (setq e (cdr e)) ; Drop filename (insert "* " (car e) ":" (car (cdr e))) @@ -1123,7 +1123,7 @@ and `END-INFO-DIR-ENTRY'" (defun Info-build-dir-anew (directory) "Build info directory information for DIRECTORY. -The generated directory listing may be saved to a `dir' according +The generated directory listing may be saved to a `dir' according to the value of `Info-save-auto-generated-dir'" (save-excursion (let* ((dirfile (expand-file-name "dir" directory)) @@ -1131,7 +1131,7 @@ to the value of `Info-save-auto-generated-dir'" (eq Info-save-auto-generated-dir 'never) (and (not (file-writable-p dirfile)) (message "File not writable %s. Using temporary." dirfile)))) - (info-files + (info-files (directory-files directory 'fullname ".*\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$" @@ -1145,13 +1145,13 @@ to the value of `Info-save-auto-generated-dir'" (erase-buffer) (insert Info-dir-prologue "Info files in " directory ":\n\n") - (Info-dump-dir-entries - (mapcar + (Info-dump-dir-entries + (mapcar #'(lambda (f) (or (Info-extract-dir-entry-from f) (list 'dummy - (progn - (string-match "\\(.*\\)\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$" + (progn + (string-match "\\(.*\\)\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$" (file-name-nondirectory f)) (capitalize (match-string 1 (file-name-nondirectory f)))) ":" @@ -1167,10 +1167,10 @@ to the value of `Info-save-auto-generated-dir'" (defun Info-rebuild-dir (file) "Build info directory information in the directory of dir FILE. -Description of info files are merged from the info files in the +Description of info files are merged from the info files in the directory and the contents of FILE with the description in info files -taking precedence over descriptions in FILE. -The generated directory listing may be saved to a `dir' according to +taking precedence over descriptions in FILE. +The generated directory listing may be saved to a `dir' according to the value of `Info-save-auto-generated-dir' " (save-excursion (save-restriction @@ -1179,7 +1179,7 @@ the value of `Info-save-auto-generated-dir' " file-dir-entry mark next-section not-first-section - (to-temp + (to-temp (or (null Info-save-auto-generated-dir) (eq Info-save-auto-generated-dir 'never) (and (eq Info-save-auto-generated-dir 'always) @@ -1188,8 +1188,8 @@ the value of `Info-save-auto-generated-dir' " (and (eq Info-save-auto-generated-dir 'conservative) (or (and (not (file-writable-p file)) (message "File not writable %s. Using temporary." file)) - (not (y-or-n-p - (message "%s is outdated. Overwrite ? " + (not (y-or-n-p + (message "%s is outdated. Overwrite ? " file)))))))) (set-buffer (find-file-noselect file t)) (setq buffer-read-only nil) @@ -1232,12 +1232,12 @@ the value of `Info-save-auto-generated-dir' " (if file-dir-entry (setq dir-section-contents (cons file-dir-entry dir-section-contents)) - (setq dir-section-contents + (setq dir-section-contents (cons (list 'dummy (capitalize (file-name-sans-extension (file-name-nondirectory file))) ":" - (list Info-no-description-string)) + (list Info-no-description-string)) dir-section-contents)))))) Info-dir-newer-info-files) (delete-region (point-min) (point-max)) @@ -1259,7 +1259,7 @@ the value of `Info-save-auto-generated-dir' " (save-buffer) (message "Rebuilding %s...done" file)))))) -;;;###autoload +;;;###autoload (defun Info-batch-rebuild-dir () "(Re)build info `dir' files in the directories remaining on the command line. Use this from the command line, with `-batch'; @@ -1279,7 +1279,7 @@ For example, invoke \"xemacs -batch -f Info-batch-rebuild-dir /usr/local/info\"" (car command-line-args-left)) (setq dir (expand-file-name "dir" (car command-line-args-left))) (setq localdir (expand-file-name "localdir" (car command-line-args-left))) - (cond + (cond ((file-exists-p dir) (Info-rebuild-dir dir)) ((file-exists-p localdir) @@ -1587,7 +1587,7 @@ annotation for any node of any file. (See `a' and `x' commands.)" (forward-line 1) (if (re-search-backward "Node: *\\([^,\n]*\\) *[,\n\t]" beg t) - (setq compl + (setq compl (cons (list (buffer-substring (match-beginning 1) (match-end 1))) compl)))))))) @@ -1667,7 +1667,7 @@ annotation for any node of any file. (See `a' and `x' commands.)" (Info-history-add ofile onode opoint))))) ;; Extract the value of the node-pointer named NAME. -;; If there is none, use ERRORNAME in the error message; +;; If there is none, use ERRORNAME in the error message; ;; if ERRORNAME is nil, just return nil. (defun Info-extract-pointer (name &optional errorname) (save-excursion @@ -1943,7 +1943,7 @@ Completion is allowed, and the menu item point is on is the default." ;; there is a problem here in that if several menu items have the same ;; name you can only go to the node of the first with this command. (Info-goto-node (Info-extract-menu-item menu-item) nil t)) - + (defun Info-extract-menu-item (menu-item &optional noerror) (save-excursion (goto-char (point-min)) @@ -2292,7 +2292,7 @@ This command is designed to be used whether you are already in Info or not." "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." (interactive (let ((fn (function-at-point)) - (enable-recursive-minibuffers t) + (enable-recursive-minibuffers t) val) (setq val (completing-read (format "Look up Emacs Lisp function%s: " @@ -2999,7 +2999,7 @@ Adds an entry for the node at EVENT, or under point if EVENT is omitted. Used to construct the menubar submenu and popup menu." (or event (setq event (point))) (let ((case-fold-search t) - (xref-regexp (concat "\\*" + (xref-regexp (concat "\\*" (regexp-quote Info-footnote-tag) "[ \n\t]*\\([^:]*\\):")) up-p prev-p next-p menu xrefs subnodes in) diff --git a/lisp/keydefs.el b/lisp/keydefs.el index 947ce34..82652ea 100644 --- a/lisp/keydefs.el +++ b/lisp/keydefs.el @@ -1,6 +1,7 @@ ;;; keydefs.el --- Define standard keybindings. ;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc. +;; Copyright (C) 2000 Ben Wing. ;; Maintainer: XEmacs Development Team ;; Keywords: internal, dumped @@ -106,9 +107,6 @@ Keymap for characters following C-c.") (define-key global-map "\C-e" 'end-of-line) (define-key global-map "\C-f" 'forward-char-command) (define-key global-map "\C-d" 'delete-char) -(define-key global-map 'delete 'backward-or-forward-delete-char) -(define-key global-map '(meta delete) 'backward-or-forward-kill-word) -(define-key global-map [(control x) (delete)] 'backward-or-forward-kill-sentence) ;; FSFmacs files.el @@ -240,6 +238,7 @@ Keymap for characters following C-c.") (define-key global-map '(control meta -) 'negative-argument) (define-key global-map "\C-k" 'kill-line) +(define-key global-map '(control K) 'historical-kill-line) (define-key global-map "\C-w" 'kill-region) (define-key global-map "\M-w" 'kill-ring-save) (define-key global-map "\M-\C-w" 'append-next-kill) @@ -305,9 +304,6 @@ Keymap for characters following C-c.") (define-key global-map "\M-\)" 'move-past-close-and-reindent) (define-key global-map "\M-\t" 'lisp-complete-symbol) -(define-key global-map '(control meta backspace) 'backward-kill-sexp) -(define-key global-map '(control meta delete) 'backward-or-forward-kill-sexp) - (define-key global-map "\C-x/" 'point-to-register) (define-key global-map "\C-xj" 'jump-to-register) @@ -510,75 +506,72 @@ Keymap for characters following C-c.") ;; movement by units (define-key global-map 'left 'backward-char-command) -(define-key global-map 'up 'previous-line) (define-key global-map 'right 'forward-char-command) +(define-key global-map 'up 'previous-line) (define-key global-map 'down 'next-line) - -;; movement by pages -(define-key global-map 'prior 'scroll-down-command) -(define-key global-map 'next 'scroll-up-command) - -;; movement to the limits -(define-key global-map 'home 'beginning-of-line) -(define-key global-map 'end 'end-of-line) - -;;; Miscellaneous key bindings -(define-key global-map 'again 'repeat-complex-command) -(define-key global-map 'insert 'overwrite-mode) - -;;; These aren't bound to kbd macros like "\C-b" so that they have the -;; expected behavior even in, for example, vi-mode. - -;; We use here symbolic names, assuming that the corresponding keys will -;; generate these keysyms. This is not true on Suns, but x-win-sun.el -;; fixes that. If it turns out that the semantics of these keys should -;; differ from server to server, this should be moved into server-specific -;; files, but these appear to be the standard Motif and PC bindings. - -;; potential R6isms (define-key global-map 'kp-left 'backward-char-command) -(define-key global-map 'kp-up 'previous-line) (define-key global-map 'kp-right 'forward-char-command) +(define-key global-map 'kp-up 'previous-line) (define-key global-map 'kp-down 'next-line) - -;; movement by larger blocks -(define-key global-map '(control left) 'backward-word) -(define-key global-map '(control up) #'(lambda () - (interactive "_") - (forward-line -6))) -(define-key global-map '(control right) 'forward-word) -(define-key global-map '(control down) #'(lambda () - (interactive "_") - (forward-line 6))) - -;; context-sensitive movement -(define-key global-map '(meta left) 'backward-sexp) -(define-key global-map '(meta right) 'forward-sexp) -(define-key global-map '(meta up) 'backward-paragraph) -(define-key global-map '(meta down) 'forward-paragraph) - ;; movement by pages +(define-key global-map 'prior 'scroll-down-command) +(define-key global-map 'next 'scroll-up-command) (define-key global-map '(control prior) 'scroll-right) (define-key global-map '(control next) 'scroll-left) -;; potential R6isms (define-key global-map 'kp-prior 'scroll-down-command) (define-key global-map 'kp-next 'scroll-up-command) (define-key global-map '(control kp-prior) 'scroll-right) (define-key global-map '(control kp-next) 'scroll-left) - ;; movement to the limits +(define-key global-map 'home 'beginning-of-line) +(define-key global-map 'end 'end-of-line) (define-key global-map '(control home) 'beginning-of-buffer) (define-key global-map '(control end) 'end-of-buffer) -(define-key global-map 'begin 'beginning-of-line) -(define-key global-map '(control begin) 'beginning-of-buffer) -;; potential R6isms (define-key global-map 'kp-home 'beginning-of-line) -(define-key global-map '(control kp-home) 'beginning-of-buffer) (define-key global-map 'kp-end 'end-of-line) +(define-key global-map '(control kp-home) 'beginning-of-buffer) (define-key global-map '(control kp-end) 'end-of-buffer) +;; on which systems do these exist? +(define-key global-map 'begin 'beginning-of-line) +(define-key global-map '(control begin) 'beginning-of-buffer) + +;; movement by larger blocks +(define-key global-map '(control left) 'backward-word) +(define-key global-map '(control right) 'forward-word) +(define-key global-map '(control up) 'backward-block-of-lines) +(define-key global-map '(control down) 'forward-block-of-lines) +(define-key global-map '(control kp-left) 'backward-word) +(define-key global-map '(control kp-right) 'forward-word) +(define-key global-map '(control kp-up) 'backward-block-of-lines) +(define-key global-map '(control kp-down) 'forward-block-of-lines) + +;; context-sensitive movement +;; (meta control left/right) should be reserved for bindings that +;; switch between buffers/web pages/etc. +(define-key global-map '(meta left) 'backward-sexp) +(define-key global-map '(meta right) 'forward-sexp) +(define-key global-map '(meta up) 'backward-sentence) +(define-key global-map '(meta down) 'forward-sentence) +(define-key global-map '(meta control up) 'backward-paragraph) +(define-key global-map '(meta control down) 'forward-paragraph) +(define-key global-map '(meta control home) 'beginning-of-defun) +(define-key global-map '(meta control end) 'end-of-defun) +(define-key global-map '(meta control prior) 'backward-page) +(define-key global-map '(meta control next) 'forward-page) +(define-key global-map '(meta kp-left) 'backward-sexp) +(define-key global-map '(meta kp-right) 'forward-sexp) +(define-key global-map '(meta kp-up) 'backward-sentence) +(define-key global-map '(meta kp-down) 'forward-sentence) +(define-key global-map '(meta control kp-up) 'backward-paragraph) +(define-key global-map '(meta control kp-down) 'forward-paragraph) +(define-key global-map '(meta control kp-home) 'beginning-of-defun) +(define-key global-map '(meta control kp-end) 'end-of-defun) +(define-key global-map '(meta control kp-prior) 'backward-page) +(define-key global-map '(meta control kp-next) 'forward-page) + ;; movement between windows (define-key global-map '(control tab) 'other-window) (define-key global-map '(control shift tab) 'backward-other-window) @@ -588,16 +581,33 @@ Keymap for characters following C-c.") (define-key global-map '(meta prior) 'scroll-other-window-down) (define-key global-map '(meta home) 'beginning-of-buffer-other-window) (define-key global-map '(meta end) 'end-of-buffer-other-window) -;; potential R6isms (define-key global-map '(meta kp-next) 'scroll-other-window) (define-key global-map '(meta kp-prior) 'scroll-other-window-down) (define-key global-map '(meta kp-home) 'beginning-of-buffer-other-window) (define-key global-map '(meta kp-end) 'end-of-buffer-other-window) -;; potential R6isms -(define-key global-map 'redo 'repeat-complex-command) +;; the infamous delete key +(define-key global-map 'delete 'backward-or-forward-delete-char) +(define-key global-map '(meta delete) 'backward-or-forward-kill-word) +(define-key global-map [(control x) (delete)] + 'backward-or-forward-kill-sentence) +(define-key global-map 'kp-delete 'backward-or-forward-delete-char) +(define-key global-map '(meta kp-delete) 'backward-or-forward-kill-word) +(define-key global-map [(control x) (kp-delete)] + 'backward-or-forward-kill-sentence) + +;; don't try this one at home, kids. +(define-key global-map '(control meta delete) 'backward-or-forward-kill-sexp) +(define-key global-map '(control meta kp-delete) 'backward-or-forward-kill-sexp) +;; or this one, either, on Linux. +(define-key global-map '(control meta backspace) 'backward-kill-sexp) + + +;;; Miscellaneous key bindings +(define-key global-map 'insert 'overwrite-mode) (define-key global-map 'kp-insert 'overwrite-mode) -(define-key global-map 'kp-delete 'backward-delete-char-untabify) +(define-key global-map 'again 'repeat-complex-command) +(define-key global-map 'redo 'repeat-complex-command) (define-key global-map 'kp-enter [return]) ; do whatever RET does now (define-key global-map 'kp-tab [tab]) diff --git a/lisp/lisp-mode.el b/lisp/lisp-mode.el index fee10bd..2772387 100644 --- a/lisp/lisp-mode.el +++ b/lisp/lisp-mode.el @@ -1,7 +1,7 @@ ;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands. ;; Copyright (C) 1985, 1996, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Tinker Systems +;; Copyright (C) 1995 Tinker Systems. ;; Maintainer: FSF ;; Keywords: lisp, languages, dumped @@ -32,8 +32,6 @@ ;; The base major mode for editing Lisp code (used also for Emacs Lisp). ;; This mode is documented in the Emacs manual -;; July/05/97 slb Converted to use easymenu. - ;;; Code: (defgroup lisp nil @@ -46,55 +44,57 @@ (defvar lisp-mode-abbrev-table nil) ;; XEmacs change -(defvar lisp-interaction-mode-popup-menu nil) -(defvar lisp-interaction-mode-popup-menu-1 +(defvar lisp-interaction-mode-popup-menu (purecopy '("Lisp-Interaction" - ["Evaluate Last S-expression" eval-last-sexp] - ["Evaluate Entire Buffer" eval-current-buffer] - ["Evaluate Region" eval-region + ["Evaluate Last %_S-expression" eval-last-sexp] + ["Evaluate %_Whole Buffer" eval-current-buffer] + ["Evaluate Re%_gion" eval-region :active (region-exists-p)] "---" - ["Evaluate This Defun" eval-defun] - ;; FSF says "Instrument Function for Debugging" - ["Debug This Defun" edebug-defun] + ["%_Evaluate This Defun" eval-defun] + ["%_Instrument This Defun for Debugging" edebug-defun] "---" - ["Trace a Function" trace-function-background] - ["Untrace All Functions" untrace-all + ["Find %_Function Source..." find-function + :active (fboundp 'find-function)] + ["Find %_Variable Source..." find-variable + :active (fboundp 'find-variable)] + ["%_Trace Function..." trace-function-background] + ["%_Untrace All Functions" untrace-all :active (fboundp 'untrace-all)] "---" - ["Comment Out Region" comment-region - :active (region-exists-p)] - ["Indent Region" indent-region + ["%_Comment Out Region" comment-region :active (region-exists-p)] - ["Indent Line" lisp-indent-line] "---" - ["Debug On Error" (setq debug-on-error (not debug-on-error)) - :style toggle :selected debug-on-error] - ["Debug On Quit" (setq debug-on-quit (not debug-on-quit)) - :style toggle :selected debug-on-quit] - ["Debug on Signal" (setq debug-on-signal (not debug-on-signal)) - :style toggle :selected debug-on-signal] + ["Indent %_Line or Region" + (if (region-exists-p) + (call-interactively 'indent-region) + (call-interactively 'lisp-indent-line))] + ["Indent B%_alanced Expression" indent-sexp] + ["Indent %_Defun" + (progn + (beginning-of-defun) + (indent-sexp))] + "---" + "Look for debug-on-error under Options->General" ))) -(defvar emacs-lisp-mode-popup-menu nil) -(defvar emacs-lisp-mode-popup-menu-1 +(defvar emacs-lisp-mode-popup-menu (purecopy (nconc '("Emacs-Lisp" - ["Byte-compile This File" emacs-lisp-byte-compile] - ["Byte-compile/load This" emacs-lisp-byte-compile-and-load] - ["Byte-recompile Directory..." byte-recompile-directory] + ["%_Byte-Compile This File" emacs-lisp-byte-compile] + ["B%_yte-Compile/Load This File" emacs-lisp-byte-compile-and-load] + ["Byte-%_Recompile Directory..." byte-recompile-directory] "---") - (cdr lisp-interaction-mode-popup-menu-1)))) + (cdr lisp-interaction-mode-popup-menu)))) ;Don't have a menubar entry in Lisp Interaction mode. Otherwise, the ;*scratch* buffer has a Lisp menubar item! Very confusing. ;(defvar lisp-interaction-mode-menubar-menu ; (purecopy (cons "Lisp" (cdr lisp-interaction-mode-popup-menu)))) -(defvar emacs-lisp-mode-menubar-menu nil) -(defvar emacs-lisp-mode-menubar-menu-1 - (purecopy (cons "Lisp" (cdr emacs-lisp-mode-popup-menu-1)))) +(defvar emacs-lisp-mode-menubar-menu + (purecopy (cons "%_Lisp" (cdr emacs-lisp-mode-popup-menu)))) (if (not emacs-lisp-mode-syntax-table) (let ((i 0)) @@ -274,19 +274,15 @@ if that value is non-nil." (set-syntax-table emacs-lisp-mode-syntax-table) ;; XEmacs changes (setq major-mode 'emacs-lisp-mode - ;; mode-popup-menu emacs-lisp-mode-popup-menu + mode-popup-menu emacs-lisp-mode-popup-menu mode-name "Emacs-Lisp") - ;; (if (and (featurep 'menubar) - ;; current-menubar) - ;; (progn + (if (and (featurep 'menubar) + current-menubar) + (progn ;; make a local copy of the menubar, so our modes don't ;; change the global menubar - ;; (set-buffer-menubar current-menubar) - ;; (add-submenu nil emacs-lisp-mode-menubar-menu))) - (unless emacs-lisp-mode-popup-menu - (easy-menu-define emacs-lisp-mode-popup-menu emacs-lisp-mode-map "" - emacs-lisp-mode-popup-menu-1)) - (easy-menu-add emacs-lisp-mode-popup-menu) + (set-buffer-menubar current-menubar) + (add-submenu nil emacs-lisp-mode-menubar-menu))) (lisp-mode-variables nil) (run-hooks 'emacs-lisp-mode-hook)) @@ -366,14 +362,7 @@ if that value is non-nil." (use-local-map lisp-interaction-mode-map) (setq major-mode 'lisp-interaction-mode) (setq mode-name "Lisp Interaction") - ;; XEmacs change - ;; (setq mode-popup-menu lisp-interaction-mode-popup-menu) - (unless lisp-interaction-mode-popup-menu - (easy-menu-define lisp-interaction-mode-popup-menu - lisp-interaction-mode-map - "" - lisp-interaction-mode-popup-menu-1)) - (easy-menu-add lisp-interaction-mode-popup-menu) + (setq mode-popup-menu lisp-interaction-mode-popup-menu) (set-syntax-table emacs-lisp-mode-syntax-table) (lisp-mode-variables nil) @@ -760,6 +749,7 @@ of the start of the containing expression." (put 'let 'lisp-indent-function 1) (put 'let* 'lisp-indent-function 1) (put 'let-specifier 'lisp-indent-function 1) +(put 'flet 'lisp-indent-function 1) (put 'while 'lisp-indent-function 1) (put 'if 'lisp-indent-function 2) (put 'catch 'lisp-indent-function 1) diff --git a/lisp/list-mode.el b/lisp/list-mode.el index b2b828b..25d2418 100644 --- a/lisp/list-mode.el +++ b/lisp/list-mode.el @@ -1,7 +1,7 @@ ;;; list-mode.el --- Major mode for buffers containing lists of items ;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1996 Ben Wing. +;; Copyright (C) 1996, 2000 Ben Wing. ;; Maintainer: XEmacs Development Team ;; Keywords: extensions, dumped @@ -63,6 +63,32 @@ (dolist (key '(kp-left left (control ?b))) (define-key map key 'previous-list-mode-item)))) +;; #### We make list-mode-hook, as well as completion-setup-hook and +;; minibuffer-setup-hook, permanent-local so that it's possible to create +;; buffers in these modes and then set up some buffer-specific +;; customizations without resorting to awful kludges. (The problem here +;; is that when you switch a buffer into a mode, reset-buffer is usually +;; called, which destroys all buffer-local settings that you carefully +;; tried to set up when you created the buffer. Therefore, the only way +;; to set these variables is to use the setup hooks -- but if they are +;; not declared permanent local, then any local hook functions that you +;; put on them (which is exactly what you want to do) also get removed, +;; so you would have to resort to putting a global hook function on the +;; setup hook, and then making sure it gets removed later. I actually +;; added some support for doing this with one-shot hooks, but this is +;; clearly not the correct way to do things, and it fails in some cases, +;; particularly when the buffer gets put into the mode more than once, +;; which typically happens with completion buffers, for example.) In +;; fact, all setup hooks should be made permanent local, but I didn't +;; feel like making a global change like this quite yet. The proper way +;; to do it would be to declare new def-style forms, such as defhook and +;; define-local-setup-hook, which are used to initialize hooks in place +;; of the current generic defvars. --ben + +(put 'list-mode-hook 'permanent-local t) +(defvar list-mode-hook nil + "Normal hook run when entering List mode.") + (defun list-mode () "Major mode for buffer containing lists of items." (interactive) @@ -70,12 +96,9 @@ (use-local-map list-mode-map) (setq mode-name "List") (setq major-mode 'list-mode) - (make-local-hook 'post-command-hook) - (add-hook 'post-command-hook 'set-list-mode-extent nil t) - (make-local-hook 'pre-command-hook) - (add-hook 'pre-command-hook 'list-mode-extent-pre-hook nil t) - (make-local-variable 'next-line-add-newlines) - (setq next-line-add-newlines nil) + (add-local-hook 'post-command-hook 'set-list-mode-extent) + (add-local-hook 'pre-command-hook 'list-mode-extent-pre-hook) + (set (make-local-variable 'next-line-add-newlines) nil) (setq list-mode-extent nil) ;; It is visually disconcerting to have the text cursor disappear within list ;; buffers, especially when moving from window to window, so leave it @@ -226,8 +249,11 @@ If ACTIVATE-CALLBACK is non-nil, it should be a function of three If the variable in not t or nil, the string is taken as a regexp to match for end of highlight") +;; see comment at list-mode-hook. +(put 'completion-setup-hook 'permanent-local t) (defvar completion-setup-hook nil - "Normal hook run at the end of setting up the text of a completion buffer.") + "Normal hook run at the end of setting up the text of a completion buffer. +When run, the completion buffer is the current buffer.") ; Unnecessary FSFmacs crock. We frob the extents directly in ; display-completion-list, so no "heuristics" like this are necessary. @@ -265,6 +291,9 @@ Keywords: :window-width If non-nil, width to use in displaying the list, instead of the actual window's width. + :window-height + If non-nil, use no more than this many lines, and extend line width as + necessary. :help-string (default is the value of `completion-default-help-string') Form to evaluate to get a string to insert at the beginning of the completion list buffer. This is evaluated when that buffer @@ -288,7 +317,8 @@ If `completion-highlight-first-word-only' is non-nil, then only the start :reference-buffer (:help-string completion-default-help-string) (:completion-string "Possible completions are:") - :window-width) + :window-width + :window-height) () (let ((old-buffer (current-buffer)) (bufferp (bufferp standard-output))) @@ -315,7 +345,8 @@ If `completion-highlight-first-word-only' is non-nil, then only the start (selected-frame))) 80)))) (let ((count 0) - (max-width 0)) + (max-width 0) + old-max-width) ;; Find longest completion (let ((tail completions)) (while tail @@ -336,6 +367,7 @@ If `completion-highlight-first-word-only' is non-nil, then only the start tail (cdr tail))))) (setq max-width (+ 2 max-width)) ; at least two chars between cols + (setq old-max-width max-width) (let ((rows (let ((cols (min (/ win-width max-width) count))) (if (<= cols 1) count @@ -345,8 +377,15 @@ If `completion-highlight-first-word-only' is non-nil, then only the start (if (/= (% count cols) 0) ; want ceiling... (1+ (/ count cols)) (/ count cols))))))) - (if (stringp cl-completion-string) - (princ (gettext cl-completion-string))) + (when + (and cl-window-height + (> rows cl-window-height)) + (setq max-width old-max-width) + (setq rows cl-window-height)) + (when (and (stringp cl-completion-string) + (> (length cl-completion-string) 0)) + (princ (gettext cl-completion-string)) + (terpri)) (let ((tail completions) (r 0) (regexp-string @@ -355,7 +394,7 @@ If `completion-highlight-first-word-only' is non-nil, then only the start "[ \t]" completion-highlight-first-word-only))) (while (< r rows) - (terpri) + (and (> r 0) (terpri)) (let ((indent 0) (column 0) (tail2 tail)) @@ -425,7 +464,9 @@ If `completion-highlight-first-word-only' is non-nil, then only the start ;; (put-text-property beg (point) 'list-mode-item t) ;; (goto-char end))))) )) - (run-hooks 'completion-setup-hook))) + (save-excursion + (set-buffer standard-output) + (run-hooks 'completion-setup-hook)))) (defvar completion-display-completion-list-function 'display-completion-list "Function to set up the list of completions in the completion buffer. diff --git a/lisp/loaddefs.el b/lisp/loaddefs.el index 44ab60b..7217ae7 100644 --- a/lisp/loaddefs.el +++ b/lisp/loaddefs.el @@ -87,7 +87,8 @@ (setq completion-ignored-extensions (mapcar 'purecopy '(".o" ".elc" "~" ".bin" ".lbin" ".fasl" - ".dvi" ".toc" ".log" ".aux" ".a" ".ln" + ".dvi" ".toc" ;".log" + ".aux" ".a" ".ln" ".lof" ".blg" ".bbl" ".glo" ".idx" ".lot" ".fmt" ".diff" ".oi" ".class"))) diff --git a/lisp/map-ynp.el b/lisp/map-ynp.el index 6fef0e9..80b0f84 100644 --- a/lisp/map-ynp.el +++ b/lisp/map-ynp.el @@ -104,7 +104,7 @@ Returns the number of actions taken." ;; (objects (capitalize (or (nth 1 help) "objects"))) ;; (action (capitalize (or (nth 2 help) "act on"))) ) - (setq map `(("Yes" . act) ("No" . skip) + (setq map `(("%_Yes" . act) ("%_No" . skip) ; bogus crap. --ben ; ((, (if help ; (capitalize @@ -119,9 +119,9 @@ Returns the number of actions taken." ; ((, (capitalize ; (or (and help (nth 5 help)) "Quit"))) ; . exit) - ("Yes All" . automatic) - ("No All" . exit) - ("Cancel" . quit) + ("Yes %_All" . automatic) + ("No A%_ll" . exit) + ("%_Cancel" . quit) ,@(mapcar #'(lambda (elt) (cons (capitalize (nth 2 elt)) (vector (nth 1 elt)))) @@ -231,7 +231,8 @@ ESC or `q' to exit;\n" (lambda (elt) (format "%c to %s" (nth 0 elt) - (nth 2 elt)))) + (normalize-menu-item-name + (nth 2 elt))))) action-alist ";\n") (if action-alist ";\n") diff --git a/lisp/menubar-items.el b/lisp/menubar-items.el index cab09aa..984d80f 100644 --- a/lisp/menubar-items.el +++ b/lisp/menubar-items.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1991-1995, 1997-1998 Free Software Foundation, Inc. ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp. ;; Copyright (C) 1995 Sun Microsystems. -;; Copyright (C) 1995, 1996 Ben Wing. +;; Copyright (C) 1995, 1996, 2000 Ben Wing. ;; Copyright (C) 1997 MORIOKA Tomohiko ;; Maintainer: XEmacs Development Team @@ -41,60 +41,115 @@ (defvar current-language-environment) (defvar tutorial-supported-languages)) +(defun menu-truncate-list (list n) + (if (<= (length list) n) + list + (butlast list (- (length list) n)))) + +(defun submenu-generate-accelerator-spec (list &optional omit-chars-list) + "Add auto-generated accelerator specifications to a submenu. +This can be used to add accelerators to the return value of a menu filter +function. It correctly ignores unselectable items. It will destructively +modify the list passed to it. If an item already has an auto-generated +accelerator spec, this will be removed before the new one is added, making +this function idempotent. + +If OMIT-CHARS-LIST is given, it should be a list of lowercase characters, +which will not be used as accelerators." + (let ((n 0)) + (dolist (item list list) + (cond + ((vectorp item) + (setq n (1+ n)) + (aset item 0 + (concat + (menu-item-generate-accelerator-spec n omit-chars-list) + (menu-item-strip-accelerator-spec (aref item 0))))) + ((consp item) + (setq n (1+ n)) + (setcar item + (concat + (menu-item-generate-accelerator-spec n omit-chars-list) + (menu-item-strip-accelerator-spec (car item))))))))) + +(defun menu-item-strip-accelerator-spec (item) + "Strip an auto-generated accelerator spec off of ITEM. +ITEM should be a string. This removes specs added by +`menu-item-generate-accelerator-spec' and `submenu-generate-accelerator-spec'." + (if (string-match "%_. " item) + (substring item 4) + item)) + +(defun menu-item-generate-accelerator-spec (n &optional omit-chars-list) + "Return an accelerator specification for use with auto-generated menus. +This should be concat'd onto the beginning of each menu line. The spec +allows the Nth line to be selected by the number N. '0' is used for the +10th line, and 'a' through 'z' are used for the following 26 lines. + +If OMIT-CHARS-LIST is given, it should be a list of lowercase characters, +which will not be used as accelerators." + (cond ((< n 10) (concat "%_" (int-to-string n) " ")) + ((= n 10) "%_0 ") + ((<= n 36) + (setq n (- n 10)) + (let ((m 0)) + (while (> n 0) + (setq m (1+ m)) + (while (memq (int-to-char (+ m (- (char-to-int ?a) 1))) + omit-chars-list) + (setq m (1+ m))) + (setq n (1- n))) + (if (<= m 26) + (concat + "%_" + (char-to-string (int-to-char (+ m (- (char-to-int ?a) 1)))) + " ") + ""))) + (t ""))) + (defconst default-menubar (purecopy-menubar ;; note backquote. `( - ("File" - ["Open..." find-file] - ["Open in Other Window..." find-file-other-window] - ["Open in New Frame..." find-file-other-frame] - ["Insert File..." insert-file] - ["View File..." view-file] + ("%_File" + ["%_Open..." find-file] + ["Open in Other %_Window..." find-file-other-window] + ["Open in New %_Frame..." find-file-other-frame] + ["%_Hex Edit File..." hexl-find-file + :active (fboundp 'hexl-find-file)] + ["%_Insert File..." insert-file] + ["%_View File..." view-file] "------" - ["Save" save-buffer + ["%_Save" save-buffer :active (buffer-modified-p) :suffix (if put-buffer-names-in-file-menu (buffer-name) "")] - ["Save As..." write-file] - ["Save Some Buffers" save-some-buffers] + ["Save %_As..." write-file] + ["Save So%_me Buffers" save-some-buffers] "-----" - ["Print Buffer" lpr-buffer + ["%_Print Buffer" lpr-buffer :active (fboundp 'lpr-buffer) :suffix (if put-buffer-names-in-file-menu (buffer-name) "")] - ["Pretty-Print Buffer" ps-print-buffer-with-faces + ["Prett%_y-Print Buffer" ps-print-buffer-with-faces :active (fboundp 'ps-print-buffer-with-faces) :suffix (if put-buffer-names-in-file-menu (buffer-name) "")] "-----" - ["New Frame" make-frame] - ["Frame on Other Display..." make-frame-on-display] - ["Delete Frame" delete-frame - :active (not (eq (next-frame (selected-frame) 'nomini 'window-system) - (selected-frame)))] - "-----" - ["Split Window" split-window-vertically] - ["Un-Split (Keep This)" delete-other-windows - :active (not (one-window-p t))] - ["Un-Split (Keep Others)" delete-window - :active (not (one-window-p t))] - "-----" - ["Revert Buffer" revert-buffer + ["%_Revert Buffer" revert-buffer :active (or buffer-file-name revert-buffer-function) :suffix (if put-buffer-names-in-file-menu (buffer-name) "")] - ["Delete Buffer" kill-this-buffer - :active t - :suffix (if put-buffer-names-in-file-menu (buffer-name) "")] + ["Re%_cover File..." recover-file] + ["Recover S%_ession..." recover-session] "-----" - ["Exit XEmacs" save-buffers-kill-emacs] + ["E%_xit XEmacs" save-buffers-kill-emacs] ) - ("Edit" - ["Undo" advertised-undo + ("%_Edit" + ["%_Undo" advertised-undo :active (and (not (eq buffer-undo-list t)) (or buffer-undo-list pending-undo-list)) :suffix (if (or (eq last-command 'undo) (eq last-command 'advertised-undo)) "More" "")] - ["Redo" redo + ["%_Redo" redo :included (fboundp 'redo) :active (not (or (eq buffer-undo-list t) (eq last-buffer-undo-list nil) @@ -105,274 +160,615 @@ (or (eq buffer-undo-list pending-undo-list) (eq (cdr buffer-undo-list) pending-undo-list)))) :suffix (if (eq last-command 'redo) "More" "")] - ["Cut" kill-primary-selection + "----" + ["Cu%_t" kill-primary-selection :active (selection-owner-p)] - ["Copy" copy-primary-selection + ["%_Copy" copy-primary-selection :active (selection-owner-p)] - ["Paste" yank-clipboard-selection + ["%_Paste" yank-clipboard-selection :active (selection-exists-p 'CLIPBOARD)] - ["Clear" delete-primary-selection + ["%_Delete" delete-primary-selection :active (selection-owner-p)] "----" - ["Search..." isearch-forward] - ["Search Backward..." isearch-backward] - ["Replace..." query-replace] + ["Select %_All" mark-whole-buffer] + ["Select %_Page" mark-page] "----" - ["Search (Regexp)..." isearch-forward-regexp] - ["Search Backward (Regexp)..." isearch-backward-regexp] - ["Replace (Regexp)..." query-replace-regexp] - "----" - ["Goto Line..." goto-line] - ["What Line" what-line] - ("Bookmarks" - :filter bookmark-menu-filter) + ["%_1 Search..." isearch-forward] + ["%_2 Search Backward..." isearch-backward] + ["%_3 Replace..." query-replace] "----" - ["Start Macro Recording" start-kbd-macro - :active (not defining-kbd-macro)] - ["End Macro Recording" end-kbd-macro - :active defining-kbd-macro] - ["Execute Last Macro" call-last-kbd-macro - :active last-kbd-macro] - "----" - ["Show Message Log" show-message-log] - ) - - ,@(when (featurep 'mule) - '(("Mule" - ("Describe language support") - ("Set language environment") + ["%_4 Search (Regexp)..." isearch-forward-regexp] + ["%_5 Search Backward (Regexp)..." isearch-backward-regexp] + ["%_6 Replace (Regexp)..." query-replace-regexp] + + ,@(when (featurep 'mule) + '("----" + ("%_Multilingual (\"Mule\")" + ("%_Describe Language Support") + ("%_Set Language Environment") "--" - ["Toggle input method" toggle-input-method] - ["Select input method" set-input-method] - ["Describe input method" describe-input-method] + ["T%_oggle Input Method" toggle-input-method] + ["Select %_Input Method" set-input-method] + ["D%_escribe Input Method" describe-input-method] "--" - ["Describe current coding systems" + ["Describe Current %_Coding Systems" describe-current-coding-system] - ["Set coding system of buffer file" + ["Set Coding System of %_Buffer File..." set-buffer-file-coding-system] ;; not implemented yet - ["Set coding system of terminal" + ["Set Coding System of %_Terminal..." set-terminal-coding-system :active nil] ;; not implemented yet - ["Set coding system of keyboard" + ["Set Coding System of %_Keyboard..." set-keyboard-coding-system :active nil] - ["Set coding system of process" + ["Set Coding System of %_Process..." set-buffer-process-coding-system :active (get-buffer-process (current-buffer))] "--" - ["Show character table" view-charset-by-menu] + ["Show Cha%_racter Table" view-charset-by-menu] ;; not implemented yet - ["Show diagnosis for MULE" mule-diag :active nil] - ["Show many languages" view-hello-file]))) - - ("Apps" - ["Read Mail (VM)..." vm - :active (fboundp 'vm)] - ["Read Mail (MH)..." (mh-rmail t) - :active (fboundp 'mh-rmail)] - ["Send mail..." compose-mail - :active (fboundp 'compose-mail)] - ["Usenet News" gnus - :active (fboundp 'gnus)] - ["Browse the Web" w3 - :active (fboundp 'w3)] + ["Show Dia%_gnosis for MULE" mule-diag :active nil] + ["Show \"%_hello\" in Many Languages" view-hello-file])) + ) + ) + + ("%_View" + ["%_New Frame" make-frame] + ["Frame on Other Displa%_y..." make-frame-on-display] + ["%_Delete Frame" delete-frame + :active (not (eq (next-frame (selected-frame) 'nomini 'window-system) + (selected-frame)))] + "-----" + ["%_Split Window" split-window-vertically] + ["S%_plit Window (Side by Side)" split-window-horizontally] + ["%_Un-Split (Keep This)" delete-other-windows + :active (not (one-window-p t))] + ["Un-Split (Keep %_Others)" delete-window + :active (not (one-window-p t))] + "----" + ("N%_arrow" + ["%_Narrow to Region" narrow-to-region :active (region-exists-p)] + ["Narrow to %_Page" narrow-to-page] + ["Narrow to %_Defun" narrow-to-defun] + "----" + ["%_Widen" widen :active (or (/= (point-min) 1) + (/= (point-max) (1+ (buffer-size))))] + ) + "----" + ["Show Message %_Log" show-message-log] + "----" + ["%_Goto Line..." goto-line] + ["%_What Line" what-line] + ("%_Bookmarks" + :filter bookmark-menu-filter) + "----" + ["%_Jump to Previous Mark" (set-mark-command t) + :active (mark t)] + ) + + ("C%_mds" + ["Repeat %_Last Complex Command..." repeat-complex-command] + ["E%_valuate Lisp Expression..." eval-expression] + ["Execute %_Named Command..." execute-extended-command] "----" - ["Spell-Check Buffer" ispell-buffer - :active (fboundp 'ispell-buffer)] - ["Toggle VI emulation" toggle-viper-mode - :active (fboundp 'toggle-viper-mode)] + ["Start %_Macro Recording" start-kbd-macro + :included (not defining-kbd-macro)] + ["End %_Macro Recording" end-kbd-macro + :included defining-kbd-macro] + ["E%_xecute Last Macro" call-last-kbd-macro + :active last-kbd-macro] + ("%_Other Macro" + ["%_Append to Last Macro" (start-kbd-macro t) + :active (and (not defining-kbd-macro) last-kbd-macro)] + ["%_Query User During Macro" kbd-macro-query + :active defining-kbd-macro] + ["Enter %_Recursive Edit During Macro" (kbd-macro-query t) + :active defining-kbd-macro] + "---" + ["E%_xecute Last Macro on Region Lines" + :active (and last-kbd-macro (region-exists-p))] + "---" + ["%_Name Last Macro..." name-last-kbd-macro + :active last-kbd-macro] + ["Assign Last Macro to %_Key..." assign-last-kbd-macro-to-key + :active (and last-kbd-macro + (fboundp 'assign-last-kbd-macro-to-key))] + "---" + ["%_Edit Macro..." edit-kbd-macro] + ["Edit %_Last Macro" edit-last-kbd-macro + :active last-kbd-macro] + "---" + ["%_Insert Named Macro into Buffer..." insert-kbd-macro] + ["Read Macro from Re%_gion" read-kbd-macro + :active (region-exists-p)] + ) "----" - ("Calendar" - ["3-Month Calendar" calendar + ("%_Abbrev" + ["D%_ynamic Abbrev Expand" dabbrev-expand] + ["Dynamic Abbrev %_Complete" dabbrev-completion] + ["Dynamic Abbrev Complete in %_All Buffers" (dabbrev-completion 16)] + "----" + "----" + ["%_Define Global Abbrev for " add-global-abbrev + :suffix (abbrev-string-to-be-defined nil) + :active abbrev-mode] + ["Define %_Mode-Specific Abbrev for " add-mode-abbrev + :suffix (abbrev-string-to-be-defined nil) + :active abbrev-mode] + ["Define Global Ex%_pansion for " inverse-add-global-abbrev + :suffix (inverse-abbrev-string-to-be-defined 1) + :active abbrev-mode] + ["Define Mode-Specific Expa%_nsion for " inverse-add-mode-abbrev + :suffix (inverse-abbrev-string-to-be-defined 1) + :active abbrev-mode] + "---" + ["E%_xpand Abbrev" expand-abbrev] + ["Expand Abbrevs in Re%_gion" expand-region-abbrevs + :active (region-exists-p)] + ["%_Unexpand Last Abbrev" unexpand-abbrev + :active (and (stringp last-abbrev-text) + (> last-abbrev-location 0))] + "---" + ["%_Kill All Abbrevs" kill-all-abbrevs] + ["%_Insert All Abbrevs into Buffer" insert-abbrevs] + ["%_List Abbrevs" list-abbrevs] + "---" + ["%_Edit Abbrevs" edit-abbrevs] + ["%_Redefine Abbrevs from Buffer" edit-abbrevs-redefine + :active (eq major-mode 'edit-abbrevs-mode)] + "---" + ["%_Save Abbrevs As..." write-abbrev-file] + ["L%_oad Abbrevs..." read-abbrev-file] + ) + ("%_Register" + ["%_Copy to Register..." copy-to-register :active (region-exists-p)] + ["%_Paste Register..." insert-register] + "---" + ["%_Save Point to Register" point-to-register] + ["%_Jump to Register" register-to-point] + ) + ("R%_ectangles" + ["%_Kill Rectangle" kill-rectangle] + ["%_Yank Rectangle" yank-rectangle] + ["Rectangle %_to Register" copy-rectangle-to-register] + ["Rectangle %_from Register" insert-register] + ["%_Clear Rectangle" clear-rectangle] + ["%_Open Rectangle" open-rectangle] + ["%_Prefix Rectangle..." string-rectangle] + ["Rectangle %_Mousing" + (customize-set-variable + mouse-track-rectangle-p (not mouse-track-rectangle-p)) + :style toggle :selected mouse-track-rectangle-p] + ) + ("%_Sort" + ["%_Lines" sort-lines :active (region-exists-p)] + ["%_Paragraphs" sort-paragraphs :active (region-exists-p)] + ["P%_ages" sort-pages :active (region-exists-p)] + ["%_Columns" sort-columns :active (region-exists-p)] + ["%_Regexp..." sort-regexp-fields :active (region-exists-p)] + ) + ("%_Center" + ["%_Line" center-line] + ["%_Paragraph" center-paragraph] + ["%_Region" center-region :active (region-exists-p)] + ) + ("%_Indent" + ["%_As Previous Line" indent-relative] + ["%_To Column..." indent-to-column] + "---" + ["%_Region" indent-region :active (region-exists-p)] + ["%_Balanced Expression" indent-sexp] + ["%_C Expression" indent-c-exp] + ) + ("S%_pell-Check" + ["%_Buffer" ispell-buffer + :active (fboundp 'ispell-buffer)] + "---" + ["%_Word" ispell-word] + ["%_Complete Word" ispell-complete-word] + ["%_Region" ispell-region] + ) + ) + + ("%_Tools" + ("%_Internet" + ["Read Mail %_1 (VM)..." vm + :active (fboundp 'vm)] + ["Read Mail %_2 (MH)..." (mh-rmail t) + :active (fboundp 'mh-rmail)] + ["Send %_Mail..." compose-mail + :active (fboundp 'compose-mail)] + ["Usenet %_News" gnus + :active (fboundp 'gnus)] + ["Browse the %_Web" w3 + :active (fboundp 'w3)]) + "---" + ("%_Grep" + :filter + (lambda (menu) + (if (or (not (boundp 'grep-history)) (null grep-history)) + menu + (let ((items + (submenu-generate-accelerator-spec + (mapcar #'(lambda (string) + (vector string + (list 'grep string))) + (menu-truncate-list grep-history 10))))) + (append menu '("---") items)))) + ["%_Grep..." grep :active (fboundp 'grep)] + ["%_Repeat Grep" recompile :active (fboundp 'recompile)] + ["%_Kill Grep" kill-compilation + :active (and (fboundp 'kill-compilation) + (fboundp 'compilation-find-buffer) + (let ((buffer (condition-case nil + (compilation-find-buffer) + (error nil)))) + (and buffer (get-buffer-process buffer))))] + "---" + ["Grep %_All Files in Current Directory..." + (progn + (require 'compile) + (let ((grep-command + (cons (concat grep-command " *") (length grep-command)))) + (call-interactively 'grep))) + :active (fboundp 'grep)] + ["Grep %_C Files in Current Directory..." + (progn + (require 'compile) + (let ((grep-command + (cons (concat grep-command " *.[ch]") (length grep-command)))) + (call-interactively 'grep))) + :active (fboundp 'grep)] + ["Grep %_E-Lisp Files in Current Directory..." + (progn + (require 'compile) + (let ((grep-command + (cons (concat grep-command " *.el") (length grep-command)))) + (call-interactively 'grep))) + :active (fboundp 'grep)] + "---" + ["%_Next Match" next-error + :active (and (fboundp 'compilation-errors-exist-p) + (compilation-errors-exist-p))] + ["%_Previous Match" previous-error + :active (and (fboundp 'compilation-errors-exist-p) + (compilation-errors-exist-p))] + ["%_First Match" first-error + :active (and (fboundp 'compilation-errors-exist-p) + (compilation-errors-exist-p))] + ["G%_oto Match" compile-goto-error + :active (and (fboundp 'compilation-errors-exist-p) + (compilation-errors-exist-p))] + "---" + ["%_Set Grep Command..." + (progn + (require 'compile) + (customize-set-variable + 'grep-command + (read-shell-command "Default Grep Command: " grep-command))) + :active (fboundp 'grep) + ] + ) + ("%_Compile" + :filter + (lambda (menu) + (if (or (not (boundp 'compile-history)) (null compile-history)) + menu + (let ((items + (submenu-generate-accelerator-spec + (mapcar #'(lambda (string) + (vector string + (list 'compile string))) + (menu-truncate-list compile-history 10))))) + (append menu '("---") items)))) + ["%_Compile..." compile :active (fboundp 'compile)] + ["%_Repeat Compilation" recompile :active (fboundp 'recompile)] + ["%_Kill Compilation" kill-compilation + :active (and (fboundp 'kill-compilation) + (fboundp 'compilation-find-buffer) + (let ((buffer (condition-case nil + (compilation-find-buffer) + (error nil)))) + (and buffer (get-buffer-process buffer))))] + "---" + ["%_Next Error" next-error + :active (and (fboundp 'compilation-errors-exist-p) + (compilation-errors-exist-p))] + ["%_Previous Error" previous-error + :active (and (fboundp 'compilation-errors-exist-p) + (compilation-errors-exist-p))] + ["%_First Error" first-error + :active (and (fboundp 'compilation-errors-exist-p) + (compilation-errors-exist-p))] + ["G%_oto Error" compile-goto-error + :active (and (fboundp 'compilation-errors-exist-p) + (compilation-errors-exist-p))] + ) + ("%_Debug" + ["%_GDB..." gdb + :active (fboundp 'gdb)] + ["%_DBX..." dbx + :active (fboundp 'dbx)]) + ("%_Shell" + ["%_Shell" shell + :active (fboundp 'shell)] + ["S%_hell Command..." shell-command + :active (fboundp 'shell-command)] + ["Shell Command on %_Region..." shell-command-on-region + :active (and (fboundp 'shell-command-on-region) (region-exists-p))]) + + ("%_Tags" + ["%_Find Tag..." find-tag] + ["Find %_Other Window..." find-tag-other-window] + ["%_Next Tag..." (find-tag nil)] + ["N%_ext Other Window..." (find-tag-other-window nil)] + ["Next %_File" next-file] + "-----" + ["Tags %_Search..." tags-search] + ["Tags %_Replace..." tags-query-replace] + ["%_Continue Search/Replace" tags-loop-continue] + "-----" + ["%_Pop stack" pop-tag-mark] + ["%_Apropos..." tags-apropos] + "-----" + ["%_Set Tags Table File..." visit-tags-table] + ) + + "----" + + ("Ca%_lendar" + ["%_3-Month Calendar" calendar :active (fboundp 'calendar)] - ["Diary" diary + ["%_Diary" diary :active (fboundp 'diary)] - ["Holidays" holidays + ["%_Holidays" holidays :active (fboundp 'holidays)] ;; we're all pagans at heart ... - ["Phases of the Moon" phases-of-moon + ["%_Phases of the Moon" phases-of-moon :active (fboundp 'phases-of-moon)] - ["Sunrise/Sunset" sunrise-sunset + ["%_Sunrise/Sunset" sunrise-sunset :active (fboundp 'sunrise-sunset)]) - ("Games" - ["Mine Game" xmine + ("Ga%_mes" + ["%_Mine Game" xmine :active (fboundp 'xmine)] - ["Tetris" tetris + ["%_Tetris" tetris :active (fboundp 'tetris)] - ["Sokoban" sokoban + ["%_Sokoban" sokoban :active (fboundp 'sokoban)] - ["Quote from Zippy" yow + ["Quote from %_Zippy" yow :active (fboundp 'yow)] - ["Psychoanalyst" doctor + ["%_Psychoanalyst" doctor :active (fboundp 'doctor)] - ["Psychoanalyze Zippy!" psychoanalyze-pinhead + ["Ps%_ychoanalyze Zippy!" psychoanalyze-pinhead :active (fboundp 'psychoanalyze-pinhead)] - ["Random Flames" flame + ["%_Random Flames" flame :active (fboundp 'flame)] - ["Dunnet (Adventure)" dunnet + ["%_Dunnet (Adventure)" dunnet :active (fboundp 'dunnet)] - ["Towers of Hanoi" hanoi + ["Towers of %_Hanoi" hanoi :active (fboundp 'hanoi)] - ["Game of Life" life + ["Game of %_Life" life :active (fboundp 'life)] - ["Multiplication Puzzle" mpuz - :active (fboundp 'mpuz)])) - - ("Options" - ("Customize" - ("Emacs" :filter (lambda (&rest junk) - (cdr (custom-menu-create 'emacs)))) - ["Group..." customize-group] - ["Variable..." customize-variable] - ["Face..." customize-face] - ["Saved..." customize-saved] - ["Set..." customize-customized] - ["Apropos..." customize-apropos] - ["Browse..." customize-browse]) - - ("Manage Packages" - ("Add Download Site" + ["M%_ultiplication Puzzle" mpuz + :active (fboundp 'mpuz)]) + + "----" + ) + + ("%_Options" + ("%_Advanced (Customize)" + ("%_Emacs" :filter (lambda (&rest junk) + (cdr (custom-menu-create 'emacs)))) + ["%_Group..." customize-group] + ["%_Variable..." customize-variable] + ["%_Face..." customize-face] + ["%_Saved..." customize-saved] + ["Se%_t..." customize-customized] + ["%_Apropos..." customize-apropos] + ["%_Browse..." customize-browse]) + ("Manage %_Packages" + ("%_Add Download Site" :filter (lambda (&rest junk) - (package-get-download-menu))) - ["Update Package Index" package-get-update-base] - ["List & Install" pui-list-packages] - ["Update Installed Packages" package-get-update-all] + (submenu-generate-accelerator-spec + (package-get-download-menu)))) + ["%_Update Package Index" package-get-update-base] + ["%_List and Install" pui-list-packages] + ["U%_pdate Installed Packages" package-get-update-all] ;; hack-o-matic, we can't force a load of package-base here ;; since it triggers dialog box interactions which we can't ;; deal with while using a menu - ("Using Custom" + ("Using %_Custom" :filter (lambda (&rest junk) (if package-get-base - (cdr (custom-menu-create 'packages)) - '(["Please load Package Index" (lamda (&rest junk) ()) nil])))) + (submenu-generate-accelerator-spec + (cdr (custom-menu-create 'packages))) + '(["Please load Package Index" + (lamda (&rest junk) ()) nil])))) - ["Help" (Info-goto-node "(xemacs)Packages")]) - + ["%_Help" (Info-goto-node "(xemacs)Packages")]) "---" - - ("Editing Options" - ["Overstrike" + ("%_Keyboard and Mouse" + ["%_Abbrev Mode" + (customize-set-variable 'abbrev-mode + (not (default-value 'abbrev-mode))) + :style toggle + :selected (default-value 'abbrev-mode)] + ["%_Delete Key Deletes Selection" + (customize-set-variable 'pending-delete-mode (not pending-delete-mode)) + :style toggle + :selected (and (boundp 'pending-delete-mode) pending-delete-mode) + :active (boundp 'pending-delete-mode)] + ["%_Yank/Kill Interact With Clipboard" + (if (eq interprogram-cut-function 'own-clipboard) + (progn + (customize-set-variable 'interprogram-cut-function nil) + (customize-set-variable 'interprogram-paste-function nil)) + (customize-set-variable 'interprogram-cut-function 'own-clipboard) + (customize-set-variable 'interprogram-paste-function 'get-clipboard)) + :style toggle + :selected (eq interprogram-cut-function 'own-clipboard)] + ["%_Overstrike" (progn (setq overwrite-mode (if overwrite-mode nil 'overwrite-mode-textual)) (customize-set-variable 'overwrite-mode overwrite-mode)) :style toggle :selected overwrite-mode] - ["Case Sensitive Search" + ("`%_kill-line' Behavior..." + ["Kill %_Whole Line" + (customize-set-variable 'kill-whole-line 'always) + :style radio :selected (eq kill-whole-line 'always)] + ["Kill to %_End of Line" + (customize-set-variable 'kill-whole-line nil) + :style radio :selected (eq kill-whole-line nil)] + ["Kill Whole Line at %_Beg, Otherwise to End" + (customize-set-variable 'kill-whole-line t) + :style radio :selected (eq kill-whole-line t)]) + ["Size for %_Block-Movement Commands..." + (customize-set-variable 'block-movement-size + (read-number "Block Movement Size: " + t block-movement-size))] + ["%_VI Emulation" + (progn + (toggle-viper-mode) + (customize-set-variable 'viper-mode viper-mode)) + :style toggle :selected (and (boundp 'viper-mode) viper-mode) + :active (fboundp 'toggle-viper-mode)] + ["Active Re%_gions" + (customize-set-variable 'zmacs-regions (not zmacs-regions)) + :style toggle :selected zmacs-regions] + "----" + ["%_Set Key..." global-set-key] + ["%_Unset Key..." global-unset-key] + "---" + ["%_Case Sensitive Search" (customize-set-variable 'case-fold-search (setq case-fold-search (not case-fold-search))) :style toggle :selected (not case-fold-search)] - ["Case Matching Replace" + ["Case Matching %_Replace" (customize-set-variable 'case-replace (not case-replace)) :style toggle :selected case-replace] - ["Auto Delete Selection" - (customize-set-variable 'pending-delete-mode (not pending-delete-mode)) - :style toggle - :selected (and (boundp 'pending-delete-mode) pending-delete-mode) - :active (boundp 'pending-delete-mode)] - ["Active Regions" - (customize-set-variable 'zmacs-regions (not zmacs-regions)) - :style toggle :selected zmacs-regions] - ["Mouse Paste At Text Cursor" - (customize-set-variable 'mouse-yank-at-point (not mouse-yank-at-point)) - :style toggle :selected mouse-yank-at-point] - ("Newline at end of file..." - ["Don't require" + "---" + ("%_Newline at End of File..." + ["%_Don't Require" (customize-set-variable 'require-final-newline nil) :style radio :selected (not require-final-newline)] - ["Require" + ["%_Require" (customize-set-variable 'require-final-newline t) :style radio :selected (eq require-final-newline t)] - ["Ask" + ["%_Ask" (customize-set-variable 'require-final-newline 'ask) :style radio :selected (and require-final-newline (not (eq require-final-newline t)))]) - ["Add Newline When Moving Past End" + ["Add Newline When Moving Past %_End" (customize-set-variable 'next-line-add-newlines (not next-line-add-newlines)) :style toggle :selected next-line-add-newlines] + "---" + ["%_Mouse Paste at Text Cursor" + (customize-set-variable 'mouse-yank-at-point (not mouse-yank-at-point)) + :style toggle :selected mouse-yank-at-point] + ["A%_void Text..." + (customize-set-variable 'mouse-avoidance-mode + (if mouse-avoidance-mode nil 'banish)) + :style toggle + :selected (and (boundp 'mouse-avoidance-mode) mouse-avoidance-mode) + :active (and (boundp 'mouse-avoidance-mode) + (device-on-window-system-p))] + ["%_Strokes Mode" + (customize-set-variable 'strokes-mode (not strokes-mode)) + :style toggle + :selected (and (boundp 'strokes-mode) strokes-mode) + :active (and (boundp 'strokes-mode) + (device-on-window-system-p))] ) - ("General Options" - ["Teach Extended Commands" + ("%_General" + ["This Buffer %_Read Only" (toggle-read-only) + :style toggle :selected buffer-read-only] + ["%_Teach Extended Commands" (customize-set-variable 'teach-extended-commands-p (not teach-extended-commands-p)) :style toggle :selected teach-extended-commands-p] - ["Debug On Error" + ["Debug on %_Error" (customize-set-variable 'debug-on-error (not debug-on-error)) :style toggle :selected debug-on-error] - ["Debug On Quit" + ["Debug on %_Quit" (customize-set-variable 'debug-on-quit (not debug-on-quit)) :style toggle :selected debug-on-quit] + ["Debug on %_Signal" + (customize-set-variable 'debug-on-signal (not debug-on-signal)) + :style toggle :selected debug-on-signal] ) - ("Printing Options" - ["Command-Line Switches for `lpr'/`lp'..." + + ("%_Printing" + ["Command-Line %_Switches for `lpr'/`lp'..." ;; better to directly open a customization buffer, since the value ;; must be a list of strings, which is somewhat complex to prompt for. (customize-variable 'lpr-switches) (boundp 'lpr-switches)] - ("Pretty-Print Paper Size" - ["Letter" + ("%_Pretty-Print Paper Size" + ["%_Letter" (customize-set-variable 'ps-paper-type 'letter) :style radio :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'letter)) :active (boundp 'ps-paper-type)] - ["Letter-small" + ["Lette%_r-Small" (customize-set-variable 'ps-paper-type 'letter-small) :style radio :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'letter-small)) :active (boundp 'ps-paper-type)] - ["Legal" + ["Le%_gal" (customize-set-variable 'ps-paper-type 'legal) :style radio :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'legal)) :active (boundp 'ps-paper-type)] - ["Statement" + ["%_Statement" (customize-set-variable 'ps-paper-type 'statement) :style radio :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'statement)) :active (boundp 'ps-paper-type)] - ["Executive" + ["%_Executive" (customize-set-variable 'ps-paper-type 'executive) :style radio :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'executive)) :active (boundp 'ps-paper-type)] - ["Tabloid" + ["%_Tabloid" (customize-set-variable 'ps-paper-type 'tabloid) :style radio :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'tabloid)) :active (boundp 'ps-paper-type)] - ["Ledger" + ["Le%_dger" (customize-set-variable 'ps-paper-type 'ledger) :style radio :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'ledger)) :active (boundp 'ps-paper-type)] - ["A3" + ["A%_3" (customize-set-variable 'ps-paper-type 'a3) :style radio :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a3)) :active (boundp 'ps-paper-type)] - ["A4" + ["%_A4" (customize-set-variable 'ps-paper-type 'a4) :style radio :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a4)) :active (boundp 'ps-paper-type)] - ["A4small" + ["A4s%_mall" (customize-set-variable 'ps-paper-type 'a4small) :style radio :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a4small)) :active (boundp 'ps-paper-type)] - ["B4" + ["B%_4" (customize-set-variable 'ps-paper-type 'b4) :style radio :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'b4)) :active (boundp 'ps-paper-type)] - ["B5" + ["%_B5" (customize-set-variable 'ps-paper-type 'b5) :style radio :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'b5)) :active (boundp 'ps-paper-type)] ) - ["Color Printing" + ["%_Color Printing" (cond (ps-print-color-p (customize-set-variable 'ps-print-color-p nil) ;; I'm wondering whether all this muck is useful. @@ -387,208 +783,111 @@ :style toggle :selected (and (boundp 'ps-print-color-p) ps-print-color-p) :active (boundp 'ps-print-color-p)]) - ("\"Other Window\" Location" - ["Always in Same Frame" + ("%_Internet" + ("%_Compose Mail With" + ["Default Emacs Mailer" + (customize-set-variable 'mail-user-agent 'sendmail-user-agent) + :style radio + :selected (eq mail-user-agent 'sendmail-user-agent)] + ["MH" + (customize-set-variable 'mail-user-agent 'mh-e-user-agent) + :style radio + :selected (eq mail-user-agent 'mh-e-user-agent) + :active (get 'mh-e-user-agent 'composefunc)] + ["GNUS" + (customize-set-variable 'mail-user-agent 'message-user-agent) + :style radio + :selected (eq mail-user-agent 'message-user-agent) + :active (get 'message-user-agent 'composefunc)] + ) + ["Set My %_Email Address..." (customize-set-variable - 'get-frame-for-buffer-default-instance-limit nil) - :style radio - :selected (null get-frame-for-buffer-default-instance-limit)] - ["Other Frame (2 Frames Max)" - (customize-set-variable 'get-frame-for-buffer-default-instance-limit 2) - :style radio - :selected (eq 2 get-frame-for-buffer-default-instance-limit)] - ["Other Frame (3 Frames Max)" - (customize-set-variable 'get-frame-for-buffer-default-instance-limit 3) - :style radio - :selected (eq 3 get-frame-for-buffer-default-instance-limit)] - ["Other Frame (4 Frames Max)" - (customize-set-variable 'get-frame-for-buffer-default-instance-limit 4) - :style radio - :selected (eq 4 get-frame-for-buffer-default-instance-limit)] - ["Other Frame (5 Frames Max)" - (customize-set-variable 'get-frame-for-buffer-default-instance-limit 5) - :style radio - :selected (eq 5 get-frame-for-buffer-default-instance-limit)] - ["Always Create New Frame" - (customize-set-variable 'get-frame-for-buffer-default-instance-limit 0) - :style radio - :selected (eq 0 get-frame-for-buffer-default-instance-limit)] - "-----" - ["Temp Buffers Always in Same Frame" - (customize-set-variable 'temp-buffer-show-function - 'show-temp-buffer-in-current-frame) - :style radio - :selected (eq temp-buffer-show-function - 'show-temp-buffer-in-current-frame)] - ["Temp Buffers Like Other Buffers" - (customize-set-variable 'temp-buffer-show-function nil) - :style radio - :selected (null temp-buffer-show-function)] - "-----" - ["Make current frame gnuserv target" - (customize-set-variable 'gnuserv-frame (if (eq gnuserv-frame t) nil t)) - :style toggle - :selected (and (boundp 'gnuserv-frame) (eq gnuserv-frame t)) - :active (boundp 'gnuserv-frame)] - ) - "-----" - ("Syntax Highlighting" - ["In This Buffer" - (progn ;; becomes buffer local - (font-lock-mode) - (customize-set-variable 'font-lock-mode font-lock-mode)) - :style toggle - :selected (and (boundp 'font-lock-mode) font-lock-mode) - :active (boundp 'font-lock-mode)] - ["Automatic" - (customize-set-variable 'font-lock-auto-fontify - (not font-lock-auto-fontify)) - :style toggle - :selected (and (boundp 'font-lock-auto-fontify) font-lock-auto-fontify) - :active (fboundp 'font-lock-mode)] - "-----" - ["Fonts" - (progn - (require 'font-lock) - (font-lock-use-default-fonts) - (customize-set-variable 'font-lock-use-fonts t) - (customize-set-variable 'font-lock-use-colors nil) - (font-lock-mode 1)) - :style radio - :selected (and (boundp 'font-lock-use-fonts) font-lock-use-fonts) - :active (fboundp 'font-lock-mode)] - ["Colors" - (progn - (require 'font-lock) - (font-lock-use-default-colors) - (customize-set-variable 'font-lock-use-colors t) - (customize-set-variable 'font-lock-use-fonts nil) - (font-lock-mode 1)) - :style radio - :selected (and (boundp 'font-lock-use-colors) font-lock-use-colors) - :active (boundp 'font-lock-mode)] - "-----" - ["Least" - (progn - (require 'font-lock) - (if (or (and (not (integerp font-lock-maximum-decoration)) - (not (eq t font-lock-maximum-decoration))) - (and (integerp font-lock-maximum-decoration) - (<= font-lock-maximum-decoration 0))) - nil - (customize-set-variable 'font-lock-maximum-decoration nil) - (font-lock-recompute-variables))) - :style radio - :active (fboundp 'font-lock-mode) - :selected (and (boundp 'font-lock-maximium-decoration) - (or (and (not (integerp font-lock-maximum-decoration)) - (not (eq t font-lock-maximum-decoration))) - (and (integerp font-lock-maximum-decoration) - (<= font-lock-maximum-decoration 0))))] - ["More" - (progn - (require 'font-lock) - (if (and (integerp font-lock-maximum-decoration) - (= 1 font-lock-maximum-decoration)) - nil - (customize-set-variable 'font-lock-maximum-decoration 1) - (font-lock-recompute-variables))) - :style radio - :active (fboundp 'font-lock-mode) - :selected (and (boundp 'font-lock-maximium-decoration) - (integerp font-lock-maximum-decoration) - (= 1 font-lock-maximum-decoration))] - ["Even More" - (progn - (require 'font-lock) - (if (and (integerp font-lock-maximum-decoration) - (= 2 font-lock-maximum-decoration)) - nil - (customize-set-variable 'font-lock-maximum-decoration 2) - (font-lock-recompute-variables))) - :style radio - :active (fboundp 'font-lock-mode) - :selected (and (boundp 'font-lock-maximum-decoration) - (integerp font-lock-maximum-decoration) - (= 2 font-lock-maximum-decoration))] - ["Most" - (progn - (require 'font-lock) - (if (or (eq font-lock-maximum-decoration t) - (and (integerp font-lock-maximum-decoration) - (>= font-lock-maximum-decoration 3))) - nil - (customize-set-variable 'font-lock-maximum-decoration t) - (font-lock-recompute-variables))) - :style radio - :active (fboundp 'font-lock-mode) - :selected (and (boundp 'font-lock-maximum-decoration) - (or (eq font-lock-maximum-decoration t) - (and (integerp font-lock-maximum-decoration) - (>= font-lock-maximum-decoration 3))))] - "-----" - ["Lazy" - (progn ;; becomes buffer local - (lazy-shot-mode) - (customize-set-variable 'lazy-shot-mode lazy-shot-mode) - ;; this shouldn't be necessary so there has to - ;; be a redisplay bug lurking somewhere (or - ;; possibly another event handler bug) - (redraw-modeline)) - :active (and (boundp 'font-lock-mode) (boundp 'lazy-shot-mode) - font-lock-mode) - :style toggle - :selected (and (boundp 'lazy-shot-mode) lazy-shot-mode)] - ["Caching" - (progn ;; becomes buffer local - (fast-lock-mode) - (customize-set-variable 'fast-lock-mode fast-lock-mode) - ;; this shouldn't be necessary so there has to - ;; be a redisplay bug lurking somewhere (or - ;; possibly another event handler bug) - (redraw-modeline)) - :active (and (boundp 'font-lock-mode) (boundp 'fast-lock-mode) - font-lock-mode) - :style toggle - :selected (and (boundp 'fast-lock-mode) fast-lock-mode)] - ) - ("Paren Highlighting" - ["None" - (customize-set-variable 'paren-mode nil) - :style radio - :selected (and (boundp 'paren-mode) (not paren-mode)) - :active (boundp 'paren-mode)] - ["Blinking Paren" - (customize-set-variable 'paren-mode 'blink-paren) - :style radio - :selected (and (boundp 'paren-mode) (eq paren-mode 'blink-paren)) - :active (boundp 'paren-mode)] - ["Steady Paren" - (customize-set-variable 'paren-mode 'paren) - :style radio - :selected (and (boundp 'paren-mode) (eq paren-mode 'paren)) - :active (boundp 'paren-mode)] - ["Expression" - (customize-set-variable 'paren-mode 'sexp) - :style radio - :selected (and (boundp 'paren-mode) (eq paren-mode 'sexp)) - :active (boundp 'paren-mode)] -;; ["Nested Shading" -;; (customize-set-variable 'paren-mode 'nested) -;; :style radio -;; :selected (and (boundp 'paren-mode) (eq paren-mode 'nested)) -;; :active (boundp 'paren-mode)] - ) + 'user-mail-address + (read-string "Set email address: " user-mail-address))] + ["Set %_Machine Email Name..." + (customize-set-variable + 'mail-host-address + (read-string "Set machine email name: " mail-host-address))] + "---" + ("%_Open URLs With" + ["%_Emacs-W3" + (customize-set-variable 'browse-url-browser-function 'browse-url-w3) + :style radio + :selected (and (boundp 'browse-url-browser-function) + (eq browse-url-browser-function 'browse-url-w3)) + :active (and (boundp 'browse-url-browser-function) + (fboundp 'browse-url-w3) + (fboundp 'w3-fetch))] + ["%_Netscape" + (customize-set-variable 'browse-url-browser-function + 'browse-url-netscape) + :style radio + :selected (and (boundp 'browse-url-browser-function) + (eq browse-url-browser-function 'browse-url-netscape)) + :active (and (boundp 'browse-url-browser-function) + (fboundp 'browse-url-netscape))] + ["%_Mosaic" + (customize-set-variable 'browse-url-browser-function + 'browse-url-mosaic) + :style radio + :selected (and (boundp 'browse-url-browser-function) + (eq browse-url-browser-function 'browse-url-mosaic)) + :active (and (boundp 'browse-url-browser-function) + (fboundp 'browse-url-mosaic))] + ["Mosaic (%_CCI)" + (customize-set-variable 'browse-url-browser-function 'browse-url-cci) + :style radio + :selected (and (boundp 'browse-url-browser-function) + (eq browse-url-browser-function 'browse-url-cci)) + :active (and (boundp 'browse-url-browser-function) + (fboundp 'browse-url-cci))] + ["%_IXI Mosaic" + (customize-set-variable 'browse-url-browser-function + 'browse-url-iximosaic) + :style radio + :selected (and (boundp 'browse-url-browser-function) + (eq browse-url-browser-function 'browse-url-iximosaic)) + :active (and (boundp 'browse-url-browser-function) + (fboundp 'browse-url-iximosaic))] + ["%_Lynx (xterm)" + (customize-set-variable 'browse-url-browser-function + 'browse-url-lynx-xterm) + :style radio + :selected (and (boundp 'browse-url-browser-function) + (eq browse-url-browser-function 'browse-url-lynx-xterm)) + :active (and (boundp 'browse-url-browser-function) + (fboundp 'browse-url-lynx-xterm))] + ["L%_ynx (xemacs)" + (customize-set-variable 'browse-url-browser-function + 'browse-url-lynx-emacs) + :style radio + :selected (and (boundp 'browse-url-browser-function) + (eq browse-url-browser-function 'browse-url-lynx-emacs)) + :active (and (boundp 'browse-url-browser-function) + (fboundp 'browse-url-lynx-emacs))] + ["%_Grail" + (customize-set-variable 'browse-url-browser-function + 'browse-url-grail) + :style radio + :selected (and (boundp 'browse-url-browser-function) + (eq browse-url-browser-function 'browse-url-grail)) + :active (and (boundp 'browse-url-browser-function) + (fboundp 'browse-url-grail))] + ["%_Kfm" + (customize-set-variable 'browse-url-browser-function + 'browse-url-kfm) + :style radio + :selected (and (boundp 'browse-url-browser-function) + (eq browse-url-browser-function 'browse-url-kfm)) + :active (and (boundp 'browse-url-browser-function) + (fboundp 'browse-url-kfm))] + )) + + "-----" - ("Frame Appearance" - ["Frame-Local Font Menu" - (customize-set-variable 'font-menu-this-frame-only-p - (not font-menu-this-frame-only-p)) - :style toggle - :selected (and (boundp 'font-menu-this-frame-only-p) - font-menu-this-frame-only-p)] + ("Display" ,@(if (featurep 'scrollbar) - '(["Scrollbars" + '(["%_Scrollbars" (customize-set-variable 'scrollbars-visible-p (not scrollbars-visible-p)) :style toggle @@ -599,62 +898,120 @@ ;; off through the Options menu. I would have uncommented this ;; source, but the code for saving options would not save the ;; modeline 3D-ness. Grrr. --hniksic -;; ["3D Modeline" -;; (progn -;; (if (zerop (specifier-instance modeline-shadow-thickness)) -;; (set-specifier modeline-shadow-thickness 2) -;; (set-specifier modeline-shadow-thickness 0)) -;; (redraw-modeline t)) -;; :style toggle -;; :selected (let ((thickness -;; (specifier-instance modeline-shadow-thickness))) -;; (and (integerp thickness) -;; (> thickness 0)))] - ["Truncate Lines" - (progn ;; becomes buffer-local + ;; ["%_3D Modeline" + ;; (progn + ;; (if (zerop (specifier-instance modeline-shadow-thickness)) + ;; (set-specifier modeline-shadow-thickness 2) + ;; (set-specifier modeline-shadow-thickness 0)) + ;; (redraw-modeline t)) + ;; :style toggle + ;; :selected (let ((thickness + ;; (specifier-instance modeline-shadow-thickness))) + ;; (and (integerp thickness) + ;; (> thickness 0)))] + ["%_Truncate Lines" + (progn;; becomes buffer-local (setq truncate-lines (not truncate-lines)) (customize-set-variable 'truncate-lines truncate-lines)) :style toggle :selected truncate-lines] - ["Blinking Cursor" + ["%_Blinking Cursor" (customize-set-variable 'blink-cursor-mode (not blink-cursor-mode)) :style toggle :selected (and (boundp 'blink-cursor-mode) blink-cursor-mode) :active (boundp 'blink-cursor-mode)] "-----" - ["Block cursor" + ["Bl%_ock Cursor" (progn (customize-set-variable 'bar-cursor nil) (force-cursor-redisplay)) :style radio :selected (null bar-cursor)] - ["Bar cursor (1 pixel)" + ["Bar Cursor (%_1 Pixel)" (progn (customize-set-variable 'bar-cursor t) (force-cursor-redisplay)) :style radio :selected (eq bar-cursor t)] - ["Bar cursor (2 pixels)" + ["Bar Cursor (%_2 Pixels)" (progn (customize-set-variable 'bar-cursor 2) (force-cursor-redisplay)) :style radio :selected (and bar-cursor (not (eq bar-cursor t)))] "------" - ["Line Numbers" + ["%_Line Numbers" (progn (customize-set-variable 'line-number-mode (not line-number-mode)) (redraw-modeline)) :style toggle :selected line-number-mode] - ["Column Numbers" + ["%_Column Numbers" (progn (customize-set-variable 'column-number-mode (not column-number-mode)) (redraw-modeline)) :style toggle :selected column-number-mode] - ) - ("Menubar Appearance" - ["Buffers Menu Length..." + + ("\"Other %_Window\" Location" + ["%_Always in Same Frame" + (customize-set-variable + 'get-frame-for-buffer-default-instance-limit nil) + :style radio + :selected (null get-frame-for-buffer-default-instance-limit)] + ["Other Frame (%_2 Frames Max)" + (customize-set-variable 'get-frame-for-buffer-default-instance-limit 2) + :style radio + :selected (eq 2 get-frame-for-buffer-default-instance-limit)] + ["Other Frame (%_3 Frames Max)" + (customize-set-variable 'get-frame-for-buffer-default-instance-limit 3) + :style radio + :selected (eq 3 get-frame-for-buffer-default-instance-limit)] + ["Other Frame (%_4 Frames Max)" + (customize-set-variable 'get-frame-for-buffer-default-instance-limit 4) + :style radio + :selected (eq 4 get-frame-for-buffer-default-instance-limit)] + ["Other Frame (%_5 Frames Max)" + (customize-set-variable 'get-frame-for-buffer-default-instance-limit 5) + :style radio + :selected (eq 5 get-frame-for-buffer-default-instance-limit)] + ["Always Create %_New Frame" + (customize-set-variable 'get-frame-for-buffer-default-instance-limit 0) + :style radio + :selected (eq 0 get-frame-for-buffer-default-instance-limit)] + "-----" + ["%_Temp Buffers Always in Same Frame" + (customize-set-variable 'temp-buffer-show-function + 'show-temp-buffer-in-current-frame) + :style radio + :selected (eq temp-buffer-show-function + 'show-temp-buffer-in-current-frame)] + ["Temp Buffers %_Like Other Buffers" + (customize-set-variable 'temp-buffer-show-function nil) + :style radio + :selected (null temp-buffer-show-function)] + "-----" + ["%_Make Current Frame Gnuserv Target" + (customize-set-variable 'gnuserv-frame (if (eq gnuserv-frame t) nil t)) + :style toggle + :selected (and (boundp 'gnuserv-frame) (eq gnuserv-frame t)) + :active (boundp 'gnuserv-frame)] + ) + ) + ("%_Menubars" + ["%_Frame-Local Font Menu" + (customize-set-variable 'font-menu-this-frame-only-p + (not font-menu-this-frame-only-p)) + :style toggle + :selected (and (boundp 'font-menu-this-frame-only-p) + font-menu-this-frame-only-p)] + ["%_Alt/Meta Selects Menu Items" + (if (eq menu-accelerator-enabled 'menu-force) + (customize-set-variable 'menu-accelerator-enabled nil) + (customize-set-variable 'menu-accelerator-enabled 'menu-force)) + :style toggle + :selected (eq menu-accelerator-enabled 'menu-force)] + "----" + ["Buffers Menu %_Length..." (customize-set-variable 'buffers-menu-max-size ;; would it be better to open a customization buffer ? @@ -662,19 +1019,34 @@ (read-number "Enter number of buffers to display (or 0 for unlimited): "))) (if (eq val 0) nil val)))] - ["Multi-Operation Buffers Sub-Menus" + ["%_Multi-Operation Buffers Sub-Menus" (customize-set-variable 'complex-buffers-menu-p (not complex-buffers-menu-p)) :style toggle :selected complex-buffers-menu-p] - ("Buffers Menu Sorting" - ["Most Recently Used" + ["S%_ubmenus for Buffer Groups" + (customize-set-variable 'buffers-menu-submenus-for-groups-p + (not buffers-menu-submenus-for-groups-p)) + :style toggle + :selected buffers-menu-submenus-for-groups-p] + ["%_Verbose Buffer Menu Entries" + (if (eq buffers-menu-format-buffer-line-function + 'slow-format-buffers-menu-line) + (customize-set-variable 'buffers-menu-format-buffer-line-function + 'format-buffers-menu-line) + (customize-set-variable 'buffers-menu-format-buffer-line-function + 'slow-format-buffers-menu-line)) + :style toggle + :selected (eq buffers-menu-format-buffer-line-function + 'slow-format-buffers-menu-line)] + ("Buffers Menu %_Sorting" + ["%_Most Recently Used" (progn (customize-set-variable 'buffers-menu-sort-function nil) (customize-set-variable 'buffers-menu-grouping-function nil)) :style radio :selected (null buffers-menu-sort-function)] - ["Alphabetically" + ["%_Alphabetically" (progn (customize-set-variable 'buffers-menu-sort-function 'sort-buffers-menu-alphabetically) @@ -682,7 +1054,7 @@ :style radio :selected (eq 'sort-buffers-menu-alphabetically buffers-menu-sort-function)] - ["By Major Mode, Then Alphabetically" + ["%_By Major Mode, Then Alphabetically" (progn (customize-set-variable 'buffers-menu-sort-function @@ -693,13 +1065,8 @@ :style radio :selected (eq 'sort-buffers-menu-by-mode-then-alphabetically buffers-menu-sort-function)]) - ["Submenus for Buffer Groups" - (customize-set-variable 'buffers-menu-submenus-for-groups-p - (not buffers-menu-submenus-for-groups-p)) - :style toggle - :selected buffers-menu-submenus-for-groups-p] "---" - ["Ignore Scaled Fonts" + ["%_Ignore Scaled Fonts" (customize-set-variable 'font-menu-ignore-scaled-fonts (not font-menu-ignore-scaled-fonts)) :style toggle @@ -707,298 +1074,341 @@ font-menu-ignore-scaled-fonts)] ) ,@(if (featurep 'toolbar) - '(("Toolbar Appearance" - ["Visible" + '(("%_Toolbars" + ["%_Visible" (customize-set-variable 'toolbar-visible-p (not toolbar-visible-p)) :style toggle :selected toolbar-visible-p] - ["Captioned" + ["%_Captioned" (customize-set-variable 'toolbar-captioned-p (not toolbar-captioned-p)) :style toggle :selected toolbar-captioned-p] - ("Default Location" - ["Top" + ("%_Default Location" + ["%_Top" (customize-set-variable 'default-toolbar-position 'top) :style radio :selected (eq default-toolbar-position 'top)] - ["Bottom" + ["%_Bottom" (customize-set-variable 'default-toolbar-position 'bottom) :style radio :selected (eq default-toolbar-position 'bottom)] - ["Left" + ["%_Left" (customize-set-variable 'default-toolbar-position 'left) :style radio :selected (eq default-toolbar-position 'left)] - ["Right" + ["%_Right" (customize-set-variable 'default-toolbar-position 'right) :style radio :selected (eq default-toolbar-position 'right)] ) ))) ,@(if (featurep 'gutter) - '(("Gutter Appearance" - ["Visible" - (customize-set-variable 'gutter-visible-p - (not gutter-visible-p)) + '(("G%_utters" + ["Buffers Tab %_Visible" + (customize-set-variable 'gutter-buffers-tab-visible-p + (not gutter-buffers-tab-visible-p)) :style toggle - :selected gutter-visible-p] - ("Default Location" - ["Top" + :selected gutter-buffers-tab-visible-p] + ("%_Default Location" + ["%_Top" (customize-set-variable 'default-gutter-position 'top) :style radio :selected (eq default-gutter-position 'top)] - ["Bottom" + ["%_Bottom" (customize-set-variable 'default-gutter-position 'bottom) :style radio :selected (eq default-gutter-position 'bottom)] - ["Left" + ["%_Left" (customize-set-variable 'default-gutter-position 'left) :style radio :selected (eq default-gutter-position 'left)] - ["Right" + ["%_Right" (customize-set-variable 'default-gutter-position 'right) :style radio :selected (eq default-gutter-position 'right)] ) ))) - ("Mouse" - ["Avoid Text..." - (customize-set-variable 'mouse-avoidance-mode - (if mouse-avoidance-mode nil 'banish)) + "-----" + ("S%_yntax Highlighting" + ["%_In This Buffer" + (progn;; becomes buffer local + (font-lock-mode) + (customize-set-variable 'font-lock-mode font-lock-mode)) :style toggle - :selected (and (boundp 'mouse-avoidance-mode) mouse-avoidance-mode) - :active (and (boundp 'mouse-avoidance-mode) - (device-on-window-system-p))] - ["strokes-mode" - (customize-set-variable 'strokes-mode (not strokes-mode)) + :selected (and (boundp 'font-lock-mode) font-lock-mode) + :active (boundp 'font-lock-mode)] + ["%_Automatic" + (customize-set-variable 'font-lock-auto-fontify + (not font-lock-auto-fontify)) :style toggle - :selected (and (boundp 'strokes-mode) strokes-mode) - :active (and (boundp 'strokes-mode) - (device-on-window-system-p))] - ) - ("Open URLs With" - ["Emacs-W3" - (customize-set-variable 'browse-url-browser-function 'browse-url-w3) + :selected (and (boundp 'font-lock-auto-fontify) font-lock-auto-fontify) + :active (fboundp 'font-lock-mode)] + "-----" + ["%_Fonts" + (progn + (require 'font-lock) + (font-lock-use-default-fonts) + (customize-set-variable 'font-lock-use-fonts t) + (customize-set-variable 'font-lock-use-colors nil) + (font-lock-mode 1)) :style radio - :selected (and (boundp 'browse-url-browser-function) - (eq browse-url-browser-function 'browse-url-w3)) - :active (and (boundp 'browse-url-browser-function) - (fboundp 'browse-url-w3) - (fboundp 'w3-fetch))] - ["Netscape" - (customize-set-variable 'browse-url-browser-function - 'browse-url-netscape) + :selected (and (boundp 'font-lock-use-fonts) font-lock-use-fonts) + :active (fboundp 'font-lock-mode)] + ["%_Colors" + (progn + (require 'font-lock) + (font-lock-use-default-colors) + (customize-set-variable 'font-lock-use-colors t) + (customize-set-variable 'font-lock-use-fonts nil) + (font-lock-mode 1)) :style radio - :selected (and (boundp 'browse-url-browser-function) - (eq browse-url-browser-function 'browse-url-netscape)) - :active (and (boundp 'browse-url-browser-function) - (fboundp 'browse-url-netscape))] - ["Mosaic" - (customize-set-variable 'browse-url-browser-function - 'browse-url-mosaic) + :selected (and (boundp 'font-lock-use-colors) font-lock-use-colors) + :active (boundp 'font-lock-mode)] + "-----" + ["%_Least" + (progn + (require 'font-lock) + (if (or (and (not (integerp font-lock-maximum-decoration)) + (not (eq t font-lock-maximum-decoration))) + (and (integerp font-lock-maximum-decoration) + (<= font-lock-maximum-decoration 0))) + nil + (customize-set-variable 'font-lock-maximum-decoration nil) + (font-lock-recompute-variables))) :style radio - :selected (and (boundp 'browse-url-browser-function) - (eq browse-url-browser-function 'browse-url-mosaic)) - :active (and (boundp 'browse-url-browser-function) - (fboundp 'browse-url-mosaic))] - ["Mosaic (CCI)" - (customize-set-variable 'browse-url-browser-function 'browse-url-cci) + :active (fboundp 'font-lock-mode) + :selected (and (boundp 'font-lock-maximium-decoration) + (or (and (not (integerp font-lock-maximum-decoration)) + (not (eq t font-lock-maximum-decoration))) + (and (integerp font-lock-maximum-decoration) + (<= font-lock-maximum-decoration 0))))] + ["M%_ore" + (progn + (require 'font-lock) + (if (and (integerp font-lock-maximum-decoration) + (= 1 font-lock-maximum-decoration)) + nil + (customize-set-variable 'font-lock-maximum-decoration 1) + (font-lock-recompute-variables))) :style radio - :selected (and (boundp 'browse-url-browser-function) - (eq browse-url-browser-function 'browse-url-cci)) - :active (and (boundp 'browse-url-browser-function) - (fboundp 'browse-url-cci))] - ["IXI Mosaic" - (customize-set-variable 'browse-url-browser-function - 'browse-url-iximosaic) + :active (fboundp 'font-lock-mode) + :selected (and (boundp 'font-lock-maximium-decoration) + (integerp font-lock-maximum-decoration) + (= 1 font-lock-maximum-decoration))] + ["%_Even More" + (progn + (require 'font-lock) + (if (and (integerp font-lock-maximum-decoration) + (= 2 font-lock-maximum-decoration)) + nil + (customize-set-variable 'font-lock-maximum-decoration 2) + (font-lock-recompute-variables))) :style radio - :selected (and (boundp 'browse-url-browser-function) - (eq browse-url-browser-function 'browse-url-iximosaic)) - :active (and (boundp 'browse-url-browser-function) - (fboundp 'browse-url-iximosaic))] - ["Lynx (xterm)" - (customize-set-variable 'browse-url-browser-function - 'browse-url-lynx-xterm) + :active (fboundp 'font-lock-mode) + :selected (and (boundp 'font-lock-maximum-decoration) + (integerp font-lock-maximum-decoration) + (= 2 font-lock-maximum-decoration))] + ["%_Most" + (progn + (require 'font-lock) + (if (or (eq font-lock-maximum-decoration t) + (and (integerp font-lock-maximum-decoration) + (>= font-lock-maximum-decoration 3))) + nil + (customize-set-variable 'font-lock-maximum-decoration t) + (font-lock-recompute-variables))) :style radio - :selected (and (boundp 'browse-url-browser-function) - (eq browse-url-browser-function 'browse-url-lynx-xterm)) - :active (and (boundp 'browse-url-browser-function) - (fboundp 'browse-url-lynx-xterm))] - ["Lynx (xemacs)" - (customize-set-variable 'browse-url-browser-function - 'browse-url-lynx-emacs) + :active (fboundp 'font-lock-mode) + :selected (and (boundp 'font-lock-maximum-decoration) + (or (eq font-lock-maximum-decoration t) + (and (integerp font-lock-maximum-decoration) + (>= font-lock-maximum-decoration 3))))] + "-----" + ["La%_zy" + (progn;; becomes buffer local + (lazy-shot-mode) + (customize-set-variable 'lazy-shot-mode lazy-shot-mode) + ;; this shouldn't be necessary so there has to + ;; be a redisplay bug lurking somewhere (or + ;; possibly another event handler bug) + (redraw-modeline)) + :active (and (boundp 'font-lock-mode) (boundp 'lazy-shot-mode) + font-lock-mode) + :style toggle + :selected (and (boundp 'lazy-shot-mode) lazy-shot-mode)] + ["Cac%_hing" + (progn;; becomes buffer local + (fast-lock-mode) + (customize-set-variable 'fast-lock-mode fast-lock-mode) + ;; this shouldn't be necessary so there has to + ;; be a redisplay bug lurking somewhere (or + ;; possibly another event handler bug) + (redraw-modeline)) + :active (and (boundp 'font-lock-mode) (boundp 'fast-lock-mode) + font-lock-mode) + :style toggle + :selected (and (boundp 'fast-lock-mode) fast-lock-mode)] + ) + ("Pa%_ren Highlighting" + ["%_None" + (customize-set-variable 'paren-mode nil) :style radio - :selected (and (boundp 'browse-url-browser-function) - (eq browse-url-browser-function 'browse-url-lynx-emacs)) - :active (and (boundp 'browse-url-browser-function) - (fboundp 'browse-url-lynx-emacs))] - ["Grail" - (customize-set-variable 'browse-url-browser-function - 'browse-url-grail) + :selected (and (boundp 'paren-mode) (not paren-mode)) + :active (boundp 'paren-mode)] + ["%_Blinking Paren" + (customize-set-variable 'paren-mode 'blink-paren) :style radio - :selected (and (boundp 'browse-url-browser-function) - (eq browse-url-browser-function 'browse-url-grail)) - :active (and (boundp 'browse-url-browser-function) - (fboundp 'browse-url-grail))] - ["Kfm" - (customize-set-variable 'browse-url-browser-function - 'browse-url-kfm) + :selected (and (boundp 'paren-mode) (eq paren-mode 'blink-paren)) + :active (boundp 'paren-mode)] + ["%_Steady Paren" + (customize-set-variable 'paren-mode 'paren) + :style radio + :selected (and (boundp 'paren-mode) (eq paren-mode 'paren)) + :active (boundp 'paren-mode)] + ["%_Expression" + (customize-set-variable 'paren-mode 'sexp) :style radio - :selected (and (boundp 'browse-url-browser-function) - (eq browse-url-browser-function 'browse-url-kfm)) - :active (and (boundp 'browse-url-browser-function) - (fboundp 'browse-url-kfm))] + :selected (and (boundp 'paren-mode) (eq paren-mode 'sexp)) + :active (boundp 'paren-mode)] + ;; ["Nes%_ted Shading" + ;; (customize-set-variable 'paren-mode 'nested) + ;; :style radio + ;; :selected (and (boundp 'paren-mode) (eq paren-mode 'nested)) + ;; :active (boundp 'paren-mode)] ) "-----" - ["Edit Faces..." (customize-face nil)] - ("Font" :filter font-menu-family-constructor) - ("Size" :filter font-menu-size-constructor) -; ("Weight" :filter font-menu-weight-constructor) + ["Edit Fa%_ces..." (customize-face nil)] + ("Fo%_nt" :filter font-menu-family-constructor) + ("Si%_ze" :filter font-menu-size-constructor) + ;; ("Weig%_ht" :filter font-menu-weight-constructor) "-----" - ["Save Options" customize-save-customized] + ["%_Edit Init (.emacs) File" + ;; #### there should be something that holds the name that the init + ;; file should be created as, when it's not present. + (progn (find-file (or user-init-file "~/.emacs")) + (emacs-lisp-mode))] + ["%_Save Options to .emacs File" customize-save-customized] ) - ("Buffers" + ("%_Buffers" :filter buffers-menu-filter - ["Read Only" (toggle-read-only) - :style toggle :selected buffer-read-only] - ["List All Buffers" list-buffers] - "--" + ["Go To %_Previous Buffer" switch-to-other-buffer] + ["Go To %_Buffer..." switch-to-buffer] + "----" + ["%_List All Buffers" list-buffers] + ["%_Delete Buffer" kill-this-buffer + :suffix (if put-buffer-names-in-file-menu (buffer-name) "")] + "----" ) - ("Tools" - ["Grep..." grep - :active (fboundp 'grep)] - ["Compile..." compile - :active (fboundp 'compile)] - ["Shell" shell - :active (fboundp 'shell)] - ["Shell Command..." shell-command - :active (fboundp 'shell-command)] - ["Shell Command on Region..." shell-command-on-region - :active (and (fboundp 'shell-command-on-region) (region-exists-p))] - ["Debug (GDB)..." gdb - :active (fboundp 'gdb)] - ["Debug (DBX)..." dbx - :active (fboundp 'dbx)] - "-----" - ("Tags" - ["Find Tag..." find-tag] - ["Find Other Window..." find-tag-other-window] - ["Next Tag..." (find-tag nil)] - ["Next Other Window..." (find-tag-other-window nil)] - ["Next File" next-file] - "-----" - ["Tags Search..." tags-search] - ["Tags Replace..." tags-query-replace] - ["Continue Search/Replace" tags-loop-continue] - "-----" - ["Pop stack" pop-tag-mark] - ["Apropos..." tags-apropos] - "-----" - ["Set Tags Table File..." visit-tags-table] - )) - - nil ; the partition: menus after this are flushright + nil ; the partition: menus after this are flushright - ("Help" - ["About XEmacs..." about-xemacs] - ("Basics" - ["Installation" describe-installation + ("%_Help" + ["%_About XEmacs..." about-xemacs] + ("%_Basics" + ["%_Installation" describe-installation :active (boundp 'Installation-string)] ;; Tutorials. ,(if (featurep 'mule) ;; Mule tutorials. - (let ((lang language-info-alist) + (let ((lang language-info-alist) (n 0) submenu tut) (while lang + (setq n (1+ n)) (and (setq tut (assq 'tutorial (car lang))) (not (string= (caar lang) "ASCII")) (setq submenu (cons - `[,(caar lang) (help-with-tutorial nil ,(cdr tut))] + `[,(concat (menu-item-generate-accelerator-spec n) + (caar lang)) + (help-with-tutorial nil ,(cdr tut))] submenu))) (setq lang (cdr lang))) - (append `("Tutorials" + (append `("%_Tutorials" :filter tutorials-menu-filter - ["Default" help-with-tutorial t + ["%_Default" help-with-tutorial t ,(concat "(" current-language-environment ")")]) submenu)) ;; Non mule tutorials. (let ((lang tutorial-supported-languages) + (n 0) submenu) (while lang + (setq n (1+ n)) (setq submenu (cons - `[,(caar lang) + `[,(concat (menu-item-generate-accelerator-spec n) + (caar lang)) (help-with-tutorial ,(format "TUTORIAL.%s" (cadr (car lang))))] submenu)) (setq lang (cdr lang))) - (append '("Tutorials" - ["English" help-with-tutorial]) + (append '("%_Tutorials" + ["%_English" help-with-tutorial]) submenu))) - ["News" view-emacs-news] - ["Packages" finder-by-keyword] - ["Splash" xemacs-splash-buffer]) + ["%_News" view-emacs-news] + ["%_Packages" finder-by-keyword] + ["%_Splash" xemacs-splash-buffer]) "-----" - ("XEmacs FAQ" - ["FAQ (local)" xemacs-local-faq] - ["FAQ via WWW" xemacs-www-faq (boundp 'browse-url-browser-function)] - ["Home Page" xemacs-www-page (boundp 'browse-url-browser-function)]) - ("Samples" - ["Sample .emacs" (find-file (locate-data-file "sample.emacs")) (locate-data-file "sample.emacs")] - ["Sample .Xdefaults" (find-file (locate-data-file "sample.Xdefaults")) (locate-data-file "sample.Xdefaults")] - ["Sample enriched" (find-file (locate-data-file "enriched.doc")) (locate-data-file "enriched.doc")]) + ("XEmacs %_FAQ" + ["%_FAQ (local)" xemacs-local-faq] + ["FAQ via %_WWW" xemacs-www-faq (boundp 'browse-url-browser-function)] + ["%_Home Page" xemacs-www-page (boundp 'browse-url-browser-function)]) + ("%_Samples" + ["Sample .%_emacs" (find-file (locate-data-file "sample.emacs")) (locate-data-file "sample.emacs")] + ["Sample .%_Xdefaults" (find-file (locate-data-file "sample.Xdefaults")) (locate-data-file "sample.Xdefaults")] + ["Sample e%_nriched" (find-file (locate-data-file "enriched.doc")) (locate-data-file "enriched.doc")]) "-----" - ("Lookup in Info" - ["Key Binding..." Info-goto-emacs-key-command-node] - ["Command..." Info-goto-emacs-command-node] - ["Function..." Info-elisp-ref] - ["Topic..." Info-query]) - ("Manuals" - ["Info" info] - ["Unix Manual..." manual-entry]) - ("Commands & Keys" - ["Mode" describe-mode] - ["Apropos..." hyper-apropos] - ["Apropos Docs..." apropos-documentation] + ("Lookup in %_Info" + ["%_Key Binding..." Info-goto-emacs-key-command-node] + ["%_Command..." Info-goto-emacs-command-node] + ["%_Function..." Info-elisp-ref] + ["%_Topic..." Info-query]) + ("%_Manuals" + ["%_Info" info] + ["%_Unix Manual..." manual-entry]) + ("%_Commands & Keys" + ["%_Mode" describe-mode] + ["%_Apropos..." hyper-apropos] + ["Apropos %_Docs..." apropos-documentation] "-----" - ["Key..." describe-key] - ["Bindings" describe-bindings] - ["Mouse Bindings" describe-pointer] - ["Recent Keys" view-lossage] + ["%_Key..." describe-key] + ["%_Bindings" describe-bindings] + ["%_Mouse Bindings" describe-pointer] + ["%_Recent Keys" view-lossage] "-----" - ["Function..." describe-function] - ["Variable..." describe-variable] - ["Locate Command..." where-is]) + ["%_Function..." describe-function] + ["%_Variable..." describe-variable] + ["%_Locate Command..." where-is]) "-----" - ["Recent Messages" view-lossage] - ("Misc" - ["No Warranty" describe-no-warranty] - ["XEmacs License" describe-copying] - ["The Latest Version" describe-distribution]) - ["Send Bug Report..." report-emacs-bug + ["%_Recent Messages" view-lossage] + ("%_Misc" + ["%_No Warranty" describe-no-warranty] + ["XEmacs %_License" describe-copying] + ["The Latest %_Version" describe-distribution]) + ["%_Send Bug Report..." report-emacs-bug :active (fboundp 'report-emacs-bug)])))) (defun maybe-add-init-button () "Don't call this. Adds `Load .emacs' button to menubar when starting up with -q." - ;; by Stig@hackvan.com - (cond - (load-user-init-file-p nil) - ((file-exists-p (expand-file-name ".emacs" "~")) - (add-menu-button nil - ["Load .emacs" - (progn (delete-menu-item '("Load .emacs")) - (load-user-init-file)) - ] - "Help")) - (t nil))) + (when (and (not load-user-init-file-p) + (file-exists-p (expand-file-name ".emacs" "~"))) + (add-menu-button + nil + ["%_Load .emacs" + (progn + (mapc #'(lambda (buf) + (with-current-buffer buf + (delete-menu-item '("Load .emacs")))) + (buffer-list)) + (load-user-init-file)) + ] + "Help"))) (add-hook 'before-init-hook 'maybe-add-init-button) @@ -1015,34 +1425,34 @@ Adds `Load .emacs' button to menubar when starting up with -q." bookmark-alist t))) `(,(if definedp - '("Jump to Bookmark" + '("%_Jump to Bookmark" :filter (lambda (&rest junk) (mapcar #'(lambda (bmk) `[,bmk (bookmark-jump ',bmk)]) (bookmark-all-names)))) - ["Jump to Bookmark" nil nil]) - ["Set bookmark" bookmark-set + ["%_Jump to Bookmark" nil nil]) + ["Set %_Bookmark" bookmark-set :active (fboundp 'bookmark-set)] "---" - ["Insert contents" bookmark-menu-insert + ["Insert %_Contents" bookmark-menu-insert :active (fboundp 'bookmark-menu-insert)] - ["Insert location" bookmark-menu-locate + ["Insert L%_ocation" bookmark-menu-locate :active (fboundp 'bookmark-menu-locate)] "---" - ["Rename bookmark" bookmark-menu-rename + ["%_Rename Bookmark" bookmark-menu-rename :active (fboundp 'bookmark-menu-rename)] ,(if definedp - '("Delete Bookmark" + '("%_Delete Bookmark" :filter (lambda (&rest junk) (mapcar #'(lambda (bmk) `[,bmk (bookmark-delete ',bmk)]) (bookmark-all-names)))) - ["Delete Bookmark" nil nil]) - ["Edit Bookmark List" bookmark-bmenu-list ,definedp] + ["%_Delete Bookmark" nil nil]) + ["%_Edit Bookmark List" bookmark-bmenu-list ,definedp] "---" - ["Save bookmarks" bookmark-save ,definedp] - ["Save bookmarks as..." bookmark-write ,definedp] - ["Load a bookmark file" bookmark-load + ["%_Save Bookmarks" bookmark-save ,definedp] + ["Save Bookmarks %_As..." bookmark-write ,definedp] + ["%_Load a Bookmark File" bookmark-load :active (fboundp 'bookmark-load)]))) ;;; The Buffers menu @@ -1051,6 +1461,8 @@ Adds `Load .emacs' button to menubar when starting up with -q." "Customization of `Buffers' menu." :group 'menu) +(defvar buffers-menu-omit-chars-list '(?b ?p ?l)) + (defcustom buffers-menu-max-size 25 "*Maximum number of entries which may appear on the \"Buffers\" menu. If this is 10, then only the ten most-recently-selected buffers will be @@ -1096,11 +1508,22 @@ begins with a space)." :group 'buffers-menu) (defcustom buffers-menu-format-buffer-line-function 'format-buffers-menu-line - "*The function to call to return a string to represent a buffer in the -buffers menu. The function is passed a buffer and should return a string. -The default value `format-buffers-menu-line' just returns the name of -the buffer. Also check out `slow-format-buffers-menu-line' which -returns a whole bunch of info about a buffer." + "*The function to call to return a string to represent a buffer in +the buffers menu. The function is passed a buffer and a number +(starting with 1) indicating which buffer line in the menu is being +processed and should return a string containing an accelerator +spec. (Check out `menu-item-generate-accelerator-spec' as a convenient +way of generating the accelerator specs.) The default value +`format-buffers-menu-line' just returns the name of the buffer and +uses the number as the accelerator. Also check out +`slow-format-buffers-menu-line' which returns a whole bunch of info +about a buffer. + +Note: Gross Compatibility Hack: Older versions of this function prototype +only expected one argument, not two. We deal gracefully with such +functions by simply calling them with one argument and leaving out the +line number. However, this may go away at any time, so make sure to +update all of your functions of this type." :type 'function :group 'buffers-menu) @@ -1131,11 +1554,6 @@ for `buffers-menu-sort-function'." function) :group 'buffers-menu) -(defun buffers-menu-omit-invisible-buffers (buf) - "For use as a value of `buffers-menu-omit-function'. -Omits normally invisible buffers (those whose name begins with a space)." - (not (null (string-match "\\` " (buffer-name buf))))) - (defun sort-buffers-menu-alphabetically (buf1 buf2) "For use as a value of `buffers-menu-sort-function'. Sorts the buffers in alphabetical order by name, but puts buffers beginning @@ -1178,21 +1596,25 @@ beginning with a star at the end of the list." (string-lessp nam1 nam2))))) ;; this version is too slow on some machines. -(defun slow-format-buffers-menu-line (buffer) +;; (vintage 1990, that is) +(defun slow-format-buffers-menu-line (buffer n) "For use as a value of `buffers-menu-format-buffer-line-function'. This returns a string containing a bunch of info about the buffer." - (format "%s%s %-19s %6s %-15s %s" - (if (buffer-modified-p buffer) "*" " ") - (if (symbol-value-in-buffer 'buffer-read-only buffer) "%" " ") - (buffer-name buffer) - (buffer-size buffer) - (symbol-value-in-buffer 'mode-name buffer) - (or (buffer-file-name buffer) ""))) - -(defun format-buffers-menu-line (buffer) + (concat (menu-item-generate-accelerator-spec n buffers-menu-omit-chars-list) + (format "%s%s %-19s %6s %-15s %s" + (if (buffer-modified-p buffer) "*" " ") + (if (symbol-value-in-buffer 'buffer-read-only buffer) + "%" " ") + (buffer-name buffer) + (buffer-size buffer) + (symbol-value-in-buffer 'mode-name buffer) + (or (buffer-file-name buffer) "")))) + +(defun format-buffers-menu-line (buffer n) "For use as a value of `buffers-menu-format-buffer-line-function'. This just returns the buffer's name." - (buffer-name buffer)) + (concat (menu-item-generate-accelerator-spec n buffers-menu-omit-chars-list) + (buffer-name buffer))) (defun group-buffers-menu-by-mode-then-alphabetically (buf1 buf2) "For use as a value of `buffers-menu-grouping-function'. @@ -1221,36 +1643,41 @@ This groups buffers by major mode. It only really makes sense if (buffer-name (current-buffer))))))) (defsubst build-buffers-menu-internal (buffers) - (let (name line) + (let (name line (n 0)) (mapcar #'(lambda (buffer) (if (eq buffer t) "---" - (setq line (funcall buffers-menu-format-buffer-line-function - buffer)) + (setq n (1+ n)) + (setq line + ; #### a truly Kyle-friendly hack. + (let ((fn buffers-menu-format-buffer-line-function)) + (if (= (function-max-args fn) 1) + (funcall fn buffer) + (funcall fn buffer n)))) (if complex-buffers-menu-p (delq nil (list line - (vector "Switch to Buffer" + (vector "S%_witch to Buffer" (list buffers-menu-switch-to-buffer-function (setq name (buffer-name buffer))) t) (if (eq buffers-menu-switch-to-buffer-function 'switch-to-buffer) - (vector "Switch to Buffer, Other Frame" + (vector "Switch to Buffer, Other %_Frame" (list 'switch-to-buffer-other-frame (setq name (buffer-name buffer))) t) nil) (if (and (buffer-modified-p buffer) (buffer-file-name buffer)) - (vector "Save Buffer" + (vector "%_Save Buffer" (list 'buffer-menu-save-buffer name) t) - ["Save Buffer" nil nil] + ["%_Save Buffer" nil nil] ) - (vector "Save As..." + (vector "Save %_As..." (list 'buffer-menu-write-file name) t) - (vector "Delete Buffer" (list 'kill-buffer name) + (vector "%_Delete Buffer" (list 'kill-buffer name) t))) ;; #### We don't want buffer names to be translated, ;; #### so we put the buffer name in the suffix. @@ -1323,10 +1750,13 @@ items by redefining the function `format-buffers-menu-line'." (defun language-environment-menu-filter (menu) "This is the menu filter for the \"Language Environment\" submenu." - (mapcar (lambda (env-sym) - `[ ,(capitalize (symbol-name env-sym)) - (set-language-environment ',env-sym)]) - language-environment-list)) + (let ((n 0)) + (mapcar (lambda (env-sym) + (setq n (1+ n)) + `[ ,(concat (menu-item-generate-accelerator-spec n) + (capitalize (symbol-name env-sym))) + (set-language-environment ',env-sym)]) + language-environment-list))) ;;; The Options menu @@ -1385,24 +1815,24 @@ If this is a relative filename, it is put into the same directory as your (defconst default-popup-menu '("XEmacs Commands" - ["Undo" advertised-undo + ["%_Undo" advertised-undo :active (and (not (eq buffer-undo-list t)) (or buffer-undo-list pending-undo-list)) :suffix (if (or (eq last-command 'undo) (eq last-command 'advertised-undo)) "More" "")] - ["Cut" kill-primary-selection + ["Cu%_t" kill-primary-selection :active (selection-owner-p)] - ["Copy" copy-primary-selection + ["%_Copy" copy-primary-selection :active (selection-owner-p)] - ["Paste" yank-clipboard-selection + ["%_Paste" yank-clipboard-selection :active (selection-exists-p 'CLIPBOARD)] - ["Clear" delete-primary-selection + ["%_Delete" delete-primary-selection :active (selection-owner-p)] "-----" - ["Select Block" mark-paragraph] - ["Split Window" split-window-vertically] - ["Unsplit Window" delete-other-windows] + ["Select %_Block" mark-paragraph] + ["Sp%_lit Window" split-window-vertically] + ["U%_nsplit Window" delete-other-windows] )) (defvar global-popup-menu nil @@ -1469,9 +1899,9 @@ The menu is computed by combining `global-popup-menu' and `mode-popup-menu'." (error "Pointer must be in a normal window")) (select-window window) (if current-menubar - (setq bmenu (assoc "Buffers" current-menubar))) + (setq bmenu (assoc "%_Buffers" current-menubar))) (if (null bmenu) - (setq bmenu (assoc "Buffers" default-menubar))) + (setq bmenu (assoc "%_Buffers" default-menubar))) (if (null bmenu) (error "Can't find the Buffers menu")) (popup-menu bmenu))) @@ -1486,12 +1916,12 @@ The menu is computed by combining `global-popup-menu' and `mode-popup-menu'." (error "Pointer must be in a normal window")) (select-window window) (and current-menubar (run-hooks 'activate-menubar-hook)) - ;; ##### Instead of having to copy this just to safely get rid of + ;; #### Instead of having to copy this just to safely get rid of ;; any nil what we should really do is fix up the internal menubar ;; code to just ignore nil if generating a popup menu (setq popup-menubar (delete nil (copy-sequence (or current-menubar default-menubar)))) - (popup-menu (cons "Menubar Menu" popup-menubar)) + (popup-menu (cons "%_Menubar Menu" popup-menubar)) )) (global-set-key 'button3 'popup-mode-menu) diff --git a/lisp/menubar.el b/lisp/menubar.el index a2f84d5..3b58c86 100644 --- a/lisp/menubar.el +++ b/lisp/menubar.el @@ -128,19 +128,6 @@ See `current-menubar' for a description of the syntax of a menubar." menuitem))) (setq plistp (or (>= L 5) (and (> L 2) (keywordp (aref menuitem 2))))) - (or (stringp (aref menuitem 0)) - (signal 'error - (list - "first element of a button must be a string (the label)" - menuitem))) - (or plistp - (< L 4) - (null (aref menuitem 3)) - (stringp (aref menuitem 3)) - (signal 'error - (list - "fourth element of a button must be a string (the label suffix)" - menuitem))) (if plistp (let ((i 2) selp diff --git a/lisp/minibuf.el b/lisp/minibuf.el index c997510..342f5bd 100644 --- a/lisp/minibuf.el +++ b/lisp/minibuf.el @@ -1,8 +1,8 @@ ;;; minibuf.el --- Minibuffer functions for XEmacs ;; Copyright (C) 1992, 1993, 1994, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Tinker Systems -;; Copyright (C) 1995, 1996 Ben Wing +;; Copyright (C) 1995 Tinker Systems. +;; Copyright (C) 1995, 1996, 2000 Ben Wing. ;; Author: Richard Mlynarik ;; Created: 2-Oct-92 @@ -111,8 +111,12 @@ minibuffer is reinvoked while it is the selected window." ;(defvar minibuffer-setup-hook nil ; "Normal hook run just after entry to minibuffer.") +;; see comment at list-mode-hook. +(put 'minibuffer-setup-hook 'permanent-local t) + (defvar minibuffer-exit-hook nil "Normal hook run just after exit from minibuffer.") +(put 'minibuffer-exit-hook 'permanent-local t) (defvar minibuffer-help-form nil "Value that `help-form' takes on inside the minibuffer.") @@ -608,7 +612,7 @@ See also the variable completion-highlight-first-word-only for control over ;; Used by minibuffer-do-completion -(defvar last-exact-completion) +(defvar last-exact-completion nil) (defun temp-minibuffer-message (m) (let ((savemax (point-max))) @@ -1446,7 +1450,10 @@ Prompts with PROMPT. By default, return DEFAULT-VALUE." Prompts with PROMPT. By default, return DEFAULT-VALUE. A user variable is one whose documentation starts with a `*' character." (intern (completing-read prompt obarray 'user-variable-p t nil - 'variable-history default-value))) + 'variable-history + (if (symbolp default-value) + (symbol-name default-value) + default-value)))) (defun read-buffer (prompt &optional default require-match) "Read the name of a buffer and return as a string. @@ -1638,30 +1645,24 @@ If DEFAULT-VALUE is non-nil, return that if user enters an empty ;; this calls read-file-name-2 (mouse-read-file-name-1 history prompt dir default must-match initial-contents completer) - (let ((rfhookfun - (lambda () - ;; #### SCREAM! Create a `file-system-ignore-case' - ;; function, so this kind of stuff is generalized! - (and (eq system-type 'windows-nt) - (set (make-local-variable 'completion-ignore-case) t)) - (set - (make-local-variable - 'completion-display-completion-list-function) - #'(lambda (completions) - (display-completion-list - completions - :user-data (not (eq completer 'read-file-name-internal)) - :activate-callback - 'read-file-name-activate-callback))) - ;; kludge! - (remove-hook 'minibuffer-setup-hook rfhookfun) - ))) - (unwind-protect - (progn - (add-hook 'minibuffer-setup-hook rfhookfun) - (read-file-name-2 history prompt dir default must-match - initial-contents completer)) - (remove-hook 'minibuffer-setup-hook rfhookfun))))) + (add-one-shot-hook + 'minibuffer-setup-hook + (lambda () + ;; #### SCREAM! Create a `file-system-ignore-case' + ;; function, so this kind of stuff is generalized! + (and (eq system-type 'windows-nt) + (set (make-local-variable 'completion-ignore-case) t)) + (set + (make-local-variable + 'completion-display-completion-list-function) + #'(lambda (completions) + (display-completion-list + completions + :user-data (not (eq completer 'read-file-name-internal)) + :activate-callback + 'read-file-name-activate-callback))))) + (read-file-name-2 history prompt dir default must-match + initial-contents completer))) (defun read-file-name (prompt &optional dir default must-match initial-contents @@ -1925,18 +1926,38 @@ whether it is a file(/result) or a directory (/result/)." result) (t file)))) +(defun mouse-rfn-setup-vars (prompt) + ;; a specifier would be nice. + (set (make-local-variable 'frame-title-format) + (capitalize-string-as-title + ;; Delete ": " off the end. There must be an easier way! + (let ((end-pos (length prompt))) + (if (and (> end-pos 0) (eq (aref prompt (1- end-pos)) ? )) + (setq end-pos (1- end-pos))) + (if (and (> end-pos 0) (eq (aref prompt (1- end-pos)) ?:)) + (setq end-pos (1- end-pos))) + (substring prompt 0 end-pos)))) + ;; ensure that killing the frame works right, + ;; instead of leaving us in the minibuffer. + (add-local-hook 'delete-frame-hook + #'(lambda (frame) + (abort-recursive-edit)))) + (defun mouse-file-display-completion-list (window dir minibuf user-data) (let ((standard-output (window-buffer window))) (condition-case nil (display-completion-list (directory-files dir nil nil nil t) - :window-width (* 2 (window-width window)) + :window-width (window-width window) + :window-height (window-text-area-height window) + :completion-string "" :activate-callback 'mouse-read-file-name-activate-callback :user-data user-data :reference-buffer minibuf :help-string "") - (t nil)))) + (t nil)) + )) (defun mouse-directory-display-completion-list (window dir minibuf user-data) (let ((standard-output (window-buffer window))) @@ -1944,21 +1965,25 @@ whether it is a file(/result) or a directory (/result/)." (display-completion-list (delete "." (directory-files dir nil nil nil 1)) :window-width (window-width window) + :window-height (window-text-area-height window) + :completion-string "" :activate-callback 'mouse-read-file-name-activate-callback :user-data user-data :reference-buffer minibuf :help-string "") - (t nil)))) + (t nil)) + )) (defun mouse-read-file-name-activate-callback (event extent user-data) (let* ((file (extent-string extent)) (minibuf (symbol-value-in-buffer 'completion-reference-buffer (extent-object extent))) - (in-dir (buffer-substring nil nil minibuf)) + (ministring (buffer-substring nil nil minibuf)) + (in-dir (file-name-directory ministring)) (full (expand-file-name file in-dir)) (filebuf (nth 0 user-data)) - (dirbuff (nth 1 user-data)) + (dirbuf (nth 1 user-data)) (filewin (nth 2 user-data)) (dirwin (nth 3 user-data))) (if (file-regular-p full) @@ -1967,29 +1992,34 @@ whether it is a file(/result) or a directory (/result/)." (insert-string (file-name-as-directory (abbreviate-file-name full t)) minibuf) (reset-buffer filebuf) - (if (not dirbuff) + (if (not dirbuf) (mouse-directory-display-completion-list filewin full minibuf user-data) (mouse-file-display-completion-list filewin full minibuf user-data) - (reset-buffer dirbuff) + (reset-buffer dirbuf) (mouse-directory-display-completion-list dirwin full minibuf user-data))))) -;; this is rather cheesified but gets the job done. +;; our cheesy but god-awful time consuming file dialog box implementation. +;; this will be replaced with use of the native file dialog box (when +;; available). (defun mouse-read-file-name-1 (history prompt dir default - must-match initial-contents - completer) + must-match initial-contents + completer) + ;; file-p is t if we're reading files, nil if directories. (let* ((file-p (eq 'read-file-name-internal completer)) (filebuf (get-buffer-create "*Completions*")) - (dirbuff (and file-p (generate-new-buffer " *mouse-read-file*"))) - (butbuff (generate-new-buffer " *mouse-read-file*")) + (dirbuf (and file-p (generate-new-buffer " *mouse-read-file*"))) + (butbuf (generate-new-buffer " *mouse-read-file*")) (frame (make-dialog-frame)) filewin dirwin user-data) (unwind-protect (progn (reset-buffer filebuf) - (select-frame frame) + + ;; set up the frame. + (focus-frame frame) (let ((window-min-height 1)) ;; #### should be 2 not 3, but that causes ;; "window too small to split" errors for some @@ -2002,16 +2032,80 @@ whether it is a file(/result) or a directory (/result/)." (setq filewin (frame-rightmost-window frame) dirwin (frame-leftmost-window frame)) (set-window-buffer filewin filebuf) - (set-window-buffer dirwin dirbuff)) + (set-window-buffer dirwin dirbuf)) (setq filewin (frame-highest-window frame)) (set-window-buffer filewin filebuf)) - (setq user-data (list filebuf dirbuff filewin dirwin)) - (set-window-buffer (frame-lowest-window frame) butbuff) - (set-buffer butbuff) + (setq user-data (list filebuf dirbuf filewin dirwin)) + (set-window-buffer (frame-lowest-window frame) butbuf) + + ;; set up completion buffers. + (let ((rfcshookfun + ;; kludge! + ;; #### I really need to flesh out the object + ;; hierarchy better to avoid these kludges. + ;; (?? I wrote this comment above some time ago, + ;; and I don't understand what I'm referring to + ;; any more. --ben + (lambda () + (mouse-rfn-setup-vars prompt) + (when (featurep 'scrollbar) + (set-specifier scrollbar-width 0 (current-buffer))) + (setq truncate-lines t)))) + + (set-buffer filebuf) + (add-local-hook 'completion-setup-hook rfcshookfun) + (when file-p + (set-buffer dirbuf) + (add-local-hook 'completion-setup-hook rfcshookfun))) + + ;; set up minibuffer. + (add-one-shot-hook + 'minibuffer-setup-hook + (lambda () + (if (not file-p) + (mouse-directory-display-completion-list + filewin dir (current-buffer) user-data) + (mouse-file-display-completion-list + filewin dir (current-buffer) user-data) + (mouse-directory-display-completion-list + dirwin dir (current-buffer) user-data)) + (set + (make-local-variable + 'completion-display-completion-list-function) + (lambda (completions) + (display-completion-list + completions + :help-string "" + :window-width (window-width filewin) + :window-height (window-text-area-height filewin) + :completion-string "" + :activate-callback + 'mouse-read-file-name-activate-callback + :user-data user-data))) + (mouse-rfn-setup-vars prompt) + (save-selected-window + ;; kludge to ensure the frame title is correct. + ;; the minibuffer leaves the frame title the way + ;; it was before (i.e. of the selected window before + ;; the dialog box was opened), so to get it correct + ;; we have to be tricky. + (select-window filewin) + (redisplay-frame nil t) + ;; #### another kludge. sometimes the focus ends up + ;; back in the main window, not the dialog box. it + ;; occurs randomly and it's not possible to reliably + ;; reproduce. We try to fix it by draining non-user + ;; events and then setting the focus back on the frame. + (sit-for 0 t) + (focus-frame frame)))) + + ;; set up button buffer. + (set-buffer butbuf) + (mouse-rfn-setup-vars prompt) (when dir (setq default-directory dir)) (when (featurep 'scrollbar) - (set-specifier scrollbar-width 0 butbuff)) + (set-specifier scrollbar-width 0 butbuf)) (insert " ") (insert-gui-button (make-gui-button "OK" (lambda (foo) @@ -2020,51 +2114,20 @@ whether it is a file(/result) or a directory (/result/)." (insert-gui-button (make-gui-button "Cancel" (lambda (foo) (abort-recursive-edit)))) - (let ((rfhookfun - (lambda () - (if (not file-p) - (mouse-directory-display-completion-list - filewin dir (current-buffer) user-data) - (mouse-file-display-completion-list filewin dir - (current-buffer) - user-data) - (mouse-directory-display-completion-list dirwin dir - (current-buffer) - user-data)) - (set - (make-local-variable - 'completion-display-completion-list-function) - #'(lambda (completions) - (display-completion-list - completions - :help-string "" - :activate-callback - 'mouse-read-file-name-activate-callback - :user-data user-data))) - ;; kludge! - (remove-hook 'minibuffer-setup-hook rfhookfun) - )) - (rfcshookfun - ;; kludge! - ;; #### I really need to flesh out the object - ;; hierarchy better to avoid these kludges. - (lambda () - (save-excursion - (set-buffer standard-output) - (setq truncate-lines t))))) - (unwind-protect - (progn - (add-hook 'minibuffer-setup-hook rfhookfun) - (add-hook 'completion-setup-hook rfcshookfun) - (read-file-name-2 history prompt dir default - must-match initial-contents - completer)) - (remove-hook 'minibuffer-setup-hook rfhookfun) - (remove-hook 'completion-setup-hook rfcshookfun)))) + + ;; now start reading filename. + (read-file-name-2 history prompt dir default + must-match initial-contents + completer)) + + ;; always clean up. + ;; get rid of our hook that calls abort-recursive-edit -- not a good + ;; idea here. + (kill-local-variable 'delete-frame-hook) (delete-frame frame) (kill-buffer filebuf) - (kill-buffer butbuff) - (and dirbuff (kill-buffer dirbuff))))) + (kill-buffer butbuf) + (and dirbuf (kill-buffer dirbuf))))) (defun read-face (prompt &optional must-match) "Read the name of a face from the minibuffer and return it as a symbol." diff --git a/lisp/msw-glyphs.el b/lisp/msw-glyphs.el index aa4db3e..de2823a 100644 --- a/lisp/msw-glyphs.el +++ b/lisp/msw-glyphs.el @@ -30,11 +30,24 @@ ;; Initialization code for MS Windows glyphs. ;; This file is dumped with XEmacs (when MS Windows support is -;; compiled in). +;; compiled in). Make sure this is the first of msw-*.el files +;; dumped. ;;; Code: +(defun msgdi-device-p (&optional device) + "Return non-nil if DEVICE is a GDI device, that is 'mswindows or 'msprinter. +MS GDI devices are mutuially WYSIWIG-compatible, so that many common glyph, +color and font properties apply to them equally. + +This function is also a predicate for 'msgdi device tag, matching this +device class." + (memq (device-type device) '(mswindows msprinter))) + (progn + + (define-specifier-tag 'msgdi (function msgdi-device-p)) + (set-console-type-image-conversion-list 'mswindows `(("\\.bmp\\'" [bmp :file nil] 2) @@ -59,11 +72,14 @@ ;; strings are not allowed so they will be ignored. ("" [nothing]))) + (set-console-type-image-conversion-list + 'msprinter (console-type-image-conversion-list 'mswindows)) + (set-face-font 'border-glyph "WingDings:Regular:11::Symbol" - 'global 'mswindows) - (set-glyph-image continuation-glyph "\xC3" 'global 'mswindows) - (set-glyph-image truncation-glyph "\xF0" 'global 'mswindows) - (set-glyph-image hscroll-glyph "\xEF" 'global 'mswindows) + 'global 'msgdi) + (set-glyph-image continuation-glyph "\xC3" 'global 'msgdi) + (set-glyph-image truncation-glyph "\xF0" 'global 'msgdi) + (set-glyph-image hscroll-glyph "\xEF" 'global 'msgdi) (set-glyph-image octal-escape-glyph "\\") (set-glyph-image control-arrow-glyph "^") @@ -78,11 +94,11 @@ (if emacs-beta-version "xemacs-beta.xpm" "xemacs.xpm")) - 'global 'mswindows)) + 'global 'msgdi)) (t (set-glyph-image xemacs-logo "XEmacs " - 'global 'mswindows))) + 'global 'msgdi))) ) ;;; msw-glyphs.el ends here diff --git a/lisp/msw-init.el b/lisp/msw-init.el index de7d823..aef2101 100644 --- a/lisp/msw-init.el +++ b/lisp/msw-init.el @@ -47,6 +47,7 @@ (if (featurep 'infodock) (require 'id-x-toolbar) (init-x-toolbar))) + (if (featurep 'gutter) (init-gutter)) (add-hook 'zmacs-deactivate-region-hook (lambda () (if (console-on-window-system-p) @@ -61,13 +62,15 @@ (activate-region-as-selection)))) ;; Old-style mswindows bindings. The new-style mswindows bindings ;; (namely Ctrl-X, Ctrl-C and Ctrl-V) are already spoken for by XEmacs. - (define-key global-map '(shift delete) 'kill-primary-selection) - (define-key global-map '(control delete) 'delete-primary-selection) - (define-key global-map '(shift insert) 'yank-clipboard-selection) - (define-key global-map '(control insert) 'copy-primary-selection) + (global-set-key '(shift delete) 'kill-primary-selection) + (global-set-key '(control delete) 'delete-primary-selection) + (global-set-key '(shift insert) 'yank-clipboard-selection) + (global-set-key '(control insert) 'copy-primary-selection) + + (global-set-key '(meta f4) 'save-buffers-kill-emacs) ;; Random stuff - (define-key global-map 'menu 'popup-mode-menu) + (global-set-key 'menu 'popup-mode-menu) (setq mswindows-post-win-initted t))) diff --git a/lisp/multicast.el b/lisp/multicast.el index cfedfde..efd3f80 100644 --- a/lisp/multicast.el +++ b/lisp/multicast.el @@ -1,25 +1,25 @@ ;;; multicast.el --- lisp frontend for multicast connections in XEmacs -;; Copyright (C) 1997-1998 Didier Verna. +;; Copyright (C) 1997-2000 Didier Verna. -;; Author: Didier Verna -;; Maintainer: Didier Verna -;; Created: Thu Dec 4 16:37:39 1997 +;; Author: Didier Verna +;; Maintainer: Didier Verna +;; Created: Thu Dec 4 16:37:39 1997 ;; Last Revision: Mon Jan 19 19:10:50 1998 ;; Current Version: 0.4 ;; Keywords: dumped comm processes -;; This file is part of XEmacs. +;; 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 of the License, or -;; (at your option) any later version. +;; (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. +;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, write to the Free Software @@ -60,7 +60,7 @@ ADDRESS specifies a standard multicast address \"dest/port/ttl\": ttl is the time-to-live (15 for site, 63 for region and 127 for world). WARNING: it is *strongly* recommended to avoid using groups beginning with - 224 or 239. Such groups are considered 'admin' groups, and may + 224 or 239. Such groups are considered 'admin' groups, and may behave in a surprising way ..." (let (dest port ttl) ;; We check only the general form of the multicast address. @@ -77,5 +77,5 @@ WARNING: it is *strongly* recommended to avoid using groups beginning with (error "invalid ttl specification.")) (open-multicast-group-internal name buffer dest port ttl) )) - + ;;; multicast.el ends here diff --git a/lisp/package-get.el b/lisp/package-get.el index 587ea39..eb395a9 100644 --- a/lisp/package-get.el +++ b/lisp/package-get.el @@ -68,7 +68,7 @@ ;; vm - a mail reader ;; [] Always install ;; [] Needs updating -;; [] Required by other [packages] +;; [] Required by other [packages] ;; ;; Where `[]' indicates a toggle box ;; @@ -79,7 +79,7 @@ ;; - "Required by other" means some other packages are going to force ;; this to be installed. Clicking on [packages] gives a list ;; of packages that require this. -;; +;; ;; The `package-get-base' should be installed in a file in ;; `data-directory'. The `package-get-here' should be installed in ;; site-lisp. Both are then read at run time. @@ -113,7 +113,7 @@ :prefix "package-get" :group 'package-tools) -;;;###autoload +;;;###autoload (defvar package-get-base nil "List of packages that are installed at this site. For each element in the alist, car is the package name and the cdr is @@ -288,7 +288,8 @@ When nil, updates which are not PGP signed are allowed without confirmation." `(if (member (quote ,(cdr site)) package-get-remote) (setq package-get-remote - (delete (quote ,(cdr site)) package-get-remote)) + (delete (quote ,(cdr site)) + package-get-remote)) (package-ui-add-site (quote ,(cdr site)))) :style 'toggle :selected `(member (quote ,(cdr site)) @@ -373,7 +374,7 @@ if different." (setq location package-get-user-index-filename)) (when (y-or-n-p (concat "Update package index in " location "? ")) (write-file location)))))) - + ;;;###autoload (defun package-get-update-base (&optional db-file force-current) @@ -515,19 +516,18 @@ Query for a version if GET-VERSION is non-nil. Return package name as a symbol instead of a string if PACKAGE-SYMBOL is non-nil. The return value is suitable for direct passing to `interactive'." (package-get-require-base t) - (let ( (table (mapcar '(lambda (item) - (let ( (name (symbol-name (car item))) ) - (cons name name) - )) - package-get-base)) - package package-symbol default-version version) + (let ((table (mapcar #'(lambda (item) + (let ((name (symbol-name (car item)))) + (cons name name))) + package-get-base)) + package package-symbol default-version version) (save-window-excursion (setq package (completing-read "Package: " table nil t)) (setq package-symbol (intern package)) (if get-version (progn - (setq default-version - (package-get-info-prop + (setq default-version + (package-get-info-prop (package-get-info-version (package-get-info-find-package package-get-base package-symbol) nil) @@ -542,8 +542,7 @@ The return value is suitable for direct passing to `interactive'." ) (if package-symbol (list package-symbol) - (list package))) - ))) + (list package)))))) ;;;###autoload (defun package-get-delete-package (package &optional pkg-topdir) @@ -706,7 +705,7 @@ package is already installed. Valid values for CONFLICT are: INSTALL-DIR, if non-nil, specifies the package directory where fetched packages should be installed. -The value of `package-get-base' is used to determine what files should +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. @@ -814,7 +813,7 @@ successfully installed but errors occurred during initialization, or current-dir-entry current-filename)) ;; Get it (setq full-package-filename dest-filename) - (message "Retrieving package `%s' ..." + (message "Retrieving package `%s' ..." current-filename) (sit-for 0) (copy-file (package-get-remote-filename current-dir-entry @@ -900,7 +899,7 @@ returned. To access fields returned from this, use `package-get-info-version' to return information about particular a -version. Use `package-get-info-find-prop' to find particular property +version. Use `package-get-info-find-prop' to find particular property from a version returned by `package-get-info-version'." (interactive "xPackage list: \nsPackage Name: ") (if which @@ -912,7 +911,7 @@ from a version returned by `package-get-info-version'." (defun package-get-info-version (package version) "In PACKAGE, return the plist associated with a particular VERSION of the package. PACKAGE is typically as returned by - `package-get-info-find-package'. If VERSION is nil, then return the + `package-get-info-find-package'. If VERSION is nil, then return the first (aka most recent) version. Use `package-get-info-find-prop' to retrieve a particular property from the value returned by this." (interactive (package-get-interactive-package-query t t)) @@ -989,7 +988,7 @@ If (car search) is nil, (cadr search is interpreted as a local directory). (defun package-get-installedp (package version) "Determine if PACKAGE with VERSION has already been installed. -I'm not sure if I want to do this by searching directories or checking +I'm not sure if I want to do this by searching directories or checking some built in variables. For now, use packages-package-list." ;; Use packages-package-list which contains name and version (equal (plist-get @@ -1001,7 +1000,7 @@ some built in variables. For now, use packages-package-list." (defun package-get-package-provider (sym &optional force-current) "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 + consp, then it must match a corresponding (provide (SYM VERSION)) from the package. If FORCE-CURRENT is non-nil make sure the database is up to date. This might @@ -1054,10 +1053,10 @@ lead to Emacs accessing remote sites." (defun package-get-ever-installed-p (pkg &optional notused) (string-match "-package$" (symbol-name pkg)) - (custom-initialize-set - pkg - (if (package-get-info-find-package - packages-package-list + (custom-initialize-set + pkg + (if (package-get-info-find-package + packages-package-list (intern (substring (symbol-name pkg) 0 (match-beginning 0)))) t))) diff --git a/lisp/package-ui.el b/lisp/package-ui.el index f471ae0..c349ca2 100644 --- a/lisp/package-ui.el +++ b/lisp/package-ui.el @@ -140,12 +140,12 @@ Set this to `nil' to use the `default' face." (defun pui-directory-exists (dir) "Check to see if DIR exists in `package-get-remote'." (let (found) - (mapcar '(lambda (item) - (if (and (null (car item)) - (string-equal (file-name-as-directory (car (cdr item))) - (file-name-as-directory dir))) - (setq found t)) - ) package-get-remote) + (mapcar #'(lambda (item) + (if (and (null (car item)) + (string-equal (file-name-as-directory (car (cdr item))) + (file-name-as-directory dir))) + (setq found t))) + package-get-remote) found )) @@ -358,11 +358,8 @@ and whether or not it is up-to-date." (save-window-excursion (with-output-to-temp-buffer tmpbuf (display-completion-list (sort - (mapcar '(lambda (pkg) - (symbol-name pkg) - ) - pui-deleted-packages) - 'string<) + (mapcar #'symbol-name pui-deleted-packages) + #'string<) :activate-callback nil :help-string "Packages selected for removal:\n" :completion-string t @@ -389,16 +386,12 @@ and whether or not it is up-to-date." ;; errors occur, which would normally be caused by display-buffer). (save-window-excursion (with-output-to-temp-buffer tmpbuf - (display-completion-list (sort - (mapcar '(lambda (pkg) - (symbol-name pkg) - ) - pui-selected-packages) - 'string<) - :activate-callback nil - :help-string "Packages selected for installation:\n" - :completion-string t - )) + (display-completion-list + (sort (mapcar #'symbol-name pui-selected-packages) #'string<) + :activate-callback nil + :help-string "Packages selected for installation:\n" + :completion-string t + )) (setq tmpbuf (get-buffer-create tmpbuf)) (display-buffer tmpbuf) (setq do-install (y-or-n-p "Install these packages? ")) @@ -618,67 +611,66 @@ Warning: No download sites specified. Package index may be out of date. ")) (insert sep-string) (setq start (point)) - (mapcar '(lambda (pkg) - (let (pkg-sym info version desc - b e extent current-vers disp) - (setq pkg-sym (car pkg) - info (package-get-info-version (cdr pkg) nil)) - (setq version (package-get-info-prop info 'version) - desc (package-get-info-prop info 'description)) - - (setq disp (pui-package-symbol-char pkg-sym - version)) - (setq b (point)) - (if pui-list-verbose - (progn - (setq current-vers (package-get-key pkg-sym :version)) - (cond - ( (not current-vers) - (setq current-vers "-----") ) - ( (stringp current-vers) - (setq current-vers - (format "%.2f" - (string-to-number current-vers))) ) - ( (numberp current-vers) - (setq current-vers (format "%.2f" current-vers)) ) - ) - (insert - (format "%s %-15s %-5.2f %-5s %s\n" - (car disp) pkg-sym - (if (stringp version) - (string-to-number version) - version) - current-vers desc)) -;; (insert -;; (format "\t\t %-12s %s\n" -;; (package-get-info-prop info 'author-version) -;; (package-get-info-prop info 'date) -;; )) - ) - (insert (format "%s %-15s %-5s %s\n" - (car disp) - pkg-sym version desc))) - (save-excursion - (setq e (progn - (forward-line -1) - (end-of-line) - (point))) - ) - (setq extent (make-extent b e)) - (if (car (cdr disp)) - (set-extent-face extent (get-face (car (cdr disp)))) - (set-extent-face extent (get-face 'default))) - (set-extent-property extent 'highlight t) - (set-extent-property extent 'pui t) - (set-extent-property extent 'pui-package pkg-sym) - (set-extent-property extent 'pui-info info) - (set-extent-property extent 'help-echo 'pui-help-echo) - (set-extent-property extent 'keymap pui-package-keymap) - )) (sort (copy-sequence package-get-base) - '(lambda (a b) - (string< (symbol-name (car a)) - (symbol-name (car b))) - ))) + (mapcar + #'(lambda (pkg) + (let (pkg-sym info version desc + b e extent current-vers disp) + (setq pkg-sym (car pkg) + info (package-get-info-version (cdr pkg) nil)) + (setq version (package-get-info-prop info 'version) + desc (package-get-info-prop info 'description)) + + (setq disp (pui-package-symbol-char pkg-sym + version)) + (setq b (point)) + (if pui-list-verbose + (progn + (setq current-vers (package-get-key pkg-sym :version)) + (cond + ( (not current-vers) + (setq current-vers "-----") ) + ( (stringp current-vers) + (setq current-vers + (format "%.2f" + (string-to-number current-vers))) ) + ( (numberp current-vers) + (setq current-vers (format "%.2f" current-vers)) ) + ) + (insert + (format "%s %-15s %-5.2f %-5s %s\n" + (car disp) pkg-sym + (if (stringp version) + (string-to-number version) + version) + current-vers desc)) + ;; (insert + ;; (format "\t\t %-12s %s\n" + ;; (package-get-info-prop info 'author-version) + ;; (package-get-info-prop info 'date))) + ) + (insert (format "%s %-15s %-5s %s\n" + (car disp) + pkg-sym version desc))) + (save-excursion + (setq e (progn + (forward-line -1) + (end-of-line) + (point)))) + (setq extent (make-extent b e)) + (if (car (cdr disp)) + (set-extent-face extent (get-face (car (cdr disp)))) + (set-extent-face extent (get-face 'default))) + (set-extent-property extent 'highlight t) + (set-extent-property extent 'pui t) + (set-extent-property extent 'pui-package pkg-sym) + (set-extent-property extent 'pui-info info) + (set-extent-property extent 'help-echo 'pui-help-echo) + (set-extent-property extent 'keymap pui-package-keymap) + )) + (sort (copy-sequence package-get-base) + #'(lambda (a b) + (string< (symbol-name (car a)) + (symbol-name (car b)))))) (insert sep-string) (insert (documentation 'list-packages-mode)) (set-buffer-modified-p nil) @@ -693,7 +685,7 @@ Warning: No download sites specified. Package index may be out of date. (add-submenu '() pui-menu) (setq mode-popup-menu pui-menu)) (clear-message) -; (message (substitute-command-keys "Press `\\[pui-help]' for help.")) + ;; (message (substitute-command-keys "Press `\\[pui-help]' for help.")) )) ;;;###autoload diff --git a/lisp/rect.el b/lisp/rect.el index f70149f..2393182 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -1,8 +1,8 @@ ;;; rect.el --- rectangle functions for XEmacs. -;; Copyright (C) 1985, 1993, 1994, 1999 Free Software Foundation, Inc. +;; Copyright (C) 1985-2000 Free Software Foundation, Inc. -;; Maintainer: Didier Verna +;; Maintainer: Didier Verna ;; Keywords: internal ;; This file is part of XEmacs. @@ -30,7 +30,7 @@ ;; in the XEmacs Reference Manual. ;; #### NOTE: this file has been almost completely rewritten by Didier Verna -;; , Jul 99. The purpose of this rewrite is to be less +;; , Jul 99. The purpose of this rewrite is to be less ;; intrusive and fill lines with whitespaces only when needed. A few functions ;; are untouched though, as noted above their definition. @@ -111,6 +111,31 @@ when the function is called." (forward-line 1))) )) + +(defun delete-rectangle-line (startcol endcol fill) + (let ((pt (point-at-eol))) + (when (= (move-to-column startcol (or fill 'coerce)) startcol) + (if (and (not fill) (<= pt endcol)) + (delete-region (point) pt) + ;; else + (setq pt (point)) + (move-to-column endcol t) + (delete-region pt (point)))) + )) + +;;;###autoload +(defun delete-rectangle (start end &optional fill) + "Delete the text in the region-rectangle without saving it. +The same range of columns is deleted in each line starting with the line +where the region begins and ending with the line where the region ends. + +When called from a program, the rectangle's corners are START and END. +With a prefix (or FILL) argument, also fill lines where nothing has to be +deleted." + (interactive "*r\nP") + (apply-on-rectangle 'delete-rectangle-line start end fill)) + + ;; I love ascii art ;-) (defconst spaces-strings '["" " " @@ -122,7 +147,6 @@ when the function is called." " " " "]) - ;; This function is untouched --dv (defun spaces-string (n) (if (<= n 8) (aref spaces-strings n) @@ -132,57 +156,6 @@ when the function is called." n (- n 8))) (concat val (aref spaces-strings n))))) -;;;###autoload -(defvar killed-rectangle nil - "Rectangle for `yank-rectangle' to insert.") - -;;;###autoload -(defun kill-rectangle (start end &optional fill) - "Delete the region-rectangle and save it as the last killed one. -You might prefer to use `delete-extract-rectangle' from a program. - -When called from a program, the rectangle's corners are START and END. -With a prefix (or FILL) argument, also fill lines where nothing has to be -deleted." - (interactive "*r\nP") - (when buffer-read-only - (setq killed-rectangle (extract-rectangle start end)) - (barf-if-buffer-read-only)) - (setq killed-rectangle (delete-extract-rectangle start end fill))) - -;;;###autoload -(defun delete-rectangle (start end &optional fill) - "Delete the text in the region-rectangle without saving it. -The same range of columns is deleted in each line starting with the line -where the region begins and ending with the line where the region ends. - -When called from a program, the rectangle's corners are START and END. -With a prefix (or FILL) argument, also fill lines where nothing has to be -deleted." - (interactive "*r\nP") - (apply-on-rectangle 'delete-rectangle-line start end fill)) - -(defun delete-rectangle-line (startcol endcol fill) - (let ((pt (point-at-eol))) - (when (= (move-to-column startcol (or fill 'coerce)) startcol) - (if (and (not fill) (<= pt endcol)) - (delete-region (point) pt) - ;; else - (setq pt (point)) - (move-to-column endcol t) - (delete-region pt (point)))) - )) - -;;;###autoload -(defun delete-extract-rectangle (start end &optional fill) - "Delete the contents of the rectangle with corners at START and END, and -return it as a list of strings, one for each line of the rectangle. - -With an optional FILL argument, also fill lines where nothing has to be -deleted." - (let ((lines (list nil))) - (apply-on-rectangle 'delete-extract-rectangle-line start end lines fill) - (nreverse (cdr lines)))) (defun delete-extract-rectangle-line (startcol endcol lines fill) (let ((pt (point-at-eol))) @@ -197,13 +170,17 @@ deleted." )) ;;;###autoload -(defun extract-rectangle (start end) - "Return the contents of the rectangle with corners at START and END, -as a list of strings, one for each line of the rectangle." +(defun delete-extract-rectangle (start end &optional fill) + "Delete the contents of the rectangle with corners at START and END, and +return it as a list of strings, one for each line of the rectangle. + +With an optional FILL argument, also fill lines where nothing has to be +deleted." (let ((lines (list nil))) - (apply-on-rectangle 'extract-rectangle-line start end lines) + (apply-on-rectangle 'delete-extract-rectangle-line start end lines fill) (nreverse (cdr lines)))) + ;; #### NOTE: this is actually the only function that needs to do complicated ;; stuff like what's happening in `operate-on-rectangle', because the buffer ;; might be read-only. --dv @@ -236,6 +213,33 @@ as a list of strings, one for each line of the rectangle." (spaces-string endextra)))) (setcdr lines (cons line (cdr lines))))) +;;;###autoload +(defun extract-rectangle (start end) + "Return the contents of the rectangle with corners at START and END, +as a list of strings, one for each line of the rectangle." + (let ((lines (list nil))) + (apply-on-rectangle 'extract-rectangle-line start end lines) + (nreverse (cdr lines)))) + + +;;;###autoload +(defvar killed-rectangle nil + "Rectangle for `yank-rectangle' to insert.") + +;;;###autoload +(defun kill-rectangle (start end &optional fill) + "Delete the region-rectangle and save it as the last killed one. +You might prefer to use `delete-extract-rectangle' from a program. + +When called from a program, the rectangle's corners are START and END. +With a prefix (or FILL) argument, also fill lines where nothing has to be +deleted." + (interactive "*r\nP") + (when buffer-read-only + (setq killed-rectangle (extract-rectangle start end)) + (barf-if-buffer-read-only)) + (setq killed-rectangle (delete-extract-rectangle start end fill))) + ;; This function is untouched --dv ;;;###autoload (defun yank-rectangle () @@ -243,6 +247,7 @@ as a list of strings, one for each line of the rectangle." (interactive "*") (insert-rectangle killed-rectangle)) + ;; This function is untouched --dv ;;;###autoload (defun insert-rectangle (rectangle) @@ -266,6 +271,15 @@ and point is at the lower right corner." (insert (car lines)) (setq lines (cdr lines))))) + +(defun open-rectangle-line (startcol endcol fill) + (let (spaces) + (when (= (move-to-column startcol (or fill 'coerce)) startcol) + (unless (and (not fill) + (= (point) (point-at-eol))) + (indent-to endcol))) + )) + ;;;###autoload (defun open-rectangle (start end &optional fill) "Blank out the region-rectangle, shifting text right. @@ -277,38 +291,32 @@ on the right side of the rectangle." (apply-on-rectangle 'open-rectangle-line start end fill) (goto-char start)) -(defun open-rectangle-line (startcol endcol fill) - (let (spaces) - (when (= (move-to-column startcol (or fill 'coerce)) startcol) - (unless (and (not fill) - (= (point) (point-at-eol))) - (indent-to endcol))) - )) + +(defun string-rectangle-line (startcol endcol string delete) + (move-to-column startcol t) + (if delete + (delete-rectangle-line startcol endcol nil)) + (insert string)) ;;;###autoload (defun string-rectangle (start end string) "Insert STRING on each line of the region-rectangle, shifting text right. -The left edge of the rectangle specifies the column for insertion. This -command does not delete or overwrite any existing text. +The left edge of the rectangle specifies the column for insertion. + +If `pending-delete-mode' is active the string replace the region. +Otherwise this command does not delete or overwrite any existing text. When called from a program, the rectangle's corners are START and END." (interactive "*r\nsString rectangle: ") - (apply-on-rectangle 'string-rectangle-line start end string)) + (apply-on-rectangle 'string-rectangle-line start end string + (and (boundp 'pending-delete-mode) pending-delete-mode))) -(defun string-rectangle-line (startcol endcol string) - (move-to-column startcol t) - (insert string)) - -;;;###autoload -(defun clear-rectangle (start end &optional fill) - "Blank out the region-rectangle. -The text previously in the region is overwritten with blanks. +(defun replace-rectangle (start end string) + "Like `string-rectangle', but unconditionally replace the original region, +as if `pending-delete-mode' were active." + (interactive "*r\nsString rectangle: ") + (apply-on-rectangle 'string-rectangle-line start end string t)) -When called from a program, the rectangle's corners are START and END. -With a prefix (or FILL) argument, also fill with blanks the parts of the -rectangle which were empty." - (interactive "*r\nP") - (apply-on-rectangle 'clear-rectangle-line start end fill)) (defun clear-rectangle-line (startcol endcol fill) (let ((pt (point-at-eol)) @@ -325,6 +333,18 @@ rectangle which were empty." (indent-to (+ (current-column) spaces)))) )) +;;;###autoload +(defun clear-rectangle (start end &optional fill) + "Blank out the region-rectangle. +The text previously in the region is overwritten with blanks. + +When called from a program, the rectangle's corners are START and END. +With a prefix (or FILL) argument, also fill with blanks the parts of the +rectangle which were empty." + (interactive "*r\nP") + (apply-on-rectangle 'clear-rectangle-line start end fill)) + + (provide 'rect) ;;; rect.el ends here diff --git a/lisp/select.el b/lisp/select.el index ef3072e..82788f4 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -83,14 +83,14 @@ set the clipboard.") This will do nothing under anything other than X.") (defun get-selection-no-error (&optional type data-type) - "Return the value of a Windows selection. + "Return the value of a window-system selection. The argument TYPE (default `PRIMARY') says which selection, and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule) says how to convert the data. Returns NIL if there is no selection" (condition-case err (get-selection type data-type) (t nil))) (defun get-selection (&optional type data-type) - "Return the value of a Windows selection. + "Return the value of a window-system selection. The argument TYPE (default `PRIMARY') says which selection, and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule) says how to convert the data. If there is no selection an error is signalled." @@ -112,12 +112,13 @@ says how to convert the data. If there is no selection an error is signalled." text)) ;; FSFmacs calls this `x-set-selection', and reverses the -;; arguments (duh ...). This order is more logical. -(defun own-selection (data &optional type) - "Make an Windows selection of type TYPE and value DATA. +;; first two arguments (duh ...). This order is more logical. +(defun own-selection (data &optional type append) + "Make a window-system selection of type TYPE and value DATA. The argument TYPE (default `PRIMARY') says which selection, and DATA specifies the contents. DATA may be a string, a symbol, an integer (or a cons of two integers or list of two integers). +If APPEND is non-nil, append the data to the existing selection data. The selection may also be a cons of two markers pointing to the same buffer, or an overlay. In these cases, the selection is considered to be the text @@ -131,36 +132,51 @@ Interactively, the text of the region is used as the selection value." (interactive (if (not current-prefix-arg) (list (read-string "Store text for pasting: ")) (list (substring (region-beginning) (region-end))))) - ;FSFmacs huh?? It says: - ;; "This is for temporary compatibility with pre-release Emacs 19." - ;(if (stringp type) - ; (setq type (intern type))) - (or (valid-simple-selection-p data) - (and (vectorp data) - (let ((valid t) - (i (1- (length data)))) - (while (>= i 0) - (or (valid-simple-selection-p (aref data i)) - (setq valid nil)) - (setq i (1- i))) - valid)) - (signal 'error (list "invalid selection" data))) - (or type (setq type 'PRIMARY)) - (if (null data) - (disown-selection-internal type) - (own-selection-internal type data) - (when (and (eq type 'PRIMARY) - selection-sets-clipboard) - (own-selection-internal 'CLIPBOARD data))) - (cond ((eq type 'PRIMARY) - (setq primary-selection-extent - (select-make-extent-for-selection - data primary-selection-extent))) - ((eq type 'SECONDARY) - (setq secondary-selection-extent - (select-make-extent-for-selection - data secondary-selection-extent)))) - (setq zmacs-region-stays t) + ;; calling own-selection-internal will mess this up, so preserve it. + (let ((zmacs-region-stays zmacs-region-stays)) + ;FSFmacs huh?? It says: + ;; "This is for temporary compatibility with pre-release Emacs 19." + ;(if (stringp type) + ; (setq type (intern type))) + (or (valid-simple-selection-p data) + (and (vectorp data) + (let ((valid t) + (i (1- (length data)))) + (while (>= i 0) + (or (valid-simple-selection-p (aref data i)) + (setq valid nil)) + (setq i (1- i))) + valid)) + (signal 'error (list "invalid selection" data))) + (or type (setq type 'PRIMARY)) + (flet ((own-selection-1 + (type data append) + (when append + (unless (stringp data) + ;; kludge! + (setq data (select-convert-to-text type 'STRING data)) + (if (stringp data) + (setq data (concat (get-selection type) data))))) + (own-selection-internal type data))) + (if (null data) + (disown-selection-internal type) + (own-selection-1 type data append) + (when (and (eq type 'PRIMARY) + selection-sets-clipboard) + (own-selection-internal 'CLIPBOARD data append)))) + (cond ((eq type 'PRIMARY) + (setq primary-selection-extent + (select-make-extent-for-selection + data primary-selection-extent))) + ((eq type 'SECONDARY) + (setq secondary-selection-extent + (select-make-extent-for-selection + data secondary-selection-extent))))) + ;; zmacs-region-stays is for commands, not low-level functions. + ;; when behaving as the latter, we better not set it, or we will + ;; cause unwanted sticky-region behavior in kill-region and friends. + (if (interactive-p) + (setq zmacs-region-stays t)) data) (defun dehilight-selection (selection) @@ -184,8 +200,9 @@ Interactively, the text of the region is used as the selection value." (setq lost-selection-hooks 'dehilight-selection) -(defun own-clipboard (string) - "Paste the given string to the window system Clipboard." +(defun own-clipboard (string &optional append) + "Paste the given string to the window system Clipboard. +If APPEND is non-nil, append the string to the existing contents." (own-selection string 'CLIPBOARD)) (defun disown-selection (&optional secondary-p) diff --git a/lisp/simple.el b/lisp/simple.el index 19a6eec..5b306a1 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2,6 +2,7 @@ ;; Copyright (C) 1985-7, 1993-5, 1997 Free Software Foundation, Inc. ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp. +;; Copyright (C) 2000 Ben Wing. ;; Maintainer: XEmacs Development Team ;; Keywords: lisp, extensions, internal, dumped @@ -1087,22 +1088,50 @@ Repeating \\[universal-argument] without digits or minus sign (skip-chars-forward " \t")) (defcustom kill-whole-line nil - "*If non-nil, `kill-line' with no arg at beg of line kills the whole line." - :type 'boolean + "*Control when and whether `kill-line' removes entire lines. +Note: This only applies when `kill-line' is called interactively; +otherwise, it behaves \"historically\". + +If `always', `kill-line' with no arg always kills the whole line, +wherever point is in the line. (If you want to just kill to the end +of the line, use \\[historical-kill-line].) + +If not `always' but non-nil, `kill-line' with no arg kills the whole +line if point is at the beginning, and otherwise behaves historically. + +If nil, `kill-line' behaves historically." + :type '(radio (const :tag "Kill to end of line" nil) + (const :tag "Kill whole line" always) + (const + :tag "Kill whole line at beginning, otherwise end of line" t)) :group 'killing) +(defun historical-kill-line (&optional arg) + "Same as `kill-line' but ignores value of `kill-whole-line'." + (interactive "*P") + (let ((kill-whole-line nil)) + (if (interactive-p) + (call-interactively 'kill-line) + (kill-line arg)))) + (defun kill-line (&optional arg) - "Kill the rest of the current line; if no nonblanks there, kill thru newline. + "Kill the rest of the current line, or the entire line. +If no nonblanks there, kill thru newline. +If called interactively, may kill the entire line; see `kill-whole-line'. +when given no argument at the beginning of a line. With prefix argument, kill that many lines from point. Negative arguments kill lines backward. When calling from a program, nil means \"no arg\", -a number counts as a prefix arg. - -If `kill-whole-line' is non-nil, then kill the whole line -when given no argument at the beginning of a line." +a number counts as a prefix arg." (interactive "*P") - (kill-region (point) + (kill-region (if (and (interactive-p) + (not arg) + (eq kill-whole-line 'always)) + (save-excursion + (beginning-of-line) + (point)) + (point)) ;; Don't shift point before doing the delete; that way, ;; undo will record the right position of point. ;; FSF @@ -1117,7 +1146,10 @@ when given no argument at the beginning of a line." (forward-line (prefix-numeric-value arg)) (if (eobp) (signal 'end-of-buffer nil)) - (if (or (looking-at "[ \t]*$") (and kill-whole-line (bolp))) + (if (or (looking-at "[ \t]*$") + (and (interactive-p) + (or (eq kill-whole-line 'always) + (and kill-whole-line (bolp))))) (forward-line 1) (end-of-line))) (point)))) @@ -1154,7 +1186,7 @@ kill become the X Clipboard selection." ;;; the cut buffers. I'm afraid to change interface of `kill-hooks', ;;; so I add it. (1997-11-03 by MORIOKA Tomohiko) -(defvar interprogram-cut-function nil +(defcustom interprogram-cut-function 'own-clipboard "Function to call to make a killed region available to other programs. Most window systems provide some sort of facility for cutting and @@ -1167,9 +1199,15 @@ The function takes one or two arguments. The first argument, TEXT, is a string containing the text which should be made available. The second, PUSH, if non-nil means this is a \"new\" kill; -nil means appending to an \"old\" kill.") +nil means appending to an \"old\" kill." + :type '(radio (function-item :tag "Send to Clipboard" + :format "%t\n" + own-clipboard) + (const :tag "None" nil) + (function :tag "Other")) + :group 'killing) -(defvar interprogram-paste-function nil +(defcustom interprogram-paste-function 'get-clipboard "Function to call to get text cut from other programs. Most window systems provide some sort of facility for cutting and @@ -1187,7 +1225,13 @@ than Emacs has provided a string for pasting; if Emacs provided the most recent string, the function should return nil. If it is difficult to tell whether Emacs or some other program provided the current string, it is probably good enough to return nil if the string -is equal (according to `string=') to the last text Emacs provided.") +is equal (according to `string=') to the last text Emacs provided." + :type '(radio (function-item :tag "Get from Clipboard" + :format "%t\n" + get-clipboard) + (const :tag "None" nil) + (function :tag "Other")) + :group 'killing) ;;;; The kill ring data structure. @@ -1804,6 +1848,53 @@ We think it is an unnecessary and unwanted side-effect." :type 'boolean :group 'editing-basics) +(defcustom shifted-motion-keys-select-region t + "*If non-nil, shifted motion keys select text, like in MS Windows. +See also `unshifted-motion-keys-deselect-region'." + :type 'boolean + :group 'editing-basics) + +(defcustom unshifted-motion-keys-deselect-region t + "*If non-nil, unshifted motion keys deselect a shifted-motion region. +This only occurs after a region has been selected using shifted motion keys +(not when using the traditional set-mark-then-move method), and has no effect +if `shifted-motion-keys-select-region' is nil." + :type 'boolean + :group 'editing-basics) + +(defun handle-pre-motion-command-current-command-is-motion () + (and (key-press-event-p last-input-event) + (memq (event-key last-input-event) + '(left right up down home end prior next + kp-left kp-right kp-up kp-down + kp-home kp-end kp-prior kp-next)))) + +(defun handle-pre-motion-command () + (if + (and + (handle-pre-motion-command-current-command-is-motion) + zmacs-regions + shifted-motion-keys-select-region + (not (region-active-p)) + (memq 'shift (event-modifiers last-input-event))) + (push-mark nil nil t))) + +(defun handle-post-motion-command () + (if + (and + (handle-pre-motion-command-current-command-is-motion) + zmacs-regions + (region-active-p)) + (cond ((memq 'shift (event-modifiers last-input-event)) + (if shifted-motion-keys-select-region + (putf this-command-properties 'shifted-motion-command t)) + (setq zmacs-region-stays t)) + ((and (getf last-command-properties 'shifted-motion-command) + unshifted-motion-keys-deselect-region) + (setq zmacs-region-stays nil)) + (t + (setq zmacs-region-stays t))))) + (defun forward-char-command (&optional arg buffer) "Move point right ARG characters (left if ARG negative) in BUFFER. On attempt to pass end of buffer, stop and signal `end-of-buffer'. @@ -1889,7 +1980,7 @@ in `goal-column', which is nil when there is none. If you are thinking of using this in a Lisp program, consider using `forward-line' instead. It is usually easier to use and more reliable (no dependence on goal column, etc.)." - (interactive "_p") ; XEmacs + (interactive "_p") (if (and next-line-add-newlines (= arg 1)) (let ((opoint (point))) (end-of-line) @@ -1920,7 +2011,7 @@ Then it does not try to move vertically. If you are thinking of using this in a Lisp program, consider using `forward-line' with a negative argument instead. It is usually easier to use and more reliable (no dependence on goal column, etc.)." - (interactive "_p") ; XEmacs + (interactive "_p") (if (interactive-p) (condition-case nil (line-move (- arg)) @@ -1930,6 +2021,25 @@ to use and more reliable (no dependence on goal column, etc.)." (line-move (- arg))) nil) +(defcustom block-movement-size 6 + "*Number of lines that \"block movement\" commands (\\[forward-block-of-lines], \\[backward-block-of-lines]) move by." + :type 'integer + :group 'editing-basics) + +(defun backward-block-of-lines () + "Move backward by one \"block\" of lines. +The number of lines that make up a block is controlled by +`block-movement-size', which defaults to 6." + (interactive "_") + (forward-line (- block-movement-size))) + +(defun forward-block-of-lines () + "Move forward by one \"block\" of lines. +The number of lines that make up a block is controlled by +`block-movement-size', which defaults to 6." + (interactive "_") + (forward-line block-movement-size)) + (defcustom track-eol nil "*Non-nil means vertical motion starting at end of line keeps to ends of lines. This means moving to the end of each line moved onto. @@ -3418,6 +3528,43 @@ Otherwise, this function always returns false." (downcase-region (region-beginning) (region-end)) (downcase-word arg))) +;; #### not localized +(defvar uncapitalized-title-words + '("the" "a" "an" "in" "of" "for" "to" "and" "but" "at" "on" "as" "by")) + +(defvar uncapitalized-title-word-regexp + (concat "[ \t]*\\(" (mapconcat #'identity uncapitalized-title-words "\\|") + "\\)\\>")) + +(defun capitalize-string-as-title (string) + "Capitalize the words in the string, except for small words (as in titles). +The words not capitalized are specified in `uncapitalized-title-words'." + (let ((buffer (get-buffer-create " *capitalize-string-as-title*"))) + (unwind-protect + (progn + (insert-string string buffer) + (capitalize-region-as-title 1 (point-max buffer) buffer) + (buffer-string buffer)) + (kill-buffer buffer)))) + +(defun capitalize-region-as-title (b e &optional buffer) + "Capitalize the words in the region, except for small words (as in titles). +The words not capitalized are specified in `uncapitalized-title-words'." + (interactive "r") + (save-excursion + (and buffer + (set-buffer buffer)) + (save-restriction + (narrow-to-region b e) + (goto-char (point-min)) + (let ((first t)) + (while (< (point) (point-max)) + (if (or first + (not (looking-at uncapitalized-title-word-regexp))) + (capitalize-word 1) + (forward-word 1)) + (setq first nil)))))) + ;; Most of the zmacs code is now in elisp. The only thing left in C ;; are the variables zmacs-regions, zmacs-region-active-p and ;; zmacs-region-stays plus the function zmacs_update_region which @@ -4097,5 +4244,5 @@ The C code calls this periodically, right before redisplay." (cond ((featurep 'infodock) "InfoDock") ((featurep 'xemacs) "XEmacs") (t "Emacs"))) - + ;;; simple.el ends here diff --git a/lisp/specifier.el b/lisp/specifier.el index 3092b38..5653975 100644 --- a/lisp/specifier.el +++ b/lisp/specifier.el @@ -403,6 +403,40 @@ is no possibility for ambiguity and no need to go through the function how-to-add)))) value) +(defun modify-specifier-instances (specifier func &optional args force default + locale tag-set) + "Modify all specifications that match LOCALE and TAG-SET by FUNC. + +For each specification that exists for SPECIFIER, in locale LOCALE +that matches TAG-SET, call the function FUNC with the instance as its +first argument and with optional arguments ARGS. The result is then +used as the new value of the instantiator. + +If there is no specification in the domain LOCALE matching TAG-SET and +FORCE is non-nil, an explicit one is created from the matching +specifier instance if that exists or DEFAULT otherwise. If LOCALE is +not a domain (i.e. a buffer), DEFAULT is always used. FUNC is then +applied like above and the resulting specification is added." + + (let ((spec-list (specifier-spec-list specifier locale tag-set))) + (cond + (spec-list + ;; Destructively edit the spec-list + (mapc #'(lambda (spec) + (mapc #'(lambda (inst-pair) + (setcdr inst-pair + (apply func (cdr inst-pair) args))) + (cdr spec))) + spec-list) + (add-spec-list-to-specifier specifier spec-list)) + (force + (set-specifier specifier + (apply func + (or (and (valid-specifier-domain-p locale) + (specifier-instance specifier)) + default) args) + locale tag-set))))) + (defmacro let-specifier (specifier-list &rest body) "Add specifier specs, evaluate forms in BODY and restore the specifiers. \(let-specifier SPECIFIER-LIST BODY...) diff --git a/lisp/subr.el b/lisp/subr.el index 0bbb855..f306b44 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3,6 +3,7 @@ ;; Copyright (C) 1985, 1986, 1992, 1994-5, 1997 Free Software Foundation, Inc. ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp. ;; Copyright (C) 1995 Sun Microsystems. +;; Copyright (C) 2000 Ben Wing. ;; Maintainer: XEmacs Development Team ;; Keywords: extensions, dumped @@ -117,7 +118,9 @@ one. This function does nothing if HOOK is already local in the current buffer. -Do not use `make-local-variable' to make a hook variable buffer-local." +Do not use `make-local-variable' to make a hook variable buffer-local. + +See also `add-local-hook' and `remove-local-hook'." (if (local-variable-p hook (current-buffer)) ; XEmacs nil (or (boundp hook) (set hook nil)) @@ -139,7 +142,11 @@ To make a hook variable buffer-local, always use HOOK should be a symbol, and FUNCTION may be any valid function. If HOOK is void, it is first set to nil. If HOOK's value is a single -function, it is changed to a list of functions." +function, it is changed to a list of functions. + +You can remove this hook yourself using `remove-hook'. + +See also `add-local-hook' and `add-one-shot-hook'." (or (boundp hook) (set hook nil)) (or (default-boundp hook) (set-default hook nil)) ;; If the hook value is a single function, turn it into a list. @@ -185,25 +192,114 @@ To make a hook variable buffer-local, always use (null (symbol-value hook)) ;value is nil, or (null function)) ;function is nil, then nil ;Do nothing. - (if (or local - ;; Detect the case where make-local-variable was used on a hook - ;; and do what we used to do. - (and (local-variable-p hook (current-buffer)) - (not (memq t (symbol-value hook))))) - (let ((hook-value (symbol-value hook))) - (if (and (consp hook-value) (not (functionp hook-value))) - (if (member function hook-value) - (setq hook-value (delete function (copy-sequence hook-value)))) - (if (equal hook-value function) - (setq hook-value nil))) - (set hook hook-value)) - (let ((hook-value (default-value hook))) - (if (and (consp hook-value) (not (functionp hook-value))) - (if (member function hook-value) - (setq hook-value (delete function (copy-sequence hook-value)))) - (if (equal hook-value function) - (setq hook-value nil))) - (set-default hook hook-value))))) + (flet ((hook-remove + (function hook-value) + (flet ((hook-test + (fn hel) + (or (equal fn hel) + (and (symbolp hel) + (equal fn + (get hel 'one-shot-hook-fun)))))) + (if (and (consp hook-value) + (not (functionp hook-value))) + (if (member* function hook-value :test 'hook-test) + (setq hook-value + (delete* function (copy-sequence hook-value) + :test 'hook-test))) + (if (equal hook-value function) + (setq hook-value nil))) + hook-value))) + (if (or local + ;; Detect the case where make-local-variable was used on a hook + ;; and do what we used to do. + (and (local-variable-p hook (current-buffer)) + (not (memq t (symbol-value hook))))) + (set hook (hook-remove function (symbol-value hook))) + (set-default hook (hook-remove function (default-value hook))))))) + +;; XEmacs addition +;; #### we need a coherent scheme for indicating compatibility info, +;; so that it can be programmatically retrieved. +(defun add-local-hook (hook function &optional append) + "Add to the local value of HOOK the function FUNCTION. +This modifies only the buffer-local value for the hook (which is +automatically make buffer-local, if necessary), not its default value. +FUNCTION is not added if already present. +FUNCTION is added (if necessary) at the beginning of the hook list +unless the optional argument APPEND is non-nil, in which case +FUNCTION is added at the end. + +HOOK should be a symbol, and FUNCTION may be any valid function. If +HOOK is void, it is first set to nil. If HOOK's value is a single +function, it is changed to a list of functions. + +You can remove this hook yourself using `remove-local-hook'. + +See also `add-hook' and `make-local-hook'." + (make-local-hook hook) + (add-hook hook function append t)) + +;; XEmacs addition +(defun remove-local-hook (hook function) + "Remove from the local value of HOOK the function FUNCTION. +This modifies only the buffer-local value for the hook, not its default +value. (Nothing happens if the hook is not buffer-local.) +HOOK should be a symbol, and FUNCTION may be any valid function. If +FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the +list of hooks to run in HOOK, then nothing is done. See `add-hook'. + +See also `add-local-hook' and `make-local-hook'." + (if (local-variable-p hook (current-buffer)) + (remove-hook hook function t))) + +(defun add-one-shot-hook (hook function &optional append local) + "Add to the value of HOOK the one-shot function FUNCTION. +FUNCTION will automatically be removed from the hook the first time +after it runs (whether to completion or to an error). +FUNCTION is not added if already present. +FUNCTION is added (if necessary) at the beginning of the hook list +unless the optional argument APPEND is non-nil, in which case +FUNCTION is added at the end. + +HOOK should be a symbol, and FUNCTION may be any valid function. If +HOOK is void, it is first set to nil. If HOOK's value is a single +function, it is changed to a list of functions. + +You can remove this hook yourself using `remove-hook'. + +See also `add-hook', `add-local-hook', and `add-local-one-shot-hook'." + (let ((sym (gensym))) + (fset sym `(lambda (&rest args) + (unwind-protect + (apply ',function args) + (remove-hook ',hook ',sym ',local)))) + (put sym 'one-shot-hook-fun function) + (add-hook hook sym append local))) + +(defun add-local-one-shot-hook (hook function &optional append) + "Add to the local value of HOOK the one-shot function FUNCTION. +FUNCTION will automatically be removed from the hook the first time +after it runs (whether to completion or to an error). +FUNCTION is not added if already present. +FUNCTION is added (if necessary) at the beginning of the hook list +unless the optional argument APPEND is non-nil, in which case +FUNCTION is added at the end. + +The optional fourth argument, LOCAL, if non-nil, says to modify +the hook's buffer-local value rather than its default value. +This makes no difference if the hook is not buffer-local. +To make a hook variable buffer-local, always use +`make-local-hook', not `make-local-variable'. + +HOOK should be a symbol, and FUNCTION may be any valid function. If +HOOK is void, it is first set to nil. If HOOK's value is a single +function, it is changed to a list of functions. + +You can remove this hook yourself using `remove-local-hook'. + +See also `add-hook', `add-local-hook', and `add-local-one-shot-hook'." + (make-local-hook hook) + (add-one-shot-hook hook function append t)) (defun add-to-list (list-var element) "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet. @@ -345,7 +441,8 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." "Collect output to `standard-output' while evaluating FORMS and return it as a string." ;; by "William G. Dubuque" w/ mods from Stig - `(with-current-buffer (get-buffer-create " *string-output*") + `(with-current-buffer (get-buffer-create + (generate-new-buffer-name " *string-output*")) (setq buffer-read-only nil) (buffer-disable-undo (current-buffer)) (erase-buffer) @@ -399,16 +496,10 @@ See also `with-temp-file' and `with-output-to-string'." "With the contents of the current buffer being STR, run BODY. Returns the new contents of the buffer, as modified by BODY. The original current buffer is restored afterwards." - `(let ((tempbuf (get-buffer-create " *string-as-buffer-contents*"))) - (with-current-buffer tempbuf - (unwind-protect - (progn - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert ,str) - ,@body - (buffer-string)) - (erase-buffer tempbuf))))) + `(with-temp-buffer + (insert ,str) + ,@body + (buffer-string))) (defun insert-face (string face) "Insert STRING and highlight with FACE. Return the extent created." diff --git a/lisp/window.el b/lisp/window.el index c60b931..8c4bba4 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -351,5 +351,4 @@ Any other non-nil value means search frames on all devices." minibuf all-frames device) wins)) - ;;; window.el ends here diff --git a/lisp/x-init.el b/lisp/x-init.el index 5df11b2..cfeaf46 100644 --- a/lisp/x-init.el +++ b/lisp/x-init.el @@ -305,8 +305,8 @@ (init-x-toolbar)) (if (and (featurep 'infodock) (featurep 'toolbar)) (require 'id-x-toolbar)) - (if (featurep 'mule) - (init-mule-x-win)) + (if (featurep 'gutter) (init-gutter)) + (if (featurep 'mule) (init-mule-x-win)) ;; these are only ever called if zmacs-regions is true. (add-hook 'zmacs-deactivate-region-hook (lambda () diff --git a/lwlib/ChangeLog b/lwlib/ChangeLog index 1d3eb2c..2362b17 100644 --- a/lwlib/ChangeLog +++ b/lwlib/ChangeLog @@ -1,3 +1,17 @@ +2000-03-20 Martin Buchholz + + * XEmacs 21.2.32 is released. + +2000-03-14 Ben Wing + + * xlwmenu.c (massage_resource_name): Handle %_ and %%. + +2000-02-20 Gunnar Evermann + + * xlwscrollbar.c (get_gc): Always check for XmUNSPECIFIED_PIXMAP + even if we are only 'compatible' with the Motif resources. + (XmUNSPECIFIED_PIXMAP): Define unconditionally. + 2000-02-23 Martin Buchholz * XEmacs 21.2.31 is released. @@ -126,7 +140,7 @@ 1999-12-12 Daniel Pittman - * lwlib-Xaw.c: + * lwlib-Xaw.c: * xlwcheckbox.c: * xlwgauge.h: * xlwgaugeP.h: @@ -241,11 +255,11 @@ Include to get prototype for atoi(). (GaugeSelect): Call GaugeExpose with the right number of args. (GaugeLoseSel): Call GaugeExpose with the right number of args. - (GaugeConvert): This is a XtConvertSelectionProc, + (GaugeConvert): This is a XtConvertSelectionProc, so 5th parameter must be of type XtPointer, not XPointer. - (GaugeGetValue): This is a XtTimerCallbackProc, + (GaugeGetValue): This is a XtTimerCallbackProc, so 2nd parameter must be of type XtIntervalId *, not XtIntervalId. - + 1999-09-01 Martin Buchholz @@ -281,7 +295,7 @@ * xlwradio.c: * xlwcheckbox.c: * xlwgauge.c: Fix for losing systems without Xmu. - + 1999-08-31 Andy Piper * lwlib-Xm.c (xm_update_one_widget): fix for AIX compiler lossage. @@ -413,7 +427,7 @@ * XEmacs 21.2.18 is released -1999-07-05 Didier Verna +1999-07-05 Didier Verna * lwlib-Xm.c (xm_update_one_widget): add missing #ifdefs around call to xm_update_label. diff --git a/lwlib/xlwmenu.c b/lwlib/xlwmenu.c index a35a629..23d5a45 100644 --- a/lwlib/xlwmenu.c +++ b/lwlib/xlwmenu.c @@ -479,16 +479,26 @@ massage_resource_name (const char *in, char *out) Boolean firstp = True; while (*in) { - char ch = massaged_resource_char[(unsigned char) *in++]; - if (ch) + if (*in == '%' && *(in + 1) == '_') + in += 2; + else { - int int_ch = (int) (unsigned char) ch; - *out++ = firstp ? tolower (int_ch) : toupper (int_ch); - firstp = False; - while ((ch = massaged_resource_char[(unsigned char) *in++]) != '\0') - *out++ = ch; - if (!*(in-1)) /* Overshot the NULL byte? */ - break; + char ch; + + if (*in == '%' && *(in + 1) == '%') + in++; + ch = massaged_resource_char[(unsigned char) *in++]; + if (ch) + { + int int_ch = (int) (unsigned char) ch; + *out++ = firstp ? tolower (int_ch) : toupper (int_ch); + firstp = False; + while ((ch = massaged_resource_char[(unsigned char) *in++]) + != '\0') + *out++ = ch; + if (!*(in-1)) /* Overshot the NULL byte? */ + break; + } } } *out = 0; diff --git a/lwlib/xlwscrollbar.c b/lwlib/xlwscrollbar.c index 88f7cc1..2c2d293 100644 --- a/lwlib/xlwscrollbar.c +++ b/lwlib/xlwscrollbar.c @@ -485,11 +485,9 @@ arrow_same_end (XlwScrollBarWidget w) } /*-------------------------- GC and Pixel allocation --------------------*/ -#ifdef NEED_MOTIF #ifndef XmUNSPECIFIED_PIXMAP #define XmUNSPECIFIED_PIXMAP 2 #endif -#endif /* NEED_MOTIF */ static GC get_gc (XlwScrollBarWidget w, Pixel fg, Pixel bg, Pixmap pm) @@ -514,14 +512,10 @@ get_gc (XlwScrollBarWidget w, Pixel fg, Pixel bg, Pixmap pm) values.stipple = pm; /* mask = GCForeground | GCBackground | (pm == None ? 0 : GCStipple | GCFillStyle); gtb */ -#ifdef NEED_MOTIF if (pm != None && pm != 0 && pm != XmUNSPECIFIED_PIXMAP) values.stipple = pm; else values.stipple = None; -#else - values.stipple = pm; -#endif /* NEED_MOTIF */ mask = GCForeground | GCBackground | (values.stipple == None ? 0 : GCStipple | GCFillStyle); diff --git a/man/ChangeLog b/man/ChangeLog index 76ba93a..0ec892f 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,81 @@ +2000-03-20 Martin Buchholz + + * XEmacs 21.2.32 is released. + +2000-03-15 SL Baur + + * lispref/postgresql.texi (Unimplemented libpq Functions): Update + documentation to reflect the latest code. + +2000-03-07 SL Baur + + * lispref/postgresql.texi (PostgreSQL Support): New File. + + * lispref/ldap.texi: Insert PostgreSQL/libpq chapter. + * lispref/lispref.texi (Top): Ditto. + * lispref/internationalization.texi: Ditto. + +2000-03-07 Yoshiki Hayashi + + * lispref/glyphs.texi (Image Specifiers): Remove parenthesis. + +2000-03-06 Yoshiki Hayashi + + * xemacs-faq.texi: Put node before section. + +2000-03-05 Jonathan Harris + + * xemacs-faq.texi (Macintosh port): Made texinfmt-friendly. + +2000-03-01 Sandra Wambold + + * xemacs-faq.texi: Added 6.4.1. XEmacs won't start on Windows + +2000-01-25 Yoshiki Hayashi + + * xemacs/xemacs.texi: Detailed menu update. + +2000-01-28 Yoshiki Hayashi + + * xemacs/help.texi: Synch with FSF 20.5. Update. + +2000-02-21 Yoshiki Hayashi + + * lispref/minibuf.texi: Add default argument documentation. + +2000-02-27 Martin Buchholz + + * internals/internals.texi (lrecords): Update docs for new lisp + object representation. + +2000-02-25 Martin Buchholz + + * internals/internals.texi (Techniques for XEmacs Developers): + Document INLINE_HEADER and how to create macros and inline functions. + Cleanup entire section. + +2000-02-17 Stephen J. Turnbull + + * man/lispref/gutter.texi: New file describing gutter API. + + * man/lispref/lispref.texi, man/lispref/scrollbars.texi, + + * man/lispref/toolbar.texi: Fixup links to new node Gutter. + +2000-02-17 Stephen J. Turnbull + + * man/lispref/frames.texi, man/xemacs/custom.texi, + man/xemacs/frame.texi, man/xemacs/glossary.texi: Mention menubars, + toolbars, and gutters as optional components of frames, with + pointers to descriptions. + +2000-02-17 Stephen J. Turnbull + + * man/lispref/mule.texi: Substantial reorganization and + revision for style of descriptions of character sets, + encodings, and coding systems. Addition of a complete table + of coding systems as of XEmacs 21.2.19. + 2000-02-23 Martin Buchholz * XEmacs 21.2.31 is released. @@ -32,7 +110,7 @@ 2000-02-09 Martin Buchholz - * lispref/symbols.texi (Object Plists): + * lispref/symbols.texi (Object Plists): Document `object-plist'. Document `remprop'. Rework all plist frobbing docs for accuracy. @@ -90,7 +168,7 @@ 2000-01-25 Yoshiki Hayashi * xemacs-faq.texi: Untabify. - + 2000-01-22 Martin Buchholz * internals/internals.texi (General Coding Rules): Document why we @@ -99,7 +177,7 @@ 2000-01-21 Yoshiki Hayashi * xemacs-faq.texi: Change ' -- ' to '---'. - + 2000-01-19 Yoshiki Hayashi * lispref/faces.texi (Face Properties): Document @@ -203,7 +281,7 @@ 1999-12-18 Martin Buchholz - * lispref/functions.texi (Mapping Functions): + * lispref/functions.texi (Mapping Functions): Warn about mapping functions modifying their sequences. 1999-12-15 Sandra Wambold @@ -217,7 +295,7 @@ 1999-12-07 Gunnar Evermann * xemacs/startup.texi (Startup Paths): fix typo: EMACSPACKAGEPATH - instead of PACKAGEPATH + instead of PACKAGEPATH From Marcus Harnisch 1999-12-07 Martin Buchholz @@ -230,9 +308,9 @@ 1999-11-29 Martin Buchholz - * info.texi (Top): + * info.texi (Top): Remove @ifnottex, which gives old makeinfos indigestion. - * texinfo.texi (Top): + * texinfo.texi (Top): Revert to pre-texinfo-4.0 version, plus small changes to make texinfo-3.12, texinfo-3.12f, texinfo-4.0, and TeX happy. @@ -262,7 +340,7 @@ 1999-11-15 Martin Buchholz * xemacs/programs.texi: Upgrade to etags Version 13.32 - + * Makefile: - Make sure the default target is `info' instead of cl.info. - Use $(INFODIR) consistently where appropriate. @@ -369,7 +447,7 @@ * packages.texi: Reword a sentence, fixing @item Decide where to install ... -1999-07-19 Didier Verna +1999-07-19 Didier Verna * custom.texi (Wishlist): removed the Custom Comments wishlist entry. They are implemented. diff --git a/man/internals/internals.texi b/man/internals/internals.texi index f432589..dc213f4 100644 --- a/man/internals/internals.texi +++ b/man/internals/internals.texi @@ -1626,11 +1626,11 @@ stuffs a pointer together with a tag, as follows: A tag of 00 is used for all pointer object types, a tag of 10 is used for characters, and the other two tags 01 and 11 are joined together to -form the integer object type. This representation gives us 31 bits -integers, 30 bits characters and pointers are represented directly -without any bit masking. This representation, though, assumes that -pointers to structs are always aligned to multiples of 4, so the lower 2 -bits are always zero. +form the integer object type. This representation gives us 31 bit +integers and 30 bit characters, while pointers are represented directly +without any bit masking or shifting. This representation, though, +assumes that pointers to structs are always aligned to multiples of 4, +so the lower 2 bits are always zero. Lisp objects use the typedef @code{Lisp_Object}, but the actual C type used for the Lisp object can vary. It can be either a simple type @@ -1641,24 +1641,24 @@ preferable because it ensures that the compiler will actually use a machine word to represent the object (some compilers will use more general and less efficient code for unions and structs even if they can fit in a machine word). The union type, however, has the advantage of -stricter type checking (if you accidentally pass an integer where a Lisp -object is desired, you get a compile error), and it makes it easier to -decode Lisp objects when debugging. The choice of which type to use is -determined by the preprocessor constant @code{USE_UNION_TYPE} which is -defined via the @code{--use-union-type} option to @code{configure}. - -Various macros are used to construct Lisp objects and extract the -components. Macros of the form @code{XINT()}, @code{XCHAR()}, -@code{XSTRING()}, @code{XSYMBOL()}, etc. shift out the tag field if -needed cast it to the appropriate type. @code{XINT()} needs to be a bit -tricky so that negative numbers are properly sign-extended. Since +stricter type checking. If you accidentally pass an integer where a Lisp +object is desired, you get a compile error. The choice of which type +to use is determined by the preprocessor constant @code{USE_UNION_TYPE} +which is defined via the @code{--use-union-type} option to +@code{configure}. + +Various macros are used to convert between Lisp_Objects and the +corresponding C type. Macros of the form @code{XINT()}, @code{XCHAR()}, +@code{XSTRING()}, @code{XSYMBOL()}, do any required bit shifting and/or +masking and cast it to the appropriate type. @code{XINT()} needs to be +a bit tricky so that negative numbers are properly sign-extended. Since integers are stored left-shifted, if the right-shift operator does an arithmetic shift (i.e. it leaves the most-significant bit as-is rather than shifting in a zero, so that it mimics a divide-by-two even for negative numbers) the shift to remove the tag bit is enough. This is the case on all the systems we support. -Note that when @code{ERROR_CHECK_TYPECHECK} is defined, the extractor +Note that when @code{ERROR_CHECK_TYPECHECK} is defined, the converter macros become more complicated---they check the tag bits and/or the type field in the first four bytes of a record type to ensure that the object is really of the correct type. This is great for catching places @@ -1668,25 +1668,29 @@ unpredictable (and sometimes not easily traceable) results. There are similar @code{XSET@var{TYPE}()} macros that construct a Lisp object. These macros are of the form @code{XSET@var{TYPE} -(@var{lvalue}, @var{result})}, -i.e. they have to be a statement rather than just used in an expression. -The reason for this is that standard C doesn't let you ``construct'' a -structure (but GCC does). Granted, this sometimes isn't too convenient; -for the case of integers, at least, you can use the function -@code{make_int()}, which constructs and @emph{returns} an integer -Lisp object. Note that the @code{XSET@var{TYPE}()} macros are also -affected by @code{ERROR_CHECK_TYPECHECK} and make sure that the -structure is of the right type in the case of record types, where the -type is contained in the structure. +(@var{lvalue}, @var{result})}, i.e. they have to be a statement rather +than just used in an expression. The reason for this is that standard C +doesn't let you ``construct'' a structure (but GCC does). Granted, this +sometimes isn't too convenient; for the case of integers, at least, you +can use the function @code{make_int()}, which constructs and +@emph{returns} an integer Lisp object. Note that the +@code{XSET@var{TYPE}()} macros are also affected by +@code{ERROR_CHECK_TYPECHECK} and make sure that the structure is of the +right type in the case of record types, where the type is contained in +the structure. The C programmer is responsible for @strong{guaranteeing} that a -Lisp_Object is is the correct type before using the @code{X@var{TYPE}} +Lisp_Object is the correct type before using the @code{X@var{TYPE}} macros. This is especially important in the case of lists. Use @code{XCAR} and @code{XCDR} if a Lisp_Object is certainly a cons cell, else use @code{Fcar()} and @code{Fcdr()}. Trust other C code, but not Lisp code. On the other hand, if XEmacs has an internal logic error, -it's better to crash immediately, so sprinkle ``unreachable'' -@code{abort()}s liberally about the source code. +it's better to crash immediately, so sprinkle @code{assert()}s and +``unreachable'' @code{abort()}s liberally about the source code. Where +performance is an issue, use @code{type_checking_assert}, +@code{bufpos_checking_assert}, and @code{gc_checking_assert}, which do +nothing unless the corresponding configure error checking flag was +specified. @node Rules When Writing New C Code, A Summary of the Various XEmacs Modules, How Lisp Objects Are Represented in C, Top @chapter Rules When Writing New C Code @@ -1740,13 +1744,14 @@ system header files) to ensure that certain tricks played by various @file{s/} and @file{m/} files work out correctly. When including header files, always use angle brackets, not double -quotes, except when the file to be included is in the same directory as -the including file. If either file is a generated file, then that is -not likely to be the case. In order to understand why we have this -rule, imagine what happens when you do a build in the source directory -using @samp{./configure} and another build in another directory using -@samp{../work/configure}. There will be two different @file{config.h} -files. Which one will be used if you @samp{#include "config.h"}? +quotes, except when the file to be included is always in the same +directory as the including file. If either file is a generated file, +then that is not likely to be the case. In order to understand why we +have this rule, imagine what happens when you do a build in the source +directory using @samp{./configure} and another build in another +directory using @samp{../work/configure}. There will be two different +@file{config.h} files. Which one will be used if you @samp{#include +"config.h"}? @strong{All global and static variables that are to be modifiable must be declared uninitialized.} This means that you may not use the @@ -1791,7 +1796,7 @@ The C source code makes heavy use of C preprocessor macros. One popular macro style is: @example -#define FOO(var, value) do @{ \ +#define FOO(var, value) do @{ \ Lisp_Object FOO_value = (value); \ ... /* compute using FOO_value */ \ (var) = bar; \ @@ -2597,13 +2602,19 @@ proceed writing new Mule-aware code. @node Techniques for XEmacs Developers, , Coding for Mule, Rules When Writing New C Code @section Techniques for XEmacs Developers +To make a purified XEmacs, do: @code{make puremacs}. To make a quantified XEmacs, do: @code{make quantmacs}. -You simply can't dump Quantified and Purified images. Run the image -like so: @code{quantmacs -batch -l loadup.el run-temacs @var{xemacs-args...}}. +You simply can't dump Quantified and Purified images (unless using the +portable dumper). Purify gets confused when xemacs frees memory in one +process that was allocated in a @emph{different} process on a different +machine!. Run it like so: +@example +temacs -batch -l loadup.el run-temacs @var{xemacs-args...} +@end example Before you go through the trouble, are you compiling with all -debugging and error-checking off? If not try that first. Be warned +debugging and error-checking off? If not, try that first. Be warned that while Quantify is directly responsible for quite a few optimizations which have been made to XEmacs, doing a run which generates results which can be acted upon is not necessarily a trivial @@ -2642,14 +2653,116 @@ Unfortunately, Emacs Lisp is slow, and is going to stay slow. Function calls in elisp are especially expensive. Iterating over a long list is going to be 30 times faster implemented in C than in Elisp. +Heavily used small code fragments need to be fast. The traditional way +to implement such code fragments in C is with macros. But macros in C +are known to be broken. + +Macro arguments that are repeatedly evaluated may suffer from repeated +side effects or suboptimal performance. + +Variable names used in macros may collide with caller's variables, +causing (at least) unwanted compiler warnings. + +In order to solve these problems, and maintain statement semantics, one +should use the @code{do @{ ... @} while (0)} trick while trying to +reference macro arguments exactly once using local variables. + +Let's take a look at this poor macro definition: + +@example +#define MARK_OBJECT(obj) \ + if (!marked_p (obj)) mark_object (obj), did_mark = 1 +@end example + +This macro evaluates its argument twice, and also fails if used like this: +@example + if (flag) MARK_OBJECT (obj); else do_something(); +@end example + +A much better definition is + +@example +#define MARK_OBJECT(obj) do @{ \ + Lisp_Object mo_obj = (obj); \ + if (!marked_p (mo_obj)) \ + @{ \ + mark_object (mo_obj); \ + did_mark = 1; \ + @} \ +@} while (0) +@end example + +Notice the elimination of double evaluation by using the local variable +with the obscure name. Writing safe and efficient macros requires great +care. The one problem with macros that cannot be portably worked around +is, since a C block has no value, a macro used as an expression rather +than a statement cannot use the techniques just described to avoid +multiple evaluation. + +In most cases where a macro has function semantics, an inline function +is a better implementation technique. Modern compiler optimizers tend +to inline functions even if they have no @code{inline} keyword, and +configure magic ensures that the @code{inline} keyword can be safely +used as an additional compiler hint. Inline functions used in a single +.c files are easy. The function must already be defined to be +@code{static}. Just add another @code{inline} keyword to the +definition. + +@example +inline static int +heavily_used_small_function (int arg) +@{ + ... +@} +@end example + +Inline functions in header files are trickier, because we would like to +make the following optimization if the function is @emph{not} inlined +(for example, because we're compiling for debugging). We would like the +function to be defined externally exactly once, and each calling +translation unit would create an external reference to the function, +instead of including a definition of the inline function in the object +code of every translation unit that uses it. This optimization is +currently only available for gcc. But you don't have to worry about the +trickiness; just define your inline functions in header files using this +pattern: + +@example +INLINE_HEADER int +i_used_to_be_a_crufty_macro_but_look_at_me_now (int arg); +INLINE_HEADER int +i_used_to_be_a_crufty_macro_but_look_at_me_now (int arg) +@{ + ... +@} +@end example + +The declaration right before the definition is to prevent warnings when +compiling with @code{gcc -Wmissing-declarations}. I consider issuing +this warning for inline functions a gcc bug, but the gcc maintainers disagree. + +Every header which contains inline functions, either directly by using +@code{INLINE_HEADER} or indirectly by using @code{DECLARE_LRECORD} must +be added to @file{inline.c}'s includes to make the optimization +described above work. (Optimization note: if all INLINE_HEADER +functions are in fact inlined in all translation units, then the linker +can just discard @code{inline.o}, since it contains only unreferenced code). + To get started debugging XEmacs, take a look at the @file{.gdbinit} and -@file{.dbxrc} files in the @file{src} directory. -@xref{Q2.1.15 - How to Debug an XEmacs problem with a debugger,,, -xemacs-faq, XEmacs FAQ}. +@file{.dbxrc} files in the @file{src} directory. See the section in the +XEmacs FAQ on How to Debug an XEmacs problem with a debugger. After making source code changes, run @code{make check} to ensure that -you haven't introduced any regressions. If you're feeling ambitious, -you can try to improve the test suite in @file{tests/automated}. +you haven't introduced any regressions. If you want to make xemacs more +reliable, please improve the test suite in @file{tests/automated}. + +Did you make sure you didn't introduce any new compiler warnings? + +Before submitting a patch, please try compiling at least once with + +@example +configure --with-mule --with-union-type --error-checking=all +@end example Here are things to know when you create a new source file: @@ -2676,23 +2789,6 @@ Header files should @emph{not} include @code{} and @code{"lisp.h"}. It is the responsibility of the @file{.c} files that use it to do so. -@item -If the header uses @code{INLINE}, either directly or through -@code{DECLARE_LRECORD}, then it must be added to @file{inline.c}'s -includes. - -@item -Try compiling at least once with - -@example -gcc --with-mule --with-union-type --error-checking=all -@end example - -@item -Did I mention that you should run the test suite? -@example -make check -@end example @end itemize Here is a checklist of things to do when creating a new lisp object type @@ -2704,17 +2800,20 @@ create @var{foo}.h @item create @var{foo}.c @item -add definitions of syms_of_@var{foo}, etc. to @var{foo}.c +add definitions of @code{syms_of_@var{foo}}, etc. to @file{@var{foo}.c} +@item +add declarations of @code{syms_of_@var{foo}}, etc. to @file{symsinit.h} @item -add declarations of syms_of_@var{foo}, etc. to symsinit.h +add calls to @code{syms_of_@var{foo}}, etc. to @file{emacs.c} @item -add calls to syms_of_@var{foo}, etc. to emacs.c(main_1) +add definitions of macros like @code{CHECK_@var{FOO}} and +@code{@var{FOO}P} to @file{@var{foo}.h} @item -add definitions of macros like CHECK_FOO and FOOP to @var{foo}.h +add the new type index to @code{enum lrecord_type} @item -add the new type index to enum lrecord_type +add a DEFINE_LRECORD_IMPLEMENTATION call to @file{@var{foo}.c} @item -add DEFINE_LRECORD_IMPLEMENTATION call to @var{foo}.c +add an INIT_LRECORD_IMPLEMENTATION call to @code{syms_of_@var{foo}.c} @end enumerate @node A Summary of the Various XEmacs Modules, Allocation of Objects in XEmacs Lisp, Rules When Writing New C Code, Top @@ -5166,7 +5265,9 @@ more defensive but less efficient and is used for error-checking.) All lrecords have at the beginning of their structure a @code{struct lrecord_header}. This just contains a type number and some flags, -including the mark bit. The type number, thru the +including the mark bit. All builtin type numbers are defined as +constants in @code{enum lrecord_type}, to allow the compiler to generate +more efficient code for @code{@var{type}P}. The type number, thru the @code{lrecord_implementation_table}, gives access to a @code{struct lrecord_implementation}, which is a structure containing method pointers and such. There is one of these for each type, and it is a global, @@ -5201,21 +5302,21 @@ type. Whenever you create an lrecord, you need to call either @code{DEFINE_LRECORD_IMPLEMENTATION()} or @code{DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION()}. This needs to be -specified in a C file, at the top level. What this actually does is -define and initialize the implementation structure for the lrecord. (And -possibly declares a function @code{error_check_foo()} that implements -the @code{XFOO()} macro when error-checking is enabled.) The arguments -to the macros are the actual type name (this is used to construct the C -variable name of the lrecord implementation structure and related -structures using the @samp{##} macro concatenation operator), a string -that names the type on the Lisp level (this may not be the same as the C -type name; typically, the C type name has underscores, while the Lisp -string has dashes), various method pointers, and the name of the C -structure that contains the object. The methods are used to encapsulate -type-specific information about the object, such as how to print it or -mark it for garbage collection, so that it's easy to add new object -types without having to add a specific case for each new type in a bunch -of different places. +specified in a @file{.c} file, at the top level. What this actually +does is define and initialize the implementation structure for the +lrecord. (And possibly declares a function @code{error_check_foo()} that +implements the @code{XFOO()} macro when error-checking is enabled.) The +arguments to the macros are the actual type name (this is used to +construct the C variable name of the lrecord implementation structure +and related structures using the @samp{##} macro concatenation +operator), a string that names the type on the Lisp level (this may not +be the same as the C type name; typically, the C type name has +underscores, while the Lisp string has dashes), various method pointers, +and the name of the C structure that contains the object. The methods +are used to encapsulate type-specific information about the object, such +as how to print it or mark it for garbage collection, so that it's easy +to add new object types without having to add a specific case for each +new type in a bunch of different places. The difference between @code{DEFINE_LRECORD_IMPLEMENTATION()} and @code{DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION()} is that the former is @@ -5229,21 +5330,20 @@ to determine the actual size of a particular object of that type. For the purpose of keeping allocation statistics, the allocation engine keeps a list of all the different types that exist. Note that, since @code{DEFINE_LRECORD_IMPLEMENTATION()} is a macro that is -specified at top-level, there is no way for it to add to the list of all -existing types. What happens instead is that each implementation -structure contains in it a dynamically assigned number that is -particular to that type. (Or rather, it contains a pointer to another -structure that contains this number. This evasiveness is done so that -the implementation structure can be declared const.) In the sweep stage -of garbage collection, each lrecord is examined to see if its -implementation structure has its dynamically-assigned number set. If -not, it must be a new type, and it is added to the list of known types -and a new number assigned. The number is used to index into an array -holding the number of objects of each type and the total memory -allocated for objects of that type. The statistics in this array are -also computed during the sweep stage. These statistics are returned by -the call to @code{garbage-collect} and are printed out at the end of the -loadup phase. +specified at top-level, there is no way for it to initialize the global +data structures containing type information, like +@code{lrecord_implementations_table}. For this reason a call to +@code{INIT_LRECORD_IMPLEMENTATION} must be added to the same source file +containing @code{DEFINE_LRECORD_IMPLEMENTATION}, but instead of to the +top level, to one of the init functions, typically +@code{syms_of_@var{foo}.c}. @code{INIT_LRECORD_IMPLEMENTATION} must be +called before an object of this type is used. + +The type number is also used to index into an array holding the number +of objects of each type and the total memory allocated for objects of +that type. The statistics in this array are computed during the sweep +stage. These statistics are returned by the call to +@code{garbage-collect}. Note that for every type defined with a @code{DEFINE_LRECORD_*()} macro, there needs to be a @code{DECLARE_LRECORD_IMPLEMENTATION()} @@ -5449,16 +5549,15 @@ warning system, when memory gets to 75%, 85%, and 95% full. (On some systems, the memory warnings are not functional.) Allocated memory that is going to be used to make a Lisp object -is created using @code{allocate_lisp_storage()}. This calls @code{xmalloc()} -but also verifies that the pointer to the memory can fit into -a Lisp word (remember that some bits are taken away for a type -tag and a mark bit). If not, an error is issued through @code{memory_full()}. -@code{allocate_lisp_storage()} is called by @code{alloc_lcrecord()}, -@code{ALLOCATE_FIXED_TYPE()}, and the vector and bit-vector creation -routines. These routines also call @code{INCREMENT_CONS_COUNTER()} at the -appropriate times; this keeps statistics on how much memory is -allocated, so that garbage-collection can be invoked when the -threshold is reached. +is created using @code{allocate_lisp_storage()}. This just calls +@code{xmalloc()}. It used to verify that the pointer to the memory can +fit into a Lisp word, before the current Lisp object representation was +introduced. @code{allocate_lisp_storage()} is called by +@code{alloc_lcrecord()}, @code{ALLOCATE_FIXED_TYPE()}, and the vector +and bit-vector creation routines. These routines also call +@code{INCREMENT_CONS_COUNTER()} at the appropriate times; this keeps +statistics on how much memory is allocated, so that garbage-collection +can be invoked when the threshold is reached. @node Cons, Vector, Low-level allocation, Allocation of Objects in XEmacs Lisp @section Cons @@ -8798,4 +8897,3 @@ Not yet documented. @c That's all @bye - diff --git a/man/lispref/frames.texi b/man/lispref/frames.texi index fb7e633..1ae6f9b 100644 --- a/man/lispref/frames.texi +++ b/man/lispref/frames.texi @@ -9,9 +9,19 @@ @cindex frame A @var{frame} is a rectangle on the screen that contains one or more -XEmacs windows. A frame initially contains a single main window (plus -perhaps a minibuffer window), which you can subdivide vertically or -horizontally into smaller windows. +XEmacs windows (@pxref{Windows}). A frame initially contains a single +main window (plus perhaps an echo area), which you can subdivide +vertically or horizontally into smaller windows. Each window is +associated with a modeline (@pxref{Modeline Format}), and optionally two +scrollbars (@pxref{Scrollbars}). By default the vertical scrollbar is +on, the horizontal scrollbar is off. + + The frame may also contain menubars (@pxref{Menubar}), toolbars +(@pxref{Toolbar Intro}), and gutters (@pxref{Gutter Intro}). By default +there is one of each at the top of the frame, with menubar topmost, +toolbar next, and gutter lowest, immediately above the windows. +(Warning: the gutter is a new, experimental, and unstable feature of +XEmacs version 21.2.) @cindex terminal frame @cindex X window frame diff --git a/man/lispref/glyphs.texi b/man/lispref/glyphs.texi index 1c71406..3cffa49 100644 --- a/man/lispref/glyphs.texi +++ b/man/lispref/glyphs.texi @@ -462,65 +462,64 @@ pairs. The @dfn{format} field should be a symbol, one of @table @code @item nothing -(Don't display anything; no keywords are valid for this. Can only be -instanced as @code{nothing}.) +Don't display anything; no keywords are valid for this. Can only be +instanced as @code{nothing}. @item string -(Display this image as a text string. Can only be instanced +Display this image as a text string. Can only be instanced as @code{text}, although support for instancing as @code{mono-pixmap} -should be added.) +should be added. @item formatted-string -(Display this image as a text string with replaceable fields, -similar to a modeline format string; not currently implemented.) +Display this image as a text string with replaceable fields, +similar to a modeline format string; not currently implemented. @item xbm -(An X bitmap; only if X support was compiled into this XEmacs. Can be +An X bitmap; only if X support was compiled into this XEmacs. Can be instanced as @code{mono-pixmap}, @code{color-pixmap}, or -@code{pointer}.) +@code{pointer}. @item xpm -(An XPM pixmap; only if XPM support was compiled into this XEmacs. Can +An XPM pixmap; only if XPM support was compiled into this XEmacs. Can be instanced as @code{color-pixmap}, @code{mono-pixmap}, or @code{pointer}. XPM is an add-on library for X that was designed to rectify the shortcomings of the XBM format. Most implementations of X include the XPM library as a standard part. If your vendor does not, it is highly recommended that you download it and install it. You can get -it from the standard XEmacs FTP site, among other places.) +it from the standard XEmacs FTP site, among other places. @item xface -(An X-Face bitmap, used to encode people's faces in e-mail messages; +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 @code{mono-pixmap}, @code{color-pixmap}, or @code{pointer}.) +as @code{mono-pixmap}, @code{color-pixmap}, or @code{pointer}. @item gif -(A GIF87 or GIF89 image; only if GIF support was compiled into this +A GIF87 or GIF89 image; only if GIF support was compiled into this XEmacs. Can be instanced as @code{color-pixmap}. Note that XEmacs includes GIF decoding functions as a standard part of it, so if you have X support, you will normally have GIF support, unless you explicitly -disable it at configure time.) +disable it at configure time. @item jpeg -(A JPEG-format image; only if JPEG support was compiled into this +A JPEG-format image; only if JPEG support was compiled into this XEmacs. Can be instanced as @code{color-pixmap}. If you have the JPEG libraries present on your system when XEmacs is built, XEmacs will automatically detect this and use them, unless you explicitly disable it -at configure time.) +at configure time. @item png -(A PNG/GIF24 image; only if PNG support was compiled into this XEmacs. -Can be instanced as @code{color-pixmap}.) +A PNG/GIF24 image; only if PNG support was compiled into this XEmacs. +Can be instanced as @code{color-pixmap}. @item tiff -(A TIFF-format image; only if TIFF support was compiled into this XEmacs. -Not currently implemented.) +A TIFF-format image; only if TIFF support was compiled into this XEmacs. @item cursor-font -(One of the standard cursor-font names, such as @samp{watch} or +One of the standard cursor-font names, such as @samp{watch} or @samp{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 @file{}] minus the @samp{XC_} prefix. On other window systems, the valid names will be specific to the type of -window system. Can only be instanced as @code{pointer}.) +window system. Can only be instanced as @code{pointer}. @item font -(A glyph from a font; i.e. the name of a font, and glyph index into it +A glyph from a font; i.e. the name of a font, and glyph index into it of the form @samp{@var{font} fontname index [[mask-font] mask-index]}. Only if X support was compiled into this XEmacs. Currently can only be -instanced as @code{pointer}, although this should probably be fixed.) +instanced as @code{pointer}, although this should probably be fixed. @item subwindow -(An embedded X window; not currently implemented.) +An embedded X window; not currently implemented. @item autodetect -(XEmacs tries to guess what format the data is in. If X support exists, +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 @@ -528,66 +527,66 @@ specified hotspot or associated mask file.] Otherwise, if @code{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.) +the image will always be displayed as text. @end table The valid keywords are: @table @code @item :data -(Inline data. For most formats above, this should be a string. For +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 -format @code{nothing}.) +format @code{nothing}. @item :file -(Data is contained in a file. The value is the name of this file. If +Data is contained in a file. The value is the name of this file. If both @code{:data} and @code{:file} are specified, the image is created from what is specified in @code{:data} and the string in @code{:file} becomes the value of the @code{image-instance-file-name} function when applied to the resulting image-instance. This keyword is not valid for instantiator formats @code{nothing}, @code{string}, @code{formatted-string}, @code{cursor-font}, @code{font}, and -@code{autodetect}.) +@code{autodetect}. @item :foreground @itemx :background -(For @code{xbm}, @code{xface}, @code{cursor-font}, and @code{font}. +For @code{xbm}, @code{xface}, @code{cursor-font}, and @code{font}. These keywords allow you to explicitly specify foreground and background colors. The argument should be anything acceptable to @code{make-color-instance}. This will cause what would be a @code{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.) +instead of black and white. @item :mask-data -(For @code{xbm} and @code{xface}. This specifies a mask to be used with the +For @code{xbm} and @code{xface}. This specifies a mask to be used with the bitmap. The format is a list of width, height, and bits, like for -@code{:data}.) +@code{:data}. @item :mask-file -(For @code{xbm} and @code{xface}. This specifies a file containing the +For @code{xbm} and @code{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 @samp{Mask} or @samp{msk} appended. For example, if you specify the XBM file @file{left_ptr} [usually located in @file{/usr/include/X11/bitmaps}], the associated mask file @file{left_ptrmsk} will automatically be picked -up.) +up. @item :hotspot-x @itemx :hotspot-y -(For @code{xbm} and @code{xface}. These keywords specify a hotspot if +For @code{xbm} and @code{xface}. These keywords specify a hotspot if the image is instantiated as a @code{pointer}. Note that if the XBM image file specifies a hotspot, it will automatically be picked up if no -explicit hotspot is given.) +explicit hotspot is given. @item :color-symbols -(Only for @code{xpm}. This specifies an alist that maps strings that +Only for @code{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 @code{xpm-color-symbols} are -used to generate the alist.) +used to generate the alist. @end table If instead of a vector, the instantiator is a string, it will be diff --git a/man/lispref/internationalization.texi b/man/lispref/internationalization.texi index 39eb968..b39bee5 100644 --- a/man/lispref/internationalization.texi +++ b/man/lispref/internationalization.texi @@ -3,7 +3,7 @@ @c Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. @c See the file lispref.texi for copying conditions. @setfilename ../../info/internationalization.info -@node Internationalization, MULE, LDAP Support, top +@node Internationalization, MULE, PostgreSQL Support, top @chapter Internationalization @menu diff --git a/man/lispref/ldap.texi b/man/lispref/ldap.texi index a3a3ffd..9195a2b 100644 --- a/man/lispref/ldap.texi +++ b/man/lispref/ldap.texi @@ -3,7 +3,7 @@ @c Copyright (C) 1998 Free Software Foundation, Inc. @c See the file lispref.texi for copying conditions. @setfilename ../../info/ldap.info -@node LDAP Support, Internationalization, ToolTalk Support, top +@node LDAP Support, PostgreSQL Support, ToolTalk Support, top @chapter LDAP Support @cindex LDAP diff --git a/man/lispref/lispref.texi b/man/lispref/lispref.texi index 8b22bcf..ac6277b 100644 --- a/man/lispref/lispref.texi +++ b/man/lispref/lispref.texi @@ -159,6 +159,7 @@ Reference Manual, corresponding to XEmacs version 21.0. * Menus:: Defining pull-down and pop-up menus. * Dialog Boxes:: Creating dialog boxes. * Toolbar:: Controlling the toolbar. +* Gutter:: Controlling the gutter. * Scrollbars:: Controlling the scrollbars. * Drag and Drop:: Generic API to inter-application communication via specific protocols. @@ -204,6 +205,7 @@ Reference Manual, corresponding to XEmacs version 21.0. * ToolTalk Support:: Interfacing with the ToolTalk message service. * LDAP Support:: Interfacing with the Lightweight Directory Access Protocol. +* PostgreSQL Support:: Interfacing to the PostgreSQL libpq library. * Internationalization:: How Emacs supports different languages and cultural conventions. * MULE:: Specifics of the Asian-language support. @@ -623,6 +625,8 @@ Toolbar * Specifying the Toolbar:: Setting a toolbar. * Other Toolbar Variables:: Controlling the size of toolbars. +Gutter + Scrollbars Major and Minor Modes @@ -1163,6 +1167,7 @@ Building XEmacs and Object Allocation @include menus.texi @include dialog.texi @include toolbar.texi +@include gutter.texi @include scrollbars.texi @include dragndrop.texi @include modes.texi @@ -1199,6 +1204,7 @@ Building XEmacs and Object Allocation @include x-windows.texi @include tooltalk.texi @include ldap.texi +@include postgresql.texi @include internationalization.texi @include mule.texi diff --git a/man/lispref/minibuf.texi b/man/lispref/minibuf.texi index 1e1e9ed..23508f7 100644 --- a/man/lispref/minibuf.texi +++ b/man/lispref/minibuf.texi @@ -150,23 +150,26 @@ the minibuffer on other occasions. However, if user is supposed to edit default value, @var{initial-contents} may be preferred. @end defun -@defun read-string prompt &optional initial history +@defun read-string prompt &optional initial history default-value This function reads a string from the minibuffer and returns it. The arguments @var{prompt} and @var{initial} are used as in @code{read-from-minibuffer}. The keymap used is @code{minibuffer-local-map}. The optional argument @var{history}, if non-nil, specifies a history -list and optionally the initial position in the list. +list and optionally the initial position in the list. The optional +argument @var{default} specifies a default value to return if the user +enters null input; it should be a string. This function is a simplified interface to the @code{read-from-minibuffer} function: @smallexample @group -(read-string @var{prompt} @var{initial}) +(read-string @var{prompt} @var{initial} @var{history} @var{default}) @equiv{} -(read-from-minibuffer @var{prompt} @var{initial} nil nil nil) +(read-from-minibuffer @var{prompt} @var{initial} nil nil + @var{history} nil @var{default}))) @end group @end smallexample @end defun @@ -205,19 +208,25 @@ default, it makes the following bindings: This section describes functions for reading Lisp objects with the minibuffer. -@defun read-minibuffer prompt &optional initial +@defun read-expression prompt &optional initial history default-value This function reads a Lisp object using the minibuffer, and returns it without evaluating it. The arguments @var{prompt} and @var{initial} are used as in @code{read-from-minibuffer}. +The optional argument @var{history}, if non-nil, specifies a history +list and optionally the initial position in the list. The optional +argument @var{default-value} specifies a default value to return if the +user enters null input; it should be a string. + This is a simplified interface to the @code{read-from-minibuffer} function: @smallexample @group -(read-minibuffer @var{prompt} @var{initial}) +(read-expression @var{prompt} @var{initial} @var{history} @var{default-value}) @equiv{} -(read-from-minibuffer @var{prompt} @var{initial} nil t) +(read-from-minibuffer @var{prompt} @var{initial} nil t + @var{history} nil @var{default-value}) @end group @end smallexample @@ -226,7 +235,7 @@ initial input: @smallexample @group -(read-minibuffer +(read-expression "Enter an expression: " (format "%s" '(testing))) ;; @r{Here is how the minibuffer is displayed:} @@ -244,27 +253,38 @@ The user can type @key{RET} immediately to use the initial input as a default, or can edit the input. @end defun -@defun eval-minibuffer prompt &optional initial +@defun read-minibuffer prompt &optional initial history default-value + +This is a FSF Emacs compatible function. Use @code{read-expression} +instead. +@end defun + +@defun eval-minibuffer prompt &optional initial history default-value This function reads a Lisp expression using the minibuffer, evaluates it, then returns the result. The arguments @var{prompt} and @var{initial} are used as in @code{read-from-minibuffer}. +The optional argument @var{history}, if non-nil, specifies a history +list and optionally the initial position in the list. The optional +argument @var{default-value} specifies a default value to return if the +user enters null input; it should be a string. + This function simply evaluates the result of a call to -@code{read-minibuffer}: +@code{read-expression}: @smallexample @group (eval-minibuffer @var{prompt} @var{initial}) @equiv{} -(eval (read-minibuffer @var{prompt} @var{initial})) +(eval (read-expression @var{prompt} @var{initial})) @end group @end smallexample @end defun -@defun edit-and-eval-command prompt form +@defun edit-and-eval-command prompt command &optional history This function reads a Lisp expression in the minibuffer, and then evaluates it. The difference between this command and -@code{eval-minibuffer} is that here the initial @var{form} is not +@code{eval-minibuffer} is that here the initial @var{command} is not optional and it is treated as a Lisp object to be converted to printed representation rather than as a string of text. It is printed with @code{prin1}, so if it is a string, double-quote characters (@samp{"}) @@ -605,7 +625,7 @@ value of @var{require-match}, and regardless of whether the empty string is included in @var{collection}. The function @code{completing-read} works by calling -@code{read-minibuffer}. It uses @code{minibuffer-local-completion-map} +@code{read-expression}. It uses @code{minibuffer-local-completion-map} as the keymap if @var{require-match} is @code{nil}, and uses @code{minibuffer-local-must-match-map} if @var{require-match} is non-@code{nil}. @xref{Completion Commands}. @@ -755,7 +775,7 @@ The list of completions is displayed as text in a buffer named @samp{*Completions*}. @end deffn -@defun display-completion-list completions +@defun display-completion-list completions &rest cl-keys This function displays @var{completions} to the stream in @code{standard-output}, usually a buffer. (@xref{Read and Print}, for more information about streams.) The argument @var{completions} is normally @@ -832,13 +852,19 @@ Buffer name? (default foo) @point{} @end example @end defun -@defun read-command prompt +@defun read-command prompt &optinal default-value This function reads the name of a command and returns it as a Lisp symbol. The argument @var{prompt} is used as in @code{read-from-minibuffer}. Recall that a command is anything for which @code{commandp} returns @code{t}, and a command name is a symbol for which @code{commandp} returns @code{t}. @xref{Interactive Call}. +The argument @var{default-value} specifies what to return if the user +enters null input. It can be a symbol or a string; if it is a string, +@code{read-command} interns it before returning it. If @var{default} is +@code{nil}, that means no default has been specified; then if the user +enters null input, the return value is @code{nil}. + @example (read-command "Command name? ") @@ -874,10 +900,16 @@ as to complete in the set of extant Lisp symbols, and it uses the @end example @end defun -@defun read-variable prompt +@defun read-variable prompt &optional default-value This function reads the name of a user variable and returns it as a symbol. +The argument @var{default-value} specifies what to return if the user +enters null input. It can be a symbol or a string; if it is a string, +@code{read-variable} interns it before returning it. If @var{default} +is @code{nil}, that means no default has been specified; then if the +user enters null input, the return value is @code{nil}. + @example @group (read-variable "Variable name? ") @@ -920,7 +952,7 @@ predicate @code{user-variable-p} instead of @code{commandp}: file name. It provides special features including automatic insertion of the default directory. -@defun read-file-name prompt &optional directory default existing initial +@defun read-file-name prompt &optional directory default existing initial history This function reads a file name in the minibuffer, prompting with @var{prompt} and providing completion. If @var{default} is non-@code{nil}, then the function returns @var{default} if the user just diff --git a/man/lispref/mule.texi b/man/lispref/mule.texi index cae4960..65e518e 100644 --- a/man/lispref/mule.texi +++ b/man/lispref/mule.texi @@ -6,13 +6,13 @@ @node MULE, Tips, Internationalization, top @chapter MULE -@dfn{MULE} is the name originally given to the version of GNU Emacs + @dfn{MULE} is the name originally given to the version of GNU Emacs extended for multi-lingual (and in particular Asian-language) support. -``MULE'' is short for ``MUlti-Lingual Emacs''. It was originally called -Nemacs (``Nihon Emacs'' where ``Nihon'' is the Japanese word for -``Japan''), when it only provided support for Japanese. XEmacs -refers to its multi-lingual support as @dfn{MULE support} since it -is based on @dfn{MULE}. +``MULE'' is short for ``MUlti-Lingual Emacs''. It is an extension and +complete rewrite of Nemacs (``Nihon Emacs'' where ``Nihon'' is the +Japanese word for ``Japan''), which only provided support for Japanese. +XEmacs refers to its multi-lingual support as @dfn{MULE support} since +it is based on @dfn{MULE}. @menu * Internationalization Terminology:: @@ -20,25 +20,40 @@ is based on @dfn{MULE}. * Charsets:: Sets of related characters. * MULE Characters:: Working with characters in XEmacs/MULE. * Composite Characters:: Making new characters by overstriking other ones. -* ISO 2022:: An international standard for charsets and encodings. * Coding Systems:: Ways of representing a string of chars using integers. * CCL:: A special language for writing fast converters. * Category Tables:: Subdividing charsets into groups. @end menu -@node Internationalization Terminology +@node Internationalization Terminology, Charsets, , MULE @section Internationalization Terminology - In internationalization terminology, a string of text is divided up + In internationalization terminology, a string of text is divided up into @dfn{characters}, which are the printable units that make up the text. A single character is (for example) a capital @samp{A}, the -number @samp{2}, a Katakana character, a Kanji ideograph (an -@dfn{ideograph} is a ``picture'' character, such as is used in Japanese -Kanji, Chinese Hanzi, and Korean Hangul; typically there are thousands -of such ideographs in each language), etc. The basic property of a -character is its shape. Note that the same character may be drawn by -two different people (or in two different fonts) in slightly different -ways, although the basic shape will be the same. +number @samp{2}, a Katakana character, a Hangul character, a Kanji +ideograph (an @dfn{ideograph} is a ``picture'' character, such as is +used in Japanese Kanji, Chinese Hanzi, and Korean Hanja; typically there +are thousands of such ideographs in each language), etc. The basic +property of a character is that it is the smallest unit of text with +semantic significance in text processing. + + Human beings normally process text visually, so to a first approximation +a character may be identified with its shape. Note that the same +character may be drawn by two different people (or in two different +fonts) in slightly different ways, although the "basic shape" will be the +same. But consider the works of Scott Kim; human beings can recognize +hugely variant shapes as the "same" character. Sometimes, especially +where characters are extremely complicated to write, completely +different shapes may be defined as the "same" character in national +standards. The Taiwanese variant of Hanzi is generally the most +complicated; over the centuries, the Japanese, Koreans, and the People's +Republic of China have adopted simplifications of the shape, but the +line of descent from the original shape is recorded, and the meanings +and pronunciation of different forms of the same character are +considered to be identical within each language. (Of course, it may +take a specialist to recognize the related form; the point is that the +relations are standardized, despite the differing shapes.) In some cases, the differences will be significant enough that it is actually possible to identify two or more distinct shapes that both @@ -57,87 +72,122 @@ are different characters rather than different glyphs---e.g. Note that @dfn{character} and @dfn{glyph} are used differently here than elsewhere in XEmacs. - A @dfn{character set} is simply a set of related characters. ASCII, + A @dfn{character set} is essentially a set of related characters. ASCII, for example, is a set of 94 characters (or 128, if you count non-printing characters). Other character sets are ISO8859-1 (ASCII plus various accented characters and other international symbols), -JISX0201 (ASCII, more or less, plus half-width Katakana), JISX0208 -(Japanese Kanji), JISX0212 (a second set of less-used Japanese Kanji), +JIS X 0201 (ASCII, more or less, plus half-width Katakana), JIS X 0208 +(Japanese Kanji), JIS X 0212 (a second set of less-used Japanese Kanji), GB2312 (Mainland Chinese Hanzi), etc. - Every character set has one or more @dfn{orderings}, which can be -viewed as a way of assigning a number (or set of numbers) to each -character in the set. For most character sets, there is a standard -ordering, and in fact all of the character sets mentioned above define a -particular ordering. ASCII, for example, places letters in their -``natural'' order, puts uppercase letters before lowercase letters, -numbers before letters, etc. Note that for many of the Asian character -sets, there is no natural ordering of the characters. The actual -orderings are based on one or more salient characteristic, of which -there are many to choose from---e.g. number of strokes, common -radicals, phonetic ordering, etc. - - The set of numbers assigned to any particular character are called -the character's @dfn{position codes}. The number of position codes -required to index a particular character in a character set is called -the @dfn{dimension} of the character set. ASCII, being a relatively -small character set, is of dimension one, and each character in the -set is indexed using a single position code, in the range 0 through -127 (if non-printing characters are included) or 33 through 126 -(if only the printing characters are considered). JISX0208, i.e. -Japanese Kanji, has thousands of characters, and is of dimension two -- -every character is indexed by two position codes, each in the range -33 through 126. (Note that the choice of the range here is somewhat -arbitrary. Although a character set such as JISX0208 defines an -@emph{ordering} of all its characters, it does not define the actual -mapping between numbers and characters. You could just as easily -index the characters in JISX0208 using numbers in the range 0 through -93, 1 through 94, 2 through 95, etc. The reason for the actual range -chosen is so that the position codes match up with the actual values -used in the common encodings.) + The definition of a character set will implicitly or explicitly give +it an @dfn{ordering}, a way of assigning a number to each character in +the set. For many character sets, there is a natural ordering, for +example the ``ABC'' ordering of the Roman letters. But it is not clear +whether digits should come before or after the letters, and in fact +different European languages treat the ordering of accented characters +differently. It is useful to use the natural order where available, of +course. The number assigned to any particular character is called the +character's @dfn{code point}. (Within a given character set, each +character has a unique code point. Thus the word "set" is ill-chosen; +different orderings of the same characters are different character sets. +Identifying characters is simple enough for alphabetic character sets, +but the difference in ordering can cause great headaches when the same +thousands of characters are used by different cultures as in the Hanzi.) + + A code point may be broken into a number of @dfn{position codes}. The +number of position codes required to index a particular character in a +character set is called the @dfn{dimension} of the character set. For +practical purposes, a position code may be thought of as a byte-sized +index. The printing characters of ASCII, being a relatively small +character set, is of dimension one, and each character in the set is +indexed using a single position code, in the range 1 through 94. Use of +this unusual range, rather than the familiar 33 through 126, is an +intentional abstraction; to understand the programming issues you must +break the equation between character sets and encodings. + + JIS X 0208, i.e. Japanese Kanji, has thousands of characters, and is +of dimension two -- every character is indexed by two position codes, +each in the range 1 through 94. (This number ``94'' is not a +coincidence; we shall see that the JIS position codes were chosen so +that JIS kanji could be encoded without using codes that in ASCII are +associated with device control functions.) Note that the choice of the +range here is somewhat arbitrary. You could just as easily index the +printing characters in ASCII using numbers in the range 0 through 93, 2 +through 95, 3 through 96, etc. In fact, the standardized +@emph{encoding} for the ASCII @emph{character set} uses the range 33 +through 126. An @dfn{encoding} is a way of numerically representing characters from one or more character sets into a stream of like-sized numerical values called @dfn{words}; typically these are 8-bit, 16-bit, or 32-bit quantities. If an encoding encompasses only one character set, then the position codes for the characters in that character set could be used -directly. (This is the case with ASCII, and as a result, most people do -not understand the difference between a character set and an encoding.) -This is not possible, however, if more than one character set is to be -used in the encoding. For example, printed Japanese text typically -requires characters from multiple character sets---ASCII, JISX0208, and -JISX0212, to be specific. Each of these is indexed using one or more -position codes in the range 33 through 126, so the position codes could -not be used directly or there would be no way to tell which character -was meant. Different Japanese encodings handle this differently---JIS -uses special escape characters to denote different character sets; EUC -sets the high bit of the position codes for JISX0208 and JISX0212, and -puts a special extra byte before each JISX0212 character; etc. (JIS, -EUC, and most of the other encodings you will encounter are 7-bit or -8-bit encodings. There is one common 16-bit encoding, which is Unicode; -this strives to represent all the world's characters in a single large -character set. 32-bit encodings are generally used internally in -programs to simplify the code that manipulates them; however, they are -not much used externally because they are not very space-efficient.) +directly. (This is the case with the trivial cipher used by children, +assigning 1 to `A', 2 to `B', and so on.) However, even with ASCII, +other considerations intrude. For example, why are the upper- and +lowercase alphabets separated by 8 characters? Why do the digits start +with `0' being assigned the code 48? In both cases because semantically +interesting operations (case conversion and numerical value extraction) +become convenient masking operations. Other artificial aspects (the +control characters being assigned to codes 0--31 and 127) are historical +accidents. (The use of 127 for @samp{DEL} is an artifact of the "punch +once" nature of paper tape, for example.) + + Naive use of the position code is not possible, however, if more than +one character set is to be used in the encoding. For example, printed +Japanese text typically requires characters from multiple character sets +-- ASCII, JIS X 0208, and JIS X 0212, to be specific. Each of these is +indexed using one or more position codes in the range 1 through 94, so +the position codes could not be used directly or there would be no way +to tell which character was meant. Different Japanese encodings handle +this differently -- JIS uses special escape characters to denote +different character sets; EUC sets the high bit of the position codes +for JIS X 0208 and JIS X 0212, and puts a special extra byte before each +JIS X 0212 character; etc. (JIS, EUC, and most of the other encodings +you will encounter in files are 7-bit or 8-bit encodings. There is one +common 16-bit encoding, which is Unicode; this strives to represent all +the world's characters in a single large character set. 32-bit +encodings are often used internally in programs, such as XEmacs with +MULE support, to simplify the code that manipulates them; however, they +are not used externally because they are not very space-efficient.) + + A general method of handling text using multiple character sets +(whether for multilingual text, or simply text in an extremely +complicated single language like Japanese) is defined in the +international standard ISO 2022. ISO 2022 will be discussed in more +detail later (@pxref{ISO 2022}), but for now suffice it to say that text +needs control functions (at least spacing), and if escape sequences are +to be used, an escape sequence introducer. It was decided to make all +text streams compatible with ASCII in the sense that the codes 0--31 +(and 128-159) would always be control codes, never graphic characters, +and where defined by the character set the @samp{SPC} character would be +assigned code 32, and @samp{DEL} would be assigned 127. Thus there are +94 code points remaining if 7 bits are used. This is the reason that +most character sets are defined using position codes in the range 1 +through 94. Then ISO 2022 compatible encodings are produced by shifting +the position codes 1 to 94 into character codes 33 to 126, or (if 8 bit +codes are available) into character codes 161 to 254. Encodings are classified as either @dfn{modal} or @dfn{non-modal}. In -a @dfn{modal encoding}, there are multiple states that the encoding can be in, -and the interpretation of the values in the stream depends on the +a @dfn{modal encoding}, there are multiple states that the encoding can +be in, and the interpretation of the values in the stream depends on the current global state of the encoding. Special values in the encoding, called @dfn{escape sequences}, are used to change the global state. JIS, for example, is a modal encoding. The bytes @samp{ESC $ B} indicate that, from then on, bytes are to be interpreted as position -codes for JISX0208, rather than as ASCII. This effect is cancelled +codes for JIS X 0208, rather than as ASCII. This effect is cancelled using the bytes @samp{ESC ( B}, which mean ``switch from whatever the -current state is to ASCII''. To switch to JISX0212, the escape sequence -@samp{ESC $ ( D}. (Note that here, as is common, the escape sequences do -in fact begin with @samp{ESC}. This is not necessarily the case, -however.) +current state is to ASCII''. To switch to JIS X 0212, the escape +sequence @samp{ESC $ ( D}. (Note that here, as is common, the escape +sequences do in fact begin with @samp{ESC}. This is not necessarily the +case, however. Some encodings use control characters called "locking +shifts" (effect persists until cancelled) to switch character sets.) -A @dfn{non-modal encoding} has no global state that extends past the + A @dfn{non-modal encoding} has no global state that extends past the character currently being interpreted. EUC, for example, is a -non-modal encoding. Characters in JISX0208 are encoded by setting -the high bit of the position codes, and characters in JISX0212 are +non-modal encoding. Characters in JIS X 0208 are encoded by setting +the high bit of the position codes, and characters in JIS X 0212 are encoded by doing the same but also prefixing the character with the byte 0x8F. @@ -148,10 +198,11 @@ disadvantage, however, is that it is much more difficult to work with if it is not being processed in a sequential manner. In the non-modal EUC encoding, for example, the byte 0x41 always refers to the letter @samp{A}; whereas in JIS, it could either be the letter @samp{A}, or -one of the two position codes in a JISX0208 character, or one of the -two position codes in a JISX0212 character. Determining exactly which +one of the two position codes in a JIS X 0208 character, or one of the +two position codes in a JIS X 0212 character. Determining exactly which one is meant could be difficult and time-consuming if the previous -bytes in the string have not already been processed. +bytes in the string have not already been processed, or impossible if +they are drawn from an external stream that cannot be rewound. Non-modal encodings are further divided into @dfn{fixed-width} and @dfn{variable-width} formats. A fixed-width encoding always uses @@ -163,14 +214,18 @@ fixed-width, and this is in fact one of the main reasons for using an encoding with a larger word size. The advantages of fixed-width encodings should be obvious. The advantages of variable-width encodings are that they are generally more space-efficient and allow -for compatibility with existing 8-bit encodings such as ASCII. - - Note that the bytes in an 8-bit encoding are often referred to -as @dfn{octets} rather than simply as bytes. This terminology -dates back to the days before 8-bit bytes were universal, when -some computers had 9-bit bytes, others had 10-bit bytes, etc. - -@node Charsets +for compatibility with existing 8-bit encodings such as ASCII. (For +example, in Unicode ASCII characters are simply promoted to a 16-bit +representation. That means that every ASCII character contains a +@samp{NUL} byte; evidently all of the standard string manipulation +functions will lose badly in a fixed-width Unicode environment.) + + The bytes in an 8-bit encoding are often referred to as @dfn{octets} +rather than simply as bytes. This terminology dates back to the days +before 8-bit bytes were universal, when some computers had 9-bit bytes, +others had 10-bit bytes, etc. + +@node Charsets, MULE Characters, Internationalization Terminology, MULE @section Charsets A @dfn{charset} in MULE is an object that encapsulates a @@ -189,7 +244,7 @@ This function returns non-@code{nil} if @var{object} is a charset. * Predefined Charsets:: Predefined charset objects. @end menu -@node Charset Properties +@node Charset Properties, Basic Charset Functions, , Charsets @subsection Charset Properties Charsets have the following properties: @@ -261,7 +316,7 @@ character will first be processed according to @code{graphic} and then passed through the CCL program, with the resulting values used to index the font. -This is used, for example, in the Big5 character set (used in Taiwan). + This is used, for example, in the Big5 character set (used in Taiwan). This character set is not ISO-2022-compliant, and its size (94x157) does not fit within the maximum 96x96 size of ISO-2022-compliant character sets. As a result, XEmacs/MULE splits it (in a rather complex fashion, @@ -272,10 +327,11 @@ position codes back into standard Big5 indices to retrieve a character from a Big5 font. @end table -Most of the above properties can only be changed when the charset -is created. @xref{Charset Property Functions}. + Most of the above properties can only be set when the charset is +initialized, and cannot be changed later. +@xref{Charset Property Functions}. -@node Basic Charset Functions +@node Basic Charset Functions, Charset Property Functions, Charset Properties, Charsets @subsection Basic Charset Functions @defun find-charset charset-or-name @@ -298,7 +354,7 @@ This function returns a list of the names of all defined charsets. @defun make-charset name doc-string props This function defines a new character set. This function is for use -with Mule support. @var{name} is a symbol, the name by which the +with MULE support. @var{name} is a symbol, the name by which the character set is normally referred. @var{doc-string} is a string describing the character set. @var{props} is a property list, describing the specific nature of the character set. The recognized @@ -326,17 +382,17 @@ number of characters, and final byte as @var{charset}, but which is displayed in the opposite direction. @end defun -@node Charset Property Functions +@node Charset Property Functions, Predefined Charsets, Basic Charset Functions, Charsets @subsection Charset Property Functions -All of these functions accept either a charset name or charset object. + All of these functions accept either a charset name or charset object. @defun charset-property charset prop This function returns property @var{prop} of @var{charset}. @xref{Charset Properties}. @end defun -Convenience functions are also provided for retrieving individual + Convenience functions are also provided for retrieving individual properties of a charset. @defun charset-name charset @@ -386,7 +442,7 @@ This function returns the CCL program, if any, for converting position codes of characters in @var{charset} into font indices. @end defun -The only property of a charset that can currently be set after + The only property of a charset that can currently be set after the charset has been created is the CCL program. @defun set-charset-ccl-program charset ccl-program @@ -394,10 +450,10 @@ This function sets the @code{ccl-program} property of @var{charset} to @var{ccl-program}. @end defun -@node Predefined Charsets +@node Predefined Charsets, , Charset Property Functions, Charsets @subsection Predefined Charsets -The following charsets are predefined in the C code. + The following charsets are predefined in the C code. @example Name Type Fi Gr Dir Registry @@ -428,7 +484,7 @@ korean-ksc5601 94x94 C 0 l2r KSC5601 composite 96x96 0 l2r --- @end example -The following charsets are predefined in the Lisp code. + The following charsets are predefined in the Lisp code. @example Name Type Fi Gr Dir Registry @@ -452,11 +508,11 @@ vietnamese-upper 96 2 1 l2r VISCII1.1 For all of the above charsets, the dimension and number of columns are the same. -Note that ASCII, Control-1, and Composite are handled specially. + Note that ASCII, Control-1, and Composite are handled specially. This is why some of the fields are blank; and some of the filled-in fields (e.g. the type) are not really accurate. -@node MULE Characters +@node MULE Characters, Composite Characters, Charsets, MULE @section MULE Characters @defun make-char charset arg1 &optional arg2 @@ -483,10 +539,10 @@ if omitted. This function returns a list of the charsets in @var{string}. @end defun -@node Composite Characters +@node Composite Characters, Coding Systems, MULE Characters, MULE @section Composite Characters -Composite characters are not yet completely implemented. + Composite characters are not yet completely implemented. @defun make-composite-char string This function converts a string into a single composite character. The @@ -514,70 +570,259 @@ which the composite character was formed. Non-composite characters are left as-is. @var{buffer} defaults to the current buffer if omitted. @end defun -@node ISO 2022 -@section ISO 2022 - -This section briefly describes the ISO 2022 encoding standard. For more -thorough understanding, please refer to the original document of ISO -2022. +@node Coding Systems, CCL, Composite Characters, MULE +@section Coding Systems -Character sets (@dfn{charsets}) are classified into the following four -categories, according to the number of characters of charset: -94-charset, 96-charset, 94x94-charset, and 96x96-charset. + 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. -@need 1000 -@table @asis -@item 94-charset - ASCII(B), left(J) and right(I) half of JISX0201, ... -@item 96-charset - Latin-1(A), Latin-2(B), Latin-3(C), ... -@item 94x94-charset - GB2312(A), JISX0208(B), KSC5601(C), ... -@item 96x96-charset - none for the moment -@end table + For example, many ISO-2022-compliant coding systems (such as Compound +Text, which is used for inter-client data under the X Window System) use +escape sequences to switch between different charsets -- Japanese Kanji, +for example, is invoked with @samp{ESC $ ( B}; ASCII is invoked with +@samp{ESC ( B}; and Cyrillic is invoked with @samp{ESC - L}. See +@code{make-coding-system} for more information. -The character in parentheses after the name of each charset -is the @dfn{final character} @var{F}, which can be regarded as -the identifier of the charset. ECMA allocates @var{F} to each -charset. @var{F} is in the range of 0x30..0x7F, but 0x30..0x3F -are only for private use. + 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 and charsets work.) -Note: @dfn{ECMA} = European Computer Manufacturers Association +@defun coding-system-p object +This function returns non-@code{nil} if @var{object} is a coding system. +@end defun -There are four @dfn{registers of charsets}, called G0 thru G3. -You can designate (or assign) any charset to one of these -registers. +@menu +* Coding System Types:: Classifying coding systems. +* ISO 2022:: An international standard for + charsets and encodings. +* EOL Conversion:: Dealing with different ways of denoting + the end of a line. +* Coding System Properties:: Properties of a coding system. +* Basic Coding System Functions:: Working with coding systems. +* Coding System Property Functions:: Retrieving a coding system's properties. +* Encoding and Decoding Text:: Encoding and decoding text. +* Detection of Textual Encoding:: Determining how text is encoded. +* Big5 and Shift-JIS Functions:: Special functions for these non-standard + encodings. +* Predefined Coding Systems:: Coding systems implemented by MULE. +@end menu -The code space contained within one octet (of size 256) is divided into -4 areas: C0, GL, C1, and GR. GL and GR are the areas into which a -register of charset can be invoked into. +@node Coding System Types, ISO 2022, , Coding Systems +@subsection Coding System Types -@example -@group - C0: 0x00 - 0x1F - GL: 0x20 - 0x7F - C1: 0x80 - 0x9F - GR: 0xA0 - 0xFF -@end group -@end example + The coding system type determines the basic algorithm XEmacs will use to +decode or encode a data stream. Character encodings will be converted +to the MULE encoding, escape sequences processed, and newline sequences +converted to XEmacs's internal representation. There are three basic +classes of coding system type: no-conversion, ISO-2022, and special. + + No conversion allows you to look at the file's internal representation. +Since XEmacs is basically a text editor, "no conversion" does convert +newline conventions by default. (Use the 'binary coding-system if this +is not desired.) + + ISO 2022 (@pxref{ISO 2022}) is the basic international standard regulating +use of "coded character sets for the exchange of data", ie, text +streams. ISO 2022 contains functions that make it possible to encode +text streams to comply with restrictions of the Internet mail system and +de facto restrictions of most file systems (eg, use of the separator +character in file names). Coding systems which are not ISO 2022 +conformant can be difficult to handle. Perhaps more important, they are +not adaptable to multilingual information interchange, with the obvious +exception of ISO 10646 (Unicode). (Unicode is partially supported by +XEmacs with the addition of the Lisp package ucs-conv.) + + The special class of coding systems includes automatic detection, CCL (a +"little language" embedded as an interpreter, useful for translating +between variants of a single character set), non-ISO-2022-conformant +encodings like Unicode, Shift JIS, and Big5, and MULE internal coding. +(NB: this list is based on XEmacs 21.2. Terminology may vary slightly +for other versions of XEmacs and for GNU Emacs 20.) -Usually, in the initial state, G0 is invoked into GL, and G1 -is invoked into GR. +@table @code +@item no-conversion +No conversion, for binary files, and a few special cases of non-ISO-2022 +coding systems where conversion is done by hook functions (usually +implemented in CCL). On output, graphic characters that are not in +ASCII or Latin-1 will be replaced by a @samp{?}. (For a +no-conversion-encoded buffer, these characters will only be present if +you explicitly insert them.) +@item iso2022 +Any ISO-2022-compliant encoding. Among others, this includes JIS (the +Japanese encoding commonly used for e-mail), national variants of EUC +(the standard Unix encoding for Japanese and other languages), and +Compound Text (an encoding used in X11). You can specify more specific +information about the conversion with the @var{flags} argument. +@item ucs-4 +ISO 10646 UCS-4 encoding. A 31-bit fixed-width superset of Unicode. +@item utf-8 +ISO 10646 UTF-8 encoding. A ``file system safe'' transformation format +that can be used with both UCS-4 and Unicode. +@item undecided +Automatic conversion. XEmacs attempts to detect the coding system used +in the file. +@item shift-jis +Shift-JIS (a Japanese encoding commonly used in PC operating systems). +@item big5 +Big5 (the encoding commonly used for Taiwanese). +@item ccl +The conversion is performed using a user-written pseudo-code program. +CCL (Code Conversion Language) is the name of this pseudo-code. For +example, CCL is used to map KOI8-R characters (an encoding for Russian +Cyrillic) to ISO8859-5 (the form used internally by MULE). +@item 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 @code{DEBUG_XEMACS} set +(the @samp{--debug} configure option). @strong{Warning}: Reading in a +file using @code{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 @code{internal} conversion. +@end table -ISO 2022 distinguishes 7-bit environments and 8-bit environments. In -7-bit environments, only C0 and GL are used. +@node ISO 2022, EOL Conversion, Coding System Types, Coding Systems +@section ISO 2022 -Charset designation is done by escape sequences of the form: + This section briefly describes the ISO 2022 encoding standard. A more +thorough treatment is available in the original document of ISO +2022 as well as various national standards (such as JIS X 0202). + + Character sets (@dfn{charsets}) are classified into the following four +categories, according to the number of characters in the charset: +94-charset, 96-charset, 94x94-charset, and 96x96-charset. This means +that although an ISO 2022 coding system may have variable width +characters, each charset used is fixed-width (in contrast to the MULE +character set and UTF-8, for example). + + ISO 2022 provides for switching between character sets via escape +sequences. This switching is somewhat complicated, because ISO 2022 +provides for both legacy applications like Internet mail that accept +only 7 significant bits in some contexts (RFC 822 headers, for example), +and more modern "8-bit clean" applications. It also provides for +compact and transparent representation of languages like Japanese which +mix ASCII and a national script (even outside of computer programs). + + First, ISO 2022 codified prevailing practice by dividing the code space +into "control" and "graphic" regions. The code points 0x00-0x1F and +0x80-0x9F are reserved for "control characters", while "graphic +characters" must be assigned to code points in the regions 0x20-0x7F and +0xA0-0xFF. The positions 0x20 and 0x7F are special, and under some +circumstances must be assigned the graphic character "ASCII SPACE" and +the control character "ASCII DEL" respectively. + + The various regions are given the name C0 (0x00-0x1F), GL (0x20-0x7F), +C1 (0x80-0x9F), and GR (0xA0-0xFF). GL and GR stand for "graphic left" +and "graphic right", respectively, because of the standard method of +displaying graphic character sets in tables with the high byte indexing +columns and the low byte indexing rows. I don't find it very intuitive, +but these are called "registers". + + An ISO 2022-conformant encoding for a graphic character set must use a +fixed number of bytes per character, and the values must fit into a +single register; that is, each byte must range over either 0x20-0x7F, or +0xA0-0xFF. It is not allowed to extend the range of the repertoire of a +character set by using both ranges at the same. This is why a standard +character set such as ISO 8859-1 is actually considered by ISO 2022 to +be an aggregation of two character sets, ASCII and LATIN-1, and why it +is technically incorrect to refer to ISO 8859-1 as "Latin 1". Also, a +single character's bytes must all be drawn from the same register; this +is why Shift JIS (for Japanese) and Big 5 (for Chinese) are not ISO +2022-compatible encodings. + + The reason for this restriction becomes clear when you attempt to define +an efficient, robust encoding for a language like Japanese. Like ISO +8859, Japanese encodings are aggregations of several character sets. In +practice, the vast majority of characters are drawn from the "JIS Roman" +character set (a derivative of ASCII; it won't hurt to think of it as +ASCII) and the JIS X 0208 standard "basic Japanese" character set +including not only ideographic characters ("kanji") but syllabic +Japanese characters ("kana"), a wide variety of symbols, and many +alphabetic characters (Roman, Greek, and Cyrillic) as well. Although +JIS X 0208 includes the whole Roman alphabet, as a 2-byte code it is not +suited to programming; thus the inclusion of ASCII in the standard +Japanese encodings. + + For normal Japanese text such as in newspapers, a broad repertoire of +approximately 3000 characters is used. Evidently this won't fit into +one byte; two must be used. But much of the text processed by Japanese +computers is computer source code, nearly all of which is ASCII. A not +insignificant portion of ordinary text is English (as such or as +borrowed Japanese vocabulary) or other languages which can represented +at least approximately in ASCII, as well. It seems reasonable then to +represent ASCII in one byte, and JIS X 0208 in two. And this is exactly +what the Extended Unix Code for Japanese (EUC-JP) does. ASCII is +invoked to the GL register, and JIS X 0208 is invoked to the GR +register. Thus, each byte can be tested for its character set by +looking at the high bit; if set, it is Japanese, if clear, it is ASCII. +Furthermore, since control characters like newline can never be part of +a graphic character, even in the case of corruption in transmission the +stream will be resynchronized at every line break, on the order of 60-80 +bytes. This coding system requires no escape sequences or special +control codes to represent 99.9% of all Japanese text. + + Note carefully the distinction between the character sets (ASCII and JIS +X 0208), the encoding (EUC-JP), and the coding system (ISO 2022). The +JIS X 0208 character set is used in three different encodings for +Japanese, but in ISO-2022-JP it is invoked into GL (so the high bit is +always clear), in EUC-JP it is invoked into GR (setting the high bit in +the process), and in Shift JIS the high bit may be set or reset, and the +significant bits are shifted within the 16-bit character so that the two +main character sets can coexist with a third (the "halfwidth katakana" +of JIS X 0201). As the name implies, the ISO-2022-JP encoding is also a +version of the ISO-2022 coding system. + + In order to systematically treat subsidiary character sets (like the +"halfwidth katakana" already mentioned, and the "supplementary kanji" of +JIS X 0212), four further registers are defined: G0, G1, G2, and G3. +Unlike GL and GR, they are not logically distinguished by internal +format. Instead, the process of "invocation" mentioned earlier is +broken into two steps: first, a character set is @dfn{designated} to one +of the registers G0-G3 by use of an @dfn{escape sequence} of the form: @example ESC [@var{I}] @var{I} @var{F} @end example -where @var{I} is an intermediate character in the range 0x20 - 0x2F, and -@var{F} is the final character identifying this charset. +where @var{I} is an intermediate character or characters in the range +0x20 - 0x3F, and @var{F}, from the range 0x30-0x7Fm is the final +character identifying this charset. (Final characters in the range +0x30-0x3F are reserved for private use and will never have a publically +registered meaning.) + + Then that register is @dfn{invoked} to either GL or GR, either +automatically (designations to G0 normally involve invocation to GL as +well), or by use of shifting (affecting only the following character in +the data stream) or locking (effective until the next designation or +locking) control sequences. An encoding conformant to ISO 2022 is +typically defined by designating the initial contents of the G0-G3 +registers, specifying an 7 or 8 bit environment, and specifying whether +further designations will be recognized. -The meaning of intermediate characters are: + Some examples of character sets and the registered final characters +@var{F} used to designate them: + +@need 1000 +@table @asis +@item 94-charset + ASCII (B), left (J) and right (I) half of JIS X 0201, ... +@item 96-charset + Latin-1 (A), Latin-2 (B), Latin-3 (C), ... +@item 94x94-charset + GB2312 (A), JIS X 0208 (B), KSC5601 (C), ... +@item 96x96-charset + none for the moment +@end table + + The meanings of the various characters in these sequences, where not +specified by the ISO 2022 standard (such as the ESC character), are +assigned by @dfn{ECMA}, the European Computer Manufacturers Association. + + The meaning of intermediate characters are: @example @group @@ -586,19 +831,19 @@ The meaning of intermediate characters are: ) [0x29]: designate to G1 a 94-charset whose final byte is @var{F}. * [0x2A]: designate to G2 a 94-charset whose final byte is @var{F}. + [0x2B]: designate to G3 a 94-charset whose final byte is @var{F}. + , [0x2C]: designate to G0 a 96-charset whose final byte is @var{F}. - [0x2D]: designate to G1 a 96-charset whose final byte is @var{F}. . [0x2E]: designate to G2 a 96-charset whose final byte is @var{F}. / [0x2F]: designate to G3 a 96-charset whose final byte is @var{F}. @end group @end example -The following rule is not allowed in ISO 2022 but can be used in Mule. + The comma may be used in files read and written only by MULE, as a MULE +extension, but this is illegal in ISO 2022. (The reason is that in ISO +2022 G0 must be a 94-member character set, with 0x20 assigned the value +SPACE, and 0x7F assigned the value DEL.) -@example - , [0x2C]: designate to G0 a 96-charset whose final byte is @var{F}. -@end example - -Here are examples of designations: + Here are examples of designations: @example @group @@ -610,12 +855,15 @@ Here are examples of designations: @end group @end example -To use a charset designated to G2 or G3, and to use a charset designated +(The short forms used to designate GB2312 and JIS X 0208 are for +backwards compatibility; the long forms are preferred.) + + To use a charset designated to G2 or G3, and to use a charset designated to G1 in a 7-bit environment, you must explicitly invoke G1, G2, or G3 into GL. There are two types of invocation, Locking Shift (forever) and Single Shift (one character only). -Locking Shift is done as follows: + Locking Shift is done as follows: @example LS0 or SI (0x0F): invoke G0 into GL @@ -627,7 +875,7 @@ Locking Shift is done as follows: LS3R: invoke G3 into GR @end example -Single Shift is done as follows: + Single Shift is done as follows: @example @group @@ -636,48 +884,53 @@ Single Shift is done as follows: @end group @end example + The shift functions (such as LS1R and SS3) are represented by control +characters (from C1) in 8 bit environments and by escape sequences in 7 +bit environments. + (#### Ben says: I think the above is slightly incorrect. It appears that SS2 invokes G2 into GR and SS3 invokes G3 into GR, whereas ESC N and ESC O behave as indicated. The above definitions will not parse EUC-encoded text correctly, and it looks like the code in mule-coding.c has similar problems.) -You may realize that there are a lot of ISO-2022-compliant ways of -encoding multilingual text. Now, in the world, there exist many coding -systems such as X11's Compound Text, Japanese JUNET code, and so-called -EUC (Extended UNIX Code); all of these are variants of ISO 2022. + Evidently there are a lot of ISO-2022-compliant ways of encoding +multilingual text. Now, in the world, there exist many coding systems +such as X11's Compound Text, Japanese JUNET code, and so-called EUC +(Extended UNIX Code); all of these are variants of ISO 2022. -In Mule, we characterize ISO 2022 by the following attributes: + In MULE, we characterize a version of ISO 2022 by the following +attributes: @enumerate @item -Initial designation to G0 thru G3. +The character sets initially designated to G0 thru G3. @item -Allow designation of short form for Japanese and Chinese. +Whether short form designations are allowed for Japanese and Chinese. @item -Should we designate ASCII to G0 before control characters? +Whether ASCII should be designated to G0 before control characters. @item -Should we designate ASCII to G0 at the end of line? +Whether ASCII should be designated to G0 at the end of line. @item 7-bit environment or 8-bit environment. @item -Use Locking Shift or not. +Whether Locking Shifts are used or not. @item -Use ASCII or JIS0201-1976-Roman. +Whether to use ASCII or the variant JIS X 0201-1976-Roman. @item -Use JISX0208-1983 or JISX0208-1976. +Whether to use JIS X 0208-1983 or the older version JIS X 0208-1976. @end enumerate (The last two are only for Japanese.) -By specifying these attributes, you can create any variant + By specifying these attributes, you can create any variant of ISO 2022. -Here are several examples: + Here are several examples: @example @group -junet -- Coding system used in JUNET. +ISO-2022-JP -- Coding system used in Japanese email (RFC 1463 #### check). 1. G0 <- ASCII, G1..3 <- never used 2. Yes. 3. Yes. @@ -685,125 +938,50 @@ junet -- Coding system used in JUNET. 5. 7-bit environment 6. No. 7. Use ASCII - 8. Use JISX0208-1983 + 8. Use JIS X 0208-1983 @end group @group -ctext -- Compound Text - 1. G0 <- ASCII, G1 <- Latin-1, G2,3 <- never used +ctext -- X11 Compound Text + 1. G0 <- ASCII, G1 <- Latin-1, G2,3 <- never used. 2. No. 3. No. 4. Yes. - 5. 8-bit environment + 5. 8-bit environment. 6. No. - 7. Use ASCII - 8. Use JISX0208-1983 + 7. Use ASCII. + 8. Use JIS X 0208-1983. @end group @group -euc-china -- Chinese EUC. Although many people call this -as "GB encoding", the name may cause misunderstanding. - 1. G0 <- ASCII, G1 <- GB2312, G2,3 <- never used +euc-china -- Chinese EUC. Often called the "GB encoding", but that is +technically incorrect. + 1. G0 <- ASCII, G1 <- GB 2312, G2,3 <- never used. 2. No. 3. Yes. 4. Yes. - 5. 8-bit environment + 5. 8-bit environment. 6. No. - 7. Use ASCII - 8. Use JISX0208-1983 + 7. Use ASCII. + 8. Use JIS X 0208-1983. @end group @group -korean-mail -- Coding system used in Korean network. - 1. G0 <- ASCII, G1 <- KSC5601, G2,3 <- never used +ISO-2022-KR -- Coding system used in Korean email. + 1. G0 <- ASCII, G1 <- KSC 5601, G2,3 <- never used. 2. No. 3. Yes. 4. Yes. - 5. 7-bit environment + 5. 7-bit environment. 6. Yes. - 7. No. - 8. No. + 7. Use ASCII. + 8. Use JIS X 0208-1983. @end group @end example -Mule creates all these coding systems by default. - -@node Coding Systems -@section Coding Systems - -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 ISO-2022-compliant coding systems (such as Compound -Text, which is used for inter-client data under the X Window System) use -escape sequences to switch between different charsets---Japanese Kanji, -for example, is invoked with @samp{ESC $ ( B}; ASCII is invoked with -@samp{ESC ( B}; and Cyrillic is invoked with @samp{ESC - L}. See -@code{make-coding-system} for more information. - -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 and charsets work.) - -@defun coding-system-p object -This function returns non-@code{nil} if @var{object} is a coding system. -@end defun +MULE creates all of these coding systems by default. -@menu -* Coding System Types:: Classifying coding systems. -* EOL Conversion:: Dealing with different ways of denoting - the end of a line. -* Coding System Properties:: Properties of a coding system. -* Basic Coding System Functions:: Working with coding systems. -* Coding System Property Functions:: Retrieving a coding system's properties. -* Encoding and Decoding Text:: Encoding and decoding text. -* Detection of Textual Encoding:: Determining how text is encoded. -* Big5 and Shift-JIS Functions:: Special functions for these non-standard - encodings. -@end menu - -@node Coding System Types -@subsection Coding System Types - -@table @code -@item nil -@itemx autodetect -Automatic conversion. XEmacs attempts to detect the coding system used -in the file. -@item 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 -@samp{?}. (For a no-conversion-encoded buffer, these characters will -only be present if you explicitly insert them.) -@item shift-jis -Shift-JIS (a Japanese encoding commonly used in PC operating systems). -@item iso2022 -Any ISO-2022-compliant encoding. Among other things, this includes JIS -(the Japanese encoding commonly used for e-mail), national variants of -EUC (the standard Unix encoding for Japanese and other languages), and -Compound Text (an encoding used in X11). You can specify more specific -information about the conversion with the @var{flags} argument. -@item big5 -Big5 (the encoding commonly used for Taiwanese). -@item ccl -The conversion is performed using a user-written pseudo-code program. -CCL (Code Conversion Language) is the name of this pseudo-code. -@item 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 @code{DEBUG_XEMACS} set -(the @samp{--debug} configure option). @strong{Warning}: Reading in a -file using @code{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 @code{internal} conversion. -@end table - -@node EOL Conversion +@node EOL Conversion, Coding System Properties, ISO 2022, Coding Systems @subsection EOL Conversion @table @code @@ -830,7 +1008,7 @@ coding systems. (This value is converted to @code{nil} when stored internally, and @code{coding-system-property} will return @code{nil}.) @end table -@node Coding System Properties +@node Coding System Properties, Basic Coding System Functions, EOL Conversion, Coding Systems @subsection Coding System Properties @table @code @@ -842,6 +1020,18 @@ active. End-of-line conversion to be used. It should be one of the types listed in @ref{EOL Conversion}. +@item eol-lf +The coding system which is the same as this one, except that it uses the +Unix line-breaking convention. + +@item eol-crlf +The coding system which is the same as this one, except that it uses the +DOS line-breaking convention. + +@item eol-cr +The coding system which is the same as this one, except that it uses the +Macintosh line-breaking convention. + @item post-read-conversion Function called after a file has been read in, to perform the decoding. Called with two arguments, @var{beg} and @var{end}, denoting a region of @@ -853,7 +1043,7 @@ Called with two arguments, @var{beg} and @var{end}, denoting a region of the current buffer to be encoded. @end table -The following additional properties are recognized if @var{type} is + The following additional properties are recognized if @var{type} is @code{iso2022}: @table @code @@ -931,7 +1121,7 @@ in one charset to another when encoding is performed. The form of each specification is the same as for @code{input-charset-conversion}. @end table -The following additional properties are recognized (and required) if + The following additional properties are recognized (and required) if @var{type} is @code{ccl}: @table @code @@ -942,13 +1132,16 @@ CCL program used for decoding (converting to internal format). CCL program used for encoding (converting to external format). @end table -@node Basic Coding System Functions + The following properties are used internally: @var{eol-cr}, +@var{eol-crlf}, @var{eol-lf}, and @var{base}. + +@node Basic Coding System Functions, Coding System Property Functions, Coding System Properties, Coding Systems @subsection Basic Coding System Functions @defun find-coding-system coding-system-or-name This function retrieves the coding system of the given name. -If @var{coding-system-or-name} is a coding-system object, it is simply + If @var{coding-system-or-name} is a coding-system object, it is simply returned. Otherwise, @var{coding-system-or-name} should be a symbol. If there is no such coding system, @code{nil} is returned. Otherwise the associated coding system object is returned. @@ -968,6 +1161,11 @@ This function returns a list of the names of all defined coding systems. This function returns the name of the given coding system. @end defun +@defun coding-system-base coding-system +Returns the base coding system (undecided EOL convention) +coding system. +@end defun + @defun make-coding-system name type &optional doc-string props This function registers symbol @var{name} as a coding system. @@ -992,7 +1190,7 @@ This function returns the subsidiary coding system of @var{coding-system} with eol type @var{eol-type}. @end defun -@node Coding System Property Functions +@node Coding System Property Functions, Encoding and Decoding Text, Basic Coding System Functions, Coding Systems @subsection Coding System Property Functions @defun coding-system-doc-string coding-system @@ -1007,7 +1205,7 @@ This function returns the type of @var{coding-system}. This function returns the @var{prop} property of @var{coding-system}. @end defun -@node Encoding and Decoding Text +@node Encoding and Decoding Text, Detection of Textual Encoding, Coding System Property Functions, Coding Systems @subsection Encoding and Decoding Text @defun decode-coding-region start end coding-system &optional buffer @@ -1028,7 +1226,7 @@ encoding. The length of the encoded text is returned. @var{buffer} defaults to the current buffer if unspecified. @end defun -@node Detection of Textual Encoding +@node Detection of Textual Encoding, Big5 and Shift-JIS Functions, Encoding and Decoding Text, Coding Systems @subsection Detection of Textual Encoding @defun coding-category-list @@ -1064,20 +1262,20 @@ according to a detected end-of-line type. Optional arg @var{buffer} defaults to the current buffer. @end defun -@node Big5 and Shift-JIS Functions +@node Big5 and Shift-JIS Functions, Predefined Coding Systems, Detection of Textual Encoding, Coding Systems @subsection Big5 and Shift-JIS Functions -These are special functions for working with the non-standard + These are special functions for working with the non-standard Shift-JIS and Big5 encodings. @defun decode-shift-jis-char code -This function decodes a JISX0208 character of Shift-JIS coding-system. +This function decodes a JIS X 0208 character of Shift-JIS coding-system. @var{code} is the character code in Shift-JIS as a cons of type bytes. The corresponding character is returned. @end defun @defun encode-shift-jis-char ch -This function encodes a JISX0208 character @var{ch} to SHIFT-JIS +This function encodes a JIS X 0208 character @var{ch} to SHIFT-JIS coding-system. The corresponding character code in SHIFT-JIS is returned as a cons of two bytes. @end defun @@ -1093,10 +1291,379 @@ This function encodes the Big5 character @var{char} to BIG5 coding-system. The corresponding character code in Big5 is returned. @end defun +@node Predefined Coding Systems, , Big5 and Shift-JIS Functions, Coding Systems +@subsection Coding Systems Implemented + + MULE initializes most of the commonly used coding systems at XEmacs's +startup. A few others are initialized only when the relevant language +environment is selected and support libraries are loaded. (NB: The +following list is based on XEmacs 21.2.19, the development branch at the +time of writing. The list may be somewhat different for other +versions. Recent versions of GNU Emacs 20 implement a few more rare +coding systems; work is being done to port these to XEmacs.) + + Unfortunately, there is not a consistent naming convention for character +sets, and for practical purposes coding systems often take their name +from their principal character sets (ASCII, KOI8-R, Shift JIS). Others +take their names from the coding system (ISO-2022-JP, EUC-KR), and a few +from their non-text usages (internal, binary). To provide for this, and +for the fact that many coding systems have several common names, an +aliasing system is provided. Finally, some effort has been made to use +names that are registered as MIME charsets (this is why the name +'shift_jis contains that un-Lisp-y underscore). + + There is a systematic naming convention regarding end-of-line (EOL) +conventions for different systems. A coding system whose name ends in +"-unix" forces the assumptions that lines are broken by newlines (0x0A). +A coding system whose name ends in "-mac" forces the assumptions that +lines are broken by ASCII CRs (0x0D). A coding system whose name ends +in "-dos" forces the assumptions that lines are broken by CRLF sequences +(0x0D 0x0A). These subsidiary coding systems are automatically derived +from a base coding system. Use of the base coding system implies +autodetection of the text file convention. (The fact that the -unix, +-mac, and -dos are derived from a base system results in them showing up +as "aliases" in `list-coding-systems'.) These subsidiaries have a +consistent modeline indicator as well. "-dos" coding systems have ":T" +appended to their modeline indicator, while "-mac" coding systems have +":t" appended (eg, "ISO8:t" for iso-2022-8-mac). + + In the following table, each coding system is given with its mode line +indicator in parentheses. Non-textual coding systems are listed first, +followed by textual coding systems and their aliases. (The coding system +subsidiary modeline indicators ":T" and ":t" will be omitted from the +table of coding systems.) + + ### SJT 1999-08-23 Maybe should order these by language? Definitely +need language usage for the ISO-8859 family. + + Note that although true coding system aliases have been implemented for +XEmacs 21.2, the coding system initialization has not yet been converted +as of 21.2.19. So coding systems described as aliases have the same +properties as the aliased coding system, but will not be equal as Lisp +objects. + +@table @code + +@item automatic-conversion +@itemx undecided +@itemx undecided-dos +@itemx undecided-mac +@itemx undecided-unix + +Modeline indicator: @code{Auto}. A type @code{undecided} coding system. +Attempts to determine an appropriate coding system from file contents or +the environment. + +@item raw-text +@itemx no-conversion +@itemx raw-text-dos +@itemx raw-text-mac +@itemx raw-text-unix +@itemx no-conversion-dos +@itemx no-conversion-mac +@itemx no-conversion-unix + +Modeline indicator: @code{Raw}. A type @code{no-conversion} coding system, +which converts only line-break-codes. An implementation quirk means +that this coding system is also used for ISO8859-1. + +@item binary +Modeline indicator: @code{Binary}. A type @code{no-conversion} coding +system which does no character coding or EOL conversions. An alias for +@code{raw-text-unix}. + +@item alternativnyj +@itemx alternativnyj-dos +@itemx alternativnyj-mac +@itemx alternativnyj-unix + +Modeline indicator: @code{Cy.Alt}. A type @code{ccl} coding system used for +Alternativnyj, an encoding of the Cyrillic alphabet. + +@item big5 +@itemx big5-dos +@itemx big5-mac +@itemx big5-unix + +Modeline indicator: @code{Zh/Big5}. A type @code{big5} coding system used for +BIG5, the most common encoding of traditional Chinese as used in Taiwan. + +@item cn-gb-2312 +@itemx cn-gb-2312-dos +@itemx cn-gb-2312-mac +@itemx cn-gb-2312-unix + +Modeline indicator: @code{Zh-GB/EUC}. A type @code{iso2022} coding system used +for simplified Chinese (as used in the People's Republic of China), with +the @code{ascii} (G0), @code{chinese-gb2312} (G1), and @code{sisheng} +(G2) character sets initially designated. Chinese EUC (Extended Unix +Code). + +@item ctext-hebrew +@itemx ctext-hebrew-dos +@itemx ctext-hebrew-mac +@itemx ctext-hebrew-unix + +Modeline indicator: @code{CText/Hbrw}. A type @code{iso2022} coding system +with the @code{ascii} (G0) and @code{hebrew-iso8859-8} (G1) character +sets initially designated for Hebrew. + +@item ctext +@itemx ctext-dos +@itemx ctext-mac +@itemx ctext-unix + +Modeline indicator: @code{CText}. A type @code{iso2022} 8-bit coding system +with the @code{ascii} (G0) and @code{latin-iso8859-1} (G1) character +sets initially designated. X11 Compound Text Encoding. Often +mistakenly recognized instead of EUC encodings; usual cause is +inappropriate setting of @code{coding-priority-list}. + +@item escape-quoted + +Modeline indicator: @code{ESC/Quot}. A type @code{iso2022} 8-bit coding +system with the @code{ascii} (G0) and @code{latin-iso8859-1} (G1) +character sets initially designated and escape quoting. Unix EOL +conversion (ie, no conversion). It is used for .ELC files. + +@item euc-jp +@itemx euc-jp-dos +@itemx euc-jp-mac +@itemx euc-jp-unix + +Modeline indicator: @code{Ja/EUC}. A type @code{iso2022} 8-bit coding system +with @code{ascii} (G0), @code{japanese-jisx0208} (G1), +@code{katakana-jisx0201} (G2), and @code{japanese-jisx0212} (G3) +initially designated. Japanese EUC (Extended Unix Code). + +@item euc-kr +@itemx euc-kr-dos +@itemx euc-kr-mac +@itemx euc-kr-unix + +Modeline indicator: @code{ko/EUC}. A type @code{iso2022} 8-bit coding system +with @code{ascii} (G0) and @code{korean-ksc5601} (G1) initially +designated. Korean EUC (Extended Unix Code). + +@item hz-gb-2312 +Modeline indicator: @code{Zh-GB/Hz}. A type @code{no-conversion} coding +system with Unix EOL convention (ie, no conversion) using +post-read-decode and pre-write-encode functions to translate the Hz/ZW +coding system used for Chinese. + +@item iso-2022-7bit +@itemx iso-2022-7bit-unix +@itemx iso-2022-7bit-dos +@itemx iso-2022-7bit-mac +@itemx iso-2022-7 + +Modeline indicator: @code{ISO7}. A type @code{iso2022} 7-bit coding system +with @code{ascii} (G0) initially designated. Other character sets must +be explicitly designated to be used. + +@item iso-2022-7bit-ss2 +@itemx iso-2022-7bit-ss2-dos +@itemx iso-2022-7bit-ss2-mac +@itemx iso-2022-7bit-ss2-unix + +Modeline indicator: @code{ISO7/SS}. A type @code{iso2022} 7-bit coding system +with @code{ascii} (G0) initially designated. Other character sets must +be explicitly designated to be used. SS2 is used to invoke a +96-charset, one character at a time. + +@item iso-2022-8 +@itemx iso-2022-8-dos +@itemx iso-2022-8-mac +@itemx iso-2022-8-unix + +Modeline indicator: @code{ISO8}. A type @code{iso2022} 8-bit coding system +with @code{ascii} (G0) and @code{latin-iso8859-1} (G1) initially +designated. Other character sets must be explicitly designated to be +used. No single-shift or locking-shift. + +@item iso-2022-8bit-ss2 +@itemx iso-2022-8bit-ss2-dos +@itemx iso-2022-8bit-ss2-mac +@itemx iso-2022-8bit-ss2-unix + +Modeline indicator: @code{ISO8/SS}. A type @code{iso2022} 8-bit coding system +with @code{ascii} (G0) and @code{latin-iso8859-1} (G1) initially +designated. Other character sets must be explicitly designated to be +used. SS2 is used to invoke a 96-charset, one character at a time. + +@item iso-2022-int-1 +@itemx iso-2022-int-1-dos +@itemx iso-2022-int-1-mac +@itemx iso-2022-int-1-unix + +Modeline indicator: @code{INT-1}. A type @code{iso2022} 7-bit coding system +with @code{ascii} (G0) and @code{korean-ksc5601} (G1) initially +designated. ISO-2022-INT-1. + +@item iso-2022-jp-1978-irv +@itemx iso-2022-jp-1978-irv-dos +@itemx iso-2022-jp-1978-irv-mac +@itemx iso-2022-jp-1978-irv-unix + +Modeline indicator: @code{Ja-78/7bit}. A type @code{iso2022} 7-bit coding +system. For compatibility with old Japanese terminals; if you need to +know, look at the source. + +@item iso-2022-jp +@itemx iso-2022-jp-2 (ISO7/SS) +@itemx iso-2022-jp-dos +@itemx iso-2022-jp-mac +@itemx iso-2022-jp-unix +@itemx iso-2022-jp-2-dos +@itemx iso-2022-jp-2-mac +@itemx iso-2022-jp-2-unix + +Modeline indicator: @code{MULE/7bit}. A type @code{iso2022} 7-bit coding +system with @code{ascii} (G0) initially designated, and complex +specifications to insure backward compatibility with old Japanese +systems. Used for communication with mail and news in Japan. The "-2" +versions also use SS2 to invoke a 96-charset one character at a time. + +@item iso-2022-kr +Modeline indicator: @code{Ko/7bit} A type @code{iso2022} 7-bit coding +system with @code{ascii} (G0) and @code{korean-ksc5601} (G1) initially +designated. Used for e-mail in Korea. + +@item iso-2022-lock +@itemx iso-2022-lock-dos +@itemx iso-2022-lock-mac +@itemx iso-2022-lock-unix + +Modeline indicator: @code{ISO7/Lock}. A type @code{iso2022} 7-bit coding +system with @code{ascii} (G0) initially designated, using Locking-Shift +to invoke a 96-charset. + +@item iso-8859-1 +@itemx iso-8859-1-dos +@itemx iso-8859-1-mac +@itemx iso-8859-1-unix + +Due to implementation, this is not a type @code{iso2022} coding system, +but rather an alias for the @code{raw-text} coding system. + +@item iso-8859-2 +@itemx iso-8859-2-dos +@itemx iso-8859-2-mac +@itemx iso-8859-2-unix + +Modeline indicator: @code{MIME/Ltn-2}. A type @code{iso2022} coding +system with @code{ascii} (G0) and @code{latin-iso8859-2} (G1) initially +invoked. + +@item iso-8859-3 +@itemx iso-8859-3-dos +@itemx iso-8859-3-mac +@itemx iso-8859-3-unix + +Modeline indicator: @code{MIME/Ltn-3}. A type @code{iso2022} coding system +with @code{ascii} (G0) and @code{latin-iso8859-3} (G1) initially +invoked. + +@item iso-8859-4 +@itemx iso-8859-4-dos +@itemx iso-8859-4-mac +@itemx iso-8859-4-unix + +Modeline indicator: @code{MIME/Ltn-4}. A type @code{iso2022} coding system +with @code{ascii} (G0) and @code{latin-iso8859-4} (G1) initially +invoked. + +@item iso-8859-5 +@itemx iso-8859-5-dos +@itemx iso-8859-5-mac +@itemx iso-8859-5-unix + +Modeline indicator: @code{ISO8/Cyr}. A type @code{iso2022} coding system with +@code{ascii} (G0) and @code{cyrillic-iso8859-5} (G1) initially invoked. + +@item iso-8859-7 +@itemx iso-8859-7-dos +@itemx iso-8859-7-mac +@itemx iso-8859-7-unix + +Modeline indicator: @code{Grk}. A type @code{iso2022} coding system with +@code{ascii} (G0) and @code{greek-iso8859-7} (G1) initially invoked. + +@item iso-8859-8 +@itemx iso-8859-8-dos +@itemx iso-8859-8-mac +@itemx iso-8859-8-unix + +Modeline indicator: @code{MIME/Hbrw}. A type @code{iso2022} coding system with +@code{ascii} (G0) and @code{hebrew-iso8859-8} (G1) initially invoked. + +@item iso-8859-9 +@itemx iso-8859-9-dos +@itemx iso-8859-9-mac +@itemx iso-8859-9-unix + +Modeline indicator: @code{MIME/Ltn-5}. A type @code{iso2022} coding system +with @code{ascii} (G0) and @code{latin-iso8859-9} (G1) initially +invoked. + +@item koi8-r +@itemx koi8-r-dos +@itemx koi8-r-mac +@itemx koi8-r-unix + +Modeline indicator: @code{KOI8}. A type @code{ccl} coding-system used for +KOI8-R, an encoding of the Cyrillic alphabet. + +@item shift_jis +@itemx shift_jis-dos +@itemx shift_jis-mac +@itemx shift_jis-unix + +Modeline indicator: @code{Ja/SJIS}. A type @code{shift-jis} coding-system +implementing the Shift-JIS encoding for Japanese. The underscore is to +conform to the MIME charset implementing this encoding. + +@item tis-620 +@itemx tis-620-dos +@itemx tis-620-mac +@itemx tis-620-unix + +Modeline indicator: @code{TIS620}. A type @code{ccl} encoding for Thai. The +external encoding is defined by TIS620, the internal encoding is +peculiar to MULE, and called @code{thai-xtis}. + +@item viqr + +Modeline indicator: @code{VIQR}. A type @code{no-conversion} coding +system with Unix EOL convention (ie, no conversion) using +post-read-decode and pre-write-encode functions to translate the VIQR +coding system for Vietnamese. + +@item viscii +@itemx viscii-dos +@itemx viscii-mac +@itemx viscii-unix + +Modeline indicator: @code{VISCII}. A type @code{ccl} coding-system used +for VISCII 1.1 for Vietnamese. Differs slightly from VSCII; VISCII is +given priority by XEmacs. + +@item vscii +@itemx vscii-dos +@itemx vscii-mac +@itemx vscii-unix + +Modeline indicator: @code{VSCII}. A type @code{ccl} coding-system used +for VSCII 1.1 for Vietnamese. Differs slightly from VISCII, which is +given priority by XEmacs. Use +@code{(prefer-coding-system 'vietnamese-vscii)} to give priority to VSCII. + +@end table + @node CCL, Category Tables, Coding Systems, MULE @section CCL -CCL (Code Conversion Language) is a simple structured programming + CCL (Code Conversion Language) is a simple structured programming language designed for character coding conversions. A CCL program is compiled to CCL code (represented by a vector of integers) and executed by the CCL interpreter embedded in Emacs. The CCL interpreter @@ -1107,7 +1674,7 @@ statements) and especially @code{r7} (used internally by several statements and operations, especially for multiple return values and I/O operations). -CCL is used for code conversion during process I/O and file I/O for + CCL is used for code conversion during process I/O and file I/O for non-ISO2022 coding systems. (It is the only way for a user to specify a code conversion function.) It is also used for calculating the code point of an X11 font from a character code. However, since CCL is @@ -1116,14 +1683,14 @@ generic calculation where efficiency is demanded. A combination of three or more arithmetic operations can be calculated faster by CCL than by Emacs Lisp. -@strong{Warning:} The code in @file{src/mule-ccl.c} and + @strong{Warning:} The code in @file{src/mule-ccl.c} and @file{$packages/lisp/mule-base/mule-ccl.el} is the definitive description of CCL's semantics. The previous version of this section contained several typos and obsolete names left from earlier versions of MULE, and many may remain. (I am not an experienced CCL programmer; the few who know CCL well find writing English painful.) -A CCL program transforms an input data stream into an output data + A CCL program transforms an input data stream into an output data stream. The input stream, held in a buffer of constant bytes, is left unchanged. The buffer may be filled by an external input operation, taken from an Emacs buffer, or taken from a Lisp string. The output @@ -1131,7 +1698,7 @@ buffer is a dynamic array of bytes, which can be written by an external output operation, inserted into an Emacs buffer, or returned as a Lisp string. -A CCL program is a (Lisp) list containing two or three members. The + A CCL program is a (Lisp) list containing two or three members. The first member is the @dfn{buffer magnification}, which indicates the required minimum size of the output buffer as a multiple of the input buffer. It is followed by the @dfn{main block} which executes while @@ -1139,7 +1706,7 @@ there is input remaining, and an optional @dfn{EOF block} which is executed when the input is exhausted. Both the main block and the EOF block are CCL blocks. -A @dfn{CCL block} is either a CCL statement or list of CCL statements. + A @dfn{CCL block} is either a CCL statement or list of CCL statements. A @dfn{CCL statement} is either a @dfn{set statement} (either an integer or an @dfn{assignment}, which is a list of a register to receive the assignment, an assignment operator, and an expression) or a @dfn{control @@ -1154,11 +1721,11 @@ depends on the keyword). * CCL Examples:: The encoding functions for Big5 and KOI-8. @end menu -@node CCL Syntax, CCL Statements, CCL, CCL +@node CCL Syntax, CCL Statements, , CCL @comment Node, Next, Previous, Up @subsection CCL Syntax -The full syntax of a CCL program in BNF notation: + The full syntax of a CCL program in BNF notation: @format CCL_PROGRAM := @@ -1217,13 +1784,13 @@ ARRAY := '[' integer ... ']' @comment Node, Next, Previous, Up @subsection CCL Statements -The Emacs Code Conversion Language provides the following statement + The Emacs Code Conversion Language provides the following statement types: @dfn{set}, @dfn{if}, @dfn{branch}, @dfn{loop}, @dfn{repeat}, @dfn{break}, @dfn{read}, @dfn{write}, @dfn{call}, and @dfn{end}. @heading Set statement: -The @dfn{set} statement has three variants with the syntaxes + The @dfn{set} statement has three variants with the syntaxes @samp{(@var{reg} = @var{expression})}, @samp{(@var{reg} @var{assignment_operator} @var{expression})}, and @samp{@var{integer}}. The assignment operator variation of the @@ -1236,10 +1803,10 @@ the form @code{(r0 = @var{integer})}. @heading I/O statements: -The @dfn{read} statement takes one or more registers as arguments. It + The @dfn{read} statement takes one or more registers as arguments. It reads one byte (a C char) from the input into each register in turn. -The @dfn{write} takes several forms. In the form @samp{(write @var{reg} + The @dfn{write} takes several forms. In the form @samp{(write @var{reg} ...)} it takes one or more registers as arguments and writes each in turn to the output. The integer in a register (interpreted as an Emchar) is encoded to multibyte form (ie, Bufbytes) and written to the @@ -1253,13 +1820,13 @@ the @var{reg}th element of the @var{array} to the output. @heading Conditional statements: -The @dfn{if} statement takes an @var{expression}, a @var{CCL block}, and + The @dfn{if} statement takes an @var{expression}, a @var{CCL block}, and an optional @var{second CCL block} as arguments. If the @var{expression} evaluates to non-zero, the first @var{CCL block} is executed. Otherwise, if there is a @var{second CCL block}, it is executed. -The @dfn{read-if} variant of the @dfn{if} statement takes an + The @dfn{read-if} variant of the @dfn{if} statement takes an @var{expression}, a @var{CCL block}, and an optional @var{second CCL block} as arguments. The @var{expression} must have the form @code{(@var{reg} @var{operator} @var{operand})} (where @var{operand} is @@ -1268,7 +1835,7 @@ from the input into the first register operand in the @var{expression}, then conditionally executes a CCL block just as the @code{if} statement does. -The @dfn{branch} statement takes an @var{expression} and one or more CCL + The @dfn{branch} statement takes an @var{expression} and one or more CCL blocks as arguments. The CCL blocks are treated as a zero-indexed array, and the @code{branch} statement uses the @var{expression} as the index of the CCL block to execute. Null CCL blocks may be used as @@ -1276,7 +1843,7 @@ no-ops, continuing execution with the statement following the @code{branch} statement in the containing CCL block. Out-of-range values for the @var{EXPRESSION} are also treated as no-ops. -The @dfn{read-branch} variant of the @dfn{branch} statement takes an + The @dfn{read-branch} variant of the @dfn{branch} statement takes an @var{register}, a @var{CCL block}, and an optional @var{second CCL block} as arguments. The @code{read-branch} statement first reads from the input into the @var{register}, then conditionally executes a CCL @@ -1284,16 +1851,16 @@ block just as the @code{branch} statement does. @heading Loop control statements: -The @dfn{loop} statement creates a block with an implied jump from the + The @dfn{loop} statement creates a block with an implied jump from the end of the block back to its head. The loop is exited on a @code{break} statement, and continued without executing the tail by a @code{repeat} statement. -The @dfn{break} statement, written @samp{(break)}, terminates the + The @dfn{break} statement, written @samp{(break)}, terminates the current loop and continues with the next statement in the current block. -The @dfn{repeat} statement has three variants, @code{repeat}, + The @dfn{repeat} statement has three variants, @code{repeat}, @code{write-repeat}, and @code{write-read-repeat}. Each continues the current loop from its head, possibly after performing I/O. @code{repeat} takes no arguments and does no I/O before jumping. @@ -1309,11 +1876,11 @@ operations for each type of argument. @heading Other control statements: -The @dfn{call} statement, written @samp{(call @var{ccl-program-name})}, + The @dfn{call} statement, written @samp{(call @var{ccl-program-name})}, executes a CCL program as a subroutine. It does not return a value to the caller, but can modify the register status. -The @dfn{end} statement, written @samp{(end)}, terminates the CCL + The @dfn{end} statement, written @samp{(end)}, terminates the CCL program successfully, and returns to caller (which may be a CCL program). It does not alter the status of the registers. @@ -1321,13 +1888,13 @@ program). It does not alter the status of the registers. @comment Node, Next, Previous, Up @subsection CCL Expressions -CCL, unlike Lisp, uses infix expressions. The simplest CCL expressions + CCL, unlike Lisp, uses infix expressions. The simplest CCL expressions consist of a single @var{operand}, either a register (one of @code{r0}, ..., @code{r0}) or an integer. Complex expressions are lists of the form @code{( @var{expression} @var{operator} @var{operand} )}. Unlike C, assignments are not expressions. -In the following table, @var{X} is the target resister for a @dfn{set}. + In the following table, @var{X} is the target resister for a @dfn{set}. In subexpressions, this is implicitly @code{r7}. This means that @code{>8}, @code{//}, @code{de-sjis}, and @code{en-sjis} cannot be used freely in subexpressions, since they return parts of their values in @@ -1361,7 +1928,7 @@ freely in subexpressions, since they return parts of their values in @item @tab @tab @tab r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) @end multitable -The CCL operators are as in C, with the addition of CCL_LSH8, CCL_RSH8, + The CCL operators are as in C, with the addition of CCL_LSH8, CCL_RSH8, CCL_DIVMOD, CCL_ENCODE_SJIS, and CCL_DECODE_SJIS. The CCL_ENCODE_SJIS and CCL_DECODE_SJIS treat their first and second bytes as the high and low bytes of a two-byte character code. (SJIS stands for Shift JIS, an @@ -1370,11 +1937,11 @@ complicated transformation of the Japanese standard JIS encoding to Shift JIS. CCL_DECODE_SJIS is its inverse.) It is somewhat odd to represent the SJIS operations in infix form. -@node Calling CCL, CCL Examples, CCL Expressions, CCL +@node Calling CCL, CCL Examples, CCL Expressions, CCL @comment Node, Next, Previous, Up @subsection Calling CCL -CCL programs are called automatically during Emacs buffer I/O when the + CCL programs are called automatically during Emacs buffer I/O when the external representation has a coding system type of @code{shift-jis}, @code{big5}, or @code{ccl}. The program is specified by the coding system (@pxref{Coding Systems}). You can also call CCL programs from @@ -1411,7 +1978,7 @@ side-effect) to contain the ending values for the corresponding registers and IC. Returns the resulting string. @end defun -To call a CCL program from another CCL program, it must first be + To call a CCL program from another CCL program, it must first be registered: @defun register-ccl-program name ccl-program @@ -1421,7 +1988,7 @@ a CCL program, or nil. Return index number of the registered CCL program. @end defun -Information about the processor time used by the CCL interpreter can be + Information about the processor time used by the CCL interpreter can be obtained using these functions: @defun ccl-elapsed-time @@ -1436,11 +2003,11 @@ value and 0. Resets the CCL interpreter's internal elapsed time registers. @end defun -@node CCL Examples, , Calling CCL, CCL +@node CCL Examples, , Calling CCL, CCL @comment Node, Next, Previous, Up @subsection CCL Examples -This section is not yet written. + This section is not yet written. @node Category Tables, , CCL, MULE @section Category Tables diff --git a/man/lispref/scrollbars.texi b/man/lispref/scrollbars.texi index 6fa6cf9..0e4dbbb 100644 --- a/man/lispref/scrollbars.texi +++ b/man/lispref/scrollbars.texi @@ -3,8 +3,8 @@ @c Copyright (C) 1995 Ben Wing. @c See the file lispref.texi for copying conditions. @setfilename ../../info/glyphs.info -@node Scrollbars, Drag and Drop, Toolbar, top -@chapter scrollbars +@node Scrollbars, Drag and Drop, Gutter, top +@chapter Scrollbars @cindex scrollbars Not yet documented. diff --git a/man/lispref/toolbar.texi b/man/lispref/toolbar.texi index 4a72742..13747cd 100644 --- a/man/lispref/toolbar.texi +++ b/man/lispref/toolbar.texi @@ -3,7 +3,7 @@ @c Copyright (C) 1995, 1996 Ben Wing. @c See the file lispref.texi for copying conditions. @setfilename ../../info/toolbar.info -@node Toolbar, Scrollbars, Dialog Boxes, top +@node Toolbar, Gutter, Dialog Boxes, top @chapter Toolbar @cindex toolbar diff --git a/man/xemacs-faq.texi b/man/xemacs-faq.texi index 7197ea8..5b62a19 100644 --- a/man/xemacs-faq.texi +++ b/man/xemacs-faq.texi @@ -1,4 +1,4 @@ -\input texinfo.tex @c -*-texinfo-*- +\input texinfo.tex @c -*- mode: texinfo; coding: iso-2022-8 -*- @c %**start of header @setfilename ../info/xemacs-faq.info @settitle Frequently asked questions about XEmacs @@ -7,7 +7,7 @@ @finalout @titlepage @title XEmacs FAQ -@subtitle Frequently asked questions about XEmacs @* Last Modified: $Date: 2000/01/27 17:11:28 $ +@subtitle Frequently asked questions about XEmacs @* Last Modified: $Date: 2000/03/07 09:19:02 $ @sp 1 @author Tony Rossini @author Ben Wing @@ -403,6 +403,9 @@ Miscellaneous: * Q6.3.2:: What are the differences between the various MS Windows emacsen? * Q6.3.3:: What is the porting team doing at the moment? +Troubleshooting: +* Q6.4.1:: XEmacs won't start on Windows. (NEW) + Current Events: * Q7.0.1:: What is new in 20.2? @@ -697,9 +700,8 @@ Yes, @xref{MS Windows}. @c @uref{ftp://ftp.cs.cornell.edu/pub/parmet/, Emacs 18.59}. Yes, there is a port of XEmacs 19.14, tested on MacOS 7.6.1 and MacOS -8.5.1 by @uref{pjarvis@@ispchannel.com,Pitts Jarvis}. It's available -at @uref{http://my.ispchannel.com/~pjarvis/xemacs.html, -http://my.ispchannel.com/~pjarvis/xemacs.html}. +8.5.1 by @email{pjarvis@@ispchannel.com, Pitts Jarvis}. It's available +at @uref{http://my.ispchannel.com/~pjarvis/xemacs.html}. @node Q1.0.12, Q1.0.13, Q1.0.11, Introduction @unnumberedsubsec Q1.0.12: Is there a port of XEmacs to NextStep? @@ -3035,8 +3037,8 @@ and so on. You can also do this interactively via @kbd{M-x edit-faces}. @end quotation -@unnumberedsec 3.3: The Modeline @node Q3.3.1, Q3.3.2, Q3.2.6, Customization +@unnumberedsec 3.3: The Modeline @unnumberedsubsec Q3.3.1: How can I make the modeline go away? @lisp @@ -6103,6 +6105,9 @@ Miscellaneous * Q6.3.2:: What are the differences between the various MS Windows emacsen? * Q6.3.3:: What is the porting team doing at the moment? +Troubleshooting: +* Q6.4.1:: XEmacs won't start on Windows. (NEW) + @end menu @node Q6.0.1, Q6.0.2, MS Windows, MS Windows @@ -6433,11 +6438,31 @@ others. @end itemize -@node Q6.3.3, , Q6.3.2, MS Windows +@node Q6.3.3, Q6.4.1, Q6.3.2, MS Windows @unnumberedsubsec Q6.3.3: What is the porting team doing at the moment? The porting team is continuing work on the MS Windows-specific code. +@node Q6.4.1, ,Q6.3.3, MS Windows +@unnumberedsec 6.3: Troubleshooting +@unnumberedsubsec Q6.4.1 XEmacs won't start on Windows. (NEW) + +XEmacs relies on a process called "dumping" to generate a working +executable. Under MS-Windows this process effectively fixes the memory +addresses of information in the executable. When XEmacs starts up it tries +to reserve these memory addresses so that the dumping process can be +reversed - putting the information back at the correct addresses. +Unfortunately some .dlls (For instance the soundblaster driver) occupy +memory addresses that can conflict with those needed by the dumped XEmacs +executable. In this instance XEmacs will fail to start without any +explanation. Note that this is extremely machine specific. + +Work is being done on fixes for 21.1.* that will make more intelligent +guesses about which memory addresses will be free and so this should +cure the problem for most people. + +21.2 implements "portable dumping" which will eliminate the problem +altogether. @node Current Events, , MS Windows, Top @unnumbered 7 What the Future Holds diff --git a/man/xemacs/custom.texi b/man/xemacs/custom.texi index ffb5a27..bd54971 100644 --- a/man/xemacs/custom.texi +++ b/man/xemacs/custom.texi @@ -28,8 +28,10 @@ customization in each session. @xref{Init File}. are parsed. * Init File:: How to write common customizations in the @file{.emacs} file. -* Audible Bell:: Changing how Emacs sounds the bell. -* Faces:: Changing the fonts and colors of a region of text. +* Audible Bell:: Changing how Emacs sounds the bell. +* Faces:: Changing the fonts and colors of a region of text. +* Frame Components:: Controlling the presence and positions of the + menubar, toolbars, and gutters. * X Resources:: X resources controlling various aspects of the behavior of XEmacs. @end menu @@ -2052,6 +2054,16 @@ to make underlining an attribute of the face or not. If the optional @var{frame} argument is provided, the face is changed only in that frame; otherwise, it is changed in all frames. +@node Frame Components +@section Frame Components + +You can control the presence and position of most frame components, such +as the menubar, toolbars, and gutters. + +This section is not written yet. Try the Lisp Reference Manual: +@ref{Menubar,,,lispref,}, @ref{Toolbar Intro,,,lispref,}, and +@ref{Gutter Intro,,,lispref,}. + @node X Resources @section X Resources @cindex X resources @@ -2477,7 +2489,7 @@ XEmacs executable (usually @samp{xemacs}), and @subsection Menubar Resources As the menubar is implemented as a widget which is not a part of XEmacs -proper, it does not use the fac" mechanism for specifying fonts and +proper, it does not use the face mechanism for specifying fonts and colors: It uses whatever resources are appropriate to the type of widget which is used to implement it. diff --git a/man/xemacs/frame.texi b/man/xemacs/frame.texi index 52be4b8..8dff083 100644 --- a/man/xemacs/frame.texi +++ b/man/xemacs/frame.texi @@ -41,9 +41,21 @@ At the bottom of each XEmacs frame is the @dfn{echo area} or @dfn{minibuffer window}(@pxref{Echo Area}). It is used by XEmacs to exchange information with the user. There is only one echo area per XEmacs frame. @item -If you are running XEmacs under the X Window System, a +If you are running XEmacs under a graphical windowing system, a menu bar at the top of the frame makes shortcuts to several of the commands available (@pxref{Pull-down Menus}). +@item +If you are running XEmacs under a graphical windowing system, a +toolbar at the top of the frame, just under the menu bar if it exists, +provides ``one-touch'' shortcuts to several commands. (Not yet +documented.) +@item +If you are running XEmacs under a graphical windowing system, a +gutter at the top (under the toolbar) and/or bottom of the frame +provides advanced GUI facilities like tab controls for rapid switching +among related windows and progress bars for time-consuming operations +like downloads across the Internet. Gutters are an experimental feature +introduced in XEmacs version 21.2. (Not yet documented.) @end itemize You can subdivide the XEmacs frame into multiple text windows, and use diff --git a/man/xemacs/glossary.texi b/man/xemacs/glossary.texi index a8c21aa..dd2321f 100644 --- a/man/xemacs/glossary.texi +++ b/man/xemacs/glossary.texi @@ -278,7 +278,7 @@ screen. When running Emacs under X, you can have multiple frames, each corresponding to a top-level X window and each looking like the screen on a TTY. Each frame contains one or more non-overlapping Emacs windows (possibly with associated scrollbars, under X), an -echo area, and (under X) possibly a menubar. +echo area, and (under X) possibly a menubar, toolbar, and/or gutter. @item Global Global means `independent of the current environment; in effect diff --git a/man/xemacs/help.texi b/man/xemacs/help.texi index 2b517fc..6fa5fd8 100644 --- a/man/xemacs/help.texi +++ b/man/xemacs/help.texi @@ -1,20 +1,28 @@ @node Help, Mark, M-x, Top @chapter Help +@kindex Help @cindex help @cindex self-documentation +@findex help-command +@kindex C-h +@kindex F1 - Emacs provides extensive help features which revolve around a single + XEmacs provides extensive help features accessible through a single character, @kbd{C-h}. @kbd{C-h} is a prefix key that is used only for -documentation-printing commands. The characters you can type after +documentation-printing commands. The characters that you can type after @kbd{C-h} are called @dfn{help options}. One help option is @kbd{C-h}; -you use it to ask for help about using @kbd{C-h}. +that is how you ask for help about using @kbd{C-h}. To cancel, type +@kbd{C-g}. The function key @key{F1} is equivalent to @kbd{C-h}. - @kbd{C-h C-h} prints a list of the possible help options, and then asks -you to type the desired option. It prompts with the string: +@kindex C-h C-h +@findex help-for-help + @kbd{C-h C-h} (@code{help-for-help}) displays a list of the possible +help options, and then asks you to type the desired option. It prompts +with the string: @smallexample -A, B, C, F, I, K, L, M, N, S, T, V, W, C-c, C-d, C-n, C-w or C-h for more help: +A B C F I K L M N P S T V W C-c C-d C-f C-i C-k C-n C-w; ? for more help: @end smallexample @noindent @@ -23,66 +31,109 @@ You should type one of those characters. Typing a third @kbd{C-h} displays a description of what the options mean; Emacs still waits for you to type an option. To cancel, type @kbd{C-g}. + Most help buffers use a special major mode, Help mode, which lets you +scroll conveniently with @key{SPC} and @key{DEL} or @key{BS}. + +@menu +* Help Summary:: Brief list of all Help commands. +* Key Help:: Asking what a key does in XEmacs. +* Name Help:: Asking about a command, variable or function name. +* Apropos:: Asking what pertains to a given topic. +* Library Keywords:: Finding Lisp libraries by keywords (topics). +* Help Mode:: Special features of Help mode and Help buffers. +* Misc Help:: Other help commands. +@end menu + +@iftex +@node Help Summary, Help Summary, Help, Help +@end iftex +@ifinfo +@node Help Summary, Key Help, Help, Help +@section Help Summary +@end ifinfo + Here is a summary of the defined help commands. @table @kbd -@item C-h a @var{string} @key{RET} -Display a list of commands whose names contain @var{string} -(@code{command-@*apropos}).@refill +@item C-h a @var{regexp} @key{RET} +Display a list of functions and variables whose names match @var{regexp} +(@code{heper-apropos}). +@item C-h A @var{regexp} +Show all commands whose names contain matches for @var{regexp} +(@code{command-apropos}). @item C-h b -Display a table of all key bindings currently in effect, with local bindings of -the current major mode first, followed by all global bindings -(@code{describe-bindings}). +Display a table of all key bindings currently in effect, with local +bindings of the current major mode first, followed by all global +bindings (@code{describe-bindings}). @item C-h c @var{key} -Print the name of the command that @var{key} runs (@code{describe-key-@*briefly}). -@kbd{c} is for `character'. For more extensive information on @var{key}, -use @kbd{C-h k}. -@item C-h f @var{function} @key{RET} +Print the name of the command that @var{key} runs +(@code{describe-key-briefly}). Here @kbd{c} stands for `character'. For more +extensive information on @var{key}, use @kbd{C-h k}. +@item C-h d @var{function} @key{RET} +@itemx C-h f @var{function} @key{RET} Display documentation on the Lisp function named @var{function} -(@code{describe-function}). Note that commands are Lisp functions, so +(@code{describe-function}). Since commands are Lisp functions, a command name may be used. @item C-h i Run Info, the program for browsing documentation files (@code{info}). -The complete Emacs manual is available online in Info. +The complete XEmacs manual is available online in Info. @item C-h k @var{key} -Display name and documentation of the command @var{key} runs (@code{describe-key}). +Display the name and documentation of the command that @var{key} runs +(@code{describe-key}). @item C-h l Display a description of the last 100 characters you typed (@code{view-lossage}). @item C-h m Display documentation of the current major mode (@code{describe-mode}). @item C-h n -Display documentation of Emacs changes, most recent first +@itemx C-h C-n +Display documentation of XEmacs changes, most recent first (@code{view-emacs-news}). @item C-h p +Find packages by topic keyword (@code{finder-by-keyword}). +@item C-h C-p Display a table of all mouse bindings currently in effect now, with -local bindings of the current major mode first, followed by all global bindings -(@code{describe-pointer}). +local bindings of the current major mode first, followed by all global +bindings (@code{describe-pointer}). @item C-h s Display current contents of the syntax table, plus an explanation of -what they mean (@code{describe-syntax}). +what they mean (@code{describe-syntax}). @xref{Syntax}. @item C-h t -Display the Emacs tutorial (@code{help-with-tutorial}). +Enter the XEmacs interactive tutorial (@code{help-with-tutorial}). @item C-h v @var{var} @key{RET} Display the documentation of the Lisp variable @var{var} -(@code{describe-@*variable}). +(@code{describe-variable}). @item C-h w @var{command} @key{RET} Print which keys run the command named @var{command} (@code{where-is}). -@item M-x apropos @var{regexp} -Show all symbols whose names contain matches for @var{regexp}. +@item C-h B @key{RET} +Display info on how to deal with Beta versions of XEmacs +(@code{describe-beta}). +@item C-h C @var{group} @key{RET} +Select customization buffer for @var{group} (@code{customize}). +@item C-h F @key{RET} +View the local copy of the XEmacs FAQ (@code{xemacs-local-faq}). +@item C-h C-i @var{file} @key{RET} +Read Info file @var{file} with Info browser (@code{Info-query}). +@item C-h C-c @var{command} @key{RET} +Look up an Emacs command @var{command} in the Emacs manual in the Info +system (@code{Info-goto-emacs-command-node}). +@item C-h C-f @var{function} @key{RET} +Look up an Emacs Lisp function @var{function} in the Elisp manual in the +Info system (@code{Info-elisp-ref}). @end table +@node Key Help, Name Help, Help Summary, Help @section Documentation for a Key @kindex C-h c @findex describe-key-briefly The most basic @kbd{C-h} options are @kbd{C-h c} -(@code{describe-key-briefly}) and @kbd{C-h k}@*(@code{describe-key}). -@kbd{C-h c @var{key}} prints the name of the command that @var{key} is -bound to in the echo area. For example, @kbd{C-h c C-f} prints +(@code{describe-key-briefly}) and @w{@kbd{C-h k}} (@code{describe-key}). +@kbd{C-h c @var{key}} prints in the echo area the name of the command +that @var{key} is bound to. For example, @kbd{C-h c C-f} prints @samp{forward-char}. Since command names are chosen to describe what -the command does, using this option is a good way to get a somewhat cryptic -description of what @var{key} does.@refill +the commands do, this is a good way to get a very brief description of +what @var{key} does. @kindex C-h k @findex describe-key @@ -93,6 +144,10 @@ vector of events. When called interactively, @var{key} may also be a menu selection. This information does not usually fit into the echo area, so a window is used for the display. + @kbd{C-h c} and @kbd{C-h k} work for any sort of key sequences, +including function keys and mouse events. + +@node Name Help, Apropos, Key Help, Help @section Help by Command or Variable Name @kindex C-h f @@ -116,117 +171,238 @@ If the variable @code{describe-function-show-arglist} is @code{t}, @code{describe-function} shows its arglist if the @var{function} is not an autoload function. - @kbd{C-h f} is also useful for Lisp functions you are planning to -use in a Lisp program. For example, if you have just written the code -@code{(make-vector len)} and want to make sure you are using -@code{make-vector} properly, type @kbd{C-h f make-vector @key{RET}}. Because -@kbd{C-h f} allows all function names, not just command names, you may find -that some of your favorite abbreviations that work in @kbd{M-x} don't work -in @kbd{C-h f}. An abbreviation may be unique among command names, yet fail -to be unique when other function names are allowed. - - -If you type @key{RET}, leaving the minibuffer empty, @kbd{C-h f} by -default describes the function called by the innermost Lisp expression -in the buffer around point, @i{provided} that that is a valid, defined Lisp -function name. For example, if point is located following the text + @kbd{C-h f} is also useful for Lisp functions that you are planning to +use in a Lisp program. For example, if you have just written the +expression @code{(make-vector len)} and want to make sure you are using +@code{make-vector} properly, type @kbd{C-h f make-vector @key{RET}}. +Because @kbd{C-h f} allows all function names, not just command names, +you may find that some of your favorite abbreviations that work in +@kbd{M-x} don't work in @kbd{C-h f}. An abbreviation may be unique +among command names, yet fail to be unique when other function names are +allowed. + + The function name for @kbd{C-h f} to describe has a default which is +used if you type @key{RET} leaving the minibuffer empty. The default is +the function called by the innermost Lisp expression in the buffer +around point, @emph{provided} that is a valid, defined Lisp function +name. For example, if point is located following the text @samp{(make-vector (car x)}, the innermost list containing point is the -one starting with @samp{(make-vector}, so the default is to describe -the function @code{make-vector}. +one that starts with @samp{(make-vector}, so the default is to describe the +function @code{make-vector}. @kbd{C-h f} is often useful just to verify that you have the right -spelling for the function name. If @kbd{C-h f} mentions a default in the -prompt, you have typed the name of a defined Lisp function. If that is -what you wanted to know, just type @kbd{C-g} to cancel the @kbd{C-h f} -command and continue editing. +spelling for the function name. If @kbd{C-h f} mentions a name from the +buffer as the default, that name must be defined as a Lisp function. If +that is all you want to know, just type @kbd{C-g} to cancel the @kbd{C-h +f} command, then go on editing. @kindex C-h w @findex where-is - @kbd{C-h w @var{command} @key{RET}} (@code{where-s}) tells you what + @kbd{C-h w @var{command} @key{RET}} (@code{where-is}) tells you what keys are bound to @var{command}. It prints a list of the keys in the -echo area. Alternatively, it informs you that a command is not bound to -any keys, which implies that you must use @kbd{M-x} to call the -command.@refill +echo area. Alternatively, it informs you that a command is not bound to +any keys, which implies that you must use @kbd{M-x} to call the +command. @kindex C-h v @findex describe-variable @kbd{C-h v} (@code{describe-variable}) is like @kbd{C-h f} but describes Lisp variables instead of Lisp functions. Its default is the Lisp symbol around or before point, if that is the name of a known Lisp -variable. @xref{Variables}.@refill +variable. @xref{Variables}. +@node Apropos, Library Keywords, Name Help, Help @section Apropos -@kindex C-h a +@kindex C-h A @findex command-apropos -@cindex apropos +@cindex apropos @table @kbd -@item C-h a +@item C-h A Show only symbols that are names of commands -(@code{command-apropos}).@refill +(@code{command-apropos}). @item M-x apropos @var{regexp} Show all symbols whose names comtain matches for @var{regexp}. @end table - It is possible to ask a question like, ``What are the commands for -working with files?'' To do this, type @kbd{C-h a file @key{RET}}, -which displays a list of all command names that contain @samp{file}, -such as @code{copy-file}, @code{find-file}, and so on. With each -command name a brief description of its use and information on the keys -you can use to invoke it is displayed. For example, you would be -informed that you can invoke @code{find-file} by typing @kbd{C-x C-f}. -The @kbd{a} in @kbd{C-h a} stands for `Apropos'; @kbd{C-h a} runs the -Lisp function @code{command-apropos}.@refill - - Because @kbd{C-h a} looks only for functions whose names contain the + A more sophisticated sort of question to ask is, ``What are the +commands for working with files?'' To ask this question, type @kbd{C-h +a file @key{RET}}, which displays a list of all command names that +contain @samp{file}, including @code{copy-file}, @code{find-file}, and +so on. With each command name appears a brief description of how to use +the command, and what keys you can currently invoke it with. For +example, it would say that you can invoke @code{find-file} by typing +@kbd{C-x C-f}. The @kbd{A} in @kbd{C-h A} stands for `Apropos'; +@kbd{C-h A} runs the command @code{command-apropos}. This command +normally checks only commands (interactive functions); if you specify a +prefix argument, it checks noninteractive functions as well. + + Because @kbd{C-h A} looks only for functions whose names contain the string you specify, you must use ingenuity in choosing the string. If you are looking for commands for killing backwards and @kbd{C-h a -kill-backwards @key{RET}} doesn't reveal any commands, don't give up. -Try just @kbd{kill}, or just @kbd{backwards}, or just @kbd{back}. Be -persistent. Pretend you are playing Adventure. Also note that you can -use a regular expression as the argument (@pxref{Regexps}). +kill-backwards @key{RET}} doesn't reveal any, don't give up. Try just +@kbd{kill}, or just @kbd{backwards}, or just @kbd{back}. Be persistent. +Pretend you are playing Adventure. Also note that you can use a regular +expression as the argument, for more flexibility (@pxref{Regexps}). Here is a set of arguments to give to @kbd{C-h a} that covers many -classes of Emacs commands, since there are strong conventions for naming -standard Emacs commands. By giving you a feeling for the naming -conventions, this set of arguments can also help you develop a -technique for picking @code{apropos} strings. +classes of XEmacs commands, since there are strong conventions for +naming the standard XEmacs commands. By giving you a feel for the +naming conventions, this set should also serve to aid you in developing +a technique for picking @code{apropos} strings. @quotation char, line, word, sentence, paragraph, region, page, sexp, list, defun, -buffer, frame, window, file, dir, register, mode, -beginning, end, forward, backward, next, previous, up, down, search, goto, -kill, delete, mark, insert, yank, fill, indent, case, -change, set, what, list, find, view, describe. +rect, buffer, frame, window, face, file, dir, register, mode, beginning, +end, forward, backward, next, previous, up, down, search, goto, kill, +delete, mark, insert, yank, fill, indent, case, change, set, what, list, +find, view, describe, default. @end quotation @findex apropos To list all Lisp symbols that contain a match for a regexp, not just the ones that are defined as commands, use the command @kbd{M-x apropos} -instead of @kbd{C-h a}. +instead of @kbd{C-h A}. This command does not check key bindings by +default; specify a numeric argument if you want it to check them. + +@findex apropos-documentation + The @code{apropos-documentation} command is like @code{apropos} except +that it searches documentation strings for matches for the specified +regular expression. + +@findex apropos-value + The @code{apropos-value} command is like @code{apropos} except that it +searches symbols' values for matches for the specified regular +expression. This command does not check function definitions or +property lists by default; specify a numeric argument if you want it to +check them. + +@vindex apropos-do-all + If the variable @code{apropos-do-all} is non-@code{nil}, the commands +above all behave as if they had been given a prefix argument. + + If you want more information about a function definition, variable or +symbol property listed in the Apropos buffer, you can click on it with +@kbd{Mouse-2} or move there and type @key{RET}. + +@node Library Keywords, Help Mode, Apropos, Help +@section Keyword Search for Lisp Libraries + +@kindex C-h p +@findex finder-by-keyword +The @kbd{C-h p} command lets you search the standard Emacs Lisp +libraries by topic keywords. Here is a partial list of keywords you can +use: + +@display +abbrev abbreviation handling, typing shortcuts, macros +bib code related to the `bib' bibliography processor +c C, C++, and Objective-C language support +calendar calendar and time management support +comm communications, networking, remote access to files +data support for editing files of data +docs support for Emacs documentation +dumped files preloaded into Emacs +emulations emulations of other editors +extensions Emacs Lisp language extensions +faces support for multiple fonts +frames support for Emacs frames and window systems +games games, jokes and amusements +hardware support for interfacing with exotic hardware +help support for on-line help systems +hypermedia support for links between text or other media types +i18n internationalization and alternate character-set support +internal code for Emacs internals, build process, defaults +languages specialized modes for editing programming languages +lisp Lisp support, including Emacs Lisp +local code local to your site +maint maintenance aids for the Emacs development group +mail modes for electronic-mail handling +matching various sorts of searching and matching +mouse mouse support +mule multi-language extensions +news support for netnews reading and posting +oop support for object-oriented programming +outlines support for hierarchical outlining +processes process, subshell, compilation, and job control support +terminals support for terminal types +tex code related to the TeX formatter +tools programming tools +unix front-ends/assistants for, or emulators of, UNIX features +vms support code for vms +wp word processing +@end display + +@node Help Mode, Misc Help, Library Keywords, Help +@section Help Mode Commands + + Help buffers provide the commands of View mode (@pxref{Misc File +Ops}), plus a few special commands of their own. +@table @kbd +@item @key{SPC} +Scroll forward. +@item @key{DEL} +@itemx @key{BS} +Scroll backward. +@c @item @key{RET} +@c Follow a cross reference at point. +@c @item @key{TAB} +@c Move point forward to the next cross reference. +@c @item S-@key{TAB} +@c Move point back to the previous cross reference. +@c @item Mouse-2 +@c Follow a cross reference that you click on. +@end table + + When a command name (@pxref{M-x,, Running Commands by Name}) or +variable name (@pxref{Variables}) appears in the documentation, it +normally appears inside paired single-quotes. + +@node Misc Help, , Help Mode, Help @section Other Help Commands @kindex C-h i @findex info +@cindex Info +@cindex manuals, on-line +@cindex on-line manuals @kbd{C-h i} (@code{info}) runs the Info program, which is used for -browsing through structured documentation files. The entire Emacs manual +browsing through structured documentation files. The entire XEmacs manual is available within Info. Eventually all the documentation of the GNU system will be available. Type @kbd{h} after entering Info to run a tutorial on using Info. + If you specify a numeric argument, @kbd{C-h i} prompts for the name of +a documentation file. This way, you can browse a file which doesn't +have an entry in the top-level Info menu. It is also handy when you +need to get to the documentation quickly, and you know the exact name of +the file. + +@kindex C-h C-f +@kindex C-h C-k +@findex Info-elisp-ref +@findex Info-goto-emacs-command-node + There are two special help commands for accessing XEmacs documentation +through Info. @kbd{C-h C-f @var{function} @key{RET}} enters Info and +goes straight to the documentation of the XEmacs function +@var{function}. @kbd{C-h C-k @var{key}} enters Info and goes straight +to the documentation of the key @var{key}. These two keys run the +commands @code{Info-elisp-ref} and +@code{Info-goto-emacs-key-command-node}. + @kindex C-h l @findex view-lossage If something surprising happens, and you are not sure what commands you typed, use @kbd{C-h l} (@code{view-lossage}). @kbd{C-h l} prints the last -100 command characters you typed. If you see commands you don't -know, use @kbd{C-h c} to find out what they do. +100 command characters you typed in. If you see commands that you don't +know, you can use @kbd{C-h c} to find out what they do. @kindex C-h m @findex describe-mode - Emacs has several major modes. Each mode redefines a few keys and + XEmacs has several major modes. Each mode redefines a few keys and makes a few other changes in how editing works. @kbd{C-h m} (@code{describe-mode}) prints documentation on the current major mode, which normally describes all the commands that are changed in this mode. @@ -234,13 +410,21 @@ which normally describes all the commands that are changed in this mode. @kindex C-h b @findex describe-bindings @kbd{C-h b} (@code{describe-bindings}) and @kbd{C-h s} -(@code{describe-syntax}) present information about the current Emacs +(@code{describe-syntax}) present information about the current XEmacs mode that is not covered by @kbd{C-h m}. @kbd{C-h b} displays a list of -all key bindings currently in effect, with the local bindings of the current -major mode first, followed by the global bindings (@pxref{Key +all the key bindings currently in effect, with the local bindings of the +current major mode first, followed by the global bindings (@pxref{Key Bindings}). @kbd{C-h s} displays the contents of the syntax table with -explanations of each character's syntax (@pxref{Syntax}).@refill +explanations of each character's syntax (@pxref{Syntax}). + + You can get a similar list for a particular prefix key by typing +@kbd{C-h} after the prefix key. (There are a few prefix keys for which +this does not work---those that provide their own bindings for +@kbd{C-h}. One of these is @key{ESC}, because @kbd{@key{ESC} C-h} is +actually @kbd{C-M-h}, which marks a defun.) +@kindex C-h F +@findex xemacs-local-faq @kindex C-h n @findex view-emacs-news @kindex C-h t @@ -252,14 +436,16 @@ explanations of each character's syntax (@pxref{Syntax}).@refill @kindex C-h C-w @findex describe-no-warranty The other @kbd{C-h} options display various files of useful -information. @kbd{C-h C-w} (@code{describe-no-warranty}) displays -details on the complete absence of warranty for XEmacs. @kbd{C-h n} -(@code{view-emacs-news}) displays the file @file{emacs/etc/NEWS}, which -contains documentation on Emacs changes arranged chronologically. -@kbd{C-h t} (@code{help-with-tutorial}) displays the learn-by-doing -Emacs tutorial. @kbd{C-h C-c} (@code{describe-copying}) displays the file -@file{emacs/etc/COPYING}, which tells you the conditions you must obey -in distributing copies of Emacs. @kbd{C-h C-d} +information. @kbd{C-h C-w} (@code{describe-no-warranty}) displays the +full details on the complete absence of warranty for XEmacs. @kbd{C-h +n} (@code{view-emacs-news}) displays the file @file{xemacs/etc/NEWS}, +which contains documentation on XEmacs changes arranged chronologically. +@kbd{C-h F} (@code{xemacs-local-faq}) displays local version of the +XEmacs frequentliy-answered-questions-list. @kbd{C-h t} +(@code{help-with-tutorial}) displays the learn-by-doing XEmacs +tutorial. @kbd{C-h C-c} (@code{describe-copying}) displays the file +@file{xemacs/etc/COPYING}, which tells you the conditions you must obey +in distributing copies of XEmacs. @kbd{C-h C-d} (@code{describe-distribution}) displays another file named -@file{emacs/etc/DISTRIB}, which tells you how you can order a copy of -the latest version of Emacs.@refill +@file{xemacs/etc/DISTRIB}, which tells you how you can order a copy of +the latest version of XEmacs. diff --git a/man/xemacs/xemacs.texi b/man/xemacs/xemacs.texi index cbbf13c..dbcc221 100644 --- a/man/xemacs/xemacs.texi +++ b/man/xemacs/xemacs.texi @@ -271,9 +271,13 @@ Using X Selections Registers -* RegPos:: Saving positions in registers. -* RegText:: Saving text in registers. -* RegRect:: Saving rectangles in registers. +* Position: RegPos. Saving positions in registers. +* Text: RegText. Saving text in registers. +* Rectangle: RegRect. Saving rectangles in registers. +* Configurations: RegConfig. Saving window configurations in registers. +* Files: RegFiles. File names in registers. +* Numbers: RegNumbers. Numbers in registers. +* Bookmarks:: Bookmarks are like registers, but persistent. Controlling the Display diff --git a/nt/ChangeLog b/nt/ChangeLog index fffa7b9..e7ec435 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,66 @@ +2000-03-20 Martin Buchholz + + * XEmacs 21.2.32 is released. + +2000-03-15 Mike Alexander + + * xemacs.mak: Fix for generation of $(XEMACS)\Installation. + +2000-03-14 Adrian Aichner + + * xemacs.mak (LIB_SRC_TOOLS): LIB_SRC_TOOLS depend on + XEMACS_INCLUDES when we USE_PORTABLE_DUMPER. + +2000-03-13 Ben Wing + + * xemacs.mak (TEMACS_ENTRYPOINT): + Fix for portable dumper. + +2000-03-12 Ben Wing + + * xemacs.mak (*): + * config.inc: New. + + a) Added a file called config.inc which makes it easier to set + build options for MS Windows. (Previously, the only way to do this + was through command line options to nmake.) + + b) Cleaned the file up a bit. + + c) Changed xemacs to be a windows application and not a console + application, now that runemacs.exe is no longer necessary. + + d) Added support for building the tags file. + + * xemacs.dsw: New. + * xemacs.dsp: New. + For compiling, editing, and debugging XEmacs using the VC++ 5.0 + GUI. They may well work under other versions of VC++, but I don't + have access to them to test them. + +2000-03-11 Andy Piper + + * PROBLEMS: Doc fix from Reini Urban . + +2000-02-27 Mike Alexander + + * xemacs.rc: Include the portable dump data if INCLUDE_DUMP is defined + + * xemacs.mak: Add the portable dump data to the EXE as a resource + +2000-03-07 Jonathan Harris + + * xemacs.mak (TEMACS_LIBS): Add ole32.lib and uuid.lib. + (installation): Always regenerate installation report. + +2000-02-25 Craig Lanning + + * inc\sys\time.h: MinGW defines struct timeval in . + +2000-02-24 Martin Buchholz + + * config.h (INLINE_HEADER): Define properly (?) for Windows. + 2000-02-23 Martin Buchholz * XEmacs 21.2.31 is released. diff --git a/nt/PROBLEMS b/nt/PROBLEMS index 0be8bff..899d0e3 100644 --- a/nt/PROBLEMS +++ b/nt/PROBLEMS @@ -87,9 +87,9 @@ the Cut, Copy and Paste functions. Function XEmacs binding -------- -------------- Undo C-_ - Cut C-Insert - Copy C-Insert - Paste Sh-Del + Cut Sh-Del + Copy C-Insert + Paste Sh-Insert You can rebind keys to make XEmacs more Windows-compatible; for example, to bind C-z to undo: diff --git a/nt/config.h b/nt/config.h index 23974d1..a03e7c6 100644 --- a/nt/config.h +++ b/nt/config.h @@ -583,11 +583,13 @@ on various systems. */ /* MSVC version >= 2.x without /Za supports __inline */ #if (_MSC_VER < 900) || defined(__STDC__) -# define INLINE static +# define inline #else -# define INLINE __inline +# define inline __inline #endif +#define INLINE_HEADER inline static + /* MSVC warnings no-no crap. When adding one to this section, 1. Think twice 2. Insert textual description of the warning. diff --git a/nt/xemacs.mak b/nt/xemacs.mak index 5b4aef6..ed5ec7b 100644 --- a/nt/xemacs.mak +++ b/nt/xemacs.mak @@ -26,9 +26,14 @@ XEMACS=.. LISP=$(XEMACS)\lisp +LIB_SRC=$(XEMACS)\lib-src MODULES=$(XEMACS)\modules NT=$(XEMACS)\nt OUTDIR=$(NT)\obj +SRC=$(XEMACS)\src +MAKEDIRSTRING=$(MAKEDIR:\=\\) +XEMACSDIRSTRING=$(MAKEDIRSTRING:\\nt=) + # Define a variable for the 'del' command to use DEL=-del @@ -37,6 +42,8 @@ DEL=-del !include "..\version.sh" +!include "config.inc" + !if !defined(INFODOCK) INFODOCK=0 !endif @@ -315,7 +322,7 @@ MSW_INCLUDES= MSW_LIBS= !if $(HAVE_MSW_C_DIRED) MSW_DEFINES=$(MSW_DEFINES) -DHAVE_MSW_C_DIRED -MSW_C_DIRED_SRC=$(XEMACS)\src\dired-msw.c +MSW_C_DIRED_SRC=$(SRC)\dired-msw.c MSW_C_DIRED_OBJ=$(OUTDIR)\dired-msw.obj !endif !if $(HAVE_XPM) @@ -325,7 +332,7 @@ MSW_LIBS=$(MSW_LIBS) "$(XPM_DIR)\lib\Xpm.lib" !endif !if $(HAVE_GIF) MSW_DEFINES=$(MSW_DEFINES) -DHAVE_GIF -MSW_GIF_SRC=$(XEMACS)\src\dgif_lib.c $(XEMACS)\src\gif_io.c +MSW_GIF_SRC=$(SRC)\dgif_lib.c $(SRC)\gif_io.c MSW_GIF_OBJ=$(OUTDIR)\dgif_lib.obj $(OUTDIR)\gif_io.obj !endif !if $(HAVE_PNG) @@ -350,13 +357,13 @@ MSW_LIBS=$(MSW_LIBS) "$(COMPFACE_DIR)\libcompface.lib" !endif !if $(HAVE_TOOLBARS) MSW_DEFINES=$(MSW_DEFINES) -DHAVE_TOOLBARS -MSW_TOOLBAR_SRC=$(XEMACS)\src\toolbar.c $(XEMACS)\src\toolbar-msw.c +MSW_TOOLBAR_SRC=$(SRC)\toolbar.c $(SRC)\toolbar-msw.c MSW_TOOLBAR_OBJ=$(OUTDIR)\toolbar.obj $(OUTDIR)\toolbar-msw.obj MSW_LIBS=$(MSW_LIBS) comctl32.lib !endif !if $(HAVE_DIALOGS) MSW_DEFINES=$(MSW_DEFINES) -DHAVE_DIALOGS -MSW_DIALOG_SRC=$(XEMACS)\src\dialog.c $(XEMACS)\src\dialog-msw.c +MSW_DIALOG_SRC=$(SRC)\dialog.c $(SRC)\dialog-msw.c MSW_DIALOG_OBJ=$(OUTDIR)\dialog.obj $(OUTDIR)\dialog-msw.obj !endif !if $(HAVE_WIDGETS) @@ -408,7 +415,7 @@ PATH_DEFINES=-DPATH_PREFIX=\"$(PATH_PREFIX)\" # Generic variables -INCLUDES=$(X_INCLUDES) $(MSW_INCLUDES) -I$(XEMACS)\nt\inc -I$(XEMACS)\src -I$(XEMACS)\lwlib +INCLUDES=$(X_INCLUDES) $(MSW_INCLUDES) -I$(NT)\inc -I$(SRC) -I$(XEMACS)\lwlib DEFINES=$(X_DEFINES) $(MSW_DEFINES) $(MULE_DEFINES) \ $(TAGBITS_DEFINES) $(LRECORD_DEFINES) $(UNION_DEFINES) \ @@ -424,24 +431,23 @@ $(OUTDIR)\nul: -@mkdir $(OUTDIR) XEMACS_INCLUDES=\ - $(XEMACS)\src\config.h \ - $(XEMACS)\src\Emacs.ad.h \ - $(XEMACS)\src\paths.h + $(SRC)\config.h \ + $(SRC)\Emacs.ad.h \ + $(SRC)\paths.h -$(XEMACS)\src\config.h: config.h - copy config.h $(XEMACS)\src +$(SRC)\config.h: config.h + copy config.h $(SRC) -$(XEMACS)\src\Emacs.ad.h: Emacs.ad.h - copy Emacs.ad.h $(XEMACS)\src +$(SRC)\Emacs.ad.h: Emacs.ad.h + copy Emacs.ad.h $(SRC) -$(XEMACS)\src\paths.h: paths.h - copy paths.h $(XEMACS)\src +$(SRC)\paths.h: paths.h + copy paths.h $(SRC) #------------------------------------------------------------------------------ # lib-src programs -LIB_SRC = $(XEMACS)\lib-src LIB_SRC_DEFINES = -DHAVE_CONFIG_H -DWIN32 -DWINDOWSNT # @@ -471,7 +477,7 @@ CONFIG_VALUES = $(LIB_SRC)\config.values # Inferred rule {$(LIB_SRC)}.c{$(LIB_SRC)}.exe : cd $(LIB_SRC) - $(CCV) -I. -I$(XEMACS)/src -I$(XEMACS)/nt/inc $(LIB_SRC_DEFINES) $(CFLAGS) -Fe$@ $** -link -incremental:no + $(CCV) -I. -I$(XEMACS)/src -I$(XEMACS)/nt/inc $(LIB_SRC_DEFINES) $(CFLAGS) -Fe$@ $** -link -incremental:no setargv.obj cd $(NT) # Individual dependencies @@ -497,6 +503,11 @@ LIB_SRC_TOOLS = \ $(LIB_SRC_TOOLS) \ $(LIB_SRC)/minitar.exe !endif +!if $(USE_PORTABLE_DUMPER) +LIB_SRC_TOOLS = \ + $(XEMACS_INCLUDES) \ + $(LIB_SRC_TOOLS) +!endif # Shorthand target minitar: $(LIB_SRC)/minitar.exe @@ -505,7 +516,7 @@ minitar: $(LIB_SRC)/minitar.exe # runxemacs proglet -RUNEMACS = $(XEMACS)\src\runxemacs.exe +RUNEMACS = $(SRC)\runxemacs.exe $(RUNEMACS): $(LIB_SRC)\run.c $(LIB_SRC)\run.res $(CCV) -I$(LIB_SRC) $(CFLAGS) -Fe$@ -Fo$(LIB_SRC) -Fd$(LIB_SRC)\ $** kernel32.lib user32.lib -link -incremental:no @@ -520,7 +531,7 @@ $(LIB_SRC)\run.res: $(LIB_SRC)\run.rc !if !$(USE_SYSTEM_MALLOC) || !$(USE_PORTABLE_DUMPER) LASTFILE=$(OUTDIR)\lastfile.lib -LASTFILE_SRC=$(XEMACS)\src +LASTFILE_SRC=$(SRC) LASTFILE_FLAGS=$(CFLAGS) $(INCLUDES) -Fo$@ -Fd$* -c LASTFILE_OBJS= \ $(OUTDIR)\lastfile.obj @@ -583,135 +594,135 @@ $(OUTDIR)\xlwscrollbar.obj: $(LWLIB_SRC)\xlwscrollbar.c DOC=$(LIB_SRC)\DOC DOC_SRC1=\ - $(XEMACS)\src\abbrev.c \ - $(XEMACS)\src\alloc.c \ - $(XEMACS)\src\alloca.c \ - $(XEMACS)\src\blocktype.c \ - $(XEMACS)\src\buffer.c \ - $(XEMACS)\src\bytecode.c \ - $(XEMACS)\src\callint.c \ - $(XEMACS)\src\callproc.c \ - $(XEMACS)\src\casefiddle.c \ - $(XEMACS)\src\casetab.c \ - $(XEMACS)\src\chartab.c \ - $(XEMACS)\src\cmdloop.c \ - $(XEMACS)\src\cmds.c \ - $(XEMACS)\src\console-stream.c \ - $(XEMACS)\src\console.c \ - $(XEMACS)\src\data.c \ - $(XEMACS)\src\device.c + $(SRC)\abbrev.c \ + $(SRC)\alloc.c \ + $(SRC)\alloca.c \ + $(SRC)\blocktype.c \ + $(SRC)\buffer.c \ + $(SRC)\bytecode.c \ + $(SRC)\callint.c \ + $(SRC)\callproc.c \ + $(SRC)\casefiddle.c \ + $(SRC)\casetab.c \ + $(SRC)\chartab.c \ + $(SRC)\cmdloop.c \ + $(SRC)\cmds.c \ + $(SRC)\console-stream.c \ + $(SRC)\console.c \ + $(SRC)\data.c \ + $(SRC)\device.c DOC_SRC2=\ - $(XEMACS)\src\dired.c \ - $(XEMACS)\src\doc.c \ - $(XEMACS)\src\doprnt.c \ - $(XEMACS)\src\dragdrop.c \ - $(XEMACS)\src\dynarr.c \ - $(XEMACS)\src\editfns.c \ - $(XEMACS)\src\elhash.c \ - $(XEMACS)\src\emacs.c \ - $(XEMACS)\src\eval.c \ - $(XEMACS)\src\event-stream.c \ - $(XEMACS)\src\events.c \ - $(XEMACS)\src\extents.c \ - $(XEMACS)\src\faces.c \ - $(XEMACS)\src\file-coding.c \ - $(XEMACS)\src\fileio.c \ - $(XEMACS)\src\filemode.c \ - $(XEMACS)\src\floatfns.c \ - $(XEMACS)\src\fns.c + $(SRC)\dired.c \ + $(SRC)\doc.c \ + $(SRC)\doprnt.c \ + $(SRC)\dragdrop.c \ + $(SRC)\dynarr.c \ + $(SRC)\editfns.c \ + $(SRC)\elhash.c \ + $(SRC)\emacs.c \ + $(SRC)\eval.c \ + $(SRC)\event-stream.c \ + $(SRC)\events.c \ + $(SRC)\extents.c \ + $(SRC)\faces.c \ + $(SRC)\file-coding.c \ + $(SRC)\fileio.c \ + $(SRC)\filemode.c \ + $(SRC)\floatfns.c \ + $(SRC)\fns.c DOC_SRC3=\ - $(XEMACS)\src\font-lock.c \ - $(XEMACS)\src\frame.c \ - $(XEMACS)\src\general.c \ - $(XEMACS)\src\glyphs.c \ - $(XEMACS)\src\glyphs-eimage.c \ - $(XEMACS)\src\glyphs-widget.c \ - $(XEMACS)\src\gui.c \ - $(XEMACS)\src\gutter.c \ - $(XEMACS)\src\hash.c \ - $(XEMACS)\src\imgproc.c \ - $(XEMACS)\src\indent.c \ - $(XEMACS)\src\insdel.c \ - $(XEMACS)\src\intl.c \ - $(XEMACS)\src\keymap.c \ - $(XEMACS)\src\line-number.c \ - $(XEMACS)\src\lread.c \ - $(XEMACS)\src\lstream.c \ - $(XEMACS)\src\macros.c \ - $(XEMACS)\src\marker.c + $(SRC)\font-lock.c \ + $(SRC)\frame.c \ + $(SRC)\general.c \ + $(SRC)\glyphs.c \ + $(SRC)\glyphs-eimage.c \ + $(SRC)\glyphs-widget.c \ + $(SRC)\gui.c \ + $(SRC)\gutter.c \ + $(SRC)\hash.c \ + $(SRC)\imgproc.c \ + $(SRC)\indent.c \ + $(SRC)\insdel.c \ + $(SRC)\intl.c \ + $(SRC)\keymap.c \ + $(SRC)\line-number.c \ + $(SRC)\lread.c \ + $(SRC)\lstream.c \ + $(SRC)\macros.c \ + $(SRC)\marker.c DOC_SRC4=\ - $(XEMACS)\src\md5.c \ - $(XEMACS)\src\menubar.c \ - $(XEMACS)\src\minibuf.c \ - $(XEMACS)\src\nt.c \ - $(XEMACS)\src\ntplay.c \ - $(XEMACS)\src\ntproc.c \ - $(XEMACS)\src\objects.c \ - $(XEMACS)\src\opaque.c \ - $(XEMACS)\src\print.c \ - $(XEMACS)\src\process.c \ - $(XEMACS)\src\process-nt.c \ - $(XEMACS)\src\profile.c \ - $(XEMACS)\src\rangetab.c \ - $(XEMACS)\src\realpath.c \ - $(XEMACS)\src\redisplay-output.c \ - $(XEMACS)\src\redisplay.c \ - $(XEMACS)\src\regex.c \ - $(XEMACS)\src\scrollbar.c \ - $(XEMACS)\src\search.c \ - $(XEMACS)\src\select.c \ - $(XEMACS)\src\signal.c \ - $(XEMACS)\src\sound.c + $(SRC)\md5.c \ + $(SRC)\menubar.c \ + $(SRC)\minibuf.c \ + $(SRC)\nt.c \ + $(SRC)\ntplay.c \ + $(SRC)\ntproc.c \ + $(SRC)\objects.c \ + $(SRC)\opaque.c \ + $(SRC)\print.c \ + $(SRC)\process.c \ + $(SRC)\process-nt.c \ + $(SRC)\profile.c \ + $(SRC)\rangetab.c \ + $(SRC)\realpath.c \ + $(SRC)\redisplay-output.c \ + $(SRC)\redisplay.c \ + $(SRC)\regex.c \ + $(SRC)\scrollbar.c \ + $(SRC)\search.c \ + $(SRC)\select.c \ + $(SRC)\signal.c \ + $(SRC)\sound.c DOC_SRC5=\ - $(XEMACS)\src\specifier.c \ - $(XEMACS)\src\strftime.c \ - $(XEMACS)\src\symbols.c \ - $(XEMACS)\src\syntax.c \ - $(XEMACS)\src\sysdep.c \ - $(XEMACS)\src\termcap.c \ - $(XEMACS)\src\tparam.c \ - $(XEMACS)\src\undo.c \ - $(XEMACS)\src\window.c \ - $(XEMACS)\src\widget.c + $(SRC)\specifier.c \ + $(SRC)\strftime.c \ + $(SRC)\symbols.c \ + $(SRC)\syntax.c \ + $(SRC)\sysdep.c \ + $(SRC)\termcap.c \ + $(SRC)\tparam.c \ + $(SRC)\undo.c \ + $(SRC)\window.c \ + $(SRC)\widget.c !if $(HAVE_X) DOC_SRC6=\ - $(XEMACS)\src\balloon_help.c \ - $(XEMACS)\src\console-x.c \ - $(XEMACS)\src\device-x.c \ - $(XEMACS)\src\dialog-x.c \ - $(XEMACS)\src\EmacsFrame.c \ - $(XEMACS)\src\EmacsManager.c \ - $(XEMACS)\src\EmacsShell-sub.c\ - $(XEMACS)\src\EmacsShell.c \ - $(XEMACS)\src\event-Xt.c \ - $(XEMACS)\src\frame-x.c \ - $(XEMACS)\src\glyphs-x.c \ - $(XEMACS)\src\gui-x.c \ - $(XEMACS)\src\menubar.c \ - $(XEMACS)\src\menubar-x.c \ - $(XEMACS)\src\objects-x.c \ - $(XEMACS)\src\redisplay-x.c \ - $(XEMACS)\src\scrollbar-x.c \ - $(XEMACS)\src\balloon-x.c \ - $(XEMACS)\src\xgccache.c \ - $(XEMACS)\src\xmu.c \ - $(XEMACS)\src\select-x.c + $(SRC)\balloon_help.c \ + $(SRC)\console-x.c \ + $(SRC)\device-x.c \ + $(SRC)\dialog-x.c \ + $(SRC)\EmacsFrame.c \ + $(SRC)\EmacsManager.c \ + $(SRC)\EmacsShell-sub.c\ + $(SRC)\EmacsShell.c \ + $(SRC)\event-Xt.c \ + $(SRC)\frame-x.c \ + $(SRC)\glyphs-x.c \ + $(SRC)\gui-x.c \ + $(SRC)\menubar.c \ + $(SRC)\menubar-x.c \ + $(SRC)\objects-x.c \ + $(SRC)\redisplay-x.c \ + $(SRC)\scrollbar-x.c \ + $(SRC)\balloon-x.c \ + $(SRC)\xgccache.c \ + $(SRC)\xmu.c \ + $(SRC)\select-x.c !endif !if $(HAVE_MSW) DOC_SRC7=\ - $(XEMACS)\src\console-msw.c \ - $(XEMACS)\src\device-msw.c \ - $(XEMACS)\src\event-msw.c \ - $(XEMACS)\src\frame-msw.c \ - $(XEMACS)\src\glyphs-msw.c \ - $(XEMACS)\src\gui-msw.c \ - $(XEMACS)\src\menubar-msw.c \ - $(XEMACS)\src\objects-msw.c \ - $(XEMACS)\src\redisplay-msw.c \ - $(XEMACS)\src\scrollbar-msw.c \ - $(XEMACS)\src\select-msw.c \ + $(SRC)\console-msw.c \ + $(SRC)\device-msw.c \ + $(SRC)\event-msw.c \ + $(SRC)\frame-msw.c \ + $(SRC)\glyphs-msw.c \ + $(SRC)\gui-msw.c \ + $(SRC)\menubar-msw.c \ + $(SRC)\objects-msw.c \ + $(SRC)\redisplay-msw.c \ + $(SRC)\scrollbar-msw.c \ + $(SRC)\select-msw.c \ $(MSW_C_DIRED_SRC) \ $(MSW_TOOLBAR_SRC) \ $(MSW_DIALOG_SRC) \ @@ -720,31 +731,31 @@ DOC_SRC7=\ !if $(HAVE_MULE) DOC_SRC8=\ - $(XEMACS)\src\mule.c \ - $(XEMACS)\src\mule-charset.c \ - $(XEMACS)\src\mule-ccl.c + $(SRC)\mule.c \ + $(SRC)\mule-charset.c \ + $(SRC)\mule-ccl.c ! if $(HAVE_X) - DOC_SRC8=$(DOC_SRC8) $(XEMACS)\src\input-method-xlib.c + DOC_SRC8=$(DOC_SRC8) $(SRC)\input-method-xlib.c ! endif !endif !if $(DEBUG_XEMACS) DOC_SRC9=\ - $(XEMACS)\src\debug.c \ - $(XEMACS)\src\tests.c + $(SRC)\debug.c \ + $(SRC)\tests.c !endif !if !$(USE_SYSTEM_MALLOC) DOC_SRC10=\ - $(XEMACS)\src\free-hook.c \ - $(XEMACS)\src\gmalloc.c \ - $(XEMACS)\src\ntheap.c \ - $(XEMACS)\src\vm-limit.c + $(SRC)\free-hook.c \ + $(SRC)\gmalloc.c \ + $(SRC)\ntheap.c \ + $(SRC)\vm-limit.c !endif !if !$(USE_PORTABLE_DUMPER) DOC_SRC11=\ - $(XEMACS)\src\unexnt.c + $(SRC)\unexnt.c !endif #------------------------------------------------------------------------------ @@ -757,20 +768,22 @@ EMACS_BETA_VERSION=-DEMACS_BETA_VERSION=$(emacs_beta_version) !ENDIF !if !$(USE_PORTABLE_DUMPER) -TEMACS_ENTRYPOINT=-entry:_start +TEMACS_ENTRYPOINT=-entry:_start +!else +TEMACS_ENTRYPOINT=-entry:mainCRTStartup !endif -TEMACS_DIR=$(XEMACS)\src +TEMACS_DIR=$(SRC) TEMACS=$(TEMACS_DIR)\temacs.exe TEMACS_BROWSE=$(TEMACS_DIR)\temacs.bsc -TEMACS_SRC=$(XEMACS)\src +TEMACS_SRC=$(SRC) TEMACS_LIBS=$(LASTFILE) $(LWLIB) $(X_LIBS) $(MSW_LIBS) \ oldnames.lib kernel32.lib user32.lib gdi32.lib advapi32.lib \ - shell32.lib wsock32.lib winmm.lib winspool.lib $(LIBC_LIB) + shell32.lib wsock32.lib winmm.lib winspool.lib ole32.lib uuid.lib $(LIBC_LIB) TEMACS_LFLAGS=-nologo $(LIBRARIES) $(DEBUG_FLAGS) -base:0x1000000\ - -stack:0x800000 $(TEMACS_ENTRYPOINT) -subsystem:console\ + -stack:0x800000 $(TEMACS_ENTRYPOINT) -subsystem:windows\ -pdb:$(TEMACS_DIR)\temacs.pdb -map:$(TEMACS_DIR)\temacs.map \ - -heap:0x00100000 -out:$@ -nodefaultlib + -heap:0x00100000 -nodefaultlib -incremental:no TEMACS_CPP_FLAGS=-c \ $(CFLAGS) $(INCLUDES) $(DEFINES) $(DEBUG_DEFINES) \ -DEMACS_MAJOR_VERSION=$(emacs_major_version) \ @@ -946,8 +959,7 @@ TEMACS_OBJS= \ $(OUTDIR)\tparam.obj \ $(OUTDIR)\undo.obj \ $(OUTDIR)\widget.obj \ - $(OUTDIR)\window.obj \ - $(OUTDIR)\xemacs.res + $(OUTDIR)\window.obj # Rules @@ -977,7 +989,7 @@ $(OUTDIR)\alloc.obj: $(TEMACS_SRC)\alloc.c #$(TEMACS_SRC)\paths.h: $(TEMACS_SRC)\paths.h.in # !"cd $(TEMACS_SRC); cp paths.h.in paths.h" -$(TEMACS): $(TEMACS_INCLUDES) $(TEMACS_OBJS) +$(TEMACS): $(TEMACS_INCLUDES) $(TEMACS_OBJS) $(OUTDIR)\xemacs.res !if $(DEBUG_XEMACS) @dir /b/s $(OUTDIR)\*.sbr > bscmake.tmp bscmake -nologo -o$(TEMACS_BROWSE) @bscmake.tmp @@ -985,20 +997,23 @@ $(TEMACS): $(TEMACS_INCLUDES) $(TEMACS_OBJS) !endif !if $(USE_PORTABLE_DUMPER) @if exist $(TEMACS_DIR)\xemacs.dmp del $(TEMACS_DIR)\xemacs.dmp -!endif link.exe @<< - $(TEMACS_LFLAGS) $(TEMACS_OBJS) $(TEMACS_LIBS) + $(TEMACS_LFLAGS) -out:$@ $(TEMACS_OBJS) $(TEMACS_LIBS) +<< +!else + link.exe @<< + $(TEMACS_LFLAGS) -out:$@ $(TEMACS_OBJS) $(OUTDIR)\xemacs.res $(TEMACS_LIBS) << +!endif $(OUTDIR)\xemacs.res: xemacs.rc rc -Fo$@ xemacs.rc # Section handling automated tests starts here -SRCDIR=$(MAKEDIR)\..\src -PROGNAME=$(SRCDIR)\xemacs.exe +PROGNAME=$(SRC)\xemacs.exe blddir=$(MAKEDIR:\=\\)\\.. -temacs_loadup=$(TEMACS) -batch -l $(SRCDIR)/../lisp/loadup.el +temacs_loadup=$(TEMACS) -batch -l $(LISP)/loadup.el dump_temacs = $(temacs_loadup) dump run_temacs = $(temacs_loadup) run-temacs ## We have automated tests!! @@ -1008,17 +1023,36 @@ batch_test_emacs=-batch -l $(testdir)/test-harness.el -f batch-test-emacs $(test # .PHONY: check check-temacs check: - cd $(SRCDIR) + cd $(SRC) $(PROGNAME) $(batch_test_emacs) check-temacs: - cd $(SRCDIR) + cd $(SRC) set EMACSBOOTSTRAPLOADPATH=$(LISP) set EMACSBOOTSTRAPMODULEPATH=$(MODULES) $(run_temacs) $(batch_test_emacs) # Section handling automated tests ends here +# Section handling tags starts here + +tagslisp=lisp + +tags: + @echo If you don't have a copy of etags around, then do 'make lib-src' first. + @echo To make use of the tags file, put the following in your .emacs: + @echo (setq tag-table-alist + @echo '(("$(XEMACSDIRSTRING)\\" . "$(XEMACSDIRSTRING)\\"))) + cd $(XEMACS) + $(DEL) TAGS + set PATH=lib-src;%PATH% +# argh!!! we need two ^^'s to get one ^, but only before a backslash. +# i have no idea why. probably some obscure nmake quoting convention. + etags -a -r "/[ ]*DEF\(VAR\|INE\)_[A-Z_]+[ ]*([ ]*\"\([^^\"]+\)\"/\2/" src\*.c src\*.h lwlib\*.c lwlib\*.h lib-src\*.c lib-src\*.h + etags -a -l none -r "/^(def\(var\|un\|alias\|const\|macro\|subst\|struct\|face\|group\|custom\|ine-\(function\|compiler-macro\|[a-z-]+alias\)\)[ ]+'?\([^ ]+\)/\3/" $(tagslisp)\*.el + +# Section handling tags ends here + # Section handling info starts here !if !defined(MAKEINFO) @@ -1258,14 +1292,21 @@ dump-xemacs: temacs set EMACSBOOTSTRAPMODULEPATH=$(MODULES) -1 $(TEMACS) -batch -l $(TEMACS_DIR)\..\lisp\loadup.el dump !if $(USE_PORTABLE_DUMPER) - copy temacs.exe xemacs.exe + rc -d INCLUDE_DUMP -Fo $(OUTDIR)\xemacs.res $(NT)\xemacs.rc + link.exe @<< + $(TEMACS_LFLAGS) -out:xemacs.exe $(TEMACS_OBJS) $(OUTDIR)\xemacs.res $(TEMACS_LIBS) +<< +# Make the resource section read/write since almost all of it is the dump +# data which needs to be writable. This avoids having to copy it. + editbin -nologo -section:.rsrc,rw xemacs.exe + del $(TEMACS_DIR)\xemacs.dmp !endif cd $(NT) @if not exist $(TEMACS_DIR)\SATISFIED nmake -nologo -f xemacs.mak $@ #------------------------------------------------------------------------------ # use this rule to build the complete system -all: $(XEMACS)\Installation $(OUTDIR)\nul $(LASTFILE) $(LWLIB) \ +all: installation $(OUTDIR)\nul $(LASTFILE) $(LWLIB) \ $(LIB_SRC_TOOLS) $(RUNEMACS) $(TEMACS) update-elc $(DOC) dump-xemacs \ $(LISP)/auto-autoloads.el $(LISP)/custom-load.el info @@ -1282,10 +1323,7 @@ install: all @xcopy /q $(LIB_SRC)\*.exe "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)\" @copy $(LIB_SRC)\DOC "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)" @copy $(CONFIG_VALUES) "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)" - @copy $(XEMACS)\src\xemacs.exe "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)" -!if $(USE_PORTABLE_DUMPER) - @copy $(XEMACS)\src\xemacs.dmp "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)" -!endif + @copy $(SRC)\xemacs.exe "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)" @copy $(RUNEMACS) "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)" @xcopy /e /q $(XEMACS)\etc "$(INSTALL_DIR)\etc\" @xcopy /e /q $(XEMACS)\info "$(INSTALL_DIR)\info\" @@ -1342,12 +1380,9 @@ depend: perl ./make-src-depend > depend.tmp perl -MFile::Compare -e "compare('depend.tmp', 'depend') && rename('depend.tmp', 'depend') or unlink('depend.tmp')" -installation:: - @if exist $(XEMACS)\Installation del $(XEMACS)\Installation - -installation:: $(XEMACS)\Installation +$(XEMACS)\Installation:: installation -$(XEMACS)\Installation: +installation:: @type > $(XEMACS)\Installation << !if defined(OS) OS: $(OS) diff --git a/nt/xemacs.rc b/nt/xemacs.rc index 3c0f003..3b5cb7e 100644 --- a/nt/xemacs.rc +++ b/nt/xemacs.rc @@ -1,3 +1,7 @@ +#ifdef INCLUDE_DUMP +101 DUMP "xemacs.dmp" +#endif + XEmacs icon preload "xemacs.ico" XEmacsFile icon "File.ico" XEmacsLisp icon "Lisp.ico" diff --git a/src/ChangeLog.1 b/src/ChangeLog.1 index fa31bc6..89cd18b 100644 --- a/src/ChangeLog.1 +++ b/src/ChangeLog.1 @@ -50,7 +50,7 @@ * This change adds four scrollbar specifiers: {horizontal,vertical}-scrollbar-visible-p and scrollbar-on-{top,left}-p. - Spare parts supplied by Didier Verna + Spare parts supplied by Didier Verna * frameslots.h: Added slots for the four specifier caching. @@ -80,7 +80,7 @@ (specifier_vars_of_scrollbar): Declared the four specifiers. * window.h (struct window): Defined slots for caching the new - specifiers. + specifiers. * window.c (mark_window): Mark them. (allocate_window): Initialize them. @@ -123,7 +123,7 @@ 1998-05-10 Kirill M. Katsnelson - * EmacsFrame.c (update_various_frame_slots): Do not store internal + * EmacsFrame.c (update_various_frame_slots): Do not store internal border width there. (EmacsFrameInitialize): Do it rather here. (EmacsFrameSetValues): If EditRes has changed internal border @@ -135,11 +135,11 @@ variables and access macros Added size_slipped redisplay bit and mark/clear macros. - * redisplay.c (redisplay_frame): Adjust frame size if size slipped + * redisplay.c (redisplay_frame): Adjust frame size if size slipped bit is set. (redisplay_device): Call redisplay_frame if size slipped bit is set. - - * frame.c (adjust_frame_size): Redisplay beats frame back in shape + + * frame.c (adjust_frame_size): Redisplay beats frame back in shape with this. Added. (frame_size_slipped): Added. (internal_set_frame_size): Clear size slipped bit. @@ -183,7 +183,7 @@ (EmacsFrameSetValues): Simulate a call to resize callback when no actual geometry change happened. - * console.h (struct console_methods): Removed declarations for all + * console.h (struct console_methods): Removed declarations for all _changed_in_frame methods for toolbars and scrollbars. Added frame_size_fixed_p method. @@ -267,7 +267,7 @@ the system. * ntproc.c: Removed select emulation crap and dynamic Windock - loading. + loading. * nt.c: Removed a lot of terrible wrappers for socket functions. @@ -395,9 +395,9 @@ 1998-05-04 Martin Buchholz - * rangetab.c: + * rangetab.c: * rangetab.h: Move #include's from rangetab.h into rangetab.c for - consistency. + consistency. * inline.c: include rangetab.h to get GCC inlines 1998-05-03 SL Baur @@ -466,17 +466,17 @@ * specifier.h: Corrected documentation on magic specifiers. Documented DEPTH parameter to instantiate_method. - Renamed reveal->unlock_ghost_specifiers_protected(). + Renamed reveal->unlock_ghost_specifiers_protected(). * specifier.c: Removed the reveal mechanism and made ghost specifiers read-only, so they are accessible as fallbacks of magic specifier, but aren't modifiable unless C code enables so. (specifier_equal): Compare specifier fallbacks as well. - * scrollbar.c (init_frame_scrollbars): - (init_device_scrollbars): + * scrollbar.c (init_frame_scrollbars): + (init_device_scrollbars): (init_global_scrollbars): Renamed - reveal->unlock_ghost_specifiers_protected(). + reveal->unlock_ghost_specifiers_protected(). 1998-05-01 Hrvoje Niksic @@ -613,7 +613,7 @@ Compute new character sizes passed to change_frame_size, do not use the old (pre-toolbar-change) ones. (update_frame_toolbars): Honor frame_changed and clear frame bits. - (recompute_overlaying_specifier): New helper function, called from + (recompute_overlaying_specifier): New helper function, called from default toolbar specifier change handlers. (default_toolbar_specs_changed): Use it. (default_toolbar_size_changed_in_frame): Ditto. @@ -622,7 +622,7 @@ (toolbar_geometry_changed_in_window): New handler. The old one, some_windows_value_changed, did not do the trick. (default_toolbar_size_changed_in_window): New handler for default - toolbar. + toolbar. (default_toolbar_border_width_changed_in_window): Ditto. (default_toolbar_visible_p_changed_in_window): Ditto. (specifier_vars_of_toolbar): Use one of the above four handlers @@ -765,8 +765,8 @@ Sun Apr 23 1998 Andy Piper 1998-04-24 Martin Buchholz - * mule-charset.h: - * mule-charset.c: + * mule-charset.h: + * mule-charset.c: Use ints instead of bitfields for Lisp_Charset fields. This should work around bugs in the latest egcs snapshot, and make XEmacs faster. Introduce dimension and chars as fields in @@ -812,7 +812,7 @@ Sat Apr 24 1998 Andy Piper * data.c (Fnot): There has traditionally been kludgy startup lisp code that called `null' even if `not' was more appropriate, because `not' was defined in lisp. This is one primitive - sufficiently important that it should ALWAYS be defined. + sufficiently important that it should ALWAYS be defined. Sat Apr 24 1998 Andy Piper @@ -874,10 +874,10 @@ Thu Apr 23 19:38:19 1998 Andy Piper 1998-04-23 Hrvoje Niksic - * fns.c (Fload_average): Respect errno when reporting getloadavg() + * fns.c (Fload_average): Respect errno when reporting getloadavg() errors. - * getloadavg.c (getloadavg): Cleaner Solaris implementation, based + * getloadavg.c (getloadavg): Cleaner Solaris implementation, based on sample code by Casper Dik. 1998-04-23 SL Baur @@ -903,7 +903,7 @@ Thu Apr 23 19:38:19 1998 Andy Piper * toolbar-msw.c (mswindows_clear_toolbar): Fixed wabbit buttons. (mswindows_output_toolbar): Gave 3D look to toolbars. Still no pretty, needs more work. - (mswindows_move_toolbar): Renamed so because it does not deal with + (mswindows_move_toolbar): Renamed so because it does not deal with redrawing exposed toolbars. Properly position toolbars. (mswindows_redraw_exposed_toolbars): Changed calls to the above. @@ -1026,7 +1026,7 @@ Wed Apr 22 12:59:35 1998 Andy Piper * eldap.c: (print_ldap): Ignore escapeflag (Fldap_search_internal): Added unwind protection to appropriately - free the LDAP temporary structures in case of interruption. Added + free the LDAP temporary structures in case of interruption. Added a QUIT to the result fetching loop. 1998-04-19 SL Baur @@ -1193,7 +1193,7 @@ Fri Apr 17 12:59:35 1998 Andy Piper * indent.c (vertical_motion_1): new helper function to share common code between Fvertical_motion and Fvertical_motion_pixels. - Properly handle the WINDOW argument as the doc string indicates it + Properly handle the WINDOW argument as the doc string indicates it should. Update docstrings to be more clear and concise. (Fvertical_motion): use vertical_motion_1. (Fvertical_motion_pixels): use vertical_motion_1. @@ -1206,7 +1206,7 @@ Fri Apr 17 12:59:35 1998 Andy Piper * specifier.c: Reworked many functions to support magic specifiers. - * scrollbar.c (specifier_vars_of_scrollbar): Made magic specifiers + * scrollbar.c (specifier_vars_of_scrollbar): Made magic specifiers Vscrollbar_width and Vscrollbar_height. (init_frame_scrollbars): Enabled critical lisp code operate on ghost specifiers. @@ -1215,7 +1215,7 @@ Fri Apr 17 12:59:35 1998 Andy Piper * scrollbar-msw.c (Fmswindows_init_scrollbar_metrics): Scrollbar init function, called from init-scrollbars-from-resuorce in - lisp/scrollbar.c + lisp/scrollbar.c (syms_of_scrollbar_mswindows): DEFSUBR it. * emacs.c (main_1): Called syms_of_scrollbar_mswindows() @@ -1252,7 +1252,7 @@ Thu Apr 16 12:59:35 1998 Andy Piper * data.c (pure_write_error): Accept an argument. - * emacs.c (vars_of_emacs): New variable `internal-error-checking'; + * emacs.c (vars_of_emacs): New variable `internal-error-checking'; initialize it. 1998-04-16 Hrvoje Niksic @@ -1301,7 +1301,7 @@ Thu Apr 16 12:59:35 1998 Andy Piper * device-x.c (have_xemacs_resources_in_xrdb): adhere to coding standards and avoid opening display twice by breaking - XtOpenDisplay into XOpenDisplay and XtDisplayInitialize. + XtOpenDisplay into XOpenDisplay and XtDisplayInitialize. (x_init_device): Ditto. 1998-04-15 Olivier Galibert @@ -1359,7 +1359,7 @@ Thu Apr 16 12:59:35 1998 Andy Piper 1998-04-13 Greg Klanderman - * redisplay.c (redisplay_window): When echo area is active, and we + * redisplay.c (redisplay_window): When echo area is active, and we swap in the echo area buffer, restore the minibuffer's pointm and startp when we restore the minibuffer to the window. This avoids having the minibuffer point randomly change when it is active but @@ -1391,9 +1391,9 @@ Thu Apr 16 12:59:35 1998 Andy Piper (emacs_mswindows_select_process): Get Win32 process handle directly from process lrecord. (get_process_handle): Removed function. - (emacs_mswindows_handle_magic_event): Removed handling of + (emacs_mswindows_handle_magic_event): Removed handling of XM_BUMPQUEUE magic event. - (mswindows_wnd_proc): Removed handling of WM_EXITMENULOOP message, + (mswindows_wnd_proc): Removed handling of WM_EXITMENULOOP message, which called a do-nothing handler in menubar-msw.c (mswindows_wnd_proc, WM_EXITSIZEMOVE): Queue an empty event instead of magic event, via mswindows_bump_queue(). @@ -1410,18 +1410,18 @@ Thu Apr 16 12:59:35 1998 Andy Piper * event-stream.c (event_stream_deal_with_async_timeout): Conditionalized timer-based polling for finished processes on - HAVE_UNIX_PROCESSES. + HAVE_UNIX_PROCESSES. * menubar-msw.c (mswindows_handle_wm_command): Queued proper bump queue event. (mswindows_handle_wm_exitmenuloop): Removed function. - + * menubar-msw.h: Removed unused function prototype. * process-nt.c (get_nt_process_handle): Added function. * signal.c (init_poll_for_sigchld): Conditionalized on - HAVE_UNIX_PROCESSES. + HAVE_UNIX_PROCESSES. 1998-04-13 Kirill M. Katsnelson @@ -1455,40 +1455,40 @@ Thu Apr 16 12:59:35 1998 Andy Piper * callproc.c (init_callproc): Correctly initialize `shell-file-name' for WINDOWSNT - + * emacs.c (main_1): Properly called new functions (see symsinit.h entry for which). - * event-msw.c (struct ntpipe_slurp_stream): - (slurp_thread): - (make_ntpipe_input_stream): - (get_ntpipe_input_stream_waitable): - (get_ntpipe_input_stream_param): - (ntpipe_slurp_reader): - (ntpipe_slurp_closer): + * event-msw.c (struct ntpipe_slurp_stream): + (slurp_thread): + (make_ntpipe_input_stream): + (get_ntpipe_input_stream_waitable): + (get_ntpipe_input_stream_param): + (ntpipe_slurp_reader): + (ntpipe_slurp_closer): (init_slurp_stream): Win32 pipe input stream implementation. - (struct ntpipe_shove_stream): - (shove_thread): - (make_ntpipe_output_stream): - (get_ntpipe_output_stream_param): - (ntpipe_shove_writer): - (ntpipe_shove_was_blocked_p): - (ntpipe_shove_flusher): - (ntpipe_shove_closer): + (struct ntpipe_shove_stream): + (shove_thread): + (make_ntpipe_output_stream): + (get_ntpipe_output_stream_param): + (ntpipe_shove_writer): + (ntpipe_shove_was_blocked_p): + (ntpipe_shove_flusher): + (ntpipe_shove_closer): (init_shove_stream): Win32 pipe output stream implementation. (mswindows_enqueue_process_event): Dispatch helper. - (find_waitable_handle): - (add_waitable_handle): + (find_waitable_handle): + (add_waitable_handle): (remove_waitable_handle): New three, waitable handles handling. (mswindows_need_event_in_modal_loop): Simplified. (mswindows_need_event): Simplified. - (mswindows_need_event): Generate process events on process output; + (mswindows_need_event): Generate process events on process output; kick status_notify when a process ends. (mswindows_find_console): Simplified. (emacs_mswindows_event_pending_p): Adjusted parameters to mswindows_need_event(). (emacs_mswindows_next_event): Ditto. - (get_process_input_waitable): + (get_process_input_waitable): (get_process_handle): Process select/unselect helpers. (emacs_mswindows_select_process): Implemented. (emacs_mswindows_unselect_process): Implemented. @@ -1521,7 +1521,7 @@ Thu Apr 16 12:59:35 1998 Andy Piper 1998-04-10 Martin Buchholz - * fns.c (Fnthcdr): + * fns.c (Fnthcdr): Most times through the loop will get a cons, so optimize for that. * bytecode.c (Fbyte_code): Remove '91 vintage compiler bug workaround. @@ -1572,8 +1572,8 @@ Thu Apr 16 12:59:35 1998 Andy Piper * event-msw.c (mswindows_wnd_proc): Fix member access macro names. - * frame-msw.c (mswindows_frame_property): - (mswindows_internal_frame_property_p): + * frame-msw.c (mswindows_frame_property): + (mswindows_internal_frame_property_p): (mswindows_frame_properties): Implemented for the 'left and 'top properties. (console_type_create_frame_mswindows): Regsitered the above. @@ -1650,10 +1650,10 @@ Thu Apr 16 12:59:35 1998 Andy Piper * insdel.c (make_gap): Thou shan't cast EMACS_INT_MAX to int. (buffer_insert_string_1): ditto. - * regex.c (print_partial_compiled_pattern): Neither EMACS_INTs nor + * regex.c (print_partial_compiled_pattern): Neither EMACS_INTs nor ptrdiff_t are portably printable as an int. - * redisplay.c (window_line_number): Don't assume that an EMACS_INT + * redisplay.c (window_line_number): Don't assume that an EMACS_INT in an int. * alloc.c (report_pure_usage): Don't assume that a size_t is @@ -1717,24 +1717,24 @@ Thu Apr 16 12:59:35 1998 Andy Piper (sys_chmod): (sys_creat): - * sysdep.c (sys_read_1): - (sys_read): - (sys_write_1): - (sys_write): - (sys_mkdir): - (sys_readlink): - (sys_chmod): - (sys_creat): - - * nt.c (sys_read): - (sys_chmod): - (sys_creat): + * sysdep.c (sys_read_1): + (sys_read): + (sys_write_1): + (sys_write): + (sys_mkdir): + (sys_readlink): + (sys_chmod): + (sys_creat): + + * nt.c (sys_read): + (sys_chmod): + (sys_creat): (sys_write): Change types of sys_* in accordance with published standards. Use size_t and mode_t instead of unsigned int and int. 1998-04-03 Martin Buchholz - * config.h.in (enum_field): + * config.h.in (enum_field): * lisp-union.h: * extents.h: * redisplay.c (add_margin_runes): @@ -1798,7 +1798,7 @@ Thu Apr 16 12:59:35 1998 Andy Piper * window.c (set_window_pixsize): Move up call to check_min_window_sizes. - * indent.c (vmotion_1): renamed from vmotion() and added + * indent.c (vmotion_1): renamed from vmotion() and added additional argument to optionally return the pixel motion. (vpix_motion): Helper for vmotion_1. (vmotion): Wrapper - just call vmotion_1() with the right args. @@ -1807,36 +1807,36 @@ Thu Apr 16 12:59:35 1998 Andy Piper 1998-04-02 Martin Buchholz - * xselect.c: - * event-Xt.c: - * emacs.c: + * xselect.c: + * event-Xt.c: + * emacs.c: Remove last vestiges of #ifdef EPOCH code. It had no chance of - working anyways. In honour of seeing Marc Andreesen in person for + working anyways. In honour of seeing Marc Andreesen in person for the first time today. 1998-04-01 Martin Buchholz - * extents.h: - * lisp-union.h: + * extents.h: + * lisp-union.h: Don't use enums as bitfields - only unsigned ints. Fixes: warning: nonportable bit-field type * eval.c (call_with_suspended_errors): More volatilizing to appease Sunpro cc. - * mem-limits.h: + * mem-limits.h: * ralloc.c: Remove #undef NULL; they're not even used! - * process-unix.c (unix_send_process): send_process is a method, so + * process-unix.c (unix_send_process): send_process is a method, so we can't include volatile in the prototype. We make the argument - non-volatile, make a volatile copy, and then use that instead. + non-volatile, make a volatile copy, and then use that instead. - * frame-x.c (x_delete_frame): The `frame' variable is initialized + * frame-x.c (x_delete_frame): The `frame' variable is initialized but not actually used. * Makefile.in.in (xselect.o): The last line of b34-pre2's src/Makefile.in.in contains a dependency that should have been - patched away. + patched away. (mostlyclean): Remove the removal of depend.* - no such files exist anymore @@ -1908,7 +1908,7 @@ Sun Mar 29 1998 Andy Piper 1998-03-30 Martin Buchholz - * redisplay.c (create_right_glyph_block): glyph_type should really + * redisplay.c (create_right_glyph_block): glyph_type should really be glyph_layout. 1998-03-29 Martin Buchholz @@ -1918,7 +1918,7 @@ Sun Mar 29 1998 Andy Piper #include sysfile.h. Check all .o files for missing #includes. * config.h.in: - Discovered that config.h.in was missing ENCAPSULATE_CLOSEDIR, as a + Discovered that config.h.in was missing ENCAPSULATE_CLOSEDIR, as a result of fixing the above. * gui.c (gui_item_add_keyval_pair): We should not use the idiom @@ -1927,7 +1927,7 @@ Sun Mar 29 1998 Andy Piper (signal_too_long_error): Ditto. * glyphs.c (image_instantiate_cache_result): Use XC[AD]R instead - of Fc[ad]r. This is always called with valid conses, and in fact, + of Fc[ad]r. This is always called with valid conses, and in fact, already assumed it. * font-lock.c (find_context): Use context_none with context @@ -1940,7 +1940,7 @@ Sun Mar 29 1998 Andy Piper 1998-03-28 Martin Buchholz - * fns.c (string_putprop): + * fns.c (string_putprop): (string_getprop): Make method functions static. * window.c (find_window_by_pixel_pos): Warning suppression. @@ -1949,7 +1949,7 @@ Sun Mar 29 1998 Andy Piper * redisplay-x.c (x_output_eol_cursor): Remove redundant XSETWINDOW. - * glyphs-x.c (signal_image_error): + * glyphs-x.c (signal_image_error): (signal_image_error_2): (convert_EImage_to_XImage): Make functions static. @@ -1966,7 +1966,7 @@ Sun Mar 29 1998 Andy Piper 1998-03-27 Martin Buchholz - * console-tty.c (free_tty_console_struct): + * console-tty.c (free_tty_console_struct): Replace con->console_data with CONSOLE_type_DATA (con) * *.[ch]: C++ compilability of xemacs, on Linux and Solaris. @@ -1976,7 +1976,7 @@ Sun Mar 29 1998 Andy Piper * eval.c: * bytecode.c: Rename Fcondition_case_3 to condition_case_3 - it's not a DEFUN. - + * buffer.h: Remove all *BUFFER_OR_STRING* macros - unused. (memind_to_bytind): Merge two versions of function by moving @@ -1998,27 +1998,27 @@ Sun Mar 29 1998 Andy Piper * marker.c (print_marker): Fix compiler warning, real bug! - * device.h (MARK_DEVICE_FRAMES_FACES_CHANGED): - * frame.h (MARK_FRAME_FACES_CHANGED): - (MARK_FRAME_TOOLBARS_CHANGED): - (MARK_FRAME_SIZE_CHANGED): - (MARK_FRAME_CHANGED): - (MARK_FRAME_WINDOWS_CHANGED): - (MARK_FRAME_WINDOWS_STRUCTURE_CHANGED): + * device.h (MARK_DEVICE_FRAMES_FACES_CHANGED): + * frame.h (MARK_FRAME_FACES_CHANGED): + (MARK_FRAME_TOOLBARS_CHANGED): + (MARK_FRAME_SIZE_CHANGED): + (MARK_FRAME_CHANGED): + (MARK_FRAME_WINDOWS_CHANGED): + (MARK_FRAME_WINDOWS_STRUCTURE_CHANGED): Fix multiple evaluation of macro arguments. Macros are a fact of life. Callers have to use temp variables to avoid multiple evaluation of arguments. * data.c (Ftrue_list_p): New function, with obvious meaning. - This is terminology from Cltl2. + This is terminology from Cltl2. Also define a corresponding macro TRUE_LIST_P. * device-x.c (validify_resource_component): Optimize. Rename. Use the standard technique of using a precomputed table of valid chars. - - (x_get_resource_prefix): - (Fx_get_resource): - (Fx_get_resource_prefix): + + (x_get_resource_prefix): + (Fx_get_resource): + (Fx_get_resource_prefix): Avoid fixed buffer sizes. Use a char_dynarr. Run validify_resource_component on all computed components. @@ -2033,50 +2033,50 @@ Sun Mar 29 1998 Andy Piper Use acons in functions which create alists. * lisp/cl.el (acons): Add docstring. Really otta be a macro, tho. - * buffer.c (Fbuffer_memory_usage): + * buffer.c (Fbuffer_memory_usage): * window.c (Fwindow_memory_usage): Clean up horrible consing code using new acons function. Fix incorrect value reported for gap-overhead. - + * fns.c (Fmember): - (Fold_member): - (Fmemq): - (Fold_memq): - (memq_no_quit): - (Fassoc): - (Fold_assoc): - (Fassq): - (Fold_assq): - (assq_no_quit): - (Frassoc): - (Fold_rassoc): - (Frassq): - (Fold_rassq): - (rassq_no_quit): - (Fdelete): - (Fold_delete): - (Fdelq): - (Fold_delq): - (delq_no_quit): - (delq_no_quit_and_free_cons): - (Fremassoc): - (Fremassq): - (remassq_no_quit): - (Fremrassoc): - (Fremrassq): - (remrassq_no_quit): - (Fnreverse): - (Freverse): - (Fnthcdr): - Optimize. - Replace calls to Fcar, Fcdr, Fsetcar with XCAR and XCDR. + (Fold_member): + (Fmemq): + (Fold_memq): + (memq_no_quit): + (Fassoc): + (Fold_assoc): + (Fassq): + (Fold_assq): + (assq_no_quit): + (Frassoc): + (Fold_rassoc): + (Frassq): + (Fold_rassq): + (rassq_no_quit): + (Fdelete): + (Fold_delete): + (Fdelq): + (Fold_delq): + (delq_no_quit): + (delq_no_quit_and_free_cons): + (Fremassoc): + (Fremassq): + (remassq_no_quit): + (Fremrassoc): + (Fremrassq): + (remrassq_no_quit): + (Fnreverse): + (Freverse): + (Fnthcdr): + Optimize. + Replace calls to Fcar, Fcdr, Fsetcar with XCAR and XCDR. Simplify logic. Many of these functions wouldn't QUIT if called on cyclic lists. e.g. try (progn (setq x '(nil)) (setcdr x x) (reverse x)) One benchmark of delq showed it to be 3 times faster. * emacs.c: - * database.c: + * database.c: Cleanup of database functions. Make the get_subtype and get_type methods return Lisp_Objects, instead of C strings. No more need for both dbm_type and dbm_lisp_type. @@ -2084,7 +2084,7 @@ Sun Mar 29 1998 Andy Piper Replace old `dbm' names with `database'. Rename struct database to struct Lisp_Database. Rename DEFUN arguments to `database', when applicable. - + * buffer.c: * chartab.c: * console.c: @@ -2112,7 +2112,7 @@ Sun Mar 29 1998 Andy Piper * window.c: Place DEFINE_LRECORD_* after definition of static object methods, to avoid redundant declarations. - + * console.c: * console.h: * device.c: @@ -2142,7 +2142,7 @@ Sun Mar 29 1998 Andy Piper 1998-03-21 Martin Buchholz * alloc.c (list*): Optimize recursion levels. - + * alloc.c: Add debugger support via enum dbg_constants. * gdbinit: Complete rewrite. * gdbinit.union: Remove @@ -2153,7 +2153,7 @@ Sun Mar 29 1998 Andy Piper Support all combinations of Kylish DEFINEs. Work out of the box with no user customizations. See the updated faq for details. - + * emacsfns.h: Remove. Move declarations to lisp.h * dynarr.h: Remove. Move declarations to lisp.h * lisp.h. @@ -2161,8 +2161,8 @@ Sun Mar 29 1998 Andy Piper Introduce EXFUN macro for external declaration to correspond to DEFUN. Include header files only when necessary, i.e. not from lisp.h: - unistd.h, limits.h, fnctl.h, blocktype.h, dynarr.h, emacsfns.h - - + + * lisp.h: * lisp-union.h: * lisp-disunion.h: @@ -2217,7 +2217,7 @@ Sun Mar 29 1998 Andy Piper * depend: New file. Generated by make-src-depend * make-src-depend: New file. generates up-to-date dependencies. Makefile dependencies are now automagically maintained, and - CORRECT. lisp.h and friends are now included in the dependencies, + CORRECT. lisp.h and friends are now included in the dependencies, since this complies with the principle of least astonishment. * symbols.c (symbol_is_constant): Optimize. @@ -2230,7 +2230,7 @@ Sun Mar 29 1998 Andy Piper 1998-03-29 SL Baur * emacs.c (voodoo_free_hook): ELF libraries built with newer - versions of GCC do horrible things in dumped binaries after exit() + versions of GCC do horrible things in dumped binaries after exit() is called. (Fkill_emacs): Use it. @@ -2288,8 +2288,8 @@ Sat Mar 28 10:16:29 1998 Andy Piper glyph_changed_set variables, mimicking clip_changed and clip_changed_set. - (redisplay_window): Reset the window's glyph cache is - f->glyphs_changed is non-zero. Call regenerate_window + (redisplay_window): Reset the window's glyph cache is + f->glyphs_changed is non-zero. Call regenerate_window if f->glyphs_changed is non-zero. (redisplay_frame): Clear f->glyphs_changed after @@ -2311,12 +2311,12 @@ Sat Mar 28 10:16:29 1998 Andy Piper related, mark all frames. * redisplay-output.c (compare_display_blocks): - Output the whole display block if f->glyphs_changed is + Output the whole display block if f->glyphs_changed is non-nil. 1998-03-27 Kyle Jones - * callproc.c (Fcall_process_internal): In the case where + * callproc.c (Fcall_process_internal): In the case where fd_error and fd1 are the same don't close that descriptor twice. @@ -2352,7 +2352,7 @@ Sat Mar 28 10:16:29 1998 Andy Piper (mswindows_init_frame_1): Fixed support for popup frames. (mswindows_delete_frame): Fixed memory leak. (mswindows_get_frame_parent): Implemented. - (mswindows_update_frame_external_traits): Moved part of the former + (mswindows_update_frame_external_traits): Moved part of the former update_EmacsFrame() here. (console_type_create_frame_mswindows): Declare get_frame_parent and update_frame_external_traits methods. @@ -2366,16 +2366,16 @@ Sat Mar 28 10:16:29 1998 Andy Piper windows does not yet have associated frame object (mswindows_find_frame): Casted long to Lisp_Object properly. - * device.c (window_system_pixelated_geometry): Changed to call the + * device.c (window_system_pixelated_geometry): Changed to call the device_implementation_flags device method. * device-msw.c (mswindows_device_implementation_flags): - Implemented. + Implemented. (console_type_create_device_mswindows): Declared the above. * console.h (struct console_methods): Added device_implementation_flags_method and - update_frame_external_traits_method. + update_frame_external_traits_method. Defined flags retuned by device_implementation_flags_method. * console-msw.h (struct mswindows_frame): Added charheight and @@ -2384,7 +2384,7 @@ Sat Mar 28 10:16:29 1998 Andy Piper Moved Windows-specific macros from frame.h here. (typedef struct XEMACS_RECT_WH): Added. Declared global variables. - + 1998-03-19 Kirill M. Katsnelson * console-msw.h: Added prototypes for @@ -2408,8 +2408,8 @@ Sat Mar 28 10:16:29 1998 Andy Piper indication to fake font size to 1. (char_to_pixel_size): Ditto. (round_size_to_char): Ditto. - (pixel_to_real_char_size): - (char_to_real_pixel_size): + (pixel_to_real_char_size): + (char_to_real_pixel_size): (round_size_to_real_char): New three counterparts of the above metioned functions, which always use real character metrics. (change_frame_size_1): Use real character metrics when computing @@ -2423,7 +2423,7 @@ Sat Mar 28 10:16:29 1998 Andy Piper (mswindows_init_frame_2): Commented out, unused. (mswindows_after_init_frame): Added frame method. (mswindows_set_frame_size): Reworked to support pixel base - geometry. + geometry. (mswindows_set_frame_position): Cahnged to use SetWindowPos. (mswindows_lower_frame): Ditto. (mswindows_set_frame_properties): Fixed to perform correct @@ -2432,7 +2432,7 @@ Sat Mar 28 10:16:29 1998 Andy Piper after_init_frame added. * faces.c (default_face_height_and_width_1): Added. - (update_EmacsFrame): Changed method of notifying mswindwows frame, + (update_EmacsFrame): Changed method of notifying mswindwows frame, so modeline border gets redrawn. * faces.h: Prototype for default_face_height_and_width_1(). @@ -2443,13 +2443,13 @@ Sat Mar 28 10:16:29 1998 Andy Piper char if window is maximized. Use real char metrics for rounding. Call DefWindowProc to process WM_GETMINMAXINFO - (mswindows_set_chord_timer): Changed chord timeout from 1/2 to 1/3 + (mswindows_set_chord_timer): Changed chord timeout from 1/2 to 1/3 system double click time * device.c (domain_device_type): New function. - (window_system_pixelated_geometry): New function. + (window_system_pixelated_geometry): New function. (Fdomain_device_type): New function, lisp interface to - domain_device_type(). + domain_device_type(). (syms_of_device): DEFSUBRed the above. * device.h: Ptorotypes for domain_device_type() and @@ -2492,7 +2492,7 @@ Sat Mar 28 10:16:29 1998 Andy Piper 1998-03-27 P. E. Jareth Hein - * glyphs-x.c: + * glyphs-x.c: * imgproc.c: * imgproc.h: * glyphs-x.h: Added in a colormap variable in the X specific image @@ -2501,7 +2501,7 @@ Sat Mar 28 10:16:29 1998 Andy Piper coding standards. * glyphs.h: - * glyphs.c: + * glyphs.c: * glyphs-x.c: added image-conversion-error type * objects-x.c (allocate_nearest_color): Corrected a minor bug involving @@ -2530,13 +2530,13 @@ Sat Mar 28 10:16:29 1998 Andy Piper 1998-03-24 Kirill M. Katsnelson - * fileio.c (Ffile_readable_p): GC protect fix, MS Windows specific. + * fileio.c (Ffile_readable_p): GC protect fix, MS Windows specific. Mon Mar 23 22:14:12 1998 Andy Piper * configure.in: compile in glyphs-msw.o when compiling fopr mswindows. - + Mon Mar 23 22:14:12 1998 Andy Piper * msw-glyphs.el: add support for xpm and bmp. change @@ -2547,7 +2547,7 @@ Mon Mar 23 22:14:12 1998 Andy Piper * Makefile.in.in: fastdump - new target for dumping bypassing bytecompilation, DOC. Add dependencies for glyphs-msw.o. Move imgproc.o to object list. - + * glyphs-msw.h: * glyphs-msw.c: new files adding support for xpm and bmp and EImages. @@ -2557,7 +2557,7 @@ Mon Mar 23 22:14:12 1998 Andy Piper * console-msw.h: add bitspixel field to mswindows frame. * device-msw.c: initialise bitspixel field in mswindows frame. - + * glyphs-x.c (xpm_instantiate): call mswindows_xpm_instantiate if the device type is mswindows. @@ -2565,7 +2565,7 @@ Mon Mar 23 22:14:12 1998 Andy Piper mswindows. * symsinit.h: add prototypes for glyphs-msw.c functions. - + * sheap.c: make includes src-dir compliant. * events.c: remove cygwin ^H <-> erase hack. @@ -2609,7 +2609,7 @@ Mon Mar 23 22:14:12 1998 Andy Piper if the symbol is in Vobarray. * symbols.c (reject_constant_symbols): Signal error when - attempting to assign a value to a keyword, unless the value is the + attempting to assign a value to a keyword, unless the value is the keyword itself. * symbols.c (Fintern): Initialize symbol's ->obarray to t only @@ -2716,7 +2716,7 @@ Mon Mar 23 22:14:12 1998 Andy Piper * config.h.in: Add HAVE_LIBMCHECK and HAVE_MCHECK_H. * hash.c (grow_hashtable): Fix tests to compare against - Qnull_pointer since this function may be called before any symbols + Qnull_pointer since this function may be called before any symbols or the Lisp engine is initialized. * emacs.c (main_1): Restore usage of free-hook.c. @@ -2730,7 +2730,7 @@ Mon Mar 23 22:14:12 1998 Andy Piper control variable is being modified underneath us. - Avoid calling delete_console_internal on stream consoles. - * console-tty.c (free_tty_console_struct): NULL out pointers after + * console-tty.c (free_tty_console_struct): NULL out pointers after xfree'ing. * console-stream.c (allocate_stream_console_struct): Fix memory @@ -2758,7 +2758,7 @@ Mon Mar 23 22:14:12 1998 Andy Piper (Fwrite_region_internal): Ditto. (decide_buffer_type): Function removed. (buf_decide_buffer_type): Function removed. - (Many places): References to DOS_NT replaced with WINDOWSNT. MSDOS- + (Many places): References to DOS_NT replaced with WINDOWSNT. MSDOS- specific code removed. * lread.c (Fload_internal): Removed ugly DOS style re-opening a @@ -2774,7 +2774,7 @@ Mon Mar 23 22:14:12 1998 Andy Piper implemented in nt.c * fileio.c (Ffile_readable_p): Conditionalized declared never used - variables. + variables. (Fexpand_file_name): Ditto. (check_executable): Ditto. @@ -2823,7 +2823,7 @@ Mon Mar 23 22:14:12 1998 Andy Piper 1998-03-15 Kyle Jones - * console.h: Added set_final_cursor_coords method to console + * console.h: Added set_final_cursor_coords method to console struct. * console-tty.h: Added final_cursor_x and final_cursor_y @@ -2872,7 +2872,7 @@ Mon Mar 23 22:14:12 1998 Andy Piper * glyphs-x.c (png_instantiate): Added in override support for png backgrounds. - + 1998-03-13 P. E. Jareth Hein * glyphs-x.c (png_instantiate): Fixed a bug that was causing @@ -3058,7 +3058,7 @@ Mon Mar 09 13:00:55 1998 Andy Piper (Fenlarge_window_pixels): New function. (Fshrink_window_pixels): New function. (window_displayed_pixel_height): New, helper for - Fwindow_displayed_pixel_height. + Fwindow_displayed_pixel_height. (change_window_height): Add `inpixels' argument. (syms_of_window): 3 new DEFSUBR's. @@ -3179,16 +3179,16 @@ Fri Feb 20 21:22:34 1998 Darryl Okahata (get_eof_char): Ditto * symsinit.h: Prototypes for initialization functions called from - emacs.c: process_type_create_mswindows, process_type_create_unix, + emacs.c: process_type_create_mswindows, process_type_create_unix, vars_of_process_mswindows, vars_of_process_unix. - * procimpl.h: New file. Includes prototypes and other stuff shared + * procimpl.h: New file. Includes prototypes and other stuff shared by process.c and implementation files (process-unix.c, process-msw.c in future). * process.h (PROCESS_LIVE_P): Changed to test against stream existence, to avoid dependency on fds. - + * process.c: Only process implementation independent code is now in this file. Moved the rest into process-unix.c (Fopen_network_stream_internal): Added 5th parameter, protocol @@ -3198,7 +3198,7 @@ Fri Feb 20 21:22:34 1998 Darryl Okahata processes. UNIX-specific code from the old process.c is here. * Lstream.c (Lstream_was_blocked_p): New function. Replaces - filedesc_stream_was_blocked_p. + filedesc_stream_was_blocked_p. (filedesc_was_blocked_p): Implementation of the method for filedesc stream (filedesc_stream_set_pty_flushing): set pty_flushing flag @@ -3208,10 +3208,10 @@ Fri Feb 20 21:22:34 1998 Darryl Okahata optional lstream method. Added prototypes for functions in lstream.c - * lisp.h: (USID): Typedef for Unique Stream IDentifier. Reuqired + * lisp.h: (USID): Typedef for Unique Stream IDentifier. Reuqired by the new code in many places. - * events.h (struct event_stream): Declaration of the two mandatory + * events.h (struct event_stream): Declaration of the two mandatory event stream methods, required by process support. * event-unixoid.c (event_stream_unixoid_create_stream_pair): @@ -3235,7 +3235,7 @@ Fri Feb 20 21:22:34 1998 Darryl Okahata (emacs_Xt_delete_stream_pair): Ditto * emacs.c (main_1): Added calls to process_type_create*() and - vars_of_process() + vars_of_process() * callproc.c: (many places): removed DOS support @@ -3290,7 +3290,7 @@ Mon Mar 02 11:37:36 1998 Andy Piper 1998-03-01 Kyle Jones - * file-coding.c (setup_eol_coding_systems): Don't try + * file-coding.c (setup_eol_coding_systems): Don't try to copy the mnemonic property of the coding system unless it is a string. @@ -3304,7 +3304,7 @@ Mon Mar 02 11:37:36 1998 Andy Piper 1998-03-01 Kyle Jones - * callint.c: Read coding system names for the 'z' and + * callint.c: Read coding system names for the 'z' and 'Z' interactive specs if FILE_CODING or MULE is defined. Previously, coding system names were read only if MULE was defined. @@ -3393,7 +3393,7 @@ Tue Feb 17 12:50:37 1998 Andy Piper * mule-coding.c: #if 0 out functionality until file-coding is split up. - * file-coding.h: + * file-coding.h: * file-coding.c: new files. copies of mule-coding.h and mule-coding.c. The mule case is unchanged. The non-mule case removes coding relating to other charsets - iso2022, big5, sjis, @@ -3431,7 +3431,7 @@ Tue Feb 17 12:50:37 1998 Andy Piper case, the application class is chosen based on whether the user has any resources with application class `XEmacs' set in the resource database. - (vars_of_device_x): make x-emacs-application-class nil by default + (vars_of_device_x): make x-emacs-application-class nil by default and document new behavior in its doc string. 1998-02-23 Aki Vehtari @@ -3451,11 +3451,11 @@ Tue Feb 17 12:50:37 1998 Andy Piper * s/sol2.h: define HAVE_GETLOADAVG for late edition Solaris From Georg Nikodym -1998-02-24 Didier Verna +1998-02-24 Didier Verna * redisplay.c (generate_fstring_runes): fixed the modeline scrolling lossage (the % constructs appearing in the - modeline). Now that we can have negative positions and boundaries, + modeline). Now that we can have negative positions and boundaries, max_pos == -1 can't mean 'no limit' anymore. Me, stupido! (add_string_to_fstring_db_runes): Ditto. (add_glyph_to_fstring_db_runes): Ditto. @@ -3508,7 +3508,7 @@ Tue Feb 17 12:50:37 1998 Andy Piper * unexelf.c: The proper way to check for GNU libc is with __GLIBC__. Suggested by Andreas Jaeger - + 1998-02-18 SL Baur * Makefile.in.in: Remove all references to prefix-args. @@ -3536,28 +3536,28 @@ Tue Feb 17 12:50:37 1998 Andy Piper (Fset-window-configuration): Restore window-cached specifier values. -1998-02-18 Didier Verna +1998-02-18 Didier Verna * modeline.el (mouse-drag-modeline): added the horizontal scrolling functionality for the modeline. This could still be improved, for instance when the mouse goes out of the modeline. -1998-02-18 Didier Verna +1998-02-18 Didier Verna * redisplay.c: (generate_formatted_string_db): new flag to distinguish a modeline string from a title or icon one, plus use a negative first pos to - indicate the modeline hscroll ammount. + indicate the modeline hscroll ammount. (add_string_to_fstring_db_runes): completely rewrote this function to handle the case of scrolled modelines. (add_glyph_to_fstring_db_runes): handle the case of scrolled - modelines. + modelines. * window.c: (Fmodeline_hscroll): new function to return the modeline current - horizontal scroll ammount. + horizontal scroll ammount. (Fset_modeline_hscroll): new function to scroll the modeline - horizontaly. + horizontaly. Plus some updates related to this new functionality (windows configuration, notably). @@ -3604,8 +3604,8 @@ Tue Feb 17 12:50:37 1998 Andy Piper 1998-02-14 Martin Buchholz - * event-Xt.c (x_reset_key_mapping): - * device-x.c: + * event-Xt.c (x_reset_key_mapping): + * device-x.c: (x-keysym-on-keyboard-p): (x-keysym-on-keyboard-sans-modifiers-p): Use x-keysym-on-keyboard-sans-modifiers-p instead of @@ -3677,7 +3677,7 @@ Tue Feb 17 12:50:37 1998 Andy Piper (gui_item_display_flush_left): Ditto (gui_item_display_flush_right): Ditto. The above listen new functions manipulate on properties common to menu items and GUI - buttons. + buttons. * menubar.c (current_frame_menubar): Moved from menubar-msw.c (menu_parse_submenu_keywords): New function @@ -3771,7 +3771,7 @@ Tue Feb 17 12:50:37 1998 Andy Piper Wed Jan 28 13:41:22 1998 Andy Piper * Makefile.in.in: add support for sheap-adjust.h generation for - static heap. + static heap. Wed Jan 28 13:41:22 1998 Andy Piper @@ -3906,7 +3906,7 @@ Wed Jan 28 13:41:22 1998 Andy Piper * frame-msw.c: Added file-based drag and drop support. The "System/Open" DDE command is also implemented as if it were a drag and drop operation. - + * emacsfns.h: * event-stream.c: * events.c: @@ -4004,7 +4004,7 @@ Wed Jan 21 10:49:47 1998 Andy Piper * unexcw.cc: new file for cygwin32 unexec() requires cygwin32 b19. Predicated on HAVE_COFF_H. - * console.c: + * console.c: * device-msw.c: * event-msw.c: * frame-msw.c: @@ -4034,7 +4034,7 @@ Wed Jan 21 10:49:47 1998 Andy Piper 1998-01-23 Hrvoje Niksic * print.c (print_cons): Use XCAR/XCDR. - (print_string): Fix up so it Vprint_string_length works under Mule + (print_string): Fix up so it Vprint_string_length works under Mule correctly. * eval.c (Feval): Increase profile call count. @@ -4122,15 +4122,15 @@ Wed Jan 21 10:49:47 1998 Andy Piper * offix-cursors.h (cursor_bits): Warning elimination. - * redisplay.c (add_blank_rune): - * redisplay.c (add_glyph_rune): - * redisplay.c (add_emchar_rune): + * redisplay.c (add_blank_rune): + * redisplay.c (add_glyph_rune): + * redisplay.c (add_emchar_rune): Warning elimination. Avoid useless computation in non-mule case. * config.h.in: Define HAVE_INVERSE_HYPERBOLIC using 1 configure test, not 3. - * src/alloc.c: - * src/events.c: + * src/alloc.c: + * src/events.c: Rearrange order of declarations and definitions to avoid forward * src/mem-limits.h: Add motivating comment for future cleanup. @@ -4140,7 +4140,7 @@ Wed Jan 21 10:49:47 1998 Andy Piper Always define _GNU_SOURCE when using GNU libc. Support --without-FOO as a synonym for --with-FOO=no. Always use $srcdir to locate config.guess. - Make it clear that CONFIGURATION is optional. + Make it clear that CONFIGURATION is optional. De-emphasize CONFIGURATION parameter. Random cleanup. More compatible with standard GNU install instructions. --with-menubars=athena3d ==> --with-menubars=lucid. @@ -4247,7 +4247,7 @@ Sat Jan 10 11:36:11 1998 Andy Piper Suggested by Aki Vehtari * src/symbols.c (Fsetq_default): Fix docstring. - From Didier Verna + From Didier Verna 1998-01-07 Kirill M. Katsnelson @@ -4283,13 +4283,13 @@ Thu Jan 08 09:42:36 1998 Andy Piper * lread.c (Fload_internal): On Win32, this reopened the file without first closing the handle. This caused running out of handles. - + * nt.c (sys_open): This one made big mess when opening a handle next after MAXDESC-1. Fixed. 1998-01-06 Kirill M. Katsnelson - * objects-msw.c (mswindows_string_to_color): Patched not to modify + * objects-msw.c (mswindows_string_to_color): Patched not to modify const char* parameter. (hexval): Modified to accept uppercase hex digits. @@ -4321,7 +4321,7 @@ Thu Jan 08 09:42:36 1998 Andy Piper * nt.h: Removed FD_* macros. Rely on definitions in winsock.h. Changed EMACSDEBUG references to DEBUG_XEMACS - * event-msw.c (mswindows_cancel_dispatch_event): Returns Qnil when + * event-msw.c (mswindows_cancel_dispatch_event): Returns Qnil when event not found in the queue. Used to return undefined value. 1998-01-07 SL Baur @@ -4362,7 +4362,7 @@ Thu Jan 08 09:42:36 1998 Andy Piper 1997-12-29 Kirill M. Katsnelson - * msw-proc.c (mswindows_enqueue_magic_event): Made extern. User by + * msw-proc.c (mswindows_enqueue_magic_event): Made extern. User by menubar-msw.c * event-msw.h: Prototype for mswindows_enqueue_magic_event @@ -4410,7 +4410,7 @@ Thu Jan 08 09:42:36 1998 Andy Piper * alloc.c (disksave_object_finalization): Don't zero out load-history if history of pure symbols is desired. - * lread.c (build_load_history): If LOADHIST_DUMPED is defined, add + * lread.c (build_load_history): If LOADHIST_DUMPED is defined, add pure symbols to load-history. * emacsfns.h: New symbols added -- LOADHIST_DUMPED, define to get @@ -4432,7 +4432,7 @@ Thu Jan 08 09:42:36 1998 Andy Piper 1997-12-26 Kirill M. Katsnelson * menubar-msw.c, menubar-msw.h: New files. Menus support. - + * console-msw.h: Added frame menu hashtable variable. * gui.c: popup_up_p variable and Fpopup_up_p and @@ -4458,7 +4458,7 @@ Thu Jan 08 09:42:36 1998 Andy Piper can be compared with 'equal. Menubar uses opaque pointers as hash keys in an 'equal style hastable. - * Most of the above touched files: Eliminated compiler warnings. + * Most of the above touched files: Eliminated compiler warnings. 1997-12-18 Hrvoje Niksic @@ -4471,7 +4471,7 @@ Thu Jan 08 09:42:36 1998 Andy Piper 1997-12-26 P. E. Jareth Hein - * glyphs-x.c (imagick_instantiate): Add in error and + * glyphs-x.c (imagick_instantiate): Add in error and warning handling for ImageMagick files 1997-12-26 SL Baur @@ -4587,7 +4587,7 @@ Thu Dec 18 09:53:12 1997 * fileio.c (Finsert_file_contents_internal): Use report_file_error() to report reading error. - * cmds.c (internal_self_insert): Don't self-insert if the expanded + * cmds.c (internal_self_insert): Don't self-insert if the expanded symbol's hook has a non-nil `no-self-insert' property; synch with FSF 20.2. @@ -4622,22 +4622,22 @@ Thu Dec 18 09:53:12 1997 * dired.c (file_name_completion): Use noseeum_cons. (file_name_completion_unwind): Free the cons. -1997-12-16 - +1997-12-16 + * scrollbar.c: Add HAVE_MS_WINDOWS to scrollbar-page functions. - + * msw-proc.c: Handle scrolling events. - + * frame-msw.c: Initialize scrollbar width and height. This should not be necessary, since the window shouldn't be created until init_frame_2 - + * emacs.c: Call mswindows scrolbar setup when appropriate. - + * scrollbar-msw.c: Created for mswindows-scrollbar support. - + * scrollbar-msw.h: Ditto. - + 1997-12-16 Kirill M. Katsnelson * msw-proc.c: Minor bug in the middle button emulation code @@ -4706,7 +4706,7 @@ Thu Dec 18 09:53:12 1997 1997-12-12 SL Baur - * input-method-xlib.c (describe_XIC): Add casts, use unsigned long + * input-method-xlib.c (describe_XIC): Add casts, use unsigned long int. * eval.c (funcall_subr): Ifdef out as it is now unused. @@ -4786,9 +4786,9 @@ Thu Dec 18 09:53:12 1997 * input-method-xfs.c (Initialize_Locale): Ditto. * input-method-motif.c (Initialize_Locale): Ditto. * input-method-xlib.c (Initialize_Locale): Ditto. - Suggested by Didier Verna and + Suggested by Didier Verna and Martin Buchholz - + 1997-12-10 Karl M. Hegbloom * config.h.in: #undef MAGICK_HEADERS_ARE_UNDER_X11 @@ -4902,11 +4902,11 @@ Thu Dec 18 09:53:12 1997 set the correct window size. 1997-12-04 Jeff Sparkes - + * frame-msw.c: added frame functions for move, resize, iconify, raise, lower, visible_p, iconified_p, focus, make visible, make invisible, set title. - + 1997-12-01 Jonathon Harris * event-msw.c, event-msw.h, frame-msw.c, msw-proc.c: @@ -4931,7 +4931,7 @@ Thu Dec 18 09:53:12 1997 * menubar-x.c: change #ifdef LWLIB_MENUBARS_MOTIF to #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF - around code for incremental menu build. + around code for incremental menu build. * event-stream.c: Changed HAVE_MENUBARS to HAVE_MENUBARS_LUCID in the #ifdef wrappers around menubar accelerator stuff. @@ -5033,7 +5033,7 @@ Thu Dec 18 09:53:12 1997 vector and call mapcar1 with its data. 1997-12-02 P E Jareth Hein - + * objects-x.c: Added colormap/visual support, rewrote allocate_nearest_color, and changed the x-color-instance to deal with possibly not freeing a color. @@ -5142,7 +5142,7 @@ Thu Dec 18 09:53:12 1997 (Fredisplay_echo_area): Clear echo_area_garbaged flag on frame after displaying in echo area. - * redisplay.c: Added hscroll_glyph_width_adjust field + * redisplay.c: Added hscroll_glyph_width_adjust field to position_redisplay_data_type struct. (add_hscroll_rune): Compute the difference in width @@ -5178,7 +5178,7 @@ Thu Dec 18 09:53:12 1997 1997-11-17 Marc Paquette - * callproc.c (Fcall_process_internal): Fix for bug in + * callproc.c (Fcall_process_internal): Fix for bug in CRLF -> LF conversion. 1997-11-19 Jonathan Harris @@ -5199,7 +5199,7 @@ Thu Dec 18 09:53:12 1997 * callproc.c (Fcall_process_internal): Close fd_error. -1997-11-19 Didier Verna +1997-11-19 Didier Verna * emacs.c (main_1): Added the missing argmatch call to check for the '-h' option. @@ -5255,7 +5255,7 @@ Thu Dec 18 09:53:12 1997 * frame.c: Document new toolbar border width speciifer as being usable as frame properties. - (frame_conversion_internal): Factor the toolbar border + (frame_conversion_internal): Factor the toolbar border widths into the geometry calculations. (change_frame_size_1): Ditto. @@ -5274,11 +5274,11 @@ Thu Dec 18 09:53:12 1997 support for drawing a border along with the blank button. Accept border_width and vertical args. - (x_output_toolbar_button): Added support for drawing a + (x_output_toolbar_button): Added support for drawing a border along with the button. (X_OUTPUT_BUTTONS_LOOP): Pass border_width and vert - args to x_draw_blank_toolbar_button. Set vertical and + args to x_draw_blank_toolbar_button. Set vertical and border_width fields in toolbar button. (x_output_toolbar): Support toolbar border widths. @@ -5324,7 +5324,7 @@ Thu Dec 18 09:53:12 1997 1997-11-16 Hrvoje Niksic - * events.c (print_event): Use `event-x-pixel' and `event-y-pixel', + * events.c (print_event): Use `event-x-pixel' and `event-y-pixel', to be consistent with `make-event' and `event-properties'. (Fmake_event): Allow nil dnd-data. @@ -5630,7 +5630,7 @@ Sun November 01 12:00:00 1997 * redisplay.c: init_redisplay Initialise window system to w32, conditioned on HAVE_W32GUI. - + * symsinit.h: Added syms_of_*_w32, vars_of_*_w32 and init_event_w32_late. @@ -5717,33 +5717,33 @@ Sun November 01 12:00:00 1997 1997-11-02 Andreas Jaeger - * m/vax.h: - * s/cxux.h: - * s/xenix.h: - * s/umax.h: - * s/msdos.h: - * s/template.h: - * termcap.c: - * signal.c: - * lread.c: + * m/vax.h: + * s/cxux.h: + * s/xenix.h: + * s/umax.h: + * s/msdos.h: + * s/template.h: + * termcap.c: + * signal.c: + * lread.c: * callproc.c * buffer.c: Remove VMS dependent code. 1997-11-02 Andreas Jaeger * syspwd.h: - * systty.h: - * systime.h: - * syssignal.h: - * sysproc.h: - * sysfloat.h: - * sysfile.h: - * regex.h: - * process.h: - * ndir.h: - * mule-mcpath.h: - * getpagesize.h: - * sysdep.h: + * systty.h: + * systime.h: + * syssignal.h: + * sysproc.h: + * sysfloat.h: + * sysfile.h: + * regex.h: + * process.h: + * ndir.h: + * mule-mcpath.h: + * getpagesize.h: + * sysdep.h: * fileio.c: * process.c: Remove old VMS code. @@ -5753,8 +5753,8 @@ Sun November 01 12:00:00 1997 1997-11-02 Andreas Jaeger - * sysdep.c: - * getloadavg.c: + * sysdep.c: + * getloadavg.c: * malloc.c: Remove old VMS code. 1997-11-02 Hrvoje Niksic @@ -5803,12 +5803,12 @@ Sun November 01 12:00:00 1997 1997-10-31 Kyle Jones - * callproc.c: GC protect current_dir while infile and + * callproc.c: GC protect current_dir while infile and error_file are being initialized. 1997-10-30 SL Baur - * config.h.in: Remove HAVE_GIF, HAVE_JPEG, HAVE_PNG, HAVE_TIFF and + * config.h.in: Remove HAVE_GIF, HAVE_JPEG, HAVE_PNG, HAVE_TIFF and replace with HAVE_IMAGEMAGICK. 1997-10-30 Kyle Jones @@ -5824,7 +5824,7 @@ Sun November 01 12:00:00 1997 1997-10-28 Kyle Jones - * Under LRECORD_VECTOR, moved vectors from being an basic + * Under LRECORD_VECTOR, moved vectors from being an basic lrecord tpye to an lcrecord. Added support for 31 bits Lisp integers. Added support for maskless pointers to Lisp objects. @@ -5854,7 +5854,7 @@ Sun November 01 12:00:00 1997 type checking code on an uninitialized implementation pointer. - (Fpurecopy): return if given a null pointer. THis can + (Fpurecopy): return if given a null pointer. THis can happen when initializing Qnil. (mark_object): return if passed a null pointer. I @@ -5870,7 +5870,7 @@ Sun November 01 12:00:00 1997 indirect children list gets reset to a null pointer when a bfufer is killed. - (complex_vars_of_buffer): initialize indirect_children + (complex_vars_of_buffer): initialize indirect_children slow of Vbuffer_local_symbols and Vbuffer_defaults to nil. @@ -6010,11 +6010,11 @@ Sun November 01 12:00:00 1997 * README: Remove references to VMS. - * vlimit.h: - * s/vms5-5.h: - * s/vms4-4.h: - * s/vms4-2.h: - * s/vms4-0.h: + * vlimit.h: + * s/vms5-5.h: + * s/vms4-4.h: + * s/vms4-2.h: + * s/vms4-0.h: * s/vms.h: Remove files since VMS isn't supported any more. 1997-10-25 Kyle Jones @@ -6030,7 +6030,7 @@ Sun November 01 12:00:00 1997 * alloc.c: Disable purespace statistics unless --debug is in effect. - * console-stream.c (init_console_stream): At the price of a tiny + * console-stream.c (init_console_stream): At the price of a tiny memory leak, reinitialize FILE fields of the console. From Tonny Madsen @@ -6072,15 +6072,15 @@ Sun November 01 12:00:00 1997 separate function so that it could be used as a `print' method for lrecord-based strings. -1997-10-20 Jan Vroonhof - +1997-10-20 Jan Vroonhof + * extents.c: Renamed shot property to initial-redisplay-function (extent_fragment_update): Changed the bookkeeping whether an event has been spawned. The initial-redisplay-function property is no longer set to nil. - + * extents.h: ditto - + 1997-10-20 Kyle Jones * Added support for conses and vectors to be lrecords. @@ -6153,7 +6153,7 @@ Sun November 01 12:00:00 1997 (make-coding-system, coding-system-type, detect-coding-region): Rename `Qautomatic_conversion' -> `Qundecided'. - + * general.c (syms_of_general): Rename `automatic-conversion' -> `undecided' to sync with Emacs 20.2. @@ -6202,7 +6202,7 @@ Sun November 01 12:00:00 1997 1997-10-11 SL Baur - * realpath.c (realpath): CONST IS LOSING but removing it conflicts + * realpath.c (realpath): CONST IS LOSING but removing it conflicts with system headers. * callproc.c: New variable infopath-internal. @@ -6272,7 +6272,7 @@ Sun November 01 12:00:00 1997 * regex.c: Global change: register -> REGISTER. - Ensure REGISTER is always defined. - + * nt.c: Global change: register -> REGISTER. * linuxplay.c: Global change: register -> REGISTER. @@ -6281,7 +6281,7 @@ Sun November 01 12:00:00 1997 * gifalloc.c: Global change: register -> REGISTER. - Ensure REGISTER is always defined. - + * getloadavg.c (getloadavg): register -> REGISTER. * eval.c (unwind_to_catch): [Unused variable] register -> REGISTER. @@ -6344,7 +6344,7 @@ Sun November 01 12:00:00 1997 Fri Oct 3 12:28:08 1997 Kyle Jones * lisp-disunion.h: Move markbit to be between the - type bits and the value bits. Previously it was always + type bits and the value bits. Previously it was always the sign bit of a EMACS_INT, unless modified by a #define in a machine dependent .h file. @@ -6446,7 +6446,7 @@ Fri Oct 3 12:28:08 1997 Kyle Jones is a cons. (Fremrassoc): Ditto. - * dired.c (Fdirectory_files): Nreverse the list only if it will be + * dired.c (Fdirectory_files): Nreverse the list only if it will be sorted. Fri Sep 26 13:55:28 1997 Kyle Jones @@ -6458,7 +6458,7 @@ Fri Sep 26 13:55:28 1997 Kyle Jones 1997-09-26 Hrvoje Niksic * dired.c (close_directory_fd): New function. - (Fdirectory_files): Use it to set up an unwind-protection to close + (Fdirectory_files): Use it to set up an unwind-protection to close the descriptor. (Fdirectory_files): Allow QUIT in re_search. (Fdirectory_files): If the file is too big, allocate necessary @@ -6494,7 +6494,7 @@ Fri Sep 26 13:55:28 1997 Kyle Jones * syntax.c (Fchar_syntax): convert nil input to \000 for compatibility. - * alloc.c (report_pure_usage): Increase slop to 512 bytes in betas + * alloc.c (report_pure_usage): Increase slop to 512 bytes in betas and reduce it to 4 bytes in releases. 1997-09-23 SL Baur @@ -6535,7 +6535,7 @@ Sun Sep 21 14:14:44 1997 Kyle Jones * eval.c (Fapply): replace Flength call with for-loop to compute list length. - + * eval.c (apply_lambda):Use XCAR and XCDR in some places where it is safe to do so. @@ -6577,7 +6577,7 @@ Sun Sep 21 14:14:44 1997 Kyle Jones * events.c (Fmake_event): Add default case, remove unused variables. 1997-08-21 Jan Vroonhof - + * extents.c (extent_fragment_update): Trigger one_shot_function * extents.c (set-extent-one-shot-function): New function @@ -6629,7 +6629,7 @@ Sun Sep 21 14:14:44 1997 Kyle Jones 1997-08-05 Jens-Ulrik Holger Petersen - * eval.c (vars_of_eval): Updated docstring for `debug_on_error' to + * eval.c (vars_of_eval): Updated docstring for `debug_on_error' to mention `debug-ignored-errors'. 1997-08-01 SL Baur @@ -6644,7 +6644,7 @@ Sun Sep 21 14:14:44 1997 Kyle Jones * frame-x.c (x_offix_drop_event_handler): Use stderr_out instead of fprintf. - * mule-coding.c (parse_iso2022_esc): Add abort() trap on unhandled + * mule-coding.c (parse_iso2022_esc): Add abort() trap on unhandled condition. * mule-wnnfns.c (Fwnn_dict_search): Remove unused variable. @@ -6719,7 +6719,7 @@ Sun Sep 21 14:14:44 1997 Kyle Jones New variable Vpackage_path. (vars_of_emacs): Use it. - * editfns.c (Fstring_to_char): Return nil instead of `0' for empty + * editfns.c (Fstring_to_char): Return nil instead of `0' for empty string. 1997-07-10 Hrvoje Niksic @@ -6760,7 +6760,7 @@ Sun Sep 21 14:14:44 1997 Kyle Jones Was forgotten cut & paste identical clone to Fcompiled_function_interactive? - * Makefile.in.in (alloc.o): Remove dependency on puresize_adjust.h + * Makefile.in.in (alloc.o): Remove dependency on puresize_adjust.h so alloc.c need not be recompiled when puresize changes. * alloc.c (PURIFIED): Use get_PURESIZE() instead of constant. @@ -6775,7 +6775,7 @@ Sun Sep 21 14:14:44 1997 Kyle Jones (get_PURESIZE): New function -- declare it. * pure.c: Move final PURESIZE computation and include of - puresize_adjust.h into here so alloc.c need not be recompiled each + puresize_adjust.h into here so alloc.c need not be recompiled each time the puresize is adjusted. (get_PURESIZE): New function. @@ -6795,7 +6795,7 @@ Sun Sep 21 14:14:44 1997 Kyle Jones I am still not sure what this buys us, but I guess it doesn't hurt to have it. From Hrvoje Niksic - + * glyphs.c (make_string_from_file): Use insert-file-contents-literally instead of insert-file-contents-internal. @@ -6925,7 +6925,7 @@ Sun Sep 21 14:14:44 1997 Kyle Jones 1997-06-18 Martin Buchholz - * Makefile.in: + * Makefile.in: * s/*.h: * m/*.h: * config.h.in: @@ -6946,10 +6946,10 @@ Sun Sep 21 14:14:44 1997 Kyle Jones - Make quoted pre-processor string tokens out of all macro values to be used only by configure. * xmu.c: DON'T use Xos.h - * sysdep.c (wait_for_termination): - * search.c: - * editfns.c: - * console-*: + * sysdep.c (wait_for_termination): + * search.c: + * editfns.c: + * console-*: 1997-06-18 Steven L Baur @@ -7049,7 +7049,7 @@ Fri Jun 13 00:25:46 1997 Kyle Jones * syntax.c (Fchar_syntax): Handle case of being passed nil. - * data.c (eq_with_ebola_notice): Add more legitimate places in the + * data.c (eq_with_ebola_notice): Add more legitimate places in the bytecompiler that should not get Ebola notices. Tue Jun 10 00:34:40 1997 Kyle Jones @@ -7097,7 +7097,7 @@ Tue Jun 10 00:34:40 1997 Kyle Jones * keydefs.c (get_relevant_extent_keymaps): Choose correct keymap at extent boundaries. - + Mon Jun 9 19:35:19 1997 Kyle Jones * redisplay.c (pixel_to_glyph_translation): @@ -7119,7 +7119,7 @@ Sat Jun 7 22:07:41 1997 Kyle Jones * sysdep.c: MS Windows NT doesn't (yet) do child TTY processes. From David Hobley - + Sat Jun 7 22:00:54 1997 Kyle Jones * device-x.c (x_delete_device): @@ -7130,7 +7130,7 @@ Sat Jun 7 22:00:54 1997 Kyle Jones * frame.c (Fmake_frame): Correct checking of first_frame_on_device. From Hrvoje Niksic - + 1997-06-04 Steven L Baur * device.c (delete_deviceless_console): New function. @@ -7170,7 +7170,7 @@ Mon Jun 2 02:49:44 1997 Kyle Jones Sat May 31 19:59:49 1997 Kyle Jones * frame-tty.c (tty_init_frame_3: - Defer selection of the newly created frame until + Defer selection of the newly created frame until an event is read. 1997-06-02 Steven L Baur @@ -7233,7 +7233,7 @@ Thu May 29 03:00:16 1997 Kyle Jones (Fset_recent_keys_ring_size): New function. Modifies the above. From Hrvoje Niksic - + * event-stream.c: New variable recent_keys_ring_size replacing a hard-coded macro. @@ -7251,7 +7251,7 @@ Thu May 29 03:00:16 1997 Kyle Jones Wed May 21 11:58:17 1997 Kyle Jones * insdel.c (signal_first_change): - record the current buffer for the unwind instead of the + record the current buffer for the unwind instead of the buffer that's about to become the current buffer. Tue May 20 23:23:39 1997 Steven L Baur @@ -7333,7 +7333,7 @@ Wed Apr 30 18:07:18 1997 Steven L Baur * lread.c: New variable featurep. (read1): Add processing for #- and #+. - (read_list_conser): Handle case where a feature test has removed a + (read_list_conser): Handle case where a feature test has removed a portion of the input stream. (vars_of_lread): New feature `xemacs'. @@ -7362,7 +7362,7 @@ Tue Apr 22 11:54:02 1997 Steven L Baur HAVE_X_WINDOWS. (main_1): Add vars_of_balloon_x and guard with HAVE_X_WINDOWS. - * process.c (get_process): This function can be passed a BUFFER as + * process.c (get_process): This function can be passed a BUFFER as a parameter. Tue Apr 22 01:32:00 1997 Kyle Jones @@ -7493,7 +7493,7 @@ Sun Apr 6 18:03:47 1997 David Moore * dired.c (Fdirectory_files): Clean up GC protection. - * insdel.c (signal_after_change): Don't run after_change_functions + * insdel.c (signal_after_change): Don't run after_change_functions on special Vprin1_to_string_buffer. (signal_before_change): Ditto for before_change_functions. @@ -7551,7 +7551,7 @@ Sun Apr 6 08:08:33 1997 Steven L Baur * config.h.in: Strip unimplemented NeXTStep/Epoch stuff out. - * Makefile.in.in: Remove unused NeXTStep support. It's all in the + * Makefile.in.in: Remove unused NeXTStep support. It's all in the cvs attic if someone wishes to revive it. (epoch.o): Remove last vestiges of non-existent epoch support. @@ -7566,7 +7566,7 @@ Thu Apr 3 08:01:50 1997 Steve Carney Tue Apr 1 12:22:32 1997 Steven L Baur - * config.h.in: MAIL_USE_POP, KERBEROS, HESIOD -- new parameters to + * config.h.in: MAIL_USE_POP, KERBEROS, HESIOD -- new parameters to deal with upgraded movemail.c. Fri Mar 28 19:25:22 1997 Steven L Baur @@ -7613,7 +7613,7 @@ Mon Mar 24 21:50:13 1997 Steven L Baur Mon Mar 24 12:40:56 1997 David Moore * profile.c: Fixed some comments about GC status of functions. - + * profile.c (inside_profiling): New variable to lock the profiling table. (sigprof_handler): Check it. @@ -7647,7 +7647,7 @@ Fri Mar 21 18:54:04 1997 David Moore (Fset_file_modes): ditto (Ffile_newer_than_file_p): ditto (Fset_visited_file_modtime): ditto - + *fileio.c (Ffile_truename): Unneccessary GC protection. (Fdelete_directory): Fix broken caller-must-GC-protect call. @@ -7684,7 +7684,7 @@ Wed Mar 19 10:49:05 1997 Steven L Baur * glyphs-x.c (x_print_image_instance): Move define of HAVE_SUBWINDOWS to glyphs-x.h. - (our_skip_input_data): Implement with some error checking based on + (our_skip_input_data): Implement with some error checking based on patch by Dominic Froud. * glyphs-x.h (HAVE_SUBWINDOWS): Define to keep inline.c from @@ -7755,7 +7755,7 @@ Mon Mar 10 23:51:04 1997 Martin Buchholz Sun Mar 9 21:46:53 1997 Tomasz J. Cholewo - * minibuf.c (regexp_ignore_completion_p): Reverse meaning of + * minibuf.c (regexp_ignore_completion_p): Reverse meaning of completion-regexp-list. Thu Mar 6 19:15:29 1997 Steven L Baur @@ -7843,7 +7843,7 @@ Mon Feb 24 17:35:05 1997 Jonathan Edwards * process.c (record_exited_processes): Fix obvious typo in checking for SIGCLD. - + Sun Feb 23 01:45:49 1997 Martin Buchholz * scrollbar.c (update_scrollbar_instance): Fix for @@ -8312,4 +8312,3 @@ Sat Dec 7 15:48:39 1996 Steven L Baur Wed Dec 4 23:38:03 1996 Steven L Baur * redisplay.c: Allow column numbers in modeline to start from 1. - diff --git a/src/Makefile.in.in b/src/Makefile.in.in index 0934deb..e840e6d 100644 --- a/src/Makefile.in.in +++ b/src/Makefile.in.in @@ -25,7 +25,20 @@ PROGNAME=@PROGNAME@ -all: ${PROGNAME} +#define NOT_C_CODE +#include "config.h" + +#ifdef PDUMP +DUMP_TARGET = ${PROGNAME}.dmp +EXE_TARGET = ${PROGNAME} +ID_FILE = dump-id.c +#else +DUMP_TARGET = ${PROGNAME} +EXE_TARGET = temacs +ID_FILE = +#endif + +all: ${DUMP_TARGET} .PHONY : all release dump-elc dump-elcs all-elc all-elcs lint ## For performance and consistency, no built-in rules. @@ -73,8 +86,6 @@ LD=@ld@ lib_gcc=@lib_gcc@ ##libmcheck=@libmcheck@ -#define NOT_C_CODE -#include "config.h" ## With the traditional VPATH setting, it is not possible to ## simultaneously compile in-place and in another directory. The @@ -98,6 +109,7 @@ vpath config.h vpath paths.h vpath Emacs.ad.h vpath sheap-adjust.h +vpath dump-id.c #else VPATH=@srcdir@ #endif @@ -126,7 +138,7 @@ LIBI18N = -li18n X11_libs = $(LIBI18N) #endif /* HAVE_X_WINDOWS */ -#ifdef HEAP_IN_DATA +#if defined (HEAP_IN_DATA) && !defined(PDUMP) sheap_obj=sheap.o #endif @@ -309,25 +321,25 @@ mo_dir = ${etcdir} mo_file = ${mo_dir}emacs.mo #endif -temacs_loadup = ./temacs -batch -l ${srcdir}/../lisp/loadup.el +temacs_loadup = ./${EXE_TARGET} -nd -batch -l ${srcdir}/../lisp/loadup.el dump_temacs = ${temacs_loadup} dump run_temacs = ${temacs_loadup} run-temacs -debug_temacs = gdb temacs +debug_temacs = gdb ${EXE_TARGET} -release: temacs ${libsrc}DOC $(mo_file) ${other_files} +release: ${EXE_TARGET} ${libsrc}DOC $(mo_file) ${other_files} #ifdef CANNOT_DUMP - ln temacs ${PROGNAME} + ln ${EXE_TARGET} ${PROGNAME} #else -if [ -w ${srcdir}/../lisp ]; then \ - w=`pwd`; cd ${srcdir} && $${w}/temacs -batch -l ${srcdir}/../lisp/inc-vers; \ + w=`pwd`; cd ${srcdir} && $${w}/${EXE_TARGET} -nd -batch -l ${srcdir}/../lisp/inc-vers; \ else true; fi - -./temacs -batch -l ${srcdir}/../lisp/loadup.el dump + -./${EXE_TARGET} -nd -batch -l ${srcdir}/../lisp/loadup.el dump touch release #endif /* ! defined (CANNOT_DUMP) */ -${PROGNAME}: temacs ${libsrc}DOC $(mo_file) ${other_files} update-elc.stamp +${DUMP_TARGET}: ${EXE_TARGET} ${libsrc}DOC $(mo_file) ${other_files} update-elc.stamp #ifdef HEAP_IN_DATA - @$(RM) $@ $@.exe && touch SATISFIED + @$(RM) $@ && touch SATISFIED -${dump_temacs} @if test -f $@; then if test -f SATISFIED; then \ echo "Testing for Lisp shadows ..."; \ @@ -336,25 +348,22 @@ ${PROGNAME}: temacs ${libsrc}DOC $(mo_file) ${other_files} update-elc.stamp if test -f SATISFIED; then $(RM) SATISFIED; exit 1; fi; \ $(RECURSIVE_MAKE) $@; #else - @$(RM) $@ xemacs.dmp + @$(RM) $@ ${dump_temacs} -#ifdef PDUMP - @mv temacs $@ -#endif @echo "Testing for Lisp shadows ..." @./${PROGNAME} -batch -vanilla -f list-load-path-shadows #endif -fastdump: temacs - @$(RM) ${PROGNAME} && touch SATISFIED +fastdump: ${EXE_TARGET} + @$(RM) ${DUMP_TARGET} && touch SATISFIED -${dump_temacs} @./${PROGNAME} -batch -vanilla -f list-load-path-shadows FRC.update-elc.stamp : -update-elc.stamp : temacs FRC.update-elc.stamp +update-elc.stamp : ${EXE_TARGET} FRC.update-elc.stamp @touch NOBYTECOMPILE - ./temacs -batch -l ${srcdir}/../lisp/update-elc.el + ./${EXE_TARGET} -nd -batch -l ${srcdir}/../lisp/update-elc.el @if test ! -f $@ -o -f NOBYTECOMPILE; then touch $@; fi; \ $(RM) NOBYTECOMPILE @@ -373,16 +382,16 @@ dynodump_deps = ../dynodump/dynodump.so cd ../dynodump && $(RECURSIVE_MAKE) #endif /* DYNODUMP */ -${libsrc}DOC: temacs update-elc.stamp +${libsrc}DOC: ${EXE_TARGET} update-elc.stamp $(RM) ${libsrc}DOC; \ - ${DUMPENV} ./temacs -batch -l ${srcdir}/../lisp/make-docfile.el -- \ + ${DUMPENV} ./${EXE_TARGET} -nd -batch -l ${srcdir}/../lisp/make-docfile.el -- \ -o ${libsrc}DOC -d ${srcdir} -i ${libsrc}../site-packages \ ${obj_src} ${mallocdocsrc} ${rallocdocsrc} dump_elcs: dump-elcs -dump-elcs: temacs - -${DUMPENV} ./temacs -batch -l ${srcdir}/../lisp/update-elc.el +dump-elcs: ${EXE_TARGET} + -${DUMPENV} ./${EXE_TARGET} -nd -batch -l ${srcdir}/../lisp/update-elc.el all-elc all-elcs: cd .. && $(RECURSIVE_MAKE) all-elc @@ -416,6 +425,9 @@ ${libsrc}make-po: #endif /* I18N3 */ +${libsrc}make-dump-id: + cd ${libsrc} && $(RECURSIVE_MAKE) make-dump-id + ${libsrc}make-docfile: cd ${libsrc} && $(RECURSIVE_MAKE) make-docfile @@ -429,23 +441,26 @@ lint: $(LINTFILES) $(LINT.c) $(LINTFILES) ## end of Lint Section -temacs_deps=\ +link_deps=\ $(start_files) ${objs} ${otherobjs}\ $(lwlib_deps) $(dynodump_deps) +temacs_deps=\ + $(link_deps) $(ID_FILE) + temacs_link_args=\ - ${start_flags} ${ldflags}\ - -o $@ ${start_files} ${objs} ${otherobjs} ${LIBES} + ${start_flags} ${ldflags} -I${srcdir} \ + -o $@ ${start_files} ${objs} ${otherobjs} ${ID_FILE} ${LIBES} -temacs: $(temacs_deps) +${EXE_TARGET}: $(temacs_deps) $(LD) $(temacs_link_args) -#ifdef PDUMP - @$(RM) xemacs.dmp -#endif + +dump-id.c: ${libsrc}make-dump-id ${link_deps} + ${libsrc}make-dump-id .PHONY : run-temacs -run-temacs: temacs +run-temacs: ${EXE_TARGET} -${run_temacs} ## We have automated tests!! @@ -470,8 +485,8 @@ rtc_patch.o: rtc_patch_area -o $@ rtcmacs: $(temacs_deps) rtc_patch.o - $(RM) temacs; $(RECURSIVE_MAKE) temacs RTC_patch_objs=rtc_patch.o - mv temacs rtcmacs + $(RM) ${EXE_TARGET}; $(RECURSIVE_MAKE) ${EXE_TARGET} RTC_patch_objs=rtc_patch.o + mv ${EXE_TARGET} rtcmacs .PHONY: run-rtcmacs run-rtcmacs: rtcmacs @@ -484,7 +499,7 @@ run-rtcmacs: rtcmacs runargs -batch -l ${srcdir}/../lisp/loadup.el run-temacs -q; \ run' rtcmacs -debug-temacs: temacs +debug-temacs: ${EXE_TARGET} -${debug_temacs} ## Purify, Quantify, PureCoverage are software quality products from @@ -502,7 +517,7 @@ PURIFY_FLAGS =\ PURIFY_LIBS = -lpthread puremacs: $(temacs_deps) $(PURIFY_PROG) $(PURIFY_FLAGS) $(LD) $(temacs_link_args) $(PURIFY_LIBS) - cp $@ temacs + cp $@ ${EXE_TARGET} ## Quantify #ifdef QUANTIFY @@ -514,7 +529,7 @@ temacs_link_args += $(QUANTIFY_HOME)/quantify_stubs.a quantmacs: $(temacs_deps) $(QUANTIFY_PROG) $(QUANTIFY_FLAGS) $(LD) $(temacs_link_args) - cp $@ temacs + cp $@ ${EXE_TARGET} #endif /* QUANTIFY */ diff --git a/src/console-msw.c b/src/console-msw.c index 8d15ccc..0eb61e1 100644 --- a/src/console-msw.c +++ b/src/console-msw.c @@ -1,5 +1,5 @@ /* Console functions for mswindows. - Copyright (C) 1996 Ben Wing. + Copyright (C) 1996, 2000 Ben Wing. This file is part of XEmacs. @@ -28,6 +28,8 @@ Boston, MA 02111-1307, USA. */ #include #include "lisp.h" +#include "events.h" +#include "opaque.h" #include "console-msw.h" @@ -44,6 +46,69 @@ mswindows_initially_selected_for_input (struct console *con) return 1; } +static HWND msw_console_hwnd = 0; + +#define KLUDGE_BUFSIZE 1024 /* buffer size for console window titles */ + +/* Direct from the horse's mouth: Microsoft KB article Q124103 */ +static HWND +GetConsoleHwnd (void) +{ + HWND hwndFound; /* this is what is returned to the caller */ + char pszNewWindowTitle[KLUDGE_BUFSIZE]; /* contains fabricated WindowTitle */ + char pszOldWindowTitle[KLUDGE_BUFSIZE]; /* contains original WindowTitle */ + + /* fetch current window title */ + + GetConsoleTitle(pszOldWindowTitle, KLUDGE_BUFSIZE); + + /* format a "unique" NewWindowTitle */ + + wsprintf(pszNewWindowTitle,"%d/%d", + GetTickCount(), + GetCurrentProcessId()); + + /* change current window title */ + + SetConsoleTitle(pszNewWindowTitle); + + /* ensure window title has been updated */ + + Sleep(40); + + /* look for NewWindowTitle */ + + hwndFound=FindWindow(NULL, pszNewWindowTitle); + + /* restore original window title */ + + SetConsoleTitle(pszOldWindowTitle); + + return(hwndFound); +} + +HWND +msw_get_console_hwnd (void) +{ + if (!msw_console_hwnd) + msw_console_hwnd = GetConsoleHwnd (); + return msw_console_hwnd; +} + +int +msw_ensure_console_allocated (void) +{ + HWND fgwin = GetForegroundWindow (); + /* stupid mswin api won't let you create the console window + hidden! creating it changes the focus! fuck me! */ + if (AllocConsole ()) + { + SetForegroundWindow (fgwin); + return 1; + } + return 0; +} + static Lisp_Object mswindows_canonicalize_console_connection (Lisp_Object connection, Error_behavior errb) @@ -71,51 +136,70 @@ mswindows_canonicalize_device_connection (Lisp_Object connection, return mswindows_canonicalize_console_connection (connection, errb); } - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - void -syms_of_console_mswindows (void) +msw_hide_console (void) { + ShowWindow (msw_get_console_hwnd (), SW_HIDE); } void -console_type_create_mswindows (void) +msw_show_console (void) { - INITIALIZE_CONSOLE_TYPE (mswindows, "mswindows", "console-mswindows-p"); + HWND hwnd = msw_get_console_hwnd (); + ShowWindow (hwnd, SW_SHOWNA); + + /* I tried to raise the window to the top without activating + it, but this fails. Apparently Windows just doesn't like + having the active window not be on top. So instead, we + at least put it just below our own window, where part of it + will likely be seen. */ + SetWindowPos (hwnd, GetForegroundWindow (), 0, 0, 0, 0, + SWP_NOSIZE | SWP_NOMOVE | SWP_NOSENDCHANGING | + SWP_NOACTIVATE); +} - /* console methods */ -/* CONSOLE_HAS_METHOD (mswindows, init_console); */ -/* CONSOLE_HAS_METHOD (mswindows, mark_console); */ - CONSOLE_HAS_METHOD (mswindows, initially_selected_for_input); -/* CONSOLE_HAS_METHOD (mswindows, delete_console); */ - CONSOLE_HAS_METHOD (mswindows, canonicalize_console_connection); - CONSOLE_HAS_METHOD (mswindows, canonicalize_device_connection); -/* CONSOLE_HAS_METHOD (mswindows, semi_canonicalize_console_connection); */ -/* CONSOLE_HAS_METHOD (mswindows, semi_canonicalize_device_connection); */ +static int msw_console_buffered = 0; +HANDLE msw_console_buffer; - INITIALIZE_CONSOLE_TYPE (msprinter, "msprinter", "console-msprinter-p"); +static void +msw_ensure_console_buffered (void) +{ + if (!msw_console_buffered) + { + COORD new_size; + + new_size.X = 80; + new_size.Y = 1000; + msw_ensure_console_allocated (); + msw_console_buffer = + CreateConsoleScreenBuffer (GENERIC_WRITE, 0, NULL, + CONSOLE_TEXTMODE_BUFFER, NULL); + SetConsoleScreenBufferSize (msw_console_buffer, new_size); + SetConsoleActiveScreenBuffer (msw_console_buffer); + msw_console_buffered = 1; + } } -void -reinit_console_type_create_mswindows (void) +int +msw_output_console_string (CONST Extbyte *str, Extcount len) { - REINITIALIZE_CONSOLE_TYPE (mswindows); - REINITIALIZE_CONSOLE_TYPE (msprinter); + DWORD num_written; + + msw_ensure_console_buffered (); + msw_show_console (); + return WriteConsole (msw_console_buffer, str, len, &num_written, NULL); } -void -vars_of_console_mswindows (void) +/* Determine if running on Windows 9x and not NT */ +int +msw_windows9x_p (void) { - Fprovide (Qmswindows); + return GetVersion () & 0x80000000; } #ifdef DEBUG_XEMACS -#include "events.h" -#include "opaque.h" + /* * Random helper functions for debugging. * Intended for use in the MSVC "Watch" window which doesn't like @@ -176,3 +260,45 @@ DSYMNAME (Lisp_Object obj) } #endif /* DEBUG_XEMACS */ + + + +/************************************************************************/ +/* initialization */ +/************************************************************************/ + +void +syms_of_console_mswindows (void) +{ +} + +void +console_type_create_mswindows (void) +{ + INITIALIZE_CONSOLE_TYPE (mswindows, "mswindows", "console-mswindows-p"); + + /* console methods */ +/* CONSOLE_HAS_METHOD (mswindows, init_console); */ +/* CONSOLE_HAS_METHOD (mswindows, mark_console); */ + CONSOLE_HAS_METHOD (mswindows, initially_selected_for_input); +/* CONSOLE_HAS_METHOD (mswindows, delete_console); */ + CONSOLE_HAS_METHOD (mswindows, canonicalize_console_connection); + CONSOLE_HAS_METHOD (mswindows, canonicalize_device_connection); +/* CONSOLE_HAS_METHOD (mswindows, semi_canonicalize_console_connection); */ +/* CONSOLE_HAS_METHOD (mswindows, semi_canonicalize_device_connection); */ + + INITIALIZE_CONSOLE_TYPE (msprinter, "msprinter", "console-msprinter-p"); +} + +void +reinit_console_type_create_mswindows (void) +{ + REINITIALIZE_CONSOLE_TYPE (mswindows); + REINITIALIZE_CONSOLE_TYPE (msprinter); +} + +void +vars_of_console_mswindows (void) +{ + Fprovide (Qmswindows); +} diff --git a/src/console-msw.h b/src/console-msw.h index afbd3b2..1aad49f 100644 --- a/src/console-msw.h +++ b/src/console-msw.h @@ -45,22 +45,6 @@ Boston, MA 02111-1307, USA. */ #include #endif -/* - * XXX FIXME: The following X modifier defs in events-mod.h clash with win32 - * hotkey defs in winuser.h. For the moment lose the win32 versions. - * Maybe we should rename all of MOD_* to something that doesn't clash. - */ -#ifdef MOD_CONTROL -# undef MOD_CONTROL -#endif -#ifdef MOD_ALT -# undef MOD_ALT -#endif -#ifdef MOD_SHIFT -# undef MOD_SHIFT -#endif - - /* The name of the main window class */ #define XEMACS_CLASS "XEmacs" @@ -93,6 +77,7 @@ struct mswindows_device int horzsize, vertsize; /* Size in mm */ int bitspixel; Lisp_Object fontlist; /* List of strings, device fonts */ + HDC hcdc; /* Compatible DC */ }; #define DEVICE_MSWINDOWS_DATA(d) DEVICE_TYPE_DATA (d, mswindows) @@ -106,10 +91,11 @@ struct mswindows_device #define DEVICE_MSWINDOWS_VERTSIZE(d) (DEVICE_MSWINDOWS_DATA (d)->vertsize) #define DEVICE_MSWINDOWS_BITSPIXEL(d) (DEVICE_MSWINDOWS_DATA (d)->bitspixel) #define DEVICE_MSWINDOWS_FONTLIST(d) (DEVICE_MSWINDOWS_DATA (d)->fontlist) +#define DEVICE_MSWINDOWS_HCDC(d) (DEVICE_MSWINDOWS_DATA (d)->hcdc) struct msprinter_device { - HDC hdc; + HDC hdc, hcdc; /* Printer and the comp. DCs */ HANDLE hprinter; Lisp_Object fontlist; char* name; @@ -119,6 +105,7 @@ struct msprinter_device #define DEVICE_MSPRINTER_DATA(d) DEVICE_TYPE_DATA (d, msprinter) #define DEVICE_MSPRINTER_HDC(d) (DEVICE_MSPRINTER_DATA (d)->hdc) +#define DEVICE_MSPRINTER_HCDC(d) (DEVICE_MSPRINTER_DATA (d)->hcdc) #define DEVICE_MSPRINTER_HPRINTER(d) (DEVICE_MSPRINTER_DATA (d)->hprinter) #define DEVICE_MSPRINTER_FONTLIST(d) (DEVICE_MSPRINTER_DATA (d)->fontlist) #define DEVICE_MSPRINTER_NAME(d) (DEVICE_MSPRINTER_DATA (d)->name) @@ -140,6 +127,24 @@ void msprinter_apply_devmode (struct device *d, DEVMODE *devmode); /* Printer functions in frame-msw.c */ void msprinter_start_page (struct frame *f); +/* Common checks */ + +#define DEVICE_MSGDI_P(dev) (DEVICE_MSWINDOWS_P(dev) || DEVICE_MSPRINTER_P(dev)) +#define CHECK_MSGDI_DEVICE(d) \ + do { \ + CHECK_DEVICE (d); \ + if (!(DEVICEP (d) && DEVICE_MSGDI_P(XDEVICE(d)))) \ + dead_wrong_type_argument \ + (list3 (Qor, Qmswindows, Qmsprinter), d); \ + } while (0) +#define CONCHECK_MSGDI_DEVICE(d) \ + do { \ + CHECK_DEVICE (d); \ + if (!(DEVICEP (d) && DEVICE_MSGDI_P(XDEVICE(d)))) \ + wrong_type_argument \ + (list3 (Qor, Qmswindows, Qmsprinter), d); \ + } while (0) + /* * Frame */ @@ -159,9 +164,6 @@ struct mswindows_frame /* DC for this win32 window */ HDC hdc; - /* compatible DC for bitmap operations */ - HDC cdc; - /* Time of last click event, for button 2 emul */ DWORD last_click_time; @@ -196,6 +198,7 @@ struct mswindows_frame int ignore_next_lbutton_up : 1; int ignore_next_rbutton_up : 1; int sizing : 1; + int paint_pending : 1; /* Whether a WM_PAINT magic event has been queued */ /* Geometry, in characters, as specified by proplist during frame creation. Memebers are set to -1 for unspecified */ @@ -206,7 +209,6 @@ struct mswindows_frame #define FRAME_MSWINDOWS_HANDLE(f) (FRAME_MSWINDOWS_DATA (f)->hwnd) #define FRAME_MSWINDOWS_DC(f) (FRAME_MSWINDOWS_DATA (f)->hdc) -#define FRAME_MSWINDOWS_CDC(f) (FRAME_MSWINDOWS_DATA (f)->cdc) #define FRAME_MSWINDOWS_MENU_HASH_TABLE(f) (FRAME_MSWINDOWS_DATA (f)->menu_hash_table) #define FRAME_MSWINDOWS_TOOLBAR_HASH_TABLE(f) \ (FRAME_MSWINDOWS_DATA (f)->toolbar_hash_table) @@ -236,7 +238,6 @@ struct mswindows_frame struct msprinter_frame { - HDC hcdc; /* Compatoble DC */ int left_margin, top_margin, /* All in twips */ right_margin, bottom_margin; int charheight, charwidth; /* As per proplist or -1 if not gven */ @@ -250,7 +251,6 @@ struct msprinter_frame #define FRAME_MSPRINTER_RIGHT_MARGIN(f) (FRAME_MSPRINTER_DATA (f)->top_margin) #define FRAME_MSPRINTER_TOP_MARGIN(f) (FRAME_MSPRINTER_DATA (f)->right_margin) #define FRAME_MSPRINTER_BOTTOM_MARGIN(f) (FRAME_MSPRINTER_DATA (f)->bottom_margin) -#define FRAME_MSPRINTER_CDC(f) (FRAME_MSPRINTER_DATA (f)->hcdc) #define FRAME_MSPRINTER_JOB_STARTED(f) (FRAME_MSPRINTER_DATA (f)->job_started) #define FRAME_MSPRINTER_PAGE_STARTED(f) (FRAME_MSPRINTER_DATA (f)->page_started) #define FRAME_MSPRINTER_ORIENTATION(f) (FRAME_MSPRINTER_DATA (f)->orientation) @@ -293,7 +293,8 @@ extern HSZ mswindows_dde_service; extern HSZ mswindows_dde_topic_system; extern HSZ mswindows_dde_item_open; HDDEDATA CALLBACK mswindows_dde_callback (UINT uType, UINT uFmt, HCONV hconv, - HSZ hszTopic, HSZ hszItem, HDDEDATA hdata, + HSZ hszTopic, HSZ hszItem, + HDDEDATA hdata, DWORD dwData1, DWORD dwData2); void mswindows_enqueue_misc_user_event (Lisp_Object channel, @@ -301,18 +302,11 @@ void mswindows_enqueue_misc_user_event (Lisp_Object channel, Lisp_Object object); Lisp_Object mswindows_cancel_dispatch_event (Lisp_Event* event); Lisp_Object mswindows_pump_outstanding_events (void); -Lisp_Object mswindows_protect_modal_loop (Lisp_Object (*bfun) (Lisp_Object barg), +Lisp_Object mswindows_protect_modal_loop (Lisp_Object (*bfun) + (Lisp_Object barg), Lisp_Object barg); void mswindows_unmodalize_signal_maybe (void); -#ifdef HAVE_TOOLBARS -Lisp_Object -mswindows_get_toolbar_button_text ( struct frame* f, int command_id ); -Lisp_Object -mswindows_handle_toolbar_wm_command (struct frame* f, HWND ctrl, WORD id); -#endif -Lisp_Object -mswindows_handle_gui_wm_command (struct frame* f, HWND ctrl, DWORD id); COLORREF mswindows_string_to_color (const char *name); USID emacs_mswindows_create_stream_pair (void* inhandle, void* outhandle, Lisp_Object* instream, @@ -328,13 +322,29 @@ HANDLE get_nt_process_handle (Lisp_Process *p); extern Lisp_Object Vmswindows_frame_being_created; extern Lisp_Object mswindows_frame_being_created; +void msw_get_workspace_coords (RECT *rc); + +HWND msw_get_console_hwnd (void); +void msw_hide_console (void); +void msw_show_console (void); +int msw_output_console_string (CONST Extbyte *str, Extcount len); + Lisp_Object mswindows_enumerate_fonts (HDC hdc); +int msw_char_is_accelerator (struct frame *f, Emchar ch); +Bytecount msw_translate_menu_or_dialog_item (Bufbyte *item, Bytecount len, + Bytecount maxlen, Emchar *accel, + Lisp_Object error_name); + +#ifdef HAVE_TOOLBARS Lisp_Object mswindows_get_toolbar_button_text (struct frame* f, int command_id); Lisp_Object mswindows_handle_toolbar_wm_command (struct frame* f, HWND ctrl, WORD id); +#endif Lisp_Object mswindows_handle_gui_wm_command (struct frame* f, - HWND ctrl, DWORD id); + HWND ctrl, LPARAM id); + +int msw_windows9x_p (void); #endif /* INCLUDED_console_msw_h_ */ diff --git a/src/console.c b/src/console.c index 068200e..ab147bc 100644 --- a/src/console.c +++ b/src/console.c @@ -1410,11 +1410,11 @@ consoles, for example), it is set to nil. /* While this should be const it can't be because some things (i.e. edebug) do manipulate it. */ DEFVAR_CONSOLE_LOCAL ("defining-kbd-macro", defining_kbd_macro /* -Non-nil while a console macro is being defined. Don't set this! +Non-nil while a keyboard macro is being defined. Don't set this! */ ); DEFVAR_CONSOLE_LOCAL ("last-kbd-macro", last_kbd_macro /* -Last kbd macro defined, as a vector of events; nil if none defined. +Last keyboard macro defined, as a vector of events; nil if none defined. */ ); DEFVAR_CONSOLE_LOCAL ("prefix-arg", prefix_arg /* diff --git a/src/device-msw.c b/src/device-msw.c index ded93db..1734233 100644 --- a/src/device-msw.c +++ b/src/device-msw.c @@ -40,7 +40,16 @@ Boston, MA 02111-1307, USA. */ #include "frame.h" #include "sysdep.h" +#if (defined (__CYGWIN32__) || defined(__MINGW32__)) && \ + CYGWIN_VERSION_DLL_MAJOR < 21 +extern BOOL WINAPI DdeFreeStringHandle(DWORD,HSZ); +#else #include +#endif + +#if !(defined (__CYGWIN32__) || defined(__MINGW32__)) +# include /* For CoInitialize */ +#endif /* win32 DDE management library globals */ #ifdef HAVE_DRAGNDROP @@ -129,8 +138,8 @@ mswindows_init_device (struct device *d, Lisp_Object props) DEVICE_MSWINDOWS_VERTSIZE(d) = GetDeviceCaps(hdc, VERTSIZE); DEVICE_MSWINDOWS_BITSPIXEL(d) = GetDeviceCaps(hdc, BITSPIXEL); DEVICE_MSWINDOWS_FONTLIST (d) = mswindows_enumerate_fonts (hdc); - - DeleteDC (hdc); + + DEVICE_MSWINDOWS_HCDC(d) = hdc; /* Register the main window class */ wc.cbSize = sizeof (WNDCLASSEX); @@ -174,13 +183,20 @@ mswindows_finish_init_device (struct device *d, Lisp_Object props) /* Initialize DDE management library and our related globals. We execute a * dde Open("file") by simulating a drop, so this depends on dnd support. */ #ifdef HAVE_DRAGNDROP +# if !(defined(__CYGWIN32__) || defined(__MINGW32__)) + CoInitialize (NULL); +# endif + mswindows_dde_mlid = 0; DdeInitialize (&mswindows_dde_mlid, (PFNCALLBACK)mswindows_dde_callback, APPCMD_FILTERINITS|CBF_FAIL_SELFCONNECTIONS|CBF_FAIL_ADVISES| - CBF_FAIL_POKES|CBF_FAIL_REQUESTS|CBF_SKIP_ALLNOTIFICATIONS, 0); + CBF_FAIL_POKES|CBF_FAIL_REQUESTS|CBF_SKIP_ALLNOTIFICATIONS, + 0); - mswindows_dde_service = DdeCreateStringHandle (mswindows_dde_mlid, XEMACS_CLASS, 0); - mswindows_dde_topic_system = DdeCreateStringHandle (mswindows_dde_mlid, SZDDESYS_TOPIC, 0); + mswindows_dde_service = DdeCreateStringHandle (mswindows_dde_mlid, + XEMACS_CLASS, 0); + mswindows_dde_topic_system = DdeCreateStringHandle (mswindows_dde_mlid, + SZDDESYS_TOPIC, 0); mswindows_dde_item_open = DdeCreateStringHandle (mswindows_dde_mlid, TEXT(MSWINDOWS_DDE_ITEM_OPEN), 0); DdeNameService (mswindows_dde_mlid, mswindows_dde_service, 0L, DNS_REGISTER); @@ -196,11 +212,22 @@ mswindows_delete_device (struct device *d) DdeFreeStringHandle (mswindows_dde_mlid, mswindows_dde_topic_system); DdeFreeStringHandle (mswindows_dde_mlid, mswindows_dde_service); DdeUninitialize (mswindows_dde_mlid); + +# if !(defined(__CYGWIN32__) || defined(__MINGW32__)) + CoUninitialize (); +# endif #endif + DeleteDC (DEVICE_MSWINDOWS_HCDC(d)); free (d->device_data); } +void +msw_get_workspace_coords (RECT *rc) +{ + SystemParametersInfo (SPI_GETWORKAREA, 0, rc, 0); +} + static void mswindows_mark_device (struct device *d) { @@ -271,10 +298,18 @@ mswindows_device_system_metrics (struct device *d, case DM_size_workspace: { RECT rc; - SystemParametersInfo (SPI_GETWORKAREA, 0, &rc, 0); + msw_get_workspace_coords (&rc); return Fcons (make_int (rc.right - rc.left), make_int (rc.bottom - rc.top)); } + + case DM_offset_workspace: + { + RECT rc; + msw_get_workspace_coords (&rc); + return Fcons (make_int (rc.left), make_int (rc.top)); + } + /* case DM_size_toolbar: case DM_size_toolbar_button: @@ -344,8 +379,11 @@ msprinter_init_device (struct device *d, Lisp_Object props) if (DEVICE_MSPRINTER_HDC (d) == NULL) signal_open_printer_error (d); + DEVICE_MSPRINTER_HCDC(d) = + CreateCompatibleDC (DEVICE_MSPRINTER_HDC (d)); + /* Determinie DEVMODE size and store the default DEVMODE */ - DEVICE_MSPRINTER_DEVMODE_SIZE(d) = + DEVICE_MSPRINTER_DEVMODE_SIZE(d) = DocumentProperties (NULL, DEVICE_MSPRINTER_HPRINTER(d), printer_name, NULL, NULL, 0); if (DEVICE_MSPRINTER_DEVMODE_SIZE(d) <= 0) @@ -411,6 +449,8 @@ msprinter_delete_device (struct device *d) ClosePrinter (DEVICE_MSPRINTER_HPRINTER (d)); if (DEVICE_MSPRINTER_HDC (d)) DeleteDC (DEVICE_MSPRINTER_HDC (d)); + if (DEVICE_MSPRINTER_HCDC (d)) + DeleteDC (DEVICE_MSPRINTER_HCDC (d)); if (DEVICE_MSPRINTER_NAME (d)) free (DEVICE_MSPRINTER_NAME (d)); if (DEVICE_MSPRINTER_DEVMODE (d)) @@ -481,7 +521,15 @@ msprinter_apply_devmode (struct device *d, DEVMODE *devmode) devmode, devmode, DM_IN_BUFFER | DM_OUT_BUFFER); - ResetDC (DEVICE_MSPRINTER_HDC (d), devmode); + /* #### ResetDC fails sometimes, Bill only know s why. + The solution below looks more like a workaround to me, + although it might be fine. --kkm */ + if (ResetDC (DEVICE_MSPRINTER_HDC (d), devmode) == NULL) + { + DeleteDC (DEVICE_MSPRINTER_HDC (d)); + DEVICE_MSPRINTER_HDC (d) = + CreateDC ("WINSPOOL", DEVICE_MSPRINTER_NAME(d), NULL, devmode); + } } diff --git a/src/device.c b/src/device.c index 25aa688..5d6ebd9 100644 --- a/src/device.c +++ b/src/device.c @@ -891,6 +891,7 @@ behavior cannot necessarily be determined automatically. MARK_FRAME_GLYPHS_CHANGED (f); MARK_FRAME_SUBWINDOWS_CHANGED (f); MARK_FRAME_TOOLBARS_CHANGED (f); + MARK_FRAME_GUTTERS_CHANGED (f); f->menubar_changed = 1; } } @@ -990,7 +991,7 @@ size-workspace Workspace size in pixels. This can be less than or decorations. For printers, this is the size of printable area. offset-workspace Offset of workspace area from the top left corner - of screen or paper. + of screen or paper, in pixels. size-device-mm Device screen size in millimeters. device-dpi Device resolution, in dots per inch. num-bit-planes Integer, number of device bit planes. diff --git a/src/device.h b/src/device.h index a95c3df..d33b1ea 100644 --- a/src/device.h +++ b/src/device.h @@ -238,9 +238,9 @@ DECLARE_LRECORD (device, struct device); #define DEVICE_TYPE_P(d, type) EQ (DEVICE_TYPE (d), Q##type) #ifdef ERROR_CHECK_TYPECHECK -INLINE struct device * +INLINE_HEADER struct device * error_check_device_type (struct device *d, Lisp_Object sym); -INLINE struct device * +INLINE_HEADER struct device * error_check_device_type (struct device *d, Lisp_Object sym) { assert (EQ (DEVICE_TYPE (d), sym)); diff --git a/src/dialog-msw.c b/src/dialog-msw.c index 279cd36..c1f3251 100644 --- a/src/dialog-msw.c +++ b/src/dialog-msw.c @@ -168,6 +168,25 @@ push_lisp_string_as_unicode (unsigned_char_dynarr* dynarr, Lisp_Object string) Dynarr_add_many (dynarr, uni_string, sizeof(WCHAR) * length); } +/* Helper function which converts the supplied string STRING into Unicode and + pushes it at the end of DYNARR */ +static void +push_bufbyte_string_as_unicode (unsigned_char_dynarr* dynarr, Bufbyte *string, + Bytecount len) +{ + Extbyte *mbcs_string; + Charcount length = bytecount_to_charcount (string, len); + LPWSTR uni_string; + + TO_EXTERNAL_FORMAT (C_STRING, string, + C_STRING_ALLOCA, mbcs_string, + Qnative); + uni_string = alloca_array (WCHAR, length + 1); + length = MultiByteToWideChar (CP_ACP, 0, mbcs_string, -1, + uni_string, sizeof(WCHAR) * (length + 1)); + Dynarr_add_many (dynarr, uni_string, sizeof(WCHAR) * length); +} + /* Given button TEXT, return button width in DLU */ static unsigned int button_width (Lisp_Object text) @@ -362,7 +381,21 @@ mswindows_popup_dialog_box (struct frame* f, Lisp_Object desc) Dynarr_add_many (template, &button_class_id, sizeof (button_class_id)); /* Next thing to add is control text, as Unicode string */ - push_lisp_string_as_unicode (template, pgui_item->name); + { + Lisp_Object ctext = pgui_item->name; + Emchar accel_unused; + Bufbyte *trans = (Bufbyte *) alloca (2 * XSTRING_LENGTH (ctext) + 3); + Bytecount translen; + + memcpy (trans, XSTRING_DATA (ctext), XSTRING_LENGTH (ctext) + 1); + translen = + msw_translate_menu_or_dialog_item (trans, + XSTRING_LENGTH (ctext), + 2 * XSTRING_LENGTH (ctext) + 3, + &accel_unused, + ctext); + push_bufbyte_string_as_unicode (template, trans, translen); + } /* Specify 0 length creation data. */ Dynarr_add_many (template, &zeroes, 2); @@ -385,7 +418,8 @@ mswindows_popup_dialog_box (struct frame* f, Lisp_Object desc) vector = make_vector (Dynarr_length (dialog_items), Qunbound); dialog_data = Fcons (frame, vector); for (i = 0; i < Dynarr_length (dialog_items); i++) - XVECTOR_DATA (vector) [i] = XGUI_ITEM (*Dynarr_atp (dialog_items, i))->callback; + XVECTOR_DATA (vector) [i] = + XGUI_ITEM (*Dynarr_atp (dialog_items, i))->callback; /* Woof! Everything is ready. Pop pop pop in now! */ if (!CreateDialogIndirectParam (NULL, diff --git a/src/dialog.c b/src/dialog.c index 0f0af99..4ce48a6 100644 --- a/src/dialog.c +++ b/src/dialog.c @@ -21,9 +21,6 @@ Boston, MA 02111-1307, USA. */ /* Synched up with: Not in FSF. */ -/* #### There ain't nothin' here because dialog boxes have not been - properly abstracted yet. */ - #include #include "lisp.h" #include "frame.h" @@ -48,6 +45,11 @@ The name is the string to display on the button; it is filtered through the resource database, so it is possible for resources to override what string is actually displayed. +Accelerators can be indicated in the string by putting the sequence +"%_" before the character corresponding to the key that will invoke +the button. Uppercase and lowercase accelerators are equivalent. The +sequence "%%" is also special, and is translated into a single %. + If the `callback' of a button is a symbol, then it must name a command. It will be invoked with `call-interactively'. If it is a list, then it is evaluated with `eval'. @@ -57,8 +59,7 @@ following buttons should be flushright instead of flushleft. Though the keyword/value syntax is supported for dialog boxes just as in popup menus, the only keyword which is both meaningful and fully implemented -for dialog box buttons is `:active'. -*/ +for dialog box buttons is `:active'. */ (dbox_desc)) { struct frame *f = selected_frame (); @@ -72,7 +73,8 @@ for dialog box buttons is `:active'. CHECK_CONS (dbox_desc); CHECK_STRING (XCAR (dbox_desc)); if (!CONSP (XCDR (dbox_desc))) - signal_simple_error ("Dialog descriptor must supply at least one button", dbox_desc); + signal_simple_error ("Dialog descriptor must supply at least one button", + dbox_desc); DEVMETH (d, popup_dialog_box, (f, dbox_desc)); diff --git a/src/dired.c b/src/dired.c index c987db2..3f992ee 100644 --- a/src/dired.c +++ b/src/dired.c @@ -23,16 +23,16 @@ Boston, MA 02111-1307, USA. */ #include #include "lisp.h" -#include "buffer.h" -#include "commands.h" -#include "elhash.h" -#include "regex.h" -#include "opaque.h" #include "sysfile.h" #include "sysdir.h" #include "systime.h" #include "sysdep.h" #include "syspwd.h" +#include "buffer.h" +#include "commands.h" +#include "elhash.h" +#include "regex.h" +#include "opaque.h" Lisp_Object Vcompletion_ignored_extensions; Lisp_Object Qdirectory_files; diff --git a/src/editfns.c b/src/editfns.c index 61ceb1f..a4ee746 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -822,10 +822,18 @@ uncache_home_directory (void) of a few bytes */ } +/* !!#### not Mule correct. */ + /* Returns the home directory, in external format */ Extbyte * get_home_directory (void) { + /* !!#### this is hopelessly bogus. Rule #1: Do not make any assumptions + about what format an external string is in. Could be Unicode, for all + we know, and then all the operations below are totally bogus. + Instead, convert all data to internal format *right* at the juncture + between XEmacs and the outside world, the very moment we first get + the data. --ben */ int output_home_warning = 0; if (cached_home_directory == NULL) @@ -847,7 +855,9 @@ get_home_directory (void) } else { -# if 1 +# if 0 /* changed by ben. This behavior absolutely stinks, and the + possibility being addressed here occurs quite commonly. + Using the current directory makes absolutely no sense. */ /* * Use the current directory. * This preserves the existing XEmacs behavior, but is different diff --git a/src/eldap.c b/src/eldap.c index 99c5d53..68b63e7 100644 --- a/src/eldap.c +++ b/src/eldap.c @@ -417,7 +417,7 @@ entry according to the value of WITHDN. LDAPMessage *e; BerElement *ptr; char *a, *dn; - int i, rc, rc2; + int i, rc; int matches; struct ldap_unwind_struct unwind; @@ -426,10 +426,11 @@ entry according to the value of WITHDN. int speccount = specpdl_depth (); - Lisp_Object list, entry, result; + Lisp_Object list = Qnil; + Lisp_Object entry = Qnil; + Lisp_Object result = Qnil; struct gcpro gcpro1, gcpro2, gcpro3; - list = entry = result = Qnil; GCPRO3 (list, entry, result); unwind.res = NULL; @@ -489,9 +490,9 @@ entry according to the value of WITHDN. /* Perform the search */ if (ldap_search (ld, - NILP (base) ? "" : (char *) XSTRING_DATA (base), + NILP (base) ? (char *) "" : (char *) XSTRING_DATA (base), ldap_scope, - NILP (filter) ? "" : (char *) XSTRING_DATA (filter), + NILP (filter) ? (char *) "" : (char *) XSTRING_DATA (filter), ldap_attributes, NILP (attrsonly) ? 0 : 1) == -1) @@ -538,7 +539,7 @@ entry according to the value of WITHDN. { for (i = 0; unwind.vals[i] != NULL; i++) { - list = Fcons (make_ext_string (unwind.vals[i]->bv_val, + list = Fcons (make_ext_string ((Extbyte *) unwind.vals[i]->bv_val, unwind.vals[i]->bv_len, Qnative), list); @@ -558,11 +559,13 @@ entry according to the value of WITHDN. } #if defined HAVE_LDAP_PARSE_RESULT - rc2 = ldap_parse_result (ld, unwind.res, - &rc, - NULL, NULL, NULL, NULL, 0); - if (rc2 != LDAP_SUCCESS) - rc = rc2; + { + int rc2 = ldap_parse_result (ld, unwind.res, + &rc, + NULL, NULL, NULL, NULL, 0); + if (rc2 != LDAP_SUCCESS) + rc = rc2; + } #else if (rc == 0) signal_ldap_error (ld, NULL, LDAP_TIMELIMIT_EXCEEDED); @@ -604,9 +607,12 @@ containing attribute/value string pairs. struct berval *bervals; int rc; int i, j; + size_t len; - Lisp_Object current, values; + Lisp_Object current = Qnil; + Lisp_Object values = Qnil; struct gcpro gcpro1, gcpro2; + GCPRO2 (current, values); /* Do all the parameter checking */ @@ -622,8 +628,9 @@ containing attribute/value string pairs. signal_simple_error ("Cannot add void entry", entry); /* Build the ldap_mods array */ - ldap_mods = alloca_array (LDAPMod, XINT (Flength (entry))); - ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + XINT (Flength (entry))); + len = XINT (Flength (entry)); + ldap_mods = alloca_array (LDAPMod, len); + ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + len); i = 0; EXTERNAL_LIST_LOOP (entry, entry) { @@ -638,10 +645,10 @@ containing attribute/value string pairs. values = XCDR (current); if (CONSP (values)) { - bervals = - alloca_array (struct berval, XINT (Flength (values))); + len = XINT (Flength (values)); + bervals = alloca_array (struct berval, len); ldap_mods[i].mod_vals.modv_bvals = - alloca_array (struct berval *, 1 + XINT (Flength (values))); + alloca_array (struct berval *, 1 + len); j = 0; EXTERNAL_LIST_LOOP (values, values) { @@ -676,6 +683,7 @@ containing attribute/value string pairs. signal_ldap_error (ld, NULL, rc); UNGCPRO; + return Qnil; } DEFUN ("ldap-modify", Fldap_modify, 3, 3, 0, /* @@ -686,7 +694,7 @@ MODS is a list of modifications to apply. A modification is a list of the form (MOD-OP ATTR VALUE1 VALUE2 ...) MOD-OP and ATTR are mandatory, VALUEs are optional depending on MOD-OP. MOD-OP is the type of modification, one of the symbols `add', `delete' -or `replace'. ATTR is the LDAP attribute type to modify +or `replace'. ATTR is the LDAP attribute type to modify. */ (ldap, dn, mods)) { @@ -694,8 +702,11 @@ or `replace'. ATTR is the LDAP attribute type to modify LDAPMod *ldap_mods, **ldap_mods_ptrs; struct berval *bervals; int i, j, rc; + Lisp_Object mod_op; + size_t len; - Lisp_Object current, mod_op, values; + Lisp_Object current = Qnil; + Lisp_Object values = Qnil; struct gcpro gcpro1, gcpro2; GCPRO2 (current, values); @@ -713,8 +724,9 @@ or `replace'. ATTR is the LDAP attribute type to modify return Qnil; /* Build the ldap_mods array */ - ldap_mods = alloca_array (LDAPMod, XINT (Flength (mods))); - ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + XINT (Flength (mods))); + len = XINT (Flength (mods)); + ldap_mods = alloca_array (LDAPMod, len); + ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + len); i = 0; EXTERNAL_LIST_LOOP (mods, mods) { @@ -738,9 +750,10 @@ or `replace'. ATTR is the LDAP attribute type to modify C_STRING_ALLOCA, ldap_mods[i].mod_type, Qnative); values = XCDR (current); - bervals = alloca_array (struct berval, XINT (Flength (values))); + len = XINT (Flength (values)); + bervals = alloca_array (struct berval, len); ldap_mods[i].mod_vals.modv_bvals = - alloca_array (struct berval *, 1 + XINT (Flength (values))); + alloca_array (struct berval *, 1 + len); j = 0; EXTERNAL_LIST_LOOP (values, values) { @@ -762,6 +775,7 @@ or `replace'. ATTR is the LDAP attribute type to modify signal_ldap_error (ld, NULL, rc); UNGCPRO; + return Qnil; } @@ -783,6 +797,8 @@ DN is the distinguished name of the entry to delete. rc = ldap_delete_s (ld, (char *) XSTRING_DATA (dn)); if (rc != LDAP_SUCCESS) signal_ldap_error (ld, NULL, rc); + + return Qnil; } void diff --git a/src/elhash.c b/src/elhash.c index 52ba848..688018c 100644 --- a/src/elhash.c +++ b/src/elhash.c @@ -1218,6 +1218,15 @@ elisp_map_remhash (maphash_function_t predicate, /************************************************************************/ /* garbage collecting weak hash tables */ /************************************************************************/ +#define MARK_OBJ(obj) do { \ + Lisp_Object mo_obj = (obj); \ + if (!marked_p (mo_obj)) \ + { \ + mark_object (mo_obj); \ + did_mark = 1; \ + } \ +} while (0) + /* Complete the marking for semi-weak hash tables. */ int @@ -1241,9 +1250,6 @@ finish_marking_weak_hash_tables (void) /* Now, scan over all the pairs. For all pairs that are half-marked, we may need to mark the other half if we're keeping this pair. */ -#define MARK_OBJ(obj) \ -do { if (!marked_p (obj)) mark_object (obj), did_mark = 1; } while (0) - switch (ht->weakness) { case HASH_TABLE_KEY_WEAK: diff --git a/src/eval.c b/src/eval.c index 426cda1..4e9cbc4 100644 --- a/src/eval.c +++ b/src/eval.c @@ -267,10 +267,16 @@ Lisp_Object Vdebugger; static Lisp_Object Vcondition_handlers; -#if 0 /* no longer used */ +#define DEFEND_AGAINST_THROW_RECURSION + +#ifdef DEFEND_AGAINST_THROW_RECURSION /* Used for error catching purposes by throw_or_bomb_out */ static int throw_level; -#endif /* unused */ +#endif + +#ifdef ERROR_CHECK_TYPECHECK +void check_error_state_sanity (void); +#endif /************************************************************************/ @@ -1304,6 +1310,9 @@ internal_catch (Lisp_Object tag, c.val = (*func) (arg); if (threw) *threw = 0; catchlist = c.next; +#ifdef ERROR_CHECK_TYPECHECK + check_error_state_sanity (); +#endif return c.val; } @@ -1360,19 +1369,25 @@ unwind_to_catch (struct catchtag *c, Lisp_Object val) unbind_to (catchlist->pdlcount, Qnil); handlerlist = catchlist->handlerlist; catchlist = catchlist->next; +#ifdef ERROR_CHECK_TYPECHECK + check_error_state_sanity (); +#endif } while (! last_time); #else /* Actual XEmacs code */ /* Unwind the specpdl stack */ unbind_to (c->pdlcount, Qnil); catchlist = c->next; +#ifdef ERROR_CHECK_TYPECHECK + check_error_state_sanity (); +#endif #endif gcprolist = c->gcpro; backtrace_list = c->backlist; lisp_eval_depth = c->lisp_eval_depth; -#if 0 /* no longer used */ +#ifdef DEFEND_AGAINST_THROW_RECURSION throw_level = 0; #endif LONGJMP (c->jmp, 1); @@ -1382,7 +1397,7 @@ static DOESNT_RETURN throw_or_bomb_out (Lisp_Object tag, Lisp_Object val, int bomb_out_p, Lisp_Object sig, Lisp_Object data) { -#if 0 +#ifdef DEFEND_AGAINST_THROW_RECURSION /* die if we recurse more than is reasonable */ if (++throw_level > 20) abort(); @@ -1635,6 +1650,9 @@ condition_case_1 (Lisp_Object handlers, have this code here, and it doesn't cost anything, so I'm leaving it.*/ UNGCPRO; catchlist = c.next; +#ifdef ERROR_CHECK_TYPECHECK + check_error_state_sanity (); +#endif Vcondition_handlers = XCDR (c.tag); return unbind_to (speccount, c.val); @@ -1851,6 +1869,8 @@ signal_1 (Lisp_Object sig, Lisp_Object data) { /* who knows how much has been initialized? Safest bet is just to bomb out immediately. */ + /* let's not use stderr_out() here, because that does a bunch of + things that might not be safe yet. */ fprintf (stderr, "Error before initialization is complete!\n"); abort (); } @@ -2036,16 +2056,25 @@ signal_error (Lisp_Object sig, Lisp_Object data) for (;;) Fsignal (sig, data); } - -static Lisp_Object -call_with_suspended_errors_1 (Lisp_Object opaque_arg) +#ifdef ERROR_CHECK_TYPECHECK +void +check_error_state_sanity (void) { - Lisp_Object val; - Lisp_Object *kludgy_args = (Lisp_Object *) get_opaque_ptr (opaque_arg); - PRIMITIVE_FUNCALL (val, get_opaque_ptr (kludgy_args[0]), - kludgy_args + 2, XINT (kludgy_args[1])); - return val; + struct catchtag *c; + int found_error_tag = 0; + + for (c = catchlist; c; c = c->next) + { + if (EQ (c->tag, Qunbound_suspended_errors_tag)) + { + found_error_tag = 1; + break; + } + } + + assert (found_error_tag || NILP (Vcurrent_error_state)); } +#endif static Lisp_Object restore_current_warning_class (Lisp_Object warning_class) @@ -2061,6 +2090,25 @@ restore_current_error_state (Lisp_Object error_state) return Qnil; } +static Lisp_Object +call_with_suspended_errors_1 (Lisp_Object opaque_arg) +{ + Lisp_Object val; + Lisp_Object *kludgy_args = (Lisp_Object *) get_opaque_ptr (opaque_arg); + Lisp_Object no_error = kludgy_args[2]; + int speccount = specpdl_depth (); + + if (!EQ (Vcurrent_error_state, no_error)) + { + record_unwind_protect (restore_current_error_state, + Vcurrent_error_state); + Vcurrent_error_state = no_error; + } + PRIMITIVE_FUNCALL (val, get_opaque_ptr (kludgy_args[0]), + kludgy_args + 3, XINT (kludgy_args[1])); + return unbind_to (speccount, val); +} + /* Many functions would like to do one of three things if an error occurs: @@ -2083,8 +2131,8 @@ call_with_suspended_errors (lisp_fn_t fun, volatile Lisp_Object retval, { va_list vargs; int speccount; - Lisp_Object kludgy_args[22]; - Lisp_Object *args = kludgy_args + 2; + Lisp_Object kludgy_args[23]; + Lisp_Object *args = kludgy_args + 3; int i; Lisp_Object no_error; @@ -2126,7 +2174,7 @@ call_with_suspended_errors (lisp_fn_t fun, volatile Lisp_Object retval, return val; } - speccount = specpdl_depth(); + speccount = specpdl_depth (); if (NILP (class) || NILP (Vcurrent_warning_class)) { /* If we're currently calling for no warnings, then make it so. @@ -2137,12 +2185,6 @@ call_with_suspended_errors (lisp_fn_t fun, volatile Lisp_Object retval, Vcurrent_warning_class); Vcurrent_warning_class = class; } - if (!EQ (Vcurrent_error_state, no_error)) - { - record_unwind_protect (restore_current_error_state, - Vcurrent_error_state); - Vcurrent_error_state = no_error; - } { int threw; @@ -2154,6 +2196,7 @@ call_with_suspended_errors (lisp_fn_t fun, volatile Lisp_Object retval, GCPRO2 (opaque1, opaque2); kludgy_args[0] = opaque2; kludgy_args[1] = make_int (nargs); + kludgy_args[2] = no_error; the_retval = internal_catch (Qunbound_suspended_errors_tag, call_with_suspended_errors_1, opaque1, &threw); @@ -5057,7 +5100,7 @@ reinit_vars_of_eval (void) /* XEmacs change: increase these values. */ max_specpdl_size = 3000; max_lisp_eval_depth = 500; -#if 0 /* no longer used */ +#ifdef DEFEND_AGAINST_THROW_RECURSION throw_level = 0; #endif } diff --git a/src/event-Xt.c b/src/event-Xt.c index cb0115f..f984949 100644 --- a/src/event-Xt.c +++ b/src/event-Xt.c @@ -65,16 +65,6 @@ Boston, MA 02111-1307, USA. */ #include "offix.h" #endif -#ifdef WINDOWSNT -/* Hmm, under unix we want X modifiers, under NT we want X modifiers if - we are running X and Windows modifiers otherwise. - gak. This is a kludge until we support multiple native GUIs! -*/ -#undef MOD_ALT -#undef MOD_CONTROL -#undef MOD_SHIFT -#endif - #include "events-mod.h" static void enqueue_Xt_dispatch_event (Lisp_Object event); @@ -1124,7 +1114,7 @@ x_event_to_emacs_event (XEvent *x_event, Lisp_Event *emacs_event) case ButtonPress: case ButtonRelease: { - unsigned int modifiers = 0; + int modifiers = 0; int shift_p, lock_p; Bool key_event_p = (x_event->type == KeyPress); unsigned int *state = @@ -1151,11 +1141,11 @@ x_event_to_emacs_event (XEvent *x_event, Lisp_Event *emacs_event) x_handle_sticky_modifiers (x_event, d); - if (*state & ControlMask) modifiers |= MOD_CONTROL; - if (*state & xd->MetaMask) modifiers |= MOD_META; - if (*state & xd->SuperMask) modifiers |= MOD_SUPER; - if (*state & xd->HyperMask) modifiers |= MOD_HYPER; - if (*state & xd->AltMask) modifiers |= MOD_ALT; + if (*state & ControlMask) modifiers |= XEMACS_MOD_CONTROL; + if (*state & xd->MetaMask) modifiers |= XEMACS_MOD_META; + if (*state & xd->SuperMask) modifiers |= XEMACS_MOD_SUPER; + if (*state & xd->HyperMask) modifiers |= XEMACS_MOD_HYPER; + if (*state & xd->AltMask) modifiers |= XEMACS_MOD_ALT; /* Ignore the Caps_Lock key if: - any other modifiers are down, so that Caps_Lock doesn't @@ -1168,7 +1158,7 @@ x_event_to_emacs_event (XEvent *x_event, Lisp_Event *emacs_event) lock_p = *state & LockMask; if (shift_p || lock_p) - modifiers |= MOD_SHIFT; + modifiers |= XEMACS_MOD_SHIFT; if (key_event_p) { @@ -1200,7 +1190,7 @@ x_event_to_emacs_event (XEvent *x_event, Lisp_Event *emacs_event) ! (CHAR_OR_CHAR_INTP (keysym) && keysym_obeys_caps_lock_p ((KeySym) XCHAR_OR_CHAR_INT (keysym), d))) - modifiers &= (~MOD_SHIFT); + modifiers &= (~XEMACS_MOD_SHIFT); /* If this key contains two distinct keysyms, that is, "shift" generates a different keysym than the @@ -1212,13 +1202,13 @@ x_event_to_emacs_event (XEvent *x_event, Lisp_Event *emacs_event) in the modifiers slot. Neither the characters "a", "A", "2", nor "@" normally have the shift bit set. However, "F1" normally does. */ - if (modifiers & MOD_SHIFT) + if (modifiers & XEMACS_MOD_SHIFT) { int Mode_switch_p = *state & xd->ModeMask; KeySym bot = XLookupKeysym (ev, Mode_switch_p ? 2 : 0); KeySym top = XLookupKeysym (ev, Mode_switch_p ? 3 : 1); if (top && bot && top != bot) - modifiers &= ~MOD_SHIFT; + modifiers &= ~XEMACS_MOD_SHIFT; } emacs_event->event_type = key_press_event; emacs_event->timestamp = ev->time; @@ -1255,7 +1245,7 @@ x_event_to_emacs_event (XEvent *x_event, Lisp_Event *emacs_event) { XMotionEvent *ev = &x_event->xmotion; struct frame *frame = x_window_to_frame (d, ev->window); - unsigned int modifiers = 0; + int modifiers = 0; XMotionEvent event2; if (! frame) @@ -1284,12 +1274,12 @@ x_event_to_emacs_event (XEvent *x_event, Lisp_Event *emacs_event) emacs_event->timestamp = ev->time; emacs_event->event.motion.x = ev->x; emacs_event->event.motion.y = ev->y; - if (ev->state & ShiftMask) modifiers |= MOD_SHIFT; - if (ev->state & ControlMask) modifiers |= MOD_CONTROL; - if (ev->state & xd->MetaMask) modifiers |= MOD_META; - if (ev->state & xd->SuperMask) modifiers |= MOD_SUPER; - if (ev->state & xd->HyperMask) modifiers |= MOD_HYPER; - if (ev->state & xd->AltMask) modifiers |= MOD_ALT; + if (ev->state & ShiftMask) modifiers |= XEMACS_MOD_SHIFT; + if (ev->state & ControlMask) modifiers |= XEMACS_MOD_CONTROL; + if (ev->state & xd->MetaMask) modifiers |= XEMACS_MOD_META; + if (ev->state & xd->SuperMask) modifiers |= XEMACS_MOD_SUPER; + if (ev->state & xd->HyperMask) modifiers |= XEMACS_MOD_HYPER; + if (ev->state & xd->AltMask) modifiers |= XEMACS_MOD_ALT; /* Currently ignores Shift_Lock but probably shouldn't (but it definitely should ignore Caps_Lock). */ emacs_event->event.motion.modifiers = modifiers; @@ -1305,7 +1295,9 @@ x_event_to_emacs_event (XEvent *x_event, Lisp_Event *emacs_event) #ifdef HAVE_OFFIX_DND if (DndIsDropMessage(x_event)) { - unsigned int state, modifiers = 0, button=0; + unsigned int state; + int modifiers = 0; + unsigned int button=0; struct frame *frame = x_any_window_to_frame (d, ev->window); Extbyte *data; unsigned long size, dtype; @@ -1324,12 +1316,12 @@ x_event_to_emacs_event (XEvent *x_event, Lisp_Event *emacs_event) state=DndDragButtons(x_event); - if (state & ShiftMask) modifiers |= MOD_SHIFT; - if (state & ControlMask) modifiers |= MOD_CONTROL; - if (state & xd->MetaMask) modifiers |= MOD_META; - if (state & xd->SuperMask) modifiers |= MOD_SUPER; - if (state & xd->HyperMask) modifiers |= MOD_HYPER; - if (state & xd->AltMask) modifiers |= MOD_ALT; + if (state & ShiftMask) modifiers |= XEMACS_MOD_SHIFT; + if (state & ControlMask) modifiers |= XEMACS_MOD_CONTROL; + if (state & xd->MetaMask) modifiers |= XEMACS_MOD_META; + if (state & xd->SuperMask) modifiers |= XEMACS_MOD_SUPER; + if (state & xd->HyperMask) modifiers |= XEMACS_MOD_HYPER; + if (state & xd->AltMask) modifiers |= XEMACS_MOD_ALT; if (state & Button5Mask) button = Button5; if (state & Button4Mask) button = Button4; @@ -1463,6 +1455,7 @@ x_event_to_emacs_event (XEvent *x_event, Lisp_Event *emacs_event) case FocusIn: case FocusOut: FROB(xfocus, window); break; case VisibilityNotify: FROB(xvisibility, window); break; + case CreateNotify: FROB(xcreatewindow, window); break; default: w = x_event->xany.window; *x_event_copy = *x_event; @@ -1722,6 +1715,25 @@ handle_client_message (struct frame *f, XEvent *event) } static void +emacs_Xt_force_event_pending (struct frame* f) +{ + XEvent event; + + Display* dpy = DEVICE_X_DISPLAY (XDEVICE (FRAME_DEVICE (f))); + event.xclient.type = ClientMessage; + event.xclient.display = dpy; + event.xclient.message_type = XInternAtom (dpy, "BumpQueue", False); + event.xclient.format = 32; + event.xclient.window = 0; + + /* Send the drop message */ + XSendEvent(dpy, XtWindow (FRAME_X_SHELL_WIDGET (f)), + True, NoEventMask, &event); + /* Force event pending to check the X queue. */ + quit_check_signal_tick_count++; +} + +static void emacs_Xt_handle_magic_event (Lisp_Event *emacs_event) { /* This function can GC */ @@ -1834,6 +1846,9 @@ emacs_Xt_handle_magic_event (Lisp_Event *emacs_event) #endif break; + case CreateNotify: + printf ("window created\n"); + break; default: break; } @@ -2295,7 +2310,7 @@ describe_event_window (Window window, Display *display) char *buf = alloca_array (char, XSTRING_LENGTH (f->name) + 4); sprintf (buf, " \"%s\"", XSTRING_DATA (f->name)); write_string_to_stdio_stream (stderr, 0, (Bufbyte *) buf, 0, - strlen (buf), Qterminal); + strlen (buf), Qterminal, 1); } stderr_out ("\n"); } @@ -3080,6 +3095,7 @@ reinit_vars_of_event_Xt (void) { Xt_event_stream = xnew (struct event_stream); Xt_event_stream->event_pending_p = emacs_Xt_event_pending_p; + Xt_event_stream->force_event_pending = emacs_Xt_force_event_pending; Xt_event_stream->next_event_cb = emacs_Xt_next_event; Xt_event_stream->handle_magic_event_cb = emacs_Xt_handle_magic_event; Xt_event_stream->add_timeout_cb = emacs_Xt_add_timeout; diff --git a/src/event-msw.c b/src/event-msw.c index e18c1e6..681743e 100644 --- a/src/event-msw.c +++ b/src/event-msw.c @@ -1,7 +1,7 @@ /* The mswindows event_stream interface. Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1996 Ben Wing. + Copyright (C) 1996, 2000 Ben Wing. Copyright (C) 1997 Jonathan Harris. This file is part of XEmacs. @@ -41,6 +41,7 @@ Boston, MA 02111-1307, USA. */ #endif #ifdef HAVE_MENUBARS +# include "menubar.h" # include "menubar-msw.h" #endif @@ -73,6 +74,10 @@ typedef unsigned int SOCKET; #include #include +#if !(defined(__CYGWIN32__) || defined(__MINGW32__)) +# include /* For IShellLink */ +#endif + #if defined (__CYGWIN32__) && (CYGWIN_VERSION_DLL_MAJOR < 20) typedef NMHDR *LPNMHDR; #endif @@ -140,7 +145,7 @@ int mswindows_quit_chars_count = 0; /* These are Lisp integers; see DEFVARS in this file for description. */ int mswindows_dynamic_frame_resize; -int mswindows_meta_activates_menu; +int mswindows_alt_by_itself_activates_menu; int mswindows_num_mouse_buttons; int mswindows_mouse_button_max_skew_x; int mswindows_mouse_button_max_skew_y; @@ -179,11 +184,11 @@ static int mswindows_pending_timers_count; struct ntpipe_slurp_stream_shared_data { HANDLE hev_thread; /* Our thread blocks on this, signaled by caller */ - /* This is a manual-reset object. */ + /* This is a manual-reset object. */ HANDLE hev_caller; /* Caller blocks on this, and we signal it */ - /* This is a manual-reset object. */ + /* This is a manual-reset object. */ HANDLE hev_unsleep; /* Pipe read delay is canceled if this is set */ - /* This is a manual-reset object. */ + /* This is a manual-reset object. */ HANDLE hpipe; /* Pipe read end handle. */ LONG die_p; /* Thread must exit ASAP if non-zero */ BOOL eof_p : 1; /* Set when thread saw EOF */ @@ -222,7 +227,7 @@ slurper_free_shared_data_maybe (struct ntpipe_slurp_stream_shared_data* s) } static struct ntpipe_slurp_stream_shared_data* -slurper_allocate_shared_data() +slurper_allocate_shared_data (void) { int i=0; for (i=0; ievent_type == timeout_event || match->event_type == key_press_event); @@ -1221,7 +1226,7 @@ mswindows_pump_outstanding_events (void) GCPRO1 (result); if (NILP(mswindows_error_caught_in_modal_loop)) - result = mswindows_protect_modal_loop (mswindows_unsafe_pump_events, Qnil); + result = mswindows_protect_modal_loop (mswindows_unsafe_pump_events, Qnil); UNGCPRO; return result; } @@ -1231,7 +1236,7 @@ mswindows_pump_outstanding_events (void) * QUITP, and are interesting in keyboard messages only. */ static void -mswindows_drain_windows_queue () +mswindows_drain_windows_queue (void) { MSG msg; @@ -1243,20 +1248,29 @@ mswindows_drain_windows_queue () /* We have to translate messages that are not sent to the main window. This is so that key presses work ok in things like edit fields. However, we *musn't* translate message for the - main window as this is handled in the wnd proc. */ - if (GetWindowLong (msg.hwnd, GWL_STYLE) & WS_CHILD) + main window as this is handled in the wnd proc. + We also have to avoid generating paint magic events for windows + that aren't XEmacs frames */ + if (GetWindowLong (msg.hwnd, GWL_STYLE) & (WS_CHILD|WS_POPUP)) { TranslateMessage (&msg); } else if (msg.message == WM_PAINT) { + struct mswindows_frame* msframe; + /* hdc will be NULL unless this is a subwindow - in which case we shouldn't have received a paint message for it here. */ assert (msg.wParam == 0); /* Queue a magic event for handling when safe */ - mswindows_enqueue_magic_event (msg.hwnd, WM_PAINT); - + msframe = FRAME_MSWINDOWS_DATA ( + XFRAME (mswindows_find_frame (msg.hwnd))); + if (!msframe->paint_pending) + { + msframe->paint_pending = 1; + mswindows_enqueue_magic_event (msg.hwnd, WM_PAINT); + } /* Don't dispatch. WM_PAINT is always the last message in the queue so it's OK to just return. */ return; @@ -1355,48 +1369,51 @@ mswindows_need_event (int badly_p) { mswindows_drain_windows_queue (); } -#ifdef HAVE_TTY - /* Look for a TTY event */ - for (i = 0; i < MAXDESC-1; i++) + else { - /* To avoid race conditions (among other things, an infinite - loop when called from Fdiscard_input()), we must return - user events ahead of process events. */ - if (FD_ISSET (i, &temp_mask) && FD_ISSET (i, &tty_only_mask)) +#ifdef HAVE_TTY + /* Look for a TTY event */ + for (i = 0; i < MAXDESC-1; i++) { - struct console *c = tty_find_console_from_fd (i); - Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); - Lisp_Event* event = XEVENT (emacs_event); - - assert (c); - if (read_event_from_tty_or_stream_desc (event, c, i)) + /* To avoid race conditions (among other things, an infinite + loop when called from Fdiscard_input()), we must return + user events ahead of process events. */ + if (FD_ISSET (i, &temp_mask) && FD_ISSET (i, &tty_only_mask)) { - mswindows_enqueue_dispatch_event (emacs_event); - return; + struct console *c = tty_find_console_from_fd (i); + Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); + Lisp_Event* event = XEVENT (emacs_event); + + assert (c); + if (read_event_from_tty_or_stream_desc (event, c, i)) + { + mswindows_enqueue_dispatch_event (emacs_event); + return; + } } } - } #endif - /* Look for a process event */ - for (i = 0; i < MAXDESC-1; i++) - { - if (FD_ISSET (i, &temp_mask)) + /* Look for a process event */ + for (i = 0; i < MAXDESC-1; i++) { - if (FD_ISSET (i, &process_only_mask)) + if (FD_ISSET (i, &temp_mask)) { - Lisp_Process *p = - get_process_from_usid (FD_TO_USID(i)); - - mswindows_enqueue_process_event (p); - } - else - { - /* We might get here when a fake event came - through a signal. Return a dummy event, so - that a cycle of the command loop will - occur. */ - drain_signal_event_pipe (); - mswindows_enqueue_magic_event (NULL, XM_BUMPQUEUE); + if (FD_ISSET (i, &process_only_mask)) + { + Lisp_Process *p = + get_process_from_usid (FD_TO_USID(i)); + + mswindows_enqueue_process_event (p); + } + else + { + /* We might get here when a fake event came + through a signal. Return a dummy event, so + that a cycle of the command loop will + occur. */ + drain_signal_event_pipe (); + mswindows_enqueue_magic_event (NULL, XM_BUMPQUEUE); + } } } } @@ -1415,53 +1432,53 @@ mswindows_need_event (int badly_p) } #else /* Now try getting a message or process event */ - active = MsgWaitForMultipleObjects (mswindows_waitable_count, - mswindows_waitable_handles, - FALSE, badly_p ? INFINITE : 0, - QS_ALLINPUT); - - /* This will assert if handle being waited for becomes abandoned. - Not the case currently tho */ - assert ((!badly_p && active == WAIT_TIMEOUT) || - (active >= WAIT_OBJECT_0 && - active <= WAIT_OBJECT_0 + mswindows_waitable_count)); - - if (active == WAIT_TIMEOUT) - { - /* No luck trying - just return what we've already got */ - return; - } - else if (active == WAIT_OBJECT_0 + mswindows_waitable_count) - { - /* Got your message, thanks */ - mswindows_drain_windows_queue (); - } - else - { - int ix = active - WAIT_OBJECT_0; - /* First, try to find which process' output has signaled */ - Lisp_Process *p = - get_process_from_usid (HANDLE_TO_USID (mswindows_waitable_handles[ix])); - if (p != NULL) - { - /* Found a signaled process input handle */ - mswindows_enqueue_process_event (p); - } - else - { - /* None. This means that the process handle itself has signaled. - Remove the handle from the wait vector, and make status_notify - note the exited process */ - mswindows_waitable_handles [ix] = - mswindows_waitable_handles [--mswindows_waitable_count]; - kick_status_notify (); - /* Have to return something: there may be no accompanying - process event */ - mswindows_enqueue_magic_event (NULL, XM_BUMPQUEUE); - } - } + active = MsgWaitForMultipleObjects (mswindows_waitable_count, + mswindows_waitable_handles, + FALSE, badly_p ? INFINITE : 0, + QS_ALLINPUT); + + /* This will assert if handle being waited for becomes abandoned. + Not the case currently tho */ + assert ((!badly_p && active == WAIT_TIMEOUT) || + (active >= WAIT_OBJECT_0 && + active <= WAIT_OBJECT_0 + mswindows_waitable_count)); + + if (active == WAIT_TIMEOUT) + { + /* No luck trying - just return what we've already got */ + return; + } + else if (active == WAIT_OBJECT_0 + mswindows_waitable_count) + { + /* Got your message, thanks */ + mswindows_drain_windows_queue (); + } + else + { + int ix = active - WAIT_OBJECT_0; + /* First, try to find which process' output has signaled */ + Lisp_Process *p = + get_process_from_usid (HANDLE_TO_USID (mswindows_waitable_handles[ix])); + if (p != NULL) + { + /* Found a signaled process input handle */ + mswindows_enqueue_process_event (p); + } + else + { + /* None. This means that the process handle itself has signaled. + Remove the handle from the wait vector, and make status_notify + note the exited process */ + mswindows_waitable_handles [ix] = + mswindows_waitable_handles [--mswindows_waitable_count]; + kick_status_notify (); + /* Have to return something: there may be no accompanying + process event */ + mswindows_enqueue_magic_event (NULL, XM_BUMPQUEUE); + } + } #endif - } /* while */ + } /* while */ } /************************************************************************/ @@ -1614,36 +1631,36 @@ mswindows_dde_callback (UINT uType, UINT uFmt, HCONV hconv, * Helper to do repainting - repaints can happen both from the windows * procedure and from magic events */ -void +static void mswindows_handle_paint (struct frame *frame) - { - HWND hwnd = FRAME_MSWINDOWS_HANDLE (frame); +{ + HWND hwnd = FRAME_MSWINDOWS_HANDLE (frame); - /* According to the docs we need to check GetUpdateRect() before - actually doing a WM_PAINT */ - if (GetUpdateRect (hwnd, NULL, FALSE)) - { - PAINTSTRUCT paintStruct; - int x, y, width, height; - - BeginPaint (hwnd, &paintStruct); - x = paintStruct.rcPaint.left; - y = paintStruct.rcPaint.top; - width = paintStruct.rcPaint.right - paintStruct.rcPaint.left; - height = paintStruct.rcPaint.bottom - paintStruct.rcPaint.top; - /* Normally we want to ignore expose events when child - windows are unmapped, however once we are in the guts of - WM_PAINT we need to make sure that we don't register - unmaps then because they will not actually occur. */ - if (!check_for_ignored_expose (frame, x, y, width, height)) - { - hold_ignored_expose_registration = 1; - mswindows_redraw_exposed_area (frame, x, y, width, height); - hold_ignored_expose_registration = 0; - } - EndPaint (hwnd, &paintStruct); - } - } + /* According to the docs we need to check GetUpdateRect() before + actually doing a WM_PAINT */ + if (GetUpdateRect (hwnd, NULL, FALSE)) + { + PAINTSTRUCT paintStruct; + int x, y, width, height; + + BeginPaint (hwnd, &paintStruct); + x = paintStruct.rcPaint.left; + y = paintStruct.rcPaint.top; + width = paintStruct.rcPaint.right - paintStruct.rcPaint.left; + height = paintStruct.rcPaint.bottom - paintStruct.rcPaint.top; + /* Normally we want to ignore expose events when child + windows are unmapped, however once we are in the guts of + WM_PAINT we need to make sure that we don't register + unmaps then because they will not actually occur. */ + if (!check_for_ignored_expose (frame, x, y, width, height)) + { + hold_ignored_expose_registration = 1; + mswindows_redraw_exposed_area (frame, x, y, width, height); + hold_ignored_expose_registration = 0; + } + EndPaint (hwnd, &paintStruct); + } +} /* * Returns 1 if a key is a real modifier or special key, which @@ -1652,7 +1669,7 @@ mswindows_handle_paint (struct frame *frame) static int key_needs_default_processing_p (UINT vkey) { - if (mswindows_meta_activates_menu && vkey == VK_MENU) + if (mswindows_alt_by_itself_activates_menu && vkey == VK_MENU) return 1; return 0; @@ -1673,742 +1690,821 @@ mswindows_wnd_proc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam) struct frame *frame; struct mswindows_frame* msframe; + assert (!GetWindowLong (hwnd, GWL_USERDATA)); switch (message) - { - case WM_DESTROYCLIPBOARD: - /* We own the clipboard and someone else wants it. Delete our - cached copy of the clipboard contents so we'll ask for it from - Windows again when someone does a paste. */ - handle_selection_clear(QCLIPBOARD); - break; - - case WM_ERASEBKGND: - /* Erase background only during non-dynamic sizing */ - msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); - if (msframe->sizing && !mswindows_dynamic_frame_resize) - goto defproc; - return 1; - - case WM_CLOSE: - fobj = mswindows_find_frame (hwnd); - mswindows_enqueue_misc_user_event (fobj, Qeval, list3 (Qdelete_frame, fobj, Qt)); - break; - - case WM_KEYUP: - case WM_SYSKEYUP: - /* See Win95 comment under WM_KEYDOWN */ { - BYTE keymap[256]; - - if (wParam == VK_CONTROL) - { - GetKeyboardState (keymap); - keymap [(lParam & 0x1000000) ? VK_RCONTROL : VK_LCONTROL] &= ~0x80; - SetKeyboardState (keymap); - } - else if (wParam == VK_MENU) - { - GetKeyboardState (keymap); - keymap [(lParam & 0x1000000) ? VK_RMENU : VK_LMENU] &= ~0x80; - SetKeyboardState (keymap); - } - }; - if (key_needs_default_processing_p (wParam)) - goto defproc; - else + case WM_DESTROYCLIPBOARD: + /* We own the clipboard and someone else wants it. Delete our + cached copy of the clipboard contents so we'll ask for it from + Windows again when someone does a paste. */ + handle_selection_clear(QCLIPBOARD); break; - case WM_KEYDOWN: - case WM_SYSKEYDOWN: - /* In some locales the right-hand Alt key is labelled AltGr. This key - * should produce alternative charcaters when combined with another key. - * eg on a German keyboard pressing AltGr+q should produce '@'. - * AltGr generates exactly the same keystrokes as LCtrl+RAlt. But if - * TranslateMessage() is called with *any* combination of Ctrl+Alt down, - * it translates as if AltGr were down. - * We get round this by removing all modifiers from the keymap before - * calling TranslateMessage() unless AltGr is *really* down. */ - { - BYTE keymap[256]; - int has_AltGr = mswindows_current_layout_has_AltGr (); - int mods; - int extendedp = lParam & 0x1000000; - Lisp_Object keysym; - - GetKeyboardState (keymap); - mods = mswindows_modifier_state (keymap, has_AltGr); - - /* Handle non-printables */ - if (!NILP (keysym = mswindows_key_to_emacs_keysym (wParam, mods, - extendedp))) - mswindows_enqueue_keypress_event (hwnd, keysym, mods); - else /* Normal keys & modifiers */ - { - int quit_ch = CONSOLE_QUIT_CHAR (XCONSOLE (mswindows_find_console (hwnd))); - BYTE keymap_orig[256]; - POINT pnt = { LOWORD (GetMessagePos()), HIWORD (GetMessagePos()) }; - MSG msg; - - msg.hwnd = hwnd; - msg.message = message; - msg.wParam = wParam; - msg.lParam = lParam; - msg.time = GetMessageTime(); - msg.pt = pnt; - - /* GetKeyboardState() does not work as documented on Win95. We have - * to loosely track Left and Right modifiers on behalf of the OS, - * without screwing up Windows NT which tracks them properly. */ - if (wParam == VK_CONTROL) - keymap [extendedp ? VK_RCONTROL : VK_LCONTROL] |= 0x80; - else if (wParam == VK_MENU) - keymap [extendedp ? VK_RMENU : VK_LMENU] |= 0x80; - - memcpy (keymap_orig, keymap, 256); - - /* Remove shift modifier from an ascii character */ - mods &= ~MOD_SHIFT; - - /* Clear control and alt modifiers unless AltGr is pressed */ - keymap [VK_RCONTROL] = 0; - keymap [VK_LMENU] = 0; - if (!has_AltGr || !(keymap [VK_LCONTROL] & 0x80) - || !(keymap [VK_RMENU] & 0x80)) - { - keymap [VK_LCONTROL] = 0; - keymap [VK_CONTROL] = 0; - keymap [VK_RMENU] = 0; - keymap [VK_MENU] = 0; - } - SetKeyboardState (keymap); - - /* Maybe generate some WM_[SYS]CHARs in the queue */ - TranslateMessage (&msg); - - while (PeekMessage (&msg, hwnd, WM_CHAR, WM_CHAR, PM_REMOVE) - || PeekMessage (&msg, hwnd, WM_SYSCHAR, WM_SYSCHAR, PM_REMOVE)) - { - int mods1 = mods; - WPARAM ch = msg.wParam; - - /* If a quit char with no modifiers other than control and - shift, then mark it with a fake modifier, which is removed - upon dequeueing the event */ - /* #### This might also not withstand localization, if - quit character is not a latin-1 symbol */ - if (((quit_ch < ' ' && (mods & MOD_CONTROL) && quit_ch + 'a' - 1 == ch) - || (quit_ch >= ' ' && !(mods & MOD_CONTROL) && quit_ch == ch)) - && ((mods & ~(MOD_CONTROL | MOD_SHIFT)) == 0)) - { - mods1 |= FAKE_MOD_QUIT; - ++mswindows_quit_chars_count; - } + case WM_ERASEBKGND: + /* Erase background only during non-dynamic sizing */ + msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); + if (msframe->sizing && !mswindows_dynamic_frame_resize) + goto defproc; + return 1; - mswindows_enqueue_keypress_event (hwnd, make_char(ch), mods1); - } /* while */ - SetKeyboardState (keymap_orig); - } /* else */ - } - if (key_needs_default_processing_p (wParam)) - goto defproc; - else + case WM_CLOSE: + fobj = mswindows_find_frame (hwnd); + mswindows_enqueue_misc_user_event (fobj, Qeval, list3 (Qdelete_frame, fobj, Qt)); break; - case WM_MBUTTONDOWN: - case WM_MBUTTONUP: - /* Real middle mouse button has nothing to do with emulated one: - if one wants to exercise fingers playing chords on the mouse, - he is allowed to do that! */ - mswindows_enqueue_mouse_button_event (hwnd, message, - MAKEPOINTS (lParam), GetMessageTime()); - break; - - case WM_LBUTTONUP: - msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); - msframe->last_click_time = GetMessageTime(); - - KillTimer (hwnd, BUTTON_2_TIMER_ID); - msframe->button2_need_lbutton = 0; - if (msframe->ignore_next_lbutton_up) + case WM_KEYUP: + case WM_SYSKEYUP: + /* See Win95 comment under WM_KEYDOWN */ { - msframe->ignore_next_lbutton_up = 0; - } - else if (msframe->button2_is_down) - { - msframe->button2_is_down = 0; - msframe->ignore_next_rbutton_up = 1; - mswindows_enqueue_mouse_button_event (hwnd, WM_MBUTTONUP, - MAKEPOINTS (lParam), GetMessageTime()); - } - else - { - if (msframe->button2_need_rbutton) + BYTE keymap[256]; + int should_set_keymap = 0; + + if (wParam == VK_CONTROL) { - msframe->button2_need_rbutton = 0; - mswindows_enqueue_mouse_button_event (hwnd, WM_LBUTTONDOWN, - MAKEPOINTS (lParam), GetMessageTime()); + GetKeyboardState (keymap); + keymap [(lParam & 0x1000000) ? VK_RCONTROL : VK_LCONTROL] &= ~0x80; + should_set_keymap = 1; } - mswindows_enqueue_mouse_button_event (hwnd, WM_LBUTTONUP, - MAKEPOINTS (lParam), GetMessageTime()); - } - break; - - case WM_RBUTTONUP: - msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); - msframe->last_click_time = GetMessageTime(); - - KillTimer (hwnd, BUTTON_2_TIMER_ID); - msframe->button2_need_rbutton = 0; - if (msframe->ignore_next_rbutton_up) - { - msframe->ignore_next_rbutton_up = 0; - } - else if (msframe->button2_is_down) - { - msframe->button2_is_down = 0; - msframe->ignore_next_lbutton_up = 1; - mswindows_enqueue_mouse_button_event (hwnd, WM_MBUTTONUP, - MAKEPOINTS (lParam), GetMessageTime()); - } - else - { - if (msframe->button2_need_lbutton) + else if (wParam == VK_MENU) { - msframe->button2_need_lbutton = 0; - mswindows_enqueue_mouse_button_event (hwnd, WM_RBUTTONDOWN, - MAKEPOINTS (lParam), GetMessageTime()); + GetKeyboardState (keymap); + keymap [(lParam & 0x1000000) ? VK_RMENU : VK_LMENU] &= ~0x80; + should_set_keymap = 1; } - mswindows_enqueue_mouse_button_event (hwnd, WM_RBUTTONUP, - MAKEPOINTS (lParam), GetMessageTime()); - } - break; - case WM_LBUTTONDOWN: - msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); + if (should_set_keymap + && (message != WM_SYSKEYUP + || NILP (Vmenu_accelerator_enabled))) + SetKeyboardState (keymap); - if (msframe->button2_need_lbutton) - { - KillTimer (hwnd, BUTTON_2_TIMER_ID); - msframe->button2_need_lbutton = 0; - msframe->button2_need_rbutton = 0; - if (mswindows_button2_near_enough (msframe->last_click_point, MAKEPOINTS (lParam))) - { - mswindows_enqueue_mouse_button_event (hwnd, WM_MBUTTONDOWN, - MAKEPOINTS (lParam), GetMessageTime()); - msframe->button2_is_down = 1; - } - else - { - mswindows_enqueue_mouse_button_event (hwnd, WM_RBUTTONDOWN, - msframe->last_click_point, msframe->last_click_time); - mswindows_enqueue_mouse_button_event (hwnd, WM_LBUTTONDOWN, - MAKEPOINTS (lParam), GetMessageTime()); - } } - else - { - mswindows_set_chord_timer (hwnd); - msframe->button2_need_rbutton = 1; - msframe->last_click_point = MAKEPOINTS (lParam); - } - msframe->last_click_time = GetMessageTime(); - break; - - case WM_RBUTTONDOWN: - msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); + if (key_needs_default_processing_p (wParam)) + goto defproc; + else + break; - if (msframe->button2_need_rbutton) + case WM_KEYDOWN: + case WM_SYSKEYDOWN: + /* In some locales the right-hand Alt key is labelled AltGr. This key + * should produce alternative charcaters when combined with another key. + * eg on a German keyboard pressing AltGr+q should produce '@'. + * AltGr generates exactly the same keystrokes as LCtrl+RAlt. But if + * TranslateMessage() is called with *any* combination of Ctrl+Alt down, + * it translates as if AltGr were down. + * We get round this by removing all modifiers from the keymap before + * calling TranslateMessage() unless AltGr is *really* down. */ { - KillTimer (hwnd, BUTTON_2_TIMER_ID); - msframe->button2_need_lbutton = 0; - msframe->button2_need_rbutton = 0; - if (mswindows_button2_near_enough (msframe->last_click_point, MAKEPOINTS (lParam))) + BYTE keymap[256]; + int has_AltGr = mswindows_current_layout_has_AltGr (); + int mods; + int extendedp = lParam & 0x1000000; + Lisp_Object keysym; + + frame = XFRAME (mswindows_find_frame (hwnd)); + GetKeyboardState (keymap); + mods = mswindows_modifier_state (keymap, has_AltGr); + + /* Handle non-printables */ + if (!NILP (keysym = mswindows_key_to_emacs_keysym (wParam, mods, + extendedp))) + mswindows_enqueue_keypress_event (hwnd, keysym, mods); + else /* Normal keys & modifiers */ { - mswindows_enqueue_mouse_button_event (hwnd, WM_MBUTTONDOWN, - MAKEPOINTS (lParam), GetMessageTime()); - msframe->button2_is_down = 1; - } - else - { - mswindows_enqueue_mouse_button_event (hwnd, WM_LBUTTONDOWN, - msframe->last_click_point, msframe->last_click_time); - mswindows_enqueue_mouse_button_event (hwnd, WM_RBUTTONDOWN, - MAKEPOINTS (lParam), GetMessageTime()); - } - } - else - { - mswindows_set_chord_timer (hwnd); - msframe->button2_need_lbutton = 1; - msframe->last_click_point = MAKEPOINTS (lParam); + Emchar quit_ch = CONSOLE_QUIT_CHAR (XCONSOLE (mswindows_find_console (hwnd))); + BYTE keymap_orig[256]; + POINT pnt = { LOWORD (GetMessagePos()), HIWORD (GetMessagePos()) }; + MSG msg, tranmsg; + int potential_accelerator = 0; + int got_accelerator = 0; + + msg.hwnd = hwnd; + msg.message = message; + msg.wParam = wParam; + msg.lParam = lParam; + msg.time = GetMessageTime(); + msg.pt = pnt; + + /* GetKeyboardState() does not work as documented on Win95. We have + * to loosely track Left and Right modifiers on behalf of the OS, + * without screwing up Windows NT which tracks them properly. */ + if (wParam == VK_CONTROL) + keymap [extendedp ? VK_RCONTROL : VK_LCONTROL] |= 0x80; + else if (wParam == VK_MENU) + keymap [extendedp ? VK_RMENU : VK_LMENU] |= 0x80; + + memcpy (keymap_orig, keymap, 256); + + if (!NILP (Vmenu_accelerator_enabled) && + !(mods & XEMACS_MOD_SHIFT) && message == WM_SYSKEYDOWN) + potential_accelerator = 1; + + /* Remove shift modifier from an ascii character */ + mods &= ~XEMACS_MOD_SHIFT; + + /* Clear control and alt modifiers unless AltGr is pressed */ + keymap [VK_RCONTROL] = 0; + keymap [VK_LMENU] = 0; + if (!has_AltGr || !(keymap [VK_LCONTROL] & 0x80) + || !(keymap [VK_RMENU] & 0x80)) + { + keymap [VK_LCONTROL] = 0; + keymap [VK_CONTROL] = 0; + keymap [VK_RMENU] = 0; + keymap [VK_MENU] = 0; + } + SetKeyboardState (keymap); + + /* Maybe generate some WM_[SYS]CHARs in the queue */ + TranslateMessage (&msg); + + while (PeekMessage (&tranmsg, hwnd, WM_CHAR, WM_CHAR, PM_REMOVE) + || PeekMessage (&tranmsg, hwnd, WM_SYSCHAR, WM_SYSCHAR, PM_REMOVE)) + { + int mods1 = mods; + WPARAM ch = tranmsg.wParam; + + /* If a quit char with no modifiers other than control and + shift, then mark it with a fake modifier, which is removed + upon dequeueing the event */ + /* #### This might also not withstand localization, if + quit character is not a latin-1 symbol */ + if (((quit_ch < ' ' && (mods & XEMACS_MOD_CONTROL) && quit_ch + 'a' - 1 == ch) + || (quit_ch >= ' ' && !(mods & XEMACS_MOD_CONTROL) && quit_ch == ch)) + && ((mods & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_SHIFT)) == 0)) + { + mods1 |= FAKE_MOD_QUIT; + ++mswindows_quit_chars_count; + } + else if (potential_accelerator && !got_accelerator && + msw_char_is_accelerator (frame, ch)) + { + got_accelerator = 1; + break; + } + mswindows_enqueue_keypress_event (hwnd, make_char (ch), mods1); + } /* while */ + SetKeyboardState (keymap_orig); + /* This generates WM_SYSCHAR messages, which are interpreted + by DefWindowProc as the menu selections. */ + if (got_accelerator) + { + TranslateMessage (&msg); + goto defproc; + } + } /* else */ } - msframe->last_click_time = GetMessageTime(); - break; + if (key_needs_default_processing_p (wParam)) + goto defproc; + else + break; - case WM_TIMER: - if (wParam == BUTTON_2_TIMER_ID) - { - msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); - KillTimer (hwnd, BUTTON_2_TIMER_ID); + case WM_MBUTTONDOWN: + case WM_MBUTTONUP: + /* Real middle mouse button has nothing to do with emulated one: + if one wants to exercise fingers playing chords on the mouse, + he is allowed to do that! */ + mswindows_enqueue_mouse_button_event (hwnd, message, + MAKEPOINTS (lParam), GetMessageTime()); + break; - if (msframe->button2_need_lbutton) - { - msframe->button2_need_lbutton = 0; - mswindows_enqueue_mouse_button_event (hwnd, WM_RBUTTONDOWN, - msframe->last_click_point, msframe->last_click_time); - } - else if (msframe->button2_need_rbutton) - { - msframe->button2_need_rbutton = 0; - mswindows_enqueue_mouse_button_event (hwnd, WM_LBUTTONDOWN, - msframe->last_click_point, msframe->last_click_time); - } - } - else - assert ("Spurious timer fired" == 0); - break; + case WM_LBUTTONUP: + msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); + msframe->last_click_time = GetMessageTime(); - case WM_MOUSEMOVE: - /* Optimization: don't report mouse movement while size is changing */ - msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); - if (!msframe->sizing) - { - /* When waiting for the second mouse button to finish - button2 emulation, and have moved too far, just pretend - as if timer has expired. This improves drag-select feedback */ - if ((msframe->button2_need_lbutton || msframe->button2_need_rbutton) - && !mswindows_button2_near_enough (msframe->last_click_point, - MAKEPOINTS (lParam))) + KillTimer (hwnd, BUTTON_2_TIMER_ID); + msframe->button2_need_lbutton = 0; + if (msframe->ignore_next_lbutton_up) { - KillTimer (hwnd, BUTTON_2_TIMER_ID); - SendMessage (hwnd, WM_TIMER, BUTTON_2_TIMER_ID, 0); + msframe->ignore_next_lbutton_up = 0; } + else if (msframe->button2_is_down) + { + msframe->button2_is_down = 0; + msframe->ignore_next_rbutton_up = 1; + mswindows_enqueue_mouse_button_event (hwnd, WM_MBUTTONUP, + MAKEPOINTS (lParam), GetMessageTime()); + } + else + { + if (msframe->button2_need_rbutton) + { + msframe->button2_need_rbutton = 0; + mswindows_enqueue_mouse_button_event (hwnd, WM_LBUTTONDOWN, + MAKEPOINTS (lParam), GetMessageTime()); + } + mswindows_enqueue_mouse_button_event (hwnd, WM_LBUTTONUP, + MAKEPOINTS (lParam), GetMessageTime()); + } + break; - emacs_event = Fmake_event (Qnil, Qnil); - event = XEVENT(emacs_event); - - event->channel = mswindows_find_frame(hwnd); - event->timestamp = GetMessageTime(); - event->event_type = pointer_motion_event; - event->event.motion.x = MAKEPOINTS(lParam).x; - event->event.motion.y = MAKEPOINTS(lParam).y; - event->event.motion.modifiers = mswindows_modifier_state (NULL, 0); - - mswindows_enqueue_dispatch_event (emacs_event); - } - break; + case WM_RBUTTONUP: + msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); + msframe->last_click_time = GetMessageTime(); - case WM_CANCELMODE: - ReleaseCapture (); - /* Queue a `cancel-mode-internal' misc user event, so mouse - selection would be canceled if any */ - mswindows_enqueue_misc_user_event (mswindows_find_frame (hwnd), - Qcancel_mode_internal, Qnil); - break; + KillTimer (hwnd, BUTTON_2_TIMER_ID); + msframe->button2_need_rbutton = 0; + if (msframe->ignore_next_rbutton_up) + { + msframe->ignore_next_rbutton_up = 0; + } + else if (msframe->button2_is_down) + { + msframe->button2_is_down = 0; + msframe->ignore_next_lbutton_up = 1; + mswindows_enqueue_mouse_button_event (hwnd, WM_MBUTTONUP, + MAKEPOINTS (lParam), GetMessageTime()); + } + else + { + if (msframe->button2_need_lbutton) + { + msframe->button2_need_lbutton = 0; + mswindows_enqueue_mouse_button_event (hwnd, WM_RBUTTONDOWN, + MAKEPOINTS (lParam), GetMessageTime()); + } + mswindows_enqueue_mouse_button_event (hwnd, WM_RBUTTONUP, + MAKEPOINTS (lParam), GetMessageTime()); + } + break; - case WM_NOTIFY: - { - LPNMHDR nmhdr = (LPNMHDR)lParam; + case WM_LBUTTONDOWN: + msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); - if (nmhdr->code == TTN_NEEDTEXT) + if (msframe->button2_need_lbutton) { -#ifdef HAVE_TOOLBARS - LPTOOLTIPTEXT tttext = (LPTOOLTIPTEXT)lParam; - Lisp_Object btext; - - /* find out which toolbar */ - frame = XFRAME (mswindows_find_frame (hwnd)); - btext = mswindows_get_toolbar_button_text ( frame, - nmhdr->idFrom ); + KillTimer (hwnd, BUTTON_2_TIMER_ID); + msframe->button2_need_lbutton = 0; + msframe->button2_need_rbutton = 0; + if (mswindows_button2_near_enough (msframe->last_click_point, MAKEPOINTS (lParam))) + { + mswindows_enqueue_mouse_button_event (hwnd, WM_MBUTTONDOWN, + MAKEPOINTS (lParam), GetMessageTime()); + msframe->button2_is_down = 1; + } + else + { + mswindows_enqueue_mouse_button_event (hwnd, WM_RBUTTONDOWN, + msframe->last_click_point, msframe->last_click_time); + mswindows_enqueue_mouse_button_event (hwnd, WM_LBUTTONDOWN, + MAKEPOINTS (lParam), GetMessageTime()); + } + } + else + { + mswindows_set_chord_timer (hwnd); + msframe->button2_need_rbutton = 1; + msframe->last_click_point = MAKEPOINTS (lParam); + } + msframe->last_click_time = GetMessageTime(); + break; - tttext->lpszText = NULL; - tttext->hinst = NULL; + case WM_RBUTTONDOWN: + msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); - if (!NILP(btext)) + if (msframe->button2_need_rbutton) + { + KillTimer (hwnd, BUTTON_2_TIMER_ID); + msframe->button2_need_lbutton = 0; + msframe->button2_need_rbutton = 0; + if (mswindows_button2_near_enough (msframe->last_click_point, MAKEPOINTS (lParam))) { - /* I think this is safe since the text will only go away - when the toolbar does...*/ - TO_EXTERNAL_FORMAT (LISP_STRING, btext, - C_STRING_ALLOCA, tttext->lpszText, - Qnative); + mswindows_enqueue_mouse_button_event (hwnd, WM_MBUTTONDOWN, + MAKEPOINTS (lParam), GetMessageTime()); + msframe->button2_is_down = 1; + } + else + { + mswindows_enqueue_mouse_button_event (hwnd, WM_LBUTTONDOWN, + msframe->last_click_point, msframe->last_click_time); + mswindows_enqueue_mouse_button_event (hwnd, WM_RBUTTONDOWN, + MAKEPOINTS (lParam), GetMessageTime()); } -#endif } - /* handle tree view callbacks */ - else if (nmhdr->code == TVN_SELCHANGED) + else { - NM_TREEVIEW* ptree = (NM_TREEVIEW*)lParam; - frame = XFRAME (mswindows_find_frame (hwnd)); - mswindows_handle_gui_wm_command (frame, 0, ptree->itemNew.lParam); + mswindows_set_chord_timer (hwnd); + msframe->button2_need_lbutton = 1; + msframe->last_click_point = MAKEPOINTS (lParam); } - /* handle tab control callbacks */ - else if (nmhdr->code == TCN_SELCHANGE) - { - TC_ITEM item; - int idx = SendMessage (nmhdr->hwndFrom, TCM_GETCURSEL, 0, 0); - frame = XFRAME (mswindows_find_frame (hwnd)); + msframe->last_click_time = GetMessageTime(); + break; - item.mask = TCIF_PARAM; - SendMessage (nmhdr->hwndFrom, TCM_GETITEM, (WPARAM)idx, - (LPARAM)&item); + case WM_TIMER: + if (wParam == BUTTON_2_TIMER_ID) + { + msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); + KillTimer (hwnd, BUTTON_2_TIMER_ID); - mswindows_handle_gui_wm_command (frame, 0, item.lParam); + if (msframe->button2_need_lbutton) + { + msframe->button2_need_lbutton = 0; + mswindows_enqueue_mouse_button_event (hwnd, WM_RBUTTONDOWN, + msframe->last_click_point, msframe->last_click_time); + } + else if (msframe->button2_need_rbutton) + { + msframe->button2_need_rbutton = 0; + mswindows_enqueue_mouse_button_event (hwnd, WM_LBUTTONDOWN, + msframe->last_click_point, msframe->last_click_time); + } } - } - break; - - case WM_PAINT: - /* hdc will be NULL unless this is a subwindow - in which case we - shouldn't have received a paint message for it here. */ - assert (wParam == 0); - - /* Can't queue a magic event because windows goes modal and sends paint - messages directly to the windows procedure when doing solid drags - and the message queue doesn't get processed. */ - mswindows_handle_paint (XFRAME (mswindows_find_frame (hwnd))); - break; - - case WM_SIZE: - /* We only care about this message if our size has really changed */ - if (wParam==SIZE_RESTORED || wParam==SIZE_MAXIMIZED || wParam==SIZE_MINIMIZED) - { - RECT rect; - int columns, rows; + else + assert ("Spurious timer fired" == 0); + break; - fobj = mswindows_find_frame (hwnd); - frame = XFRAME (fobj); - msframe = FRAME_MSWINDOWS_DATA (frame); + case WM_MOUSEMOVE: + /* Optimization: don't report mouse movement while size is changing */ + msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); + if (!msframe->sizing) + { + /* When waiting for the second mouse button to finish + button2 emulation, and have moved too far, just pretend + as if timer has expired. This improves drag-select feedback */ + if ((msframe->button2_need_lbutton || msframe->button2_need_rbutton) + && !mswindows_button2_near_enough (msframe->last_click_point, + MAKEPOINTS (lParam))) + { + KillTimer (hwnd, BUTTON_2_TIMER_ID); + SendMessage (hwnd, WM_TIMER, BUTTON_2_TIMER_ID, 0); + } - /* We cannot handle frame map and unmap hooks right in - this routine, because these may throw. We queue - magic events to run these hooks instead - kkm */ + emacs_event = Fmake_event (Qnil, Qnil); + event = XEVENT(emacs_event); - if (wParam==SIZE_MINIMIZED) - { - /* Iconified */ - FRAME_VISIBLE_P (frame) = 0; - mswindows_enqueue_magic_event (hwnd, XM_UNMAPFRAME); + event->channel = mswindows_find_frame(hwnd); + event->timestamp = GetMessageTime(); + event->event_type = pointer_motion_event; + event->event.motion.x = MAKEPOINTS(lParam).x; + event->event.motion.y = MAKEPOINTS(lParam).y; + event->event.motion.modifiers = mswindows_modifier_state (NULL, 0); + + mswindows_enqueue_dispatch_event (emacs_event); } - else + break; + + case WM_CANCELMODE: + ReleaseCapture (); + /* Queue a `cancel-mode-internal' misc user event, so mouse + selection would be canceled if any */ + mswindows_enqueue_misc_user_event (mswindows_find_frame (hwnd), + Qcancel_mode_internal, Qnil); + break; + + case WM_NOTIFY: + { + LPNMHDR nmhdr = (LPNMHDR)lParam; + + if (nmhdr->code == TTN_NEEDTEXT) + { +#ifdef HAVE_TOOLBARS + LPTOOLTIPTEXT tttext = (LPTOOLTIPTEXT)lParam; + Lisp_Object btext; + + /* find out which toolbar */ + frame = XFRAME (mswindows_find_frame (hwnd)); + btext = mswindows_get_toolbar_button_text ( frame, + nmhdr->idFrom ); + + tttext->lpszText = NULL; + tttext->hinst = NULL; + + if (!NILP(btext)) + { + /* I think this is safe since the text will only go away + when the toolbar does...*/ + TO_EXTERNAL_FORMAT (LISP_STRING, btext, + C_STRING_ALLOCA, tttext->lpszText, + Qnative); + } +#endif + } + /* handle tree view callbacks */ + else if (nmhdr->code == TVN_SELCHANGED) + { + NM_TREEVIEW* ptree = (NM_TREEVIEW*)lParam; + frame = XFRAME (mswindows_find_frame (hwnd)); + mswindows_handle_gui_wm_command (frame, 0, ptree->itemNew.lParam); + } + /* handle tab control callbacks */ + else if (nmhdr->code == TCN_SELCHANGE) + { + TC_ITEM item; + int idx = SendMessage (nmhdr->hwndFrom, TCM_GETCURSEL, 0, 0); + frame = XFRAME (mswindows_find_frame (hwnd)); + + item.mask = TCIF_PARAM; + SendMessage (nmhdr->hwndFrom, TCM_GETITEM, (WPARAM)idx, + (LPARAM)&item); + + mswindows_handle_gui_wm_command (frame, 0, item.lParam); + } + } + break; + + case WM_PAINT: + /* hdc will be NULL unless this is a subwindow - in which case we + shouldn't have received a paint message for it here. */ + assert (wParam == 0); + + /* Can't queue a magic event because windows goes modal and sends paint + messages directly to the windows procedure when doing solid drags + and the message queue doesn't get processed. */ + mswindows_handle_paint (XFRAME (mswindows_find_frame (hwnd))); + break; + + case WM_SIZE: + /* We only care about this message if our size has really changed */ + if (wParam==SIZE_RESTORED || wParam==SIZE_MAXIMIZED || wParam==SIZE_MINIMIZED) { - GetClientRect(hwnd, &rect); - FRAME_PIXWIDTH(frame) = rect.right; - FRAME_PIXHEIGHT(frame) = rect.bottom; + RECT rect; + int columns, rows; - pixel_to_real_char_size (frame, rect.right, rect.bottom, - &FRAME_MSWINDOWS_CHARWIDTH (frame), - &FRAME_MSWINDOWS_CHARHEIGHT (frame)); + fobj = mswindows_find_frame (hwnd); + frame = XFRAME (fobj); + msframe = FRAME_MSWINDOWS_DATA (frame); - pixel_to_char_size (frame, rect.right, rect.bottom, &columns, &rows); - change_frame_size (frame, rows, columns, 1); + /* We cannot handle frame map and unmap hooks right in + this routine, because these may throw. We queue + magic events to run these hooks instead - kkm */ - /* If we are inside frame creation, we have to apply geometric - properties now. */ - if (FRAME_MSWINDOWS_TARGET_RECT (frame)) + if (wParam==SIZE_MINIMIZED) { - /* Yes, we have to size again */ - mswindows_size_frame_internal ( frame, - FRAME_MSWINDOWS_TARGET_RECT - (frame)); - /* Reset so we do not get here again. The SetWindowPos call in - * mswindows_size_frame_internal can cause recursion here. */ - if (FRAME_MSWINDOWS_TARGET_RECT (frame)) - { - xfree (FRAME_MSWINDOWS_TARGET_RECT (frame)); - FRAME_MSWINDOWS_TARGET_RECT (frame) = 0; - } + /* Iconified */ + FRAME_VISIBLE_P (frame) = 0; + mswindows_enqueue_magic_event (hwnd, XM_UNMAPFRAME); } else { - if (!msframe->sizing && !FRAME_VISIBLE_P (frame)) - mswindows_enqueue_magic_event (hwnd, XM_MAPFRAME); - FRAME_VISIBLE_P (frame) = 1; + GetClientRect(hwnd, &rect); + FRAME_PIXWIDTH(frame) = rect.right; + FRAME_PIXHEIGHT(frame) = rect.bottom; + + pixel_to_real_char_size (frame, rect.right, rect.bottom, + &FRAME_MSWINDOWS_CHARWIDTH (frame), + &FRAME_MSWINDOWS_CHARHEIGHT (frame)); + + pixel_to_char_size (frame, rect.right, rect.bottom, &columns, &rows); + change_frame_size (frame, rows, columns, 1); - if (!msframe->sizing || mswindows_dynamic_frame_resize) - redisplay (); + /* If we are inside frame creation, we have to apply geometric + properties now. */ + if (FRAME_MSWINDOWS_TARGET_RECT (frame)) + { + /* Yes, we have to size again */ + mswindows_size_frame_internal ( frame, + FRAME_MSWINDOWS_TARGET_RECT + (frame)); + /* Reset so we do not get here again. The SetWindowPos call in + * mswindows_size_frame_internal can cause recursion here. */ + if (FRAME_MSWINDOWS_TARGET_RECT (frame)) + { + xfree (FRAME_MSWINDOWS_TARGET_RECT (frame)); + FRAME_MSWINDOWS_TARGET_RECT (frame) = 0; + } + } + else + { + if (!msframe->sizing && !FRAME_VISIBLE_P (frame)) + mswindows_enqueue_magic_event (hwnd, XM_MAPFRAME); + FRAME_VISIBLE_P (frame) = 1; + + if (!msframe->sizing || mswindows_dynamic_frame_resize) + redisplay (); + } } } - } - break; + break; + + case WM_DISPLAYCHANGE: + { + struct device *d; - /* Misc magic events which only require that the frame be identified */ - case WM_SETFOCUS: - case WM_KILLFOCUS: - mswindows_enqueue_magic_event (hwnd, message); - break; + fobj = mswindows_find_frame (hwnd); + frame = XFRAME (fobj); + d = XDEVICE (FRAME_DEVICE (frame)); - case WM_WINDOWPOSCHANGING: - { - WINDOWPOS *wp = (LPWINDOWPOS) lParam; - WINDOWPLACEMENT wpl = { sizeof(WINDOWPLACEMENT) }; - GetWindowPlacement(hwnd, &wpl); - - /* Only interested if size is changing and we're not being iconified */ - if (wpl.showCmd != SW_SHOWMINIMIZED - && wpl.showCmd != SW_SHOWMAXIMIZED - && !(wp->flags & SWP_NOSIZE)) + DEVICE_MSWINDOWS_HORZRES(d) = LOWORD (lParam); + DEVICE_MSWINDOWS_VERTRES(d) = HIWORD (lParam); + DEVICE_MSWINDOWS_BITSPIXEL(d) = wParam; + break; + } + + /* Misc magic events which only require that the frame be identified */ + case WM_SETFOCUS: + case WM_KILLFOCUS: + mswindows_enqueue_magic_event (hwnd, message); + break; + + case WM_WINDOWPOSCHANGING: { - RECT ncsize = { 0, 0, 0, 0 }; - int pixwidth, pixheight; - AdjustWindowRectEx (&ncsize, GetWindowLong (hwnd, GWL_STYLE), - GetMenu(hwnd) != NULL, - GetWindowLong (hwnd, GWL_EXSTYLE)); - - round_size_to_real_char (XFRAME (mswindows_find_frame (hwnd)), - wp->cx - (ncsize.right - ncsize.left), - wp->cy - (ncsize.bottom - ncsize.top), - &pixwidth, &pixheight); - - /* Convert client sizes to window sizes */ - pixwidth += (ncsize.right - ncsize.left); - pixheight += (ncsize.bottom - ncsize.top); - - if (wpl.showCmd != SW_SHOWMAXIMIZED) + WINDOWPOS *wp = (LPWINDOWPOS) lParam; + WINDOWPLACEMENT wpl = { sizeof(WINDOWPLACEMENT) }; + GetWindowPlacement(hwnd, &wpl); + + /* Only interested if size is changing and we're not being iconified */ + if (wpl.showCmd != SW_SHOWMINIMIZED + && wpl.showCmd != SW_SHOWMAXIMIZED + && !(wp->flags & SWP_NOSIZE)) { - /* Adjust so that the bottom or right doesn't move if it's - * the top or left that's being changed */ - RECT rect; - GetWindowRect (hwnd, &rect); - - if (rect.left != wp->x) - wp->x += wp->cx - pixwidth; - if (rect.top != wp->y) - wp->y += wp->cy - pixheight; + RECT ncsize = { 0, 0, 0, 0 }; + int pixwidth, pixheight; + AdjustWindowRectEx (&ncsize, GetWindowLong (hwnd, GWL_STYLE), + GetMenu(hwnd) != NULL, + GetWindowLong (hwnd, GWL_EXSTYLE)); + + round_size_to_real_char (XFRAME (mswindows_find_frame (hwnd)), + wp->cx - (ncsize.right - ncsize.left), + wp->cy - (ncsize.bottom - ncsize.top), + &pixwidth, &pixheight); + + /* Convert client sizes to window sizes */ + pixwidth += (ncsize.right - ncsize.left); + pixheight += (ncsize.bottom - ncsize.top); + + if (wpl.showCmd != SW_SHOWMAXIMIZED) + { + /* Adjust so that the bottom or right doesn't move if it's + * the top or left that's being changed */ + RECT rect; + GetWindowRect (hwnd, &rect); + + if (rect.left != wp->x) + wp->x += wp->cx - pixwidth; + if (rect.top != wp->y) + wp->y += wp->cy - pixheight; + } + + wp->cx = pixwidth; + wp->cy = pixheight; } - - wp->cx = pixwidth; - wp->cy = pixheight; + /* DefWindowProc sends useful WM_GETMINMAXINFO message, and adjusts + window position if the user tries to track window too small */ } - /* DefWindowProc sends useful WM_GETMINMAXINFO message, and adjusts - window position if the user tries to track window too small */ - } - goto defproc; + goto defproc; - case WM_ENTERSIZEMOVE: - msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); - msframe->sizing = 1; - return 0; + case WM_ENTERSIZEMOVE: + msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); + msframe->sizing = 1; + return 0; - case WM_EXITSIZEMOVE: - msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); - msframe->sizing = 0; - /* Queue noop event */ - mswindows_enqueue_magic_event (NULL, XM_BUMPQUEUE); - return 0; + case WM_EXITSIZEMOVE: + msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); + msframe->sizing = 0; + /* Queue noop event */ + mswindows_enqueue_magic_event (NULL, XM_BUMPQUEUE); + return 0; #ifdef HAVE_SCROLLBARS - case WM_VSCROLL: - case WM_HSCROLL: - { - /* Direction of scroll is determined by scrollbar instance. */ - int code = (int) LOWORD(wParam); - int pos = (short int) HIWORD(wParam); - HWND hwndScrollBar = (HWND) lParam; - struct gcpro gcpro1, gcpro2; - - mswindows_handle_scrollbar_event (hwndScrollBar, code, pos); - GCPRO2 (emacs_event, fobj); - if (UNBOUNDP(mswindows_pump_outstanding_events())) /* Can GC */ - { - /* Error during event pumping - cancel scroll */ - SendMessage (hwndScrollBar, WM_CANCELMODE, 0, 0); - } - UNGCPRO; - break; - } + case WM_VSCROLL: + case WM_HSCROLL: + { + /* Direction of scroll is determined by scrollbar instance. */ + int code = (int) LOWORD(wParam); + int pos = (short int) HIWORD(wParam); + HWND hwndScrollBar = (HWND) lParam; + struct gcpro gcpro1, gcpro2; + + mswindows_handle_scrollbar_event (hwndScrollBar, code, pos); + GCPRO2 (emacs_event, fobj); + if (UNBOUNDP(mswindows_pump_outstanding_events())) /* Can GC */ + { + /* Error during event pumping - cancel scroll */ + SendMessage (hwndScrollBar, WM_CANCELMODE, 0, 0); + } + UNGCPRO; + break; + } - case WM_MOUSEWHEEL: - { - int keys = LOWORD (wParam); /* Modifier key flags */ - int delta = (short) HIWORD (wParam); /* Wheel rotation amount */ - struct gcpro gcpro1, gcpro2; + case WM_MOUSEWHEEL: + { + int keys = LOWORD (wParam); /* Modifier key flags */ + int delta = (short) HIWORD (wParam); /* Wheel rotation amount */ + struct gcpro gcpro1, gcpro2; - if (mswindows_handle_mousewheel_event (mswindows_find_frame (hwnd), keys, delta)) - { - GCPRO2 (emacs_event, fobj); - mswindows_pump_outstanding_events (); /* Can GC */ - UNGCPRO; - } - else - goto defproc; - break; - } + if (mswindows_handle_mousewheel_event (mswindows_find_frame (hwnd), keys, delta)) + { + GCPRO2 (emacs_event, fobj); + mswindows_pump_outstanding_events (); /* Can GC */ + UNGCPRO; + } + else + goto defproc; + break; + } #endif #ifdef HAVE_MENUBARS - case WM_INITMENU: - if (UNBOUNDP (mswindows_handle_wm_initmenu ( - (HMENU) wParam, - XFRAME (mswindows_find_frame (hwnd))))) - SendMessage (hwnd, WM_CANCELMODE, 0, 0); - break; - - case WM_INITMENUPOPUP: - if (!HIWORD(lParam)) - { - if (UNBOUNDP (mswindows_handle_wm_initmenupopup ( - (HMENU) wParam, - XFRAME (mswindows_find_frame (hwnd))))) - SendMessage (hwnd, WM_CANCELMODE, 0, 0); - } - break; + case WM_INITMENU: + if (UNBOUNDP (mswindows_handle_wm_initmenu ( + (HMENU) wParam, + XFRAME (mswindows_find_frame (hwnd))))) + SendMessage (hwnd, WM_CANCELMODE, 0, 0); + break; + + case WM_INITMENUPOPUP: + if (!HIWORD(lParam)) + { + if (UNBOUNDP (mswindows_handle_wm_initmenupopup ( + (HMENU) wParam, + XFRAME (mswindows_find_frame (hwnd))))) + SendMessage (hwnd, WM_CANCELMODE, 0, 0); + } + break; #endif /* HAVE_MENUBARS */ - case WM_COMMAND: - { - WORD id = LOWORD (wParam); - WORD nid = HIWORD (wParam); - HWND cid = (HWND)lParam; - frame = XFRAME (mswindows_find_frame (hwnd)); + case WM_COMMAND: + { + WORD id = LOWORD (wParam); + WORD nid = HIWORD (wParam); + HWND cid = (HWND)lParam; + frame = XFRAME (mswindows_find_frame (hwnd)); #ifdef HAVE_TOOLBARS - if (!NILP (mswindows_handle_toolbar_wm_command (frame, cid, id))) - break; + if (!NILP (mswindows_handle_toolbar_wm_command (frame, cid, id))) + break; #endif - /* widgets in a buffer only eval a callback for suitable events.*/ - switch (nid) - { - case BN_CLICKED: - case EN_CHANGE: - case CBN_EDITCHANGE: - case CBN_SELCHANGE: - if (!NILP (mswindows_handle_gui_wm_command (frame, cid, id))) - return 0; - } - /* menubars always must come last since the hashtables do not - always exist*/ + /* widgets in a buffer only eval a callback for suitable events.*/ + switch (nid) + { + case BN_CLICKED: + case EN_CHANGE: + case CBN_EDITCHANGE: + case CBN_SELCHANGE: + if (!NILP (mswindows_handle_gui_wm_command (frame, cid, id))) + return 0; + } + /* menubars always must come last since the hashtables do not + always exist*/ #ifdef HAVE_MENUBARS - if (!NILP (mswindows_handle_wm_command (frame, id))) - break; + if (!NILP (mswindows_handle_wm_command (frame, id))) + break; #endif - return DefWindowProc (hwnd, message, wParam, lParam); - /* Bite me - a spurious command. This used to not be able to - happen but with the introduction of widgets its now - possible. */ - } - break; + return DefWindowProc (hwnd, message, wParam, lParam); + /* Bite me - a spurious command. This used to not be able to + happen but with the introduction of widgets its now + possible. */ + } + break; - case WM_CTLCOLORBTN: - case WM_CTLCOLORLISTBOX: - case WM_CTLCOLOREDIT: - case WM_CTLCOLORSTATIC: - case WM_CTLCOLORSCROLLBAR: - { - /* if we get an opportunity to paint a widget then do so if - there is an appropriate face */ - HWND crtlwnd = (HWND)lParam; - LONG ii = GetWindowLong (crtlwnd, GWL_USERDATA); - if (ii) - { - Lisp_Object image_instance; - VOID_TO_LISP (image_instance, ii); - if (IMAGE_INSTANCEP (image_instance) - && - IMAGE_INSTANCE_TYPE_P (image_instance, IMAGE_WIDGET)) - { - /* set colors for the buttons */ - HDC hdc = (HDC)wParam; - if (last_widget_brushed != ii) - { - if (widget_brush) - DeleteObject (widget_brush); - widget_brush = CreateSolidBrush - (COLOR_INSTANCE_MSWINDOWS_COLOR - (XCOLOR_INSTANCE - (FACE_BACKGROUND - (XIMAGE_INSTANCE_WIDGET_FACE (image_instance), - XIMAGE_INSTANCE_SUBWINDOW_FRAME (image_instance))))); - } - last_widget_brushed = ii; - SetTextColor - (hdc, - COLOR_INSTANCE_MSWINDOWS_COLOR - (XCOLOR_INSTANCE - (FACE_FOREGROUND - (XIMAGE_INSTANCE_WIDGET_FACE (image_instance), - XIMAGE_INSTANCE_SUBWINDOW_FRAME (image_instance))))); - SetBkMode (hdc, OPAQUE); - SetBkColor - (hdc, - COLOR_INSTANCE_MSWINDOWS_COLOR - (XCOLOR_INSTANCE - (FACE_BACKGROUND - (XIMAGE_INSTANCE_WIDGET_FACE (image_instance), - XIMAGE_INSTANCE_SUBWINDOW_FRAME (image_instance))))); - return (LRESULT)widget_brush; - } - } - } - goto defproc; + case WM_CTLCOLORBTN: + case WM_CTLCOLORLISTBOX: + case WM_CTLCOLOREDIT: + case WM_CTLCOLORSTATIC: + case WM_CTLCOLORSCROLLBAR: + { + /* if we get an opportunity to paint a widget then do so if + there is an appropriate face */ + HWND crtlwnd = (HWND)lParam; + LONG ii = GetWindowLong (crtlwnd, GWL_USERDATA); + if (ii) + { + Lisp_Object image_instance; + VOID_TO_LISP (image_instance, ii); + if (IMAGE_INSTANCEP (image_instance) + && + IMAGE_INSTANCE_TYPE_P (image_instance, IMAGE_WIDGET)) + { + /* set colors for the buttons */ + HDC hdc = (HDC)wParam; + if (last_widget_brushed != ii) + { + if (widget_brush) + DeleteObject (widget_brush); + widget_brush = CreateSolidBrush + (COLOR_INSTANCE_MSWINDOWS_COLOR + (XCOLOR_INSTANCE + (FACE_BACKGROUND + (XIMAGE_INSTANCE_WIDGET_FACE (image_instance), + XIMAGE_INSTANCE_SUBWINDOW_FRAME (image_instance))))); + } + last_widget_brushed = ii; + SetTextColor + (hdc, + COLOR_INSTANCE_MSWINDOWS_COLOR + (XCOLOR_INSTANCE + (FACE_FOREGROUND + (XIMAGE_INSTANCE_WIDGET_FACE (image_instance), + XIMAGE_INSTANCE_SUBWINDOW_FRAME (image_instance))))); + SetBkMode (hdc, OPAQUE); + SetBkColor + (hdc, + COLOR_INSTANCE_MSWINDOWS_COLOR + (XCOLOR_INSTANCE + (FACE_BACKGROUND + (XIMAGE_INSTANCE_WIDGET_FACE (image_instance), + XIMAGE_INSTANCE_SUBWINDOW_FRAME (image_instance))))); + return (LRESULT)widget_brush; + } + } + } + goto defproc; #ifdef HAVE_DRAGNDROP - case WM_DROPFILES: /* implementation ripped-off from event-Xt.c */ - { - UINT filecount, i, len; - POINT point; - char* filename; -#ifdef __CYGWIN32__ - char* fname; -#endif - Lisp_Object l_dndlist = Qnil, l_item = Qnil; - struct gcpro gcpro1, gcpro2, gcpro3; + case WM_DROPFILES: /* implementation ripped-off from event-Xt.c */ + { + UINT filecount, i, len; + POINT point; + char* filename; + char* fname; - emacs_event = Fmake_event (Qnil, Qnil); - event = XEVENT(emacs_event); + Lisp_Object l_dndlist = Qnil, l_item = Qnil; + struct gcpro gcpro1, gcpro2, gcpro3; - GCPRO3 (emacs_event, l_dndlist, l_item); + emacs_event = Fmake_event (Qnil, Qnil); + event = XEVENT(emacs_event); - if (!DragQueryPoint ((HDROP) wParam, &point)) - point.x = point.y = -1; /* outside client area */ + GCPRO3 (emacs_event, l_dndlist, l_item); - event->event_type = misc_user_event; - event->channel = mswindows_find_frame(hwnd); - event->timestamp = GetMessageTime(); - event->event.misc.button = 1; /* #### Should try harder */ - event->event.misc.modifiers = mswindows_modifier_state (NULL, 0); - event->event.misc.x = point.x; - event->event.misc.y = point.y; - event->event.misc.function = Qdragdrop_drop_dispatch; + if (!DragQueryPoint ((HDROP) wParam, &point)) + point.x = point.y = -1; /* outside client area */ + + event->event_type = misc_user_event; + event->channel = mswindows_find_frame(hwnd); + event->timestamp = GetMessageTime(); + event->event.misc.button = 1; /* #### Should try harder */ + event->event.misc.modifiers = mswindows_modifier_state (NULL, 0); + event->event.misc.x = point.x; + event->event.misc.y = point.y; + event->event.misc.function = Qdragdrop_drop_dispatch; + + filecount = DragQueryFile ((HDROP) wParam, 0xffffffff, NULL, 0); + for (i=0; i/ part and + * because they may contain reserved characters. But that's OK - + * they just need to be good enough to keep dragdrop.el happy. */ + fname = (char *)xmalloc (len+1); + DragQueryFile ((HANDLE) wParam, i, fname, len+1); + + /* May be a shell link aka "shortcut" - replace fname if so */ +#if !(defined(__CYGWIN32__) || defined(__MINGW32__)) + /* cygwin doesn't define this COM stuff */ + if (!stricmp (fname + strlen (fname) - 4, ".LNK")) + { + IShellLink* psl; + + if (CoCreateInstance (&CLSID_ShellLink, NULL, + CLSCTX_INPROC_SERVER, &IID_IShellLink, &psl) == S_OK) + { + IPersistFile* ppf; + + if (psl->lpVtbl->QueryInterface (psl, &IID_IPersistFile, + &ppf) == S_OK) + { + WORD wsz[MAX_PATH]; + WIN32_FIND_DATA wfd; + LPSTR resolved = (char *) xmalloc (MAX_PATH+1); + + MultiByteToWideChar (CP_ACP,0, fname, -1, wsz, MAX_PATH); + + if ((ppf->lpVtbl->Load (ppf, wsz, STGM_READ) == S_OK) && + (psl->lpVtbl->GetPath (psl, resolved, MAX_PATH, + &wfd, 0)==S_OK)) + { + xfree (fname); + fname = resolved; + len = strlen (fname); + } + + ppf->lpVtbl->Release (ppf); + } + + psl->lpVtbl->Release (psl); + } + } +#endif - filecount = DragQueryFile ((HDROP) wParam, 0xffffffff, NULL, 0); - for (i=0; i/ part and - * because they may contain reserved characters. But that's OK. */ #ifdef __CYGWIN32__ - fname = (char *)xmalloc (len+1); - DragQueryFile ((HANDLE) wParam, i, fname, len+1); - filename = xmalloc (cygwin32_win32_to_posix_path_list_buf_size (fname) + 5); - strcpy (filename, "file:"); - cygwin32_win32_to_posix_path_list (fname, filename+5); - xfree (fname); + filename = xmalloc (cygwin32_win32_to_posix_path_list_buf_size (fname) + 5); + strcpy (filename, "file:"); + cygwin32_win32_to_posix_path_list (fname, filename+5); #else - filename = (char *)xmalloc (len+6); - strcpy (filename, "file:"); - DragQueryFile ((HDROP) wParam, i, filename+5, len+1); - dostounix_filename (filename+5); + filename = (char *)xmalloc (len+6); + strcat (strcpy (filename, "file:"), fname); + dostounix_filename (filename+5); #endif - l_item = make_string (filename, strlen (filename)); - l_dndlist = Fcons (l_item, l_dndlist); - xfree (filename); - } - DragFinish ((HDROP) wParam); + xfree (fname); + l_item = make_string (filename, strlen (filename)); + l_dndlist = Fcons (l_item, l_dndlist); + xfree (filename); + } + DragFinish ((HDROP) wParam); - event->event.misc.object = Fcons (Qdragdrop_URL, l_dndlist); - mswindows_enqueue_dispatch_event (emacs_event); - UNGCPRO; - } - break; + event->event.misc.object = Fcons (Qdragdrop_URL, l_dndlist); + mswindows_enqueue_dispatch_event (emacs_event); + UNGCPRO; + } + break; #endif - defproc: - default: - return DefWindowProc (hwnd, message, wParam, lParam); - } + defproc: + default: + return DefWindowProc (hwnd, message, wParam, lParam); + } return (0); } @@ -2487,16 +2583,16 @@ int mswindows_modifier_state (BYTE* keymap, int has_AltGr) if (has_AltGr && (keymap [VK_LCONTROL] & 0x80) && (keymap [VK_RMENU] & 0x80)) { - mods |= (keymap [VK_LMENU] & 0x80) ? MOD_META : 0; - mods |= (keymap [VK_RCONTROL] & 0x80) ? MOD_CONTROL : 0; + mods |= (keymap [VK_LMENU] & 0x80) ? XEMACS_MOD_META : 0; + mods |= (keymap [VK_RCONTROL] & 0x80) ? XEMACS_MOD_CONTROL : 0; } else { - mods |= (keymap [VK_MENU] & 0x80) ? MOD_META : 0; - mods |= (keymap [VK_CONTROL] & 0x80) ? MOD_CONTROL : 0; + mods |= (keymap [VK_MENU] & 0x80) ? XEMACS_MOD_META : 0; + mods |= (keymap [VK_CONTROL] & 0x80) ? XEMACS_MOD_CONTROL : 0; } - mods |= (keymap [VK_SHIFT] & 0x80) ? MOD_SHIFT : 0; + mods |= (keymap [VK_SHIFT] & 0x80) ? XEMACS_MOD_SHIFT : 0; return mods; } @@ -2554,8 +2650,8 @@ Lisp_Object mswindows_key_to_emacs_keysym (int mswindows_key, int mods, case VK_DELETE: return KEYSYM ("kp-delete"); case VK_HELP: return KEYSYM ("help"); #if 0 /* FSF Emacs allows these to return configurable syms/mods */ - case VK_LWIN return KEYSYM (""); - case VK_RWIN return KEYSYM (""); + case VK_LWIN return KEYSYM (""); + case VK_RWIN return KEYSYM (""); #endif case VK_APPS: return KEYSYM ("menu"); case VK_NUMPAD0: return KEYSYM ("kp-0"); @@ -2717,7 +2813,11 @@ emacs_mswindows_handle_magic_event (Lisp_Event *emacs_event) break; case WM_PAINT: - mswindows_handle_paint (XFRAME (EVENT_CHANNEL (emacs_event))); + { + struct frame *f = XFRAME (EVENT_CHANNEL (emacs_event)); + mswindows_handle_paint (f); + (FRAME_MSWINDOWS_DATA (f))->paint_pending = 0; + } break; case WM_SETFOCUS: @@ -2778,7 +2878,7 @@ get_process_input_waitable (Lisp_Process *process) ? get_winsock_stream_waitable (XLSTREAM (instr)) : get_ntpipe_input_stream_waitable (XLSTREAM (instr))); #else - return get_ntpipe_input_stream_waitable (XLSTREAM (instr)); + return get_ntpipe_input_stream_waitable (XLSTREAM (instr)); #endif } @@ -2866,7 +2966,7 @@ emacs_mswindows_quit_p (void) emacs_event = mswindows_cancel_dispatch_event (&match_against); assert (!NILP (emacs_event)); - if (XEVENT(emacs_event)->event.key.modifiers & MOD_SHIFT) + if (XEVENT(emacs_event)->event.key.modifiers & XEMACS_MOD_SHIFT) critical_p = 1; Fdeallocate_event(emacs_event); @@ -2950,7 +3050,7 @@ emacs_mswindows_create_stream_pair (void* inhandle, void* outhandle, USID emacs_mswindows_delete_stream_pair (Lisp_Object instream, - Lisp_Object outstream) + Lisp_Object outstream) { /* Oh nothing special here for Win32 at all */ #if defined (HAVE_UNIX_PROCESSES) @@ -3012,6 +3112,7 @@ reinit_vars_of_event_mswindows (void) mswindows_event_stream = xnew (struct event_stream); mswindows_event_stream->event_pending_p = emacs_mswindows_event_pending_p; + mswindows_event_stream->force_event_pending = 0; mswindows_event_stream->next_event_cb = emacs_mswindows_next_event; mswindows_event_stream->handle_magic_event_cb = emacs_mswindows_handle_magic_event; mswindows_event_stream->add_timeout_cb = emacs_mswindows_add_timeout; @@ -3052,13 +3153,16 @@ vars_of_event_mswindows (void) mswindows_error_caught_in_modal_loop = Qnil; staticpro (&mswindows_error_caught_in_modal_loop); - DEFVAR_BOOL ("mswindows-meta-activates-menu", &mswindows_meta_activates_menu /* -*Controls whether pressing and releasing the Meta (Alt) key should -activate the menubar. + DEFVAR_BOOL ("mswindows-alt-by-itself-activates-menu", + &mswindows_alt_by_itself_activates_menu /* +*Controls whether pressing and releasing the Alt key activates the menubar. +This applies only if no intervening key was pressed. See also +`menu-accelerator-enabled', which is probably the behavior you actually want. Default is t. */ ); - DEFVAR_BOOL ("mswindows-dynamic-frame-resize", &mswindows_dynamic_frame_resize /* + DEFVAR_BOOL ("mswindows-dynamic-frame-resize", + &mswindows_dynamic_frame_resize /* *Controls redrawing frame contents during mouse-drag or keyboard resize operation. When non-nil, the frame is redrawn while being resized. When nil, frame is not redrawn, and exposed areas are filled with default @@ -3068,8 +3172,8 @@ settings. Default is t on fast machines, nil on slow. */ ); -/* The description copied verbatim from nt-emacs. (C) Geoff Voelker */ - DEFVAR_INT ("mswindows-mouse-button-tolerance", &mswindows_mouse_button_tolerance /* + DEFVAR_INT ("mswindows-mouse-button-tolerance", + &mswindows_mouse_button_tolerance /* *Analogue of double click interval for faking middle mouse events. The value is the minimum time in milliseconds that must elapse between left/right button down events before they are considered distinct events. @@ -3078,12 +3182,12 @@ button down event is generated instead. If negative or zero, currently set system default is used instead. */ ); -/* The description copied verbatim from nt-emacs. (C) Geoff Voelker */ DEFVAR_INT ("mswindows-num-mouse-buttons", &mswindows_num_mouse_buttons /* Number of physical mouse buttons. */ ); - DEFVAR_INT ("mswindows-mouse-button-max-skew-x", &mswindows_mouse_button_max_skew_x /* + DEFVAR_INT ("mswindows-mouse-button-max-skew-x", + &mswindows_mouse_button_max_skew_x /* *Maximum horizontal distance in pixels between points in which left and right button clicks occurred for them to be translated into single middle button event. Clicks must occur in time not longer than defined @@ -3091,7 +3195,8 @@ by the variable `mswindows-mouse-button-tolerance'. If negative or zero, currently set system default is used instead. */ ); - DEFVAR_INT ("mswindows-mouse-button-max-skew-y", &mswindows_mouse_button_max_skew_y /* + DEFVAR_INT ("mswindows-mouse-button-max-skew-y", + &mswindows_mouse_button_max_skew_y /* *Maximum vertical distance in pixels between points in which left and right button clicks occurred for them to be translated into single middle button event. Clicks must occur in time not longer than defined @@ -3102,7 +3207,7 @@ If negative or zero, currently set system default is used instead. mswindows_mouse_button_max_skew_x = 0; mswindows_mouse_button_max_skew_y = 0; mswindows_mouse_button_tolerance = 0; - mswindows_meta_activates_menu = 1; + mswindows_alt_by_itself_activates_menu = 1; } void diff --git a/src/event-stream.c b/src/event-stream.c index 8871609..4b67a2e 100644 --- a/src/event-stream.c +++ b/src/event-stream.c @@ -23,6 +23,20 @@ Boston, MA 02111-1307, USA. */ /* Synched up with: Not in FSF. */ +/* Authorship: + + Created 1991 by Jamie Zawinski. + A great deal of work over the ages by Ben Wing (Mule-ization for 19.12, + device abstraction for 19.12/19.13, async timers for 19.14, + rewriting of focus code for 19.12, pre-idle hook for 19.12, + redoing of signal and quit handling for 19.9 and 19.12, + misc-user events to clean up menu/scrollbar handling for 19.11, + function-key-map/key-translation-map/keyboard-translate-table for + 19.13/19.14, open-dribble-file for 19.13, much other cleanup). + focus-follows-mouse from Chuck Thompson, 1995. + XIM stuff by Martin Buchholz, c. 1996?. +*/ + /* This file has been Mule-ized. */ /* @@ -38,8 +52,6 @@ Boston, MA 02111-1307, USA. */ /* TODO: This stuff is way too hard to maintain - needs rework. - (global-set-key "\C-p" global-map) causes a crash - need recursion check. - C-x @ h x causes a crash. The command builder should deal only with key and button events. @@ -62,14 +74,6 @@ Boston, MA 02111-1307, USA. */ #include #include "lisp.h" -#ifdef HAVE_X_WINDOWS -#include "console-x.h" /* for menu accelerators ... */ -#include "gui-x.h" -#include "../lwlib/lwlib.h" -#else -#define lw_menu_active 0 -#endif - #include "blocktype.h" #include "buffer.h" #include "commands.h" @@ -81,6 +85,7 @@ Boston, MA 02111-1307, USA. */ #include "keymap.h" #include "lstream.h" #include "macros.h" /* for defining_keyboard_macro */ +#include "menubar.h" /* #### for evil kludges. */ #include "process.h" #include "window.h" @@ -107,21 +112,22 @@ Lisp_Object Qcommand_event_p; Lisp_Object Vpre_command_hook, Vpost_command_hook; Lisp_Object Qpre_command_hook, Qpost_command_hook; +/* See simple.el */ +Lisp_Object Qhandle_pre_motion_command, Qhandle_post_motion_command; + /* Hook run when XEmacs is about to be idle. */ Lisp_Object Qpre_idle_hook, Vpre_idle_hook; /* Control gratuitous keyboard focus throwing. */ int focus_follows_mouse; -#ifdef ILL_CONCEIVED_HOOK +#if 0 /* FSF Emacs crap */ /* Hook run after a command if there's no more input soon. */ Lisp_Object Qpost_command_idle_hook, Vpost_command_idle_hook; /* Delay time in microseconds before running post-command-idle-hook. */ int post_command_idle_delay; -#endif /* ILL_CONCEIVED_HOOK */ -#ifdef DEFERRED_ACTION_CRAP /* List of deferred actions to be performed at a later time. The precise format isn't relevant here; we just check whether it is nil. */ Lisp_Object Vdeferred_action_list; @@ -129,7 +135,7 @@ Lisp_Object Vdeferred_action_list; /* Function to call to handle deferred actions, when there are any. */ Lisp_Object Vdeferred_action_function; Lisp_Object Qdeferred_action_function; -#endif /* DEFERRED_ACTION_CRAP */ +#endif /* FSF Emacs crap */ /* Non-nil disable property on a command means do not execute it; call disabled-command-hook's value instead. */ @@ -164,13 +170,20 @@ Lisp_Object Vunread_command_event; /* obsoleteness support */ static Lisp_Object Qunread_command_events, Qunread_command_event; /* Previous command, represented by a Lisp object. - Does not include prefix commands and arg setting commands */ + Does not include prefix commands and arg setting commands. */ Lisp_Object Vlast_command; +/* Contents of this-command-properties for the last command. */ +Lisp_Object Vlast_command_properties; + /* If a command sets this, the value goes into - previous-command for the next command. */ + last-command for the next command. */ Lisp_Object Vthis_command; +/* If a command sets this, the value goes into + last-command-properties for the next command. */ +Lisp_Object Vthis_command_properties; + /* The value of point when the last command was executed. */ Bufpos last_point_position; @@ -235,30 +248,6 @@ int recent_keys_ring_index; recent-keys. */ int inhibit_input_event_recording; -/* prefix key(s) that must match in order to activate menu. - This is ugly. fix me. - */ -Lisp_Object Vmenu_accelerator_prefix; - -/* list of modifier keys to match accelerator for top level menus */ -Lisp_Object Vmenu_accelerator_modifiers; - -/* whether menu accelerators are enabled */ -Lisp_Object Vmenu_accelerator_enabled; - -/* keymap for auxiliary menu accelerator functions */ -Lisp_Object Vmenu_accelerator_map; - -Lisp_Object Qmenu_force; -Lisp_Object Qmenu_fallback; -Lisp_Object Qmenu_quit; -Lisp_Object Qmenu_up; -Lisp_Object Qmenu_down; -Lisp_Object Qmenu_left; -Lisp_Object Qmenu_right; -Lisp_Object Qmenu_select; -Lisp_Object Qmenu_escape; - Lisp_Object Qself_insert_defer_undo; /* this is in keymap.c */ @@ -288,60 +277,6 @@ external_debugging_print_event (char *event_description, Lisp_Object event) /* The callback routines for the window system or terminal driver */ struct event_stream *event_stream; -/* This structure is what we use to encapsulate the state of a command sequence - being composed; key events are executed by adding themselves to the command - builder; if the command builder is then complete (does not still represent - a prefix key sequence) it executes the corresponding command. - */ -struct command_builder -{ - struct lcrecord_header header; - Lisp_Object console; /* back pointer to the console this command - builder is for */ - /* Qnil, or a Lisp_Event representing the first event read - * after the last command completed. Threaded. */ - /* #### NYI */ - Lisp_Object prefix_events; - /* Qnil, or a Lisp_Event representing event in the current - * keymap-lookup sequence. Subsequent events are threaded via - * the event's next slot */ - Lisp_Object current_events; - /* Last elt of above */ - Lisp_Object most_current_event; - /* Last elt before function map code took over. What this means is: - All prefixes up to (but not including) this event have non-nil - bindings, but the prefix including this event has a nil binding. - Any events in the chain after this one were read solely because - we're part of a possible function key. If we end up with - something that's not part of a possible function key, we have to - unread all of those events. */ - Lisp_Object last_non_munged_event; - /* One set of values for function-key-map, one for key-translation-map */ - struct munging_key_translation - { - /* First event that can begin a possible function key sequence - (to be translated according to function-key-map). Normally - this is the first event in the chain. However, once we've - translated a sequence through function-key-map, this will point - to the first event after the translated sequence: we don't ever - want to translate any events twice through function-key-map, or - things could get really screwed up (e.g. if the user created a - translation loop). If this is nil, then the next-read event is - the first that can begin a function key sequence. */ - Lisp_Object first_mungeable_event; - } munge_me[2]; - - Bufbyte *echo_buf; - Bytecount echo_buf_length; /* size of echo_buf */ - Bytecount echo_buf_index; /* index into echo_buf - * -1 before doing echoing for new cmd */ - /* Self-insert-command is magic in that it doesn't always push an undo- - boundary: up to 20 consecutive self-inserts can happen before an undo- - boundary is pushed. This variable is that counter. - */ - int self_insert_countdown; -}; - static void echo_key_event (struct command_builder *, Lisp_Object event); static void maybe_kbd_translate (Lisp_Object event); @@ -507,6 +442,13 @@ event_stream_event_pending_p (int user) return event_stream && event_stream->event_pending_p (user); } +static void +event_stream_force_event_pending (struct frame* f) +{ + if (event_stream->force_event_pending) + event_stream->force_event_pending (f); +} + static int maybe_read_quit_event (Lisp_Event *event) { @@ -734,7 +676,10 @@ maybe_echo_keys (struct command_builder *command_builder, int no_snooze) if (minibuf_level == 0 && echo_keystrokes > 0.0 - && !lw_menu_active) +#if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID) + && !x_kludge_lw_menu_active () +#endif + ) { if (!no_snooze) { @@ -2123,9 +2068,6 @@ The returned event will be one of the following types: XCOMMAND_BUILDER (con->command_builder); int store_this_key = 0; struct gcpro gcpro1; -#ifdef LWLIB_MENUBARS_LUCID - extern int in_menu_callback; /* defined in menubar-x.c */ -#endif /* LWLIB_MENUBARS_LUCID */ GCPRO1 (event); /* DO NOT do QUIT anywhere within this function or the functions it calls. @@ -2401,6 +2343,56 @@ but it also makes a provision for displaying keystrokes in the echo area. return event; } +DEFUN ("dispatch-non-command-events", Fdispatch_non_command_events, 0, 0, 0, /* +Dispatch any pending "magic" events. + +This function is useful for forcing the redisplay of native +widgets. Normally these are redisplayed through a native window-system +event encoded as magic event, rather than by the redisplay code. This +function does not call redisplay or do any of the other things that +`next-event' does. +*/ + ()) +{ + /* This function can GC */ + Lisp_Object event = Qnil; + struct gcpro gcpro1; + GCPRO1 (event); + event = Fmake_event (Qnil, Qnil); + + /* Make sure that there will be something in the native event queue + so that externally managed things (e.g. widgets) get some CPU + time. */ + event_stream_force_event_pending (selected_frame ()); + + while (event_stream_event_pending_p (0)) + { + QUIT; /* next_event_internal() does not QUIT. */ + + /* We're a generator of the command_event_queue, so we can't be a + consumer as well. Also, we have no reason to consult the + command_event_queue; there are only user and eval-events there, + and we'd just have to put them back anyway. + */ + next_event_internal (event, 0); /* blocks */ + /* See the comment in accept-process-output about Vquit_flag */ + if (XEVENT_TYPE (event) == magic_event || + XEVENT_TYPE (event) == timeout_event || + XEVENT_TYPE (event) == process_event || + XEVENT_TYPE (event) == pointer_motion_event) + execute_internal_event (event); + else + { + enqueue_command_event_1 (event); + break; + } + } + + Fdeallocate_event (event); + UNGCPRO; + return Qnil; +} + static void reset_current_events (struct command_builder *command_builder) { @@ -3096,502 +3088,6 @@ command_builder_find_leaf_1 (struct command_builder *builder) return event_binding (event0, 1); } -#if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID) -static void -menu_move_up (void) -{ - widget_value *current = lw_get_entries (False); - widget_value *entries = lw_get_entries (True); - widget_value *prev = NULL; - - while (entries != current) - { - if (entries->name /*&& entries->enabled*/) prev = entries; - entries = entries->next; - assert (entries); - } - - if (!prev) - /* move to last item */ - { - while (entries->next) - { - if (entries->name /*&& entries->enabled*/) prev = entries; - entries = entries->next; - } - if (prev) - { - if (entries->name /*&& entries->enabled*/) - prev = entries; - } - else - { - /* no selectable items in this menu, pop up to previous level */ - lw_pop_menu (); - return; - } - } - lw_set_item (prev); -} - -static void -menu_move_down (void) -{ - widget_value *current = lw_get_entries (False); - widget_value *new = current; - - while (new->next) - { - new = new->next; - if (new->name /*&& new->enabled*/) break; - } - - if (new==current||!(new->name/*||new->enabled*/)) - { - new = lw_get_entries (True); - while (new!=current) - { - if (new->name /*&& new->enabled*/) break; - new = new->next; - } - if (new==current&&!(new->name /*|| new->enabled*/)) - { - lw_pop_menu (); - return; - } - } - - lw_set_item (new); -} - -static void -menu_move_left (void) -{ - int level = lw_menu_level (); - int l = level; - widget_value *current; - - while (level-- >= 3) - lw_pop_menu (); - - menu_move_up (); - current = lw_get_entries (False); - if (l > 2 && current->contents) - lw_push_menu (current->contents); -} - -static void -menu_move_right (void) -{ - int level = lw_menu_level (); - int l = level; - widget_value *current; - - while (level-- >= 3) - lw_pop_menu (); - - menu_move_down (); - current = lw_get_entries (False); - if (l > 2 && current->contents) - lw_push_menu (current->contents); -} - -static void -menu_select_item (widget_value *val) -{ - if (val == NULL) - val = lw_get_entries (False); - - /* is match a submenu? */ - - if (val->contents) - { - /* enter the submenu */ - - lw_set_item (val); - lw_push_menu (val->contents); - } - else - { - /* Execute the menu entry by calling the menu's `select' - callback function - */ - lw_kill_menus (val); - } -} - -static Lisp_Object -command_builder_operate_menu_accelerator (struct command_builder *builder) -{ - /* this function can GC */ - - struct console *con = XCONSOLE (Vselected_console); - Lisp_Object evee = builder->most_current_event; - Lisp_Object binding; - widget_value *entries; - - extern int lw_menu_accelerate; /* lwlib.c */ - -#if 0 - { - int i; - Lisp_Object t; - char buf[50]; - - t = builder->current_events; - i = 0; - while (!NILP (t)) - { - i++; - sprintf (buf,"OPERATE (%d): ",i); - write_c_string (buf, Qexternal_debugging_output); - print_internal (t, Qexternal_debugging_output, 1); - write_c_string ("\n", Qexternal_debugging_output); - t = XEVENT_NEXT (t); - } - } -#endif /* 0 */ - - /* menu accelerator keys don't go into keyboard macros */ - if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro)) - con->kbd_macro_ptr = con->kbd_macro_end; - - /* don't echo menu accelerator keys */ - /*reset_key_echo (builder, 1);*/ - - if (!lw_menu_accelerate) - { - /* `convert' mouse display to keyboard display - by entering the open submenu - */ - entries = lw_get_entries (False); - if (entries->contents) - { - lw_push_menu (entries->contents); - lw_display_menu (CurrentTime); - } - } - - /* compare event to the current menu accelerators */ - - entries=lw_get_entries (True); - - while (entries) - { - Lisp_Object accel; - VOID_TO_LISP (accel, entries->accel); - if (entries->name && !NILP (accel)) - { - if (event_matches_key_specifier_p (XEVENT (evee), accel)) - { - /* a match! */ - - menu_select_item (entries); - - if (lw_menu_active) lw_display_menu (CurrentTime); - - reset_this_command_keys (Vselected_console, 1); - /*reset_command_builder_event_chain (builder);*/ - return Vmenu_accelerator_map; - } - } - entries = entries->next; - } - - /* try to look up event in menu-accelerator-map */ - - binding = event_binding_in (evee, Vmenu_accelerator_map, 1); - - if (NILP (binding)) - { - /* beep at user for undefined key */ - return Qnil; - } - else - { - if (EQ (binding, Qmenu_quit)) - { - /* turn off menus and set quit flag */ - lw_kill_menus (NULL); - Vquit_flag = Qt; - } - else if (EQ (binding, Qmenu_up)) - { - int level = lw_menu_level (); - if (level > 2) - menu_move_up (); - } - else if (EQ (binding, Qmenu_down)) - { - int level = lw_menu_level (); - if (level > 2) - menu_move_down (); - else - menu_select_item (NULL); - } - else if (EQ (binding, Qmenu_left)) - { - int level = lw_menu_level (); - if (level > 3) - { - lw_pop_menu (); - lw_display_menu (CurrentTime); - } - else - menu_move_left (); - } - else if (EQ (binding, Qmenu_right)) - { - int level = lw_menu_level (); - if (level > 2 && - lw_get_entries (False)->contents) - { - widget_value *current = lw_get_entries (False); - if (current->contents) - menu_select_item (NULL); - } - else - menu_move_right (); - } - else if (EQ (binding, Qmenu_select)) - menu_select_item (NULL); - else if (EQ (binding, Qmenu_escape)) - { - int level = lw_menu_level (); - - if (level > 2) - { - lw_pop_menu (); - lw_display_menu (CurrentTime); - } - else - { - /* turn off menus quietly */ - lw_kill_menus (NULL); - } - } - else if (KEYMAPP (binding)) - { - /* prefix key */ - reset_this_command_keys (Vselected_console, 1); - /*reset_command_builder_event_chain (builder);*/ - return binding; - } - else - { - /* turn off menus and execute binding */ - lw_kill_menus (NULL); - reset_this_command_keys (Vselected_console, 1); - /*reset_command_builder_event_chain (builder);*/ - return binding; - } - } - - if (lw_menu_active) lw_display_menu (CurrentTime); - - reset_this_command_keys (Vselected_console, 1); - /*reset_command_builder_event_chain (builder);*/ - - return Vmenu_accelerator_map; -} - -static Lisp_Object -menu_accelerator_junk_on_error (Lisp_Object errordata, Lisp_Object ignored) -{ - Vmenu_accelerator_prefix = Qnil; - Vmenu_accelerator_modifiers = Qnil; - Vmenu_accelerator_enabled = Qnil; - if (!NILP (errordata)) - { - Lisp_Object args[2]; - - args[0] = build_string ("Error in menu accelerators (setting to nil)"); - /* #### This should call - (with-output-to-string (display-error errordata)) - but that stuff is all in Lisp currently. */ - args[1] = errordata; - warn_when_safe_lispobj - (Qerror, Qwarning, - emacs_doprnt_string_lisp ((const Bufbyte *) "%s: %s", - Qnil, -1, 2, args)); - } - - return Qnil; -} - -static Lisp_Object -menu_accelerator_safe_compare (Lisp_Object event0) -{ - if (CONSP (Vmenu_accelerator_prefix)) - { - Lisp_Object t; - t=Vmenu_accelerator_prefix; - while (!NILP (t) - && !NILP (event0) - && event_matches_key_specifier_p (XEVENT (event0), Fcar (t))) - { - t = Fcdr (t); - event0 = XEVENT_NEXT (event0); - } - if (!NILP (t)) - return Qnil; - } - else if (NILP (event0)) - return Qnil; - else if (event_matches_key_specifier_p (XEVENT (event0), Vmenu_accelerator_prefix)) - event0 = XEVENT_NEXT (event0); - else - return Qnil; - return event0; -} - -static Lisp_Object -menu_accelerator_safe_mod_compare (Lisp_Object cons) -{ - return (event_matches_key_specifier_p (XEVENT (XCAR (cons)), XCDR (cons)) - ? Qt - : Qnil); -} - -static Lisp_Object -command_builder_find_menu_accelerator (struct command_builder *builder) -{ - /* this function can GC */ - Lisp_Object event0 = builder->current_events; - struct console *con = XCONSOLE (Vselected_console); - struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con)); - Widget menubar_widget; - - /* compare entries in event0 against the menu prefix */ - - if ((!CONSOLE_X_P (XCONSOLE (builder->console))) || NILP (event0) || - XEVENT (event0)->event_type != key_press_event) - return Qnil; - - if (!NILP (Vmenu_accelerator_prefix)) - { - event0 = condition_case_1 (Qerror, - menu_accelerator_safe_compare, - event0, - menu_accelerator_junk_on_error, - Qnil); - } - - if (NILP (event0)) - return Qnil; - - menubar_widget = FRAME_X_MENUBAR_WIDGET (f); - if (menubar_widget - && CONSP (Vmenu_accelerator_modifiers)) - { - Lisp_Object fake; - Lisp_Object last = Qnil; - struct gcpro gcpro1; - Lisp_Object matchp; - - widget_value *val; - LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id; - - val = lw_get_all_values (id); - if (val) - { - val = val->contents; - - fake = Fcopy_sequence (Vmenu_accelerator_modifiers); - last = fake; - - while (!NILP (Fcdr (last))) - last = Fcdr (last); - - Fsetcdr (last, Fcons (Qnil, Qnil)); - last = Fcdr (last); - } - - fake = Fcons (Qnil, fake); - - GCPRO1 (fake); - - while (val) - { - Lisp_Object accel; - VOID_TO_LISP (accel, val->accel); - if (val->name && !NILP (accel)) - { - Fsetcar (last, accel); - Fsetcar (fake, event0); - matchp = condition_case_1 (Qerror, - menu_accelerator_safe_mod_compare, - fake, - menu_accelerator_junk_on_error, - Qnil); - if (!NILP (matchp)) - { - /* we found one! */ - - lw_set_menu (menubar_widget, val); - /* yah - yet another hack. - pretend emacs timestamp is the same as an X timestamp, - which for the moment it is. (read events.h) - */ - lw_map_menu (XEVENT (event0)->timestamp); - - if (val->contents) - lw_push_menu (val->contents); - - lw_display_menu (CurrentTime); - - /* menu accelerator keys don't go into keyboard macros */ - if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro)) - con->kbd_macro_ptr = con->kbd_macro_end; - - /* don't echo menu accelerator keys */ - /*reset_key_echo (builder, 1);*/ - reset_this_command_keys (Vselected_console, 1); - UNGCPRO; - - return Vmenu_accelerator_map; - } - } - - val = val->next; - } - - UNGCPRO; - } - return Qnil; -} - - -DEFUN ("accelerate-menu", Faccelerate_menu, 0, 0, "_", /* -Make the menubar active. Menu items can be selected using menu accelerators -or by actions defined in menu-accelerator-map. -*/ - ()) -{ - struct console *con = XCONSOLE (Vselected_console); - struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con)); - LWLIB_ID id; - widget_value *val; - - if (NILP (f->menubar_data)) - error ("Frame has no menubar."); - - id = XPOPUP_DATA (f->menubar_data)->id; - val = lw_get_all_values (id); - val = val->contents; - lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val); - lw_map_menu (CurrentTime); - - lw_display_menu (CurrentTime); - - /* menu accelerator keys don't go into keyboard macros */ - if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro)) - con->kbd_macro_ptr = con->kbd_macro_end; - - return Qnil; -} -#endif /* HAVE_X_WINDOWS && HAVE_MENUBARS */ - /* See if we can do function-key-map or key-translation-map translation on the current events in the command builder. If so, do this, and return the resulting binding, if any. */ @@ -3713,9 +3209,11 @@ command_builder_find_leaf (struct command_builder *builder, return Qnil; } - /* if we're currently in a menu accelerator, check there for further events */ + /* if we're currently in a menu accelerator, check there for further + events */ + /* #### fuck me! who wrote this crap? think "abstraction", baby. */ #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID) - if (lw_menu_active) + if (x_kludge_lw_menu_active ()) { return command_builder_operate_menu_accelerator (builder); } @@ -3766,14 +3264,14 @@ command_builder_find_leaf (struct command_builder *builder, Lisp_Object terminal = builder->most_current_event; struct key_data* key = & XEVENT (terminal)->event.key; Emchar c = 0; - if ((key->modifiers & MOD_SHIFT) + if ((key->modifiers & XEMACS_MOD_SHIFT) || (CHAR_OR_CHAR_INTP (key->keysym) && ((c = XCHAR_OR_CHAR_INT (key->keysym)), c >= 'A' && c <= 'Z'))) { Lisp_Event terminal_copy = *XEVENT (terminal); - if (key->modifiers & MOD_SHIFT) - key->modifiers &= (~ MOD_SHIFT); + if (key->modifiers & XEMACS_MOD_SHIFT) + key->modifiers &= (~ XEMACS_MOD_SHIFT); else key->keysym = make_char (c + 'a' - 'A'); @@ -4174,10 +3672,10 @@ lookup_command_event (struct command_builder *command_builder, Fcopy_event (event, recent); e = XEVENT (recent); if (e->event_type == key_press_event) - e->event.key.modifiers |= MOD_META; + e->event.key.modifiers |= XEMACS_MOD_META; else if (e->event_type == button_press_event || e->event_type == button_release_event) - e->event.button.modifiers |= MOD_META; + e->event.button.modifiers |= XEMACS_MOD_META; else abort (); @@ -4208,7 +3706,11 @@ lookup_command_event (struct command_builder *command_builder, if (KEYMAPP (leaf)) { - if (!lw_menu_active) +#if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID) + if (!x_kludge_lw_menu_active ()) +#else + if (1) +#endif { Lisp_Object prompt = Fkeymap_prompt (leaf, Qt); if (STRINGP (prompt)) @@ -4228,19 +3730,20 @@ lookup_command_event (struct command_builder *command_builder, else maybe_echo_keys (command_builder, 0); } - else if (!NILP (Vquit_flag)) { - Lisp_Object quit_event = Fmake_event(Qnil, Qnil); - Lisp_Event *e = XEVENT (quit_event); - /* if quit happened during menu acceleration, pretend we read it */ - struct console *con = XCONSOLE (Fselected_console ()); - int ch = CONSOLE_QUIT_CHAR (con); - - character_to_event (ch, e, con, 1, 1); - e->channel = make_console (con); - - enqueue_command_event (quit_event); - Vquit_flag = Qnil; - } + else if (!NILP (Vquit_flag)) + { + Lisp_Object quit_event = Fmake_event (Qnil, Qnil); + Lisp_Event *e = XEVENT (quit_event); + /* if quit happened during menu acceleration, pretend we read it */ + struct console *con = XCONSOLE (Fselected_console ()); + int ch = CONSOLE_QUIT_CHAR (con); + + character_to_event (ch, e, con, 1, 1); + e->channel = make_console (con); + + enqueue_command_event (quit_event); + Vquit_flag = Qnil; + } } else if (!NILP (leaf)) { @@ -4359,6 +3862,9 @@ execute_command_event (struct command_builder *command_builder, { /* Start a new command next time */ Vlast_command = Vthis_command; + Vlast_command_properties = Vthis_command_properties; + Vthis_command_properties = Qnil; + /* Emacs 18 doesn't unconditionally clear the echoed keystrokes, so we don't either */ reset_this_command_keys (make_console (con), 0); @@ -4379,6 +3885,9 @@ pre_command_hook (void) safe_run_hook_trapping_errors ("Error in `pre-command-hook' (setting hook to nil)", Qpre_command_hook, 1); + + /* This is a kludge, but necessary; see simple.el */ + call0 (Qhandle_pre_motion_command); } /* Run the post command hook. */ @@ -4398,14 +3907,18 @@ post_command_hook (void) Lisp_Object win = Fselected_window (Qnil); -#if 0 /* If the last command deleted the frame, `win' might be nil. It seems safest to do nothing in this case. */ + /* Note: Someone added the following comment and put #if 0's around + this code, not realizing that doing this invites a crash in the + line after. */ /* #### This doesn't really fix the problem, if delete-frame is called by some hook */ if (NILP (win)) return; -#endif + + /* This is a kludge, but necessary; see simple.el */ + call0 (Qhandle_post_motion_command); if (! zmacs_region_stays && (!MINI_WINDOW_P (XWINDOW (win)) @@ -4418,12 +3931,10 @@ post_command_hook (void) ("Error in `post-command-hook' (setting hook to nil)", Qpost_command_hook, 1); -#ifdef DEFERRED_ACTION_CRAP +#if 0 /* FSF Emacs crap */ if (!NILP (Vdeferred_action_list)) call0 (Vdeferred_action_function); -#endif -#ifdef ILL_CONCEIVED_HOOK if (NILP (Vunread_command_events) && NILP (Vexecuting_macro) && !NILP (Vpost_command_idle_hook) @@ -4432,9 +3943,9 @@ post_command_hook (void) safe_run_hook_trapping_errors ("Error in `post-command-idle-hook' (setting hook to nil)", Qpost_command_idle_hook, 1); -#endif +#endif /* FSF Emacs crap */ -#if 0 /* FSFmacs */ +#if 0 /* FSF Emacs */ if (!NILP (current_buffer->mark_active)) { if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode)) @@ -4446,7 +3957,7 @@ post_command_hook (void) BUF_MODIFF (current_buffer) != prev_modiff) run_hook (intern ("activate-mark-hook")); } -#endif /* FSFmacs */ +#endif /* FSF Emacs */ /* #### Kludge!!! This is necessary to make sure that things are properly positioned even if post-command-hook moves point. @@ -4935,23 +4446,21 @@ syms_of_event_stream (void) DEFSUBR (Fadd_async_timeout); DEFSUBR (Fdisable_async_timeout); DEFSUBR (Fdispatch_event); + DEFSUBR (Fdispatch_non_command_events); DEFSUBR (Fread_key_sequence); DEFSUBR (Fthis_command_keys); DEFSUBR (Freset_this_command_lengths); DEFSUBR (Fopen_dribble_file); -#if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID) - DEFSUBR (Faccelerate_menu); -#endif defsymbol (&Qpre_command_hook, "pre-command-hook"); defsymbol (&Qpost_command_hook, "post-command-hook"); defsymbol (&Qunread_command_events, "unread-command-events"); defsymbol (&Qunread_command_event, "unread-command-event"); defsymbol (&Qpre_idle_hook, "pre-idle-hook"); -#ifdef ILL_CONCEIVED_HOOK + defsymbol (&Qhandle_pre_motion_command, "handle-pre-motion-command"); + defsymbol (&Qhandle_post_motion_command, "handle-post-motion-command"); +#if 0 /* FSF Emacs crap */ defsymbol (&Qpost_command_idle_hook, "post-command-idle-hook"); -#endif -#ifdef DEFERRED_ACTION_CRAP defsymbol (&Qdeferred_action_function, "deferred-action-function"); #endif defsymbol (&Qretry_undefined_key_binding_unshifted, @@ -4959,17 +4468,6 @@ syms_of_event_stream (void) defsymbol (&Qauto_show_make_point_visible, "auto-show-make-point-visible"); - defsymbol (&Qmenu_force, "menu-force"); - defsymbol (&Qmenu_fallback, "menu-fallback"); - - defsymbol (&Qmenu_quit, "menu-quit"); - defsymbol (&Qmenu_up, "menu-up"); - defsymbol (&Qmenu_down, "menu-down"); - defsymbol (&Qmenu_left, "menu-left"); - defsymbol (&Qmenu_right, "menu-right"); - defsymbol (&Qmenu_select, "menu-select"); - defsymbol (&Qmenu_escape, "menu-escape"); - defsymbol (&Qself_insert_defer_undo, "self-insert-defer-undo"); defsymbol (&Qcancel_mode_internal, "cancel-mode-internal"); } @@ -5063,7 +4561,7 @@ used by the window manager, so it is up to the user to set it. */ ); focus_follows_mouse = 0; -#ifdef ILL_CONCEIVED_HOOK +#if 0 /* FSF Emacs crap */ /* Ill-conceived because it's not run in all sorts of cases where XEmacs is blocking. That's what `pre-idle-hook' is designed to solve. */ @@ -5080,9 +4578,7 @@ Delay time before running `post-command-idle-hook'. This is measured in microseconds. */ ); post_command_idle_delay = 5000; -#endif /* ILL_CONCEIVED_HOOK */ -#ifdef DEFERRED_ACTION_CRAP /* Random FSFmacs crap. There is absolutely nothing to gain, and a great deal to lose, in using this in place of just setting `post-command-hook'. */ @@ -5098,7 +4594,7 @@ This function is called with no arguments after each command whenever `deferred-action-list' is non-nil. */ ); Vdeferred_action_function = Qnil; -#endif /* DEFERRED_ACTION_CRAP */ +#endif /* FSF Emacs crap */ DEFVAR_LISP ("last-command-event", &Vlast_command_event /* Last keyboard or mouse button event that was part of a command. This @@ -5188,6 +4684,23 @@ will be in `last-command' during the following command. */ ); Vthis_command = Qnil; + DEFVAR_LISP ("last-command-properties", &Vlast_command_properties /* +Value of `this-command-properties' for the last command. +Used by commands to help synchronize consecutive commands, in preference +to looking at `last-command' directly. +*/ ); + Vlast_command_properties = Qnil; + + DEFVAR_LISP ("this-command-properties", &Vthis_command_properties /* +Properties set by the current command. +At the beginning of each command, the current value of this variable is +copied to `last-command-properties', and then it is set to nil. Use `putf' +to add properties to this variable. Commands should use this to communicate +with pre/post-command hooks, subsequent commands, wrapping commands, etc. +in preference to looking at and/or setting `this-command'. +*/ ); + Vthis_command_properties = Qnil; + DEFVAR_LISP ("help-char", &Vhelp_char /* Character to recognize as meaning Help. When it is read, do `(eval help-form)', and display result if it's a string. @@ -5301,41 +4814,6 @@ and is one of the following: Non-nil inhibits recording of input-events to recent-keys ring. */ ); inhibit_input_event_recording = 0; - - DEFVAR_LISP("menu-accelerator-prefix", &Vmenu_accelerator_prefix /* -Prefix key(s) that must be typed before menu accelerators will be activated. -Set this to a value acceptable by define-key. -*/ ); - Vmenu_accelerator_prefix = Qnil; - - DEFVAR_LISP ("menu-accelerator-modifiers", &Vmenu_accelerator_modifiers /* -Modifier keys which must be pressed to get to the top level menu accelerators. -This is a list of modifier key symbols. All modifier keys must be held down -while a valid menu accelerator key is pressed in order for the top level -menu to become active. - -See also menu-accelerator-enabled and menu-accelerator-prefix. -*/ ); - Vmenu_accelerator_modifiers = list1 (Qmeta); - - DEFVAR_LISP ("menu-accelerator-enabled", &Vmenu_accelerator_enabled /* -Whether menu accelerator keys can cause the menubar to become active. -If 'menu-force or 'menu-fallback, then menu accelerator keys can -be used to activate the top level menu. Once the menubar becomes active, the -accelerator keys can be used regardless of the value of this variable. - -menu-force is used to indicate that the menu accelerator key takes -precedence over bindings in the current keymap(s). menu-fallback means -that bindings in the current keymap take precedence over menu accelerator keys. -Thus a top level menu with an accelerator of "T" would be activated on a -keypress of Meta-t if menu-accelerator-enabled is menu-force. -However, if menu-accelerator-enabled is menu-fallback, then -Meta-t will not activate the menubar and will instead run the function -transpose-words, to which it is normally bound. - -See also menu-accelerator-modifiers and menu-accelerator-prefix. -*/ ); - Vmenu_accelerator_enabled = Qnil; } void @@ -5343,41 +4821,6 @@ complex_vars_of_event_stream (void) { Vkeyboard_translate_table = make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); - - DEFVAR_LISP ("menu-accelerator-map", &Vmenu_accelerator_map /* -Keymap for use when the menubar is active. -The actions menu-quit, menu-up, menu-down, menu-left, menu-right, -menu-select and menu-escape can be mapped to keys in this map. - -menu-quit Immediately deactivate the menubar and any open submenus without - selecting an item. -menu-up Move the menu cursor up one row in the current menu. If the - move extends past the top of the menu, wrap around to the bottom. -menu-down Move the menu cursor down one row in the current menu. If the - move extends past the bottom of the menu, wrap around to the top. - If executed while the cursor is in the top level menu, move down - into the selected menu. -menu-left Move the cursor from a submenu into the parent menu. If executed - while the cursor is in the top level menu, move the cursor to the - left. If the move extends past the left edge of the menu, wrap - around to the right edge. -menu-right Move the cursor into a submenu. If the cursor is located in the - top level menu or is not currently on a submenu heading, then move - the cursor to the next top level menu entry. If the move extends - past the right edge of the menu, wrap around to the left edge. -menu-select Activate the item under the cursor. If the cursor is located on - a submenu heading, then move the cursor into the submenu. -menu-escape Pop up to the next level of menus. Moves from a submenu into its - parent menu. From the top level menu, this deactivates the - menubar. - -This keymap can also contain normal key-command bindings, in which case the -menubar is deactivated and the corresponding command is executed. - -The action bindings used by the menu accelerator code are designed to mimic -the actions of menu traversal keys in a commonly used PC operating system. -*/ ); - Vmenu_accelerator_map = Fmake_keymap(Qnil); } void diff --git a/src/event-tty.c b/src/event-tty.c index 93fb928..59b4e00 100644 --- a/src/event-tty.c +++ b/src/event-tty.c @@ -249,6 +249,7 @@ reinit_vars_of_event_tty (void) tty_event_stream = xnew (struct event_stream); tty_event_stream->event_pending_p = emacs_tty_event_pending_p; + tty_event_stream->force_event_pending = 0; tty_event_stream->next_event_cb = emacs_tty_next_event; tty_event_stream->handle_magic_event_cb = emacs_tty_handle_magic_event; tty_event_stream->add_timeout_cb = emacs_tty_add_timeout; diff --git a/src/event-unixoid.c b/src/event-unixoid.c index 1bfd82c..3d7efb7 100644 --- a/src/event-unixoid.c +++ b/src/event-unixoid.c @@ -225,7 +225,7 @@ poll_fds_for_input (SELECT_TYPE mask) { /* Something went seriously wrong; don't abort since maybe the TTY just died at the wrong time. */ - fprintf (stderr, "xemacs: select failed: errno = %d\n", errno); + stderr_out ("xemacs: select failed: errno = %d\n", errno); return 0; } /* else, we got interrupted by a signal, so try again. */ diff --git a/src/events-mod.h b/src/events-mod.h index 48da194..76644e1 100644 --- a/src/events-mod.h +++ b/src/events-mod.h @@ -1,8 +1,8 @@ /* The modifiers XEmacs knows about; these appear in key and button events. */ -#define MOD_CONTROL (1<<0) -#define MOD_META (1<<1) -#define MOD_SUPER (1<<2) -#define MOD_HYPER (1<<3) -#define MOD_ALT (1<<4) -#define MOD_SHIFT (1<<5) /* not used for dual-case characters */ +#define XEMACS_MOD_CONTROL (1<<0) +#define XEMACS_MOD_META (1<<1) +#define XEMACS_MOD_SUPER (1<<2) +#define XEMACS_MOD_HYPER (1<<3) +#define XEMACS_MOD_ALT (1<<4) +#define XEMACS_MOD_SHIFT (1<<5) /* not used for dual-case characters */ diff --git a/src/events.c b/src/events.c index 60002d8..325be1e 100644 --- a/src/events.c +++ b/src/events.c @@ -37,17 +37,6 @@ Boston, MA 02111-1307, USA. */ #include "keymap.h" /* for key_desc_list_to_event() */ #include "redisplay.h" #include "window.h" - -#ifdef WINDOWSNT -/* Hmm, under unix we want X modifiers, under NT we want X modifiers if - we are running X and Windows modifiers otherwise. - gak. This is a kludge until we support multiple native GUIs! -*/ -#undef MOD_ALT -#undef MOD_CONTROL -#undef MOD_SHIFT -#endif - #include "events-mod.h" /* Where old events go when they are explicitly deallocated. @@ -87,7 +76,7 @@ deinitialize_event (Lisp_Object ev) ((int *) event) [i] = 0xdeadbeef; event->event_type = dead_event; event->channel = Qnil; - set_lheader_implementation (&(event->lheader), &lrecord_event); + set_lheader_implementation (&event->lheader, &lrecord_event); XSET_EVENT_NEXT (ev, Qnil); } @@ -96,7 +85,7 @@ void zero_event (Lisp_Event *e) { xzero (*e); - set_lheader_implementation (&(e->lheader), &lrecord_event); + set_lheader_implementation (&e->lheader, &lrecord_event); e->event_type = empty_event; e->next = Qnil; e->channel = Qnil; @@ -551,13 +540,13 @@ WARNING: the event object returned may be a reused one; see the function EXTERNAL_LIST_LOOP_2 (sym, value) { - if (EQ (sym, Qcontrol)) modifiers |= MOD_CONTROL; - else if (EQ (sym, Qmeta)) modifiers |= MOD_META; - else if (EQ (sym, Qsuper)) modifiers |= MOD_SUPER; - else if (EQ (sym, Qhyper)) modifiers |= MOD_HYPER; - else if (EQ (sym, Qalt)) modifiers |= MOD_ALT; - else if (EQ (sym, Qsymbol)) modifiers |= MOD_ALT; - else if (EQ (sym, Qshift)) modifiers |= MOD_SHIFT; + if (EQ (sym, Qcontrol)) modifiers |= XEMACS_MOD_CONTROL; + else if (EQ (sym, Qmeta)) modifiers |= XEMACS_MOD_META; + else if (EQ (sym, Qsuper)) modifiers |= XEMACS_MOD_SUPER; + else if (EQ (sym, Qhyper)) modifiers |= XEMACS_MOD_HYPER; + else if (EQ (sym, Qalt)) modifiers |= XEMACS_MOD_ALT; + else if (EQ (sym, Qsymbol)) modifiers |= XEMACS_MOD_ALT; + else if (EQ (sym, Qshift)) modifiers |= XEMACS_MOD_SHIFT; else signal_simple_error ("Invalid key modifier", sym); } @@ -977,7 +966,7 @@ character_to_event (Emchar c, Lisp_Event *event, struct console *con, int use_console_meta_flag, int do_backspace_mapping) { Lisp_Object k = Qnil; - unsigned int m = 0; + int m = 0; if (event->event_type == dead_event) error ("character-to-event called with a deallocated event!"); @@ -996,21 +985,21 @@ character_to_event (Emchar c, Lisp_Event *event, struct console *con, break; case 1: /* top bit is meta */ c -= 128; - m = MOD_META; + m = XEMACS_MOD_META; break; default: /* this is a real character */ break; } } - if (c < ' ') c += '@', m |= MOD_CONTROL; - if (m & MOD_CONTROL) + if (c < ' ') c += '@', m |= XEMACS_MOD_CONTROL; + if (m & XEMACS_MOD_CONTROL) { switch (c) { - case 'I': k = QKtab; m &= ~MOD_CONTROL; break; - case 'J': k = QKlinefeed; m &= ~MOD_CONTROL; break; - case 'M': k = QKreturn; m &= ~MOD_CONTROL; break; - case '[': k = QKescape; m &= ~MOD_CONTROL; break; + case 'I': k = QKtab; m &= ~XEMACS_MOD_CONTROL; break; + case 'J': k = QKlinefeed; m &= ~XEMACS_MOD_CONTROL; break; + case 'M': k = QKreturn; m &= ~XEMACS_MOD_CONTROL; break; + case '[': k = QKescape; m &= ~XEMACS_MOD_CONTROL; break; default: #if defined(HAVE_TTY) if (do_backspace_mapping && @@ -1018,7 +1007,7 @@ character_to_event (Emchar c, Lisp_Event *event, struct console *con, c - '@' == XCHAR (con->tty_erase_char)) { k = QKbackspace; - m &= ~MOD_CONTROL; + m &= ~XEMACS_MOD_CONTROL; } #endif /* defined(HAVE_TTY) && !defined(__CYGWIN32__) */ break; @@ -1067,7 +1056,7 @@ event_to_character (Lisp_Event *event, return -1; } if (!allow_extra_modifiers && - event->event.key.modifiers & (MOD_SUPER|MOD_HYPER|MOD_ALT)) + event->event.key.modifiers & (XEMACS_MOD_SUPER|XEMACS_MOD_HYPER|XEMACS_MOD_ALT)) return -1; if (CHAR_OR_CHAR_INTP (event->event.key.keysym)) c = XCHAR_OR_CHAR_INT (event->event.key.keysym); @@ -1086,7 +1075,7 @@ event_to_character (Lisp_Event *event, else return -1; - if (event->event.key.modifiers & MOD_CONTROL) + if (event->event.key.modifiers & XEMACS_MOD_CONTROL) { if (c >= 'a' && c <= 'z') c -= ('a' - 'A'); @@ -1104,7 +1093,7 @@ event_to_character (Lisp_Event *event, if (! allow_extra_modifiers) return -1; } - if (event->event.key.modifiers & MOD_META) + if (event->event.key.modifiers & XEMACS_MOD_META) { if (! allow_meta) return -1; if (c & 0200) return -1; /* don't allow M-oslash (overlap) */ @@ -1244,13 +1233,13 @@ format_event_object (char *buf, Lisp_Event *event, int brief) key = event->event.key.keysym; /* Hack. */ if (! brief && CHARP (key) && - mod & (MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER)) + mod & (XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER | XEMACS_MOD_HYPER)) { int k = XCHAR (key); if (k >= 'a' && k <= 'z') key = make_char (k - ('a' - 'A')); else if (k >= 'A' && k <= 'Z') - mod |= MOD_SHIFT; + mod |= XEMACS_MOD_SHIFT; } break; } @@ -1292,12 +1281,12 @@ format_event_object (char *buf, Lisp_Event *event, int brief) } #define modprint1(x) do { strcpy (buf, (x)); buf += sizeof (x)-1; } while (0) #define modprint(x,y) do { if (brief) modprint1 (y); else modprint1 (x); } while (0) - if (mod & MOD_CONTROL) modprint ("control-", "C-"); - if (mod & MOD_META) modprint ("meta-", "M-"); - if (mod & MOD_SUPER) modprint ("super-", "S-"); - if (mod & MOD_HYPER) modprint ("hyper-", "H-"); - if (mod & MOD_ALT) modprint ("alt-", "A-"); - if (mod & MOD_SHIFT) modprint ("shift-", "Sh-"); + if (mod & XEMACS_MOD_CONTROL) modprint ("control-", "C-"); + if (mod & XEMACS_MOD_META) modprint ("meta-", "M-"); + if (mod & XEMACS_MOD_SUPER) modprint ("super-", "S-"); + if (mod & XEMACS_MOD_HYPER) modprint ("hyper-", "H-"); + if (mod & XEMACS_MOD_ALT) modprint ("alt-", "A-"); + if (mod & XEMACS_MOD_SHIFT) modprint ("shift-", "Sh-"); if (mouse_p) { modprint1 ("button"); @@ -1554,12 +1543,12 @@ See also the function event-modifier-bits. { int mod = XINT (Fevent_modifier_bits (event)); Lisp_Object result = Qnil; - if (mod & MOD_SHIFT) result = Fcons (Qshift, result); - if (mod & MOD_ALT) result = Fcons (Qalt, result); - if (mod & MOD_HYPER) result = Fcons (Qhyper, result); - if (mod & MOD_SUPER) result = Fcons (Qsuper, result); - if (mod & MOD_META) result = Fcons (Qmeta, result); - if (mod & MOD_CONTROL) result = Fcons (Qcontrol, result); + if (mod & XEMACS_MOD_SHIFT) result = Fcons (Qshift, result); + if (mod & XEMACS_MOD_ALT) result = Fcons (Qalt, result); + if (mod & XEMACS_MOD_HYPER) result = Fcons (Qhyper, result); + if (mod & XEMACS_MOD_SUPER) result = Fcons (Qsuper, result); + if (mod & XEMACS_MOD_META) result = Fcons (Qmeta, result); + if (mod & XEMACS_MOD_CONTROL) result = Fcons (Qcontrol, result); return result; } diff --git a/src/events.h b/src/events.h index 3174fe8..7088301 100644 --- a/src/events.h +++ b/src/events.h @@ -329,6 +329,7 @@ struct event_stream void (*select_process_cb) (Lisp_Process *); void (*unselect_process_cb) (Lisp_Process *); void (*quit_p_cb) (void); + void (*force_event_pending) (struct frame* f); USID (*create_stream_pair_cb) (void* /* inhandle*/, void* /*outhandle*/ , Lisp_Object* /* instream */, Lisp_Object* /* outstream */, @@ -366,20 +367,20 @@ typedef enum emacs_event_type struct key_data { Lisp_Object keysym; - unsigned char modifiers; + int modifiers; }; struct button_data { int button; - unsigned char modifiers; + int modifiers; int x, y; }; struct motion_data { int x, y; - unsigned char modifiers; + int modifiers; }; struct process_data @@ -406,7 +407,7 @@ struct misc_user_data Lisp_Object function; Lisp_Object object; int button; - unsigned char modifiers; + int modifiers; int x, y; }; @@ -532,9 +533,9 @@ extern Lisp_Object QKbackspace, QKdelete, QKescape, QKlinefeed, QKreturn; extern Lisp_Object QKspace, QKtab, Qmouse_event_p, Vcharacter_set_property; extern Lisp_Object Qcancel_mode_internal; -/* Note: under X Windows, MOD_ALT is generated by the Alt key if there are +/* Note: under X Windows, XEMACS_MOD_ALT is generated by the Alt key if there are both Alt and Meta keys. If there are no Meta keys, then Alt generates - MOD_META instead. + XEMACS_MOD_META instead. */ #ifdef emacs @@ -661,4 +662,60 @@ USID event_stream_unixoid_delete_stream_pair (Lisp_Object instream, #endif /* emacs */ +/* #### a hack, until accelerator shit is cleaned up */ + +/* This structure is what we use to encapsulate the state of a command sequence + being composed; key events are executed by adding themselves to the command + builder; if the command builder is then complete (does not still represent + a prefix key sequence) it executes the corresponding command. + */ +struct command_builder +{ + struct lcrecord_header header; + Lisp_Object console; /* back pointer to the console this command + builder is for */ + /* Qnil, or a Lisp_Event representing the first event read + * after the last command completed. Threaded. */ + /* #### NYI */ + Lisp_Object prefix_events; + /* Qnil, or a Lisp_Event representing event in the current + * keymap-lookup sequence. Subsequent events are threaded via + * the event's next slot */ + Lisp_Object current_events; + /* Last elt of above */ + Lisp_Object most_current_event; + /* Last elt before function map code took over. What this means is: + All prefixes up to (but not including) this event have non-nil + bindings, but the prefix including this event has a nil binding. + Any events in the chain after this one were read solely because + we're part of a possible function key. If we end up with + something that's not part of a possible function key, we have to + unread all of those events. */ + Lisp_Object last_non_munged_event; + /* One set of values for function-key-map, one for key-translation-map */ + struct munging_key_translation + { + /* First event that can begin a possible function key sequence + (to be translated according to function-key-map). Normally + this is the first event in the chain. However, once we've + translated a sequence through function-key-map, this will point + to the first event after the translated sequence: we don't ever + want to translate any events twice through function-key-map, or + things could get really screwed up (e.g. if the user created a + translation loop). If this is nil, then the next-read event is + the first that can begin a function key sequence. */ + Lisp_Object first_mungeable_event; + } munge_me[2]; + + Bufbyte *echo_buf; + Bytecount echo_buf_length; /* size of echo_buf */ + Bytecount echo_buf_index; /* index into echo_buf + * -1 before doing echoing for new cmd */ + /* Self-insert-command is magic in that it doesn't always push an undo- + boundary: up to 20 consecutive self-inserts can happen before an undo- + boundary is pushed. This variable is that counter. + */ + int self_insert_countdown; +}; + #endif /* INCLUDED_events_h_ */ diff --git a/src/extents.c b/src/extents.c index 14bebe2..6900786 100644 --- a/src/extents.c +++ b/src/extents.c @@ -227,6 +227,7 @@ Boston, MA 02111-1307, USA. */ #include "opaque.h" #include "process.h" #include "redisplay.h" +#include "gutter.h" /* ------------------------------- */ /* gap array */ @@ -461,7 +462,6 @@ Lisp_Object Vextent_face_reusable_list; /* FSFmacs bogosity */ Lisp_Object Vdefault_text_properties; - EXFUN (Fextent_properties, 1); EXFUN (Fset_extent_property, 3); @@ -1589,33 +1589,46 @@ extent_changed_for_redisplay (EXTENT extent, int descendants_too, object = extent_object (extent); - if (!BUFFERP (object) || extent_detached_p (extent)) - /* #### Can changes to string extents affect redisplay? - I will have to think about this. What about string glyphs? - Things in the modeline? etc. */ - /* #### changes to string extents can certainly affect redisplay - if the extent is in some generated-modeline-string: when - we change an extent in generated-modeline-string, this changes - its parent, which is in `modeline-format', so we should - force the modeline to be updated. But how to determine whether - a string is a `generated-modeline-string'? Looping through - all buffers is not very efficient. Should we add all - `generated-modeline-string' strings to a hash table? - Maybe efficiency is not the greatest concern here and there's - no big loss in looping over the buffers. */ + if (extent_detached_p (extent)) return; - { - struct buffer *b; - b = XBUFFER (object); - BUF_FACECHANGE (b)++; - MARK_EXTENTS_CHANGED; - if (invisibility_change) - MARK_CLIP_CHANGED; - buffer_extent_signal_changed_region (b, - extent_endpoint_bufpos (extent, 0), - extent_endpoint_bufpos (extent, 1)); - } + else if (STRINGP (object)) + { + /* #### Changes to string extents can affect redisplay if they are + in the modeline or in the gutters. + + If the extent is in some generated-modeline-string: when we + change an extent in generated-modeline-string, this changes its + parent, which is in `modeline-format', so we should force the + modeline to be updated. But how to determine whether a string + is a `generated-modeline-string'? Looping through all buffers + is not very efficient. Should we add all + `generated-modeline-string' strings to a hash table? Maybe + efficiency is not the greatest concern here and there's no big + loss in looping over the buffers. + + If the extent is in a gutter we mark the gutter as + changed. This means (a) we can update extents in the gutters + when we need it. (b) we don't have to update the gutters when + only extents attached to buffers have changed. */ + + MARK_EXTENTS_CHANGED; + gutter_extent_signal_changed_region_maybe (object, + extent_endpoint_bufpos (extent, 0), + extent_endpoint_bufpos (extent, 1)); + } + else if (BUFFERP (object)) + { + struct buffer *b; + b = XBUFFER (object); + BUF_FACECHANGE (b)++; + MARK_EXTENTS_CHANGED; + if (invisibility_change) + MARK_CLIP_CHANGED; + buffer_extent_signal_changed_region (b, + extent_endpoint_bufpos (extent, 0), + extent_endpoint_bufpos (extent, 1)); + } } /* A change to an extent occurred that might affect redisplay. @@ -4989,7 +5002,7 @@ static Lisp_Object set_extent_glyph_1 (Lisp_Object extent_obj, Lisp_Object glyph, int endp, Lisp_Object layout_obj) { - EXTENT extent = decode_extent (extent_obj, DE_MUST_HAVE_BUFFER); + EXTENT extent = decode_extent (extent_obj, 0); glyph_layout layout = symbol_to_glyph_layout (layout_obj); /* Make sure we've actually been given a valid glyph or it's nil diff --git a/src/extents.h b/src/extents.h index 94d9152..0f70381 100644 --- a/src/extents.h +++ b/src/extents.h @@ -177,8 +177,8 @@ void flush_cached_extent_info (Lisp_Object extent_info); #define extent_no_chase_normal_field(e, field) ((e)->flags.field) -INLINE struct extent_auxiliary *extent_aux_or_default (EXTENT e); -INLINE struct extent_auxiliary * +INLINE_HEADER struct extent_auxiliary *extent_aux_or_default (EXTENT e); +INLINE_HEADER struct extent_auxiliary * extent_aux_or_default (EXTENT e) { return e->flags.has_aux ? @@ -259,8 +259,8 @@ extent_aux_or_default (EXTENT e) #define extent_internal_p(e) extent_normal_field (e, internal) #define extent_in_red_event_p(e) extent_normal_field (e, in_red_event) -INLINE Lisp_Object * extent_no_chase_plist_addr (EXTENT e); -INLINE Lisp_Object * +INLINE_HEADER Lisp_Object * extent_no_chase_plist_addr (EXTENT e); +INLINE_HEADER Lisp_Object * extent_no_chase_plist_addr (EXTENT e) { return e->flags.has_aux ? &XCDR (e->plist) : &e->plist; @@ -339,8 +339,8 @@ EXTENT extent_ancestor_1 (EXTENT e); /* extent_ancestor() chases all the parent links until there aren't any more. extent_ancestor_1() does the same thing but it a function; the following optimizes the most common case. */ -INLINE EXTENT extent_ancestor (EXTENT e); -INLINE EXTENT +INLINE_HEADER EXTENT extent_ancestor (EXTENT e); +INLINE_HEADER EXTENT extent_ancestor (EXTENT e) { return e->flags.has_parent ? extent_ancestor_1 (e) : e; diff --git a/src/fileio.c b/src/fileio.c index c300003..c2eb069 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -635,8 +635,10 @@ In Unix-syntax, this function just removes the final slash. This implementation is better than what one usually finds in libc. --hniksic */ +static unsigned int temp_name_rand; + DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /* -Generate temporary file name starting with PREFIX. +Generate a temporary file name starting with PREFIX. The Emacs process number forms part of the result, so there is no danger of generating a name being used by another process. @@ -646,7 +648,8 @@ be an absolute file name. */ (prefix)) { - static char tbl[64] = { + static const char tbl[64] = + { 'A','B','C','D','E','F','G','H', 'I','J','K','L','M','N','O','P', 'Q','R','S','T','U','V','W','X', @@ -654,13 +657,12 @@ be an absolute file name. 'g','h','i','j','k','l','m','n', 'o','p','q','r','s','t','u','v', 'w','x','y','z','0','1','2','3', - '4','5','6','7','8','9','-','_' }; - static unsigned count, count_initialized_p; + '4','5','6','7','8','9','-','_' + }; Lisp_Object val; Bytecount len; Bufbyte *p, *data; - unsigned pid; CHECK_STRING (prefix); @@ -686,40 +688,33 @@ be an absolute file name. /* VAL is created by adding 6 characters to PREFIX. The first three are the PID of this process, in base 64, and the second three are - incremented if the file already exists. This ensures 262144 - unique file names per PID per PREFIX. */ + a pseudo-random number seeded from process startup time. This + ensures 262144 unique file names per PID per PREFIX per machine. */ - pid = (unsigned)getpid (); - *p++ = tbl[pid & 63], pid >>= 6; - *p++ = tbl[pid & 63], pid >>= 6; - *p++ = tbl[pid & 63], pid >>= 6; + { + unsigned int pid = (unsigned int) getpid (); + *p++ = tbl[(pid >> 0) & 63]; + *p++ = tbl[(pid >> 6) & 63]; + *p++ = tbl[(pid >> 12) & 63]; + } /* Here we try to minimize useless stat'ing when this function is invoked many times successively with the same PREFIX. We achieve - this by initializing count to a random value, and incrementing it - afterwards. */ - if (!count_initialized_p) - { - count = (unsigned)time (NULL); - /* Dumping temacs with a non-zero count_initialized_p wouldn't - make much sense. */ - if (NILP (Frunning_temacs_p ())) - count_initialized_p = 1; - } + this by using a very pseudo-random number generator to generate + file names unique to this process, with a very long cycle. */ while (1) { struct stat ignored; - unsigned num = count; - p[0] = tbl[num & 63], num >>= 6; - p[1] = tbl[num & 63], num >>= 6; - p[2] = tbl[num & 63], num >>= 6; + p[0] = tbl[(temp_name_rand >> 0) & 63]; + p[1] = tbl[(temp_name_rand >> 6) & 63]; + p[2] = tbl[(temp_name_rand >> 12) & 63]; /* Poor man's congruential RN generator. Replace with ++count for debugging. */ - count += 25229; - count %= 225307; + temp_name_rand += 25229; + temp_name_rand %= 225307; QUIT; @@ -1846,7 +1841,7 @@ Create a directory. One argument, a file name string. { return Fsignal (Qfile_error, list3 (build_translated_string ("Creating directory"), - build_translated_string ("pathame too long"), + build_translated_string ("pathname too long"), dirname_)); } strncpy (dir, (char *) XSTRING_DATA (dirname_), @@ -2075,7 +2070,6 @@ This is what happens in interactive use with M-x. return Qnil; } -#ifdef S_IFLNK DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3, "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings. @@ -2087,6 +2081,7 @@ This happens for interactive use with M-x. (filename, linkname, ok_if_already_exists)) { /* This function can GC. GC checked 1997.06.04. */ + /* XEmacs change: run handlers even if local machine doesn't have symlinks */ Lisp_Object handler; struct gcpro gcpro1, gcpro2; @@ -2114,6 +2109,7 @@ This happens for interactive use with M-x. RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname, ok_if_already_exists)); +#ifdef S_IFLNK if (NILP (ok_if_already_exists) || INTP (ok_if_already_exists)) barf_or_query_if_file_exists (linkname, "make it a link", @@ -2126,10 +2122,11 @@ This happens for interactive use with M-x. report_file_error ("Making symbolic link", list2 (filename, linkname)); } +#endif /* S_IFLNK */ + UNGCPRO; return Qnil; } -#endif /* S_IFLNK */ #ifdef HPUX_NET @@ -2351,11 +2348,13 @@ Otherwise returns nil. (filename)) { /* This function can GC. GC checked 1997.04.10. */ + /* XEmacs change: run handlers even if local machine doesn't have symlinks */ #ifdef S_IFLNK char *buf; int bufsize; int valsize; Lisp_Object val; +#endif Lisp_Object handler; struct gcpro gcpro1; @@ -2370,6 +2369,7 @@ Otherwise returns nil. if (!NILP (handler)) return call2 (handler, Qfile_symlink_p, filename); +#ifdef S_IFLNK bufsize = 100; while (1) { @@ -4185,9 +4185,7 @@ syms_of_fileio (void) DEFSUBR (Fdelete_file); DEFSUBR (Frename_file); DEFSUBR (Fadd_name_to_file); -#ifdef S_IFLNK DEFSUBR (Fmake_symbolic_link); -#endif /* S_IFLNK */ #ifdef HPUX_NET DEFSUBR (Fsysnetunam); #endif /* HPUX_NET */ @@ -4316,6 +4314,28 @@ what the normal separator is. #ifdef WINDOWSNT Vdirectory_sep_char = make_char ('\\'); #else - Vdirectory_sep_char = make_char ('/'); + Vdirectory_sep_char = make_char ('/'); #endif + + reinit_vars_of_fileio (); +} + +void +reinit_vars_of_fileio (void) +{ + /* We want temp_name_rand to be initialized to a value likely to be + unique to the process, not to the executable. The danger is that + two different XEmacs processes using the same binary on different + machines creating temp files in the same directory will be + unlucky enough to have the same pid. If we randomize using + process startup time, then in practice they will be unlikely to + collide. We use the microseconds field so that scripts that start + simultaneous XEmacs processes on multiple machines will have less + chance of collision. */ + { + EMACS_TIME thyme; + + EMACS_GET_TIME (thyme); + temp_name_rand = (unsigned int) (EMACS_SECS (thyme) ^ EMACS_USECS (thyme)); + } } diff --git a/src/filelock.c b/src/filelock.c index 97573bb..b31766d 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -366,7 +366,7 @@ unlock_file (Lisp_Object fn) } void -unlock_all_files () +unlock_all_files (void) { register Lisp_Object tail; register struct buffer *b; diff --git a/src/filemode.c b/src/filemode.c index 31f4564..efa3a28 100644 --- a/src/filemode.c +++ b/src/filemode.c @@ -79,9 +79,9 @@ static void mode_string (unsigned short mode, char *str) { str[0] = ftypelet (mode); - rwx ((mode & 0700) << 0, &str[1]); - rwx ((mode & 0070) << 3, &str[4]); - rwx ((mode & 0007) << 6, &str[7]); + rwx ((unsigned short) ((mode & 0700) << 0), &str[1]); + rwx ((unsigned short) ((mode & 0070) << 3), &str[4]); + rwx ((unsigned short) ((mode & 0007) << 6), &str[7]); setst (mode, str); } diff --git a/src/frame-msw.c b/src/frame-msw.c index ff640f2..dce9917 100644 --- a/src/frame-msw.c +++ b/src/frame-msw.c @@ -58,7 +58,7 @@ Boston, MA 02111-1307, USA. */ #define POPUP_WIDTH 30 #define POPUP_HEIGHT 10 -/* Default popup size, in characters */ +/* Default regular frame size, in characters */ #define DEFAULT_FRAME_WIDTH 80 #define DEFAULT_FRAME_HEIGHT 35 @@ -133,6 +133,7 @@ mswindows_init_frame_1 (struct frame *f, Lisp_Object props) FRAME_MSWINDOWS_DATA(f)->ignore_next_lbutton_up = 0; FRAME_MSWINDOWS_DATA(f)->ignore_next_rbutton_up = 0; FRAME_MSWINDOWS_DATA(f)->sizing = 0; + FRAME_MSWINDOWS_DATA(f)->paint_pending = 0; FRAME_MSWINDOWS_MENU_HASH_TABLE(f) = Qnil; #ifdef HAVE_TOOLBARS FRAME_MSWINDOWS_TOOLBAR_HASH_TABLE(f) = @@ -203,7 +204,6 @@ mswindows_init_frame_1 (struct frame *f, Lisp_Object props) SetWindowLong (hwnd, XWL_FRAMEOBJ, (LONG)LISP_TO_VOID(frame_obj)); FRAME_MSWINDOWS_DC(f) = GetDC (hwnd); - FRAME_MSWINDOWS_CDC(f) = CreateCompatibleDC (FRAME_MSWINDOWS_CDC(f)); SetTextAlign (FRAME_MSWINDOWS_DC(f), TA_BASELINE | TA_LEFT | TA_NOUPDATECP); } @@ -273,7 +273,6 @@ mswindows_delete_frame (struct frame *f) { if (f->frame_data) { - DeleteDC(FRAME_MSWINDOWS_CDC(f)); ReleaseDC(FRAME_MSWINDOWS_HANDLE(f), FRAME_MSWINDOWS_DC(f)); DestroyWindow(FRAME_MSWINDOWS_HANDLE(f)); xfree (f->frame_data); @@ -610,11 +609,10 @@ mswindows_set_frame_properties (struct frame *f, Lisp_Object plist) void mswindows_size_frame_internal (struct frame* f, XEMACS_RECT_WH* dest) { - RECT rect; + RECT rect, ws_rect; int pixel_width, pixel_height; int size_p = (dest->width >=0 || dest->height >=0); int move_p = (dest->top >=0 || dest->left >=0); - struct device* d = XDEVICE (FRAME_DEVICE (f)); char_to_real_pixel_size (f, dest->width, dest->height, &pixel_width, &pixel_height); if (dest->width < 0) @@ -637,32 +635,44 @@ void mswindows_size_frame_internal (struct frame* f, XEMACS_RECT_WH* dest) GetMenu (FRAME_MSWINDOWS_HANDLE(f)) != NULL, GetWindowLong (FRAME_MSWINDOWS_HANDLE(f), GWL_EXSTYLE)); - /* resize and move the window so that it fits on the screen. This is + /* resize and move the window so that it fits in the workspace. This is not restrictive since this will happen later anyway in WM_SIZE. We have to do this after adjusting the rect to account for menubar etc. */ + msw_get_workspace_coords (&ws_rect); pixel_width = rect.right - rect.left; pixel_height = rect.bottom - rect.top; - if (pixel_width > DEVICE_MSWINDOWS_HORZRES(d)) + if (pixel_width > ws_rect.right - ws_rect.left) { - pixel_width = DEVICE_MSWINDOWS_HORZRES(d); + pixel_width = ws_rect.right - ws_rect.left; size_p=1; } - if (pixel_height > DEVICE_MSWINDOWS_VERTRES(d)) + if (pixel_height > ws_rect.bottom - ws_rect.top) { - pixel_height = DEVICE_MSWINDOWS_VERTRES(d); + pixel_height = ws_rect.bottom - ws_rect.top; size_p=1; } - /* adjust position so window is on screen */ - if (dest->left + pixel_width > DEVICE_MSWINDOWS_HORZRES(d)) + /* adjust position so window is in workspace */ + if (dest->left + pixel_width > ws_rect.right) + { + dest->left = ws_rect.right - pixel_width; + move_p=1; + } + if (dest->left < ws_rect.left) + { + dest->left = ws_rect.left; + move_p=1; + } + + if (dest->top + pixel_height > ws_rect.bottom) { - dest->left = DEVICE_MSWINDOWS_HORZRES(d) - pixel_width; + dest->top = ws_rect.bottom - pixel_height; move_p=1; } - if (dest->top + pixel_height > DEVICE_MSWINDOWS_VERTRES(d)) + if (dest->top < ws_rect.top) { - dest->top = DEVICE_MSWINDOWS_VERTRES(d) - pixel_height; + dest->top = ws_rect.top; move_p=1; } @@ -766,7 +776,7 @@ msprinter_init_frame_3 (struct frame *f) { DOCINFO di; struct device *device = XDEVICE (FRAME_DEVICE (f)); - HDC hdc = DEVICE_MSPRINTER_HDC (device); + HDC hdc; int frame_left, frame_top, frame_width, frame_height; /* Change printer parameters */ @@ -798,9 +808,14 @@ msprinter_init_frame_3 (struct frame *f) abort(); } + assert (!FRAME_MSPRINTER_PAGE_STARTED (f)); msprinter_apply_devmode (device, devmode); } + /* DC might be recreated in msprinter_apply_devmode, + so do not initialize until now */ + hdc = DEVICE_MSPRINTER_HDC (device); + /* Compute geometry properties */ frame_left = (MulDiv (GetDeviceCaps (hdc, LOGPIXELSX), FRAME_MSPRINTER_LEFT_MARGIN(f), 1440) @@ -878,7 +893,6 @@ msprinter_init_frame_3 (struct frame *f) error ("Cannot start print job"); /* Finish frame setup */ - FRAME_MSPRINTER_CDC(f) = CreateCompatibleDC (hdc); FRAME_MSPRINTER_JOB_STARTED (f) = 1; FRAME_VISIBLE_P(f) = 0; } @@ -904,8 +918,6 @@ msprinter_delete_frame (struct frame *f) EndPage (hdc); if (FRAME_MSPRINTER_JOB_STARTED (f)) EndDoc (hdc); - if (FRAME_MSPRINTER_CDC(f)) - DeleteDC (FRAME_MSPRINTER_CDC(f)); xfree (f->frame_data); } diff --git a/src/frame-x.c b/src/frame-x.c index c81b27e..9396eee 100644 --- a/src/frame-x.c +++ b/src/frame-x.c @@ -50,6 +50,7 @@ Boston, MA 02111-1307, USA. */ #include "faces.h" #include "frame.h" #include "window.h" +#include "gutter.h" #ifdef HAVE_DRAGNDROP #include "dragdrop.h" @@ -1146,12 +1147,12 @@ WARNING: can only handle plain/text and file: transfers! x_event.xbutton.y_root = lisp_event->event.button.y; } modifier = lisp_event->event.button.modifiers; - if (modifier & MOD_SHIFT) state |= ShiftMask; - if (modifier & MOD_CONTROL) state |= ControlMask; - if (modifier & MOD_META) state |= xd->MetaMask; - if (modifier & MOD_SUPER) state |= xd->SuperMask; - if (modifier & MOD_HYPER) state |= xd->HyperMask; - if (modifier & MOD_ALT) state |= xd->AltMask; + if (modifier & XEMACS_MOD_SHIFT) state |= ShiftMask; + if (modifier & XEMACS_MOD_CONTROL) state |= ControlMask; + if (modifier & XEMACS_MOD_META) state |= xd->MetaMask; + if (modifier & XEMACS_MOD_SUPER) state |= xd->SuperMask; + if (modifier & XEMACS_MOD_HYPER) state |= xd->HyperMask; + if (modifier & XEMACS_MOD_ALT) state |= xd->AltMask; state |= Button1Mask << (lisp_event->event.button.button-1); x_event.xbutton.state = state; @@ -1412,12 +1413,12 @@ The type defaults to DndText (4). } modifier = lisp_event->event.button.modifiers; - if (modifier & MOD_SHIFT) state |= ShiftMask; - if (modifier & MOD_CONTROL) state |= ControlMask; - if (modifier & MOD_META) state |= xd->MetaMask; - if (modifier & MOD_SUPER) state |= xd->SuperMask; - if (modifier & MOD_HYPER) state |= xd->HyperMask; - if (modifier & MOD_ALT) state |= xd->AltMask; + if (modifier & XEMACS_MOD_SHIFT) state |= ShiftMask; + if (modifier & XEMACS_MOD_CONTROL) state |= ControlMask; + if (modifier & XEMACS_MOD_META) state |= xd->MetaMask; + if (modifier & XEMACS_MOD_SUPER) state |= xd->SuperMask; + if (modifier & XEMACS_MOD_HYPER) state |= xd->HyperMask; + if (modifier & XEMACS_MOD_ALT) state |= xd->AltMask; state |= Button1Mask << (lisp_event->event.button.button-1); x_event.xbutton.state = state; @@ -1550,13 +1551,16 @@ x_initialize_frame_size (struct frame *f) { struct window *win = XWINDOW (f->root_window); - WINDOW_LEFT (win) = FRAME_LEFT_BORDER_END (f); - WINDOW_TOP (win) = FRAME_TOP_BORDER_END (f); + WINDOW_LEFT (win) = FRAME_LEFT_BORDER_END (f) + + FRAME_LEFT_GUTTER_BOUNDS (f); + WINDOW_TOP (win) = FRAME_TOP_BORDER_END (f) + + FRAME_TOP_GUTTER_BOUNDS (f); if (!NILP (f->minibuffer_window)) { win = XWINDOW (f->minibuffer_window); - WINDOW_LEFT (win) = FRAME_LEFT_BORDER_END (f); + WINDOW_LEFT (win) = FRAME_LEFT_BORDER_END (f) + + FRAME_LEFT_GUTTER_BOUNDS (f); } } diff --git a/src/frame.h b/src/frame.h index a811476..e77a490 100644 --- a/src/frame.h +++ b/src/frame.h @@ -116,9 +116,14 @@ struct frame unsigned int current_toolbar_size[4]; #endif - /* Dynamic array of display lines for gutters */ - display_line_dynarr *current_display_lines; - display_line_dynarr *desired_display_lines; + /* Size of gutters as seen by redisplay. This is used to determine + whether to re-layout windows by a call to change_frame_size early + in redisplay_frame. */ + unsigned int current_gutter_bounds[4]; + + /* Dynamic arrays of display lines for gutters */ + display_line_dynarr *current_display_lines[4]; + display_line_dynarr *desired_display_lines[4]; /* A structure of auxiliary data specific to the device type. struct x_frame is used for X window frames; defined in console-x.h */ @@ -258,9 +263,9 @@ DECLARE_LRECORD (frame, struct frame); #define FRAME_TYPE_P(f, type) EQ (FRAME_TYPE (f), Q##type) #ifdef ERROR_CHECK_TYPECHECK -INLINE struct frame * +INLINE_HEADER struct frame * error_check_frame_type (struct frame * f, Lisp_Object sym); -INLINE struct frame * +INLINE_HEADER struct frame * error_check_frame_type (struct frame * f, Lisp_Object sym) { assert (EQ (FRAME_TYPE (f), sym)); diff --git a/src/glyphs-msw.c b/src/glyphs-msw.c index 25c037f..4cd61ab 100644 --- a/src/glyphs-msw.c +++ b/src/glyphs-msw.c @@ -72,10 +72,13 @@ DECLARE_IMAGE_INSTANTIATOR_FORMAT (gif); #endif #ifdef HAVE_XPM DEFINE_DEVICE_IIFORMAT (mswindows, xpm); +DEFINE_DEVICE_IIFORMAT (msprinter, xpm); #endif DEFINE_DEVICE_IIFORMAT (mswindows, xbm); +DEFINE_DEVICE_IIFORMAT (msprinter, xbm); #ifdef HAVE_XFACE DEFINE_DEVICE_IIFORMAT (mswindows, xface); +DEFINE_DEVICE_IIFORMAT (msprinter, xface); #endif DEFINE_DEVICE_IIFORMAT (mswindows, button); DEFINE_DEVICE_IIFORMAT (mswindows, edit_field); @@ -103,7 +106,20 @@ mswindows_initialize_dibitmap_image_instance (Lisp_Image_Instance *ii, enum image_instance_type type); static void mswindows_initialize_image_instance_mask (Lisp_Image_Instance* image, - struct frame* f); + HDC hcdc); + +/* + * Given device D, retrieve compatible device context. D can be either + * mswindows or an msprinter device. + */ +inline static HDC +get_device_compdc (struct device *d) +{ + if (DEVICE_MSWINDOWS_P (d)) + return DEVICE_MSWINDOWS_HCDC (d); + else + return DEVICE_MSPRINTER_HCDC (d); +} #define BPLINE(width) ((int)(~3UL & (unsigned long)((width) +3))) @@ -124,7 +140,7 @@ static BITMAPINFO* convert_EImage_to_DIBitmap (Lisp_Object device, BITMAPINFO* bmp_info; unsigned char *ip, *dp; - if (DEVICE_MSWINDOWS_BITSPIXEL (d) > 0) + if (GetDeviceCaps (get_device_compdc (d), BITSPIXEL) > 0) { int bpline = BPLINE(width * 3); /* FIXME: we can do this because 24bpp implies no color table, once @@ -206,25 +222,28 @@ static BITMAPINFO* convert_EImage_to_DIBitmap (Lisp_Object device, } /* build up an RGBQUAD colortable */ - for (i = 0; i < qtable->num_active_colors; i++) { - colortbl[i].rgbRed = (BYTE) qtable->rm[i]; - colortbl[i].rgbGreen = (BYTE) qtable->gm[i]; - colortbl[i].rgbBlue = (BYTE) qtable->bm[i]; - colortbl[i].rgbReserved = 0; - } + for (i = 0; i < qtable->num_active_colors; i++) + { + colortbl[i].rgbRed = (BYTE) qtable->rm[i]; + colortbl[i].rgbGreen = (BYTE) qtable->gm[i]; + colortbl[i].rgbBlue = (BYTE) qtable->bm[i]; + colortbl[i].rgbReserved = 0; + } /* now build up the data. picture has to be upside-down and back-to-front for msw bitmaps */ ip = pic; - for (i = height-1; i >= 0; i--) { - dp = (*bmp_data) + (i * bpline); - for (j = 0; j < width; j++) { - rd = *ip++; - gr = *ip++; - bl = *ip++; - *dp++ = QUANT_GET_COLOR (qtable,rd,gr,bl); + for (i = height-1; i >= 0; i--) + { + dp = (*bmp_data) + (i * bpline); + for (j = 0; j < width; j++) + { + rd = *ip++; + gr = *ip++; + bl = *ip++; + *dp++ = QUANT_GET_COLOR (qtable,rd,gr,bl); + } } - } xfree (qtable); } /* fix up the standard stuff */ @@ -296,20 +315,11 @@ init_image_instance_from_dibitmap (Lisp_Image_Instance *ii, { Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); struct device *d = XDEVICE (device); - struct frame *f; void* bmp_buf=0; enum image_instance_type type; HBITMAP bitmap; HDC hdc; - if (!DEVICE_MSWINDOWS_P (d)) - signal_simple_error ("Not an mswindows device", device); - - if (NILP (DEVICE_SELECTED_FRAME (d))) - signal_simple_error ("No selected frame on mswindows device", device); - - f = XFRAME (DEVICE_SELECTED_FRAME (d)); - if (dest_mask & IMAGE_COLOR_PIXMAP_MASK) type = IMAGE_COLOR_PIXMAP; else if (dest_mask & IMAGE_POINTER_MASK) @@ -317,13 +327,13 @@ init_image_instance_from_dibitmap (Lisp_Image_Instance *ii, else incompatible_image_types (instantiator, dest_mask, IMAGE_COLOR_PIXMAP_MASK | IMAGE_POINTER_MASK); - hdc = FRAME_MSWINDOWS_CDC (f); - bitmap=CreateDIBSection (hdc, - bmp_info, - DIB_RGB_COLORS, - &bmp_buf, - 0,0); + hdc = get_device_compdc (d); + bitmap = CreateDIBSection (hdc, + bmp_info, + DIB_RGB_COLORS, + &bmp_buf, + 0, 0); if (!bitmap || !bmp_buf) signal_simple_error ("Unable to create bitmap", instantiator); @@ -340,15 +350,15 @@ init_image_instance_from_dibitmap (Lisp_Image_Instance *ii, IMAGE_INSTANCE_MSWINDOWS_BITMAP (ii) = bitmap; IMAGE_INSTANCE_MSWINDOWS_MASK (ii) = NULL; - IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = bmp_info->bmiHeader.biWidth; - IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = bmp_info->bmiHeader.biHeight; - IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = bmp_info->bmiHeader.biBitCount; + IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = bmp_info->bmiHeader.biWidth; + IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = bmp_info->bmiHeader.biHeight; + IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = bmp_info->bmiHeader.biBitCount; XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), x_hot); XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), y_hot); if (create_mask) { - mswindows_initialize_image_instance_mask (ii, f); + mswindows_initialize_image_instance_mask (ii, hdc); } if (type == IMAGE_POINTER) @@ -365,12 +375,10 @@ image_instance_add_dibitmap (Lisp_Image_Instance *ii, int slice, Lisp_Object instantiator) { - Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); - struct device *d = XDEVICE (device); - struct frame *f = XFRAME (DEVICE_SELECTED_FRAME (d)); + struct device *d = XDEVICE (IMAGE_INSTANCE_DEVICE (ii)); void* bmp_buf=0; - HDC hdc = FRAME_MSWINDOWS_CDC (f); - HBITMAP bitmap = CreateDIBSection (hdc, + + HBITMAP bitmap = CreateDIBSection (get_device_compdc (d), bmp_info, DIB_RGB_COLORS, &bmp_buf, @@ -400,8 +408,7 @@ mswindows_init_image_instance_from_eimage (Lisp_Image_Instance *ii, COLORREF bkcolor; int slice; - if (!DEVICE_MSWINDOWS_P (XDEVICE (device))) - signal_simple_error ("Not an mswindows device", device); + CHECK_MSGDI_DEVICE (device); /* this is a hack but MaskBlt and TransparentBlt are not supported on most windows variants */ @@ -433,38 +440,38 @@ mswindows_init_image_instance_from_eimage (Lisp_Image_Instance *ii, } } -static void set_mono_pixel ( unsigned char* bits, - int bpline, int height, - int x, int y, int white ) +inline static void +set_mono_pixel (unsigned char* bits, + int bpline, int height, + int x, int y, int white) { int i; - unsigned char bitnum; + unsigned char bitnum; /* Find the byte on which this scanline begins */ i = (height - y - 1) * bpline; /* Find the byte containing this pixel */ i += (x >> 3); /* Which bit is it? */ - bitnum = (unsigned char)( 7 - (x % 8) ); - if( white ) /* Turn it on */ - bits[i] |= (1<bmiHeader.biWidth=IMAGE_INSTANCE_PIXMAP_WIDTH (image); bmp_info->bmiHeader.biHeight = height; - bmp_info->bmiHeader.biPlanes=1; + bmp_info->bmiHeader.biPlanes = 1; bmp_info->bmiHeader.biSize=sizeof(BITMAPINFOHEADER); - bmp_info->bmiHeader.biBitCount=1; - bmp_info->bmiHeader.biCompression=BI_RGB; + bmp_info->bmiHeader.biBitCount = 1; + bmp_info->bmiHeader.biCompression = BI_RGB; bmp_info->bmiHeader.biClrUsed = 2; bmp_info->bmiHeader.biClrImportant = 2; bmp_info->bmiHeader.biSizeImage = height * maskbpline; @@ -504,10 +511,10 @@ mswindows_initialize_image_instance_mask (Lisp_Image_Instance* image, bmp_info->bmiHeader.biWidth=IMAGE_INSTANCE_PIXMAP_WIDTH (image); bmp_info->bmiHeader.biHeight = -height; - bmp_info->bmiHeader.biPlanes=1; + bmp_info->bmiHeader.biPlanes = 1; bmp_info->bmiHeader.biSize=sizeof(BITMAPINFOHEADER); - bmp_info->bmiHeader.biBitCount=24; - bmp_info->bmiHeader.biCompression=BI_RGB; + bmp_info->bmiHeader.biBitCount = 24; + bmp_info->bmiHeader.biCompression = BI_RGB; bmp_info->bmiHeader.biClrUsed = 0; bmp_info->bmiHeader.biClrImportant = 0; bmp_info->bmiHeader.biSizeImage = height * bpline; @@ -578,17 +585,18 @@ mswindows_initialize_image_instance_icon (Lisp_Image_Instance* image, CreateIconIndirect (&x_icon); } -HBITMAP -mswindows_create_resized_bitmap (Lisp_Image_Instance* ii, - struct frame* f, - int newx, int newy) +static HBITMAP +create_resized_bitmap (HBITMAP curbmp, struct frame *f, + int curx, int cury, + int newx, int newy) { HBITMAP newbmp; HGDIOBJ old1, old2; - HDC hcdc = FRAME_MSWINDOWS_CDC (f); + + HDC hcdc = get_device_compdc (XDEVICE (FRAME_DEVICE (f))); HDC hdcDst = CreateCompatibleDC (hcdc); - old1 = SelectObject (hcdc, IMAGE_INSTANCE_MSWINDOWS_BITMAP (ii)); + old1 = SelectObject (hcdc, curbmp); newbmp = CreateCompatibleBitmap (hcdc, newx, newy); @@ -596,8 +604,8 @@ mswindows_create_resized_bitmap (Lisp_Image_Instance* ii, if (!StretchBlt (hdcDst, 0, 0, newx, newy, hcdc, 0, 0, - IMAGE_INSTANCE_PIXMAP_WIDTH (ii), - IMAGE_INSTANCE_PIXMAP_HEIGHT (ii), + curx, + cury, SRCCOPY)) { DeleteObject (newbmp); @@ -613,43 +621,33 @@ mswindows_create_resized_bitmap (Lisp_Image_Instance* ii, } HBITMAP +mswindows_create_resized_bitmap (Lisp_Image_Instance* ii, + struct frame* f, + int newx, int newy) +{ + return create_resized_bitmap (IMAGE_INSTANCE_MSWINDOWS_BITMAP (ii), + f, + IMAGE_INSTANCE_PIXMAP_WIDTH (ii), + IMAGE_INSTANCE_PIXMAP_HEIGHT (ii), + newx, newy); +} + +HBITMAP mswindows_create_resized_mask (Lisp_Image_Instance* ii, struct frame* f, int newx, int newy) { - if (IMAGE_INSTANCE_MSWINDOWS_MASK (ii)) - { - HBITMAP newmask; - HGDIOBJ old1, old2; - HDC hcdc = FRAME_MSWINDOWS_CDC (f); - HDC hdcDst = CreateCompatibleDC (hcdc); - - old1 = SelectObject (hcdc, IMAGE_INSTANCE_MSWINDOWS_MASK (ii)); - newmask = CreateCompatibleBitmap(hcdc, newx, newy); - old2 = SelectObject (hdcDst, newmask); - - if (!StretchBlt(hdcDst, 0, 0, newx, newy, - hcdc, 0, 0, - IMAGE_INSTANCE_PIXMAP_WIDTH (ii), - IMAGE_INSTANCE_PIXMAP_HEIGHT (ii), - SRCCOPY)) - { - DeleteObject (newmask); - DeleteDC (hdcDst); - return NULL; - } - - SelectObject (hdcDst, old2); - SelectObject (hcdc, old1); - - DeleteDC (hdcDst); - - return newmask; - } + if (IMAGE_INSTANCE_MSWINDOWS_MASK (ii) == NULL) + return NULL; - return NULL; + return create_resized_bitmap (IMAGE_INSTANCE_MSWINDOWS_MASK (ii), + f, + IMAGE_INSTANCE_PIXMAP_WIDTH (ii), + IMAGE_INSTANCE_PIXMAP_HEIGHT (ii), + newx, newy); } +#if 0 /* Currently unused */ int mswindows_resize_dibitmap_instance (Lisp_Image_Instance* ii, struct frame* f, @@ -673,6 +671,7 @@ mswindows_resize_dibitmap_instance (Lisp_Image_Instance* ii, return TRUE; } +#endif /********************************************************************** * XPM * @@ -791,7 +790,7 @@ static int xpm_to_eimage (Lisp_Object image, const Extbyte *buffer, default: { signal_double_file_error_2 ("Parsing pixmap data", - "unknown error code", + "unknown error", make_int (result), image); } } @@ -921,8 +920,7 @@ mswindows_xpm_instantiate (Lisp_Object image_instance, Lisp_Object color_symbol_alist = find_keyword_in_vector (instantiator, Q_color_symbols); - if (!DEVICE_MSWINDOWS_P (XDEVICE (device))) - signal_simple_error ("Not an mswindows device", device); + CHECK_MSGDI_DEVICE (device); assert (!NILP (data)); @@ -1007,8 +1005,7 @@ bmp_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, int bmp_bits; Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - if (!DEVICE_MSWINDOWS_P (XDEVICE (device))) - signal_simple_error ("Not an mswindows device", device); + CHECK_MSGDI_DEVICE (device); assert (!NILP (data)); @@ -1233,8 +1230,7 @@ mswindows_resource_instantiate (Lisp_Object image_instance, Lisp_Object instanti xzero (iconinfo); - if (!DEVICE_MSWINDOWS_P (XDEVICE (device))) - signal_simple_error ("Not an mswindows device", device); + CHECK_MSGDI_DEVICE (device); type = resource_symbol_to_type (resource_type); @@ -1407,7 +1403,8 @@ static int initialized = FALSE; /* easier to fill in at run time */ * Table index for the hex values. Initialized once, first time. * Used for translation value or delimiter significance lookup. */ -static void initHexTable() +static void +initHexTable (void) { /* * We build the table at run time for several reasons: @@ -1440,7 +1437,8 @@ static void initHexTable() /* * read next hex value in the input stream, return -1 if EOF */ -static int NextInt ( FILE *fstream ) +static int +NextInt (FILE *fstream) { int ch; int value = 0; @@ -1730,17 +1728,16 @@ init_image_instance_from_xbm_inline (Lisp_Image_Instance *ii, Lisp_Object mask_filename) { Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); - struct frame* f = XFRAME (DEVICE_SELECTED_FRAME (XDEVICE (device))); Lisp_Object foreground = find_keyword_in_vector (instantiator, Q_foreground); Lisp_Object background = find_keyword_in_vector (instantiator, Q_background); enum image_instance_type type; COLORREF black = PALETTERGB (0,0,0); COLORREF white = PALETTERGB (255,255,255); + HDC hdc; - HDC hdc = FRAME_MSWINDOWS_CDC (f); + CHECK_MSGDI_DEVICE (device); - if (!DEVICE_MSWINDOWS_P (XDEVICE (device))) - signal_simple_error ("Not an MS-Windows device", device); + hdc = get_device_compdc (XDEVICE (device)); if ((dest_mask & IMAGE_MONO_PIXMAP_MASK) && (dest_mask & IMAGE_COLOR_PIXMAP_MASK)) @@ -1855,9 +1852,7 @@ xbm_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator, Lisp_Object mask_data = find_keyword_in_vector (instantiator, Q_mask_data); Lisp_Object mask_file = find_keyword_in_vector (instantiator, Q_mask_file); Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - struct frame* f = XFRAME (DEVICE_SELECTED_FRAME - (XDEVICE (IMAGE_INSTANCE_DEVICE (ii)))); - HDC hdc = FRAME_MSWINDOWS_CDC (f); + HDC hdc = get_device_compdc (XDEVICE (IMAGE_INSTANCE_DEVICE (ii))); HBITMAP mask = 0; if (!NILP (mask_data)) @@ -2230,12 +2225,10 @@ mswindows_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instant { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); - struct device* d = XDEVICE (device); Lisp_Object frame = FW_FRAME (domain); HWND wnd; - if (!DEVICE_MSWINDOWS_P (d)) - signal_simple_error ("Not an mswindows device", device); + CHECK_MSWINDOWS_DEVICE (device); /* have to set the type this late in case there is no device instantiation for a widget */ @@ -2354,7 +2347,6 @@ mswindows_widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiat /* this function can call lisp */ Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii), style; - struct device* d = XDEVICE (device); Lisp_Object frame = FW_FRAME (domain); Extbyte* nm=0; HWND wnd; @@ -2362,8 +2354,7 @@ mswindows_widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiat Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii); Lisp_Gui_Item* pgui = XGUI_ITEM (gui); - if (!DEVICE_MSWINDOWS_P (d)) - signal_simple_error ("Not an mswindows device", device); + CHECK_MSWINDOWS_DEVICE (device); if (!gui_item_active_p (gui)) flags |= WS_DISABLED; @@ -2440,7 +2431,7 @@ mswindows_button_instantiate (Lisp_Object image_instance, Lisp_Object instantiat Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { - /* this function can call lisp */ + /* This function can call lisp */ Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); HWND wnd; int flags = WS_TABSTOP;/* BS_NOTIFY #### is needed to get exotic feedback @@ -2686,9 +2677,10 @@ mswindows_tab_control_instantiate (Lisp_Object image_instance, Lisp_Object insta Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { + /* This function can call lisp */ Lisp_Object rest; HWND wnd; - int i = 0; + int i = 0, selected = 0; Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object orient = find_keyword_in_vector (instantiator, Q_orientation); unsigned int flags = WS_TABSTOP; @@ -2706,38 +2698,49 @@ mswindows_tab_control_instantiate (Lisp_Object image_instance, Lisp_Object insta pointer_bg, dest_mask, domain, WC_TABCONTROL, /* borders don't suit tabs so well */ flags, 0); - wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); /* add items to the tab */ LIST_LOOP (rest, XCDR (IMAGE_INSTANCE_WIDGET_ITEMS (ii))) { add_tab_item (image_instance, wnd, XCAR (rest), domain, i); + if (gui_item_selected_p (XCAR (rest))) + selected = i; i++; } + SendMessage (wnd, TCM_SETCURSEL, selected, 0); } /* set the properties of a tab control */ static void mswindows_tab_control_update (Lisp_Object image_instance) { + /* This function can GC if IN_REDISPLAY is false. */ Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii)) { HWND wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); - int i = 0; + int i = 0, selected = 0; Lisp_Object rest; /* delete the pre-existing items */ SendMessage (wnd, TCM_DELETEALLITEMS, 0, 0); + /* Pick up the items we recorded earlier. We do this here so + that the callbacks get set up with the new items. */ + IMAGE_INSTANCE_WIDGET_ITEMS (ii) = + IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii); + IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii) = Qnil; /* add items to the tab */ LIST_LOOP (rest, XCDR (IMAGE_INSTANCE_WIDGET_ITEMS (ii))) { add_tab_item (image_instance, wnd, XCAR (rest), IMAGE_INSTANCE_SUBWINDOW_FRAME (ii), i); + if (gui_item_selected_p (XCAR (rest))) + selected = i; i++; } + SendMessage (wnd, TCM_SETCURSEL, selected, 0); } } @@ -2926,51 +2929,64 @@ syms_of_glyphs_mswindows (void) void console_type_create_glyphs_mswindows (void) { - /* image methods */ - + /* image methods - display */ CONSOLE_HAS_METHOD (mswindows, print_image_instance); CONSOLE_HAS_METHOD (mswindows, finalize_image_instance); CONSOLE_HAS_METHOD (mswindows, unmap_subwindow); CONSOLE_HAS_METHOD (mswindows, map_subwindow); CONSOLE_HAS_METHOD (mswindows, update_subwindow); + CONSOLE_HAS_METHOD (mswindows, resize_subwindow); CONSOLE_HAS_METHOD (mswindows, update_widget); CONSOLE_HAS_METHOD (mswindows, image_instance_equal); CONSOLE_HAS_METHOD (mswindows, image_instance_hash); CONSOLE_HAS_METHOD (mswindows, init_image_instance_from_eimage); CONSOLE_HAS_METHOD (mswindows, locate_pixmap_file); - CONSOLE_HAS_METHOD (mswindows, resize_subwindow); + + /* image methods - printer */ + CONSOLE_INHERITS_METHOD (msprinter, mswindows, print_image_instance); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, finalize_image_instance); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, image_instance_equal); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, image_instance_hash); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, init_image_instance_from_eimage); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, locate_pixmap_file); } void image_instantiator_format_create_glyphs_mswindows (void) { - IIFORMAT_VALID_CONSOLE (mswindows, nothing); - IIFORMAT_VALID_CONSOLE (mswindows, string); - IIFORMAT_VALID_CONSOLE (mswindows, layout); - IIFORMAT_VALID_CONSOLE (mswindows, formatted_string); - IIFORMAT_VALID_CONSOLE (mswindows, inherit); + IIFORMAT_VALID_CONSOLE2 (mswindows, msprinter, nothing); + IIFORMAT_VALID_CONSOLE2 (mswindows, msprinter, string); + IIFORMAT_VALID_CONSOLE2 (mswindows, msprinter, layout); + IIFORMAT_VALID_CONSOLE2 (mswindows, msprinter, formatted_string); + IIFORMAT_VALID_CONSOLE2 (mswindows, msprinter, inherit); /* image-instantiator types */ + INITIALIZE_DEVICE_IIFORMAT (mswindows, xbm); + INITIALIZE_DEVICE_IIFORMAT (msprinter, xbm); + IIFORMAT_HAS_DEVMETHOD (mswindows, xbm, instantiate); + IIFORMAT_INHERITS_DEVMETHOD (msprinter, mswindows, xbm, instantiate); #ifdef HAVE_XPM INITIALIZE_DEVICE_IIFORMAT (mswindows, xpm); + INITIALIZE_DEVICE_IIFORMAT (msprinter, xpm); IIFORMAT_HAS_DEVMETHOD (mswindows, xpm, instantiate); + IIFORMAT_INHERITS_DEVMETHOD (msprinter, mswindows, xpm, instantiate); #endif - INITIALIZE_DEVICE_IIFORMAT (mswindows, xbm); - IIFORMAT_HAS_DEVMETHOD (mswindows, xbm, instantiate); #ifdef HAVE_XFACE INITIALIZE_DEVICE_IIFORMAT (mswindows, xface); + INITIALIZE_DEVICE_IIFORMAT (msprinter, xface); IIFORMAT_HAS_DEVMETHOD (mswindows, xface, instantiate); + IIFORMAT_INHERITS_DEVMETHOD (msprinter, mswindows, xface, instantiate); #endif #ifdef HAVE_JPEG - IIFORMAT_VALID_CONSOLE (mswindows, jpeg); + IIFORMAT_VALID_CONSOLE2 (mswindows, msprinter, jpeg); #endif #ifdef HAVE_TIFF - IIFORMAT_VALID_CONSOLE (mswindows, tiff); + IIFORMAT_VALID_CONSOLE2 (mswindows, msprinter, tiff); #endif #ifdef HAVE_PNG - IIFORMAT_VALID_CONSOLE (mswindows, png); + IIFORMAT_VALID_CONSOLE2 (mswindows, msprinter, png); #endif #ifdef HAVE_GIF - IIFORMAT_VALID_CONSOLE (mswindows, gif); + IIFORMAT_VALID_CONSOLE2 (mswindows, msprinter, gif); #endif #ifdef HAVE_WIDGETS /* button widget */ @@ -3025,7 +3041,7 @@ image_instantiator_format_create_glyphs_mswindows (void) IIFORMAT_VALID_KEYWORD (bmp, Q_data, check_valid_string); IIFORMAT_VALID_KEYWORD (bmp, Q_file, check_valid_string); - IIFORMAT_VALID_CONSOLE (mswindows, bmp); + IIFORMAT_VALID_CONSOLE2 (mswindows, msprinter, bmp); /* mswindows resources */ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (mswindows_resource, @@ -3040,7 +3056,7 @@ image_instantiator_format_create_glyphs_mswindows (void) check_valid_resource_symbol); IIFORMAT_VALID_KEYWORD (mswindows_resource, Q_resource_id, check_valid_resource_id); IIFORMAT_VALID_KEYWORD (mswindows_resource, Q_file, check_valid_string); - IIFORMAT_VALID_CONSOLE (mswindows, mswindows_resource); + IIFORMAT_VALID_CONSOLE2 (mswindows, msprinter, mswindows_resource); } void diff --git a/src/glyphs-widget.c b/src/glyphs-widget.c index ab50d29..355be6e 100644 --- a/src/glyphs-widget.c +++ b/src/glyphs-widget.c @@ -149,6 +149,13 @@ check_valid_callback (Lisp_Object data) } static void +check_valid_int_or_function (Lisp_Object data) +{ + if (!INTP (data) && !CONSP (data)) + signal_simple_error ("must be an integer or expresssion", data); +} + +static void check_valid_symbol (Lisp_Object data) { CHECK_SYMBOL (data); @@ -360,6 +367,8 @@ widget_query_geometry (Lisp_Object image_instance, { Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); struct image_instantiator_methods* meths; + Lisp_Object dynamic_width = Qnil; + Lisp_Object dynamic_height = Qnil; /* First just set up what we already have. */ if (width) *width = IMAGE_INSTANCE_WIDTH (ii); @@ -402,6 +411,19 @@ widget_query_geometry (Lisp_Object image_instance, *height = h + 2 * WIDGET_BORDER_HEIGHT; } } + /* Finish off with dynamic sizing. */ + if (!NILP (IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (ii))) + { + dynamic_width = Feval (IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (ii)); + if (INTP (dynamic_width)) + *width = XINT (dynamic_width); + } + if (!NILP (IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (ii))) + { + dynamic_height = Feval (IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (ii)); + if (INTP (dynamic_height)) + *height = XINT (dynamic_height); + } } } @@ -484,6 +506,9 @@ initialize_widget_image_instance (Lisp_Image_Instance *ii, Lisp_Object type) IMAGE_INSTANCE_WIDGET_PROPS (ii) = Qnil; SET_IMAGE_INSTANCE_WIDGET_FACE (ii, Qnil); IMAGE_INSTANCE_WIDGET_ITEMS (ii) = allocate_gui_item (); + IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii) = Qnil; + IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (ii) = Qnil; + IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (ii) = Qnil; IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii) = 1; IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) = 1; IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) = 0; @@ -618,8 +643,13 @@ widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, geometry gets called. */ if (!NILP (pixwidth)) /* pixwidth takes precendent */ { - pw = XINT (pixwidth); - IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii) = 0; + if (!INTP (pixwidth)) + IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (ii) = pixwidth; + else + { + pw = XINT (pixwidth); + IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii) = 0; + } } else if (!NILP (width)) { @@ -629,8 +659,13 @@ widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, if (!NILP (pixheight)) { - ph = XINT (pixheight); - IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) = 0; + if (!INTP (pixwidth)) + IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (ii) = pixheight; + else + { + ph = XINT (pixheight); + IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) = 0; + } } else if (!NILP (height) && XINT (height) > 1) { @@ -756,12 +791,16 @@ tab_control_set_property (Lisp_Object image_instance, if (EQ (prop, Q_items)) { Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); - check_valid_item_list_1 (val); - IMAGE_INSTANCE_WIDGET_ITEMS (ii) = - Fcons (XCAR (IMAGE_INSTANCE_WIDGET_ITEMS (ii)), - parse_gui_item_tree_children (val)); + check_valid_item_list_1 (val); + /* Don't set the actual items since we might decide not to use + the new ones (because nothing has really changed). If we did + set them and didn't use them then we would get into whole + heaps of trouble when the old items get GC'd. */ + IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii) = + Fcons (XCAR (IMAGE_INSTANCE_WIDGET_ITEMS (ii)), + parse_gui_item_tree_children (val)); IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 1; return Qt; @@ -1099,8 +1138,8 @@ syms_of_glyphs_widget (void) #define VALID_WIDGET_KEYWORDS(type) do { \ IIFORMAT_VALID_KEYWORD (type, Q_width, check_valid_int); \ IIFORMAT_VALID_KEYWORD (type, Q_height, check_valid_int); \ - IIFORMAT_VALID_KEYWORD (type, Q_pixel_width, check_valid_int); \ - IIFORMAT_VALID_KEYWORD (type, Q_pixel_height, check_valid_int); \ + IIFORMAT_VALID_KEYWORD (type, Q_pixel_width, check_valid_int_or_function);\ + IIFORMAT_VALID_KEYWORD (type, Q_pixel_height, check_valid_int_or_function);\ IIFORMAT_VALID_KEYWORD (type, Q_face, check_valid_face); \ } while (0) @@ -1146,7 +1185,7 @@ static void image_instantiator_combo_box (void) IIFORMAT_VALID_KEYWORD (combo_box, Q_width, check_valid_int); IIFORMAT_VALID_KEYWORD (combo_box, Q_height, check_valid_int); - IIFORMAT_VALID_KEYWORD (combo_box, Q_pixel_width, check_valid_int); + IIFORMAT_VALID_KEYWORD (combo_box, Q_pixel_width, check_valid_int_or_function); IIFORMAT_VALID_KEYWORD (combo_box, Q_face, check_valid_face); IIFORMAT_VALID_KEYWORD (combo_box, Q_properties, check_valid_item_list); } @@ -1159,8 +1198,8 @@ static void image_instantiator_scrollbar (void) IIFORMAT_HAS_SHARED_METHOD (scrollbar, instantiate, widget); VALID_GUI_KEYWORDS (scrollbar); - IIFORMAT_VALID_KEYWORD (scrollbar, Q_pixel_width, check_valid_int); - IIFORMAT_VALID_KEYWORD (scrollbar, Q_pixel_height, check_valid_int); + IIFORMAT_VALID_KEYWORD (scrollbar, Q_pixel_width, check_valid_int_or_function); + IIFORMAT_VALID_KEYWORD (scrollbar, Q_pixel_height, check_valid_int_or_function); IIFORMAT_VALID_KEYWORD (scrollbar, Q_face, check_valid_face); } @@ -1218,8 +1257,8 @@ static void image_instantiator_layout (void) IIFORMAT_HAS_METHOD (layout, normalize); IIFORMAT_HAS_METHOD (layout, query_geometry); IIFORMAT_HAS_METHOD (layout, layout); - IIFORMAT_VALID_KEYWORD (layout, Q_pixel_width, check_valid_int); - IIFORMAT_VALID_KEYWORD (layout, Q_pixel_height, check_valid_int); + IIFORMAT_VALID_KEYWORD (layout, Q_pixel_width, check_valid_int_or_function); + IIFORMAT_VALID_KEYWORD (layout, Q_pixel_height, check_valid_int_or_function); IIFORMAT_VALID_KEYWORD (layout, Q_orientation, check_valid_orientation); IIFORMAT_VALID_KEYWORD (layout, Q_justify, check_valid_justification); IIFORMAT_VALID_KEYWORD (layout, Q_border, check_valid_border); diff --git a/src/glyphs-x.c b/src/glyphs-x.c index 6124be4..0651929 100644 --- a/src/glyphs-x.c +++ b/src/glyphs-x.c @@ -2189,6 +2189,12 @@ x_update_widget (Lisp_Image_Instance *p) need to update most other things after the items have changed.*/ if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p)) { + /* Pick up the items we recorded earlier. We do this here so + that the callbacks get set up with the new items. */ + IMAGE_INSTANCE_WIDGET_ITEMS (p) = + IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (p); + IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (p) = Qnil; + wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (p)); wv->change = STRUCTURAL_CHANGE; @@ -2201,6 +2207,9 @@ x_update_widget (Lisp_Image_Instance *p) /* Now do non structural updates. */ wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (p)); + if (!wv) + return; + /* Possibly update the colors and font */ if (IMAGE_INSTANCE_WIDGET_FACE_CHANGED (p) || @@ -2692,6 +2701,11 @@ x_tab_control_update (Lisp_Object image_instance) IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii)) { widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii)); + + /* #### I don't know why this can occur. */ + if (!wv) + return; + update_tab_widget_face (wv, ii, IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)); diff --git a/src/glyphs.h b/src/glyphs.h index 771ce7a..b405f9e 100644 --- a/src/glyphs.h +++ b/src/glyphs.h @@ -269,6 +269,10 @@ IIFORMAT_VALID_GENERIC_KEYWORD(format, keyw, validate_fun, 0, 0) entry); \ } while (0) +#define IIFORMAT_VALID_CONSOLE2(con1, con2, format) \ + IIFORMAT_VALID_CONSOLE (con1, format); \ + IIFORMAT_VALID_CONSOLE (con2, format); + #define DEFINE_DEVICE_IIFORMAT(type, format) \ DECLARE_IMAGE_INSTANTIATOR_FORMAT(format); \ struct image_instantiator_methods *type##_##format##_image_instantiator_methods @@ -295,6 +299,11 @@ do { \ #define IIFORMAT_HAS_SHARED_DEVMETHOD(type, format, m, fromformat) \ (type##_##format##_image_instantiator_methods->m##_method = type##_##fromformat##_##m) +#define IIFORMAT_INHERITS_DEVMETHOD(type, from, format, m) \ + (type##_##format##_image_instantiator_methods->m##_method = from##_##format##_##m) +#define IIFORMAT_INHERITS_SHARED_DEVMETHOD(type, from, format, m, fromformat) \ + (type##_##format##_image_instantiator_methods->m##_method = from##_##fromformat##_##m) + struct image_instantiator_methods * decode_device_ii_format (Lisp_Object device, Lisp_Object format, Error_behavior errb); @@ -488,10 +497,14 @@ struct Lisp_Image_Instance enum image_instance_type type; unsigned int x_offset, y_offset; /* for layout purposes */ unsigned int width, height; + unsigned long display_hash; /* Hash value representing the structure + of the image_instance when it was + last displayed. */ unsigned int dirty : 1; unsigned int size_changed : 1; unsigned int text_changed : 1; unsigned int layout_changed : 1; + unsigned int optimize_output : 1; /* For outputting layouts. */ union { @@ -531,6 +544,9 @@ struct Lisp_Image_Instance Lisp_Object type; Lisp_Object props; /* properties or border*/ Lisp_Object items; /* a list of gui_items or children */ + Lisp_Object pending_items; /* gui_items that should be displayed */ + Lisp_Object width; /* dynamic width spec. */ + Lisp_Object height; /* dynamic height spec. */ /* Change flags to augment dirty. */ unsigned int face_changed : 1; unsigned int items_changed : 1; @@ -550,6 +566,8 @@ struct Lisp_Image_Instance #define LAYOUT_JUSTIFY_RIGHT 1 #define LAYOUT_JUSTIFY_CENTER 2 +#define IMAGE_INSTANCE_HASH_DEPTH -2 + /* Accessor macros. */ #define IMAGE_INSTANCE_DEVICE(i) ((i)->device) #define IMAGE_INSTANCE_NAME(i) ((i)->name) @@ -560,6 +578,7 @@ struct Lisp_Image_Instance #define IMAGE_INSTANCE_YOFFSET(i) ((i)->y_offset) #define IMAGE_INSTANCE_WIDTH(i) ((i)->width) #define IMAGE_INSTANCE_HEIGHT(i) ((i)->height) +#define IMAGE_INSTANCE_DISPLAY_HASH(i) ((i)->display_hash) #define IMAGE_INSTANCE_PIXMAP_TYPE_P(i) \ ((IMAGE_INSTANCE_TYPE (i) == IMAGE_MONO_PIXMAP) \ || (IMAGE_INSTANCE_TYPE (i) == IMAGE_COLOR_PIXMAP)) @@ -567,7 +586,8 @@ struct Lisp_Image_Instance #define IMAGE_INSTANCE_NEEDS_LAYOUT(i) \ (IMAGE_INSTANCE_DIRTYP (i) && IMAGE_INSTANCE_LAYOUT_CHANGED (i)) #define IMAGE_INSTANCE_FACE(i) \ - XGLYPH_FACE (IMAGE_INSTANCE_GLYPH (i)) + (GLYPHP (IMAGE_INSTANCE_GLYPH (i)) ? \ + XGLYPH_FACE (IMAGE_INSTANCE_GLYPH (i)) : Qnil) /* Changed flags */ #define IMAGE_INSTANCE_TEXT_CHANGED(i) ((i)->text_changed) @@ -578,8 +598,8 @@ struct Lisp_Image_Instance ((i)->u.subwindow.items_changed) #define IMAGE_INSTANCE_WIDGET_PERCENT_CHANGED(i) \ ((i)->u.subwindow.percent_changed) -#define IMAGE_INSTANCE_LAYOUT_CHANGED(i) \ - ((i)->layout_changed) +#define IMAGE_INSTANCE_LAYOUT_CHANGED(i) ((i)->layout_changed) +#define IMAGE_INSTANCE_OPTIMIZE_OUTPUT(i) ((i)->optimize_output) /* Text properties */ #define IMAGE_INSTANCE_TEXT_STRING(i) ((i)->u.text.string) @@ -632,6 +652,8 @@ struct Lisp_Image_Instance IMAGE_INSTANCE_WIDTH(i) #define IMAGE_INSTANCE_WIDGET_HEIGHT(i) \ IMAGE_INSTANCE_HEIGHT(i) +#define IMAGE_INSTANCE_WIDGET_WIDTH_SUBR(i) ((i)->u.subwindow.width) +#define IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR(i) ((i)->u.subwindow.height) #define IMAGE_INSTANCE_WIDGET_TYPE(i) ((i)->u.subwindow.type) #define IMAGE_INSTANCE_WIDGET_PROPS(i) ((i)->u.subwindow.props) #define SET_IMAGE_INSTANCE_WIDGET_FACE(i,f) \ @@ -641,6 +663,8 @@ struct Lisp_Image_Instance !NILP (IMAGE_INSTANCE_FACE (i)) ? IMAGE_INSTANCE_FACE (i) : \ Vwidget_face) #define IMAGE_INSTANCE_WIDGET_ITEMS(i) ((i)->u.subwindow.items) +#define IMAGE_INSTANCE_WIDGET_PENDING_ITEMS(i) \ + ((i)->u.subwindow.pending_items) #define IMAGE_INSTANCE_WIDGET_ITEM(i) \ (CONSP (IMAGE_INSTANCE_WIDGET_ITEMS (i)) ? \ XCAR (IMAGE_INSTANCE_WIDGET_ITEMS (i)) : \ @@ -661,6 +685,8 @@ XCAR (IMAGE_INSTANCE_WIDGET_ITEMS (i)) : \ IMAGE_INSTANCE_PARENT (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_TYPE(i) \ IMAGE_INSTANCE_TYPE (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_DISPLAY_HASH(i) \ + IMAGE_INSTANCE_DISPLAY_HASH (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_XOFFSET(i) \ IMAGE_INSTANCE_XOFFSET (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_YOFFSET(i) \ @@ -718,6 +744,10 @@ XCAR (IMAGE_INSTANCE_WIDGET_ITEMS (i)) : \ IMAGE_INSTANCE_WIDGET_WIDTH (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_WIDGET_HEIGHT(i) \ IMAGE_INSTANCE_WIDGET_HEIGHT (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_WIDGET_WIDTH_SUBR(i) \ + IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_WIDGET_HEIGHT_SUBR(i) \ + IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_WIDGET_TYPE(i) \ IMAGE_INSTANCE_WIDGET_TYPE (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_WIDGET_PROPS(i) \ @@ -730,6 +760,8 @@ XCAR (IMAGE_INSTANCE_WIDGET_ITEMS (i)) : \ IMAGE_INSTANCE_WIDGET_ITEM (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_WIDGET_ITEMS(i) \ IMAGE_INSTANCE_WIDGET_ITEMS (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_WIDGET_PENDING_ITEMS(i) \ + IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_WIDGET_TEXT(i) \ IMAGE_INSTANCE_WIDGET_TEXT (XIMAGE_INSTANCE (i)) @@ -854,7 +886,7 @@ extern Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y; extern Lisp_Object Q_foreground, Q_background, Q_face, Q_descriptor, Q_group; extern Lisp_Object Q_width, Q_height, Q_pixel_width, Q_pixel_height, Q_text; extern Lisp_Object Q_items, Q_properties, Q_image, Q_percent, Qimage_conversion_error; -extern Lisp_Object Q_orientation; +extern Lisp_Object Q_orientation, Qupdate_widget_instances; extern Lisp_Object Vcontinuation_glyph, Vcontrol_arrow_glyph, Vhscroll_glyph; extern Lisp_Object Vinvisible_text_glyph, Voctal_escape_glyph, Vtruncation_glyph; extern Lisp_Object Vxemacs_logo; @@ -977,7 +1009,6 @@ void reset_subwindow_cachels (struct frame *f); void unmap_subwindow (Lisp_Object subwindow); void map_subwindow (Lisp_Object subwindow, int x, int y, struct display_glyph_area *dga); -void update_frame_subwindows (struct frame *f); int find_matching_subwindow (struct frame* f, int x, int y, int width, int height); void update_widget (Lisp_Object widget); void update_subwindow (Lisp_Object subwindow); diff --git a/src/gmalloc.c b/src/gmalloc.c index 472bd3f..7358472 100644 --- a/src/gmalloc.c +++ b/src/gmalloc.c @@ -367,7 +367,7 @@ Boston, MA 02111-1307, USA. #endif /* How to really get more memory. */ -#ifdef HEAP_IN_DATA +#if defined (HEAP_IN_DATA) && !defined(PDUMP) /* once dumped, free() & realloc() on static heap space will fail */ #define PURE_DATA(x) \ ((static_heap_dumped && (char*)x >= static_heap_base \ @@ -446,7 +446,7 @@ static int initialize __P ((void)); static int initialize () { -#ifdef HEAP_IN_DATA +#if defined (HEAP_IN_DATA) && !defined(PDUMP) if (static_heap_dumped && __morecore == more_static_core) { __morecore = __default_morecore; diff --git a/src/gpmevent.c b/src/gpmevent.c index 1c879d4..64df9ab 100644 --- a/src/gpmevent.c +++ b/src/gpmevent.c @@ -140,10 +140,10 @@ This function is the process handler for the GPM connection. /* Whow, wouldn't named defines be NICE!?!?! */ modifiers = 0; - if (ev.modifiers & 1) modifiers |= MOD_SHIFT; - if (ev.modifiers & 2) modifiers |= MOD_META; - if (ev.modifiers & 4) modifiers |= MOD_CONTROL; - if (ev.modifiers & 8) modifiers |= MOD_META; + if (ev.modifiers & 1) modifiers |= XEMACS_MOD_SHIFT; + if (ev.modifiers & 2) modifiers |= XEMACS_MOD_META; + if (ev.modifiers & 4) modifiers |= XEMACS_MOD_CONTROL; + if (ev.modifiers & 8) modifiers |= XEMACS_MOD_META; if (ev.buttons & GPM_B_LEFT) { diff --git a/src/gui-msw.c b/src/gui-msw.c index 07b4a79..415d9e2 100644 --- a/src/gui-msw.c +++ b/src/gui-msw.c @@ -36,7 +36,7 @@ Boston, MA 02111-1307, USA. */ * command if we return nil */ Lisp_Object -mswindows_handle_gui_wm_command (struct frame* f, HWND ctrl, DWORD id) +mswindows_handle_gui_wm_command (struct frame* f, HWND ctrl, LPARAM id) { /* Try to map the command id through the proper hash table */ Lisp_Object data, fn, arg, frame; @@ -50,11 +50,14 @@ mswindows_handle_gui_wm_command (struct frame* f, HWND ctrl, DWORD id) if (NILP (data) || UNBOUNDP (data)) return Qnil; - MARK_SUBWINDOWS_STATE_CHANGED; /* Ok, this is our one. Enqueue it. */ get_gui_callback (data, &fn, &arg); XSETFRAME (frame, f); mswindows_enqueue_misc_user_event (frame, fn, arg); + /* The result of this evaluation could cause other instances to change so + enqueue an update callback to check this. */ + mswindows_enqueue_misc_user_event (frame, Qeval, + list2 (Qupdate_widget_instances, frame)); return Qt; } @@ -137,9 +140,9 @@ otherwise it is an integer representing a ShowWindow flag: if (ret > 32) return Qt; - if (ret == ERROR_FILE_NOT_FOUND || ret == SE_ERR_FNF) + if (ret == ERROR_FILE_NOT_FOUND) signal_simple_error ("file not found", document); - else if (ret == ERROR_PATH_NOT_FOUND || ret == SE_ERR_PNF) + else if (ret == ERROR_PATH_NOT_FOUND) signal_simple_error ("path not found", current_dir); else if (ret == ERROR_BAD_FORMAT) signal_simple_error ("bad executable format", document); diff --git a/src/gui-x.c b/src/gui-x.c index 467c3ab..2099351 100644 --- a/src/gui-x.c +++ b/src/gui-x.c @@ -213,6 +213,7 @@ popup_selection_callback (Widget widget, LWLIB_ID ignored_id, Lisp_Object fn, arg; Lisp_Object data; Lisp_Object frame; + int update_subwindows_p = 0; struct device *d = get_device_from_display (XtDisplay (widget)); struct frame *f = x_any_widget_or_parent_to_frame (d, widget); @@ -245,7 +246,7 @@ popup_selection_callback (Widget widget, LWLIB_ID ignored_id, } else { - MARK_SUBWINDOWS_STATE_CHANGED; + update_subwindows_p = 1; get_gui_callback (data, &fn, &arg); } @@ -258,6 +259,11 @@ popup_selection_callback (Widget widget, LWLIB_ID ignored_id, DEVICE_X_MOUSE_TIMESTAMP (d) = DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d); #endif signal_special_Xt_user_event (frame, fn, arg); + /* The result of this evaluation could cause other instances to change so + enqueue an update callback to check this. */ + if (update_subwindows_p) + signal_special_Xt_user_event (frame, Qeval, + list2 (Qupdate_widget_instances, frame)); } #if 1 @@ -303,6 +309,30 @@ menu_separator_style (const char *s) return NULL; } +char * +strdup_and_add_accel (char *name) +{ + int i; + int found_accel = 0; + + for (i=0; name[i]; ++i) + if (name[i] == '%' && name[i+1] == '_') + { + found_accel = 1; + break; + } + + if (found_accel) + return xstrdup (name); + else + { + char *chars = (char *) alloca (strlen (name) + 3); + chars[0] = '%'; + chars[1] = '_'; + memcpy (chars+2, name, strlen (name) + 1); + return xstrdup (chars); + } +} /* This does the dirty work. gc_currently_forbidden is 1 when this is called. */ @@ -320,7 +350,7 @@ button_item_to_widget_value (Lisp_Object gui_item, widget_value *wv, { wv->type = TEXT_TYPE; wv->name = (char *) XSTRING_DATA (gui_item); - wv->name = xstrdup (wv->name); + wv->name = strdup_and_add_accel (wv->name); return 1; } else if (!GUI_ITEMP (gui_item)) @@ -339,6 +369,9 @@ button_item_to_widget_value (Lisp_Object gui_item, widget_value *wv, } #endif /* HAVE_MENUBARS */ + if (!STRINGP (pgui->name)) + pgui->name = Feval (pgui->name); + CHECK_STRING (pgui->name); wv->name = (char *) XSTRING_DATA (pgui->name); wv->name = xstrdup (wv->name); @@ -388,7 +421,7 @@ button_item_to_widget_value (Lisp_Object gui_item, widget_value *wv, } else if (SYMBOLP (pgui->callback)) /* Show the binding of this command. */ { - char buf [1024]; + char buf[1024]; /* #### */ /* #### Warning, dependency here on current_buffer and point */ where_is_to_char (pgui->callback, buf); if (buf [0]) diff --git a/src/gui-x.h b/src/gui-x.h index d8e581a..f2fa851 100644 --- a/src/gui-x.h +++ b/src/gui-x.h @@ -68,6 +68,7 @@ int popup_handled_p (LWLIB_ID id); void free_popup_widget_value_tree (widget_value *wv); void popup_selection_callback (Widget widget, LWLIB_ID ignored_id, XtPointer client_data); +char *strdup_and_add_accel (char *name); int button_item_to_widget_value (Lisp_Object desc, widget_value *wv, int allow_text_field_p, int no_keys_p); widget_value * gui_items_to_widget_values (Lisp_Object items); diff --git a/src/gui.c b/src/gui.c index 00012a6..d1a546e 100644 --- a/src/gui.c +++ b/src/gui.c @@ -27,6 +27,7 @@ Boston, MA 02111-1307, USA. */ #include "lisp.h" #include "gui.h" #include "elhash.h" +#include "buffer.h" #include "bytecode.h" Lisp_Object Q_active, Q_suffix, Q_keys, Q_style, Q_selected; @@ -108,7 +109,7 @@ gui_item_add_keyval_pair (Lisp_Object gui_item, Lisp_Object key, Lisp_Object val, Error_behavior errb) { - Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); + Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); if (!KEYWORDP (key)) signal_simple_error_2 ("Non-keyword in gui item", key, pgui_item->name); @@ -132,7 +133,8 @@ gui_item_add_keyval_pair (Lisp_Object gui_item, signal_simple_error ("Bad keyboard accelerator", val); } else if (ERRB_EQ (errb, ERROR_ME)) - signal_simple_error_2 ("Unknown keyword in gui item", key, pgui_item->name); + signal_simple_error_2 ("Unknown keyword in gui item", key, + pgui_item->name); } void @@ -179,7 +181,7 @@ make_gui_item_from_keywords_internal (Lisp_Object item, int length, plist_p, start; Lisp_Object *contents; Lisp_Object gui_item = allocate_gui_item (); - Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); + Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); CHECK_VECTOR (item); length = XVECTOR_LENGTH (item); @@ -251,7 +253,7 @@ gui_parse_item_keywords_no_errors (Lisp_Object item) void gui_add_item_keywords_to_plist (Lisp_Object plist, Lisp_Object gui_item) { - Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); + Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); if (!NILP (pgui_item->callback)) Fplist_put (plist, Q_callback, pgui_item->callback); @@ -293,7 +295,7 @@ gui_item_active_p (Lisp_Object gui_item) Lisp_Object gui_item_accelerator (Lisp_Object gui_item) { - Lisp_Gui_Item* pgui = XGUI_ITEM (gui_item); + Lisp_Gui_Item *pgui = XGUI_ITEM (gui_item); if (!NILP (pgui->accelerator)) return pgui->accelerator; @@ -305,23 +307,26 @@ gui_item_accelerator (Lisp_Object gui_item) Lisp_Object gui_name_accelerator (Lisp_Object nm) { - /* !!#### This function has not been Mule-ized */ - char* name = (char*)XSTRING_DATA (nm); - - while (*name) { - if (*name=='%') { - ++name; - if (!(*name)) - return Qnil; - if (*name=='_' && *(name+1)) + Bufbyte *name = XSTRING_DATA (nm); + + while (*name) + { + if (*name == '%') { - int accelerator = (int) (unsigned char) (*(name+1)); - return make_char (tolower (accelerator)); + ++name; + if (!(*name)) + return Qnil; + if (*name == '_' && *(name + 1)) + { + Emchar accelerator = charptr_emchar (name + 1); + /* #### bogus current_buffer dependency */ + return make_char (DOWNCASE (current_buffer, accelerator)); + } } + INC_CHARPTR (name); } - ++name; - } - return Qnil; + return make_char (DOWNCASE (current_buffer, + charptr_emchar (XSTRING_DATA (nm)))); } /* @@ -347,7 +352,7 @@ int gui_item_included_p (Lisp_Object gui_item, Lisp_Object conflist) { /* This function can call lisp */ - Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); + Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); /* Evaluate :included first. Shortcut to avoid evaluating Qt each time */ if (!EQ (pgui_item->included, Qt) @@ -379,13 +384,13 @@ signal_too_long_error (Lisp_Object name) * buffer. */ unsigned int -gui_item_display_flush_left (Lisp_Object gui_item, - char* buf, Bytecount buf_len) +gui_item_display_flush_left (Lisp_Object gui_item, + char *buf, Bytecount buf_len) { /* This function can call lisp */ char *p = buf; Bytecount len; - Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); + Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); /* Copy item name first */ CHECK_STRING (pgui_item->name); @@ -429,9 +434,9 @@ gui_item_display_flush_left (Lisp_Object gui_item, */ unsigned int gui_item_display_flush_right (Lisp_Object gui_item, - char* buf, Bytecount buf_len) + char *buf, Bytecount buf_len) { - Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); + Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); *buf = 0; #ifdef HAVE_MENUBARS @@ -444,16 +449,17 @@ gui_item_display_flush_right (Lisp_Object gui_item, if (!NILP (pgui_item->keys)) { CHECK_STRING (pgui_item->keys); - if (XSTRING_LENGTH (pgui_item->keys) > buf_len) + if (XSTRING_LENGTH (pgui_item->keys) + 1 > buf_len) signal_too_long_error (pgui_item->name); - strcpy (buf, (const char *) XSTRING_DATA (pgui_item->keys)); + memcpy (buf, XSTRING_DATA (pgui_item->keys), + XSTRING_LENGTH (pgui_item->keys) + 1); return XSTRING_LENGTH (pgui_item->keys); } /* See if we can derive keys out of callback symbol */ if (SYMBOLP (pgui_item->callback)) { - char buf2 [1024]; + char buf2[1024]; /* #### */ Bytecount len; where_is_to_char (pgui_item->callback, buf2); @@ -491,7 +497,7 @@ mark_gui_item (Lisp_Object obj) } static unsigned long -gui_item_hash (Lisp_Object obj, int depth) +gui_item_hash_internal (Lisp_Object obj, int depth) { Lisp_Gui_Item *p = XGUI_ITEM (obj); @@ -507,10 +513,29 @@ gui_item_hash (Lisp_Object obj, int depth) internal_hash (p->keys, depth + 1))); } +static unsigned long +gui_item_hash (Lisp_Object obj, int depth) +{ + Lisp_Gui_Item *p = XGUI_ITEM (obj); + + /* Note that this evaluates the active and selected slots so that + the hash changes when the result of these changes. */ + return HASH2 (HASH5 (internal_hash (p->name, depth + 1), + internal_hash (p->callback, depth + 1), + internal_hash (p->suffix, depth + 1), + gui_item_active_p (obj), + internal_hash (p->included, depth + 1)), + HASH5 (internal_hash (p->config, depth + 1), + internal_hash (p->filter, depth + 1), + internal_hash (p->style, depth + 1), + gui_item_selected_p (obj), + internal_hash (p->keys, depth + 1))); +} + int gui_item_id_hash (Lisp_Object hashtable, Lisp_Object gitem, int slot) { - int hashid = gui_item_hash (gitem, 0); + int hashid = gui_item_hash_internal (gitem, 0); int id = GUI_ITEM_ID_BITS (hashid, slot); while (!NILP (Fgethash (make_int (id), hashtable, Qnil))) @@ -570,12 +595,17 @@ print_gui_item (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) The gui_item slot of an image instance can be a single item or an arbitrarily nested hierarchy of item lists. */ -static Lisp_Object parse_gui_item_tree_item (Lisp_Object entry) +static Lisp_Object +parse_gui_item_tree_item (Lisp_Object entry) { Lisp_Object ret = entry; + struct gcpro gcpro1; + + GCPRO1 (ret); + if (VECTORP (entry)) { - ret = gui_parse_item_keywords_no_errors (entry); + ret = gui_parse_item_keywords_no_errors (entry); } else if (STRINGP (entry)) { @@ -584,17 +614,20 @@ static Lisp_Object parse_gui_item_tree_item (Lisp_Object entry) else signal_simple_error ("item must be a vector or a string", entry); - return ret; + RETURN_UNGCPRO (ret); } -Lisp_Object parse_gui_item_tree_children (Lisp_Object list) +Lisp_Object +parse_gui_item_tree_children (Lisp_Object list) { - Lisp_Object rest, ret = Qnil; + Lisp_Object rest, ret = Qnil, sub = Qnil; + struct gcpro gcpro1, gcpro2; + + GCPRO2 (ret, sub); CHECK_CONS (list); /* recursively add items to the tree view */ LIST_LOOP (rest, list) { - Lisp_Object sub; if (CONSP (XCAR (rest))) sub = parse_gui_item_tree_list (XCAR (rest)); else @@ -603,21 +636,30 @@ Lisp_Object parse_gui_item_tree_children (Lisp_Object list) ret = Fcons (sub, ret); } /* make the order the same as the items we have parsed */ - return Fnreverse (ret); + RETURN_UNGCPRO (Fnreverse (ret)); } -static Lisp_Object parse_gui_item_tree_list (Lisp_Object list) +static Lisp_Object +parse_gui_item_tree_list (Lisp_Object list) { Lisp_Object ret; + struct gcpro gcpro1; CHECK_CONS (list); /* first one can never be a list */ ret = parse_gui_item_tree_item (XCAR (list)); - return Fcons (ret, parse_gui_item_tree_children (XCDR (list))); + GCPRO1 (ret); + ret = Fcons (ret, parse_gui_item_tree_children (XCDR (list))); + RETURN_UNGCPRO (ret); +} + +static void +finalize_gui_item (void* header, int for_disksave) +{ } DEFINE_LRECORD_IMPLEMENTATION ("gui-item", gui_item, mark_gui_item, print_gui_item, - 0, gui_item_equal, + finalize_gui_item, gui_item_equal, gui_item_hash, 0, Lisp_Gui_Item); diff --git a/src/inline.c b/src/inline.c index 8b4fc25..dd05e78 100644 --- a/src/inline.c +++ b/src/inline.c @@ -22,23 +22,23 @@ Boston, MA 02111-1307, USA. */ /* The purpose of this file is so that there is at least one actual definition of each inline function. This is needed under GCC. The - reason is that under GCC we declare our inline functions `extern - inline', which causes the inlined version to get used only for + reason is that under GCC we declare our inline functions `inline + extern', which causes the inlined version to get used only for inlining, and in other cases to generate an external reference to the function. This is more efficient than declaring our inline - functions `static inline', which (in many cases) would cause a separate + functions `inline static', which (in many cases) would cause a separate version of the function to get inserted into every source file that - included the corresponding header file. + included the corresponding header file. See internals.texi. Some compilers that recognize `inline' may not do the same - `extern inline' business, so on those we just do `static inline'. + `inline extern' business, so on those we just do `inline static'. */ /* Note to maintainers: This file contains a list of all header files that use the INLINE macro, either directly, or by using DECLARE_LRECORD. - i.e. the output of ``grep -l -w 'DECLARE_LRECORD|INLINE' *.h'' */ + i.e. the output of ``grep -l -w 'DECLARE_LRECORD|INLINE_HEADER' *.h'' */ -#define DONT_EXTERN_INLINE_FUNCTIONS +#define DONT_EXTERN_INLINE_HEADER_FUNCTIONS #include #include "lisp.h" @@ -53,6 +53,7 @@ Boston, MA 02111-1307, USA. */ #include "faces.h" #include "frame.h" #include "glyphs.h" +#include "gui.h" #include "keymap.h" #include "lstream.h" #include "objects.h" @@ -67,6 +68,11 @@ Boston, MA 02111-1307, USA. */ #include "eldap.h" #endif +#ifdef HAVE_POSTGRESQL +#include +#include "postgresql.h" +#endif + #ifdef HAVE_TOOLBARS #include "toolbar.h" #endif diff --git a/src/keymap.c b/src/keymap.c index 046c5e8..6d5f603 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -37,17 +37,6 @@ Boston, MA 02111-1307, USA. */ #include "insdel.h" #include "keymap.h" #include "window.h" - -#ifdef WINDOWSNT -/* Hmm, under unix we want X modifiers, under NT we want X modifiers if - we are running X and Windows modifiers otherwise. - gak. This is a kludge until we support multiple native GUIs! -*/ -#undef MOD_ALT -#undef MOD_CONTROL -#undef MOD_SHIFT -#endif - #include "events-mod.h" @@ -99,25 +88,25 @@ Boston, MA 02111-1307, USA. */ If the key `C-a' was bound to some command, the hierarchy would look like - keymap-1: associates the integer MOD_CONTROL with keymap-2 + keymap-1: associates the integer XEMACS_MOD_CONTROL with keymap-2 keymap-2: associates "a" with the command Similarly, if the key `C-H-a' was bound to some command, the hierarchy would look like - keymap-1: associates the integer (MOD_CONTROL | MOD_HYPER) + keymap-1: associates the integer (XEMACS_MOD_CONTROL | XEMACS_MOD_HYPER) with keymap-2 keymap-2: associates "a" with the command Note that a special exception is made for the meta modifier, in order to deal with ESC/meta lossage. Any key combination containing the meta modifier is first indexed off of the main map into the meta - submap (with hash key MOD_META) and then indexed off of the + submap (with hash key XEMACS_MOD_META) and then indexed off of the meta submap with the meta modifier removed from the key combination. For example, when associating a command with C-M-H-a, we'd have - keymap-1: associates the integer MOD_META with keymap-2 - keymap-2: associates the integer (MOD_CONTROL | MOD_HYPER) + keymap-1: associates the integer XEMACS_MOD_META with keymap-2 + keymap-2: associates the integer (XEMACS_MOD_CONTROL | XEMACS_MOD_HYPER) with keymap-3 keymap-3: associates "a" with the command @@ -131,7 +120,7 @@ Boston, MA 02111-1307, USA. */ Note that this new model of keymaps takes much of the magic away from the Escape key: the value of the variable `esc-map' is no longer indexed in the `global-map' under the ESC key. It's indexed under the integer - MOD_META. This is not user-visible, however; none of the "bucky" + XEMACS_MOD_META. This is not user-visible, however; none of the "bucky" maps are. There is a hack in Flookup_key() that makes (lookup-key global-map "\^[") @@ -406,32 +395,32 @@ traverse_keymaps (Lisp_Object start_keymap, Lisp_Object start_parents, /* Some low-level functions */ /************************************************************************/ -static unsigned int +static int bucky_sym_to_bucky_bit (Lisp_Object sym) { - if (EQ (sym, Qcontrol)) return MOD_CONTROL; - if (EQ (sym, Qmeta)) return MOD_META; - if (EQ (sym, Qsuper)) return MOD_SUPER; - if (EQ (sym, Qhyper)) return MOD_HYPER; - if (EQ (sym, Qalt)) return MOD_ALT; - if (EQ (sym, Qsymbol)) return MOD_ALT; /* #### - reverse compat */ - if (EQ (sym, Qshift)) return MOD_SHIFT; + if (EQ (sym, Qcontrol)) return XEMACS_MOD_CONTROL; + if (EQ (sym, Qmeta)) return XEMACS_MOD_META; + if (EQ (sym, Qsuper)) return XEMACS_MOD_SUPER; + if (EQ (sym, Qhyper)) return XEMACS_MOD_HYPER; + if (EQ (sym, Qalt)) return XEMACS_MOD_ALT; + if (EQ (sym, Qsymbol)) return XEMACS_MOD_ALT; /* #### - reverse compat */ + if (EQ (sym, Qshift)) return XEMACS_MOD_SHIFT; return 0; } static Lisp_Object -control_meta_superify (Lisp_Object frob, unsigned int modifiers) +control_meta_superify (Lisp_Object frob, int modifiers) { if (modifiers == 0) return frob; frob = Fcons (frob, Qnil); - if (modifiers & MOD_SHIFT) frob = Fcons (Qshift, frob); - if (modifiers & MOD_ALT) frob = Fcons (Qalt, frob); - if (modifiers & MOD_HYPER) frob = Fcons (Qhyper, frob); - if (modifiers & MOD_SUPER) frob = Fcons (Qsuper, frob); - if (modifiers & MOD_CONTROL) frob = Fcons (Qcontrol, frob); - if (modifiers & MOD_META) frob = Fcons (Qmeta, frob); + if (modifiers & XEMACS_MOD_SHIFT) frob = Fcons (Qshift, frob); + if (modifiers & XEMACS_MOD_ALT) frob = Fcons (Qalt, frob); + if (modifiers & XEMACS_MOD_HYPER) frob = Fcons (Qhyper, frob); + if (modifiers & XEMACS_MOD_SUPER) frob = Fcons (Qsuper, frob); + if (modifiers & XEMACS_MOD_CONTROL) frob = Fcons (Qcontrol, frob); + if (modifiers & XEMACS_MOD_META) frob = Fcons (Qmeta, frob); return frob; } @@ -439,7 +428,7 @@ static Lisp_Object make_key_description (const struct key_data *key, int prettify) { Lisp_Object keysym = key->keysym; - unsigned int modifiers = key->modifiers; + int modifiers = key->modifiers; if (prettify && CHARP (keysym)) { @@ -470,12 +459,12 @@ raw_lookup_key (Lisp_Object keymap, /* Relies on caller to gc-protect args */ static Lisp_Object keymap_lookup_directly (Lisp_Object keymap, - Lisp_Object keysym, unsigned int modifiers) + Lisp_Object keysym, int modifiers) { Lisp_Keymap *k; - if ((modifiers & ~(MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER - | MOD_ALT | MOD_SHIFT)) != 0) + if ((modifiers & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER | XEMACS_MOD_HYPER + | XEMACS_MOD_ALT | XEMACS_MOD_SHIFT)) != 0) abort (); k = XKEYMAP (keymap); @@ -488,14 +477,14 @@ keymap_lookup_directly (Lisp_Object keymap, keysym = i_fart_on_gcc; } - if (modifiers & MOD_META) /* Utterly hateful ESC lossage */ + if (modifiers & XEMACS_MOD_META) /* Utterly hateful ESC lossage */ { - Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META), + Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META), k->table, Qnil); if (NILP (submap)) return Qnil; k = XKEYMAP (submap); - modifiers &= ~MOD_META; + modifiers &= ~XEMACS_MOD_META; } if (modifiers != 0) @@ -629,7 +618,7 @@ keymap_store_internal (Lisp_Object keysym, Lisp_Keymap *keymap, static Lisp_Object -create_bucky_submap (Lisp_Keymap *k, unsigned int modifiers, +create_bucky_submap (Lisp_Keymap *k, int modifiers, Lisp_Object parent_for_debugging_info) { Lisp_Object submap = Fmake_sparse_keymap (Qnil); @@ -649,24 +638,25 @@ keymap_store (Lisp_Object keymap, const struct key_data *key, Lisp_Object value) { Lisp_Object keysym = key->keysym; - unsigned int modifiers = key->modifiers; + int modifiers = key->modifiers; Lisp_Keymap *k = XKEYMAP (keymap); - assert ((modifiers & ~(MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER - | MOD_ALT | MOD_SHIFT)) == 0); + assert ((modifiers & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META + | XEMACS_MOD_SUPER | XEMACS_MOD_HYPER + | XEMACS_MOD_ALT | XEMACS_MOD_SHIFT)) == 0); /* If the keysym is a one-character symbol, use the char code instead. */ if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1) keysym = make_char (string_char (XSYMBOL (keysym)->name, 0)); - if (modifiers & MOD_META) /* Utterly hateful ESC lossage */ + if (modifiers & XEMACS_MOD_META) /* Utterly hateful ESC lossage */ { - Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META), + Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META), k->table, Qnil); if (NILP (submap)) - submap = create_bucky_submap (k, MOD_META, keymap); + submap = create_bucky_submap (k, XEMACS_MOD_META, keymap); k = XKEYMAP (submap); - modifiers &= ~MOD_META; + modifiers &= ~XEMACS_MOD_META; } if (modifiers != 0) @@ -1258,7 +1248,7 @@ Return the number of bindings in the keymap. static void define_key_check_and_coerce_keysym (Lisp_Object spec, Lisp_Object *keysym, - unsigned int modifiers) + int modifiers) { /* Now, check and massage the trailing keysym specifier. */ if (SYMBOLP (*keysym)) @@ -1281,7 +1271,7 @@ define_key_check_and_coerce_keysym (Lisp_Object spec, problems ... */ signal_simple_error ("keysym char must be printable", *keysym); /* #### This bites! I want to be able to write (control shift a) */ - if (modifiers & MOD_SHIFT) + if (modifiers & XEMACS_MOD_SHIFT) signal_simple_error ("The `shift' modifier may not be applied to ASCII keysyms", spec); @@ -1458,14 +1448,14 @@ define_key_parser (Lisp_Object spec, struct key_data *returned_value) } else if (CONSP (spec)) { - unsigned int modifiers = 0; + int modifiers = 0; Lisp_Object keysym = Qnil; Lisp_Object rest = spec; /* First, parse out the leading modifier symbols. */ while (CONSP (rest)) { - unsigned int modifier; + int modifier; keysym = XCAR (rest); modifier = bucky_sym_to_bucky_bit (keysym); @@ -1635,12 +1625,12 @@ define_key_alternate_name (struct key_data *key, struct key_data *returned_value) { Lisp_Object keysym = key->keysym; - unsigned int modifiers = key->modifiers; - unsigned int modifiers_sans_control = (modifiers & (~MOD_CONTROL)); - unsigned int modifiers_sans_meta = (modifiers & (~MOD_META)); + int modifiers = key->modifiers; + int modifiers_sans_control = (modifiers & (~XEMACS_MOD_CONTROL)); + int modifiers_sans_meta = (modifiers & (~XEMACS_MOD_META)); returned_value->keysym = Qnil; /* By default, no "alternate" key */ returned_value->modifiers = 0; - if (modifiers_sans_meta == MOD_CONTROL) + if (modifiers_sans_meta == XEMACS_MOD_CONTROL) { if EQ (keysym, QKspace) MACROLET (make_char ('@'), modifiers); @@ -1667,15 +1657,15 @@ define_key_alternate_name (struct key_data *key, else if (modifiers_sans_meta != 0) return; else if (EQ (keysym, QKbackspace)) /* backspace => c-h */ - MACROLET (make_char ('h'), (modifiers | MOD_CONTROL)); + MACROLET (make_char ('h'), (modifiers | XEMACS_MOD_CONTROL)); else if (EQ (keysym, QKtab)) /* tab => c-i */ - MACROLET (make_char ('i'), (modifiers | MOD_CONTROL)); + MACROLET (make_char ('i'), (modifiers | XEMACS_MOD_CONTROL)); else if (EQ (keysym, QKlinefeed)) /* linefeed => c-j */ - MACROLET (make_char ('j'), (modifiers | MOD_CONTROL)); + MACROLET (make_char ('j'), (modifiers | XEMACS_MOD_CONTROL)); else if (EQ (keysym, QKreturn)) /* return => c-m */ - MACROLET (make_char ('m'), (modifiers | MOD_CONTROL)); + MACROLET (make_char ('m'), (modifiers | XEMACS_MOD_CONTROL)); else if (EQ (keysym, QKescape)) /* escape => c-[ */ - MACROLET (make_char ('['), (modifiers | MOD_CONTROL)); + MACROLET (make_char ('['), (modifiers | XEMACS_MOD_CONTROL)); else return; #undef MACROLET @@ -1908,7 +1898,7 @@ these features. struct gcpro ngcpro1; NGCPRO1 (c); - meta_map = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META), + meta_map = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META), XKEYMAP (keymap)->table, Qnil); if (!NILP (meta_map) && keymap_fullness (meta_map) != 0) @@ -1935,14 +1925,14 @@ these features. if (metized) { - raw_key1.modifiers |= MOD_META; - raw_key2.modifiers |= MOD_META; + raw_key1.modifiers |= XEMACS_MOD_META; + raw_key2.modifiers |= XEMACS_MOD_META; metized = 0; } /* This crap is to make sure that someone doesn't bind something like "C-x M-a" while "C-x ESC" has a non-keymap binding. */ - if (raw_key1.modifiers & MOD_META) + if (raw_key1.modifiers & XEMACS_MOD_META) ensure_meta_prefix_char_keymapp (keys, idx, keymap); if (++idx == len) @@ -2065,7 +2055,7 @@ raw_lookup_key_mapper (Lisp_Object k, void *arg) if (NILP (cmd)) { /* Do kludgy return of the meta-map */ - cmd = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META), + cmd = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META), XKEYMAP (k)->table, Qnil); } } @@ -2077,11 +2067,11 @@ raw_lookup_key_mapper (Lisp_Object k, void *arg) if (!NILP (cmd)) cmd = raw_lookup_key (cmd, raw_keys + 1, remaining, keys_so_far + 1, accept_default); - else if ((raw_keys[1].modifiers & MOD_META) == 0) + else if ((raw_keys[1].modifiers & XEMACS_MOD_META) == 0) { struct key_data metified; metified.keysym = raw_keys[1].keysym; - metified.modifiers = raw_keys[1].modifiers | MOD_META; + metified.modifiers = raw_keys[1].modifiers | XEMACS_MOD_META; /* Search for meta-next-char sequence directly */ cmd = keymap_lookup_1 (k, &metified, accept_default); @@ -2743,7 +2733,7 @@ struct map_keymap_unsorted_closure { void (*fn) (const struct key_data *, Lisp_Object binding, void *arg); void *arg; - unsigned int modifiers; + int modifiers; }; /* used by map_keymap() */ @@ -2754,8 +2744,8 @@ map_keymap_unsorted_mapper (Lisp_Object keysym, Lisp_Object value, /* This function can GC */ struct map_keymap_unsorted_closure *closure = (struct map_keymap_unsorted_closure *) map_keymap_unsorted_closure; - unsigned int modifiers = closure->modifiers; - unsigned int mod_bit; + int modifiers = closure->modifiers; + int mod_bit; mod_bit = MODIFIER_HASH_KEY_BITS (keysym); if (mod_bit != 0) { @@ -2805,7 +2795,7 @@ map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, { /* obj1 and obj2 are conses with keysyms in their cars. Cdrs are ignored. */ - unsigned int bit1, bit2; + int bit1, bit2; int sym1_p = 0; int sym2_p = 0; obj1 = XCAR (obj1); @@ -2879,7 +2869,7 @@ map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, /* used by map_keymap() */ static void map_keymap_sorted (Lisp_Object keymap_table, - unsigned int modifiers, + int modifiers, void (*function) (const struct key_data *key, Lisp_Object binding, void *map_keymap_sorted_closure), @@ -2904,7 +2894,7 @@ map_keymap_sorted (Lisp_Object keymap_table, { Lisp_Object keysym = XCAR (XCAR (contents)); Lisp_Object binding = XCDR (XCAR (contents)); - unsigned int sub_bits = MODIFIER_HASH_KEY_BITS (keysym); + int sub_bits = MODIFIER_HASH_KEY_BITS (keysym); if (sub_bits != 0) map_keymap_sorted (XKEYMAP (get_keymap (binding, 1, 1))->table, @@ -3010,11 +3000,11 @@ struct accessible_keymaps_closure static void accessible_keymaps_mapper_1 (Lisp_Object keysym, Lisp_Object contents, - unsigned int modifiers, + int modifiers, struct accessible_keymaps_closure *closure) { /* This function can GC */ - unsigned int subbits = MODIFIER_HASH_KEY_BITS (keysym); + int subbits = MODIFIER_HASH_KEY_BITS (keysym); if (subbits != 0) { @@ -3492,7 +3482,7 @@ format_raw_keys (struct key_data *keys, int count, char *buf) keys_so_far and modifiers_so_far describe which map we're looking in; If we're in the "meta" submap of the map that "C-x 4" is bound to, then keys_so_far will be {(control x), \4}, and modifiers_so_far - will be MOD_META. That is, keys_so_far is the chain of keys that we + will be XEMACS_MOD_META. That is, keys_so_far is the chain of keys that we have followed, and modifiers_so_far_so_far is the bits (partial keys) beyond that. @@ -3510,7 +3500,7 @@ struct where_is_closure int shadow_count; int firstonly; int keys_count; - unsigned int modifiers_so_far; + int modifiers_so_far; char *target_buffer; struct key_data *keys_so_far; int keys_so_far_total_size; @@ -3526,8 +3516,8 @@ where_is_recursive_mapper (Lisp_Object map, void *arg) struct where_is_closure *c = (struct where_is_closure *) arg; Lisp_Object definition = c->definition; const int firstonly = c->firstonly; - const unsigned int keys_count = c->keys_count; - const unsigned int modifiers_so_far = c->modifiers_so_far; + const int keys_count = c->keys_count; + const int modifiers_so_far = c->modifiers_so_far; char *target_buffer = c->target_buffer; Lisp_Object keys = Fgethash (definition, XKEYMAP (map)->inverse_table, @@ -3600,9 +3590,9 @@ where_is_recursive_mapper (Lisp_Object map, void *arg) { Lisp_Object key = XCAR (XCAR (submaps)); Lisp_Object submap = XCDR (XCAR (submaps)); - unsigned int lower_modifiers; + int lower_modifiers; int lower_keys_count = keys_count; - unsigned int bucky; + int bucky; submap = get_keymap (submap, 0, 0); @@ -3933,7 +3923,7 @@ describe_map_mapper (const struct key_data *key, struct describe_map_closure *closure = (struct describe_map_closure *) describe_map_closure; Lisp_Object keysym = key->keysym; - unsigned int modifiers = key->modifiers; + int modifiers = key->modifiers; /* Don't mention suppressed commands. */ if (SYMBOLP (binding) @@ -4007,7 +3997,7 @@ describe_map_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, ( ( . ) . ) keysym and modifiers are used, binding is ignored. */ - unsigned int bit1, bit2; + int bit1, bit2; obj1 = XCAR (obj1); obj2 = XCAR (obj2); bit1 = XINT (XCDR (obj1)); @@ -4127,17 +4117,17 @@ describe_map (Lisp_Object keymap, Lisp_Object elt_prefix, { Lisp_Object elt = XCAR (XCAR (list)); Lisp_Object keysym = XCAR (elt); - unsigned int modifiers = XINT (XCDR (elt)); + int modifiers = XINT (XCDR (elt)); if (!NILP (elt_prefix)) buffer_insert_lisp_string (buf, elt_prefix); - if (modifiers & MOD_META) buffer_insert_c_string (buf, "M-"); - if (modifiers & MOD_CONTROL) buffer_insert_c_string (buf, "C-"); - if (modifiers & MOD_SUPER) buffer_insert_c_string (buf, "S-"); - if (modifiers & MOD_HYPER) buffer_insert_c_string (buf, "H-"); - if (modifiers & MOD_ALT) buffer_insert_c_string (buf, "Alt-"); - if (modifiers & MOD_SHIFT) buffer_insert_c_string (buf, "Sh-"); + if (modifiers & XEMACS_MOD_META) buffer_insert_c_string (buf, "M-"); + if (modifiers & XEMACS_MOD_CONTROL) buffer_insert_c_string (buf, "C-"); + if (modifiers & XEMACS_MOD_SUPER) buffer_insert_c_string (buf, "S-"); + if (modifiers & XEMACS_MOD_HYPER) buffer_insert_c_string (buf, "H-"); + if (modifiers & XEMACS_MOD_ALT) buffer_insert_c_string (buf, "Alt-"); + if (modifiers & XEMACS_MOD_SHIFT) buffer_insert_c_string (buf, "Sh-"); if (SYMBOLP (keysym)) { Lisp_Object code = Fget (keysym, Vcharacter_set_property, Qnil); @@ -4357,7 +4347,7 @@ complex_vars_of_keymap (void) meta_disgustitute = Fmake_keymap (Qnil); Ffset (ESC_prefix, meta_disgustitute); /* no need to protect meta_disgustitute, though */ - keymap_store_internal (MAKE_MODIFIER_HASH_KEY (MOD_META), + keymap_store_internal (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META), XKEYMAP (Vcurrent_global_map), meta_disgustitute); XKEYMAP (Vcurrent_global_map)->sub_maps_cache = Qt; diff --git a/src/line-number.c b/src/line-number.c index b0ce90f..cce759f 100644 --- a/src/line-number.c +++ b/src/line-number.c @@ -293,7 +293,7 @@ buffer_line_number (struct buffer *b, Bufpos pos, int cachep) get_nearest_line_number (b, &beg, pos, &cached_lines); } - scan_buffer (b, '\n', beg, pos, pos > beg ? EMACS_INT_MAX : -EMACS_INT_MAX, + scan_buffer (b, '\n', beg, pos, pos > beg ? EMACS_INT_MAX : EMACS_INT_MIN, &shortage, 0); line = EMACS_INT_MAX - shortage; diff --git a/src/lisp-union.h b/src/lisp-union.h index 648f824..4a49f8f 100644 --- a/src/lisp-union.h +++ b/src/lisp-union.h @@ -100,8 +100,8 @@ Lisp_Object; } while (0) # define XPNTRVAL(x) ((x).ui) -INLINE Lisp_Object make_int (EMACS_INT val); -INLINE Lisp_Object +INLINE_HEADER Lisp_Object make_int (EMACS_INT val); +INLINE_HEADER Lisp_Object make_int (EMACS_INT val) { Lisp_Object obj; @@ -109,8 +109,8 @@ make_int (EMACS_INT val) return obj; } -INLINE Lisp_Object make_char (Emchar val); -INLINE Lisp_Object +INLINE_HEADER Lisp_Object make_char (Emchar val); +INLINE_HEADER Lisp_Object make_char (Emchar val) { Lisp_Object obj; diff --git a/src/malloc.c b/src/malloc.c index 599110a..0fc31a0 100644 --- a/src/malloc.c +++ b/src/malloc.c @@ -738,7 +738,7 @@ malloc_stats (size) return v; } int -malloc_mem_used () +malloc_mem_used (void) { int i; int size_used; @@ -757,7 +757,7 @@ malloc_mem_used () } int -malloc_mem_free () +malloc_mem_free (void) { int i; int size_unused; @@ -787,7 +787,7 @@ malloc_mem_free () #ifdef USG static void -get_lim_data () +get_lim_data (void) { #ifdef ULIMIT_BREAK_VALUE lim_data = ULIMIT_BREAK_VALUE; @@ -802,7 +802,7 @@ get_lim_data () #ifndef BSD4_2 static void -get_lim_data () +get_lim_data (void) { lim_data = vlimit (LIM_DATA, -1); } @@ -810,7 +810,7 @@ get_lim_data () #else /* BSD4_2 */ static void -get_lim_data () +get_lim_data (void) { struct rlimit XXrlimit; diff --git a/src/mem-limits.h b/src/mem-limits.h index 427a61c..a7625d0 100644 --- a/src/mem-limits.h +++ b/src/mem-limits.h @@ -123,7 +123,7 @@ static POINTER data_space_start; /* Number of bytes of writable memory we can expect to be able to get */ extern unsigned int lim_data; -#ifdef HEAP_IN_DATA +#if defined (HEAP_IN_DATA) && !defined(PDUMP) extern unsigned long static_heap_size; extern int initialized; static void diff --git a/src/menubar-msw.c b/src/menubar-msw.c index a388c30..7d5b4de 100644 --- a/src/menubar-msw.c +++ b/src/menubar-msw.c @@ -1,7 +1,8 @@ /* Implements an elisp-programmable menubar -- Win32 Copyright (C) 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Tinker Systems and INS Engineering Corp. - Copyright (C) 1997 Kirill M. Katsnelson + Copyright (C) 1997 Kirill M. Katsnelson . + Copyright (C) 2000 Ben Wing. This file is part of XEmacs. @@ -70,7 +71,7 @@ Boston, MA 02111-1307, USA. */ * particular knowledge is bad because this may break in Windows NT * 5.0, or Windows 98, or other future version. Instead, I allow the * hash tables to hang around, and not clear them, unless WM_COMMAND is - * received. This is worthy some memory but more safe. Hacks welcome, + * received. This is worth some memory but more safe. Hacks welcome, * anyways! * */ @@ -93,7 +94,7 @@ Boston, MA 02111-1307, USA. */ #include "window.h" /* #### */ -#define REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIHGT_FLUSH 0 +#define REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH 0 #define EMPTY_ITEM_ID ((UINT)LISP_TO_VOID (Qunbound)) #define EMPTY_ITEM_NAME "(empty)" @@ -116,52 +117,107 @@ static Lisp_Object current_hash_table; #define MENU_ITEM_ID_BITS(x) (((x) & 0x7FFF) | 0x8000) static HMENU top_level_menu; -/* - * This returns Windows-style menu item string: - * "Left Flush\tRight Flush" - */ -static char* -displayable_menu_item (Lisp_Object gui_item, int bar_p) +/* Translate (in place) %_ to &, %% to %. + Return new length, and (through accel) the accelerator character. + (If there is no accelerator, it will be added on the first character.) + len = number of bytes (not including zero terminator). + maxlen = size of buffer. + We assume and maintain zero-termination. To be absolutely sure + of not hitting an error, maxlen should be >= 2*len + 3. */ + +Bytecount +msw_translate_menu_or_dialog_item (Bufbyte *item, Bytecount len, + Bytecount maxlen, Emchar *accel, + Lisp_Object error_name) { - /* We construct the name in a static buffer. That's fine, because - menu items longer than 128 chars are probably programming errors, - and better be caught than displayed! */ - - static char buf[MAX_MENUITEM_LENGTH+2]; - char *ptr; - unsigned int ll, lr; + Bufbyte *ptr; - /* Left flush part of the string */ - ll = gui_item_display_flush_left (gui_item, buf, MAX_MENUITEM_LENGTH); + *accel = '\0'; /* Escape '&' as '&&' */ - ptr = buf; - while ((ptr = (char*) memchr (ptr, '&', ll - (ptr - buf))) != NULL) + + ptr = item; + while ((ptr = (Bufbyte *) memchr (ptr, '&', len - (ptr - item))) != NULL) { - if (ll + 2 >= MAX_MENUITEM_LENGTH) + if (len + 2 > maxlen) signal_simple_error ("Menu item produces too long displayable string", - XGUI_ITEM (gui_item)->name); - memmove (ptr + 1, ptr, (ll - (ptr - buf)) + 1); - ll++; + error_name); + memmove (ptr + 1, ptr, (len - (ptr - item)) + 1); + len++; ptr += 2; } - /* Replace XEmacs accelerator '%_' with Windows accelerator '&' */ - ptr = buf; - while ((ptr = (char*) memchr (ptr, '%', ll - (ptr - buf))) != NULL) + /* Replace XEmacs accelerator '%_' with Windows accelerator '&' + and `%%' with `%'. */ + ptr = item; + while ((ptr = memchr (ptr, '%', len - (ptr - item))) != NULL) { if (*(ptr + 1) == '_') { *ptr = '&'; - memmove (ptr + 1, ptr + 2, ll - (ptr - buf + 2)); - ll--; + if (!*accel) + /* #### urk ! We need a reference translation table for + case changes that aren't buffer-specific. */ + *accel = DOWNCASE (current_buffer, charptr_emchar (ptr + 2)); + memmove (ptr + 1, ptr + 2, len - (ptr - item + 2) + 1); + len--; + } + else if (*(ptr + 1) == '%') + { + memmove (ptr + 1, ptr + 2, len - (ptr - item + 2) + 1); + len--; } ptr++; } + if (!*accel) + { + if (len + 2 > maxlen) + signal_simple_error ("Menu item produces too long displayable string", + error_name); + ptr = item; + memmove (ptr + 1, ptr, len + 1); + /* #### urk ! We need a reference translation table for + case changes that aren't buffer-specific. */ + *accel = DOWNCASE (current_buffer, charptr_emchar (ptr + 1)); + *ptr = '&'; + + len++; + } + + return len; +} + +/* + * This returns Windows-style menu item string: + * "Left Flush\tRight Flush" + */ + +/* #### This is junk. Need correct handling of sizes. Use a Bufbyte_dynarr, + not a static buffer. */ +static char* +displayable_menu_item (Lisp_Object gui_item, int bar_p, Emchar *accel) +{ + unsigned int ll; + + /* We construct the name in a static buffer. That's fine, because + menu items longer than 128 chars are probably programming errors, + and better be caught than displayed! */ + + static char buf[MAX_MENUITEM_LENGTH+2]; + + /* Left flush part of the string */ + ll = gui_item_display_flush_left (gui_item, buf, MAX_MENUITEM_LENGTH); + + ll = msw_translate_menu_or_dialog_item ((Bufbyte *) buf, ll, + MAX_MENUITEM_LENGTH, accel, + XGUI_ITEM (gui_item)->name); + /* Right flush part, unless we're at the top-level where it's not allowed */ if (!bar_p) { + unsigned int lr; + assert (MAX_MENUITEM_LENGTH > ll + 1); lr = gui_item_display_flush_right (gui_item, buf + ll + 1, MAX_MENUITEM_LENGTH - ll - 1); @@ -251,6 +307,7 @@ checksum_menu_item (Lisp_Object item) static void populate_menu_add_item (HMENU menu, Lisp_Object path, Lisp_Object hash_tab, Lisp_Object item, + Lisp_Object *accel_list, int flush_right, int bar_p) { MENUITEMINFO item_info; @@ -278,63 +335,75 @@ populate_menu_add_item (HMENU menu, Lisp_Object path, /* Submenu */ HMENU submenu; Lisp_Object gui_item = allocate_gui_item (); - Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); - struct gcpro gcpro1; + Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); + struct gcpro gcpro1, gcpro2, gcpro3; + Emchar accel; - GCPRO1 (gui_item); + GCPRO3 (gui_item, path, *accel_list); menu_parse_submenu_keywords (item, gui_item); if (!STRINGP (pgui_item->name)) - signal_simple_error ("Menu name (first element) must be a string", item); + signal_simple_error ("Menu name (first element) must be a string", + item); if (!gui_item_included_p (gui_item, Vmenubar_configuration)) - return; + { + UNGCPRO; + goto done; + } if (!gui_item_active_p (gui_item)) item_info.fState = MFS_GRAYED; /* Temptation is to put 'else' right here. Although, the displayed item won't have an arrow indicating that it is a popup. So we go ahead a little bit more and create a popup */ - submenu = create_empty_popup_menu(); + submenu = create_empty_popup_menu (); item_info.fMask |= MIIM_SUBMENU; - item_info.dwTypeData = displayable_menu_item (gui_item, bar_p); + item_info.dwTypeData = displayable_menu_item (gui_item, bar_p, &accel); item_info.hSubMenu = submenu; + if (accel && bar_p) + *accel_list = Fcons (make_char (accel), *accel_list); + if (!(item_info.fState & MFS_GRAYED)) { /* Now add the full submenu path as a value to the hash table, keyed by menu handle */ if (NILP(path)) - /* list1 cannot GC */ path = list1 (pgui_item->name); else { Lisp_Object arg[2]; arg[0] = path; arg[1] = list1 (pgui_item->name); - /* Fappend gcpro'es its arg */ path = Fappend (2, arg); } - /* Fputhash GCPRO'es PATH */ Fputhash (hmenu_to_lisp_object (submenu), path, hash_tab); } - UNGCPRO; /* gui_item */ + UNGCPRO; } else if (VECTORP (item)) { /* An ordinary item */ Lisp_Object style, id; Lisp_Object gui_item = gui_parse_item_keywords (item); - Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); - struct gcpro gcpro1; + Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); + struct gcpro gcpro1, gcpro2; + Emchar accel; - GCPRO1 (gui_item); + GCPRO2 (gui_item, *accel_list); if (!gui_item_included_p (gui_item, Vmenubar_configuration)) - return; + { + UNGCPRO; + goto done; + } + + if (!STRINGP (pgui_item->name)) + pgui_item->name = Feval (pgui_item->name); if (!gui_item_active_p (gui_item)) item_info.fState = MFS_GRAYED; @@ -356,11 +425,14 @@ populate_menu_add_item (HMENU menu, Lisp_Object path, pgui_item->suffix); Fputhash (id, pgui_item->callback, hash_tab); - item_info.wID = (UINT) XINT(id); + item_info.wID = (UINT) XINT (id); item_info.fType |= MFT_STRING; - item_info.dwTypeData = displayable_menu_item (gui_item, bar_p); + item_info.dwTypeData = displayable_menu_item (gui_item, bar_p, &accel); - UNGCPRO; /* gui_item */ + if (accel && bar_p) + *accel_list = Fcons (make_char (accel), *accel_list); + + UNGCPRO; } else { @@ -371,6 +443,8 @@ populate_menu_add_item (HMENU menu, Lisp_Object path, item_info.fType |= MFT_RIGHTJUSTIFY; InsertMenuItem (menu, UINT_MAX, TRUE, &item_info); + +done:; } /* @@ -390,16 +464,18 @@ populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object desc, { Lisp_Object item_desc; int deep_p, flush_right; - struct gcpro gcpro1; + struct gcpro gcpro1, gcpro2, gcpro3; unsigned long checksum; Lisp_Object gui_item = allocate_gui_item (); - Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); - GCPRO1 (gui_item); + Lisp_Object accel_list = Qnil; + Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); + + GCPRO3 (gui_item, accel_list, desc); /* We are sometimes called with the menubar unchanged, and with changed right flush. We have to update the menubar in this case, so account for the compliance setting in the hash value */ - checksum = REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIHGT_FLUSH; + checksum = REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH; /* Will initially contain only "(empty)" */ if (populate_p) @@ -426,14 +502,15 @@ populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object desc, if (NILP (XCAR (item_desc))) { /* Do not flush right menubar items when MS style compliant */ - if (bar_p && !REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIHGT_FLUSH) + if (bar_p && !REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH) flush_right = 1; if (!populate_p) checksum = HASH2 (checksum, LISP_HASH (Qnil)); } else if (populate_p) populate_menu_add_item (menu, path, hash_tab, - XCAR (item_desc), flush_right, bar_p); + XCAR (item_desc), &accel_list, + flush_right, bar_p); else checksum = HASH2 (checksum, checksum_menu_item (XCAR (item_desc))); @@ -447,8 +524,8 @@ populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object desc, /* Add the header to the popup, if told so. The same as in X - an insensitive item, and a separator (Seems to me, there were - two separators in X... In Windows this looks ugly, anyways. */ - if (!bar_p && !deep_p && popup_menu_titles && !NILP(pgui_item->name)) + two separators in X... In Windows this looks ugly, anyways.) */ + if (!bar_p && !deep_p && popup_menu_titles && !NILP (pgui_item->name)) { CHECK_STRING (pgui_item->name); InsertMenu (menu, 0, MF_BYPOSITION | MF_STRING | MF_DISABLED, @@ -457,13 +534,17 @@ populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object desc, SetMenuDefaultItem (menu, 0, MF_BYPOSITION); } } - UNGCPRO; /* gui_item */ + + if (bar_p) + Fputhash (Qt, accel_list, hash_tab); + + UNGCPRO; return checksum; } static void populate_menu (HMENU menu, Lisp_Object path, Lisp_Object desc, - Lisp_Object hash_tab, int bar_p) + Lisp_Object hash_tab, int bar_p) { populate_or_checksum_helper (menu, path, desc, hash_tab, bar_p, 1); } @@ -475,23 +556,28 @@ checksum_menu (Lisp_Object desc) } static void -update_frame_menubar_maybe (struct frame* f) +update_frame_menubar_maybe (struct frame *f) { HMENU menubar = GetMenu (FRAME_MSWINDOWS_HANDLE (f)); struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)); Lisp_Object desc = (!NILP (w->menubar_visible_p) ? symbol_value_in_buffer (Qcurrent_menubar, w->buffer) : Qnil); + struct gcpro gcpro1; + + GCPRO1 (desc); /* it's safest to do this, just in case some filter + or something changes the value of current-menubar */ top_level_menu = menubar; if (NILP (desc) && menubar != NULL) { /* Menubar has gone */ - FRAME_MSWINDOWS_MENU_HASH_TABLE(f) = Qnil; + FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = Qnil; SetMenu (FRAME_MSWINDOWS_HANDLE (f), NULL); DestroyMenu (menubar); DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f)); + UNGCPRO; return; } @@ -505,29 +591,35 @@ update_frame_menubar_maybe (struct frame* f) if (NILP (desc)) { /* We did not have the bar and are not going to */ + UNGCPRO; return; } /* Now we bail out if the menubar has not changed */ - if (FRAME_MSWINDOWS_MENU_CHECKSUM(f) == checksum_menu (desc)) - return; + if (FRAME_MSWINDOWS_MENU_CHECKSUM (f) == checksum_menu (desc)) + { + UNGCPRO; + return; + } populate: /* Come with empty hash table */ - if (NILP (FRAME_MSWINDOWS_MENU_HASH_TABLE(f))) - FRAME_MSWINDOWS_MENU_HASH_TABLE(f) = + if (NILP (FRAME_MSWINDOWS_MENU_HASH_TABLE (f))) + FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); else - Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE(f)); + Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); Fputhash (hmenu_to_lisp_object (menubar), Qnil, - FRAME_MSWINDOWS_MENU_HASH_TABLE(f)); + FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); populate_menu (menubar, Qnil, desc, - FRAME_MSWINDOWS_MENU_HASH_TABLE(f), 1); + FRAME_MSWINDOWS_MENU_HASH_TABLE (f), 1); SetMenu (FRAME_MSWINDOWS_HANDLE (f), menubar); DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f)); - FRAME_MSWINDOWS_MENU_CHECKSUM(f) = checksum_menu (desc); + FRAME_MSWINDOWS_MENU_CHECKSUM (f) = checksum_menu (desc); + + UNGCPRO; } static void @@ -535,6 +627,8 @@ prune_menubar (struct frame *f) { HMENU menubar = GetMenu (FRAME_MSWINDOWS_HANDLE (f)); Lisp_Object desc = current_frame_menubar (f); + struct gcpro gcpro1; + if (menubar == NULL) return; @@ -542,20 +636,22 @@ prune_menubar (struct frame *f) triggers. To resolve, we must prevent filters explicitly from mangling with the active menu. In apply_filter probably? Is copy-tree on the whole menu too expensive? */ - if (NILP(desc)) + if (NILP (desc)) /* abort(); */ return; + GCPRO1 (desc); /* just to be safe -- see above */ /* We do the trick by removing all items and re-populating top level */ empty_menu (menubar, 0); - assert (HASH_TABLEP (FRAME_MSWINDOWS_MENU_HASH_TABLE(f))); - Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE(f)); + assert (HASH_TABLEP (FRAME_MSWINDOWS_MENU_HASH_TABLE (f))); + Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); Fputhash (hmenu_to_lisp_object (menubar), Qnil, - FRAME_MSWINDOWS_MENU_HASH_TABLE(f)); + FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); populate_menu (menubar, Qnil, desc, - FRAME_MSWINDOWS_MENU_HASH_TABLE(f), 1); + FRAME_MSWINDOWS_MENU_HASH_TABLE (f), 1); + UNGCPRO; } /* @@ -570,13 +666,24 @@ menu_cleanup (struct frame *f) current_hash_table = Qnil; prune_menubar (f); } + +int +msw_char_is_accelerator (struct frame *f, Emchar ch) +{ + Lisp_Object hash = FRAME_MSWINDOWS_MENU_HASH_TABLE (f); + + assert (HASH_TABLEP (hash)); + /* !!#### not Mule-ized */ + return !NILP (memq_no_quit (make_char (tolower (ch)), + Fgethash (Qt, hash, Qnil))); +} /*------------------------------------------------------------------------*/ /* Message handlers */ /*------------------------------------------------------------------------*/ static Lisp_Object -unsafe_handle_wm_initmenupopup_1 (HMENU menu, struct frame* f) +unsafe_handle_wm_initmenupopup_1 (HMENU menu, struct frame *f) { /* This function can call lisp, beat dogs and stick chewing gum to everything! */ @@ -608,7 +715,7 @@ unsafe_handle_wm_initmenupopup_1 (HMENU menu, struct frame* f) } static Lisp_Object -unsafe_handle_wm_initmenu_1 (struct frame* f) +unsafe_handle_wm_initmenu_1 (struct frame *f) { /* This function can call lisp */ @@ -625,7 +732,7 @@ unsafe_handle_wm_initmenu_1 (struct frame* f) update_frame_menubar_maybe (f); current_menudesc = current_frame_menubar (f); - current_hash_table = FRAME_MSWINDOWS_MENU_HASH_TABLE(f); + current_hash_table = FRAME_MSWINDOWS_MENU_HASH_TABLE (f); assert (HASH_TABLEP (current_hash_table)); return Qt; @@ -638,7 +745,7 @@ unsafe_handle_wm_initmenu_1 (struct frame* f) * command if we return nil */ Lisp_Object -mswindows_handle_wm_command (struct frame* f, WORD id) +mswindows_handle_wm_command (struct frame *f, WORD id) { /* Try to map the command id through the proper hash table */ Lisp_Object data, fn, arg, frame; @@ -680,7 +787,7 @@ mswindows_handle_wm_command (struct frame* f, WORD id) /*------------------------------------------------------------------------*/ static HMENU wm_initmenu_menu; -static struct frame* wm_initmenu_frame; +static struct frame *wm_initmenu_frame; static Lisp_Object unsafe_handle_wm_initmenupopup (Lisp_Object u_n_u_s_e_d) @@ -695,7 +802,7 @@ unsafe_handle_wm_initmenu (Lisp_Object u_n_u_s_e_d) } Lisp_Object -mswindows_handle_wm_initmenupopup (HMENU hmenu, struct frame* frm) +mswindows_handle_wm_initmenupopup (HMENU hmenu, struct frame *frm) { /* We cannot pass hmenu as a lisp object. Use static var */ wm_initmenu_menu = hmenu; @@ -704,10 +811,10 @@ mswindows_handle_wm_initmenupopup (HMENU hmenu, struct frame* frm) } Lisp_Object -mswindows_handle_wm_initmenu (HMENU hmenu, struct frame* f) +mswindows_handle_wm_initmenu (HMENU hmenu, struct frame *f) { /* Handle only frame menubar, ignore if from popup or system menu */ - if (GetMenu (FRAME_MSWINDOWS_HANDLE(f)) == hmenu) + if (GetMenu (FRAME_MSWINDOWS_HANDLE (f)) == hmenu) { wm_initmenu_frame = f; return mswindows_protect_modal_loop (unsafe_handle_wm_initmenu, Qnil); @@ -721,15 +828,15 @@ mswindows_handle_wm_initmenu (HMENU hmenu, struct frame* f) /*------------------------------------------------------------------------*/ static void -mswindows_update_frame_menubars (struct frame* f) +mswindows_update_frame_menubars (struct frame *f) { update_frame_menubar_maybe (f); } static void -mswindows_free_frame_menubars (struct frame* f) +mswindows_free_frame_menubars (struct frame *f) { - FRAME_MSWINDOWS_MENU_HASH_TABLE(f) = Qnil; + FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = Qnil; } static void @@ -740,6 +847,9 @@ mswindows_popup_menu (Lisp_Object menu_desc, Lisp_Object event) HMENU menu; POINT pt; int ok; + struct gcpro gcpro1; + + GCPRO1 (menu_desc); /* to be safe -- see above */ if (!NILP (event)) { @@ -777,7 +887,7 @@ mswindows_popup_menu (Lisp_Object menu_desc, Lisp_Object event) current_menudesc = menu_desc; current_hash_table = make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); - menu = create_empty_popup_menu(); + menu = create_empty_popup_menu (); Fputhash (hmenu_to_lisp_object (menu), Qnil, current_hash_table); top_level_menu = menu; @@ -796,11 +906,13 @@ mswindows_popup_menu (Lisp_Object menu_desc, Lisp_Object event) mswindows_unmodalize_signal_maybe (); /* This is probably the only real reason for failure */ - if (!ok) { - menu_cleanup (f); - signal_simple_error ("Cannot track popup menu while in menu", - menu_desc); - } + if (!ok) + { + menu_cleanup (f); + signal_simple_error ("Cannot track popup menu while in menu", + menu_desc); + } + UNGCPRO; } diff --git a/src/menubar-x.c b/src/menubar-x.c index 216856f..99400a3 100644 --- a/src/menubar-x.c +++ b/src/menubar-x.c @@ -21,7 +21,14 @@ Boston, MA 02111-1307, USA. */ /* Synched up with: Not in FSF. */ -/* created 16-dec-91 by jwz */ +/* Authorship: + + Created 16-dec-91 by Jamie Zawinski. + Menu filters and many other keywords added by Stig for 19.12. + Original device-abstraction work and GC cleanup work by Ben Wing for 19.13. + Menu accelerators c. 1997? by ??. Moved here from event-stream.c. + Other work post-1996 by ??. +*/ #include #include "lisp.h" @@ -29,12 +36,15 @@ Boston, MA 02111-1307, USA. */ #include "console-x.h" #include "EmacsFrame.h" #include "gui-x.h" +#include "../lwlib/lwlib.h" #include "buffer.h" #include "commands.h" /* zmacs_regions */ -#include "gui.h" #include "events.h" #include "frame.h" +#include "gui.h" +#include "keymap.h" +#include "menubar.h" #include "opaque.h" #include "window.h" @@ -154,7 +164,7 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, wv->type = CASCADE_TYPE; wv->enabled = 1; wv->name = (char *) XSTRING_DATA (LISP_GETTEXT (XCAR (desc))); - wv->name = xstrdup (wv->name); + wv->name = strdup_and_add_accel (wv->name); accel = gui_name_accelerator (LISP_GETTEXT (XCAR (desc))); wv->accel = LISP_TO_VOID (accel); @@ -267,7 +277,7 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, dummy->next = NULL; goto menu_item_done; - } + } } else if (menubar_root_p) @@ -292,7 +302,7 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, { if (partition_seen) error ( - "More than one partition (nil) in menubar description"); + "More than one partition (nil) in menubar description"); partition_seen = 1; next = xmalloc_widget_value (); next->type = PUSHRIGHT_TYPE; @@ -319,7 +329,7 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, else signal_simple_error ("Unrecognized menu descriptor", desc); -menu_item_done: + menu_item_done: if (wv) { @@ -336,7 +346,7 @@ menu_item_done: static widget_value * menu_item_descriptor_to_widget_value (Lisp_Object desc, int menu_type, /* if this is a menubar, - popup or sub menu */ + popup or sub menu */ int deep_p, /* */ int filter_p) /* if :filter forms should run now */ @@ -360,8 +370,8 @@ int in_menu_callback; static Lisp_Object restore_in_menu_callback (Lisp_Object val) { - in_menu_callback = XINT (val); - return Qnil; + in_menu_callback = XINT (val); + return Qnil; } #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */ @@ -830,7 +840,7 @@ x_popup_menu (Lisp_Object menu_desc, Lisp_Object event) them. We don't want the *first* command event to alter the state of the region, so that the region can be available as an argument for the second command. - */ + */ if (zmacs_regions) zmacs_region_stays = 1; @@ -841,9 +851,516 @@ x_popup_menu (Lisp_Object menu_desc, Lisp_Object event) } + +#if defined(LWLIB_MENUBARS_LUCID) +static void +menu_move_up (void) +{ + widget_value *current = lw_get_entries (False); + widget_value *entries = lw_get_entries (True); + widget_value *prev = NULL; + + while (entries != current) + { + if (entries->name /*&& entries->enabled*/) prev = entries; + entries = entries->next; + assert (entries); + } + + if (!prev) + /* move to last item */ + { + while (entries->next) + { + if (entries->name /*&& entries->enabled*/) prev = entries; + entries = entries->next; + } + if (prev) + { + if (entries->name /*&& entries->enabled*/) + prev = entries; + } + else + { + /* no selectable items in this menu, pop up to previous level */ + lw_pop_menu (); + return; + } + } + lw_set_item (prev); +} + +static void +menu_move_down (void) +{ + widget_value *current = lw_get_entries (False); + widget_value *new = current; + + while (new->next) + { + new = new->next; + if (new->name /*&& new->enabled*/) break; + } + + if (new==current||!(new->name/*||new->enabled*/)) + { + new = lw_get_entries (True); + while (new!=current) + { + if (new->name /*&& new->enabled*/) break; + new = new->next; + } + if (new==current&&!(new->name /*|| new->enabled*/)) + { + lw_pop_menu (); + return; + } + } + + lw_set_item (new); +} + +static void +menu_move_left (void) +{ + int level = lw_menu_level (); + int l = level; + widget_value *current; + + while (level-- >= 3) + lw_pop_menu (); + + menu_move_up (); + current = lw_get_entries (False); + if (l > 2 && current->contents) + lw_push_menu (current->contents); +} + +static void +menu_move_right (void) +{ + int level = lw_menu_level (); + int l = level; + widget_value *current; + + while (level-- >= 3) + lw_pop_menu (); + + menu_move_down (); + current = lw_get_entries (False); + if (l > 2 && current->contents) + lw_push_menu (current->contents); +} + +static void +menu_select_item (widget_value *val) +{ + if (val == NULL) + val = lw_get_entries (False); + + /* is match a submenu? */ + + if (val->contents) + { + /* enter the submenu */ + + lw_set_item (val); + lw_push_menu (val->contents); + } + else + { + /* Execute the menu entry by calling the menu's `select' + callback function + */ + lw_kill_menus (val); + } +} + +Lisp_Object +command_builder_operate_menu_accelerator (struct command_builder *builder) +{ + /* this function can GC */ + + struct console *con = XCONSOLE (Vselected_console); + Lisp_Object evee = builder->most_current_event; + Lisp_Object binding; + widget_value *entries; + + extern int lw_menu_accelerate; /* lwlib.c */ + +#if 0 + { + int i; + Lisp_Object t; + char buf[50]; + + t = builder->current_events; + i = 0; + while (!NILP (t)) + { + i++; + sprintf (buf,"OPERATE (%d): ",i); + write_c_string (buf, Qexternal_debugging_output); + print_internal (t, Qexternal_debugging_output, 1); + write_c_string ("\n", Qexternal_debugging_output); + t = XEVENT_NEXT (t); + } + } +#endif /* 0 */ + + /* menu accelerator keys don't go into keyboard macros */ + if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro)) + con->kbd_macro_ptr = con->kbd_macro_end; + + /* don't echo menu accelerator keys */ + /*reset_key_echo (builder, 1);*/ + + if (!lw_menu_accelerate) + { + /* `convert' mouse display to keyboard display + by entering the open submenu + */ + entries = lw_get_entries (False); + if (entries->contents) + { + lw_push_menu (entries->contents); + lw_display_menu (CurrentTime); + } + } + + /* compare event to the current menu accelerators */ + + entries=lw_get_entries (True); + + while (entries) + { + Lisp_Object accel; + VOID_TO_LISP (accel, entries->accel); + if (entries->name && !NILP (accel)) + { + if (event_matches_key_specifier_p (XEVENT (evee), accel)) + { + /* a match! */ + + menu_select_item (entries); + + if (lw_menu_active) lw_display_menu (CurrentTime); + + reset_this_command_keys (Vselected_console, 1); + /*reset_command_builder_event_chain (builder);*/ + return Vmenu_accelerator_map; + } + } + entries = entries->next; + } + + /* try to look up event in menu-accelerator-map */ + + binding = event_binding_in (evee, Vmenu_accelerator_map, 1); + + if (NILP (binding)) + { + /* beep at user for undefined key */ + return Qnil; + } + else + { + if (EQ (binding, Qmenu_quit)) + { + /* turn off menus and set quit flag */ + lw_kill_menus (NULL); + Vquit_flag = Qt; + } + else if (EQ (binding, Qmenu_up)) + { + int level = lw_menu_level (); + if (level > 2) + menu_move_up (); + } + else if (EQ (binding, Qmenu_down)) + { + int level = lw_menu_level (); + if (level > 2) + menu_move_down (); + else + menu_select_item (NULL); + } + else if (EQ (binding, Qmenu_left)) + { + int level = lw_menu_level (); + if (level > 3) + { + lw_pop_menu (); + lw_display_menu (CurrentTime); + } + else + menu_move_left (); + } + else if (EQ (binding, Qmenu_right)) + { + int level = lw_menu_level (); + if (level > 2 && + lw_get_entries (False)->contents) + { + widget_value *current = lw_get_entries (False); + if (current->contents) + menu_select_item (NULL); + } + else + menu_move_right (); + } + else if (EQ (binding, Qmenu_select)) + menu_select_item (NULL); + else if (EQ (binding, Qmenu_escape)) + { + int level = lw_menu_level (); + + if (level > 2) + { + lw_pop_menu (); + lw_display_menu (CurrentTime); + } + else + { + /* turn off menus quietly */ + lw_kill_menus (NULL); + } + } + else if (KEYMAPP (binding)) + { + /* prefix key */ + reset_this_command_keys (Vselected_console, 1); + /*reset_command_builder_event_chain (builder);*/ + return binding; + } + else + { + /* turn off menus and execute binding */ + lw_kill_menus (NULL); + reset_this_command_keys (Vselected_console, 1); + /*reset_command_builder_event_chain (builder);*/ + return binding; + } + } + + if (lw_menu_active) lw_display_menu (CurrentTime); + + reset_this_command_keys (Vselected_console, 1); + /*reset_command_builder_event_chain (builder);*/ + + return Vmenu_accelerator_map; +} + +static Lisp_Object +menu_accelerator_junk_on_error (Lisp_Object errordata, Lisp_Object ignored) +{ + Vmenu_accelerator_prefix = Qnil; + Vmenu_accelerator_modifiers = Qnil; + Vmenu_accelerator_enabled = Qnil; + if (!NILP (errordata)) + { + Lisp_Object args[2]; + + args[0] = build_string ("Error in menu accelerators (setting to nil)"); + /* #### This should call + (with-output-to-string (display-error errordata)) + but that stuff is all in Lisp currently. */ + args[1] = errordata; + warn_when_safe_lispobj + (Qerror, Qwarning, + emacs_doprnt_string_lisp ((const Bufbyte *) "%s: %s", + Qnil, -1, 2, args)); + } + + return Qnil; +} + +static Lisp_Object +menu_accelerator_safe_compare (Lisp_Object event0) +{ + if (CONSP (Vmenu_accelerator_prefix)) + { + Lisp_Object t; + t=Vmenu_accelerator_prefix; + while (!NILP (t) + && !NILP (event0) + && event_matches_key_specifier_p (XEVENT (event0), Fcar (t))) + { + t = Fcdr (t); + event0 = XEVENT_NEXT (event0); + } + if (!NILP (t)) + return Qnil; + } + else if (NILP (event0)) + return Qnil; + else if (event_matches_key_specifier_p (XEVENT (event0), Vmenu_accelerator_prefix)) + event0 = XEVENT_NEXT (event0); + else + return Qnil; + return event0; +} + +static Lisp_Object +menu_accelerator_safe_mod_compare (Lisp_Object cons) +{ + return (event_matches_key_specifier_p (XEVENT (XCAR (cons)), XCDR (cons)) + ? Qt + : Qnil); +} + +Lisp_Object +command_builder_find_menu_accelerator (struct command_builder *builder) +{ + /* this function can GC */ + Lisp_Object event0 = builder->current_events; + struct console *con = XCONSOLE (Vselected_console); + struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con)); + Widget menubar_widget; + + /* compare entries in event0 against the menu prefix */ + + if ((!CONSOLE_X_P (XCONSOLE (builder->console))) || NILP (event0) || + XEVENT (event0)->event_type != key_press_event) + return Qnil; + + if (!NILP (Vmenu_accelerator_prefix)) + { + event0 = condition_case_1 (Qerror, + menu_accelerator_safe_compare, + event0, + menu_accelerator_junk_on_error, + Qnil); + } + + if (NILP (event0)) + return Qnil; + + menubar_widget = FRAME_X_MENUBAR_WIDGET (f); + if (menubar_widget + && CONSP (Vmenu_accelerator_modifiers)) + { + Lisp_Object fake; + Lisp_Object last = Qnil; + struct gcpro gcpro1; + Lisp_Object matchp; + + widget_value *val; + LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id; + + val = lw_get_all_values (id); + if (val) + { + val = val->contents; + + fake = Fcopy_sequence (Vmenu_accelerator_modifiers); + last = fake; + + while (!NILP (Fcdr (last))) + last = Fcdr (last); + + Fsetcdr (last, Fcons (Qnil, Qnil)); + last = Fcdr (last); + } + + fake = Fcons (Qnil, fake); + + GCPRO1 (fake); + + while (val) + { + Lisp_Object accel; + VOID_TO_LISP (accel, val->accel); + if (val->name && !NILP (accel)) + { + Fsetcar (last, accel); + Fsetcar (fake, event0); + matchp = condition_case_1 (Qerror, + menu_accelerator_safe_mod_compare, + fake, + menu_accelerator_junk_on_error, + Qnil); + if (!NILP (matchp)) + { + /* we found one! */ + + lw_set_menu (menubar_widget, val); + /* yah - yet another hack. + pretend emacs timestamp is the same as an X timestamp, + which for the moment it is. (read events.h) + */ + lw_map_menu (XEVENT (event0)->timestamp); + + if (val->contents) + lw_push_menu (val->contents); + + lw_display_menu (CurrentTime); + + /* menu accelerator keys don't go into keyboard macros */ + if (!NILP (con->defining_kbd_macro) + && NILP (Vexecuting_macro)) + con->kbd_macro_ptr = con->kbd_macro_end; + + /* don't echo menu accelerator keys */ + /*reset_key_echo (builder, 1);*/ + reset_this_command_keys (Vselected_console, 1); + UNGCPRO; + + return Vmenu_accelerator_map; + } + } + + val = val->next; + } + + UNGCPRO; + } + return Qnil; +} + +int +x_kludge_lw_menu_active (void) +{ + return lw_menu_active; +} + +DEFUN ("accelerate-menu", Faccelerate_menu, 0, 0, "_", /* +Make the menubar active. Menu items can be selected using menu accelerators +or by actions defined in menu-accelerator-map. +*/ + ()) +{ + struct console *con = XCONSOLE (Vselected_console); + struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con)); + LWLIB_ID id; + widget_value *val; + + if (NILP (f->menubar_data)) + error ("Frame has no menubar."); + + id = XPOPUP_DATA (f->menubar_data)->id; + val = lw_get_all_values (id); + val = val->contents; + lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val); + lw_map_menu (CurrentTime); + + lw_display_menu (CurrentTime); + + /* menu accelerator keys don't go into keyboard macros */ + if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro)) + con->kbd_macro_ptr = con->kbd_macro_end; + + return Qnil; +} +#endif /* LWLIB_MENUBARS_LUCID */ + + void syms_of_menubar_x (void) { +#if defined(LWLIB_MENUBARS_LUCID) + DEFSUBR (Faccelerate_menu); +#endif } void diff --git a/src/menubar.c b/src/menubar.c index df32322..f397934 100644 --- a/src/menubar.c +++ b/src/menubar.c @@ -21,8 +21,13 @@ Boston, MA 02111-1307, USA. */ /* Synched up with: Not in FSF. */ -/* #### There ain't much here because menubars have not been - properly abstracted yet. */ +/* Authorship: + + Created by Ben Wing as part of device-abstraction work for 19.12. + Menu filters and many other keywords added by Stig for 19.12. + Menu accelerators c. 1997? by ??. Moved here from event-stream.c. + Much other work post-1996 by ??. +*/ #include #include "lisp.h" @@ -31,6 +36,7 @@ Boston, MA 02111-1307, USA. */ #include "device.h" #include "frame.h" #include "gui.h" +#include "keymap.h" #include "menubar.h" #include "redisplay.h" #include "window.h" @@ -54,6 +60,30 @@ int popup_menu_titles; Lisp_Object Vmenubar_pointer_glyph; +/* prefix key(s) that must match in order to activate menu. + This is ugly. fix me. + */ +Lisp_Object Vmenu_accelerator_prefix; + +/* list of modifier keys to match accelerator for top level menus */ +Lisp_Object Vmenu_accelerator_modifiers; + +/* whether menu accelerators are enabled */ +Lisp_Object Vmenu_accelerator_enabled; + +/* keymap for auxiliary menu accelerator functions */ +Lisp_Object Vmenu_accelerator_map; + +Lisp_Object Qmenu_force; +Lisp_Object Qmenu_fallback; +Lisp_Object Qmenu_quit; +Lisp_Object Qmenu_up; +Lisp_Object Qmenu_down; +Lisp_Object Qmenu_left; +Lisp_Object Qmenu_right; +Lisp_Object Qmenu_select; +Lisp_Object Qmenu_escape; + static int menubar_variable_changed (Lisp_Object sym, Lisp_Object *val, Lisp_Object in_object, int flags) @@ -104,7 +134,7 @@ current_frame_menubar (const struct frame* f) Lisp_Object menu_parse_submenu_keywords (Lisp_Object desc, Lisp_Object gui_item) { - Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); + Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); /* Menu descriptor should be a list */ CHECK_CONS (desc); @@ -153,11 +183,11 @@ See also 'find-menu-item'. (desc, path)) { Lisp_Object path_entry, submenu_desc, submenu; - struct gcpro gcpro1; + struct gcpro gcpro1, gcpro2; Lisp_Object gui_item = allocate_gui_item (); Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); - GCPRO1 (gui_item); + GCPRO2 (gui_item, desc); EXTERNAL_LIST_LOOP (path_entry, path) { @@ -292,6 +322,7 @@ See menubar.el for many more examples. DEFUN ("normalize-menu-item-name", Fnormalize_menu_item_name, 1, 2, 0, /* Convert a menu item name string into normal form, and return the new string. Menu item names should be converted to normal form before being compared. +This removes %_'s (accelerator indications) and converts %% to %. */ (name, buffer)) { @@ -347,6 +378,18 @@ void syms_of_menubar (void) { defsymbol (&Qcurrent_menubar, "current-menubar"); + + defsymbol (&Qmenu_force, "menu-force"); + defsymbol (&Qmenu_fallback, "menu-fallback"); + + defsymbol (&Qmenu_quit, "menu-quit"); + defsymbol (&Qmenu_up, "menu-up"); + defsymbol (&Qmenu_down, "menu-down"); + defsymbol (&Qmenu_left, "menu-left"); + defsymbol (&Qmenu_right, "menu-right"); + defsymbol (&Qmenu_select, "menu-select"); + defsymbol (&Qmenu_escape, "menu-escape"); + DEFSUBR (Fpopup_menu); DEFSUBR (Fnormalize_menu_item_name); DEFSUBR (Fmenu_find_real_submenu); @@ -397,8 +440,18 @@ This is the string that will be displayed in the parent menu, if any. For toplevel menus, it is ignored. This string is not displayed in the menu itself. -Immediately following the name string of the menu, any of three -optional keyword-value pairs is permitted. +Menu accelerators can be indicated in the string by putting the +sequence "%_" before the character corresponding to the key that will +invoke the menu or menu item. Uppercase and lowercase accelerators +are equivalent. The sequence "%%" is also special, and is translated +into a single %. + +If no menu accelerator is present in the string, XEmacs will act as if +the first character has been tagged as an accelerator. + +Immediately following the name string of the menu, various optional +keyword-value pairs are permitted: currently, :filter, :active, :included, +and :config. (See below.) If an element of a menu (or menubar) is a string, then that string will be presented as unselectable text. @@ -406,6 +459,29 @@ presented as unselectable text. If an element of a menu is a string consisting solely of hyphens, then that item will be presented as a solid horizontal line. +If an element of a menu is a string beginning with "--:", it will be +presented as a line whose appearance is controlled by the rest of the +text in the string. The allowed line specs are system-dependent, and +currently work only under X Windows (with Lucid and Motif menubars); +otherwise, a solid horizontal line is presented, as if the string were +all hyphens. + +The possibilities are: + + "--:singleLine" + "--:doubleLine" + "--:singleDashedLine" + "--:doubleDashedLine" + "--:noLine" + "--:shadowEtchedIn" + "--:shadowEtchedOut" + "--:shadowEtchedInDash" + "--:shadowEtchedOutDash" + "--:shadowDoubleEtchedIn" (Lucid menubars only) + "--:shadowDoubleEtchedOut" (Lucid menubars only) + "--:shadowDoubleEtchedInDash" (Lucid menubars only) + "--:shadowDoubleEtchedOutDash" (Lucid menubars only) + If an element of a menu is a list, it is treated as a submenu. The name of that submenu (the first element in the list) will be used as the name of the item representing this menu on the parent. @@ -415,33 +491,39 @@ division between the set of menubar-items which are flushleft and those which are flushright. Otherwise, the element must be a vector, which describes a menu item. -A menu item can have any of the following forms: +A menu item is of the following form: + + [ "name" callback : : ... ] + +The following forms are also accepted for compatibility, but deprecated: [ "name" callback ] [ "name" callback ] - [ "name" callback : : ... ] The name is the string to display on the menu; it is filtered through the resource database, so it is possible for resources to override what string -is actually displayed. +is actually displayed. Menu accelerator indicators (the sequence `%_') are +also processed; see above. If the name is not a string, it will be +evaluated with `eval', and the result should be a string. If the `callback' of a menu item is a symbol, then it must name a command. It will be invoked with `call-interactively'. If it is a list, then it is evaluated with `eval'. -The possible keywords are this: +In the deprecated forms, is equivalent to using the :active +keyword, and is equivalent to using the :suffix keyword. - :active
Same as in the first two forms: the - expression is evaluated just before the menu is +The possible keywords are: + + :active The expression is evaluated just before the menu is displayed, and the menu will be selectable only if the result is non-nil. - :suffix Same as in the second form: the expression - is evaluated just before the menu is displayed and - resulting string is appended to the displayed name, - providing a convenient way of adding the name of a - command's ``argument'' to the menu, like - ``Kill Buffer NAME''. + :suffix The expression is evaluated just before the menu is + displayed and the resulting string is appended to + the displayed name, providing a convenient way of + adding the name of a command's ``argument'' to the + menu, like ``Kill Buffer NAME''. :keys "string" Normally, the keyboard equivalents of commands in menus are displayed when the `callback' is a symbol. @@ -478,47 +560,42 @@ The possible keywords are this: See the variable `menubar-configuration'. :filter A menu filter can only be used in a menu item list. - (i.e.: not in a menu item itself). It is used to - sensitize or incrementally create a submenu only when - it is selected by the user and not every time the - menubar is activated. The filter function is passed - the list of menu items in the submenu and must return a - list of menu items to be used for the menu. It is - called only when the menu is about to be displayed, so - other menus may already be displayed. Vile and - terrible things will happen if a menu filter function - changes the current buffer, window, or frame. It - also should not raise, lower, or iconify any frames. - Basically, the filter function should have no - side-effects. + (i.e. not in a menu item itself). It is used to + incrementally create a submenu only when it is selected + by the user and not every time the menubar is activated. + The filter function is passed the list of menu items in + the submenu and must return a list of menu items to be + used for the menu. It must not destructively modify + the list of menu items passed to it. It is called only + when the menu is about to be displayed, so other menus + may already be displayed. Vile and terrible things will + happen if a menu filter function changes the current + buffer, window, or frame. It also should not raise, + lower, or iconify any frames. Basically, the filter + function should have no side-effects. :key-sequence keys Used in FSF Emacs as an hint to an equivalent keybinding. - Ignored by XEnacs for easymenu.el compatibility. - - :label (unimplemented!) Like :suffix, but replaces label - completely. - (might be added in 21.2). + Ignored by XEmacs for easymenu.el compatibility. For example: - ("File" + ("%_File" :filter file-menu-filter ; file-menu-filter is a function that takes ; one argument (a list of menu items) and ; returns a list of menu items - [ "Save As..." write-file t ] - [ "Revert Buffer" revert-buffer (buffer-modified-p) ] - [ "Read Only" toggle-read-only :style toggle + [ "Save %_As..." write-file t ] + [ "%_Revert Buffer" revert-buffer (buffer-modified-p) ] + [ "R%_ead Only" toggle-read-only :style toggle :selected buffer-read-only ] ) -See x-menubar.el for many more examples. +See menubar-items.el for many more examples. After the menubar is clicked upon, but before any menus are popped up, the functions on the `activate-menubar-hook' are invoked to make top-level changes to the menus and menubar. Note, however, that the use of menu filters (using the :filter keyword) is usually a more efficient way to -dynamically alter or sensitize menus. -*/, menubar_variable_changed); +dynamically alter or sensitize menus. */, menubar_variable_changed); Vcurrent_menubar = Qnil; @@ -564,6 +641,80 @@ If unspecified in a particular domain, the window-system-provided default pointer is used. */ ); + DEFVAR_LISP ("menu-accelerator-prefix", &Vmenu_accelerator_prefix /* +Prefix key(s) that must be typed before menu accelerators will be activated. +Set this to a value acceptable by define-key. + +NOTE: This currently only has any effect under X Windows. +*/ ); + Vmenu_accelerator_prefix = Qnil; + + DEFVAR_LISP ("menu-accelerator-modifiers", &Vmenu_accelerator_modifiers /* +Modifier keys which must be pressed to get to the top level menu accelerators. +This is a list of modifier key symbols. All modifier keys must be held down +while a valid menu accelerator key is pressed in order for the top level +menu to become active. + +NOTE: This currently only has any effect under X Windows. + +See also menu-accelerator-enabled and menu-accelerator-prefix. +*/ ); + Vmenu_accelerator_modifiers = list1 (Qmeta); + + DEFVAR_LISP ("menu-accelerator-enabled", &Vmenu_accelerator_enabled /* +Whether menu accelerator keys can cause the menubar to become active. +If 'menu-force or 'menu-fallback, then menu accelerator keys can +be used to activate the top level menu. Once the menubar becomes active, the +accelerator keys can be used regardless of the value of this variable. + +menu-force is used to indicate that the menu accelerator key takes +precedence over bindings in the current keymap(s). menu-fallback means +that bindings in the current keymap take precedence over menu accelerator keys. +Thus a top level menu with an accelerator of "T" would be activated on a +keypress of Meta-t if menu-accelerator-enabled is menu-force. +However, if menu-accelerator-enabled is menu-fallback, then +Meta-t will not activate the menubar and will instead run the function +transpose-words, to which it is normally bound. + +See also menu-accelerator-modifiers and menu-accelerator-prefix. +*/ ); + Vmenu_accelerator_enabled = Qnil; + + DEFVAR_LISP ("menu-accelerator-map", &Vmenu_accelerator_map /* +Keymap for use when the menubar is active. +The actions menu-quit, menu-up, menu-down, menu-left, menu-right, +menu-select and menu-escape can be mapped to keys in this map. +NOTE: This currently only has any effect under X Windows. + +menu-quit Immediately deactivate the menubar and any open submenus without + selecting an item. +menu-up Move the menu cursor up one row in the current menu. If the + move extends past the top of the menu, wrap around to the bottom. +menu-down Move the menu cursor down one row in the current menu. If the + move extends past the bottom of the menu, wrap around to the top. + If executed while the cursor is in the top level menu, move down + into the selected menu. +menu-left Move the cursor from a submenu into the parent menu. If executed + while the cursor is in the top level menu, move the cursor to the + left. If the move extends past the left edge of the menu, wrap + around to the right edge. +menu-right Move the cursor into a submenu. If the cursor is located in the + top level menu or is not currently on a submenu heading, then move + the cursor to the next top level menu entry. If the move extends + past the right edge of the menu, wrap around to the left edge. +menu-select Activate the item under the cursor. If the cursor is located on + a submenu heading, then move the cursor into the submenu. +menu-escape Pop up to the next level of menus. Moves from a submenu into its + parent menu. From the top level menu, this deactivates the + menubar. + +This keymap can also contain normal key-command bindings, in which case the +menubar is deactivated and the corresponding command is executed. + +The action bindings used by the menu accelerator code are designed to mimic +the actions of menu traversal keys in a commonly used PC operating system. +*/ ); + Fprovide (intern ("menubar")); } @@ -588,4 +739,6 @@ void complex_vars_of_menubar (void) { Vmenubar_pointer_glyph = Fmake_glyph_internal (Qpointer); + + Vmenu_accelerator_map = Fmake_keymap (Qnil); } diff --git a/src/menubar.h b/src/menubar.h index c67de98..9b2cce8 100644 --- a/src/menubar.h +++ b/src/menubar.h @@ -20,7 +20,7 @@ Boston, MA 02111-1307, USA. */ /* Synched up with: Not in FSF. */ -/* #### Not properly abstracted for device-independence. */ +/* #### Still needs some device-abstraction work. */ #ifndef INCLUDED_menubar_h_ #define INCLUDED_menubar_h_ @@ -35,6 +35,37 @@ Lisp_Object current_frame_menubar (const struct frame* f); EXFUN (Fmenu_find_real_submenu, 2); +extern Lisp_Object Vmenu_accelerator_prefix; +extern Lisp_Object Vmenu_accelerator_modifiers; +extern Lisp_Object Vmenu_accelerator_enabled; +extern Lisp_Object Vmenu_accelerator_map; + +extern Lisp_Object Qmenu_force; +extern Lisp_Object Qmenu_fallback; + +extern Lisp_Object Qmenu_quit; +extern Lisp_Object Qmenu_up; +extern Lisp_Object Qmenu_down; +extern Lisp_Object Qmenu_left; +extern Lisp_Object Qmenu_right; +extern Lisp_Object Qmenu_select; +extern Lisp_Object Qmenu_escape; + + +/* #### kluuuuuuuuuuuuuuuuuuuuuuuuuuuudge! + The author of the accelerator code didn't know what the hell he was doing. + Someone needs to abstract this properly. */ +#if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID) +extern int x_kludge_lw_menu_active (void); +struct command_builder; +Lisp_Object command_builder_find_menu_accelerator (struct command_builder + *builder); +Lisp_Object command_builder_operate_menu_accelerator (struct command_builder + *builder); + +extern int in_menu_callback; +#endif + #endif /* HAVE_MENUBARS */ #endif /* INCLUDED_menubar_h_ */ diff --git a/src/minibuf.c b/src/minibuf.c index f189636..0c9d560 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -682,7 +682,7 @@ clear_echo_area_internal (struct frame *f, Lisp_Object label, int from_print, else { write_string_to_stdio_stream (stderr, 0, (const Bufbyte *) "\n", 0, 1, - Qterminal); + Qterminal, 0); return Qnil; } } @@ -751,7 +751,7 @@ echo_area_append (struct frame *f, const Bufbyte *nonreloc, Lisp_Object reloc, if (STRINGP (reloc)) nonreloc = XSTRING_DATA (reloc); write_string_to_stdio_stream (stderr, 0, nonreloc, offset, length, - Qterminal); + Qterminal, 0); } } diff --git a/src/nt.c b/src/nt.c index 4b21a11..bd14ddc 100644 --- a/src/nt.c +++ b/src/nt.c @@ -48,20 +48,7 @@ Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA #include #include -#ifndef __MINGW32__ #include -#else -typedef void (CALLBACK TIMECALLBACK)(UINT uTimerID, UINT uMsg, DWORD dwUser, DWORD dw1, DWORD dw2); - -typedef TIMECALLBACK FAR *LPTIMECALLBACK; -DWORD WINAPI timeGetTime(void); -MMRESULT WINAPI timeSetEvent(UINT uDelay, UINT uResolution, - LPTIMECALLBACK fptc, DWORD dwUser, UINT fuEvent); -MMRESULT WINAPI timeKillEvent(UINT uTimerID); -MMRESULT WINAPI timeGetDevCaps(TIMECAPS* ptc, UINT cbtc); -MMRESULT WINAPI timeBeginPeriod(UINT uPeriod); -MMRESULT WINAPI timeEndPeriod(UINT uPeriod); -#endif #include "nt.h" #include @@ -132,25 +119,25 @@ static struct passwd the_passwd = }; uid_t -getuid () +getuid (void) { return nt_fake_unix_uid; } uid_t -geteuid () +geteuid (void) { return nt_fake_unix_uid; } gid_t -getgid () +getgid (void) { return the_passwd.pw_gid; } gid_t -getegid () +getegid (void) { return getgid (); } @@ -183,7 +170,7 @@ getpwnam (const char *name) } void -init_user_info () +init_user_info (void) { /* This code is pretty much of ad hoc nature. There is no unix-like UIDs under Windows NT. There is no concept of root user, because @@ -593,7 +580,7 @@ nt_get_resource (char *key, LPDWORD lpdwtype) } void -init_environment () +init_environment (void) { /* Check for environment variables and use registry if they don't exist */ { @@ -615,7 +602,7 @@ init_environment () "EMACSLOCKDIR", "INFOPATH" }; -#ifdef HEAP_IN_DATA +#if defined (HEAP_IN_DATA) && !defined(PDUMP) cache_system_info (); #endif for (i = 0; i < countof (env_vars); i++) @@ -1250,6 +1237,11 @@ convert_time (FILETIME ft) } #else +#if defined(__MINGW32__) && CYGWIN_VERSION_DLL_MAJOR <= 21 +#define LowPart u.LowPart +#define HighPart u.HighPart +#endif + static LARGE_INTEGER utc_base_li; time_t @@ -1319,6 +1311,10 @@ convert_time (FILETIME uft) return ret; } #endif +#if defined(__MINGW32__) && CYGWIN_VERSION_DLL_MAJOR <= 21 +#undef LowPart +#undef HighPart +#endif #if 0 /* in case we ever have need of this */ @@ -1400,6 +1396,12 @@ generate_inode_val (const char * name) Oh, and do not encapsulater stat for non-MS compilers, too */ /* #### popineau@ese-metz.fr says they still might be broken. Oh well... Let's add that `1 ||' condition.... --kkm */ +/* #### aichner@ecf.teradyne.com reported that with the library + provided stat/fstat, (file-exist "d:\\tmp\\") =>> nil, + (file-exist "d:\\tmp") =>> t, when d:\tmp exists. Whenever + we opt to use non-encapsulated stat(), this should serve as + a compatibility test. --kkm */ + #if 1 || defined(_MSC_VER) && _MSC_VER < 1100 /* Since stat is encapsulated on Windows NT, we need to encapsulate @@ -1667,7 +1669,7 @@ term_ntproc (int unused) } void -init_ntproc () +init_ntproc (void) { /* Initial preparation for subprocess support: replace our standard handles with non-inheritable versions. */ diff --git a/src/ntproc.c b/src/ntproc.c index 0b95e43..eed038e 100644 --- a/src/ntproc.c +++ b/src/ntproc.c @@ -55,6 +55,9 @@ Boston, MA 02111-1307, USA. #include "syswait.h" #include "buffer.h" #include "process.h" + +#include "console-msw.h" + /*#include "w32term.h"*/ /* From 19.34.6: sync in ? --marcpa */ /* #### I'm not going to play with shit. */ @@ -120,13 +123,6 @@ child_process *dead_child = NULL; DWORD WINAPI reader_thread (void *arg); -/* Determine if running on Windows 9x and not NT */ -static int -windows9x_p (void) -{ - return GetVersion () & 0x80000000; -} - /* Find an unused process slot. */ child_process * new_child (void) @@ -751,7 +747,7 @@ sys_spawnve (int mode, const char *cmdname, /* Override escape char by binding win32-quote-process-args to desired character, or use t for auto-selection. */ if (INTP (Vwin32_quote_process_args)) - escape_char = XINT (Vwin32_quote_process_args); + escape_char = (char) XINT (Vwin32_quote_process_args); else escape_char = is_cygnus_app ? '"' : '\\'; } @@ -947,7 +943,7 @@ find_child_console (HWND hwnd, child_process * cp) GetClassName (hwnd, window_class, sizeof (window_class)); if (strcmp (window_class, - windows9x_p() + msw_windows9x_p() ? "tty" : "ConsoleWindowClass") == 0) { @@ -1040,7 +1036,7 @@ sys_kill (int pid, int sig) if (NILP (Vwin32_start_process_share_console) && cp && cp->hwnd) { #if 1 - if (windows9x_p()) + if (msw_windows9x_p()) { /* Another possibility is to try terminating the VDM out-right by @@ -1442,7 +1438,7 @@ If successful, the new locale id is returned, otherwise nil. void -syms_of_ntproc () +syms_of_ntproc (void) { DEFSUBR (Fwin32_short_file_name); DEFSUBR (Fwin32_long_file_name); diff --git a/src/opaque.c b/src/opaque.c index 1b080e5..2fb6dec 100644 --- a/src/opaque.c +++ b/src/opaque.c @@ -124,7 +124,7 @@ print_opaque_ptr (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) const Lisp_Opaque_Ptr *p = XOPAQUE_PTR (obj); char buf[200]; - sprintf (buf, "#", + sprintf (buf, "#", (long)(p->ptr), (unsigned long) p); write_c_string (buf, printcharfun); } @@ -141,7 +141,7 @@ hash_opaque_ptr (Lisp_Object obj, int depth) return (unsigned long) XOPAQUE_PTR (obj)->ptr; } -DEFINE_LRECORD_IMPLEMENTATION ("opaque_ptr", opaque_ptr, +DEFINE_LRECORD_IMPLEMENTATION ("opaque-ptr", opaque_ptr, 0, print_opaque_ptr, 0, equal_opaque_ptr, hash_opaque_ptr, 0, Lisp_Opaque_Ptr); diff --git a/src/print.c b/src/print.c index 981e4f8..dfe2e1c 100644 --- a/src/print.c +++ b/src/print.c @@ -1,6 +1,6 @@ /* Lisp object printing and output streams. Copyright (C) 1985, 1986, 1988, 1992-1995 Free Software Foundation, Inc. - Copyright (C) 1995, 1996 Ben Wing. + Copyright (C) 1995, 1996, 2000 Ben Wing. This file is part of XEmacs. @@ -38,6 +38,9 @@ Boston, MA 02111-1307, USA. */ #include "insdel.h" #include "lstream.h" #include "sysfile.h" +#ifdef WINDOWSNT +#include "console-msw.h" +#endif #include #include @@ -103,40 +106,40 @@ FILE *termscript; /* Stdio stream being used for copy of all output. */ int stdout_needs_newline; -/* Write a string (in internal format) to stdio stream STREAM. */ - -void -write_string_to_stdio_stream (FILE *stream, struct console *con, - const Bufbyte *str, - Bytecount offset, Bytecount len, - Lisp_Object coding_system) +static void +std_handle_out_external (FILE *stream, Lisp_Object lstream, + const Extbyte *extptr, Extcount extlen, + /* is this really stdout/stderr? + (controls termscript writing) */ + int output_is_std_handle, + int must_flush) { - Extcount extlen; - const Extbyte *extptr; - - TO_EXTERNAL_FORMAT (DATA, (str + offset, len), - ALLOCA, (extptr, extlen), - coding_system); if (stream) { - fwrite (extptr, 1, extlen, stream); #ifdef WINDOWSNT - /* Q122442 says that pipes are "treated as files, not as - devices", and that this is a feature. Before I found that - article, I thought it was a bug. Thanks MS, I feel much - better now. - kkm */ - if (stream == stdout || stream == stderr) - fflush (stream); + /* we typically have no useful stdout/stderr under windows if we're + being invoked graphically. */ + if (!noninteractive) + msw_output_console_string (extptr, extlen); + else +#endif + { + fwrite (extptr, 1, extlen, stream); +#ifdef WINDOWSNT + /* Q122442 says that pipes are "treated as files, not as + devices", and that this is a feature. Before I found that + article, I thought it was a bug. Thanks MS, I feel much + better now. - kkm */ + must_flush = 1; #endif + if (must_flush) + fflush (stream); + } } else - { - assert (CONSOLE_TTY_P (con)); - Lstream_write (XLSTREAM (CONSOLE_TTY_DATA (con)->outstream), - extptr, extlen); - } - if (stream == stdout || stream == stderr || - (!stream && CONSOLE_TTY_DATA (con)->is_stdio)) + Lstream_write (XLSTREAM (lstream), extptr, extlen); + + if (output_is_std_handle) { if (termscript) { @@ -147,6 +150,113 @@ write_string_to_stdio_stream (FILE *stream, struct console *con, } } +/* #### The following function should be replaced a call to the + emacs_doprnt_*() functions. 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). + + Note, however, that to do this, we'd have to + + 1) pre-allocate all the lstreams and do whatever else was necessary + to make sure that no allocation occurs, since these functions may be + called from fatal_error_signal(). + + 2) (to be really correct) make a new lstream that outputs using + msw_output_console_string(). */ + +static int +std_handle_out_va (FILE *stream, const char *fmt, va_list args) +{ + Bufbyte kludge[8192]; + Extbyte *extptr; + Extcount extlen; + int retval; + + retval = vsprintf ((char *) kludge, fmt, args); + TO_EXTERNAL_FORMAT (DATA, (kludge, strlen ((char *) kludge)), + ALLOCA, (extptr, extlen), + Qnative); + std_handle_out_external (stream, Qnil, extptr, extlen, 1, 1); + return retval; +} + +/* Output portably to stderr or its equivalent; call GETTEXT on the + format string. Automatically flush when done. */ + +int +stderr_out (const char *fmt, ...) +{ + int retval; + va_list args; + va_start (args, fmt); + retval = std_handle_out_va (stderr, GETTEXT (fmt), args); + va_end (args); + return retval; +} + +/* Output portably to stdout or its equivalent; call GETTEXT on the + format string. Automatically flush when done. */ + +int +stdout_out (const char *fmt, ...) +{ + int retval; + va_list args; + va_start (args, fmt); + retval = std_handle_out_va (stdout, GETTEXT (fmt), args); + va_end (args); + return retval; +} + +DOESNT_RETURN +fatal (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + + stderr_out ("\nXEmacs: "); + std_handle_out_va (stderr, GETTEXT (fmt), args); + stderr_out ("\n"); + + va_end (args); + exit (1); +} + +/* Write a string (in internal format) to stdio stream STREAM. */ + +void +write_string_to_stdio_stream (FILE *stream, struct console *con, + const Bufbyte *str, + Bytecount offset, Bytecount len, + Lisp_Object coding_system, + int must_flush) +{ + Extcount extlen; + const Extbyte *extptr; + + /* #### yuck! sometimes this function is called with string data, + and the following call may gc. */ + { + Bufbyte *puta = (Bufbyte *) alloca (len); + memcpy (puta, str + offset, len); + TO_EXTERNAL_FORMAT (DATA, (puta, len), + ALLOCA, (extptr, extlen), + coding_system); + } + + if (stream) + std_handle_out_external (stream, Qnil, extptr, extlen, + stream == stdout || stream == stderr, must_flush); + else + { + assert (CONSOLE_TTY_P (con)); + std_handle_out_external (0, CONSOLE_TTY_DATA (con)->outstream, + extptr, extlen, + CONSOLE_TTY_DATA (con)->is_stdio, must_flush); + } +} + /* Write a string to the output location specified in FUNCTION. Arguments NONRELOC, RELOC, OFFSET, and LEN are as in buffer_insert_string_1() in insdel.c. */ @@ -238,7 +348,7 @@ output_string (Lisp_Object function, const Bufbyte *nonreloc, else if (EQ (function, Qt) || EQ (function, Qnil)) { write_string_to_stdio_stream (stdout, 0, newnonreloc, offset, len, - Qterminal); + Qterminal, print_unbuffered); } else { @@ -1427,6 +1537,10 @@ If optional arg STDOUT-P is non-nil, write to stdout; otherwise, write to stderr. You can use this function to write directly to the terminal. This function can be used as the STREAM argument of Fprint() or the like. +Under MS Windows, this writes output to the console window (which is +created, if necessary), unless XEmacs is being run noninteractively +(i.e. using the `-batch' argument). + If you have opened a termscript file (using `open-termscript'), then the output also will be logged to this file. */ @@ -1461,7 +1575,7 @@ the output also will be logged to this file. write_string_to_stdio_stream (file, con, XSTRING_DATA (char_or_string), 0, XSTRING_LENGTH (char_or_string), - Qterminal); + Qterminal, 1); else { Bufbyte str[MAX_EMCHAR_LEN]; @@ -1469,7 +1583,7 @@ the output also will be logged to this file. CHECK_CHAR_COERCE_INT (char_or_string); len = set_charptr_emchar (str, XCHAR (char_or_string)); - write_string_to_stdio_stream (file, con, str, 0, len, Qterminal); + write_string_to_stdio_stream (file, con, str, 0, len, Qterminal, 1); } return char_or_string; @@ -1542,7 +1656,6 @@ debug_print (Lisp_Object debug_print_obj) { debug_print_no_newline (debug_print_obj); stderr_out ("\n"); - fflush (stderr); } /* Debugging kludge -- unbuffered */ @@ -1575,7 +1688,6 @@ debug_backtrace (void) Fbacktrace (Qexternal_debugging_output, Qt); stderr_out ("\n"); - fflush (stderr); Vinhibit_quit = old_inhibit_quit; Vprint_level = old_print_level; @@ -1593,13 +1705,11 @@ debug_short_backtrace (int length) int first = 1; struct backtrace *bt = backtrace_list; stderr_out (" ["); - fflush (stderr); while (length > 0 && bt) { if (!first) { stderr_out (", "); - fflush (stderr); } if (COMPILED_FUNCTIONP (*bt->function)) { @@ -1612,15 +1722,12 @@ debug_short_backtrace (int length) if (!NILP (ann)) { stderr_out (""); - fflush (stderr); } else { stderr_out (""); - fflush (stderr); } } else @@ -1630,7 +1737,6 @@ debug_short_backtrace (int length) bt = bt->next; } stderr_out ("]\n"); - fflush (stderr); } #endif /* debugging kludge */ diff --git a/src/process-nt.c b/src/process-nt.c index f7ab6a5..8450fbc 100644 --- a/src/process-nt.c +++ b/src/process-nt.c @@ -2,7 +2,7 @@ Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 1996 Ben Wing. + Copyright (C) 1995, 1996, 2000 Ben Wing. This file is part of XEmacs. @@ -26,15 +26,15 @@ Boston, MA 02111-1307, USA. */ #include #include "lisp.h" +#include "console-msw.h" #include "hash.h" #include "lstream.h" #include "process.h" #include "procimpl.h" #include "sysdep.h" -#ifndef __MINGW32__ #include -#else +#ifdef __MINGW32__ #include #endif #include @@ -52,9 +52,22 @@ Lisp_Object Qnt_quote_process_args; struct nt_process_data { HANDLE h_process; + DWORD dwProcessId; + HWND hwnd; /* console window */ int need_enable_child_signals; }; +/* Control whether create_child causes the process to inherit Emacs' + console window, or be given a new one of its own. The default is + nil, to allow multiple DOS programs to run on Win95. Having separate + consoles also allows Emacs to cleanly terminate process groups. */ +Lisp_Object Vmswindows_start_process_share_console; + +/* Control whether create_child cause the process to inherit Emacs' + error mode setting. The default is t, to minimize the possibility of + subprocesses blocking when accessing unmounted drives. */ +Lisp_Object Vmswindows_start_process_inherit_error_mode; + #define NT_DATA(p) ((struct nt_process_data*)((p)->process_data)) /*-----------------------------------------------------------------------*/ @@ -68,6 +81,21 @@ get_nt_process_handle (Lisp_Process *p) { return (NT_DATA (p)->h_process); } + +static struct Lisp_Process * +find_process_from_pid (DWORD pid) +{ + Lisp_Object tail, proc; + + for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) + { + proc = XCAR (tail); + if (NT_DATA (XPROCESS (proc))->dwProcessId == pid) + return XPROCESS (proc); + } + return 0; +} + /*-----------------------------------------------------------------------*/ /* Running remote threads. See Microsoft Systems Journal 1994 Number 5 */ @@ -224,6 +252,8 @@ run_in_other_process (HANDLE h_process, /* Sending signals */ /*-----------------------------------------------------------------------*/ +/* ---------------------------- the NT way ------------------------------- */ + /* * We handle the following signals: * @@ -287,19 +317,34 @@ sig_enable_proc (sig_enable_data* data) * Return nonzero if successful. */ -/* This code assigns a return value of GetProcAddress to function pointers - of many different types. Instead of heavy obscure casts, we just disable - warnings about assignments to different function pointer types. */ -#pragma warning (disable : 4113) - static int -send_signal (HANDLE h_process, int signo) +send_signal_the_nt_way (struct nt_process_data *cp, int pid, int signo) { + HANDLE h_process; HMODULE h_kernel = GetModuleHandle ("kernel32"); + int close_process = 0; DWORD retval; assert (h_kernel != NULL); + if (cp) + { + pid = cp->dwProcessId; + h_process = cp->h_process; + } + else + { + close_process = 1; + /* Try to open the process with required privileges */ + h_process = OpenProcess (PROCESS_CREATE_THREAD + | PROCESS_QUERY_INFORMATION + | PROCESS_VM_OPERATION + | PROCESS_VM_WRITE, + FALSE, pid); + if (!h_process) + return 0; + } + switch (signo) { case SIGKILL: @@ -308,7 +353,9 @@ send_signal (HANDLE h_process, int signo) case SIGHUP: { sigkill_data d; - d.adr_ExitProcess = GetProcAddress (h_kernel, "ExitProcess"); + + d.adr_ExitProcess = + (void (WINAPI *) (UINT)) GetProcAddress (h_kernel, "ExitProcess"); assert (d.adr_ExitProcess); retval = run_in_other_process (h_process, (LPTHREAD_START_ROUTINE)sigkill_proc, @@ -319,6 +366,7 @@ send_signal (HANDLE h_process, int signo) { sigint_data d; d.adr_GenerateConsoleCtrlEvent = + (BOOL (WINAPI *) (DWORD, DWORD)) GetProcAddress (h_kernel, "GenerateConsoleCtrlEvent"); assert (d.adr_GenerateConsoleCtrlEvent); d.event = CTRL_C_EVENT; @@ -331,6 +379,8 @@ send_signal (HANDLE h_process, int signo) assert (0); } + if (close_process) + CloseHandle (h_process); return (int)retval > 0 ? 1 : 0; } @@ -345,6 +395,7 @@ enable_child_signals (HANDLE h_process) assert (h_kernel != NULL); d.adr_SetConsoleCtrlHandler = + (BOOL (WINAPI *) (LPVOID, BOOL)) GetProcAddress (h_kernel, "SetConsoleCtrlHandler"); assert (d.adr_SetConsoleCtrlHandler); run_in_other_process (h_process, (LPTHREAD_START_ROUTINE)sig_enable_proc, @@ -353,6 +404,214 @@ enable_child_signals (HANDLE h_process) #pragma warning (default : 4113) +/* ---------------------------- the 95 way ------------------------------- */ + +static BOOL CALLBACK +find_child_console (HWND hwnd, struct nt_process_data *cp) +{ + DWORD thread_id; + DWORD process_id; + + thread_id = GetWindowThreadProcessId (hwnd, &process_id); + if (process_id == cp->dwProcessId) + { + char window_class[32]; + + GetClassName (hwnd, window_class, sizeof (window_class)); + if (strcmp (window_class, + msw_windows9x_p () + ? "tty" + : "ConsoleWindowClass") == 0) + { + cp->hwnd = hwnd; + return FALSE; + } + } + /* keep looking */ + return TRUE; +} + +static int +send_signal_the_95_way (struct nt_process_data *cp, int pid, int signo) +{ + HANDLE h_process; + int close_process = 0; + int rc = 1; + + if (cp) + { + pid = cp->dwProcessId; + h_process = cp->h_process; + + /* Try to locate console window for process. */ + EnumWindows (find_child_console, (LPARAM) cp); + } + else + { + close_process = 1; + /* Try to open the process with required privileges */ + h_process = OpenProcess (PROCESS_TERMINATE, FALSE, pid); + if (!h_process) + return 0; + } + + if (signo == SIGINT) + { + if (NILP (Vmswindows_start_process_share_console) && cp && cp->hwnd) + { + BYTE control_scan_code = (BYTE) MapVirtualKey (VK_CONTROL, 0); + BYTE vk_break_code = VK_CANCEL; + BYTE break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0); + HWND foreground_window; + + if (break_scan_code == 0) + { + /* Fake Ctrl-C if we can't manage Ctrl-Break. */ + vk_break_code = 'C'; + break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0); + } + + foreground_window = GetForegroundWindow (); + if (foreground_window) + { + /* NT 5.0, and apparently also Windows 98, will not allow + a Window to be set to foreground directly without the + user's involvement. The workaround is to attach + ourselves to the thread that owns the foreground + window, since that is the only thread that can set the + foreground window. */ + DWORD foreground_thread, child_thread; + foreground_thread = + GetWindowThreadProcessId (foreground_window, NULL); + if (foreground_thread == GetCurrentThreadId () + || !AttachThreadInput (GetCurrentThreadId (), + foreground_thread, TRUE)) + foreground_thread = 0; + + child_thread = GetWindowThreadProcessId (cp->hwnd, NULL); + if (child_thread == GetCurrentThreadId () + || !AttachThreadInput (GetCurrentThreadId (), + child_thread, TRUE)) + child_thread = 0; + + /* Set the foreground window to the child. */ + if (SetForegroundWindow (cp->hwnd)) + { + /* Generate keystrokes as if user had typed Ctrl-Break or + Ctrl-C. */ + keybd_event (VK_CONTROL, control_scan_code, 0, 0); + keybd_event (vk_break_code, break_scan_code, + (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY), 0); + keybd_event (vk_break_code, break_scan_code, + (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY) + | KEYEVENTF_KEYUP, 0); + keybd_event (VK_CONTROL, control_scan_code, + KEYEVENTF_KEYUP, 0); + + /* Sleep for a bit to give time for Emacs frame to respond + to focus change events (if Emacs was active app). */ + Sleep (100); + + SetForegroundWindow (foreground_window); + } + /* Detach from the foreground and child threads now that + the foreground switching is over. */ + if (foreground_thread) + AttachThreadInput (GetCurrentThreadId (), + foreground_thread, FALSE); + if (child_thread) + AttachThreadInput (GetCurrentThreadId (), + child_thread, FALSE); + } + } + /* Ctrl-Break is NT equivalent of SIGINT. */ + else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid)) + { +#if 0 /* FSF Emacs */ + DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d " + "for pid %lu\n", GetLastError (), pid)); + errno = EINVAL; +#endif + rc = 0; + } + } + else + { + if (NILP (Vmswindows_start_process_share_console) && cp && cp->hwnd) + { +#if 1 + if (msw_windows9x_p ()) + { +/* + Another possibility is to try terminating the VDM out-right by + calling the Shell VxD (id 0x17) V86 interface, function #4 + "SHELL_Destroy_VM", ie. + + mov edx,4 + mov ebx,vm_handle + call shellapi + + First need to determine the current VM handle, and then arrange for + the shellapi call to be made from the system vm (by using + Switch_VM_and_callback). + + Could try to invoke DestroyVM through CallVxD. + +*/ +#if 0 + /* On Win95, posting WM_QUIT causes the 16-bit subsystem + to hang when cmdproxy is used in conjunction with + command.com for an interactive shell. Posting + WM_CLOSE pops up a dialog that, when Yes is selected, + does the same thing. TerminateProcess is also less + than ideal in that subprocesses tend to stick around + until the machine is shutdown, but at least it + doesn't freeze the 16-bit subsystem. */ + PostMessage (cp->hwnd, WM_QUIT, 0xff, 0); +#endif + if (!TerminateProcess (h_process, 0xff)) + { +#if 0 /* FSF Emacs */ + DebPrint (("sys_kill.TerminateProcess returned %d " + "for pid %lu\n", GetLastError (), pid)); + errno = EINVAL; +#endif + rc = 0; + } + } + else +#endif + PostMessage (cp->hwnd, WM_CLOSE, 0, 0); + } + /* Kill the process. On W32 this doesn't kill child processes + so it doesn't work very well for shells which is why it's not + used in every case. */ + else if (!TerminateProcess (h_process, 0xff)) + { +#if 0 /* FSF Emacs */ + DebPrint (("sys_kill.TerminateProcess returned %d " + "for pid %lu\n", GetLastError (), pid)); + errno = EINVAL; +#endif + rc = 0; + } + } + + if (close_process) + CloseHandle (h_process); + + return rc; +} + +/* -------------------------- all-OS functions ---------------------------- */ + +static int +send_signal (struct nt_process_data *cp, int pid, int signo) +{ + return send_signal_the_nt_way (cp, pid, signo) + || send_signal_the_95_way (cp, pid, signo); +} + /* * Signal error if SIGNO is not supported */ @@ -383,8 +642,8 @@ static void nt_finalize_process_data (Lisp_Process *p, int for_disksave) { assert (!for_disksave); - if (NT_DATA(p)->h_process) - CloseHandle (NT_DATA(p)->h_process); + if (NT_DATA (p)->h_process) + CloseHandle (NT_DATA (p)->h_process); } /* @@ -416,6 +675,13 @@ signal_cannot_launch (Lisp_Object image_file, DWORD err) signal_simple_error_2 ("Error starting", image_file, lisp_strerror (errno)); } +static void +ensure_console_window_exists () +{ + if (msw_windows9x_p ()) + msw_hide_console (); +} + static int nt_create_process (Lisp_Process *p, Lisp_Object *argv, int nargv, @@ -595,6 +861,7 @@ nt_create_process (Lisp_Process *p, STARTUPINFO si; PROCESS_INFORMATION pi; DWORD err; + DWORD flags; xzero (si); si.dwFlags = STARTF_USESHOWWINDOW; @@ -607,9 +874,19 @@ nt_create_process (Lisp_Process *p, si.dwFlags |= STARTF_USESTDHANDLES; } - err = (CreateProcess (NULL, command_line, NULL, NULL, TRUE, - CREATE_NEW_CONSOLE | CREATE_NEW_PROCESS_GROUP - | CREATE_SUSPENDED, + flags = CREATE_SUSPENDED; + if (msw_windows9x_p ()) + flags |= (!NILP (Vmswindows_start_process_share_console) + ? CREATE_NEW_PROCESS_GROUP + : CREATE_NEW_CONSOLE); + else + flags |= CREATE_NEW_CONSOLE | CREATE_NEW_PROCESS_GROUP; + if (NILP (Vmswindows_start_process_inherit_error_mode)) + flags |= CREATE_DEFAULT_ERROR_MODE; + + ensure_console_window_exists (); + + err = (CreateProcess (NULL, command_line, NULL, NULL, TRUE, flags, proc_env, (char *) XSTRING_DATA (cur_dir), &si, &pi) ? 0 : GetLastError ()); @@ -636,6 +913,7 @@ nt_create_process (Lisp_Process *p, if (do_io) { NT_DATA(p)->h_process = pi.hProcess; + NT_DATA(p)->dwProcessId = pi.dwProcessId; init_process_io_handles (p, (void*)hmyslurp, (void*)hmyshove, 0); } else @@ -789,18 +1067,18 @@ nt_kill_child_process (Lisp_Object proc, int signo, /* Enable child signals if necessary. This may lose the first but it's better than nothing. */ - if (NT_DATA(p)->need_enable_child_signals > 0) + if (NT_DATA (p)->need_enable_child_signals > 0) { - enable_child_signals(NT_DATA(p)->h_process); - NT_DATA(p)->need_enable_child_signals = 0; + enable_child_signals (NT_DATA(p)->h_process); + NT_DATA (p)->need_enable_child_signals = 0; } /* Signal error if SIGNO cannot be sent */ validate_signal_number (signo); /* Send signal */ - if (!send_signal (NT_DATA(p)->h_process, signo)) - error ("Cannot send signal to process"); + if (!send_signal (NT_DATA (p), 0, signo)) + signal_simple_error ("Cannot send signal to process", proc); } /* @@ -812,26 +1090,13 @@ nt_kill_child_process (Lisp_Object proc, int signo, static int nt_kill_process_by_pid (int pid, int signo) { - HANDLE h_process; - int send_result; - + struct Lisp_Process *p; + /* Signal error if SIGNO cannot be sent */ validate_signal_number (signo); - /* Try to open the process with required privileges */ - h_process = OpenProcess (PROCESS_CREATE_THREAD - | PROCESS_QUERY_INFORMATION - | PROCESS_VM_OPERATION - | PROCESS_VM_WRITE, - FALSE, pid); - if (h_process == NULL) - return -1; - - send_result = send_signal (h_process, signo); - - CloseHandle (h_process); - - return send_result ? 0 : -1; + p = find_process_from_pid (pid); + return send_signal (p ? NT_DATA (p) : 0, pid, signo) ? 0 : -1; } /*-----------------------------------------------------------------------*/ @@ -942,9 +1207,11 @@ nt_canonicalize_host_name (Lisp_Object host) deactivate and close it via delete-process */ static void -nt_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object service, +nt_open_network_stream (Lisp_Object name, Lisp_Object host, + Lisp_Object service, Lisp_Object protocol, void** vinfd, void** voutfd) { + /* !!#### not Mule-ized */ struct sockaddr_in address; SOCKET s; int port; @@ -953,8 +1220,7 @@ nt_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object service, CHECK_STRING (host); if (!EQ (protocol, Qtcp)) - error ("Unsupported protocol \"%s\"", - string_data (symbol_name (XSYMBOL (protocol)))); + signal_simple_error ("Unsupported protocol", protocol); if (INTP (service)) port = htons ((unsigned short) XINT (service)); @@ -964,7 +1230,7 @@ nt_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object service, CHECK_STRING (service); svc_info = getservbyname ((char *) XSTRING_DATA (service), "tcp"); if (svc_info == 0) - error ("Unknown service \"%s\"", XSTRING_DATA (service)); + signal_simple_error ("Unknown service", service); port = svc_info->s_port; } @@ -1026,18 +1292,20 @@ nt_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object service, connect_failed: closesocket (s); - if (INTP (service)) { - warn_when_safe(Qstream, Qwarning, - "failure to open network stream to host \"%s\" for service \"%d\"", - XSTRING_DATA (host), - (unsigned short) XINT (service)); - } - else { - warn_when_safe(Qstream, Qwarning, - "failure to open network stream to host \"%s\" for service \"%s\"", - XSTRING_DATA (host), - XSTRING_DATA (service)); - } + if (INTP (service)) + { + warn_when_safe (Qstream, Qwarning, + "failure to open network stream to host \"%s\" for service \"%d\"", + XSTRING_DATA (host), + (unsigned short) XINT (service)); + } + else + { + warn_when_safe (Qstream, Qwarning, + "failure to open network stream to host \"%s\" for service \"%s\"", + XSTRING_DATA (host), + XSTRING_DATA (service)); + } report_file_error ("connection failed", list2 (host, name)); } @@ -1077,4 +1345,22 @@ syms_of_process_nt (void) void vars_of_process_nt (void) { + DEFVAR_LISP ("mswindows-start-process-share-console", + &Vmswindows_start_process_share_console /* +When nil, new child processes are given a new console. +When non-nil, they share the Emacs console; this has the limitation of +allowing only only DOS subprocess to run at a time (whether started directly +or indirectly by Emacs), and preventing Emacs from cleanly terminating the +subprocess group, but may allow Emacs to interrupt a subprocess that doesn't +otherwise respond to interrupts from Emacs. +*/ ); + Vmswindows_start_process_share_console = Qnil; + + DEFVAR_LISP ("mswindows-start-process-inherit-error-mode", + &Vmswindows_start_process_inherit_error_mode /* + "When nil, new child processes revert to the default error mode. +When non-nil, they inherit their error mode setting from Emacs, which stops +them blocking when trying to access unmounted drives etc. +*/ ); + Vmswindows_start_process_inherit_error_mode = Qt; } diff --git a/src/process-unix.c b/src/process-unix.c index c4f8bbd..c9ac0a1 100644 --- a/src/process-unix.c +++ b/src/process-unix.c @@ -1765,7 +1765,7 @@ unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object servic #ifdef HAVE_MULTICAST -/* Didier Verna Nov. 28 1997. +/* Didier Verna Nov. 28 1997. This function is similar to open-network-stream-internal, but provides a mean to open an UDP multicast connection instead of a TCP one. Like in the diff --git a/src/process.h b/src/process.h index 8e230cf..bb4f682 100644 --- a/src/process.h +++ b/src/process.h @@ -37,7 +37,8 @@ void wait_without_blocking (void); #else /* not NO_SUBPROCESSES */ -/* Only process.c needs to know about the guts of this */ +/* struct Lisp_Process is defined in procimpl.h; only process-*.c need + to know about the guts of it. */ DECLARE_LRECORD (process, Lisp_Process); #define XPROCESS(x) XRECORD (x, process, Lisp_Process) diff --git a/src/s/cygwin32.h b/src/s/cygwin32.h index d108923..937adab 100644 --- a/src/s/cygwin32.h +++ b/src/s/cygwin32.h @@ -42,26 +42,26 @@ Boston, MA 02111-1307, USA. */ /* cheesy way to determine cygwin version */ #ifndef NOT_C_CODE -#include -#ifdef HAVE_CYGWIN_VERSION_H -#include -#else -#ifdef SIGIO -#define CYGWIN_VERSION_DLL_MAJOR 19 -#define CYGWIN_VERSION_DLL_MINOR 0 -#define CYGWIN_B19 -#else -#define CYGWIN_VERSION_DLL_MAJOR 18 -#define CYGWIN_VERSION_DLL_MINOR 0 -#define BROKEN_CYGWIN -#endif -#endif +# include +# ifdef HAVE_CYGWIN_VERSION_H +# include +# else +# ifdef SIGIO +# define CYGWIN_VERSION_DLL_MAJOR 19 +# define CYGWIN_VERSION_DLL_MINOR 0 +# define CYGWIN_B19 +# else +# define CYGWIN_VERSION_DLL_MAJOR 18 +# define CYGWIN_VERSION_DLL_MINOR 0 +# define BROKEN_CYGWIN +# endif +# endif extern void cygwin32_win32_to_posix_path_list(const char*, char*); extern int cygwin32_win32_to_posix_path_list_buf_size(const char*); extern void cygwin32_posix_to_win32_path_list(const char*, char*); extern int cygwin32_posix_to_win32_path_list_buf_size(const char*); -#if CYGWIN_VERSION_DLL_MAJOR < 20 +# if CYGWIN_VERSION_DLL_MAJOR < 20 struct timeval; struct timezone; struct itimerval; @@ -85,28 +85,27 @@ extern int utimes(char *file, struct timeval *tvp); extern int srandom( unsigned seed); extern long random(); -#define SND_ASYNC 1 -#define SND_NODEFAULT 2 -#define SND_MEMORY 4 -#define SND_FILENAME 0x2000L -#define VK_APPS 0x5D -#define SIF_TRACKPOS 0x0010 -#define ICC_BAR_CLASSES 4 -#define FW_BLACK FW_HEAVY -#define FW_ULTRABOLD FW_EXTRABOLD -#define FW_DEMIBOLD FW_SEMIBOLD -#define FW_ULTRALIGHT FW_EXTRALIGHT -#define APPCMD_FILTERINITS 0x20L -#define CBF_FAIL_SELFCONNECTIONS 0x1000 -#define CBF_SKIP_ALLNOTIFICATIONS 0x3C0000 -#define CBF_FAIL_ADVISES 0x4000 -#define CBF_FAIL_POKES 0x10000 -#define CBF_FAIL_REQUESTS 0x20000 -#define SZDDESYS_TOPIC "System" -#define JOHAB_CHARSET 130 -#define MAC_CHARSET 77 - -#endif +# define SND_ASYNC 1 +# define SND_NODEFAULT 2 +# define SND_MEMORY 4 +# define SND_FILENAME 0x2000L +# define VK_APPS 0x5D +# define SIF_TRACKPOS 0x0010 +# define ICC_BAR_CLASSES 4 +# define FW_BLACK FW_HEAVY +# define FW_ULTRABOLD FW_EXTRABOLD +# define FW_DEMIBOLD FW_SEMIBOLD +# define FW_ULTRALIGHT FW_EXTRALIGHT +# define APPCMD_FILTERINITS 0x20L +# define CBF_FAIL_SELFCONNECTIONS 0x1000 +# define CBF_SKIP_ALLNOTIFICATIONS 0x3C0000 +# define CBF_FAIL_ADVISES 0x4000 +# define CBF_FAIL_POKES 0x10000 +# define CBF_FAIL_REQUESTS 0x20000 +# define SZDDESYS_TOPIC "System" +# define JOHAB_CHARSET 130 +# define MAC_CHARSET 77 +# endif #endif #ifndef SPI_GETWHEELSCROLLLINES @@ -160,6 +159,7 @@ extern long random(); #define TEXT_END -1 #define DATA_END -1 #define HEAP_IN_DATA +#define NO_LIM_DATA #define UNEXEC "unexcw.o" #ifdef CYGWIN_VERSION_DLL_MAJOR diff --git a/src/s/windowsnt.h b/src/s/windowsnt.h index 33d49a4..ed8b98a 100644 --- a/src/s/windowsnt.h +++ b/src/s/windowsnt.h @@ -58,7 +58,7 @@ typedef int pid_t; #define SIZEOF_SHORT 2 #define SIZEOF_INT 4 #define SIZEOF_LONG 4 -#define SIZEOF_LONG_LONG 8 +#define SIZEOF_LONG_LONG 0 #define SIZEOF_VOID_P 4 /* NOMULTIPLEJOBS should be defined if your system's shell diff --git a/src/scrollbar.c b/src/scrollbar.c index 7f586b4..18360c0 100644 --- a/src/scrollbar.c +++ b/src/scrollbar.c @@ -460,14 +460,10 @@ update_scrollbar_instance (struct window *w, int vertical, if (!NILP (w->scrollbar_on_left_p)) { x_offset = WINDOW_LEFT (w); - if (window_is_leftmost (w)) - x_offset += FRAME_LEFT_GUTTER_BOUNDS (f); } else { x_offset = WINDOW_RIGHT (w) - scrollbar_width; - if (window_is_rightmost (w)) - x_offset -= FRAME_RIGHT_GUTTER_BOUNDS (f); if (window_needs_vertical_divider (w)) x_offset -= window_divider_width (w); } @@ -481,8 +477,6 @@ update_scrollbar_instance (struct window *w, int vertical, if (!NILP (w->scrollbar_on_top_p)) { y_offset += WINDOW_TOP (w); - if (window_is_highest (w)) - y_offset += FRAME_TOP_GUTTER_BOUNDS (f); } else { diff --git a/src/select-msw.c b/src/select-msw.c index f72a46c..7d11bd9 100644 --- a/src/select-msw.c +++ b/src/select-msw.c @@ -34,175 +34,178 @@ Boston, MA 02111-1307, USA. */ #include "console-msw.h" -DEFUN ("mswindows-set-clipboard", Fmswindows_set_clipboard, 1, 1, 0, /* -Copy STRING to the mswindows clipboard. -*/ - (string)) -{ - int rawsize, size, i; - unsigned char *src, *dst, *next; - HGLOBAL h = NULL; - struct frame *f = NULL; - - CHECK_STRING (string); - - /* Calculate size with LFs converted to CRLFs because - * CF_TEXT format uses CRLF delimited ASCIIZ */ - src = XSTRING_DATA (string); - size = rawsize = XSTRING_LENGTH (string) + 1; - for (i=0; icaching->offset_into_struct_window); + /* #### What's the point of this check, other than to optimize image + instance instantiation? Unless you specify a caching instantiate + method the instantiation that specifier_instance will do will + always create a new copy. Thus EQ will always fail. Unfortunately + calling equal is no good either as this doesn't take into account + things attached to the specifier - for instance strings on + extents. --andyp */ if (!EQ (newval, *location)) { Lisp_Object oldval = *location; diff --git a/src/specifier.h b/src/specifier.h index bb6472d..17461cb 100644 --- a/src/specifier.h +++ b/src/specifier.h @@ -267,9 +267,9 @@ extern const struct lrecord_description specifier_empty_extra_description[]; #ifdef ERROR_CHECK_TYPECHECK #define DECLARE_SPECIFIER_TYPE(type) \ extern struct specifier_methods * type##_specifier_methods; \ -INLINE struct type##_specifier * \ +INLINE_HEADER struct type##_specifier * \ error_check_##type##_specifier_data (Lisp_Specifier *sp); \ -INLINE struct type##_specifier * \ +INLINE_HEADER struct type##_specifier * \ error_check_##type##_specifier_data (Lisp_Specifier *sp) \ { \ if (SPECIFIERP (sp->magic_parent)) \ @@ -282,9 +282,9 @@ error_check_##type##_specifier_data (Lisp_Specifier *sp) \ assert (SPECIFIER_TYPE_P (sp, type)); \ return (struct type##_specifier *) sp->data; \ } \ -INLINE Lisp_Specifier * \ +INLINE_HEADER Lisp_Specifier * \ error_check_##type##_specifier_type (Lisp_Object obj); \ -INLINE Lisp_Specifier * \ +INLINE_HEADER Lisp_Specifier * \ error_check_##type##_specifier_type (Lisp_Object obj) \ { \ Lisp_Specifier *sp = XSPECIFIER (obj); \ @@ -293,11 +293,11 @@ error_check_##type##_specifier_type (Lisp_Object obj) \ } \ DECLARE_NOTHING #else -#define DECLARE_SPECIFIER_TYPE(type) \ +#define DECLARE_SPECIFIER_TYPE(type) \ extern struct specifier_methods * type##_specifier_methods #endif /* ERROR_CHECK_TYPECHECK */ -#define DEFINE_SPECIFIER_TYPE(type) \ +#define DEFINE_SPECIFIER_TYPE(type) \ struct specifier_methods * type##_specifier_methods #define INITIALIZE_SPECIFIER_TYPE(type, obj_name, pred_sym) do { \ @@ -305,12 +305,12 @@ struct specifier_methods * type##_specifier_methods type##_specifier_methods->name = obj_name; \ type##_specifier_methods->extra_description = \ specifier_empty_extra_description; \ - defsymbol_nodump (&type##_specifier_methods->predicate_symbol, pred_sym); \ - add_entry_to_specifier_type_list (Q##type, type##_specifier_methods); \ - dumpstruct (&type##_specifier_methods, &specifier_methods_description); \ + defsymbol_nodump (&type##_specifier_methods->predicate_symbol, pred_sym); \ + add_entry_to_specifier_type_list (Q##type, type##_specifier_methods); \ + dumpstruct (&type##_specifier_methods, &specifier_methods_description); \ } while (0) -#define REINITIALIZE_SPECIFIER_TYPE(type) do { \ +#define REINITIALIZE_SPECIFIER_TYPE(type) do { \ staticpro_nodump (&type##_specifier_methods->predicate_symbol); \ } while (0) @@ -366,7 +366,7 @@ do { \ # define XSETSPECIFIER_TYPE(x, p, type) XSETSPECIFIER (x, p) #endif /* ERROR_CHECK_TYPE_CHECK */ -#define SPECIFIER_TYPEP(x, type) \ +#define SPECIFIER_TYPEP(x, type) \ (SPECIFIERP (x) && SPECIFIER_TYPE_P (XSPECIFIER (x), type)) #define CHECK_SPECIFIER_TYPE(x, type) do { \ CHECK_SPECIFIER (x); \ diff --git a/src/sysdep.c b/src/sysdep.c index fbf71ac..f3aa717 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -93,6 +93,11 @@ Boston, MA 02111-1307, USA. */ #include "ntheap.h" #endif +#ifdef HAVE_MMAP +#include +#include +#endif + /* ------------------------------- */ /* TTY definitions */ /* ------------------------------- */ @@ -612,20 +617,20 @@ restore_signal_handlers (struct save_signal *saved_handlers) } #ifdef WINDOWSNT + pid_t sys_getpid (void) { return abs (getpid ()); } + #endif /* WINDOWSNT */ /* Fork a subshell. */ static void sys_subshell (void) { -#ifdef WINDOWSNT - HANDLE pid; -#else +#ifndef WINDOWSNT int pid; #endif struct save_signal saved_handlers[5]; @@ -660,21 +665,17 @@ sys_subshell (void) str = (unsigned char *) alloca (XSTRING_LENGTH (dir) + 2); len = XSTRING_LENGTH (dir); memcpy (str, XSTRING_DATA (dir), len); - /* #### Unix specific */ - if (str[len - 1] != '/') str[len++] = '/'; + if (!IS_ANY_SEP (str[len - 1])) + str[len++] = DIRECTORY_SEP; str[len] = 0; xyzzy: -#ifdef WINDOWSNT - pid = NULL; -#else /* not WINDOWSNT */ - +#ifndef WINDOWSNT pid = fork (); if (pid == -1) error ("Can't spawn subshell"); if (pid == 0) - #endif /* not WINDOWSNT */ { char *sh = 0; @@ -688,7 +689,18 @@ sys_subshell (void) if (str) sys_chdir (str); -#if !defined (NO_SUBPROCESSES) && !defined (WINDOWSNT) +#ifdef WINDOWSNT + + /* Waits for process completion */ + if (_spawnlp (_P_WAIT, sh, sh, NULL) != 0) + error ("Can't spawn subshell"); + else + return; /* we're done, no need to wait for termination */ + } + +#else + +#if !defined (NO_SUBPROCESSES) close_process_descs (); /* Close Emacs's pipes/ptys */ #endif @@ -697,23 +709,18 @@ sys_subshell (void) nice (-emacs_priority); /* Give the new shell the default priority */ #endif -#ifdef WINDOWSNT - /* Waits for process completion */ - pid = (HANDLE) _spawnlp (_P_WAIT, sh, sh, NULL); - if (pid == NULL) - write (1, "Can't execute subshell", 22); - -#else /* not WINDOWSNT */ execlp (sh, sh, 0); write (1, "Can't execute subshell", 22); _exit (1); -#endif /* not WINDOWSNT */ } save_signal_handlers (saved_handlers); synch_process_alive = 1; wait_for_termination (pid); restore_signal_handlers (saved_handlers); + +#endif /* not WINDOWSNT */ + } #endif /* !defined (SIGTSTP) && !defined (USG_JOBCTRL) */ @@ -2191,7 +2198,7 @@ start_of_text (void) * */ -#ifdef ORDINARY_LINK +#if defined(ORDINARY_LINK) && !defined(__MINGW32__) extern char **environ; #endif @@ -2208,7 +2215,7 @@ start_of_data (void) * is known to live at or near the start of the system crt0.c, and * we don't sweat the handful of bytes that might lose. */ -#ifdef HEAP_IN_DATA +#if defined (HEAP_IN_DATA) && !defined(PDUMP) extern char* static_heap_base; if (!initialized) return static_heap_base; diff --git a/src/sysdep.h b/src/sysdep.h index 2911014..c5476de 100644 --- a/src/sysdep.h +++ b/src/sysdep.h @@ -29,6 +29,10 @@ Boston, MA 02111-1307, USA. */ extern char **environ; #endif +#ifdef PDUMP +int pdump_read_file (char **pdump_start_pos, size_t *pdump_length); +#endif + int eight_bit_tty (struct device *d); void stuff_char (struct console *con, int c); diff --git a/src/sysfile.h b/src/sysfile.h index 69179b7..f573ce3 100644 --- a/src/sysfile.h +++ b/src/sysfile.h @@ -24,6 +24,7 @@ Boston, MA 02111-1307, USA. */ #define INCLUDED_sysfile_h_ #include +#include #ifndef WINDOWSNT #include /* does not always imply this */ @@ -206,10 +207,21 @@ Boston, MA 02111-1307, USA. */ #define S_ISNWK(m) (((m) & S_IFMT) == S_IFNWK) #endif +/* Client .c files should simply use `PATH_MAX'. */ +#ifndef PATH_MAX +# if defined (_POSIX_PATH_MAX) +# define PATH_MAX _POSIX_PATH_MAX +# elif defined (MAXPATHLEN) +# define PATH_MAX MAXPATHLEN +# else +# define PATH_MAX 1024 +# endif +#endif + +/* MAXPATHLEN is deprecated, but, as of this writing, still used. */ #ifndef MAXPATHLEN -/* in 4.1, param.h fails to define this. */ -#define MAXPATHLEN 1024 -#endif /* not MAXPATHLEN */ +# define MAXPATHLEN 1024 +#endif #ifndef X_OK # define X_OK 01 diff --git a/src/window.c b/src/window.c index 7f84aa0..473c778 100644 --- a/src/window.c +++ b/src/window.c @@ -290,6 +290,11 @@ allocate_window (void) INIT_DISP_VARIABLE (window_end_pos, 0); p->redisplay_end_trigger = Qnil; + p->gutter_extent_modiff[0] = 0; + p->gutter_extent_modiff[1] = 0; + p->gutter_extent_modiff[2] = 0; + p->gutter_extent_modiff[3] = 0; + #define WINDOW_SLOT(slot, compare) p->slot = Qnil #include "winslots.h" @@ -1010,31 +1015,35 @@ window_right_margin_width (struct window *w) relative to the frame, not the window. ****************************************************************************/ -int -window_top_gutter_height (struct window *w) +static int +window_top_window_gutter_height (struct window *w) { - int gutter = WINDOW_REAL_TOP_GUTTER_BOUNDS (w); - if (!NILP (w->hchild) || !NILP (w->vchild)) return 0; - + #ifdef HAVE_SCROLLBARS if (!NILP (w->scrollbar_on_top_p)) - return window_scrollbar_height (w) + gutter; + return window_scrollbar_height (w); else #endif - return gutter; + return 0; } int -window_bottom_gutter_height (struct window *w) +window_top_gutter_height (struct window *w) +{ + return window_top_window_gutter_height (w); +} + +static int +window_bottom_window_gutter_height (struct window *w) { - int gutter = WINDOW_REAL_BOTTOM_GUTTER_BOUNDS (w); + int gutter; if (!NILP (w->hchild) || !NILP (w->vchild)) return 0; - gutter += window_modeline_height (w); + gutter = window_modeline_height (w); #ifdef HAVE_SCROLLBARS if (NILP (w->scrollbar_on_top_p)) @@ -1045,25 +1054,35 @@ window_bottom_gutter_height (struct window *w) } int -window_left_gutter_width (struct window *w, int modeline) +window_bottom_gutter_height (struct window *w) { - int gutter = WINDOW_REAL_LEFT_GUTTER_BOUNDS (w); + return window_bottom_window_gutter_height (w); +} +static int +window_left_window_gutter_width (struct window *w, int modeline) +{ if (!NILP (w->hchild) || !NILP (w->vchild)) return 0; #ifdef HAVE_SCROLLBARS if (!modeline && !NILP (w->scrollbar_on_left_p)) - gutter += window_scrollbar_width (w); + return window_scrollbar_width (w); #endif - return gutter; + return 0; } int -window_right_gutter_width (struct window *w, int modeline) +window_left_gutter_width (struct window *w, int modeline) +{ + return window_left_window_gutter_width (w, modeline); +} + +static int +window_right_window_gutter_width (struct window *w, int modeline) { - int gutter = WINDOW_REAL_RIGHT_GUTTER_BOUNDS (w); + int gutter = 0; if (!NILP (w->hchild) || !NILP (w->vchild)) return 0; @@ -1079,6 +1098,18 @@ window_right_gutter_width (struct window *w, int modeline) return gutter; } +int +window_right_gutter_width (struct window *w, int modeline) +{ + return window_right_window_gutter_width (w, modeline); +} + +static int +window_pixel_height (struct window* w) +{ + return WINDOW_HEIGHT (w); +} + DEFUN ("windowp", Fwindowp, 1, 1, 0, /* Return t if OBJ is a window. @@ -1294,6 +1325,22 @@ be different. Use `window-height' to get consistent results in geometry calculations. Use `window-displayed-height' to get the actual number of lines currently displayed in a window. + +The names are somewhat confusing; here's a table to help out: + + width height +------------------------------------------------------------------------- +w/o gutters + (rows/columns) window-width window-text-area-height + (pixels) window-text-area-pixel-width window-text-area-pixel-height + +with gutters + (rows/columns) window-full-width window-height + (pixels) window-pixel-width window-pixel-height + +actually displayed + (rows/columns) ---- window-displayed-height + (pixels) ---- window-displayed-text-pixel-height */ (window)) { @@ -1320,7 +1367,20 @@ This includes the window's modeline and horizontal scrollbar (if any). */ (window)) { - return make_int (decode_window (window)->pixel_height); + return make_int (window_pixel_height (decode_window (window))); +} + +DEFUN ("window-text-area-height", Fwindow_text_area_height, 0, 1, 0, /* +Return the number of default lines in the text area of WINDOW. +This actually works by dividing the window's text area pixel height (i.e. +excluding the modeline and horizontal scrollbar, if any) by the height of the +default font; therefore, the number of displayed lines will probably +be different. +See also `window-height' and `window-displayed-height'. +*/ + (window)) +{ + return make_int (window_char_height (decode_window (window), 0)); } DEFUN ("window-text-area-pixel-height", @@ -1401,13 +1461,25 @@ is non-nil, do not include space occupied by clipped lines. DEFUN ("window-width", Fwindow_width, 0, 1, 0, /* Return the number of display columns in WINDOW. -This is the width that is usable columns available for text in WINDOW. +This is the width that is usable columns available for text in WINDOW, +and does not include vertical scrollbars, dividers, or the like. See also +`window-full-width' and `window-height'. */ (window)) { return make_int (window_char_width (decode_window (window), 0)); } +DEFUN ("window-full-width", Fwindow_full_width, 0, 1, 0, /* +Return the total number of columns in WINDOW. +This is like `window-width' but includes vertical scrollbars, dividers, +etc. +*/ + (window)) +{ + return make_int (window_char_width (decode_window (window), 1)); +} + DEFUN ("window-pixel-width", Fwindow_pixel_width, 0, 1, 0, /* Return the width of WINDOW in pixels. Defaults to current window. */ @@ -1526,15 +1598,14 @@ Afterwards the end-trigger value is reset to nil. DEFUN ("window-pixel-edges", Fwindow_pixel_edges, 0, 1, 0, /* Return a list of the pixel edge coordinates of WINDOW. \(LEFT TOP RIGHT BOTTOM), all relative to 0, 0 at top left corner of frame. -The frame toolbars and menubars are considered to be outside of this area. +The frame toolbars, menubars and gutters are considered to be outside of this area. */ (window)) { struct window *w = decode_window (window); - struct frame *f = XFRAME (w->frame); - int left = w->pixel_left - FRAME_LEFT_BORDER_END (f); - int top = w->pixel_top - FRAME_TOP_BORDER_END (f); + int left = w->pixel_left; + int top = w->pixel_top; return list4 (make_int (left), make_int (top), @@ -3277,8 +3348,9 @@ global or per-frame buffer ordering. /* we have already caught dead-window errors */ if (!NILP (w->hchild) || !NILP (w->vchild)) error ("Trying to select non-leaf window"); - + w->use_time = make_int (++window_select_count); + if (EQ (window, old_selected_window)) return window; @@ -3402,6 +3474,10 @@ make_dummy_parent (Lisp_Object window) p->line_start_cache = Dynarr_new (line_start_cache); p->face_cachels = Dynarr_new (face_cachel); p->glyph_cachels = Dynarr_new (glyph_cachel); + p->subwindow_instance_cache = + make_lisp_hash_table (10, + HASH_TABLE_KEY_WEAK, + HASH_TABLE_EQ); /* Put new into window structure in place of window */ replace_window (window, new); @@ -3617,12 +3693,6 @@ selected window. } static int -window_pixel_height (Lisp_Object window) -{ - return WINDOW_HEIGHT (XWINDOW (window)); -} - -static int window_pixel_height_to_char_height (struct window *w, int pixel_height, int include_gutters_p) { @@ -3635,8 +3705,8 @@ window_pixel_height_to_char_height (struct window *w, int pixel_height, avail_height = (pixel_height - (include_gutters_p ? 0 : - window_top_gutter_height (w) + - window_bottom_gutter_height (w))); + window_top_window_gutter_height (w) + + window_bottom_window_gutter_height (w))); default_face_height_and_width (window, &defheight, &defwidth); @@ -3667,8 +3737,8 @@ window_char_height_to_pixel_height (struct window *w, int char_height, avail_height = char_height * defheight; pixel_height = (avail_height + (include_gutters_p ? 0 : - window_top_gutter_height (w) + - window_bottom_gutter_height (w))); + window_top_window_gutter_height (w) + + window_bottom_window_gutter_height (w))); /* It's the calling function's responsibility to check these values and make sure they're not out of range. @@ -3681,11 +3751,12 @@ window_char_height_to_pixel_height (struct window *w, int char_height, /* Return number of default lines of text can fit in the window W. If INCLUDE_GUTTERS_P is 1, include "gutter" space (modeline plus horizontal scrollbar) in the space that is used for the calculation. + This doesn't include space used by the frame gutters. */ int window_char_height (struct window *w, int include_gutters_p) { - return window_pixel_height_to_char_height (w, WINDOW_HEIGHT (w), + return window_pixel_height_to_char_height (w, window_pixel_height (w), include_gutters_p); } @@ -3765,6 +3836,8 @@ window_pixel_width (Lisp_Object window) return WINDOW_WIDTH (XWINDOW (window)); } +/* Calculate the pixel of a window, optionally including margin space + but no vertical gutters. */ static int window_pixel_width_to_char_width (struct window *w, int pixel_width, int include_margins_p) @@ -3809,8 +3882,8 @@ window_char_width_to_pixel_width (struct window *w, int char_width, avail_width = char_width * defwidth; pixel_width = (avail_width + - window_left_gutter_width (w, 0) + - window_right_gutter_width (w, 0) + + window_left_window_gutter_width (w, 0) + + window_right_window_gutter_width (w, 0) + (include_margins_p ? 0 : window_left_margin_width (w)) + (include_margins_p ? 0 : window_right_margin_width (w))); @@ -3849,6 +3922,12 @@ window_char_width (struct window *w, int include_margins_p) (widthflag ? window_min_width : MINI_WINDOW_P (XWINDOW (window)) \ ? 1 : window_min_height) +static int +window_pixheight (Lisp_Object w) +{ + return window_pixel_height (XWINDOW (w)); +} + /* Unlike set_window_pixheight, this function also changes the heights of the siblings so as to keep everything consistent. */ @@ -3864,7 +3943,7 @@ change_window_height (struct window *win, int delta, int widthflag, int *sizep; int (*sizefun) (Lisp_Object) = (widthflag ? window_pixel_width - : window_pixel_height); + : window_pixheight); void (*setsizefun) (Lisp_Object, int, int) = (widthflag ? set_window_pixwidth : set_window_pixheight); @@ -5102,7 +5181,7 @@ by `current-window-configuration' (which see). frame "sizes" maybe equal but the windows still should be resized. This is tickled alot by the new "character size stays constant" policy in 21.0. It leads to very wierd - glitches (and possibly craches when asserts are tickled). + glitches (and possibly crashes when asserts are tickled). Just changing the units doens't help because changing the toolbar configuration can also change the pixel positions. @@ -5175,6 +5254,10 @@ by `current-window-configuration' (which see). w->glyph_cachels = Dynarr_new (glyph_cachel); if (!w->line_start_cache) w->line_start_cache = Dynarr_new (line_start_cache); + w->gutter_extent_modiff[0] = 0; + w->gutter_extent_modiff[1] = 0; + w->gutter_extent_modiff[2] = 0; + w->gutter_extent_modiff[3] = 0; w->dead = 0; if (p->parent_index >= 0) @@ -5374,6 +5457,7 @@ by `current-window-configuration' (which see). the restored current_window. */ if (f == selected_frame ()) { +#if 0 /* When using `pop-window-configuration', often the minibuffer ends up as the selected window even though it's not active ... I really don't know the cause of this, but it should never @@ -5382,15 +5466,25 @@ by `current-window-configuration' (which see). #### Find out why this is really going wrong. */ if (!minibuf_level && MINI_WINDOW_P (XWINDOW (config->current_window))) - Fselect_window (Fnext_window (config->current_window, - Qnil, Qnil, Qnil), - Qnil); + window_to_select = Fnext_window (config->current_window, + Qnil, Qnil, Qnil); else - Fselect_window (config->current_window, Qnil); + window_to_select = config->current_window; +#endif + /* Do this last so that buffer stacking is calculated + correctly. */ + Fselect_window (config->current_window, Qnil); + if (!NILP (new_current_buffer)) - Fset_buffer (new_current_buffer); + { + Fset_buffer (new_current_buffer); + Frecord_buffer (new_current_buffer); + } else - Fset_buffer (XWINDOW (Fselected_window (Qnil))->buffer); + { + Fset_buffer (XWINDOW (config->current_window)->buffer); + Frecord_buffer (XWINDOW (config->current_window)->buffer); + } } else set_frame_selected_window (f, config->current_window); @@ -5599,7 +5693,14 @@ its value is -not- saved. /* config->frame_width = FRAME_WIDTH (f); config->frame_height = FRAME_HEIGHT (f); */ - config->current_window = FRAME_SELECTED_WINDOW (f); + /* When using `push-window-configuration', often the minibuffer ends + up as the selected window because functions run as the result of + user interaction e.g. hyper-apropros. It seems to me the sensible + thing to do is not record the minibuffer here. */ + if (FRAME_MINIBUF_ONLY_P (f) || minibuf_level) + config->current_window = FRAME_SELECTED_WINDOW (f); + else + config->current_window = FRAME_LAST_NONMINIBUF_WINDOW (f); XSETBUFFER (config->current_buffer, current_buffer); config->minibuffer_scroll_window = Vminibuffer_scroll_window; config->root_window = FRAME_ROOT_WINDOW (f); @@ -5739,15 +5840,15 @@ debug_print_window (Lisp_Object window, int level) child = Fwindow_first_hchild (window); for (i = level; i > 0; i--) - putc ('\t', stderr); + stderr_out ("\t"); - fputs ("#buffer; if (!NILP (buffer) && BUFFERP (buffer)) - fprintf (stderr, " on %s", XSTRING_DATA (XBUFFER (buffer)->name)); + stderr_out (" on %s", XSTRING_DATA (XBUFFER (buffer)->name)); } - fprintf (stderr, " 0x%x>", XWINDOW (window)->header.uid); + stderr_out (" 0x%x>", XWINDOW (window)->header.uid); while (!NILP (child)) { @@ -5815,8 +5916,10 @@ syms_of_window (void) DEFSUBR (Fwindow_height); DEFSUBR (Fwindow_displayed_height); DEFSUBR (Fwindow_width); + DEFSUBR (Fwindow_full_width); DEFSUBR (Fwindow_pixel_height); DEFSUBR (Fwindow_pixel_width); + DEFSUBR (Fwindow_text_area_height); DEFSUBR (Fwindow_text_area_pixel_height); DEFSUBR (Fwindow_displayed_text_pixel_height); DEFSUBR (Fwindow_text_area_pixel_width); diff --git a/src/window.h b/src/window.h index d228076..8144a47 100644 --- a/src/window.h +++ b/src/window.h @@ -184,6 +184,9 @@ struct window must run the redisplay-end-trigger-functions. */ Lisp_Object redisplay_end_trigger; + /* Set by the extent code when extents in the gutter are changed. */ + int gutter_extent_modiff[4]; + /* Set by redisplay to the last position seen. This is used to implement the redisplay-end-trigger-functions. */ Bufpos last_redisplay_pos; diff --git a/src/winslots.h b/src/winslots.h index 95d74b5..c97390f 100644 --- a/src/winslots.h +++ b/src/winslots.h @@ -102,6 +102,10 @@ Boston, MA 02111-1307, USA. */ This is not a size hog because the value here is not copied, and will be shared with the specs in the specifier. */ WINDOW_SLOT_ARRAY (gutter, 4, EQUAL_WRAPPED); + /* Real (pre-calculated) gutter specification for each of the four positions. + This is not a specifier, it is calculated by the specifier change + functions. */ + WINDOW_SLOT_ARRAY (real_gutter, 4, EQUAL_WRAPPED); /* Gutter size for each of the four positions. */ WINDOW_SLOT_ARRAY (gutter_size, 4, EQUAL_WRAPPED); /* Real (pre-calculated) gutter size for each of the four positions. diff --git a/tests/ChangeLog b/tests/ChangeLog index 5921166..141d4d7 100644 --- a/tests/ChangeLog +++ b/tests/ChangeLog @@ -1,3 +1,16 @@ +2000-03-20 Martin Buchholz + + * XEmacs 21.2.32 is released. + +2000-03-10 Martin Buchholz + + * automated/mule-tests.el: Check that (make-temp-name) returns + unique values. + +2000-03-06 Yoshiki Hayashi + + * gutter-test.el: Fix name of specifier. + 2000-02-23 Martin Buchholz * XEmacs 21.2.31 is released. diff --git a/tests/glyph-test.el b/tests/glyph-test.el index b9c04a1..425b1b8 100644 --- a/tests/glyph-test.el +++ b/tests/glyph-test.el @@ -18,26 +18,26 @@ (make-extent (point) (point)) (setq radio-button1 (make-glyph - [button :descriptor ["ok " (setq ok-select t) + [button :descriptor ["ok1" (setq ok-select t) :style radio :selected ok-select]]))) ;; button in a group (set-extent-begin-glyph (make-extent (point) (point)) (setq radio-button2 (make-glyph - [button :descriptor ["ok" (setq ok-select nil) :style radio +` [button :descriptor ["ok2" (setq ok-select nil) :style radio :selected (not ok-select)]]))) ;; toggle button (set-extent-begin-glyph (make-extent (point) (point)) (setq tbutton - (make-glyph [button :descriptor ["ok" (setq ok-select nil) + (make-glyph [button :descriptor ["ok3" (setq ok-select nil) :style toggle :selected (not ok-select)]]))) (set-extent-begin-glyph (make-extent (point) (point)) (setq toggle-button - (make-glyph [button :descriptor ["ok" :style toggle + (make-glyph [button :descriptor ["ok4" :style toggle :callback (setq ok-select (not ok-select)) :selected ok-select]]))) @@ -69,9 +69,9 @@ [tab-control :descriptor "My Tab" :face highlight :orientation right - :properties (:items (["One" foo] - ["Two" fee] - ["Three" foo]))]))) + :properties (:items (["One" foo :selected t] + ["Two" fee :selected nil] + ["Three" foo :selected nil]))]))) ;; progress gauge (set-extent-begin-glyph diff --git a/version.sh b/version.sh index faa7b82..f6f2925 100644 --- a/version.sh +++ b/version.sh @@ -2,8 +2,8 @@ emacs_is_beta=t emacs_major_version=21 emacs_minor_version=2 -emacs_beta_version=31 -xemacs_codename="Iris" +emacs_beta_version=32 +xemacs_codename="Kastor & Polydeukes" infodock_major_version=4 infodock_minor_version=0 infodock_build_version=8