This commit was generated by cvs2svn to compensate for changes in r1705,
authorkazuhiko <kazuhiko>
Thu, 5 Oct 2000 05:07:19 +0000 (05:07 +0000)
committerkazuhiko <kazuhiko>
Thu, 5 Oct 2000 05:07:19 +0000 (05:07 +0000)
which included commits to RCS files with non-trunk default branches.

274 files changed:
PROBLEMS
aclocal.m4
configure.usage
dynodump/dynodump.c
etc/CHARSETS
etc/Emacs.ad
etc/NEWS
etc/OONEWS
etc/gnuserv.1
etc/xemacs-fe.sh
etc/xemacs.1
lib-src/ChangeLog
lib-src/cvtmail.c
lib-src/ellcc.c
lib-src/etags.c
lib-src/fakemail.c
lib-src/gnuclient.c
lib-src/gnuserv.c
lib-src/hexl.c
lib-src/make-msgfile.c
lisp/ChangeLog.1
lisp/autoload.el
lisp/build-report.el
lisp/byte-optimize.el
lisp/cl-macs.el
lisp/cl-seq.el
lisp/cl.el
lisp/cmdloop.el
lisp/code-files.el
lisp/code-process.el
lisp/cus-dep.el
lisp/cus-edit.el
lisp/cus-face.el
lisp/custom.el
lisp/dialog.el
lisp/dragdrop.el
lisp/easymenu.el
lisp/extents.el
lisp/faces.el
lisp/find-paths.el
lisp/finder.el
lisp/font-lock.el
lisp/glyphs.el
lisp/help.el
lisp/info.el
lisp/isearch-mode.el
lisp/keydefs.el
lisp/ldap.el
lisp/lisp-mode.el
lisp/menubar-items.el
lisp/menubar.el
lisp/minibuf.el
lisp/modeline.el
lisp/mouse.el
lisp/mule/mule-ccl.el
lisp/package-admin.el
lisp/package-get.el
lisp/package-ui.el
lisp/paths.el
lisp/process.el
lisp/replace.el
lisp/select.el
lisp/simple.el
lisp/subr.el
lisp/toolbar-items.el
lisp/userlock.el
lisp/wid-edit.el
lisp/window-xemacs.el
lisp/window.el
lisp/x-faces.el
lisp/x-font-menu.el
lisp/x-init.el
lwlib/ChangeLog
lwlib/lwlib-Xaw.c
lwlib/lwlib-Xm.c
lwlib/lwlib-internal.h
lwlib/lwlib.c
lwlib/lwlib.h
lwlib/xlwmenu.c
man/ChangeLog
man/emodules.texi
man/info.texi
man/internals/internals.texi
man/lispref/buffers.texi
man/lispref/consoles-devices.texi
man/lispref/databases.texi
man/lispref/hash-tables.texi
man/lispref/loading.texi
man/lispref/minibuf.texi
man/lispref/mule.texi
man/lispref/processes.texi
man/lispref/searching.texi
man/lispref/windows.texi
man/xemacs-faq.texi
man/xemacs/custom.texi
man/xemacs/glossary.texi
man/xemacs/help.texi
man/xemacs/mule.texi
man/xemacs/search.texi
man/xemacs/startup.texi
modules/sample/sample.c
nt/ChangeLog
nt/PROBLEMS
nt/README
nt/config.h
nt/xemacs.mak
src/ChangeLog.1
src/Makefile.in.in
src/alloca.c
src/bytecode.c
src/callproc.c
src/console-msw.c
src/console-msw.h
src/console-tty.c
src/console-x.c
src/device-msw.c
src/device-x.c
src/device.c
src/device.h
src/dialog-msw.c
src/dialog-x.c
src/dialog.c
src/dired-msw.c
src/dired.c
src/editfns.c
src/eldap.c
src/elhash.c
src/emodules.c
src/emodules.h
src/eval.c
src/event-Xt.c
src/event-msw.c
src/event-stream.c
src/events-mod.h
src/events.c
src/events.h
src/extents.c
src/fileio.c
src/filelock.c
src/frame-msw.c
src/frame-tty.c
src/frame-x.c
src/frame.h
src/general.c
src/getloadavg.c
src/glyphs-msw.c
src/glyphs-widget.c
src/glyphs-x.c
src/glyphs-x.h
src/glyphs.h
src/gpmevent.c
src/gui-msw.c
src/gui-x.c
src/gui-x.h
src/gui.c
src/gui.h
src/inline.c
src/input-method-xlib.c
src/keymap.c
src/keymap.h
src/line-number.c
src/lisp-union.h
src/m/acorn.h
src/m/alliant-2800.h
src/m/alliant.h
src/m/amdahl.h
src/m/apollo.h
src/m/arm.h
src/m/att3b.h
src/m/aviion.h
src/m/clipper.h
src/m/cnvrgnt.h
src/m/convex.h
src/m/cydra5.h
src/m/delta.h
src/m/delta88k.h
src/m/dpx2.h
src/m/elxsi.h
src/m/ews4800r.h
src/m/gould.h
src/m/hp800.h
src/m/hp9000s300.h
src/m/i860.h
src/m/ibmps2-aix.h
src/m/ibmrt.h
src/m/intel386.h
src/m/iris4d.h
src/m/iris5d.h
src/m/irist.h
src/m/m68k.h
src/m/masscomp.h
src/m/mg1.h
src/m/mips-nec.h
src/m/mips-siemens.h
src/m/mips.h
src/m/nh3000.h
src/m/nh4000.h
src/m/ns32000.h
src/m/plexus.h
src/m/powerpc.h
src/m/sequent-ptx.h
src/m/sequent.h
src/m/sgi-challenge.h
src/m/stride.h
src/m/tad68k.h
src/m/targon31.h
src/m/tekxd88.h
src/m/template.h
src/m/tower32.h
src/m/tower32v3.h
src/m/ustation.h
src/m/wicat.h
src/m/windowsnt.h
src/m/xps100.h
src/make-src-depend
src/menubar-msw.c
src/menubar-x.c
src/menubar.c
src/menubar.h
src/nas.c
src/nt.c
src/ntproc.c
src/objects-msw.h
src/objects-x.c
src/objects-x.h
src/objects.c
src/offix.h
src/print.c
src/process-nt.c
src/process-unix.c
src/process.c
src/process.h
src/rangetab.c
src/s/aix3-1.h
src/s/bsd386.h
src/s/cygwin32.h
src/s/freebsd.h
src/s/gnu.h
src/s/irix4-0.h
src/s/irix5-0.h
src/s/linux.h
src/s/netbsd.h
src/s/sol2.h
src/s/windowsnt.h
src/scrollbar-msw.c
src/scrollbar-x.c
src/scrollbar.c
src/select-msw.c
src/sound.c
src/specifier.c
src/specifier.h
src/symeval.h
src/sysdep.c
src/sysdll.c
src/sysdll.h
src/sysfile.h
src/sysproc.h
src/syssignal.h
src/systty.h
src/termcap.c
src/toolbar.c
src/tooltalk.c
src/unexcw.c
src/unexhp9k800.c
src/unexnt.c
src/vm-limit.c
src/window.c
src/winslots.h
tests/ChangeLog
tests/DLL/dltest.c
tests/automated/hash-table-tests.el
tests/automated/lisp-tests.el
tests/glyph-test.el
version.sh

index 0000084..0648a24 100644 (file)
--- a/PROBLEMS
+++ b/PROBLEMS
@@ -523,7 +523,7 @@ correctly if you are using ash instead of bash (see below).
 
 This is usually because xmkmf is not in your path or because you are
 using the default cygwin shell. The default cygwin shell (/bin/sh.exe)
-is ash which appears to work in most circumstances but has some wierd
+is ash which appears to work in most circumstances but has some weird
 failure modes. I recommend replacing sh.exe with bash.exe, this will
 mean configure is slower but more reliable.
 
@@ -1045,7 +1045,7 @@ it only if it is undefined.
 Or you could set TERMCAP only when you set TERM--which should not
 happen in a non-login shell.
 
-*** The popup menu appears at the buttom/right of my screen.
+*** The popup menu appears at the bottom/right of my screen.
 
 You probably have something like the following in your ~/.Xdefaults
 
@@ -1427,7 +1427,7 @@ Richard Cognot <cognot@ensg.u-nancy.fr> writes:
   launched. Forcing a static link of libc.a alone by adding
   /usr/lib/libc.a at the end of the link line solves this. Note that
   my 9.07 build of 19.14b17 and my (old) build of 19.13 both exhibit
-  the same behaviour. I've tried various hpux patches to no avail. If
+  the same behavior. I've tried various hpux patches to no avail. If
   this problem cannot be solved before the release date, binary kits
   for HP *must* be linked statically against libc, otherwise this
   problem will show up. (This is directed at whoever will volunteer
index 1cfb91f..9dd7ecf 100644 (file)
@@ -173,7 +173,7 @@ fi
 
 if test -n "$dll_cflags"; then
   AC_MSG_RESULT([${dll_cflags}])
-  
+
   # Check to make sure the dll_cflags actually works.
   AC_MSG_CHECKING([if PIC flag ${dll_cflags} really works])
   save_CFLAGS="$CFLAGS"
@@ -200,13 +200,13 @@ dnl Now comes the LD trickery. We do things differently to libtool here.
 dnl I believe that libtool is incorrect in trying to drive the linker
 dnl directly. This can cause considerable problems if the module you are
 dnl compiling has C++ or other static initializers. If we use ld directly,
-dnl we dont end up with the crt stuff being linked in, and we dont end up
+dnl we don't end up with the crt stuff being linked in, and we don't end up
 dnl with any .init or .fini sections (or the moral equivalent thereof).
-dnl gcc takes great care to do this propperly when invoked in -shared
-dnl mode, and we really do want this behaviour. Perhaps the libtool folks
+dnl gcc takes great care to do this properly when invoked in -shared
+dnl mode, and we really do want this behavior. Perhaps the libtool folks
 dnl are not aware that any SVR4 based dynamic loader will automatically
 dnl execute code in the .init section before dlopen() returns. This is
-dnl vital, as the module may have been compiled to rely on that behaviour.
+dnl vital, as the module may have been compiled to rely on that behavior.
 dnl
 dnl So, having said all of that, we diverge from libtool significantly
 dnl here. We want to try and use the C compiler as much as possible. Only
@@ -219,7 +219,7 @@ dnl version of XEmacs. With the libtool way, it picks up the linker that
 dnl gcc uses, which can be the internal collect2 that comes with gcc.
 dnl If the user ever changes their compiler version, the paths will no
 dnl longer be correct, and ellcc will break. This is clearly unacceptable.
-dnl By using the compiler driver on the path, we dont have this problem.
+dnl By using the compiler driver on the path, we don't have this problem.
 dnl If that is not clear, consider that gcc -print-prog-name=ld can
 dnl produce something along the lines of:
 dnl   /usr/local/lib/gcc-lib/OS-NAME/GCC-VERSION/ld
@@ -231,7 +231,7 @@ dnl If we are not using gcc, but the system C compiler can produce
 dnl shared objects, we try that. Only if all of that fails do we revert
 dnl back to the libtool ld trickery.
 dnl
-dnl We dont do ANY of this if we can't produce shared objects.
+dnl We don't do ANY of this if we can't produce shared objects.
 dnl
 if test "$can_build_shared" = "yes"; then
 cc_produces_so=no
@@ -513,7 +513,7 @@ dnl
 dnl Last thing, check how to get a linked executable to have its symbols
 dnl exported, so that the modules have access to them.
 dnl
-dnl XEmacs FIXME - we need to set ld_dynamic_link_flags propperly for
+dnl XEmacs FIXME - we need to set ld_dynamic_link_flags properly for
 dnl most of these systems, which was missing from libtool. I know they
 dnl all have a way of doing this, but someone needs to look at this
 dnl for each OS and make sure it is correct. Remember that the arguments
index a3ec3a3..d7e9f6c 100644 (file)
@@ -252,9 +252,6 @@ Other options:
 --with-debug-malloc     Use the debugging malloc package.
 --with-clash-detection  Use lock files to detect multiple edits of the same
                         file.  The default is to do clash detection.
---lockdir=DIR           The directory to put clash detection files in, such as
-                        `/var/lock/emacs'.
-                        Defaults to `${statedir}/xemacs/lock'.
 
 You may also specify any of the `path' variables found in Makefile.in,
 including --bindir, --libdir, --docdir, --lispdir, --sitelispdir,
index ff4477d..b39f93b 100644 (file)
  *             Note. under this mechanism, any data item that undergoes
  *             relocation and is then further modified during the execution of
  *             the image before dynodump(3x) is called will lose the
- *             modification that occured during the applications execution.
+ *             modification that occurred during the applications execution.
  *
  * N.B. The above commentary is not quite correct in the flags have been hardwired
  *      to RTLD_SAVREL.
  */
-#pragma ident  "@(#) $Id: dynodump.c,v 1.6 1998/03/31 20:10:55 steve Exp $ - SMI"
+#pragma ident  "@(#) $Id: dynodump.c,v 1.6.2.2 2000/09/20 02:39:17 martinb Exp $ - SMI"
 
 #define __EXTENSIONS__ 1
 
@@ -301,7 +301,7 @@ dynodump(const char * file)
      * If we had a .heap section, then its size is part of the program
      * headers notion of data size.  Because we're only going to output one
      * heap section (ignoring the one in the running binary) we need to
-     * subract the size of that which we're ignoring.
+     * subtract the size of that which we're ignoring.
      */
     if (heap_cache) {
        edata = S_ROUND((data_phdr->p_vaddr
index dd2d083..d71e593 100644 (file)
@@ -16,7 +16,7 @@
 tibetan-1-column:241:2:94:4:1:0:56:0:Tibetan 1 column glyph
 tibetan:252:2:94:4:2:0:55:0:Tibetan characters
 lao:167:1:94:3:1:0:49:0:Lao characters (ISO10646 0E80..0EDF)
-indian-1-column:240:2:94:4:1:0:54:0:Indian charset for 2-column width glypps
+indian-1-column:240:2:94:4:1:0:54:0:Indian charset for 2-column width glyphs
 indian-2-column:251:2:94:4:2:0:53:0:Indian charset for 2-column width glyphs
 indian-is13194:225:1:94:3:2:0:53:1:Generic Indian charset for data exchange with IS 13194
 ascii-right-to-left:166:1:94:3:1:1:66:0:ASCII (left half of ISO8859-1) with right-to-left direction
index 65773f1..2dda0f9 100644 (file)
@@ -17,9 +17,6 @@
 ! 
 ! See the NEWS file (C-h n) or XEmacs manual (C-h i) for a description of
 ! the various resources and the syntax for setting them.
-! 
-! Energize users: note that this is not the same app-defaults file that is
-! used with the Energize-specific version of XEmacs.
 
 
 ! Colors and backgrounds.
 ! Note that the menubar resources do not use the `face' syntax, since they
 ! are X toolkit widgets and thus outside the domain of XEmacs proper.
 ! 
+! When X Font Sets are enabled with ./configure --with-xfs (eg, for
+! multilingual menubars and XIM), some .font resources (those specific to
+! the Lucid widget set) are ignored in favor of .fontSet resources.  This
+! example shows how to add fonts for Japanese menubars:
+!
+! *menubar*FontSet:    -*-helvetica-bold-r-*-*-*-120-*-*-*-*-iso8859-*, \
+!                      -*-*-*-*-*-*-*-120-*-jisx0208.1983-0
+!
 *menubar*Font:                         -*-helvetica-bold-r-*-*-*-120-*-*-*-*-iso8859-*
 *popup*Font:                   -*-helvetica-bold-r-*-*-*-120-*-*-*-*-iso8859-*
 
index 39d5e6d..856fc15 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -187,8 +187,8 @@ clipboard can be made; the kill-ring and friends will be updated as
 per X.
 
 The only thing selection doesn't do is set the clipboard automatically
-as this would break the MS-Windows model.  If you want this behaviour
-then set `selection-sets-clipboard' to t
+as this would break the MS-Windows model.  If you want this behavior
+then set `selection-sets-clipboard' to t.
 
 ** Mail spool locking now works correctly.
 XEmacs has always come with a little auxiliary program, movemail,
@@ -252,12 +252,12 @@ menus.
 ** Pixel-based scrolling has been implemented.
 By default this will attempt to scroll in increments equal to the
 height of the default face.  Set `window-pixel-scroll-increment' to
-modify this behaviour.
+modify this behavior.
 
 ** 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'.
+do not like this behavior set `progress-feedback-use-echo-area'.
 
 ** The PostgreSQL Relational Database Management System is now supported.
 It is now possible to build XEmacs so that the programming interface
@@ -380,7 +380,7 @@ to (concat "~" init-file-user).  This turned out to be too complicated
 for most packages (and some core Lisp files) to use correctly.  Also,
 the `init-file-user' variable has been obsoleted in the process.
 
-The user-visible options like `-u' have not changed their behaviour.
+The user-visible options like `-u' have not changed their behavior.
 
 ** XEmacs finally has an automated test suite!
 Although this is not yet very sophisticated, it is already responsible
@@ -509,7 +509,7 @@ interned in the global obarray.  For example:
     (keywordp (intern ":foo"))       ; The same as (keywordp :foo)
       => t
 
-This behaviour is compatible with other code which treats symbols
+This behavior is compatible with other code which treats symbols
 beginning with colon as keywords only if they are interned in the
 global obarray.  `keywordp' used to wrongly return t in both cases
 above.
index 5ed4498..3c2f4d3 100644 (file)
@@ -801,7 +801,7 @@ as a set of built-in Lisp function in C) by a flexible and
 customizable Common Lisp like one (implemented entirely in Emacs
 Lisp). During reading of Emacs Lisp source files, it is about 40%
 slower than the built-in reader, but there is no difference in
-loading byte compiled files - they dont contain any syntactic sugar
+loading byte compiled files - they don't contain any syntactic sugar
 and are loaded with the built in subroutine `load'.
 
 ** ediff        - Compare and merge files with graphical difference display
index 781d24e..09f213b 100644 (file)
@@ -24,7 +24,7 @@ One typical use for this is with a dialup connection to a machine on
 which an XEmacs process is currently running.
 .PP
 \fIgnudoit\fP is a shell script frontend to ``gnuclient -batch -eval form''.
-Its use is depreciated. Try to get used to calling gnuclient directly.
+Its use is deprecated. Try to get used to calling gnuclient directly.
 .PP
 \fIgnuserv\fP is the server program that is set running by XEmacs to
 handle all incoming and outgoing requests. It is not usually invoked
index 881ad07..3b61e27 100755 (executable)
@@ -109,7 +109,7 @@ esac
 #
 # The largish sed script prefixes all version numbers with a sort key.
 # That key is constructed by padding out any single or double digits to 3
-# digits from the version number, then converting all occurences of `.' to
+# digits from the version number, then converting all occurrences of `.' to
 # `0', and prefixing and suffixing the entire result with an additional
 # zero.  After sorting, the sort key is stripped from the output.
 # We do all this because `sort' cannot numerically sort decimal numbers and
index c912a1c..7e99828 100644 (file)
@@ -1,4 +1,4 @@
-.TH XEMACS 1 "1998 January 13"
+.TH XEMACS 1 "2000-09-20"
 .UC 4
 .SH NAME
 xemacs \- Emacs: The Next Generation
@@ -151,7 +151,7 @@ Load no extra files at startup.  Equivalent to the combination of
 ,
 .B \-no-site-file
 , and
-.B \-no-packages
+.B \-no-early-packages
 \.
 .TP
 .BI \-u " user, " \-user " user"
@@ -197,16 +197,13 @@ Exit
 (useful with
 .BR \-batch ).
 .PP
-.SM Using XEmacs with X
+.SM Using XEmacs with X Windows
 .PP
 .I XEmacs
 has been tailored to work well with the X window system.
 If you run
 .I XEmacs
-from under X windows, it will create its own X window to
-display in.  You will probably want to start the editor
-as a background process
-so that you can continue using your original window.
+from under X windows, it will create its own X window to display in.
 .PP
 .I XEmacs
 can be started with the following standard X options:
@@ -223,9 +220,11 @@ for a 24bit TrueColor visual) See
 for more information.
 .TP
 .B -privateColormap
-Require XEmacs to create and use a private colormap for display.  This will keep
-XEmacs from taking colors from the default colormap and keeping them from other
-clients.
+Require XEmacs to create and use a private colormap for display.  This
+will keep XEmacs from taking colors from the default colormap and
+keeping them from other clients, at the cost of causing annoying
+flicker when the focus changes.  Use this option only if your X server
+does not support 24 bit visuals.
 .TP
 .BI \-geometry " ##x##+##+##"
 Specify the geometry of the initial window.  The ##'s represent a number;
@@ -318,7 +317,7 @@ this option.
 .BI \-xrm " argument"
 This allows you to set an arbitrary resource on the command line.
 .I argument
-should be a resource specification, as might as in your
+should be a resource specification, as might be found in your
 .I \.Xresources
 or
 .I \.Xdefaults
@@ -439,7 +438,7 @@ If set to
 .IR on ,
 the window will be displayed in reverse video.  Consider
 explicitly setting the foreground and background colors instead
-of using this resources.
+of using this resource.
 .TP
 .B borderWidth (\fPclass\fB BorderWidth)
 Sets the window's border width in pixels.
@@ -462,7 +461,7 @@ Sets the default visual
 will try to use (as described above).
 .TP
 .B privateColormap (\fPclass\fB PrivateColormap)
-If set, 
+If set,
 .I XEmacs
 will default to using a private colormap.
 .TP
@@ -511,7 +510,7 @@ means no horizontal scrollbars.
 Sets the position of vertical and horizontal scrollbars.   Should be one
 of the strings "top-left", "bottom-left", "top-right", or "bottom-right".
 The default is "bottom-right" for the Motif and Lucid scrollbars and
-"buttom-left" for the Athena scrollbars.
+"bottom-left" for the Athena scrollbars.
 .TP
 .B topToolBarHeight (\fPclass\fB TopToolBarHeight)
 Sets the height of the top toolbar, in pixels.  0 means no top toolbar.
@@ -642,9 +641,6 @@ is included in a convenient tree structured form.
 
 /usr/local/lib/xemacs-$VERSION/info - the Info files may be here instead.
 
-/usr/local/lib/xemacs-$VERSION/src - C source files and object files.
-(May not be present.)
-
 /usr/local/lib/xemacs-$VERSION/lisp/* - Lisp source files and compiled files
 that define most editing commands.  The files are contained in subdirectories,
 categorized by function or individual package.  Some are preloaded;
@@ -661,19 +657,7 @@ contains the documentation strings for the Lisp primitives and
 preloaded Lisp functions of \fIXEmacs\fP.
 They are stored here to reduce the size of \fIXEmacs\fP proper.
 
-.br
-/usr/local/lib/xemacs-$VERSION/etc/SERVICE - lists people offering
-various services to assist users of \fIXEmacs\fP,
-including education, troubleshooting, porting and customization.
-
-/usr/local/lib/xemacs/lock - holds lock files that are made for all
-files being modified in
-.IR XEmacs ,
-to prevent simultaneous modification of one file by two users.
-
 /usr/local/lib/xemacs/site-lisp - locally-provided Lisp files.
-
-/usr/lib/X11/rgb.txt - list of valid X color names.
 .PP
 .SH BUGS AND HELP
 There is a newsgroup, comp.emacs.xemacs, for reporting
index 7abe91d..cf05b9a 100644 (file)
@@ -1,3 +1,34 @@
+2000-10-04  Martin Buchholz <martin@xemacs.org>
+
+       * XEmacs 21.2.36 is released.
+
+2000-09-30  Martin Buchholz  <martin@xemacs.org>
+
+       * gnuserv.c (main): Warning removal.
+
+2000-09-27  Martin Buchholz  <martin@xemacs.org>
+
+       * ellcc.c: Make global variables static.  Avoids warnings on AIX.
+
+       * fakemail.c (make_file_preface): Use standard type time_t.
+       Actually check that the 25th char returned from ctime is '\n'.
+
+2000-09-19  Martin Buchholz  <martin@xemacs.org>
+
+       * *: Spelling mega-patch
+
+2000-09-12  Martin Buchholz  <martin@xemacs.org>
+
+       * gnuclient.c (main):
+       * hexl.c (usage):
+       Use `Usage', not `usage', in Usage messages.
+
+2000-07-15  Ben Wing  <ben@xemacs.org>
+
+       * etags.c (add_regex): added commented out code for use figuring
+       out Windows quoting problems.
+       * hexl.c (main): fixed warnings about possible used uninitialized.
+
 2000-07-19  Martin Buchholz <martin@xemacs.org>
 
        * XEmacs 21.2.35 is released.
index 15099ce..a34434c 100644 (file)
@@ -24,13 +24,13 @@ Boston, MA 02111-1307, USA.  */
  * exist in your home directory, containing individual mail messages in
  * separate files in the standard gosling emacs mail reader format.
  *
- * Program takes one argument: an output file.  THis file will contain
+ * Program takes one argument: an output file.  This file will contain
  * all the messages in Messages directory, in berkeley mail format.
  * If no output file is mentioned, messages are put in ~/OMAIL.
  *
  * In order to get rmail to read the messages, the resulting file must
  * be mv'ed to ~/mbox, and then have rmail invoked on them.
- * 
+ *
  * Author: Larry Kolodney, 1985
  */
 
@@ -106,7 +106,7 @@ main (int argc, char *argv[])
      fclose (cff);
     }
   fclose (mddf);
-  fclose (mfilef);    
+  fclose (mfilef);
   return 0;
 }
 
index 54a2c8b..53bd780 100644 (file)
@@ -61,6 +61,7 @@ See the samples for more details.
 #include <config.h>
 #include <stdio.h>
 #include <stdlib.h>
+#include <stddef.h>
 #include <string.h>
 #include <ctype.h>
 #include <errno.h>
@@ -120,16 +121,19 @@ static void do_init_mode (void);
 #define ELLCC_LINK_MODE         1
 #define ELLCC_INIT_MODE         2
 
-int ellcc_mode = ELLCC_COMPILE_MODE;
-char *progname;
-char *mod_name = (char *)0, *mod_version = (char *)0, *mod_title = (char *)0;
-char *mod_output = (char *)0;
-int verbose = 0;
-char **exec_argv;
-int exec_argc = 1, *exec_args;
-int real_argc = 0;
-int prog_argc;
-char **prog_argv;
+static int ellcc_mode = ELLCC_COMPILE_MODE;
+static char *progname;
+static char *mod_name = NULL;
+static char *mod_version = NULL;
+static char *mod_title = NULL;
+static char *mod_output = NULL;
+static int verbose = 0;
+static char **exec_argv;
+static int exec_argc = 1;
+static int *exec_args;
+static int real_argc = 0;
+static int prog_argc;
+static char **prog_argv;
 
 /*
  * We allow the user to over-ride things in the environment
index d3cff3f..ce7d1c2 100644 (file)
@@ -4840,6 +4840,10 @@ add_regex (regexp_pattern, ignore_case, lang)
   patbuf->buffer = NULL;
   patbuf->allocated = 0;
 
+#if 0 /* useful when debugging windows quoting convention problems */
+  printf ("Compiling regex pattern: %s\n", regexp_pattern);
+#endif
+
   err = re_compile_pattern (regexp_pattern, strlen (regexp_pattern), patbuf);
   if (err != NULL)
     {
index 0bf4ca4..a074fa8 100644 (file)
@@ -302,7 +302,7 @@ static line_list
 make_file_preface (void)
 {
   char *the_string, *temp;
-  long idiotic_interface;
+  time_t idiotic_interface;
   long prefix_length;
   long user_length;
   long date_length;
@@ -313,7 +313,8 @@ make_file_preface (void)
   the_date = ctime (&idiotic_interface);
   /* the_date has an unwanted newline at the end */
   date_length = strlen (the_date) - 1;
-  the_date[date_length] = '\0';
+  if (the_date[date_length] == '\n')
+    the_date[date_length] = '\0';
 #ifdef WIN32_NATIVE
   temp = "(null)";
 #else
index 0f57c85..58588f6 100644 (file)
@@ -225,7 +225,7 @@ filename_expand (char *fullpath, char *filename)
       /* Assume relative Unix style path.  Get the current directory
        and prepend it.  FIXME: need to fix the case of DOS paths like
        "\foo", where we need to get the current drive. */
-      
+
       strcat (fullpath, get_current_working_directory ());
       len = strlen (fullpath);
 
@@ -461,11 +461,11 @@ main (int argc, char *argv[])
     {
       fprintf (stderr,
 #ifdef INTERNET_DOMAIN_SOCKETS
-              "usage: %s [-nw] [-display display] [-q] [-v] [-l library]\n"
+              "Usage: %s [-nw] [-display display] [-q] [-v] [-l library]\n"
                "       [-batch] [-f function] [-eval form]\n"
               "       [-h host] [-p port] [-r remote-path] [[+line] file] ...\n",
 #else /* !INTERNET_DOMAIN_SOCKETS */
-              "usage: %s [-nw] [-q] [-v] [-l library] [-f function] [-eval form] "
+              "Usage: %s [-nw] [-q] [-v] [-l library] [-f function] [-eval form] "
               "[[+line] path] ...\n",
 #endif /* !INTERNET_DOMAIN_SOCKETS */
               progname);
@@ -573,7 +573,7 @@ main (int argc, char *argv[])
                       progname);
              exit (1);
            }
-      /* Don't do disconnect_from_server becasue we have already read
+      /* Don't do disconnect_from_server because we have already read
         data, and disconnect doesn't do anything else. */
 #ifndef INTERNET_DOMAIN_SOCKETS
          if (connect_type == (int) CONN_IPC)
index f792f74..419baa8 100644 (file)
@@ -889,7 +889,7 @@ main (int argc, char *argv[])
       {
        perror(progname);
        fprintf(stderr,"%s: unable to select\n",progname);
-       exit(1);
+       return 1;
       } /* if */
 
 #ifdef UNIX_DOMAIN_SOCKETS
@@ -905,9 +905,7 @@ main (int argc, char *argv[])
     if (FD_ISSET(fileno(stdin), &rmask))      /* from stdin (gnu process) */
       handle_response();
 #endif /* NOT SYSV_IPC */
-  } /* while */
-
-  return 0;
+  } /* while (1) */
 } /* main */
 
 #endif /* SYSV_IPC || UNIX_DOMAIN_SOCKETS || INTERNET_DOMAIN_SOCKETS */
index b254d85..2389bad 100644 (file)
@@ -149,7 +149,7 @@ main (int argc, char *argv[])
 #endif
          for (;;)
            {
-             register int i, c, d;
+             register int i, c = 0, d;
 
 #define hexchar(x) (isdigit (x) ? x - '0' : x - 'a' + 10)
 
@@ -195,7 +195,7 @@ main (int argc, char *argv[])
          string[17] = '\0';
          for (;;)
            {
-             register int i, c;
+             register int i, c = 0;
 
              for (i=0; i < 16; ++i)
                {
@@ -246,6 +246,6 @@ main (int argc, char *argv[])
 void
 usage (void)
 {
-  (void) fprintf (stderr, "usage: %s [-de] [-iso]\n", progname);
+  fprintf (stderr, "Usage: %s [-de] [-iso]\n", progname);
   exit (1);
 }
index 31b9379..ed02e6e 100644 (file)
@@ -1,10 +1,10 @@
-/* 
-   
-   
+/*
+
+
    PROPOSAL FOR HOW THIS ALL OUGHT TO WORK
    this isn't implemented yet, but this is the plan-in-progress
 
-   
+
    In general, it's accepted that the best way to internationalize is for all
    messages to be referred to by a symbolic name (or number) and come out of a
    table or tables, which are easy to change.
    something has gone wrong.  (Except to do things like remove assumptions
    about the order of words within a sentence, or how pluralization works.)
 
-   There are two parts to the task of displaying translated strings to the 
+   There are two parts to the task of displaying translated strings to the
    user: the first is to extract the strings which need to be translated from
    the sources; and the second is to make some call which will translate those
    strings before they are presented to the user.
-   
+
    The old way was to use the same form to do both, that is, GETTEXT() was both
    the tag that we searched for to build a catalog, and was the form which did
    the translation.  The new plan is to separate these two things more: the
    already, and the translation will get done in some more centralized, lower
    level place.
 
-   This program (make-msgfile.c) addresses the first part, extracting the 
+   This program (make-msgfile.c) addresses the first part, extracting the
    strings.
-   
+
    For the emacs C code, we need to recognize the following patterns:
-   
+
      message ("string" ... )
      error ("string")
      report_file_error ("string" ... )
      signal_simple_error ("string" ... )
      signal_simple_error_2 ("string" ... )
-     
+
      build_translated_string ("string")
      #### add this and use it instead of build_string() in some places.
-     
+
      yes_or_no_p ("string" ... )
      #### add this instead of funcalling Qyes_or_no_p directly.
 
      barf_or_query_if_file_exists      #### restructure this
      check all callers of Fsignal      #### restructure these
      signal_error (Qerror ... )                #### change all of these to error()
-     
+
      And we also parse out the `interactive' prompts from DEFUN() forms.
-     
+
      #### When we've got a string which is a candidate for translation, we
      should ignore it if it contains only format directives, that is, if
      there are no alphabetic characters in it that are not a part of a `%'
      directive.  (Careful not to translate either "%s%s" or "%s: ".)
 
    For the emacs Lisp code, we need to recognize the following patterns:
-   
+
      (message "string" ... )
      (error "string" ... )
      (format "string" ... )
      (read-file-name "string" ... )
      (temp-minibuffer-message "string")
      (query-replace-read-args "string" ... )
-     
+
    I expect there will be a lot like the above; basically, any function which
    is a commonly used wrapper around an eventual call to `message' or
    `read-from-minibuffer' needs to be recognized by this program.
 
 
      (dgettext "domain-name" "string")         #### do we still need this?
-     
+
      things that should probably be restructured:
        `princ' in cmdloop.el
        `insert' in debug.el
        face-interactive
        help.el, syntax.el all messed up
-     
+
 
    Menu descriptors: one way to extract the strings in menu labels would be
    to teach this program about "^(defvar .*menu\n" forms; that's probably
 
      "string" ... ;###translate
 
-   where the magic token ";###translate" on a line means that the string 
-   constant on this line should go into the message catalog.  This is analagous
+   where the magic token ";###translate" on a line means that the string
+   constant on this line should go into the message catalog.  This is analogous
    to the magic ";###autoload" comments, and to the magic comments used in the
    EPSF structuring conventions.
 
   translations, there are hooks in a small number of low level places in
   emacs.
 
-  Assume the existence of a C function gettext(str) which returns the 
+  Assume the existence of a C function gettext(str) which returns the
   translation of `str' if there is one, otherwise returns `str'.
 
   - message() takes a char* as its argument, and always filters it through
   Solving the "translating too much" problem:
   The concern has been raised that in this situation:
    - "Help" is a string for which we know a translation;
-   - someone visits a file called Help, and someone does something 
+   - someone visits a file called Help, and someone does something
      contrived like (error buffer-file-name)
   then we would display the translation of Help, which would not be correct.
   We can solve this by adding a bit to Lisp_String objects which identifies
   them as having been read as literal constants from a .el or .elc file (as
-  opposed to having been constructed at run time as it would in the above 
+  opposed to having been constructed at run time as it would in the above
   case.)  To solve this:
 
     - Fmessage() takes a lisp string as its first argument.
@@ -306,7 +306,7 @@ void scan_file (char *filename)
   else
     process_Lisp_file ();
   fputc ('\n', outfile);
-  
+
   fclose (infile);
 }
 
index df5627e..3ad71dd 100644 (file)
        instead of 1000.
        (find-tag-internal): Use `letf'.
        (tags-delete): Removed -- was unused.
-       (set-buffer-tag-table): Use `expland-file-name'.
+       (set-buffer-tag-table): Use `expand-file-name'.
        (get-tag-table-buffer): Use `ecase'.
        (add-to-tag-completion-table): Mark the filename messages with
        progress.
@@ -998,7 +998,7 @@ Sun Nov 01 12:00:00 1997 Jonathan Harris  <jhar@tardis.ed.ac.uk>
 
        * modes/lazy-shot.el (lazy-shot-mode): Unstall lazy-shot only if
        needed.
-       (lazy-shot-fontify-internal): Functionality put in seperate function.
+       (lazy-shot-fontify-internal): Functionality put in separate function.
        (lazy-shot-lock-extent): Use it.
        (lazy-shot-fontify-region): Dumb implementation added.
        (lazy-shot-unstall-after-fontify): Needed to disable lazy
index 965d550..f1ee483 100644 (file)
@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 1991, 1992, 1993, 1994, 1997 Free Software Foundation, Inc.
 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
-;; Copyright (C) 1996 Ben Wing.
+;; Copyright (C) 1996, 2000 Ben Wing.
 
 ;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
 ;; Keywords: maint
@@ -121,7 +121,7 @@ the section of autoloads for a file.")
                             (directory-file-name
                              (file-name-directory file))))
    "\\\\" "/"))
-  
+
 ;;;###autoload
 (defun generate-file-autoloads (file &optional funlist)
   "Insert at point a loaddefs autoload section for FILE.
@@ -360,8 +360,8 @@ generally the file named `autoload-file-name' in the directory being
 updated.")
 
 (defconst cusload-file-name "custom-load.el"
-  "Generic filename ot put custom loads into.
-Unless you are an XEmacs maintainr, it is probably unwise to change this.")
+  "Generic filename to put custom loads into.
+Unless you are an XEmacs maintainer, it is probably unwise to change this.")
 
 ;;;###autoload
 (defun update-file-autoloads (file)
@@ -542,10 +542,13 @@ on the command line."
          (goto-char (point-max))
          (insert "\n(provide '" sym ")\n")))))
 
-;; #### this function is almost identical, but subtly different,
-;; from batch-update-autoloads.  Steve, it's your responsibility to
-;; clean this up.  The two should be merged, but I'm not sure what
-;; package-creation scripts out there might be using this. --ben
+(defvar autoload-package-name nil)
+
+;; #### this function is almost identical to, but subtly different from,
+;; batch-update-autoloads.  Both of these functions, unfortunately, are
+;; used in various build scripts in xemacs-packages.  They should be
+;; merged. (However, it looks like no scripts pass more than one arg,
+;; making merging easy.) --ben
 
 ;;;###autoload
 (defun batch-update-directory ()
@@ -576,7 +579,7 @@ be used only with -batch."
     (setq command-line-args-left nil)))
 
 ;; #### i created the following.  this one and the last should be merged into
-;; batch-update-autoloads. --ben
+;; batch-update-autoloads and batch-update-one-directory. --ben
 
 ;;;###autoload
 (defun batch-update-one-directory ()
index 26b63bd..b3797f3 100644 (file)
@@ -3,8 +3,8 @@
 ;; Copyright (C) 1997 Adrian Aichner
 
 ;; Author: Adrian Aichner <adrian@xemacs.org>
-;; Date: Sun., Apr. 20, 1997, 1998, 1999.
-;; Version: 1.35
+;; Date: Sun., Apr. 20, 1997-2000.
+;; Version: $Revision: 1.5.2.6 $
 ;; Keywords: internal
 
 ;; This file is part of XEmacs.
 ;;; Code:
 
 (require 'config)
+(require 'custom)
+(require 'cl)
 (provide 'build-report)
 
-;; Due to recommendation by developers on xemacs-beta@xemacs.org,
-;; release versions are to be checked out using `co -u -kv ...'.
-(defconst build-report-version
-  "1.35"
-  "Version number of build-report.")
+;;; Constant definitions used internally by `build-report'.  These are not
+;;; anticipated to be changed by users of `build-report'.
+;;; If users do need to change the value of any of these, they need to do
+;;; it after `build-report' has been loaded (not just required).  Please
+;;; report it to the maintainers of `build-report' when you think you
+;;; need to do this.
+(defconst build-report-installation-version-regexp
+  "XEmacs\\s-+\\([0-9]+\\)\\.\\([0-9]+\\)\\(\\(-b\\|\\.\\)\\([0-9]+\\)\\)?\\s-+\\\\?\"\\([^\\\"]+\\)\\\\?\"\\s-+configured\\s-+for\\s-+`\\(.+\\)'\\."
+  "*REGEXP matching XEmacs Beta Version string in
+`build-report-installation-file' file.  This variable is used by
+`build-report-installation-data'.")
+
+(defconst build-report-version-file-regexp
+  "emacs_major_version\\s-*=\\s-*\\([0-9]+\\)
+emacs_minor_version\\s-*=\\s-*\\([0-9]+\\)
+emacs_beta_version\\s-*=\\s-*\\([0-9]+\\)?
+xemacs_codename\\s-*=\\s-*\"\\([^\"]+\\)\""
+  "*REGEXP matching XEmacs Beta Version variable assignments in
+`build-report-version-file' file.  This variable is used by
+`build-report-version-file-data'.")
+
+(defconst build-report-installation-srcdir-regexp
+  "\\s-*Where should the build process find the source code\\?\\s-*\\(.*\\)$"
+  "REGEXP matching XEmacs Beta srcdir as the first substring match in
+`build-report-installation-file' file.  This variable is used by
+`build-report-installation-data'.")
+
+;;; Customization support for build-report starts here.
 
 (defgroup build-report nil
-  "Package automating the process of sending XEmacs Build Reports."
+  "Standardizes the Creation of XEmacs Build Reports."
+  :load 'build-report
   :group 'build)
 
 (defcustom build-report-destination
-  "xemacs-build-reports@xemacs.org"
-  "The mail address XEmacs Build Reports should go to."
-  :type 'string
+  (quote ("XEmacs Build Reports List <xemacs-build-reports@xemacs.org>"
+          "XEmacs Beta List <xemacs-beta@xemacs.org>"))
+  "*The list of mail addresses XEmacs Build Reports should most likely
+go to."
+  :type '(repeat
+          :custom-show t
+          :documentation-shown t
+          string)
   :group 'build-report)
 
 (defcustom build-report-keep-regexp
-  (list
-   "make\\["
-   "error"
-   "warn"
-   "pure.*\\(space\\|size\\)"
-   "hides\\b"
-   "strange"
-   "shadowings"
-   "^Compilation"
-   "not\\s-+found")
-  "Regexp of make process output lines to keep in the report."
-  :type '(repeat regexp)
+  (quote ("^\\(cd\\|n?make\\)\\s-" "errors?" "warnings?"
+          "pure.*\\(space\\|size\\)" "hides\\b" "strange" "shadowings"
+          "^Compil\\(ing\\s-+in\\|ation\\)" "^Using" "not\\s-+found"
+          "^While\\s-+compiling.*\\(\n\\s-+.+\\)*" "^Note:"
+          "Installing" "[Ff]ile(s) copied"
+          "\\s-+tests\\s-+"))
+  "*Regexp of make process output lines to keep in the report."
+  :type '(repeat
+          :custom-show t
+          :documentation-shown t
+          regexp)
   :group 'build-report)
 
 (defcustom build-report-delete-regexp
-  (list
-   "confl.*with.*auto-inlining"
-   (concat (regexp-quote (gethash 'blddir (config-value-hash-table))) "/lisp/[^ \t\n]+ hides "))
-  "Regexp of make process output lines to delete from the report."
-  :type '(repeat regexp)
+  (quote ("confl.*with.*auto-inlining" "^Formatting:"))
+  "*Regexp of make process output lines to delete from the report."
+  :type '(repeat
+          :custom-show t
+          :documentation-shown t
+          regexp)
   :group 'build-report)
 
-(defcustom build-report-make-output-file
-  (concat (gethash 'blddir (config-value-hash-table)) "/beta.err")
-  "Filename where stdout and stderr of XEmacs make process have been stored.
-mk.err will not be created automatically. You'll have to run make with
-output redirection. I use an alias
+(defcustom build-report-make-output-dir
+  (cond 
+   ((equal system-type 'windows-nt)
+    (expand-file-name "nt"
+                      (gethash 'blddir (config-value-hash-table))))
+   (t
+    (gethash 'blddir (config-value-hash-table))))
+  "*Directory where the build report file is found.
+  If this is empty or nil, the default, it is replaced by the value of
+  the XEmacs build directory."
+  :type '(directory
+          :custom-show t
+          :documentation-shown t)
+  :group 'build-report)
+
+(defcustom build-report-make-output-files
+  (quote ("beta.err"))
+  "*List of Filenames where stdout and stderr of XEmacs make process
+have been stored.  These are relative to
+`build-report-make-output-dir`.  You'll have to run make with output
+redirection or use the `build' XEmacs package to save this output. You
+may use following alias
+
 alias mk 'make \!* >>&\! \!$.err &'
-for that, so that I get beta.err went I run `mk beta'."
-  :type 'file
+
+under csh, so that you get beta.err went you run `mk beta'."
+  :type '(repeat
+          :custom-show t
+          :documentation-shown t
+          file)
   :group 'build-report)
 
 (defcustom build-report-installation-file
-  (concat (gethash 'blddir (config-value-hash-table)) "/Installation")
-  "Installation file produced by XEmacs configure process."
-  :type 'file
+  (expand-file-name "Installation"
+                    (gethash 'blddir (config-value-hash-table)))
+  "*Installation file produced by XEmacs configure process."
+  :type '(file
+          :custom-show t
+          :documentation-shown t)
   :group 'build-report)
 
-(defcustom build-report-installation-insert-all nil
-  "Tell build-report to insert the whole Installation file
-instead of just the last report."
+(defcustom build-report-version-file
+  (expand-file-name
+   "version.sh"
+   (gethash 'blddir (config-value-hash-table)))
+  "*version.sh file identifying XEmacs (Beta) Distribution."
+  :type '(file
+          :custom-show t
+          :documentation-shown t)
+  :group 'build-report)
+
+(defcustom build-report-installation-insert-all
+  nil
+  "*Tell build-report to insert the whole Installation file
+  instead of just the last report."
   :type 'boolean
   :group 'build-report)
 
 (defcustom build-report-subject
   (concat "[%s] " emacs-version " on " system-configuration)
-  "XEmacs Build Report Subject Line. %s-sequences will be substituted
-with user input through `build-report' according to
-`build-report-prompts' using `format'."
-  :type 'string
+  "*XEmacs Build Report Subject Line. %s-sequences will be substituted
+  with user input through `build-report' according to
+  `build-report-prompts' using `format'."
+  :type '(string
+          :custom-show t
+          :documentation-shown t)
   :group 'build-report)
 
 (defcustom build-report-prompts
-  '(("Status?: "  "Success" "Failure"))
-  "XEmacs Build Report Prompt(s). This is a list of prompt-string
-lists used by `build-report' in conjunction with
-`build-report-subject'. Each list consists of a prompt string
-followed by any number of strings which can be chosen via the history
-mechanism."
+  (quote (("Status?: "  ("Success" "Failure"))))
+  "*XEmacs Build Report Prompt(s). This is a list of prompt-string
+  lists used by `build-report' in conjunction with
+  `build-report-subject'. Each list consists of a prompt string
+  followed by any number of strings which can be chosen via the history
+  mechanism."
+  :type '(repeat
+          :custom-show t
+          :documentation-shown t
+          (list
+           :tag "Prompt"
+           string
+           (repeat
+            :tag "Values"
+            string)))
   :group 'build-report)
 
 (defcustom build-report-file-encoding
   "7bit"
-  "XEmacs Build Report File Encoding to be used when MIME support is
-available."
+  "*XEmacs Build Report File Encoding to be used when MIME support is
+  available."
   :group 'build-report)
 
 ;; Symbol Name mappings from TM to SEMI serving as Compatibility
@@ -151,45 +229,113 @@ available."
     (defalias 'mime-edit-insert-binary-file
       'mime-editor/insert-binary-file)))
 
+(defun build-report-make-output-get ()
+  "Returns the filename the XEmacs make output is saved in."
+  (interactive)
+  (if (or (string-equal build-report-make-output-dir "")
+          (null build-report-make-output-dir))
+      (mapcar
+       (function
+        (lambda (f)
+          (expand-file-name
+           f
+           (file-name-as-directory
+            (gethash 'blddir (config-value-hash-table))))))
+       build-report-make-output-files)
+    (mapcar
+     (function
+      (lambda (f)
+        (expand-file-name
+         f
+         (file-name-as-directory build-report-make-output-dir))))
+     build-report-make-output-files)))
+
 ;;;###autoload
 (defun build-report (&rest args)
-  "Initializes a fresh mail composition buffer using `compose-mail'
-with the contents of XEmacs Installation file and excerpts from XEmacs
-make output and errors and leaves point at the beginning of the mail text.
- See also
-`compose-mail', `mail-user-agent',
-`build-report-destination',
-`build-report-keep-regexp',
-`build-report-delete-regexp',
-`build-report-make-output-file' and
-`build-report-installation-file'."
+  "Composes a fresh mail message with the contents of the built XEmacs
+Installation file and excerpts from XEmacs make output.
+`compose-mail' is used to create the mail message.  Point is left at
+the beginning of the mail text.  You may add some personal notes if
+you like and send the report.
+See also
+  `compose-mail', `mail-user-agent',
+  `build-report-destination',
+  `build-report-keep-regexp',
+  `build-report-delete-regexp',
+  `build-report-make-output-dir',
+  `build-report-make-output-files', and
+  `build-report-installation-file'."
+  ;; `interactive' form returns value for formal parameter `args'.
   (interactive
    (let (prompt
-        hist
-        arg
-        (prompts build-report-prompts))
+         hist
+         arg
+         (prompts build-report-prompts))
      (progn
        (while prompts
-        (defvar hist)
-        (setq prompt (caar prompts))
-        (setq hist (cdar prompts))
-        (setq prompts (cdr prompts))
-        (setq arg (cons (read-string prompt "" 'hist) arg)))
+         (defvar hist)
+         (setq prompt (caar prompts))
+         (setq hist (cdar prompts))
+         ;; `build-report-prompts' used to be a list of lists, the
+         ;; first element of each list being the prompt, the rest being
+         ;; the history.  The history is now in a separate list.  We
+         ;; better check for that.
+         (if (listp (car hist))
+             (setq hist (car hist)))
+         (setq prompts (cdr prompts))
+         (setq arg (cons (read-string prompt "" 'hist) arg)))
        arg)))
   (save-excursion
+    (if (file-exists-p build-report-installation-file)
+        (multiple-value-bind
+            (major minor beta codename configuration)
+            (build-report-installation-data build-report-installation-file)
+          (setq build-report-subject
+                (format "[%%s] XEmacs %s.%s%s \"%s\", %s"
+                        major minor beta codename configuration)))
+      (multiple-value-bind
+          (major minor beta codename)
+          (build-report-version-file-data build-report-version-file)
+        (setq build-report-subject
+              (format "[%%s] XEmacs %s.%s%s \"%s\", %s"
+                      major minor beta codename system-configuration))))
     (compose-mail
-     build-report-destination
+     ;; `build-report-destination' used to be a single string, so
+     ;; let's test if we really get a list of destinations.
+     (if (listp build-report-destination)
+         (read-string
+          "Build Report Destination: "
+          (car build-report-destination)
+          'build-report-destination)
+       (read-string
+        "Build Report Destination: "
+        build-report-destination)
+       )
      (apply 'format build-report-subject args)
      nil
      nil
      nil
      nil
      nil)
-    (let ((report-begin (point)))
-      (insert (build-report-insert-make-output report-begin))
-      (insert (build-report-insert-installation-file
-              report-begin
-              build-report-installation-insert-all))
+    (let* ((report-begin (point))
+           (files (reverse (build-report-make-output-get)))
+           (file (car files)))
+      (while file
+        (if (file-exists-p file)
+            (insert (build-report-insert-make-output report-begin file))
+          (insert (format "%s not found!\n" file)))
+        (insert "\n")
+        (setq files (cdr files))
+        (setq file (car files)))
+      (if (file-exists-p build-report-installation-file)
+          (insert (build-report-insert-installation-file
+                   report-begin
+                   build-report-installation-insert-all))
+        (insert (format "%s not found!\n" build-report-installation-file)))
+;;;       (when (and (>= major 21) (>= minor 2) (or (null beta) (>= beta 32)))
+;;;         (insert "\n")
+;;;         (insert (build-report-insert-config-inc report-begin)))
+      (insert "\n")
       (insert (build-report-insert-header report-begin))
       (goto-char report-begin))))
 
@@ -197,48 +343,69 @@ make output and errors and leaves point at the beginning of the mail text.
   "Inserts the build-report-header at the point specified by `where'."
   (goto-char where)
   (with-temp-buffer
-    (insert "\n> XEmacs Build Report as generated\n> by"
-           " build-report-version "
-           build-report-version " follows:\n\n")
+    (insert
+     (format "
+> XEmacs Build Report generated by emacs-version
+> %s
+> with system-configuration
+> %s
+> follows:\n\n" emacs-version system-configuration))
     (buffer-string)))
 
-(defun build-report-insert-make-output (where)
-  "Inserts the output of the XEmacs Beta make run.
+(defun build-report-insert-make-output (where file)
+  "Inserts the output of the XEmacs Beta make run in the
+current buffer at position WHERE.
 The make process output must have been saved in
-`build-report-make-output-file' during the XEmacs Beta building."
+`build-report-make-output-files' during the XEmacs Beta building."
   (goto-char where)
   (with-temp-buffer
-    (if (file-exists-p build-report-make-output-file)
-       (progn
-         (if (featurep 'mime-setup)
-             (progn
-               (mime-edit-insert-tag
-                "text"
-                "plain"
-                (concat
-                 "\nContent-Disposition: attachment;"
-                 " filename=\""
-                 (file-name-nondirectory
-                  build-report-make-output-file)
-                 "\""))
-               (mime-edit-insert-binary-file
-                build-report-make-output-file
-                build-report-file-encoding))
-           (insert-file-contents build-report-make-output-file))
-         (goto-char (point-min))
-         (delete-non-matching-lines (build-report-keep))
-         (goto-char (point-min))
-         (delete-matching-lines (build-report-delete))
-         (goto-char (point-min))
-         (insert "> Contents of "
-                 build-report-make-output-file
-                 "\n> keeping lines matching\n> \""
-                 (build-report-keep)
-                 "\"\n> and then deleting lines matching\n> \""
-                 (build-report-delete)
-                 "\"\n\n"))
-      (insert "> " build-report-make-output-file
-             " does not exist!\n\n"))
+    (if (file-exists-p file)
+        (progn
+          (if (featurep 'mime-setup)
+              (progn
+                (mime-edit-insert-tag
+                 "text"
+                 "plain"
+                 (concat
+                  "\nContent-Disposition: attachment;"
+                  " filename=\""
+                  (file-name-nondirectory
+                   file)
+                  "\""))
+                (mime-edit-insert-binary-file
+                 file
+                 build-report-file-encoding))
+            (insert-file-contents file))
+          (when build-report-keep-regexp
+            (goto-char (point-min))
+            (delete-non-matching-lines (build-report-keep)))
+          (when build-report-delete-regexp
+            (goto-char (point-min))
+            (delete-matching-lines (build-report-delete)))
+          (goto-char (point-min))
+          (if build-report-keep-regexp
+              (insert
+               (format
+                "> keeping lines matching
+> \"%s\"
+"
+                (build-report-keep))))
+          (if build-report-delete-regexp
+              (insert
+               (format
+                "> %sdeleting lines matching
+> \"%s\"
+"
+                (if build-report-keep-regexp
+                    "and then "
+                  "")
+                (build-report-delete))))
+          (insert "\n")
+          (goto-char (point-min))
+          (insert
+           (format "> Contents of %s\n" file)))
+      (insert "> " file
+              " does not exist!\n\n"))
     (buffer-string)))
 
 (defun build-report-insert-installation-file (where all)
@@ -247,50 +414,116 @@ created by the XEmacs Beta configure process."
   (goto-char where)
   (with-temp-buffer
     (if (file-exists-p build-report-installation-file)
-       (let (file-begin last-configure)
-         (insert "> Contents of "
-                 build-report-installation-file
-                 ":\n")
-         (insert
-          (format
-           "> (Output from %s of ./configure)\n\n"
-           (if all "all runs" "most recent run")))
-         (if (featurep 'mime-setup)
-             (progn
-               (mime-edit-insert-tag
-                "text"
-                "plain"
-                (concat
-                 "\nContent-Disposition: attachment;"
-                 " filename=\""
-                 (file-name-nondirectory
-                  build-report-installation-file)
-                 "\""))
-               (mime-edit-insert-binary-file
-                build-report-installation-file
-                build-report-file-encoding)
-               (setq file-begin (mime-edit-content-beginning)))
-           (setq file-begin (point))
-           (insert-file-contents
-            build-report-installation-file))
-         (unless all
-           (setq last-configure
-                 (search-backward-regexp
-                  "^\\(uname.*\\|osversion\\):\\s-+" file-begin t))
-           (if (and file-begin last-configure)
-               (delete-region file-begin last-configure))))
+        (let (file-begin last-configure)
+          (insert "> Contents of "
+                  build-report-installation-file
+                  ":\n")
+          (insert
+           (format
+            "> (Output from %s of ./configure)\n\n"
+            (if all "all runs" "most recent run")))
+          (if (featurep 'mime-setup)
+              (progn
+                (mime-edit-insert-tag
+                 "text"
+                 "plain"
+                 (concat
+                  "\nContent-Disposition: attachment;"
+                  " filename=\""
+                  (file-name-nondirectory
+                   build-report-installation-file)
+                  "\""))
+                (mime-edit-insert-binary-file
+                 build-report-installation-file
+                 build-report-file-encoding)
+                (setq file-begin (mime-edit-content-beginning)))
+            (setq file-begin (point))
+            (insert-file-contents
+             build-report-installation-file))
+          (unless all
+            (setq last-configure
+                  (search-backward-regexp
+                   "^\\(uname.*\\|osversion\\|OS\\):\\s-+" file-begin t))
+            (if (and file-begin last-configure)
+                (delete-region file-begin last-configure))))
       (insert "> " build-report-installation-file
-             " does not exist!\n\n"))
+              " does not exist!\n\n"))
     (buffer-string)))
 
 (defun build-report-keep ()
-  "build-report-internal function of no general value."
+  "Concatenate elements of `build-report-keep-regexp' and a general
+MIME tag REGEXP.  The result is a REGEXP string matching either of the
+REGEXPs in `build-report-keep-regexp' or a general MIME tag REGEXP."
   (mapconcat #'identity
-            (cons "^--\\[\\[\\|\\]\\]$" build-report-keep-regexp) "\\|"))
+             (cons "^--\\[\\[\\|\\]\\]$" build-report-keep-regexp) "\\|"))
 
 (defun build-report-delete ()
-  "build-report-internal function of no general value."
-  (mapconcat #'identity
-            build-report-delete-regexp "\\|"))
+  "Concatenate elements of `build-report-delete-regexp' and a general
+MIME tag REGEXP.  The result is a REGEXP string matching either of the
+REGEXPs in `build-report-delete-regexp' or a general MIME tag REGEXP."
+  (mapconcat '(lambda (item) item)
+             build-report-delete-regexp "\\|"))
+
+(defun build-report-installation-data (&optional file)
+  "Return a list of XEmacs installation data containing MAJOR_NUMBER
+MINOR_NUMBER BETA_STRING CODENAME CONFIGURATION SRCDIR from FILE,
+which defaults to `build-report-installation-file'."
+  (interactive "fInstallation file: ")
+  (unless file
+    (setq file build-report-installation-file))
+  (let
+      (major minor beta codename configuration srcdir)
+    (save-window-excursion
+      (find-file-read-only file)
+      (goto-char (point-min))
+      (while (< (point) (point-max))
+        (cond
+         ((looking-at build-report-installation-version-regexp)
+          (goto-char (match-end 0))
+          (setq major (match-string 1))
+          (setq minor (match-string 2))
+          (setq beta (match-string 3))
+          (setq codename (match-string 6))
+          (setq configuration (match-string 7)))
+         ((looking-at build-report-installation-srcdir-regexp)
+          (goto-char (match-end 0))
+          (setq srcdir (match-string 1)))
+         ;; We avoid matching a potentially zero-length string to avoid
+         ;; infinite looping.
+         ((looking-at
+           "^.+$")
+          (goto-char (match-end 0)))
+         ((looking-at "\n")
+          (goto-char (match-end 0)))))
+      (values major minor (or beta "") codename configuration srcdir))))
+
+(defun build-report-version-file-data (&optional file)
+  "Return a list of XEmacs version information containing
+MAJOR_NUMBER MINOR_NUMBER BETA_STRING CODENAME from FILE, which
+defaults to `build-report-version-file'." 
+  (interactive "fversion.sh file: ")
+  (unless file
+    (setq file build-report-version-file))
+  (let
+      (major minor beta codename)
+    (save-window-excursion
+      (find-file-read-only file)
+      (goto-char (point-min))
+      (while (< (point) (point-max))
+        (cond
+         ((looking-at build-report-version-file-regexp)
+          (goto-char (match-end 0))
+          (setq major (match-string 1))
+          (setq minor (match-string 2))
+          (setq beta (match-string 3))
+          (setq codename (match-string 4)))
+         ;; We avoid matching a potentially zero-length string to avoid
+         ;; infinite looping.
+         ((looking-at
+           "^.+$")
+          (goto-char (match-end 0)))
+         ((looking-at "\n")
+          (goto-char (match-end 0)))))
+      (values major minor (or beta "") codename))))
 
 ;;; build-report.el ends here
index 2ab79db..b18664b 100644 (file)
   ;; fetch and return the offset for the current opcode.
   ;; return NIL if this opcode has no offset
   ;; OP, PTR and BYTES are used and set dynamically
-  (defvar op)
-  (defvar ptr)
-  (defvar bytes)
+  (declare (special op ptr bytes))
   (cond ((< op byte-nth)
         (let ((tem (logand op 7)))
           (setq op (logand op 248))
 
 (defun byte-optimize-lapcode (lap &optional for-effect)
   "Simple peephole optimizer.  LAP is both modified and returned."
-  (let (lap0 ;; off0 unused
-       lap1 ;; off1
-       lap2 ;; off2
+  (let (lap0
+       lap1
+       lap2
+       variable-frequency
        (keep-going 'first-time)
        (add-depth 0)
        rest tmp tmp2 tmp3
     ;; Rebuild byte-compile-constants / byte-compile-variables.
     ;; Simple optimizations that would inhibit other optimizations if they
     ;; were done in the optimizing loop, and optimizations which there is no
-    ;;  need to do more than once.
+    ;; need to do more than once.
     (setq byte-compile-constants nil
-         byte-compile-variables nil)
+         byte-compile-variables nil
+         variable-frequency (make-hash-table :test 'eq))
     (setq rest lap)
     (while rest
       (setq lap0 (car rest)
            lap1 (nth 1 rest))
-      (if (memq (car lap0) byte-constref-ops)
-         (if (eq (cdr lap0) 'byte-constant)
-             (or (memq (cdr lap0) byte-compile-variables)
-                 (setq byte-compile-variables (cons (cdr lap0)
-                                                    byte-compile-variables)))
-           (or (memq (cdr lap0) byte-compile-constants)
-               (setq byte-compile-constants (cons (cdr lap0)
-                                                  byte-compile-constants)))))
+      (case (car lap0)
+       ((byte-varref byte-varset byte-varbind)
+        (incf (gethash (cdr lap0) variable-frequency 0))
+        (unless (memq (cdr lap0) byte-compile-variables)
+          (push (cdr lap0) byte-compile-variables)))
+       ((byte-constant)
+        (unless (memq (cdr lap0) byte-compile-constants)
+          (push (cdr lap0) byte-compile-constants))))
       (cond (;;
-            ;; const-C varset-X const-C  -->  const-C dup varset-X
+            ;; const-C varset-X  const-C  -->  const-C dup varset-X
             ;; const-C varbind-X const-C  -->  const-C dup varbind-X
             ;;
             (and (eq (car lap0) 'byte-constant)
                  (eq (car (nth 2 rest)) 'byte-constant)
-                 (eq (cdr lap0) (car (nth 2 rest)))
+                 (eq (cdr lap0) (cdr (nth 2 rest)))
                  (memq (car lap1) '(byte-varbind byte-varset)))
             (byte-compile-log-lap "  %s %s %s\t-->\t%s dup %s"
                                   lap0 lap1 lap0 lap0 lap1)
             (setcdr lap1 (+ (cdr lap1) (cdr lap0))))
            )
       (setq rest (cdr rest)))
+    ;; Since the first 6 entries of the compiled-function constants
+    ;; vector are most efficient for varref/set/bind ops, we sort by
+    ;; reference count.  This generates maximally space efficient and
+    ;; pretty time-efficient byte-code.  See `byte-compile-constants-vector'.
+    (setq byte-compile-variables
+         (sort byte-compile-variables
+               #'(lambda (v1 v2)
+                   (< (gethash v1 variable-frequency)
+                      (gethash v2 variable-frequency)))))
+    ;; Another hack - put the most used variable in position 6, for
+    ;; better locality of reference with adjoining constants.
+    (let ((tail (last byte-compile-variables 6)))
+      (setq byte-compile-variables
+           (append (nbutlast byte-compile-variables 6)
+                   (nreverse tail))))
     (setq byte-compile-maxdepth (+ byte-compile-maxdepth add-depth)))
   lap)
 
index 9a9d3a0..3299793 100644 (file)
@@ -1413,10 +1413,10 @@ values.  For compatibility, (values A B C) is a synonym for (list A B C)."
   (cond ((eq (car-safe spec) 'special)
         (if (boundp 'byte-compile-bound-variables)
             (setq byte-compile-bound-variables
-                  ;; todo: this should compute correct binding bits vs. 0
-                  (append (mapcar #'(lambda (v) (cons v 0))
-                                  (cdr spec))
-                          byte-compile-bound-variables))))
+                  (append
+                   (mapcar #'(lambda (v) (cons v byte-compile-global-bit))
+                           (cdr spec))
+                   byte-compile-bound-variables))))
 
        ((eq (car-safe spec) 'inline)
         (while (setq spec (cdr spec))
@@ -1769,6 +1769,7 @@ Example: (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))."
 (defsetf x-get-cut-buffer x-store-cut-buffer t)   ; groan.
 (defsetf x-get-secondary-selection x-own-secondary-selection t)
 (defsetf x-get-selection x-own-selection t)
+(defsetf get-selection own-selection t)
 
 ;;; More complex setf-methods.
 ;;; These should take &environment arguments, but since full arglists aren't
index 3f0ed88..c97378f 100644 (file)
@@ -355,7 +355,7 @@ Also see: `remove*', `delete', `delete*'"
   (remove* cl-item cl-seq ':test 'equal))
 
 (defun remq (cl-elt cl-list)
-  "Remove all occurances of ELT in LIST, comparing with `eq'.
+  "Remove all occurrences of ELT in LIST, comparing with `eq'.
 This is a non-destructive function; it makes a copy of LIST to avoid
 corrupting the original LIST.
 Also see: `delq', `delete', `delete*', `remove', `remove*'."
index e2ec4c5..03cfdf1 100644 (file)
@@ -269,7 +269,7 @@ If FORM is not a macro call, it is returned unchanged.
 Otherwise, the macro is expanded and the expansion is considered
 in place of FORM.  When a non-macro-call results, it is returned.
 
-The second optional arg ENVIRONMENT species an environment of macro
+The second optional arg ENVIRONMENT specifies an environment of macro
 definitions to shadow the loaded ones for use in file byte-compilation."
   (let ((cl-macro-environment cl-env))
     (while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env))
index 215fc8d..17989d0 100644 (file)
@@ -462,9 +462,28 @@ and can edit it until it has been confirmed."
                (sleep-for 2))))
       ans)))
 
-;; these may be redefined later, but make the original def easily encapsulable
-(define-function 'yes-or-no-p 'yes-or-no-p-minibuf)
-(define-function 'y-or-n-p 'y-or-n-p-minibuf)
+(defun yes-or-no-p (prompt)
+  "Ask user a yes-or-no question.  Return t if answer is yes.
+The question is asked with a dialog box or the minibuffer, as appropriate.
+Takes one argument, which is the string to display to ask the question.
+It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.
+The user must confirm the answer with RET,
+and can edit it until it as been confirmed."
+  (if (should-use-dialog-box-p)
+      (yes-or-no-p-dialog-box prompt)
+    (yes-or-no-p-minibuf prompt)))
+
+(defun y-or-n-p (prompt)
+  "Ask user a \"y or n\" question.  Return t if answer is \"y\".
+Takes one argument, which is the string to display to ask the question.
+The question is asked with a dialog box or the minibuffer, as appropriate.
+It should end in a space; `y-or-n-p' adds `(y or n) ' to it.
+No confirmation of the answer is requested; a single character is enough.
+Also accepts Space to mean yes, or Delete to mean no."
+  (if (should-use-dialog-box-p)
+      (yes-or-no-p-dialog-box prompt)
+    (y-or-n-p-minibuf prompt)))
+
 \f
 
 (defun read-char ()
index d854348..f3d138a 100644 (file)
@@ -551,9 +551,4 @@ See also `write-region-pre-hook' and `write-region-post-hook'."
                        start end filename append visit lockname
                        coding-system)))
 
-;;; The following was all that remained in mule-files.el, so I moved it
-;;; here for neatness.  -sb
-(when (featurep 'mule)
-  (setq-default buffer-file-coding-system 'iso-2022-8))
-
 ;;; code-files.el ends here
index a60b620..1b248dc 100644 (file)
@@ -211,7 +211,7 @@ Fifth argument PROTOCOL is a network protocol.  Currently 'tcp
  (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
  supported.  When omitted, 'tcp is assumed.
 
-Ouput via `process-send-string' and input via buffer or filter (see
+Output via `process-send-string' and input via buffer or filter (see
 `set-process-filter') are stream-oriented.  That means UDP datagrams are
 not guaranteed to be sent and received in discrete packets. (But small
 datagrams around 500 bytes that are not truncated by `process-send-string'
index fb14885..98c8048 100644 (file)
@@ -31,7 +31,8 @@
 ;;; Commentary:
 
 ;; This file generates the custom-load files, loaded by cus-load.el.
-;; The only entry point is `Custom-make-dependencies'.
+;; Entry points are `Custom-make-dependencies' and
+;; `Custom-make-one-dependency'.
 
 ;; It works by scanning all the `.el' files in a directory, and
 ;; evaluates any `defcustom', `defgroup', or `defface' expression that
 ;; understand, but is in fact very easy to break.  Be sure to read and
 ;; understand the commentary above!
 
-;;;###autoload
-(defun Custom-make-dependencies (&optional subdirs)
-  "Extract custom dependencies from .el files in SUBDIRS.
-SUBDIRS is a list of directories.  If it is nil, the command-line
-arguments are used.  If it is a string, only that directory is
-processed.  This function is especially useful in batch mode.
-
-Batch usage: xemacs -batch -l cus-dep.el -f Custom-make-dependencies DIRS"
-  (interactive "DDirectory: ")
-  (and (stringp subdirs)
-       (setq subdirs (list subdirs)))
-  (or subdirs
-      ;; Usurp the command-line-args
-      (setq subdirs command-line-args-left
-           command-line-args-left nil))
+(defun Custom-make-dependencies-1 (subdirs)
   (setq subdirs (mapcar #'expand-file-name subdirs))
   (with-temp-buffer
     (let ((enable-local-eval nil)
@@ -182,6 +169,31 @@ Batch usage: xemacs -batch -l cus-dep.el -f Custom-make-dependencies DIRS"
                (insert "\n;;; custom-load.el ends here\n"))
              (clrhash hash)))))))))
 
+(defun Custom-make-one-dependency ()
+  "Extract custom dependencies from .el files in one dir, on the command line.
+Like `Custom-make-dependencies' but snarfs only one command-line argument,
+making it useful in a chain of batch commands in a single XEmacs invocation."
+  (let ((subdir (car command-line-args-left)))
+    (setq command-line-args-left (cdr command-line-args-left))
+    (Custom-make-dependencies-1 (list subdir))))
+
+;;;###autoload
+(defun Custom-make-dependencies (&optional subdirs)
+  "Extract custom dependencies from .el files in SUBDIRS.
+SUBDIRS is a list of directories.  If it is nil, the command-line
+arguments are used.  If it is a string, only that directory is
+processed.  This function is especially useful in batch mode.
+
+Batch usage: xemacs -batch -l cus-dep.el -f Custom-make-dependencies DIRS"
+  (interactive "DDirectory: ")
+  (and (stringp subdirs)
+       (setq subdirs (list subdirs)))
+  (or subdirs
+      ;; Usurp the command-line-args
+      (setq subdirs command-line-args-left
+           command-line-args-left nil))
+  (Custom-make-dependencies-1 subdirs))
+
 (provide 'cus-dep)
 
 ;;; cus-dep.el ends here
index 681f8bc..1d528c7 100644 (file)
@@ -3344,6 +3344,7 @@ Leave point at the location of the call, or after the last expression."
 
 (defun custom-save-resets (property setter special)
   (let (started-writing ignored-special)
+    (setq ignored-special ignored-special) ;; suppress byte-compiler warning
     ;; (custom-save-delete setter) Done by caller 
     (let ((standard-output (current-buffer))
          (mapper `(lambda (object)
@@ -3367,7 +3368,8 @@ Leave point at the location of the call, or after the last expression."
       (setq ignored-special special)
       (mapatoms mapper)
       (when started-writing
-       (princ ")\n")))))
+       (princ ")\n"))))
+    )
                        
 
 (defun custom-save-loaded-themes ()
index 36e2d32..656f710 100644 (file)
@@ -309,7 +309,7 @@ FACE.  Nil otherwise."
 (defun custom-theme-reset-faces (theme &rest args)
   (custom-check-theme theme)
   "Reset the value of the face to values previously defined.
-Assosiate this setting with THEME.
+Associate this setting with THEME.
 
 ARGS is a list of lists of the form
 
@@ -324,7 +324,7 @@ This means reset face to its value in to-theme."
 ;;;###autoload
 (defun custom-reset-faces (&rest args)
   "Reset the value of the face to values previously defined.
-Assosiate this setting with the 'user' theme.
+Associate this setting with the 'user' theme.
 
 ARGS is defined as for `custom-theme-reset-faces'"
   (apply #'custom-theme-reset-faces 'user args))
index 29486f5..20f02ab 100644 (file)
@@ -185,7 +185,7 @@ The following KEYWORD's are defined:
         the current value for that symbol.  The default is
         `default-value'.
 :require VALUE should be a feature symbol.  Each feature will be
-        required after initialization, of the the user have saved this
+        required after initialization, of the user have saved this
         option.
 
 Read the section about customization in the Emacs Lisp manual for more
@@ -395,7 +395,7 @@ LOAD should be either a library file name, or a feature name."
   "(deftheme THEME &optional DOC &key KEYWORDS)
 
 Define a theme labeled by SYMBOL THEME. The optional argument DOC is a
-doc string describing the the theme. It is optionally followed by the
+doc string describing the theme. It is optionally followed by the
 following keyboard arguments
 
 :short-description DESC
@@ -535,7 +535,7 @@ See `custom-set-variables' for a description of the arguments ARGS."
 
 (defun custom-theme-load-themes (by-theme &rest body)
   "Load the themes specified by BODY and record them as required by
-theme BY-THEME. BODY is a secuence of
+theme BY-THEME. BODY is a sequence of
        - a SYMBOL
             require the theme SYMBOL
        - a list (reset THEME)
@@ -565,7 +565,7 @@ BODY is as with custom-theme-load-themes."
 
 
 (defsubst copy-upto-last (elt list)
-  "Copy all the elements of the list upto the last occurence of elt"
+  "Copy all the elements of the list upto the last occurrence of elt"
   ;; Is it faster to do more work in C than to do less in elisp?
   (nreverse (cdr (member elt (reverse list)))))
 
@@ -614,7 +614,7 @@ VARIABLE.  Nil otherwise."
 
 (defun custom-theme-reset-variables (theme &rest args)
   "Reset the value of the variables to values previously defined.
-Assosiate this setting with THEME.
+Associate this setting with THEME.
 
 ARGS is a list of lists of the form
 
@@ -629,7 +629,7 @@ This means reset variable to its value in to-theme."
 
 (defun custom-reset-variables (&rest args)
     "Reset the value of the variables to values previously defined.
-Assosiate this setting with the `user' theme.
+Associate this setting with the `user' theme.
 
 The ARGS are as in `custom-theme-reset-variables'."
     (apply #'custom-theme-reset-variables 'user args))
index bd94eaa..cdfbe55 100644 (file)
@@ -1,6 +1,7 @@
 ;;; dialog.el --- Dialog-box support for XEmacs
 
 ;; Copyright (C) 1991-4, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 2000 Ben Wing.
 
 ;; Maintainer: XEmacs Development Team
 ;; Keywords: extensions, internal, dumped
 Return t if the answer is \"yes\".
 Takes one argument, which is the string to display to ask the question."
   (save-selected-frame
-    (popup-dialog-box
-     (list prompt ["Yes" yes t] ["No" no t] nil ["Cancel" cancel t]))
-    (let (event)
-      (catch 'ynp-done
-       (while t
-         (setq event (next-command-event event))
-         (when (misc-user-event-p event)
-           (message "%s" (event-object event))
-           (case (event-object event)
-             ((yes) (throw 'ynp-done t))
-             ((no)  (throw 'ynp-done nil))
-             ((cancel menu-no-selection-hook) (signal 'quit nil))))
-         (unless (button-release-event-p event) ; don't beep twice
-           (beep)
-           (message "please answer the dialog box")))))))
-
-(defun yes-or-no-p-maybe-dialog-box (prompt)
-  "Ask user a yes-or-no question.  Return t if answer is yes.
-The question is asked with a dialog box or the minibuffer, as appropriate.
-Takes one argument, which is the string to display to ask the question.
-It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.
-The user must confirm the answer with RET,
-and can edit it until it as been confirmed."
-  (if (should-use-dialog-box-p)
-      (yes-or-no-p-dialog-box prompt)
-    (yes-or-no-p-minibuf prompt)))
-
-(defun y-or-n-p-maybe-dialog-box (prompt)
-  "Ask user a \"y or n\" question.  Return t if answer is \"y\".
-Takes one argument, which is the string to display to ask the question.
-The question is asked with a dialog box or the minibuffer, as appropriate.
-It should end in a space; `y-or-n-p' adds `(y or n) ' to it.
-No confirmation of the answer is requested; a single character is enough.
-Also accepts Space to mean yes, or Delete to mean no."
-  (if (should-use-dialog-box-p)
-      (yes-or-no-p-dialog-box prompt)
-    (y-or-n-p-minibuf prompt)))
-
-(when (fboundp 'popup-dialog-box)
-  (fset 'yes-or-no-p 'yes-or-no-p-maybe-dialog-box)
-  (fset 'y-or-n-p 'y-or-n-p-maybe-dialog-box))
+    (make-dialog-box 'question
+                    :question prompt
+                    :modal t
+                    :buttons '(["Yes" (dialog-box-finish t)]
+                               ["No" (dialog-box-finish nil)]
+                               nil
+                               ["Cancel" (dialog-box-cancel)]))))
 
-;; this is call-compatible with the horribly-named FSF Emacs function
-;; `x-popup-dialog'.  I refuse to use that name.
+;; FSF has a similar function `x-popup-dialog'.
 (defun get-dialog-box-response (position contents)
-  ;; by Stig@hackvan.com
-  ;; modified by pez@atlantic2.sbi.com
   "Pop up a dialog box and return user's selection.
 POSITION specifies which frame to use.
 This is normally an event or a window or frame.
@@ -110,21 +74,20 @@ on the left of the dialog box and all following items on the right."
     (select-frame position))
    ((windowp position)
     (select-window position)))
-  (let ((dbox (cons (car contents)
-                   (mapcar #'(lambda (x)
-                               (cond
-                                ((null x)
-                                 nil)
-                                ((stringp x)
-                                 `[,x 'ignore nil]) ;this will never get
-                                                    ;selected
-                                (t
-                                 `[,(car x) (throw 'result ',(cdr x)) t])))
-                           (cdr contents))
-                   )))
-    (catch 'result
-      (popup-dialog-box dbox)
-      (dispatch-event (next-command-event)))))
+  (make-dialog-box 'question
+                  :question (car contents)
+                  :modal t
+                  :buttons
+                  (mapcar #'(lambda (x)
+                              (cond
+                               ((null x)
+                                nil)
+                               ((stringp x)
+                                ;;this will never get selected
+                                `[,x 'ignore nil])
+                               (t
+                                `[,(car x) (dialog-box-finish ',(cdr x)) t])))
+                          (cdr contents))))
 
 (defun message-box (fmt &rest args)
   "Display a message, in a dialog box if possible.
@@ -144,8 +107,8 @@ minibuffer contents show."
       str)))
 
 (defun message-or-box (fmt &rest args)
-  "Display a message in a dialog box or in the echo area.\n\
-If this command was invoked with the mouse, use a dialog box.\n\
+  "Display a message in a dialog box or in the echo area.
+If this command was invoked with the mouse, use a dialog box.
 Otherwise, use the echo area.
 The arguments are the same as to `format'.
 
@@ -155,63 +118,582 @@ minibuffer contents show."
       (apply 'message-box fmt args)
     (apply 'message fmt args)))
 
-(defun make-dialog-box (&optional spec props parent)
-  "Create a frame suitable for use as a general dialog box.
-The frame is made a child of PARENT (defaults to the selected frame),
-and has additional properties PROPS, as well as `dialog-frame-plist'.
-SPEC is a string or glyph to be placed in the gutter. If INVISIBLE is
-non-nil then the frame is initially unmapped.
-Normally the created frame has no modelines, menubars, scrollbars,
-minibuffer or toolbars and is entirely covered by its gutter."
-  (or parent (setq parent (selected-frame)))
-  (let* ((ftop (frame-property parent 'top))
-        (fleft (frame-property parent 'left))
-        (fwidth (frame-pixel-width parent))
-        (fheight (frame-pixel-height parent))
-        (fonth (font-height (face-font 'default)))
-        (fontw (font-width (face-font 'default)))
-        (props (append props dialog-frame-plist))
-        (dfheight (plist-get props 'height))
-        (dfwidth (plist-get props 'width))
-        (unmapped (plist-get props 'initially-unmapped))
-        (gutter-spec spec)
-        (name (or (plist-get props 'name) "XEmacs"))
-        (frame nil))
-    (plist-remprop props 'initially-unmapped)
-    ;; allow the user to just provide a glyph
-    (when (glyphp spec)
-      (setq gutter-spec (copy-sequence "\n"))
-      (set-extent-begin-glyph (make-extent 0 1 gutter-spec) spec))
-    ;; under FVWM at least, if I don't specify the initial position,
-    ;; it ends up always at (0, 0).  xwininfo doesn't tell me
-    ;; that there are any program-specified position hints, so
-    ;; it must be an FVWM bug.  So just be smashing and position
-    ;; in the center of the selected frame.
-    (setq frame (make-frame
-                (append props
-                        `(popup ,parent initially-unmapped t
-                                menubar-visible-p nil
-                                has-modeline-p nil
-                                default-toolbar-visible-p nil
-                                top-gutter-visible-p t
-                                top-gutter-height ,(* dfheight fonth)
-                                top-gutter ,gutter-spec
-                                minibuffer none
-                                name ,name
-                                modeline-shadow-thickness 0
-                                vertical-scrollbar-visible-p nil
-                                horizontal-scrollbar-visible-p nil
-                                unsplittable t
-                                left ,(+ fleft (- (/ fwidth 2)
-                                                  (/ (* dfwidth fontw)
-                                                     2)))
-                                top ,(+ ftop (- (/ fheight 2)
-                                                (/ (* dfheight fonth)
-                                                   2)))))))
-    (set-face-foreground 'modeline [default foreground] frame)
-    (set-face-background 'modeline [default background] frame)
-    (unless unmapped (make-frame-visible frame))
-    frame))
+(defun make-dialog-box (type &rest cl-keys)
+  "Pop up a dialog box.
+TYPE is a symbol, the type of dialog box.  Remaining arguments are
+keyword-value pairs, specifying the particular characteristics of the
+dialog box.  The allowed keywords are particular to each type, but
+some standard keywords are common to many types:
+
+:title
+  The title of the dialog box's window.
+
+:modal
+  If true, indicates that XEmacs will wait until the user is \"done\"
+  with the dialog box (usually, this means that a response has been
+  given).  Typically, the response is returned.  NOTE: Some dialog
+  boxes are always modal.  If the dialog box is modal, `make-dialog-box'
+  returns immediately.  The return value will be either nil or a
+  dialog box handle of some sort, e.g. a frame for type `general'.
+
+---------------------------------------------------------------------------
+
+Recognized types are
+
+general
+  A dialog box consisting of an XEmacs glyph, typically a `layout'
+  widget specifying a dialog box arrangement.  This is the most
+  general and powerful dialog box type, but requires more work than
+  the other types below.
+
+question
+  A simple dialog box that displays a question and contains one or
+  more user-defined buttons to specify possible responses. (This is
+  compatible with the old built-in dialog boxes formerly specified
+  using `popup-dialog-box'.)
+
+file
+  A file dialog box, of the type typically used in the window system
+  XEmacs is running on.
+
+color
+  A color picker.
+
+find
+  A find dialog box.
+
+font
+  A font chooser.
+
+print
+  A dialog box used when printing (e.g. number of pages, printer).
+
+page-setup
+  A dialog box for setting page options (e.g. margins) for printing.
+
+replace
+  A find/replace dialog box.
+
+mswindows-message
+  An MS Windows-specific standard dialog box type similar to `question'.
+
+---------------------------------------------------------------------------
+
+For type `general':
+
+This type creates a frame and puts the specified widget layout in it.
+\(Currently this is done by eliminating all areas but the gutter and placing
+the layout there; but this is an implementation detail and may change.)
+
+The keywords allowed for `general' are
+
+:spec
+  The widget spec -- anything that can be passed to `make-glyph'.
+
+:title
+  The title of the frame.
+:parent
+  The frame is made a child of this frame (defaults to the selected frame).
+
+:properties
+  Additional properties of the frame, as well as `dialog-frame-plist'.
+
+---------------------------------------------------------------------------
+
+For type `question':
+
+The keywords allowed are
+
+:modal
+  t or nil.  When t, the dialog box callback should exit the dialog box
+  using the functions `dialog-box-finish' or `dialog-box-cancel'.
+:title
+  The title of the frame.
+:question
+  A string, the question.
+:buttons
+  A list, describing the buttons below the question.  Each of these is a
+  vector, the syntax of which is essentially the same as that of popup menu
+  items.  They may have any of the following forms:
+
+   [ \"name\" callback <active-p> ]
+   [ \"name\" callback <active-p> \"suffix\" ]
+   [ \"name\" callback :<keyword> <value>  :<keyword> <value> ... ]
+  
+  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'.
+  
+  One (and only one) of the buttons may be `nil'.  This marker means that all
+  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 type `file':
+
+The keywords allowed are
+
+:initial-filename
+  The initial filename to be placed in the dialog box (defaults to nothing).
+:initial-directory
+  The initial directory to be selected in the dialog box (defaults to the
+  current buffer's `default-directory).
+:filter-list
+  A list of                     (filter-desc filter ...)
+:title
+  The title of the dialog box (defaults to \"Open\").
+:allow-multi-select             t or nil
+:create-prompt-on-nonexistent   t or nil
+:overwrite-prompt               t or nil
+:file-must-exist                t or nil
+:no-network-button              t or nil
+:no-read-only-return            t or nil
+
+---------------------------------------------------------------------------
+
+For type `print':
+
+This invokes the Windows standard Print dialog.
+This dialog is usually invoked when the user selects the Print command.
+After the user presses OK, the program should start actual printout.
+
+The keywords allowed are
+
+:device
+  An 'msprinter device.
+:print-settings
+  A printer settings object.
+
+Exactly one of these keywords must be given.
+
+The function brings up the Print dialog, where the user can
+select a different printer and/or change printer options. Connection
+name can change as a result of selecting a different printer device.  If
+a printer is specified, then changes are stored into the settings object
+currently selected into that printer.  If a settings object is supplied,
+then changes are recorded into it, and, it it is selected into a
+printer, then changes are propagated to that printer 
+too.
+
+Return value is nil if the user has canceled the dialog.  Otherwise, it
+is a new plist, with the following properties:
+  name       Printer device name, even if unchanged by the user.
+  from-page  First page to print, 1-based. If not specified by the user,
+             then this value is not included in the plist.
+  to-page    Last page to print, inclusive, 1-based. If not specified by
+             the user, then this value is not included in the plist.
+  copies     Number of copies to print.  Always returned.
+
+The DEVICE is destroyed and an error is signaled in case of
+initialization problem with the new printer.
+
+See also the `page-setup' and `print-setup' dialog boxes.
+
+---------------------------------------------------------------------------
+
+For type `page-setup':
+
+This invokes the Windows standard Page Setup dialog.
+This dialog is usually invoked in response to the Page Setup command, and
+used to chose such parameters as page orientation, print margins etc.
+Note that this dialog contains the \"Printer\" button, which invokes
+the Printer Setup dialog (see `msprinter-print-setup-dialog') so that the
+user can update the printer options or even select a different printer
+as well.
+
+The keywords allowed are
+
+:device
+  An 'msprinter device.
+:print-settings
+  A printer settings object.
+:properties
+  A plist of job properties.
+
+Exactly one of these keywords must be given.
+
+The function brings up the Page Setup dialog, where the user
+can select a different printer and/or change printer options.
+Connection name can change as a result of selecting a different printer
+device.  If a printer is specified, then changes are stored into the
+settings object currently selected into that printer.  If a settings
+object is supplied, then changes are recorded into it, and, it it is
+selected into a printer, then changes are propagated to that printer
+too.
+
+:properties specifies a plist of job properties;
+see `default-msprinter-frame-plist' for the complete list.  The plist
+is used to initialize the dialog.
+
+Return value is nil if the user has canceled the dialog.  Otherwise,
+it is a new plist, containing the new list of properties.
+
+The DEVICE is destroyed and an error is signaled in case of
+initialization problem with the new printer.
+
+See also the `print' and `print-setup' dialogs.
+
+---------------------------------------------------------------------------
+
+For type `print-setup':
+
+This invokes the Windows standard Print Setup dialog.
+This dialog is usually invoked when the user selects the Printer Setup
+command.
+
+The keywords allowed are
+
+:device
+  An 'msprinter device.
+:print-settings
+  A printer settings object.
+
+Exactly one of these keywords must be given.
+
+The function brings up the Print Setup dialog, where the user
+can select a different printer and/or change printer options.
+Connection name can change as a result of selecting a different printer
+device.  If a printer is specified, then changes are stored into the
+settings object currently selected into that printer.  If a settings
+object is supplied, then changes are recorded into it, and, it it is
+selected into a printer, then changes are propagated to that printer
+too.
+
+Return value is nil if the user has canceled the dialog.  Otherwise, it
+is a new plist, with the following properties:
+  name       Printer device name, even if unchanged by the user.
+
+The printer device is destroyed and an error is signaled if new printer
+is selected by the user, but cannot be initialized.
+
+See also the `print' and `page-setup' dialogs.
+
+---------------------------------------------------------------------------
+
+For type `mswindows-message':
+
+The keywords allowed are
+
+:title
+  The title of the dialog box.
+:message
+  The string to display.
+:flags
+  A symbol or list of symbols:
+
+    -- To specify the buttons in the message box:
+    
+    abortretryignore 
+      The message box contains three push buttons: Abort, Retry, and Ignore. 
+    ok 
+      The message box contains one push button: OK. This is the default. 
+    okcancel 
+      The message box contains two push buttons: OK and Cancel. 
+    retrycancel 
+      The message box contains two push buttons: Retry and Cancel. 
+    yesno 
+      The message box contains two push buttons: Yes and No. 
+    yesnocancel 
+      The message box contains three push buttons: Yes, No, and Cancel. 
+    
+    
+    -- To display an icon in the message box:
+     
+    iconexclamation, iconwarning
+      An exclamation-point icon appears in the message box. 
+    iconinformation, iconasterisk
+      An icon consisting of a lowercase letter i in a circle appears in
+      the message box. 
+    iconquestion
+      A question-mark icon appears in the message box. 
+    iconstop, iconerror, iconhand
+      A stop-sign icon appears in the message box. 
+    
+    
+    -- To indicate the default button: 
+    
+    defbutton1
+      The first button is the default button.  This is the default.
+    defbutton2
+      The second button is the default button. 
+    defbutton3
+      The third button is the default button. 
+    defbutton4
+      The fourth button is the default button. 
+    
+    
+    -- To indicate the modality of the dialog box:
+     
+    applmodal
+      The user must respond to the message box before continuing work in
+      the window identified by the hWnd parameter. However, the user can
+      move to the windows of other applications and work in those windows.
+      Depending on the hierarchy of windows in the application, the user
+      may be able to move to other windows within the application. All
+      child windows of the parent of the message box are automatically
+      disabled, but popup windows are not.  This is the default.
+    systemmodal
+      Same as applmodal except that the message box has the WS_EX_TOPMOST
+      style. Use system-modal message boxes to notify the user of serious,
+      potentially damaging errors that require immediate attention (for
+      example, running out of memory). This flag has no effect on the
+      user's ability to interact with windows other than those associated
+      with hWnd.
+    taskmodal
+      Same as applmodal except that all the top-level windows belonging to
+      the current task are disabled if the hWnd parameter is NULL. Use
+      this flag when the calling application or library does not have a
+      window handle available but still needs to prevent input to other
+      windows in the current application without suspending other
+      applications.
+    
+    
+    In addition, you can specify the following flags: 
+    
+    default-desktop-only 
+      The desktop currently receiving input must be a default desktop;
+      otherwise, the function fails. A default desktop is one an
+      application runs on after the user has logged on.
+    help 
+      Adds a Help button to the message box. Choosing the Help button or
+      pressing F1 generates a Help event.
+    right 
+      The text is right-justified. 
+    rtlreading 
+      Displays message and caption text using right-to-left reading order
+      on Hebrew and Arabic systems.
+    setforeground 
+      The message box becomes the foreground window. Internally, Windows
+      calls the SetForegroundWindow function for the message box.
+    topmost 
+      The message box is created with the WS_EX_TOPMOST window style. 
+    service-notification 
+      Windows NT only: The caller is a service notifying the user of an
+      event. The function displays a message box on the current active
+      desktop, even if there is no user logged on to the computer.  If
+      this flag is set, the hWnd parameter must be NULL. This is so the
+      message box can appear on a desktop other than the desktop
+      corresponding to the hWnd.
+    
+
+  The return value is one of the following menu-item values returned by
+  the dialog box:
+   
+  abort
+    Abort button was selected. 
+  cancel
+    Cancel button was selected. 
+  ignore
+    Ignore button was selected. 
+  no
+    No button was selected. 
+  ok
+    OK button was selected. 
+  retry
+    Retry button was selected. 
+  yes
+    Yes button was selected. 
+  
+  If a message box has a Cancel button, the function returns the
+  `cancel' value if either the ESC key is pressed or the Cancel button
+  is selected.  If the message box has no Cancel button, pressing ESC has
+  no effect."
+  (flet ((dialog-box-modal-loop (thunk)
+          (let* ((frames (frame-list))
+                 (result
+                  ;; ok, this is extremely tricky.  normally a modal
+                  ;; dialog will pop itself down using (dialog-box-finish)
+                  ;; or (dialog-box-cancel), which throws back to this
+                  ;; catch.  but question dialog boxes pop down themselves
+                  ;; regardless, so a badly written question dialog box
+                  ;; that does not use (dialog-box-finish) could seriously
+                  ;; wedge us.  furthermore, we disable all other frames
+                  ;; in order to implement modality; we need to restore
+                  ;; them before the dialog box is destroyed, because
+                  ;; otherwise windows at least will notice that no top-
+                  ;; level window can have the focus and will shift the
+                  ;; focus to a different app, raising it and obscuring us.
+                  ;; so we create `delete-dialog-box-hook', which is
+                  ;; called right *before* the dialog box gets destroyed.
+                  ;; here, we put a hook on it, and when it's our dialog
+                  ;; box and not someone else's that's being destroyed,
+                  ;; we reenable all the frames and remove the hook.
+                  ;; BUT ...  we still have to deal with exiting the
+                  ;; modal loop in case it doesn't happen before us.
+                  ;; we can't do this until after the callbacks for this
+                  ;; dialog box get executed, and that doesn't happen until
+                  ;; after the dialog box is destroyed.  so to keep things
+                  ;; synchronous, we enqueue an eval event, which goes into
+                  ;; the same queue as the misc-user events encapsulating
+                  ;; the dialog callbacks and will go after it (because
+                  ;; destroying the dialog box happens after processing
+                  ;; its selection).  if the dialog boxes are written
+                  ;; properly, we don't see this eval event, because we've
+                  ;; already exited our modal loop. (Thus, we make sure the
+                  ;; function given in this eval event is actually defined
+                  ;; and does nothing.) If we do see it, though, we know
+                  ;; that we encountered a badly written dialog box and
+                  ;; need to exit now.  Currently we just return nil, but
+                  ;; maybe we should signal an error or issue a warning.
+                  (catch 'internal-dialog-box-finish
+                    (let ((id (eval thunk))
+                          (sym (gensym)))
+                      (fset sym
+                            `(lambda (did)
+                               (when (eq ',id did)
+                                 (mapc 'enable-frame ',frames)
+                                 (enqueue-eval-event
+                                  'internal-make-dialog-box-exit did)
+                                 (remove-hook 'delete-dialog-box-hook
+                                              ',sym))))
+                      (add-hook 'delete-dialog-box-hook sym)
+                      (mapc 'disable-frame frames)
+                      (block nil
+                        (while t
+                          (let ((event (next-event)))
+                            (if (and (eval-event-p event)
+                                     (eq (event-function event)
+                                         'internal-make-dialog-box-exit)
+                                     (eq (event-object event) id))
+                                (return '(nil))
+                              (dispatch-event event)))))))))
+            (if (listp result)
+                (car result)
+              (signal 'quit nil)))))
+    (case type
+      (general
+       (cl-parsing-keywords
+           ((:title "XEmacs")
+            (:parent (selected-frame))
+            :modal
+            :properties
+            :spec)
+           ()
+         (flet ((create-dialog-box-frame ()
+                  (let* ((ftop (frame-property cl-parent 'top))
+                         (fleft (frame-property cl-parent 'left))
+                         (fwidth (frame-pixel-width cl-parent))
+                         (fheight (frame-pixel-height cl-parent))
+                         (fonth (font-height (face-font 'default)))
+                         (fontw (font-width (face-font 'default)))
+                         (cl-properties (append cl-properties
+                                                dialog-frame-plist))
+                         (dfheight (plist-get cl-properties 'height))
+                         (dfwidth (plist-get cl-properties 'width))
+                         (unmapped (plist-get cl-properties
+                                              'initially-unmapped))
+                         (gutter-spec cl-spec)
+                         (name (or (plist-get cl-properties 'name) "XEmacs"))
+                         (frame nil))
+                    (plist-remprop cl-properties 'initially-unmapped)
+                    ;; allow the user to just provide a glyph
+                    (or (glyphp cl-spec) (setq cl-spec (make-glyph cl-spec)))
+                    (setq gutter-spec (copy-sequence "\n"))
+                    (set-extent-begin-glyph (make-extent 0 1 gutter-spec)
+                                            cl-spec)
+                    ;; under FVWM at least, if I don't specify the
+                    ;; initial position, it ends up always at (0, 0).
+                    ;; xwininfo doesn't tell me that there are any
+                    ;; program-specified position hints, so it must be
+                    ;; an FVWM bug.  So just be smashing and position in
+                    ;; the center of the selected frame.
+                    (setq frame
+                          (make-frame
+                           (append cl-properties
+                                   `(popup ,cl-parent initially-unmapped t
+                                           menubar-visible-p nil
+                                           has-modeline-p nil
+                                           default-toolbar-visible-p nil
+                                           top-gutter-visible-p t
+                                           top-gutter-height ,
+                                           (* dfheight fonth)
+                                           top-gutter ,gutter-spec
+                                           minibuffer none
+                                           name ,name
+                                           modeline-shadow-thickness 0
+                                           vertical-scrollbar-visible-p nil
+                                           horizontal-scrollbar-visible-p nil
+                                           unsplittable t
+                                           left ,(+ fleft (- (/ fwidth 2)
+                                                             (/ (* dfwidth
+                                                                   fontw)
+                                                                2)))
+                                           top ,(+ ftop (- (/ fheight 2)
+                                                           (/ (* dfheight
+                                                                 fonth)
+                                                              2)))))))
+                    (set-face-foreground 'modeline [default foreground] frame)
+                    (set-face-background 'modeline [default background] frame)
+                    (unless unmapped (make-frame-visible frame))
+                    (let ((newbuf (generate-new-buffer " *dialog box*")))
+                      (set-buffer-dedicated-frame newbuf frame)
+                      (set-frame-property frame 'dialog-box-buffer newbuf)
+                      (with-current-buffer newbuf
+                        (setq frame-title-format cl-title)
+                        (make-local-hook 'delete-frame-hook)
+                        (add-hook 'delete-frame-hook
+                                  #'(lambda (frame)
+                                      (kill-buffer
+                                       (frame-property
+                                        frame
+                                        'dialog-box-buffer))))))
+                    frame)))
+           (if cl-modal
+               (dialog-box-modal-loop '(create-dialog-box-frame))
+             (create-dialog-box-frame)))))
+      (question
+       (cl-parsing-keywords
+           ((:modal nil))
+           t
+         (remf cl-keys :modal)
+         (if cl-modal
+             (dialog-box-modal-loop `(make-dialog-box-internal ',type
+                                                               ',cl-keys))
+           (make-dialog-box-internal type cl-keys))))
+      (t
+       (make-dialog-box-internal type cl-keys)))))
+
+(defun dialog-box-finish (result)
+  "Exit a modal dialog box, returning RESULT.
+This is meant to be executed from a dialog box callback function."
+  (throw 'internal-dialog-box-finish (list result)))
+
+(defun dialog-box-cancel ()
+  "Cancel a modal dialog box.
+This is meant to be executed from a dialog box callback function."
+  (throw 'internal-dialog-box-finish 'cancel))
+
+;; an eval event, used as a trigger inside of the dialog modal loop.
+(defun internal-make-dialog-box-exit (did)
+  nil)
+
+(make-obsolete 'popup-dialog-box 'make-dialog-box)
+(defun popup-dialog-box (desc)
+  "Obsolete equivalent of (make-dialog-box 'question ...).
+
+\(popup-dialog-box (QUESTION BUTTONS ...)
+
+is equivalent to
 
+\(make-dialog-box 'question :question QUESTION :buttons BUTTONS)"
+  (check-argument-type 'stringp (car desc))
+  (or (consp (cdr desc))
+      (error 'syntax-error
+            "Dialog descriptor must supply at least one button"
+            desc))
+  (make-dialog-box 'question :question (car desc) :buttons (cdr desc)))
 
 ;;; dialog.el ends here
index 9c46f55..1250482 100644 (file)
@@ -3,7 +3,7 @@
 ;; Copyright (C) 1998 Oliver Graf <ograf@fga.de>
 
 ;; Maintainer: XEmacs Development Team, Oliver Graf <ograf@fga.de>
-;; Keywords: drag, drop, dumped
+;; Keywords: mouse, gui, dumped
 
 ;; This file is part of XEmacs.
 
@@ -244,8 +244,8 @@ Finds files and URLs. Returns nil if object does not contain URL data."
                   ;; to-do: open ftp URLs with efs...
                   (t 
                    ;; some other URL, try to fire up some browser for it
-                   (if (boundp 'browse-url-browser-function)
-                       (funcall browse-url-browser-function (car data))
+                   (if (fboundp 'browse-url)
+                       (browse-url (car data))
                      (display-message 'error 
                        "Can't show URL, no browser selected"))))
             (undo-boundary)
index 8059470..6673789 100644 (file)
@@ -24,7 +24,7 @@
 ;; 02111-1307, USA.
 
 ;;; Synched up with: Not synched with FSF but coordinated with the FSF
-;;;                  easymenu maintor for compatibility with FSF 20.4.
+;;;                  easymenu maintainer for compatibility with FSF 20.4.
 ;;; Please: Coordinate changes with Inge Frick <inge@nada.kth.se>
 
 ;; Commentary:
 
 ;; Easymenu allows you to define menus for both Emacs 19 and XEmacs.
 
-;; This file 
+;; This file
 ;; The advantages of using easymenu are:
 
 ;; - Easier to use than either the Emacs 19 and XEmacs menu syntax.
 
-;; - Common interface for Emacs 18, Emacs 19, and XEmacs.  
+;; - Common interface for Emacs 18, Emacs 19, and XEmacs.
 ;;   (The code does nothing when run under Emacs 18).
 
 ;; The public functions are:
 
 ;; - Function: easy-menu-define SYMBOL MAPS DOC MENU
 ;;     SYMBOL is both the name of the variable that holds the menu and
-;;            the name of a function that will present a the menu.
+;;            the name of a function that will present the menu.
 ;;     MAPS is a list of keymaps where the menu should appear in the menubar.
 ;;     DOC is the documentation string for the variable.
-;;     MENU is an XEmacs style menu description.  
+;;     MENU is an XEmacs style menu description.
 
 ;;     See the documentation for easy-menu-define for details.
 
 ;; - Function: easy-menu-change PATH NAME ITEMS
 ;;     Change an existing menu.
 ;;     The menu must already exist and be visible on the menu bar.
-;;     PATH is a list of strings used for locating the menu on the menu bar. 
-;;     NAME is the name of the menu.  
+;;     PATH is a list of strings used for locating the menu on the menu bar.
+;;     NAME is the name of the menu.
 ;;     ITEMS is a list of menu items, as defined in `easy-menu-define'.
 
 ;; - Function: easy-menu-add MENU [ MAP ]
@@ -105,7 +105,7 @@ or a list to evaluate when the item is chosen.
 ENABLE is an expression; the item is enabled for selection
 whenever this expression's value is non-nil.
 
-Alternatively, a menu item may have the form: 
+Alternatively, a menu item may have the form:
 
    [ NAME CALLBACK [ KEYWORD ARG ] ... ]
 
@@ -125,13 +125,13 @@ whenever this expression's value is non-nil.
 NAME is a string; the name of an argument to CALLBACK.
 
    :style STYLE
-   
+
 STYLE is a symbol describing the type of menu item.  The following are
-defined:  
+defined:
 
-toggle: A checkbox.  
+toggle: A checkbox.
         Currently just prepend the name with the string \"Toggle \".
-radio: A radio button. 
+radio: A radio button.
 nil: An ordinary menu item.
 
    :selected SELECTED
@@ -153,15 +153,14 @@ is a list of menu items, as above."
      (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu)))
 
 (defun easy-menu-do-define (symbol maps doc menu)
-  (if (featurep 'menubar)
-      (progn
-       (set symbol menu)
-       (fset symbol (list 'lambda '(e)
-                          doc
-                          '(interactive "@e")
-                          '(run-hooks 'activate-menubar-hook)
-                          '(setq zmacs-region-stays 't)
-                          (list 'popup-menu symbol))))))
+  (when (featurep 'menubar)
+    (set symbol menu)
+    (fset symbol `(lambda (e)
+                   ,doc
+                   (interactive "@e")
+                   (run-hooks 'activate-menubar-hook)
+                   (setq zmacs-region-stays 't)
+                   (popup-menu ,symbol)))))
 
 (defun easy-menu-change (&rest args)
   (when (featurep 'menubar)
@@ -174,42 +173,48 @@ is a list of menu items, as above."
 
 (defun easy-menu-add (menu &optional map)
   "Add MENU to the current menu bar."
-  (if (featurep 'menubar)
-      (progn
-       (unless (member menu easy-menu-all-popups)
-         (push menu easy-menu-all-popups))
-       (setq mode-popup-menu (if (> (length easy-menu-all-popups) 1)
-                                 (cons (easy-menu-title)
-                                       (reverse easy-menu-all-popups))
-                               (car easy-menu-all-popups)))
-
-       (cond ((null current-menubar)
-              ;; Don't add it to a non-existing menubar.
-              nil)
-             ((assoc (car menu) current-menubar)
-              ;; Already present.
-              nil)
-             ((equal current-menubar '(nil))
-              ;; Set at left if only contains right marker.
-              (set-buffer-menubar (list menu nil)))
-             (t
-              ;; Add at right.
-              (set-buffer-menubar (copy-sequence current-menubar))
-              (add-menu nil (car menu) (cdr menu)))))))
+  (when (featurep 'menubar)
+    (unless (member menu easy-menu-all-popups)
+      (push menu easy-menu-all-popups))
+    (setq mode-popup-menu (if (> (length easy-menu-all-popups) 1)
+                             (cons (easy-menu-title)
+                                   (reverse easy-menu-all-popups))
+                           (let ((same-as-menu
+                                  (car easy-menu-all-popups)))
+                             (cons (normalize-menu-item-name
+                                    (car same-as-menu))
+                                   (cdr same-as-menu)))))
+
+    (cond ((null current-menubar)
+          ;; Don't add it to a non-existing menubar.
+          nil)
+         ((assoc (car menu) current-menubar)
+          ;; Already present.
+          nil)
+         ((equal current-menubar '(nil))
+          ;; Set at left if only contains right marker.
+          (set-buffer-menubar (list menu nil)))
+         (t
+          ;; Add at right.
+          (set-buffer-menubar (copy-sequence current-menubar))
+          (add-menu nil (car menu) (cdr menu))))))
 
 (defun easy-menu-remove (menu)
   "Remove MENU from the current menu bar."
-  (if (featurep 'menubar)
-      (progn
-       (setq easy-menu-all-popups (delq menu easy-menu-all-popups)
-             mode-popup-menu (if (< (length easy-menu-all-popups) 1)
-                                 (cons (easy-menu-title)
-                                       (reverse easy-menu-all-popups))
-                               (car easy-menu-all-popups)))
-
-       (and current-menubar
-            (assoc (car menu) current-menubar)
-            (delete-menu-item (list (car menu)))))))
+  (when (featurep 'menubar)
+    (setq easy-menu-all-popups (delq menu easy-menu-all-popups)
+         mode-popup-menu (if (< (length easy-menu-all-popups) 1)
+                             (cons (easy-menu-title)
+                                   (reverse easy-menu-all-popups))
+                           (let ((same-as-menu
+                                  (car easy-menu-all-popups)))
+                             (cons (normalize-menu-item-name
+                                    (car same-as-menu))
+                                   (cdr same-as-menu)))))
+
+    (and current-menubar
+        (assoc (car menu) current-menubar)
+        (delete-menu-item (list (car menu))))))
 
 (defsubst easy-menu-normalize (menu)
   (if (symbolp menu)
@@ -217,14 +222,14 @@ is a list of menu items, as above."
     menu))
 
 (defun easy-menu-add-item (menu path item &optional before)
-  "At the end of the submenu of MENU with path PATH add ITEM.
+  "At the end of the submenu of MENU with path PATH, add ITEM.
 If ITEM is already present in this submenu, then this item will be changed.
 otherwise ITEM will be added at the end of the submenu, unless the optional
 argument BEFORE is present, in which case ITEM will instead be added
 before the item named BEFORE.
 MENU is either a symbol, which have earlier been used as the first
 argument in a call to `easy-menu-define', or the value of such a symbol
-i.e. a menu, or nil which stands for the current menubar.
+i.e. a menu, or nil, which stands for the current menubar.
 PATH is a list of strings for locating the submenu where ITEM is to be
 added.  If PATH is nil, MENU itself is used.  Otherwise, the first
 element should be the name of a submenu directly under MENU.  This
@@ -232,26 +237,30 @@ submenu is then traversed recursively with the remaining elements of PATH.
 ITEM is either defined as in `easy-menu-define', a menu defined earlier
 by `easy-menu-define' or `easy-menu-create-menu' or an item returned
 from `easy-menu-item-present-p' or `easy-menu-remove-item'."
-  (add-menu-button path item before (easy-menu-normalize menu)))                  
+  (when (featurep 'menubar)
+    (add-menu-button path item before (easy-menu-normalize menu))))
 
 (defun easy-menu-item-present-p (menu path name)
   "In submenu of MENU with path PATH, return true iff item NAME is present.
 MENU and PATH are defined as in `easy-menu-add-item'.
 NAME should be a string, the name of the element to be looked for.
 
-The return value can be used as as an argument to `easy-menu-add-item'."
-  (car (find-menu-item (or (easy-menu-normalize menu) current-menubar)
-                      (append path (list name)))))
+The return value can be used as an argument to `easy-menu-add-item'."
+  (if (featurep 'menubar)
+      (car (find-menu-item (or (easy-menu-normalize menu) current-menubar)
+                          (append path (list name))))
+    nil))
 
 (defun easy-menu-remove-item (menu path name)
-  "From submenu of MENU with path PATH remove item NAME.
+  "From submenu of MENU with path PATH, remove item NAME.
 MENU and PATH are defined as in `easy-menu-add-item'.
 NAME should be a string, the name of the element to be removed.
 
-The return value can be used as as an argument to `easy-menu-add-item'."
-  (delete-menu-item (append path (list name))
-                   (easy-menu-normalize menu)))
-  
+The return value can be used as an argument to `easy-menu-add-item'."
+  (when (featurep 'menubar)
+    (delete-menu-item (append path (list name))
+                     (easy-menu-normalize menu))))
+
 
 
 
index 37f0752..4647b44 100644 (file)
@@ -1,6 +1,7 @@
 ;;; extents.el --- miscellaneous extent functions not written in C
 
 ;; Copyright (C) 1993-4, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 2000 Ben Wing.
 
 ;; Keywords: internal, dumped
 
 
 ;;; Commentary:
 
-;; some help from stig@hackvan.com here.
+;;; Authorship:
+
+;; Created 1995 Ben Wing.
+;; mapcar-extents (and extent-list?) from stig@hackvan.com, c. 1996.
 
 ;;; Code:
 
@@ -53,7 +57,7 @@ PREDICATE or FUNCTION.  See also `map-extents'."
                  buffer-or-string from to nil flags property value)
     (nreverse *result*)))
 
-(defun extent-list (&optional buffer-or-string from to flags)
+(defun extent-list (&optional buffer-or-string from to flags property value)
   "Return a list of the extents in BUFFER-OR-STRING.
 BUFFER-OR-STRING defaults to the current buffer if omitted.
 FROM and TO can be used to limit the range over which extents are
@@ -65,11 +69,28 @@ are included in the list.  FROM and TO default to the beginning and
 end of BUFFER-OR-STRING, respectively.
 
 FLAGS controls how end cases are treated.  For a discussion of this,
-and exactly what ``overlap'' means, see `map-extents'.
+and exactly what ``overlap'' means, see `map-extents'.  PROPERTY and VALUE
+are also as in `map-extents'.
 
 If you want to map a function over the extents in a buffer or string,
-consider using `map-extents' or `mapcar-extents' instead."
-  (mapcar-extents 'identity nil buffer-or-string from to flags))
+consider using `map-extents' or `mapcar-extents' instead.
+
+See also `extents-at'."
+  (mapcar-extents 'identity nil buffer-or-string from to flags property value))
+
+(defun extent-at-event (event &optional property before at-flag)
+  "Return the smallest extent under EVENT, if any.
+PROPERTY, BEFORE, and AT-FLAG are as in `extent-at'."
+  (let* ((win (event-window event))
+        (p (event-point event)))
+    (and win p (extent-at p (window-buffer win) property before at-flag))))
+
+(defun extents-at-event (event &optional property before at-flag)
+  "Return a list of all extents under EVENT.
+PROPERTY, BEFORE, and AT-FLAG are as in `extent-at'."
+  (let* ((win (event-window event))
+        (p (event-point event)))
+    (and win p (extents-at p (window-buffer win) property before at-flag))))
 
 (defun extent-string (extent)
   "Return the string delimited by the bounds of EXTENT."
index 156de24..eff6c16 100644 (file)
@@ -117,19 +117,20 @@ The return value will be a list of instantiators (e.g. strings
 The specifications in a specifier determine what the value of
   PROPERTY will be in a particular \"domain\" or set of circumstances,
   which is typically a particular Emacs window along with the buffer
-  it contains and the frame and device it lies within.  The value
-  is derived from the instantiator associated with the most specific
+  it contains and the frame and device it lies within.  The value is
+  derived from the instantiator associated with the most specific
   locale (in the order buffer, window, frame, device, and 'global)
   that matches the domain in question.  In other words, given a domain
-  (i.e. an Emacs window, usually), the specifier for PROPERTY will first
-  be searched for a specification whose locale is the buffer contained
-  within that window; then for a specification whose locale is the window
-  itself; then for a specification whose locale is the frame that the
-  window is contained within; etc.  The first instantiator that is
-  valid for the domain (usually this means that the instantiator is
-  recognized by the device [i.e. the X server or TTY device] that the
-  domain is on.  The function `face-property-instance' actually does
-  all this, and is used to determine how to display the face.
+  (i.e. an Emacs window, usually), the specifier for PROPERTY will
+  first be searched for a specification whose locale is the buffer
+  contained within that window; then for a specification whose locale
+  is the window itself; then for a specification whose locale is the
+  frame that the window is contained within; etc.  The first
+  instantiator that is valid for the domain (usually this means that
+  the instantiator is recognized by the device [i.e. MS Windows, the X
+  server or TTY device] that the domain is on.  The function
+  `face-property-instance' actually does all this, and is used to
+  determine how to display the face.
 
 See `set-face-property' for the built-in property-names."
 
@@ -304,7 +305,7 @@ The following symbols have predefined meanings:
                     This should be a vector of 256 elements.
 
  background-pixmap  The pixmap displayed in the background of the face.
-                    Only used by faces on X devices.
+                    Only used by faces on X and MS Windows devices.
                     For valid instantiators, see `make-image-specifier'.
 
  underline          Underline all text covered by this face.
@@ -794,7 +795,8 @@ See `face-property-instance' for the semantics of the DOMAIN argument."
 ;; WE DEMAND LEXICAL SCOPING!!!
 ;; WE DEMAND LEXICAL SCOPING!!!
 ;; WE DEMAND LEXICAL SCOPING!!!
-(defun frob-face-property (face property func &optional locale tags)
+(defun frob-face-property (face property func device-tags &optional
+locale tags)
   "Change the specifier for FACE's PROPERTY according to FUNC, in LOCALE.
 This function is ugly and messy and is primarily used as an internal
 helper function for `make-face-bold' et al., so you probably don't
@@ -813,13 +815,19 @@ until a non-nil result is found (if there is no such result, the
 first valid instantiator is used), and that result substituted for
 the specification; otherwise, the process just outlined is
 iterated over each existing device and the concatenated results
-substituted for the specification."
+substituted for the specification.
+
+DEVICE-TAGS is a list of tags that each device must match in order for
+the function to be called on it."
   (let ((sp (face-property face property))
        temp-sp)
     (if (valid-specifier-domain-p locale)
        ;; this is easy.
        (let* ((inst (face-property-instance face property locale))
-              (name (and inst (funcall func inst (dfw-device locale)))))
+              (name (and inst
+                         (device-matches-specifier-tag-set-p
+                          (dfw-device locale) device-tags)
+                         (funcall func inst (dfw-device locale)))))
          (when name
            (add-spec-to-specifier sp name locale tags)))
       ;; otherwise, map over all specifications ...
@@ -852,10 +860,15 @@ substituted for the specification."
                ;; Otherwise map frob-face-property-1 over each device.
                (result
                 (if device
-                    (list (frob-face-property-1 sp-arg device inst-list func))
+                    (list (and (device-matches-specifier-tag-set-p
+                                device device-tags)
+                               (frob-face-property-1 sp-arg device inst-list
+                                                     func)))
                   (mapcar (lambda (device)
-                            (frob-face-property-1 sp-arg device
-                                                  inst-list func))
+                            (and (device-matches-specifier-tag-set-p
+                                  device device-tags)
+                                 (frob-face-property-1 sp-arg device
+                                                       inst-list func)))
                           (device-list))))
                new-result)
           ;; remove duplicates and nils from the obtained list of
@@ -866,7 +879,7 @@ substituted for the specification."
                           (setq arg (cons tags arg))
                         (setcar arg (append tags (delete 'default
                                                          (car arg))))))
-                    (when (and arg (not (member arg new-result)))                     
+                    (when (and arg (not (member arg new-result)))
                       (setq new-result (cons arg new-result))))
                   result)
           ;; add back in.
@@ -895,14 +908,14 @@ substituted for the specification."
     (or result first-valid)))
 
 (defun frob-face-font-2 (face locale tags unfrobbed-face frobbed-face
-                             tty-thunk x-thunk standard-face-mapping)
+                             tty-thunk ws-thunk standard-face-mapping)
   ;; another kludge to make things more intuitive.  If we're
   ;; inheriting from a standard face in this locale, frob the
-  ;; inheritance as appropriate.  Else, if, after the first X frobbing
-  ;; pass, the face hasn't changed and still looks like the standard
-  ;; unfrobbed face (e.g. 'default), make it inherit from the standard
-  ;; frobbed face (e.g. 'bold).  Regardless of things, do the TTY
-  ;; frobbing.
+  ;; inheritance as appropriate.  Else, if, after the first
+  ;; window-system frobbing pass, the face hasn't changed and still
+  ;; looks like the standard unfrobbed face (e.g. 'default), make it
+  ;; inherit from the standard frobbed face (e.g. 'bold).  Regardless
+  ;; of things, do the TTY frobbing.
 
   ;; yuck -- The LOCALE argument to make-face-bold is not actually a locale,
   ;; but is a "locale, locale-type, or nil for all".  So ...  do our extra
@@ -930,7 +943,7 @@ substituted for the specification."
                           (t nil)))
             (inst (and domain (face-property-instance face 'font domain))))
        (funcall tty-thunk)
-       (funcall x-thunk)
+       (funcall ws-thunk)
        ;; If it's reasonable to do the inherit-from-standard-face trick,
        ;; and it's called for, then do it now.
        (or (null domain)
@@ -946,7 +959,7 @@ substituted for the specification."
 
 (defun make-face-bold (face &optional locale tags)
   "Make FACE bold in LOCALE, if possible.
-This will attempt to make the font bold for X locales and will set the
+This will attempt to make the font bold for X/MSW locales and will set the
 highlight flag for TTY locales.
 
 If LOCALE is nil, omitted, or `all', this will attempt to frob all
@@ -979,11 +992,13 @@ circumstances."
      (when (featurep 'tty)
        (set-face-highlight-p face t locale (cons 'tty tags))))
    (lambda ()
-     ;; handle X specific entries
+     ;; handle X/MS Windows specific entries
      (when (featurep 'x)
-       (frob-face-property face 'font 'x-make-font-bold locale tags))
+       (frob-face-property face 'font 'x-make-font-bold
+                          '(x) locale tags))
      (when (featurep 'mswindows)
-       (frob-face-property face 'font 'mswindows-make-font-bold locale tags))
+       (frob-face-property face 'font 'mswindows-make-font-bold
+                          '(mswindows) locale tags))
      )
    '(([default] . [bold])
      ([bold] . t)
@@ -992,10 +1007,10 @@ circumstances."
 
 (defun make-face-italic (face &optional locale tags)
   "Make FACE italic in LOCALE, if possible.
-This will attempt to make the font italic for X locales and will set
-the underline flag for TTY locales.
-See `make-face-bold' for the semantics of the LOCALE argument and
-for more specifics on exactly how this function works."
+This will attempt to make the font italic for X/MS Windows locales and
+will set the underline flag for TTY locales.  See `make-face-bold' for
+the semantics of the LOCALE argument and for more specifics on exactly
+how this function works."
   (interactive (list (read-face-name "Make which face italic: ")))
   (frob-face-font-2
    face locale tags 'default 'italic
@@ -1006,9 +1021,11 @@ for more specifics on exactly how this function works."
    (lambda ()
      ;; handle X specific entries
      (when (featurep 'x)
-       (frob-face-property face 'font 'x-make-font-italic locale tags))
+       (frob-face-property face 'font 'x-make-font-italic
+                          '(x) locale tags))
      (when (featurep 'mswindows)
-       (frob-face-property face 'font 'mswindows-make-font-italic locale tags))
+       (frob-face-property face 'font 'mswindows-make-font-italic
+                          '(mswindows) locale tags))
      )
    '(([default] . [italic])
      ([bold] . [bold-italic])
@@ -1017,10 +1034,10 @@ for more specifics on exactly how this function works."
 
 (defun make-face-bold-italic (face &optional locale tags)
   "Make FACE bold and italic in LOCALE, if possible.
-This will attempt to make the font bold-italic for X locales and will
-set the highlight and underline flags for TTY locales.
-See `make-face-bold' for the semantics of the LOCALE argument and
-for more specifics on exactly how this function works."
+This will attempt to make the font bold-italic for X/MS Windows
+locales and will set the highlight and underline flags for TTY
+locales.  See `make-face-bold' for the semantics of the LOCALE
+argument and for more specifics on exactly how this function works."
   (interactive (list (read-face-name "Make which face bold-italic: ")))
   (frob-face-font-2
    face locale tags 'default 'bold-italic
@@ -1032,9 +1049,11 @@ for more specifics on exactly how this function works."
    (lambda ()
      ;; handle X specific entries
      (when (featurep 'x)
-       (frob-face-property face 'font 'x-make-font-bold-italic locale tags))
+       (frob-face-property face 'font 'x-make-font-bold-italic
+                          '(x) locale tags))
      (when (featurep 'mswindows)
-       (frob-face-property face 'font 'mswindows-make-font-bold-italic locale tags))
+       (frob-face-property face 'font 'mswindows-make-font-bold-italic
+                          '(mswindows) locale tags))
      )
    '(([default] . [italic])
      ([bold] . [bold-italic])
@@ -1043,10 +1062,10 @@ for more specifics on exactly how this function works."
 
 (defun make-face-unbold (face &optional locale tags)
   "Make FACE non-bold in LOCALE, if possible.
-This will attempt to make the font non-bold for X locales and will
-unset the highlight flag for TTY locales.
-See `make-face-bold' for the semantics of the LOCALE argument and
-for more specifics on exactly how this function works."
+This will attempt to make the font non-bold for X/MS Windows locales
+and will unset the highlight flag for TTY locales.  See
+`make-face-bold' for the semantics of the LOCALE argument and for more
+specifics on exactly how this function works."
   (interactive (list (read-face-name "Make which face non-bold: ")))
   (frob-face-font-2
    face locale tags 'bold 'default
@@ -1057,9 +1076,11 @@ for more specifics on exactly how this function works."
    (lambda ()
      ;; handle X specific entries
      (when (featurep 'x)
-       (frob-face-property face 'font 'x-make-font-unbold locale tags))
+       (frob-face-property face 'font 'x-make-font-unbold
+                          '(x) locale tags))
      (when (featurep 'mswindows)
-       (frob-face-property face 'font 'mswindows-make-font-unbold locale tags))
+       (frob-face-property face 'font 'mswindows-make-font-unbold
+                          '(mswindows) locale tags))
      )
    '(([default] . t)
      ([bold] . [default])
@@ -1068,10 +1089,10 @@ for more specifics on exactly how this function works."
 
 (defun make-face-unitalic (face &optional locale tags)
   "Make FACE non-italic in LOCALE, if possible.
-This will attempt to make the font non-italic for X locales and will
-unset the underline flag for TTY locales.
-See `make-face-bold' for the semantics of the LOCALE argument and
-for more specifics on exactly how this function works."
+This will attempt to make the font non-italic for X/MS Windows locales
+and will unset the underline flag for TTY locales.  See
+`make-face-bold' for the semantics of the LOCALE argument and for more
+specifics on exactly how this function works."
   (interactive (list (read-face-name "Make which face non-italic: ")))
   (frob-face-font-2
    face locale tags 'italic 'default
@@ -1082,9 +1103,11 @@ for more specifics on exactly how this function works."
    (lambda ()
      ;; handle X specific entries
      (when (featurep 'x)
-       (frob-face-property face 'font 'x-make-font-unitalic locale tags))
+       (frob-face-property face 'font 'x-make-font-unitalic
+                          '(x) locale tags))
      (when (featurep 'mswindows)
-       (frob-face-property face 'font 'mswindows-make-font-unitalic locale tags))
+       (frob-face-property face 'font 'mswindows-make-font-unitalic
+                          '(mswindows) locale tags))
      )
    '(([default] . t)
      ([bold] . t)
@@ -1103,9 +1126,11 @@ because they don't make sense in this context."
   (interactive (list (read-face-name "Shrink which face: ")))
   ;; handle X specific entries
   (when (featurep 'x)
-    (frob-face-property face 'font 'x-find-smaller-font locale))
+    (frob-face-property face 'font 'x-find-smaller-font
+                       '(x) locale))
   (when (featurep 'mswindows)
-    (frob-face-property face 'font 'mswindows-find-smaller-font locale)))
+    (frob-face-property face 'font 'mswindows-find-smaller-font
+                       '(mswindows) locale)))
 
 (defun make-face-larger (face &optional locale)
   "Make the font of FACE be larger, if possible.
@@ -1113,9 +1138,11 @@ See `make-face-smaller' for the semantics of the LOCALE argument."
   (interactive (list (read-face-name "Enlarge which face: ")))
   ;; handle X specific entries
   (when (featurep 'x)
-    (frob-face-property face 'font 'x-find-larger-font locale))
+    (frob-face-property face 'font 'x-find-larger-font
+                       '(x) locale))
   (when (featurep 'mswindows)
-    (frob-face-property face 'font 'mswindows-find-larger-font locale)))
+    (frob-face-property face 'font 'mswindows-find-larger-font
+                       '(mswindows) locale)))
 
 (defun invert-face (face &optional locale)
   "Swap the foreground and background colors of the face."
@@ -1248,7 +1275,7 @@ See `defface' for information about SPEC."
 
 (defvar default-custom-frame-properties nil
   "The frame properties used for the global faces.
-Frames not matching these propertiess should have frame local faces.
+Frames not matching these properties should have frame local faces.
 The value should be nil, if uninitialized, or a plist otherwise.
 See `defface' for a list of valid keys and values for the plist.")
 
index fdd3cc2..cc16201 100644 (file)
@@ -280,7 +280,7 @@ If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."
 
 (defun paths-decode-directory-path (string &optional drop-empties)
   "Split STRING at path separators into a directory list.
-Non-\"\" comonents are converted into directory form.
+Non-\"\" components are converted into directory form.
 If DROP-EMPTIES is non-NIL, \"\" components are dropped from the output.
 Otherwise, they are left alone."
   (let* ((components (split-path string))
index 6967e45..cbed603 100644 (file)
@@ -78,41 +78,48 @@ directories to view or extract information from package source code.")
   `(
     (abbrev    . "abbreviation handling, typing shortcuts, macros")
     (bib       . "code related to the `bib' bibliography processor")
+    (build     . "code used to build XEmacs")
     (c         . "C, C++, and Objective-C language support")
     (calendar  . "calendar and time management support")
     (comm      . "communications, networking, remote access to files")
+    (content    . "contains content (menu/dialog box descs, text, images, &c)")
     (data      . "support for editing files of data")
-    (docs      . "support for Emacs documentation")
-    (dumped     . "files preloaded into Emacs")
+    (docs      . "support for XEmacs documentation")
+    (dumped     . "files preloaded into XEmacs")
     (emulations        . "emulations of other editors")
     (extensions        . "Emacs Lisp language extensions")
     (faces     . "support for multiple fonts")
-    (frames    . "support for Emacs frames and window systems")
+    (frames    . "support for XEmacs frames and window systems")
     (games     . "games, jokes and amusements")
+    (gui       . "support for menubars, dialog boxes, and other GUI features")
     (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")
+    (internal  . "code implementing core functionality in XEmacs")
     (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")
+    (maint     . "maintenance aids for the Emacs development group")
     (matching  . "various sorts of searching and matching")
     (mouse     . "mouse support")
+    (mswin     . "support for anything running on MS Windows")
     ,(when (featurep 'mule)
        (cons '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")
+    (services  . "provides services for use by other programs (cf `user')")
     (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")
+    (user      . "program interacts directly with the user (cf `services'")
     (vms       . "support code for vms")
     (wp                . "word processing")
+    (www       . "support for the Web (WWW, the World Wide Web)")
     ))
 
 (defvar finder-mode-map nil)
@@ -286,6 +293,7 @@ arguments compiles from `load-path'."
        (setq dirs (cdr dirs)))
       found)))
 
+;;;###autoload
 (defun finder-commentary (file)
   "Display FILE's commentary section.
 FILE should be in a form suitable for passing to `locate-library'."
@@ -397,7 +405,7 @@ FILE should be in a form suitable for passing to `locate-library'."
     "\\<finder-mode-map>\\[finder-select] = select, \\[finder-list-keywords] = keywords, \\[finder-edit] = edit, \\[finder-view] = view, \\[finder-exit] = quit, \\[finder-summary] = help")))
 
 (defun finder-exit ()
-  "Exit Finder mode and kill the buffer"
+  "Exit Finder mode and kill the buffer."
   (interactive)
   ;; XEmacs change
   (or (one-window-p t 0)
index 297f15d..ee880bb 100644 (file)
@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 1992-1995, 1997 Free Software Foundation, Inc.
 ;; Copyright (C) 1995 Amdahl Corporation.
-;; Copyright (C) 1996 Ben Wing.
+;; Copyright (C) 1996, 2000 Ben Wing.
 
 ;; Author: Jamie Zawinski <jwz@jwz.org>, for the LISPM Preservation Society.
 ;; Minimally merged with FSF 19.34 by Barry Warsaw <bwarsaw@python.org>
@@ -893,9 +893,10 @@ See the variable `font-lock-keywords' for customization."
                 ((or (null maximum-size) (<= (buffer-size) maximum-size))
                  (font-lock-fontify-buffer))
                 (font-lock-verbose
-                 (lprogress-display 'font-lock
-                            "Fontifying %s... buffer too big." 'abort
-                            (buffer-name)))))
+                 (progress-feedback-with-label
+                  'font-lock
+                  "Fontifying %s... buffer too big." 'abort
+                  (buffer-name)))))
          (font-lock-fontified
           (setq font-lock-fontified nil)
           (font-lock-unfontify-region (point-min) (point-max))
@@ -1060,8 +1061,8 @@ 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)
-       (lprogress-display 'font-lock "Fontifying %s... aborted."
-                          'abort (buffer-name))))
+       (progress-feedback-with-label 'font-lock "Fontifying %s... aborted."
+                                     'abort (buffer-name))))
     (run-hooks 'font-lock-after-fontify-buffer-hook)))
 
 (defun font-lock-default-unfontify-buffer ()
@@ -1100,7 +1101,8 @@ 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))
-    (lprogress-display 'font-lock "Fontifying %s..." 0 (buffer-name)))
+    (progress-feedback-with-label '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)
@@ -1347,8 +1349,9 @@ START should be at the beginning of a line."
       nil
     (when (and font-lock-verbose
               (>= (- end start) font-lock-message-threshold))
-      (lprogress-display 'font-lock "Fontifying %s... (syntactically)" 5
-                (buffer-name)))
+      (progress-feedback-with-label '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)))
@@ -1560,8 +1563,9 @@ START should be at the beginning of a line."
                (+ (/ (* (- (point) start) 95) (* (- end start) nkeywords))
                   (/ (* iter 95) nkeywords) 5))
          (when (and loudly (> progress old-progress))
-           (lprogress-display 'font-lock "Fontifying %s... (regexps)"
-                              progress bufname))
+           (progress-feedback-with-label 'font-lock
+                                         "Fontifying %s... (regexps)"
+                                         progress bufname))
          (setq old-progress progress)
          ;; Apply each highlight to this instance of `matcher', which may be
          ;; specific highlights or more keywords anchored to `matcher'.
@@ -1578,7 +1582,9 @@ START should be at the beginning of a line."
            (setq highlights (cdr highlights))))
        (setq iter (1+ iter))
        (setq keywords (cdr keywords))))
-    (if loudly (lprogress-display 'font-lock "Fontifying %s... " 100 (buffer-name)))))
+    (if loudly
+       (progress-feedback-with-label 'font-lock "Fontifying %s... " 100
+                                     (buffer-name)))))
 
 \f
 ;; Various functions.
@@ -1881,30 +1887,39 @@ START should be at the beginning of a line."
     ;;
     ;; Control structures.  ELisp and CLisp combined.
     ;;
-    ;;(regexp-opt
-    ;;  '("cond" "if" "while" "let" "let*" "prog" "progn" "prog1"
-    ;;    "prog2" "progv" "catch" "throw" "save-restriction"
-    ;;    "save-excursion" "save-window-excursion"
-    ;;    "save-current-buffer" "with-current-buffer"
-    ;;    "with-temp-file" "with-temp-buffer" "with-output-to-string"
-    ;;    "with-string-as-buffer-contents"
-    ;;    "save-selected-window" "save-match-data" "unwind-protect"
-    ;;    "condition-case" "track-mouse" "autoload"
-    ;;    "eval-after-load" "eval-and-compile" "eval-when-compile"
-    ;;    "when" "unless" "do" "dolist" "dotimes" "flet" "labels"
-    ;;    "lambda" "return" "return-from"))
     (cons
      (concat
       "(\\("
-      "autoload\\|c\\(atch\\|ond\\(ition-case\\)?\\)\\|do\\(list\\|"
-      "times\\)?\\|eval-\\(a\\(fter-load\\|nd-compile\\)\\|when-compile\\)\\|"
-      "flet\\|if\\|l\\(a\\(bels\\|mbda\\)\\|et\\*?\\)\\|"
-      "prog[nv12\\*]?\\|return\\(-from\\)?\\|save-\\(current-buffer\\|"
-      "excursion\\|match-data\\|restriction\\|selected-window\\|"
-      "window-excursion\\)\\|t\\(hrow\\|rack-mouse\\)\\|un\\(less\\|"
-      "wind-protect\\)\\|w\\(h\\(en\\|ile\\)\\|ith-\\(current-buffer\\|"
-      "output-to-string\\|string-as-buffer-contents\\|temp-\\(buffer\\|"
-      "file\\)\\)\\)"
+      ;; beginning of generated stuff
+      ;; to regenerate, use the regexp-opt below, then delete the outermost
+      ;; grouping, then use the macro below to break up the string.
+      ;; (regexp-opt
+      ;;   '("cond" "if" "while" "let" "let*" "prog" "progn" "prog1"
+      ;;     "prog2" "progv" "catch" "throw" "save-restriction"
+      ;;     "save-excursion" "save-window-excursion"
+      ;;     "save-current-buffer" "with-current-buffer"
+      ;;     "save-selected-window" "with-selected-window"
+      ;;     "save-selected-frame" "with-selected-frame"
+      ;;     "with-temp-file" "with-temp-buffer" "with-output-to-string"
+      ;;     "with-string-as-buffer-contents"
+      ;;     "save-match-data" "unwind-protect" "call-with-condition-handler"
+      ;;     "condition-case" "track-mouse" "autoload"
+      ;;     "eval-after-load" "eval-and-compile" "eval-when-compile"
+      ;;     "when" "unless" "do" "dolist" "dotimes" "flet" "labels"
+      ;;     "lambda" "block" "return" "return-from" "loop") t)
+      ;; (setq last-kbd-macro
+      ;;   (read-kbd-macro "\" C-7 C-1 <right> C-r \\\\| 3*<right> \" RET"))
+      "autoload\\|block\\|c\\(?:a\\(?:ll-with-condition-handler\\|tch\\)\\|"
+      "ond\\(?:ition-case\\)?\\)\\|do\\(?:list\\|times\\)?\\|"
+      "eval-\\(?:a\\(?:fter-load\\|nd-compile\\)\\|when-compile\\)\\|flet\\|"
+      "if\\|l\\(?:a\\(?:bels\\|mbda\\)\\|et\\*?\\|oop\\)\\|prog[12nv]?\\|"
+      "return\\(?:-from\\)?\\|save-\\(?:current-buffer\\|excursion\\|"
+      "match-data\\|restriction\\|selected-\\(?:frame\\|window\\)\\|"
+      "window-excursion\\)\\|t\\(?:hrow\\|rack-mouse\\)\\|un\\(?:less\\|"
+      "wind-protect\\)\\|w\\(?:h\\(?:en\\|ile\\)\\|ith-\\(?:current-buffer\\|"
+      "output-to-string\\|s\\(?:elected-\\(?:frame\\|window\\)\\|"
+      "tring-as-buffer-contents\\)\\|temp-\\(?:buffer\\|file\\)\\)\\)"
+      ;; end of generated stuff
       "\\)\\>") 1)
     ;;
     ;; Feature symbols as references.
@@ -2336,19 +2351,19 @@ This adds highlighting of Java documentation tags, such as @see.")
          "\\|long\\|short\\|void\\)\\>")
   "Regexp which should match a primitive type.")
 
-(let ((capital-letter "A-Z\300-\326\330-\337")
-      (letter "a-zA-Z_$\300-\326\330-\366\370-\377")
-      (digit  "0-9"))
 (defvar java-font-lock-identifier-regexp
-  (concat "\\<\\([" letter "][" letter digit "]*\\)\\>")
+  (let ((letter "a-zA-Z_$\300-\326\330-\366\370-\377")
+       (digit  "0-9"))
+    (concat "\\<\\([" letter "][" letter digit "]*\\)\\>"))
   "Regexp which should match all Java identifiers.")
 
 (defvar java-font-lock-class-name-regexp
-  (concat "\\<\\([" capital-letter "][" letter digit "]*\\)\\>")
+  (let ((capital-letter "A-Z\300-\326\330-\337")
+       (letter "a-zA-Z_$\300-\326\330-\366\370-\377")
+       (digit  "0-9"))
+    (concat "\\<\\([" capital-letter "][" letter digit "]*\\)\\>"))
   "Regexp which should match a class or an interface name.
 The name is assumed to begin with a capital letter.")
-)
-
 
 (let ((java-modifier-regexp
        (concat "\\<\\(abstract\\|const\\|final\\|native\\|"
index dc3b882..4e31321 100644 (file)
@@ -543,6 +543,14 @@ Normally DOMAIN will be a window or nil (meaning the selected window),
 See `glyph-property-instance' for more information."
   (glyph-property-instance glyph 'image domain default no-fallback))
 
+(defun glyph-image-property (glyph prop &optional domain default no-fallback)
+  "Return property PROP of the instance of GLYPH's image in DOMAIN.
+
+Normally DOMAIN will be a window or nil (meaning the selected window).
+The value returned is dependent on the image instance type."
+  (image-instance-property
+   (glyph-image-instance glyph domain default no-fallback) prop))
+
 (defun set-glyph-image (glyph spec &optional locale tag-set how-to-add)
   "Change the image of GLYPH in LOCALE.
 
@@ -746,7 +754,7 @@ Once you have created a glyph, you specify where it will be used as follows:
    `modeline-pointer-glyph' for the pointer used over the modeline, etc.
    Do an apropos over `*-pointer-glyph' to find all of them. (Note also
    that you can temporarily set the mouse pointer to some specific shape
-   by using `set-frame-pointer', which takes an image instace, as obtained
+   by using `set-frame-pointer', which takes an image instance, as obtained
    from calling `glyph-image-instance' on a glyph of type `pointer' --
    either one of the above-mentioned variables or one you created yourself.
    (See below for what it means to create a glyph of type `pointer'.)
index 901724b..ab95b37 100644 (file)
@@ -240,10 +240,8 @@ If the optional argument BURY is non-nil, the help buffer is buried,
 otherwise it is killed."
   (interactive)
   (let ((buf (current-buffer)))
-    (cond ((frame-property (selected-frame) 'help-window-config)
-          (set-window-configuration
-           (frame-property (selected-frame) 'help-window-config))
-          (set-frame-property  (selected-frame) 'help-window-config nil))
+    (cond (help-window-config
+          (set-window-configuration help-window-config))
          ((not (one-window-p))
           (delete-window)))
     (if bury
@@ -480,6 +478,21 @@ You should never set this directory, only let-bind it.")
 ;; another name (which is a shame, because w-d-h-b is a perfect name
 ;; for a macro) that uses with-displaying-help-buffer internally.
 
+(defcustom mode-for-help 'help-mode
+  "*Mode that help buffers are put into.")
+
+(defvar help-sticky-window nil
+;; Window into which help buffers will be displayed, rather than
+;; always searching for a new one.  This is INTERNAL and liable to
+;; change its interface and/or name at any moment.  It should be
+;; bound, not set.
+)
+
+(defvar help-window-config nil)
+
+(make-variable-buffer-local 'help-window-config)
+(put 'help-window-config 'permanent-local t)
+
 (defun with-displaying-help-buffer (thunk &optional name)
   "Form which makes a help buffer with given NAME and evaluates BODY there.
 The actual name of the buffer is generated by the function `help-buffer-name'."
@@ -492,19 +505,28 @@ The actual name of the buffer is generated by the function `help-buffer-name'."
                          (mapcar 'window-frame
                                  (windows-of-buffer buffer-name)))))))
     (help-register-and-maybe-prune-excess buffer-name)
-    (prog1 (with-output-to-temp-buffer buffer-name
-            (prog1 (funcall thunk)
-              (save-excursion
-                (set-buffer standard-output)
-                (help-mode))))
+    ;; if help-sticky-window is bogus or deleted, get rid of it.
+    (if (and help-sticky-window (or (not (windowp help-sticky-window))
+                                   (not (window-live-p help-sticky-window))))
+       (setq help-sticky-window nil))
+    (prog1
+       (let ((temp-buffer-show-function
+              (if help-sticky-window
+                  #'(lambda (buffer)
+                      (set-window-buffer help-sticky-window buffer))
+                temp-buffer-show-function)))
+         (with-output-to-temp-buffer buffer-name
+           (prog1 (funcall thunk)
+             (save-excursion
+               (set-buffer standard-output)
+               (funcall mode-for-help)))))
       (let ((helpwin (get-buffer-window buffer-name)))
        (when helpwin
-         (with-current-buffer (window-buffer helpwin)
-           ;; If the *Help* buffer is already displayed on this
-           ;; frame, don't override the previous configuration
-           (when help-not-visible
-             (set-frame-property (selected-frame)
-                                 'help-window-config winconfig)))
+         ;; If the *Help* buffer is already displayed on this
+         ;; frame, don't override the previous configuration
+         (when help-not-visible
+           (with-current-buffer (window-buffer helpwin)
+             (setq help-window-config winconfig)))
          (when help-selects-help-window
            (select-window helpwin))
          (cond ((eq helpwin (selected-window))
@@ -745,16 +767,15 @@ of the key sequence that ran this command."
 (defun xemacs-www-page ()
   "Go to the XEmacs World Wide Web page."
   (interactive)
-  (if (boundp 'browse-url-browser-function)
-      (funcall browse-url-browser-function "http://www.xemacs.org/")
+  (if (fboundp 'browse-url)
+      (browse-url "http://www.xemacs.org/")
     (error "xemacs-www-page requires browse-url")))
 
 (defun xemacs-www-faq ()
   "View the latest and greatest XEmacs FAQ using the World Wide Web."
   (interactive)
-  (if (boundp 'browse-url-browser-function)
-      (funcall browse-url-browser-function
-              "http://www.xemacs.org/faq/index.html")
+  (if (fboundp 'browse-url)
+      (browse-url "http://www.xemacs.org/faq/index.html")
     (error "xemacs-www-faq requires browse-url")))
 
 (defun xemacs-local-faq ()
@@ -922,6 +943,21 @@ list containing point.  If that doesn't give a function, return nil."
              (setq obj (read (current-buffer)))
              (and (symbolp obj) (fboundp obj) obj)))))))
 
+(defun function-at-event (event)
+  "Return the function whose name is around the position of EVENT.
+EVENT should be a mouse event.  When calling from a popup or context menu,
+use `last-popup-menu-event' to find out where the mouse was clicked.
+\(You cannot use (interactive \"e\"), unfortunately.  This returns a
+misc-user event.)
+
+If the event contains no position, or the position is not over text, or
+there is no function around that point, nil is returned."
+  (if (and event (event-buffer event) (event-point event))
+      (save-excursion
+       (set-buffer (event-buffer event))
+       (goto-char (event-point event))
+       (function-at-point))))
+
 ;; Default to nil for the non-hackers?  Not until we find a way to
 ;; distinguish hackers from non-hackers automatically!
 (defcustom describe-function-show-arglist t
@@ -1065,6 +1101,119 @@ part of the documentation of internal subroutines."
             (string-match "[\n\t ]*\narguments: ?(\\(.*\\))\n?\\'" doc))
        (setq doc (substring doc 0 (match-beginning 0))))
     doc))
+;  (let ((name-char "[-+a-zA-Z0-9_*]") (sym-char "[-+a-zA-Z0-9_:*]"))
+;    (list
+;     ;;
+;     ;; The symbol itself.
+;     (list (concat "\\`\\(" name-char "+\\)\\(:\\)?")
+;         '(1 (if (match-beginning 2)
+;                 'font-lock-function-name-face
+;               'font-lock-variable-name-face)
+;             nil t))
+;     ;;
+;     ;; Words inside `' which tend to be symbol names.
+;     (list (concat "`\\(" sym-char sym-char "+\\)'")
+;         1 '(prog1
+;                'font-lock-reference-face
+;              (add-list-mode-item (match-beginning 1)
+;                             (match-end 1)
+;                             nil
+;                             'help-follow-reference))
+;         t)
+;     ;;
+;     ;; CLisp `:' keywords as references.
+;     (list (concat "\\<:" sym-char "+\\>") 0 'font-lock-reference-face t)))
+
+(defvar help-symbol-regexp
+  (let ((sym-char "[+a-zA-Z0-9_:*]")
+       (sym-char-no-dash "[-+a-zA-Z0-9_:*]"))
+    (concat "\\("
+           ;; a symbol with a - in it.
+           "\\<\\(" sym-char-no-dash "+\\(-" sym-char-no-dash "+\\)+\\)\\>"
+           "\\|"
+           "`\\(" sym-char "+\\)'"
+           "\\)")))
+
+(defun help-symbol-run-function-1 (ev ex fun)
+  (let ((help-sticky-window
+        ;; if we were called from a help buffer, make sure the new help
+        ;; goes in the same window.
+        (if (and (event-buffer ev)
+                 (symbol-value-in-buffer 'help-window-config
+                                         (event-buffer ev)))
+            (event-window ev)
+          help-sticky-window)))
+    (funcall fun (extent-property ex 'help-symbol))))
+
+(defun help-symbol-run-function (fun)
+  (let ((ex (extent-at-event last-popup-menu-event 'help-symbol)))
+    (when ex
+      (help-symbol-run-function-1 last-popup-menu-event ex fun))))
+
+(defvar help-symbol-function-context-menu
+  '("---"
+    ["View %_Documentation" (help-symbol-run-function 'describe-function)]
+    ["Find %_Function Source" (help-symbol-run-function 'find-function)]
+    ))
+
+(defvar help-symbol-variable-context-menu
+  '("---"
+    ["View %_Documentation" (help-symbol-run-function 'describe-variable)]
+    ["Find %_Variable Source" (help-symbol-run-function 'find-variable)]
+    ))
+
+(defvar help-symbol-function-and-variable-context-menu
+  '("---"
+    ["View Function %_Documentation" (help-symbol-run-function 
+                                     'describe-function)]
+    ["View Variable D%_ocumentation" (help-symbol-run-function
+                                     'describe-variable)]
+    ["Find %_Function Source" (help-symbol-run-function 'find-function)]
+    ["Find %_Variable Source" (help-symbol-run-function 'find-variable)]
+    ))
+
+(defun frob-help-extents (buffer)
+  ;; Look through BUFFER, starting at the buffer's point and continuing
+  ;; till end of file, and find documented functions and variables.
+  ;; any such symbol found is tagged with an extent, that sets up these
+  ;; properties:
+  ;; 1. mouse-face is 'highlight (so the extent gets highlighted on mouse over)
+  ;; 2. help-symbol is the name of the symbol.
+  ;; 3. context-menu is a list of context menu items, specific to whether
+  ;;    the symbol is a function, variable, or both.
+  ;; 4. activate-function will cause the function or variable to be described,
+  ;;    replacing the existing help contents.
+  (save-excursion
+    (set-buffer buffer)
+    (let (b e name)
+      (while (re-search-forward help-symbol-regexp nil t)
+       (setq b (or (match-beginning 2) (match-beginning 4)))
+       (setq e (or (match-end 2) (match-end 4)))
+       (setq name (buffer-substring b e))
+       (let* ((sym (intern-soft name))
+              (var (and sym (boundp sym)
+                        (documentation-property sym
+                                                'variable-documentation t)))
+              (fun (and sym (fboundp sym)
+                        (documentation sym t))))
+         (when (or var fun)
+           (let ((ex (make-extent b e)))
+             (set-extent-property ex 'mouse-face 'highlight)
+             (set-extent-property ex 'help-symbol sym)
+             (set-extent-property
+              ex 'context-menu
+              (cond ((and var fun)
+                     help-symbol-function-and-variable-context-menu)
+                    (var help-symbol-variable-context-menu)
+                    (fun help-symbol-function-context-menu)))
+             (set-extent-property
+              ex 'activate-function
+              (if fun
+                  #'(lambda (ev ex)
+                      (help-symbol-run-function-1 ev ex 'describe-function))
+                #'(lambda (ev ex)
+                    (help-symbol-run-function-1 ev ex 'describe-variable))))
+             ))))))) ;; 11 parentheses!
 
 (defun describe-function-1 (function &optional nodoc)
   "This function does the work for `describe-function'."
@@ -1161,7 +1310,13 @@ part of the documentation of internal subroutines."
             (unless (and obsolete aliases)
               (let ((doc (function-documentation function t)))
                 (princ "Documentation:\n")
-                (princ doc)
+                (let ((oldp (point standard-output))
+                      newp)
+                  (princ doc)
+                  (setq newp (point standard-output))
+                  (goto-char oldp standard-output)
+                  (frob-help-extents standard-output)
+                  (goto-char newp standard-output))
                 (unless (or (equal doc "")
                             (eq ?\n (aref doc (1- (length doc)))))
                   (terpri)))))))))
@@ -1175,7 +1330,6 @@ part of the documentation of internal subroutines."
   (message nil)
   (message (function-arglist function)))
 
-
 (defun variable-at-point ()
   (ignore-errors
     (with-syntax-table emacs-lisp-mode-syntax-table
@@ -1188,6 +1342,21 @@ part of the documentation of internal subroutines."
        (let ((obj (read (current-buffer))))
          (and (symbolp obj) (boundp obj) obj))))))
 
+(defun variable-at-event (event)
+  "Return the variable whose name is around the position of EVENT.
+EVENT should be a mouse event.  When calling from a popup or context menu,
+use `last-popup-menu-event' to find out where the mouse was clicked.
+\(You cannot use (interactive \"e\"), unfortunately.  This returns a
+misc-user event.)
+
+If the event contains no position, or the position is not over text, or
+there is no variable around that point, nil is returned."
+  (if (and event (event-buffer event) (event-point event))
+      (save-excursion
+       (set-buffer (event-buffer event))
+       (goto-char (event-point event))
+       (variable-at-point))))
+
 (defun variable-obsolete-p (variable)
   "Return non-nil if VARIABLE is obsolete."
   (not (null (get variable 'byte-obsolete-variable))))
@@ -1316,7 +1485,13 @@ part of the documentation of internal subroutines."
         (when (or (not obsolete) (not aliases))
           (if doc
               ;; note: documentation-property calls substitute-command-keys.
-              (princ doc)
+              (let ((oldp (point standard-output))
+                    newp)
+                (princ doc)
+                (setq newp (point standard-output))
+                (goto-char oldp standard-output)
+                (frob-help-extents standard-output)
+                (goto-char newp standard-output))
             (princ "not documented as a variable."))))
        (terpri)))
    (format "variable `%s'" variable)))
@@ -1449,5 +1624,4 @@ after the listing is made.)"
        (with-displaying-help-buffer
         (insert string)))))
 
-
 ;;; help.el ends here
index b9d4aaf..b2e266e 100644 (file)
@@ -494,10 +494,12 @@ or nil if current info file is not split into subfiles.")
 (defvar Info-current-node nil
   "Name of node that Info is now looking at, or nil.")
 
-(defvar Info-tag-table-marker (make-marker)
+(defvar Info-tag-table-marker nil
   "Marker pointing at beginning of current Info file's tag table.
 Marker points nowhere if file has no tag table.")
 
+(defvar Info-tag-table-buffer nil)
+
 (defvar Info-current-file-completions nil
   "Cached completion list for current Info file.")
 
@@ -651,7 +653,8 @@ further (recursive) error recovery.  TRYFILE is ??"
   ;; should be locked up where they can't do any more harm.
 
   ;; Go into info buffer.
-  (switch-to-buffer "*info*")
+  (or (eq major-mode 'Info-mode)
+      (switch-to-buffer "*info*"))
   (buffer-disable-undo (current-buffer))
   (run-hooks 'Info-startup-hook)
   (or (eq major-mode 'Info-mode)
@@ -660,7 +663,7 @@ further (recursive) error recovery.  TRYFILE is ??"
       (equal Info-current-file filename)
       (not Info-novice)
       (string= "dir" (file-name-nondirectory Info-current-file))
-      (if (y-or-n-p-maybe-dialog-box
+      (if (y-or-n-p
           (format "Leave Info file `%s'? "
                   (file-name-nondirectory Info-current-file)))
          (message "")
@@ -704,16 +707,20 @@ further (recursive) error recovery.  TRYFILE is ??"
                          (looking-at "(Indirect)\n"))
                        ;; It is indirect.  Copy it to another buffer
                        ;; and record that the tag table is in that buffer.
-                       (save-excursion
-                         (let ((buf (current-buffer)))
-                           (set-buffer
-                            (get-buffer-create " *info tag table*"))
-                           (buffer-disable-undo (current-buffer))
-                           (setq case-fold-search t)
-                           (erase-buffer)
-                           (insert-buffer-substring buf)
-                           (set-marker Info-tag-table-marker
-                                       (match-end 0))))
+                         (let ((buf (current-buffer))
+                               (m Info-tag-table-marker))
+                           (or
+                            Info-tag-table-buffer
+                            (setq
+                             Info-tag-table-buffer
+                             (generate-new-buffer " *info tag table*")))
+                           (save-excursion
+                             (set-buffer Info-tag-table-buffer)
+                             (buffer-disable-undo (current-buffer))
+                             (setq case-fold-search t)
+                             (erase-buffer)
+                             (insert-buffer-substring buf)
+                             (set-marker m (match-end 0))))
                     (set-marker Info-tag-table-marker pos))))
              (setq Info-current-file
                    (file-name-sans-versions buffer-file-name))))
@@ -730,18 +737,21 @@ further (recursive) error recovery.  TRYFILE is ??"
            ;; Also, if this is an indirect info file,
            ;; read the proper subfile into this buffer.
            (if (marker-position Info-tag-table-marker)
-               (save-excursion
-                 (set-buffer (marker-buffer Info-tag-table-marker))
-                 (goto-char Info-tag-table-marker)
-                 (if (re-search-forward regexp nil t)
-                     (progn
-                       (setq guesspos (read (current-buffer)))
-                       ;; If this is an indirect file,
-                       ;; determine which file really holds this node
-                       ;; and read it in.
-                       (if (not (eq (current-buffer) (get-buffer "*info*")))
-                           (setq guesspos
-                                 (Info-read-subfile guesspos)))))))
+               (let (foun found-mode (m Info-tag-table-marker))
+                 (save-excursion
+                   (set-buffer (marker-buffer Info-tag-table-marker))
+                   (goto-char m)
+                   (setq foun (re-search-forward regexp nil t))
+                   (if foun 
+                       (setq guesspos (read (current-buffer))))
+                   (setq found-mode major-mode))
+                 (if foun 
+                     ;; If this is an indirect file,
+                     ;; determine which file really holds this node
+                     ;; and read it in.
+                     (if (not (eq major-mode found-mode))
+                         (setq guesspos
+                               (Info-read-subfile guesspos))))))
            (goto-char (max (point-min) (- guesspos 1000)))
            ;; Now search from our advised position (or from beg of buffer)
            ;; to find the actual node.
@@ -1311,30 +1321,30 @@ For example, invoke \"xemacs -batch -f Info-batch-rebuild-dir /usr/local/info\""
     (if p (file-name-nondirectory file) file)))
 
 (defun Info-read-subfile (nodepos)
-  (set-buffer (marker-buffer Info-tag-table-marker))
-  (goto-char (point-min))
-  (search-forward "\n\^_")
   (let (lastfilepos
        lastfilename)
-    (forward-line 2)
-    (catch 'foo
-      (while (not (looking-at "\^_"))
-       (if (not (eolp))
-           (let ((beg (point))
-                 thisfilepos thisfilename)
-             (search-forward ": ")
-             (setq thisfilename  (buffer-substring beg (- (point) 2)))
-             (setq thisfilepos (read (current-buffer)))
-             ;; read in version 19 stops at the end of number.
-             ;; Advance to the next line.
-             (if (eolp)
-                 (forward-line 1))
-             (if (> thisfilepos nodepos)
-                 (throw 'foo t))
-             (setq lastfilename thisfilename)
-             (setq lastfilepos thisfilepos))
-         (throw 'foo t))))
-    (set-buffer (get-buffer "*info*"))
+    (save-excursion
+      (set-buffer (marker-buffer Info-tag-table-marker))
+      (goto-char (point-min))
+      (search-forward "\n\^_")
+      (forward-line 2)
+      (catch 'foo
+       (while (not (looking-at "\^_"))
+         (if (not (eolp))
+             (let ((beg (point))
+                   thisfilepos thisfilename)
+               (search-forward ": ")
+               (setq thisfilename  (buffer-substring beg (- (point) 2)))
+               (setq thisfilepos (read (current-buffer)))
+               ;; read in version 19 stops at the end of number.
+               ;; Advance to the next line.
+               (if (eolp)
+                   (forward-line 1))
+               (if (> thisfilepos nodepos)
+                   (throw 'foo t))
+               (setq lastfilename thisfilename)
+               (setq lastfilepos thisfilepos))
+           (throw 'foo t)))))
     (or (equal Info-current-subfile lastfilename)
        (let ((buffer-read-only nil))
          (setq buffer-file-name nil)
@@ -1568,14 +1578,15 @@ annotation for any node of any file.  (See `a' and `x' commands.)"
 
 (defun Info-build-node-completions ()
   (or Info-current-file-completions
-      (let ((compl (Info-build-annotation-completions)))
+      (let ((m Info-tag-table-marker)
+           (compl (Info-build-annotation-completions)))
        (save-excursion
          (save-restriction
            (widen)
            (if (marker-buffer Info-tag-table-marker)
                (progn
                  (set-buffer (marker-buffer Info-tag-table-marker))
-                 (goto-char Info-tag-table-marker)
+                 (goto-char m)
                  (while (re-search-forward "\nNode: \\(.*\\)\177" nil t)
                    (setq compl
                          (cons (list (buffer-substring (match-beginning 1)
@@ -1626,26 +1637,27 @@ annotation for any node of any file.  (See `a' and `x' commands.)"
       (if (not found)                   ;can only happen in subfile case -- else would have erred
           (unwind-protect
               (let ((list ()))
-                (set-buffer (marker-buffer Info-tag-table-marker))
-                (goto-char (point-min))
-                (search-forward "\n\^_\nIndirect:")
-                (save-restriction
-                  (narrow-to-region (point)
-                                    (progn (search-forward "\n\^_")
-                                           (1- (point))))
-                  (goto-char (point-min))
-                  (search-forward (concat "\n" osubfile ": "))
-                  (beginning-of-line)
-                  (while (not (eobp))
-                    (re-search-forward "\\(^.*\\): [0-9]+$")
-                    (goto-char (+ (match-end 1) 2))
-                    (setq list (cons (cons (read (current-buffer))
-                                           (buffer-substring (match-beginning 1)
-                                                             (match-end 1)))
-                                     list))
-                    (goto-char (1+ (match-end 0))))
-                  (setq list (nreverse list)
-                        list (cdr list)))
+                (save-excursion
+                 (set-buffer (marker-buffer Info-tag-table-marker))
+                 (goto-char (point-min))
+                 (search-forward "\n\^_\nIndirect:")
+                 (save-restriction
+                   (narrow-to-region (point)
+                                     (progn (search-forward "\n\^_")
+                                            (1- (point))))
+                   (goto-char (point-min))
+                   (search-forward (concat "\n" osubfile ": "))
+                   (beginning-of-line)
+                   (while (not (eobp))
+                     (re-search-forward "\\(^.*\\): [0-9]+$")
+                     (goto-char (+ (match-end 1) 2))
+                     (setq list (cons (cons (read (current-buffer))
+                                            (buffer-substring (match-beginning 1)
+                                                              (match-end 1)))
+                                      list))
+                     (goto-char (1+ (match-end 0))))
+                   (setq list (nreverse list)
+                         list (cdr list))))
                 (while list
                   (message "Searching subfile %s..." (cdr (car list)))
                   (Info-read-subfile (car (car list)))
@@ -2814,6 +2826,9 @@ e Edit the contents of the current node."
   (make-local-variable 'Info-current-subfile)
   (make-local-variable 'Info-current-node)
   (make-local-variable 'Info-tag-table-marker)
+  (setq Info-tag-table-marker (make-marker))
+  (make-local-variable 'Info-tag-table-buffer)
+  (setq Info-tag-table-buffer nil)
   (make-local-variable 'Info-current-file-completions)
   (make-local-variable 'Info-current-annotation-completions)
   (make-local-variable 'Info-index-alternatives)
@@ -2879,7 +2894,7 @@ Allowed only if variable `Info-enable-edit' is non-nil."
   (interactive)
   ;; Do this first, so nothing has changed if user C-g's at query.
   (and (buffer-modified-p)
-       (y-or-n-p-maybe-dialog-box "Save the file? ")
+       (y-or-n-p "Save the file? ")
        (save-buffer))
   (use-local-map Info-mode-map)
   (setq major-mode 'Info-mode)
index f42dc35..492bacd 100644 (file)
@@ -1210,7 +1210,8 @@ Obsolete."
       (set yank-pointer-name
           (setq yank-pointer
                 (mod (+ (or yank-pointer 0)
-                        (if advance -1 1))
+                        ;; XEmacs change
+                        (if advance -1 (if yank-pointer 1 0)))
                      length)))
       (setq isearch-string (nth yank-pointer ring)
            isearch-message (mapconcat 'isearch-text-char-description
index 765ee58..17f2e66 100644 (file)
@@ -272,6 +272,10 @@ Keymap for characters following C-c.")
 (define-key global-map "\M-\C-t" 'transpose-sexps)
 (define-key global-map "\C-x\C-t" 'transpose-lines)
 
+;; XEmacs: much more reasonable and useful key definitions.
+(define-key global-map '(control T) 'transpose-line-down)
+(define-key global-map '(meta T) 'transpose-line-up)
+
 (define-key global-map "\M-;" 'indent-for-comment)
 (define-key global-map "\M-j" 'indent-new-comment-line)
 (define-key global-map "\M-\C-j" 'indent-new-comment-line)
index c27747a..4f5e9a9 100644 (file)
@@ -5,7 +5,7 @@
 ;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
 ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
 ;; Created: Jan 1998
-;; Version: $Revision: 1.7.2.7 $
+;; Version: $Revision: 1.7.2.8 $
 ;; Keywords: help comm
 
 ;; This file is part of XEmacs
@@ -444,7 +444,19 @@ and the corresponding decoder is then retrieved from
     (if decoder
        (cons name (mapcar decoder values))
       attr)))
-    
+
+(defun ldap-decode-entry (entry)
+  "Decode the attributes of ENTRY according to LDAP rules."
+  (let (dn decoded)
+    (setq dn (car entry))
+    (if (stringp dn)
+       (setq entry (cdr entry))
+      (setq dn nil))
+    (setq decoded (mapcar 'ldap-decode-attribute entry))
+    (if dn
+       (cons dn decoded)
+      decoded)))
+
 (defun ldap-search (arg1 &rest args)
   "Perform an LDAP search."  
       (apply (if (ldapp arg1)
@@ -490,10 +502,7 @@ entry according to the value of WITHDN."
     (ldap-close ldap)
     (if ldap-ignore-attribute-codings
        result
-      (mapcar (function 
-              (lambda (record)
-                (mapcar 'ldap-decode-attribute record)))
-             result))))
+      (mapcar 'ldap-decode-entry result))))
 
 (defun ldap-add-entries (entries &optional host binddn passwd)
   "Add entries to an LDAP directory.
index 502a93c..d0278b1 100644 (file)
 (defvar emacs-lisp-mode-syntax-table nil)
 (defvar lisp-mode-abbrev-table nil)
 
-;; XEmacs change
-(defvar lisp-interaction-mode-popup-menu
-  (purecopy '("Lisp-Interaction"
-             ["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]
-             ["%_Instrument This Defun for Debugging" edebug-defun]
-             "---"
-             ["Find %_Function Source..." find-function
+(defun construct-lisp-mode-menu (popup-p emacs-lisp-p)
+  (flet ((popup-wrap (form)
+          (if popup-p `(menu-call-at-event ',form) form)))
+    `(,@(if emacs-lisp-p
+         `(["%_Byte-Compile This File" ,(popup-wrap
+                                         'emacs-lisp-byte-compile)]
+           ["B%_yte-Compile/Load This File"
+            ,(popup-wrap 'emacs-lisp-byte-compile-and-load)]
+           ["Byte-%_Recompile Directory..."
+            ,(popup-wrap 'byte-recompile-directory)]
+           "---"))
+       ["%_Evaluate Region or Defun"
+        ,(popup-wrap '(if (region-exists-p)
+                          (call-interactively 'eval-region)
+                        (call-interactively 'eval-defun)))]
+       ["Evaluate %_Whole Buffer" ,(popup-wrap 'eval-current-buffer)]
+       ["Evaluate Last %_S-expression" ,(popup-wrap 'eval-last-sexp)]
+       "---"
+       ,@(if popup-p
+           '(["%_Find Function"
+              (find-function (menu-call-at-event '(function-at-point)))
+              :suffix (let ((fun (menu-call-at-event '(function-at-point))))
+                        (if fun (symbol-name fun) ""))
+              :active (and (fboundp 'find-function)
+                           (menu-call-at-event '(function-at-point)))]
+             ["%_Find Variable"
+              (find-variable (menu-call-at-event '(variable-at-point)))
+              :suffix (let ((fun (menu-call-at-event '(variable-at-point))))
+                        (if fun (symbol-name fun) ""))
+              :active (and (fboundp 'find-variable)
+                           (menu-call-at-event '(variable-at-point)))]
+             ["%_Help on Function"
+              (describe-function (menu-call-at-event '(function-at-point)))
+              :suffix (let ((fun (menu-call-at-event '(function-at-point))))
+                        (if fun (symbol-name fun) ""))
+              :active (and (fboundp 'describe-function)
+                           (menu-call-at-event '(function-at-point)))]
+             ["%_Help on Variable"
+              (describe-variable (menu-call-at-event '(variable-at-point)))
+              :suffix (let ((fun (menu-call-at-event '(variable-at-point))))
+                        (if fun (symbol-name fun) ""))
+              :active (and (fboundp 'describe-variable)
+                           (menu-call-at-event '(variable-at-point)))])
+           '(["Find %_Function..." find-function
               :active (fboundp 'find-function)]
-             ["Find %_Variable Source..." find-variable
+             ["Find %_Variable..." 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 %_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"
-             )))
+             ["%_Help on Function..." describe-function
+              :active (fboundp 'describe-function)]
+             ["Hel%_p on Variable..." describe-variable
+              :active (fboundp 'describe-variable)]))
+       "---"
+       ["Instrument This Defun for %_Debugging" ,(popup-wrap 'edebug-defun)]
+       ["%_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 or Balanced Expression"
+        ,(popup-wrap '(if (region-exists-p)
+                          (call-interactively 'indent-region)
+                        (call-interactively 'indent-sexp)))]
+       ["I%_ndent Defun"
+        ,(popup-wrap '(progn
+                        (beginning-of-defun)
+                        (indent-sexp)))]
+       "---"
+       "Look for debug-on-error under Options->Troubleshooting"
+       )))
+
+(defvar lisp-interaction-mode-popup-menu
+  (cons "Lisp-Interaction" (construct-lisp-mode-menu t nil)))
 
 (defvar emacs-lisp-mode-popup-menu
-  (purecopy
-   (nconc
-    '("Emacs-Lisp"
-      ["%_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))))
+  (cons "Emacs-Lisp" (construct-lisp-mode-menu t t)))
 
 ;Don't have a menubar entry in Lisp Interaction mode.  Otherwise, the
 ;*scratch* buffer has a Lisp menubar item!  Very confusing.
 ;Jan Vroonhof really wants this, so it's back.  --ben
 (defvar lisp-interaction-mode-menubar-menu
-  (purecopy (cons "%_Lisp" (cdr lisp-interaction-mode-popup-menu))))
+  (cons "%_Lisp" (construct-lisp-mode-menu nil nil)))
 
 (defvar emacs-lisp-mode-menubar-menu
-  (purecopy (cons "%_Lisp" (cdr emacs-lisp-mode-popup-menu))))
+  (cons "%_Lisp" (construct-lisp-mode-menu nil t)))
 
 (if (not emacs-lisp-mode-syntax-table)
     (let ((i 0))
@@ -667,8 +699,16 @@ of the start of the containing expression."
       (let ((function (buffer-substring (point)
                                        (progn (forward-sexp 1) (point))))
            method)
-       (setq method (or (get (intern-soft function) 'lisp-indent-function)
-                        (get (intern-soft function) 'lisp-indent-hook)))
+       (if (condition-case nil
+               (save-excursion
+                 (backward-up-list 1)
+                 (backward-up-list 1)
+                 (backward-up-list 1)
+                 (looking-at "(flet\\s-"))
+             (error nil))
+           (setq method 'defun)
+         (setq method (or (get (intern-soft function) 'lisp-indent-function)
+                          (get (intern-soft function) 'lisp-indent-hook))))
        (cond ((or (eq method 'defun)
                   (and (null method)
                        (> (length function) 3)
@@ -749,6 +789,7 @@ of the start of the containing expression."
 (put 'save-excursion 'lisp-indent-function 0)
 (put 'save-window-excursion 'lisp-indent-function 0)
 (put 'save-selected-window 'lisp-indent-function 0)
+(put 'with-selected-window 'lisp-indent-function 1)
 (put 'save-selected-frame 'lisp-indent-function 0)
 (put 'with-selected-frame 'lisp-indent-function 1)
 (put 'save-restriction 'lisp-indent-function 0)
index c61764c..11f695f 100644 (file)
 
 ;;; Code:
 
-;;; Warning-free compile
-(eval-when-compile
-  (defvar language-environment-list)
-  (defvar bookmark-alist)
-  (defvar language-info-alist)
-  (defvar current-language-environment)
-  (defvar tutorial-supported-languages))
-
 (defun menu-truncate-list (list n)
   (if (<= (length list) n)
       list
@@ -147,12 +139,13 @@ which will not be used as accelerators."
       ["Save %_As..." write-file]
       ["Save So%_me Buffers" save-some-buffers]
       "-----"
-      ["%_Print Buffer" generic-print-buffer
+      ["%_Print" generic-print-buffer
        :active (or (valid-specifier-tag-p 'msprinter)
                   (and (not (eq system-type 'windows-nt))
                        (fboundp 'lpr-buffer)))
-       :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
-      ["Prett%_y-Print Buffer" ps-print-buffer-with-faces
+       :suffix (if put-buffer-names-in-file-menu (concat (buffer-name) "...")
+                "...")]
+      ["Prett%_y-Print" ps-print-buffer-with-faces
        :active (fboundp 'ps-print-buffer-with-faces)
        :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
       "-----"
@@ -194,15 +187,12 @@ which will not be used as accelerators."
        :active (selection-owner-p)]
       "----"
       ["Select %_All" mark-whole-buffer]
-      ["Select %_Page" mark-page]
-      "----"
-      ["%_Search..." make-search-dialog]
-      ["%_1 Replace..." query-replace]
+      ["Select Pa%_ge" mark-page]
       "----"
-      ["%_2 Search (Regexp)..." isearch-forward-regexp]
-      ["%_3 Search Backward (Regexp)..." isearch-backward-regexp]
-      ["%_4 Replace (Regexp)..." query-replace-regexp]
-
+      ["%_Find..." make-search-dialog]
+      ["R%_eplace..." query-replace]
+      ["Replace (Rege%_xp)..." query-replace-regexp]
+      ["%_List Matching Lines..." list-matching-lines]
       ,@(when (featurep 'mule)
         '("----"
           ("%_Multilingual (\"Mule\")"
@@ -363,13 +353,20 @@ which will not be used as accelerators."
        :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)]
+       ["%_Lines in Region" sort-lines :active (region-exists-p)]
+       ["%_Paragraphs in Region" sort-paragraphs :active (region-exists-p)]
+       ["P%_ages in Region" sort-pages :active (region-exists-p)]
+       ["%_Columns in Region" sort-columns :active (region-exists-p)]
        ["%_Regexp..." sort-regexp-fields :active (region-exists-p)]
        )
-      ("%_Center"
+      ("%_Change Case"
+       ["%_Upcase Region" upcase-region :active (region-exists-p)]
+       ["%_Downcase Region" downcase-region :active (region-exists-p)]
+       ["%_Capitalize Region" capitalize-region :active (region-exists-p)]
+       ["%_Title-Case Region" capitalize-region-as-title
+       :active (region-exists-p)]
+       )
+      ("Ce%_nter"
        ["%_Line" center-line]
        ["%_Paragraph" center-paragraph]
        ["%_Region" center-region :active (region-exists-p)]
@@ -393,6 +390,25 @@ which will not be used as accelerators."
       )
 
      ("%_Tools"
+      ("%_Packages"
+       ("%_Add Download Site"
+        :filter (lambda (&rest junk)
+                  (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" 
+       :filter (lambda (&rest junk)
+                 (if package-get-base
+                     (submenu-generate-accelerator-spec
+                      (cdr (custom-menu-create 'packages)))
+                   '("Please load Package Index"))))
+       
+       ["%_Help" (Info-goto-node "(xemacs)Packages")])
       ("%_Internet"
        ["Read Mail %_1 (VM)..." vm
        :active (fboundp 'vm)]
@@ -631,38 +647,10 @@ which will not be used as accelerators."
        ["Se%_t..." customize-customized]
        ["%_Apropos..." customize-apropos]
        ["%_Browse..." customize-browse])
-      ("Manage %_Packages"
-       ("%_Add Download Site"
-        :filter (lambda (&rest junk)
-                  (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" 
-       :filter (lambda (&rest junk)
-                 (if package-get-base
-                     (submenu-generate-accelerator-spec
-                      (cdr (custom-menu-create 'packages)))
-                   '(["Please load Package Index"
-                      (lamda (&rest junk) ()) nil]))))
-       
-       ["%_Help" (Info-goto-node "(xemacs)Packages")])
       "---"
-      ("%_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)]
+      ("%_Editing"
+       ["This Buffer %_Read Only" (toggle-read-only)
+       :style toggle :selected buffer-read-only]
        ["%_Yank/Kill Interact With Clipboard"
        (if (eq interprogram-cut-function 'own-clipboard)
            (progn
@@ -677,38 +665,20 @@ which will not be used as accelerators."
          (setq overwrite-mode (if overwrite-mode nil 'overwrite-mode-textual))
          (customize-set-variable 'overwrite-mode overwrite-mode))
        :style toggle :selected overwrite-mode]
-       ("`%_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)]
+       ["%_Abbrev Mode"
+       (customize-set-variable 'abbrev-mode
+                               (not (default-value 'abbrev-mode)))
+       :style toggle
+       :selected (default-value 'abbrev-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]
        "---"
@@ -726,43 +696,46 @@ which will not be used as accelerators."
        ["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]
+       :style toggle :selected next-line-add-newlines])
+      ("%_Keyboard and Mouse"
+       ["%_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)]
+       ("`%_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)]
+       "----"
+       ["%_Set Key..." global-set-key]
+       ["%_Unset Key..." global-unset-key]
        "---"
-       ["%_Mouse Paste at Text Cursor"
+       ["%_Mouse Paste at Text Cursor (not Clicked Location)"
        (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"
-       ["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"
-       (customize-set-variable 'debug-on-error (not debug-on-error))
-       :style toggle :selected debug-on-error]
-       ["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"
        ["Set Printer %_Name for Generic Print Support..."
        (customize-set-variable
@@ -967,46 +940,113 @@ which will not be used as accelerators."
                        (eq browse-url-browser-function 'browse-url-kfm))
         :active (and (boundp 'browse-url-browser-function)
                      (fboundp 'browse-url-kfm))]
-       ))
-
-
+       ))      
+      ("%_Troubleshooting"
+       ["%_Debug on Error"
+       (customize-set-variable 'debug-on-error (not debug-on-error))
+       :style toggle :selected debug-on-error]
+       ["Debug on %_Quit"
+       (customize-set-variable 'debug-on-quit (not debug-on-quit))
+       :style toggle :selected debug-on-quit]
+       ["Debug on S%_ignal"
+       (customize-set-variable 'debug-on-signal (not debug-on-signal))
+       :style toggle :selected debug-on-signal]
+       ["%_Stack Trace on Error"
+       (customize-set-variable 'stack-trace-on-error
+                               (not stack-trace-on-error))
+       :style toggle :selected stack-trace-on-error]
+       ["Stack Trace on Si%_gnal"
+       (customize-set-variable 'stack-trace-on-signal
+                               (not stack-trace-on-signal))
+       :style toggle :selected stack-trace-on-signal]
+       )
       "-----"
-      ("Display"
+      ("%_Display"
        ,@(if (featurep 'scrollbar)
             '(["%_Scrollbars"
                (customize-set-variable 'scrollbars-visible-p
                                        (not scrollbars-visible-p))
                :style toggle
                :selected scrollbars-visible-p]))
-       ;; I don't think this is of any interest. - dverna apr. 98
-       ;; #### I beg to differ!  Many FSFmacs converts hate the 3D
-       ;; modeline, and it was perfectly fine to be able to turn them
-       ;; 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"
+       ["%_3D Modeline"
+       (customize-set-variable 'modeline-3d-p
+                               (not modeline-3d-p))
+       :style toggle
+       :selected modeline-3d-p]
+       ["%_Wrap Long Lines"
        (progn;; becomes buffer-local
          (setq truncate-lines (not truncate-lines))
          (customize-set-variable 'truncate-lines truncate-lines))
        :style toggle
-       :selected truncate-lines]
+       :selected (not truncate-lines)]
+       ,@(if (featurep 'toolbar)
+            '("---"
+              ["%_Toolbars Visible"
+               (customize-set-variable 'toolbar-visible-p
+                                       (not toolbar-visible-p))
+               :style toggle
+               :selected toolbar-visible-p]
+              ["Toolbars Ca%_ptioned"
+               (customize-set-variable 'toolbar-captioned-p
+                                       (not toolbar-captioned-p))
+               :style toggle
+               :active toolbar-visible-p
+               :selected toolbar-captioned-p]
+              ("Default Toolba%_r Location"
+               ["%_Top"
+                (customize-set-variable 'default-toolbar-position 'top)
+                :style radio
+                :active toolbar-visible-p
+                :selected (eq default-toolbar-position 'top)]
+               ["%_Bottom"
+                (customize-set-variable 'default-toolbar-position 'bottom)
+                :style radio
+                :active toolbar-visible-p
+                :selected (eq default-toolbar-position 'bottom)]
+               ["%_Left"
+                (customize-set-variable 'default-toolbar-position 'left)
+                :style radio
+                :active toolbar-visible-p
+                :selected (eq default-toolbar-position 'left)]
+               ["%_Right"
+                (customize-set-variable 'default-toolbar-position 'right)
+                :style radio
+                :active toolbar-visible-p
+                :selected (eq default-toolbar-position 'right)]
+               )
+              ))
+       ,@(if (featurep 'gutter)
+            '("---"
+              ["B%_uffers Tab Visible"
+               (customize-set-variable 'gutter-buffers-tab-visible-p
+                                       (not gutter-buffers-tab-visible-p))
+               :style toggle
+               :selected gutter-buffers-tab-visible-p]
+              ("Default %_Gutter Location"
+               ["%_Top"
+                (customize-set-variable 'default-gutter-position 'top)
+                :style radio
+                :selected (eq default-gutter-position 'top)]
+               ["%_Bottom"
+                (customize-set-variable 'default-gutter-position 'bottom)
+                :style radio
+                :selected (eq default-gutter-position 'bottom)]
+               ["%_Left"
+                (customize-set-variable 'default-gutter-position 'left)
+                :style radio
+                :selected (eq default-gutter-position 'left)]
+               ["%_Right"
+                (customize-set-variable 'default-gutter-position 'right)
+                :style radio
+                :selected (eq default-gutter-position 'right)]
+               )
+              ))
+       "-----"
        ["%_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)]
-       "-----"
        ["Bl%_ock Cursor"
        (progn
          (customize-set-variable 'bar-cursor nil)
@@ -1025,6 +1065,34 @@ which will not be used as accelerators."
          (force-cursor-redisplay))
        :style radio
        :selected (and bar-cursor (not (eq bar-cursor t)))]
+       "----"
+       ("Pa%_ren 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)]
+       ;;       ["Nes%_ted Shading"
+       ;;        (customize-set-variable 'paren-mode 'nested)
+       ;;        :style radio
+       ;;        :selected (and (boundp 'paren-mode) (eq paren-mode 'nested))
+       ;;        :active (boundp 'paren-mode)]
+       )
        "------"
        ["%_Line Numbers"
        (progn
@@ -1045,23 +1113,28 @@ which will not be used as accelerators."
         :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)
+        (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)
+        (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)
+        (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)
+        (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)
+        (customize-set-variable 'get-frame-for-buffer-default-instance-limit
+                                0)
         :style radio
         :selected (eq 0 get-frame-for-buffer-default-instance-limit)]
        "-----"
@@ -1077,7 +1150,8 @@ which will not be used as accelerators."
         :selected (null temp-buffer-show-function)]
        "-----"
        ["%_Make Current Frame Gnuserv Target"
-        (customize-set-variable 'gnuserv-frame (if (eq gnuserv-frame t) nil t))
+        (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)]
@@ -1159,64 +1233,6 @@ which will not be used as accelerators."
        :selected (and (boundp 'font-menu-ignore-scaled-fonts)
                       font-menu-ignore-scaled-fonts)]
        )
-      ,@(if (featurep 'toolbar)
-           '(("%_Toolbars"
-              ["%_Visible"
-               (customize-set-variable 'toolbar-visible-p
-                                       (not toolbar-visible-p))
-               :style toggle
-               :selected toolbar-visible-p]
-              ["%_Captioned"
-               (customize-set-variable 'toolbar-captioned-p
-                                       (not toolbar-captioned-p))
-               :style toggle
-               :selected toolbar-captioned-p]
-              ("%_Default Location"
-               ["%_Top"
-                (customize-set-variable 'default-toolbar-position 'top)
-                :style radio
-                :selected (eq default-toolbar-position 'top)]
-               ["%_Bottom"
-                (customize-set-variable 'default-toolbar-position 'bottom)
-                :style radio
-                :selected (eq default-toolbar-position 'bottom)]
-               ["%_Left"
-                (customize-set-variable 'default-toolbar-position 'left)
-                :style radio
-                :selected (eq default-toolbar-position 'left)]
-               ["%_Right"
-                (customize-set-variable 'default-toolbar-position 'right)
-                :style radio
-                :selected (eq default-toolbar-position 'right)]
-               )
-              )))
-      ,@(if (featurep 'gutter)
-           '(("G%_utters"
-              ["Buffers Tab %_Visible"
-               (customize-set-variable 'gutter-buffers-tab-visible-p
-                                       (not gutter-buffers-tab-visible-p))
-               :style toggle
-               :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"
-                (customize-set-variable 'default-gutter-position 'bottom)
-                :style radio
-                :selected (eq default-gutter-position 'bottom)]
-               ["%_Left"
-                (customize-set-variable 'default-gutter-position 'left)
-                :style radio
-                :selected (eq default-gutter-position 'left)]
-               ["%_Right"
-                (customize-set-variable 'default-gutter-position 'right)
-                :style radio
-                :selected (eq default-gutter-position 'right)]
-               )
-              )))
-      "-----"
       ("S%_yntax Highlighting"
        ["%_In This Buffer"
        (progn;; becomes buffer local
@@ -1232,6 +1248,13 @@ which will not be used as accelerators."
        :selected (and (boundp 'font-lock-auto-fontify) font-lock-auto-fontify)
        :active (fboundp 'font-lock-mode)]
        "-----"
+       ["Force %_Rehighlight in this Buffer"
+       (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)
@@ -1253,7 +1276,7 @@ which will not be used as accelerators."
        :selected (and (boundp 'font-lock-use-colors) font-lock-use-colors)
        :active (boundp 'font-lock-mode)]
        "-----"
-       ["%_Least"
+       ["%_1 Least"
        (progn
          (require 'font-lock)
          (if (or (and (not (integerp font-lock-maximum-decoration))
@@ -1265,12 +1288,12 @@ which will not be used as accelerators."
            (font-lock-recompute-variables)))
        :style radio
        :active (fboundp 'font-lock-mode)
-       :selected (and (boundp 'font-lock-maximium-decoration)
+       :selected (and (boundp 'font-lock-maximum-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"
+       ["%_2 More"
        (progn
          (require 'font-lock)
          (if (and (integerp font-lock-maximum-decoration)
@@ -1280,10 +1303,10 @@ which will not be used as accelerators."
            (font-lock-recompute-variables)))
        :style radio
        :active (fboundp 'font-lock-mode)
-       :selected (and (boundp 'font-lock-maximium-decoration)
+       :selected (and (boundp 'font-lock-maximum-decoration)
                       (integerp font-lock-maximum-decoration)
                       (= 1 font-lock-maximum-decoration))]
-       ["%_Even More"
+       ["%_3 Even More"
        (progn
          (require 'font-lock)
          (if (and (integerp font-lock-maximum-decoration)
@@ -1296,7 +1319,7 @@ which will not be used as accelerators."
        :selected (and (boundp 'font-lock-maximum-decoration)
                       (integerp font-lock-maximum-decoration)
                       (= 2 font-lock-maximum-decoration))]
-       ["%_Most"
+       ["%_4 Most"
        (progn
          (require 'font-lock)
          (if (or (eq font-lock-maximum-decoration t)
@@ -1312,7 +1335,19 @@ which will not be used as accelerators."
                           (and (integerp font-lock-maximum-decoration)
                                (>= font-lock-maximum-decoration 3))))]
        "-----"
-       ["La%_zy"
+       ["Lazy %_Lock"
+       (progn;; becomes buffer local
+         (lazy-lock-mode)
+         (customize-set-variable 'lazy-lock-mode lazy-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 'lazy-lock-mode)
+                    font-lock-mode)
+       :style toggle
+       :selected (and (boundp 'lazy-lock-mode) lazy-lock-mode)]
+       ["Lazy %_Shot"
        (progn;; becomes buffer local
          (lazy-shot-mode)
          (customize-set-variable 'lazy-shot-mode lazy-shot-mode)
@@ -1337,46 +1372,18 @@ which will not be used as accelerators."
        :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 '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)]
-       ;;       ["Nes%_ted Shading"
-       ;;        (customize-set-variable 'paren-mode 'nested)
-       ;;        :style radio
-       ;;        :selected (and (boundp 'paren-mode) (eq paren-mode 'nested))
-       ;;        :active (boundp 'paren-mode)]
-       )
-      "-----"
+      ("%_Font" :filter font-menu-family-constructor)
+      ("Font Si%_ze" :filter font-menu-size-constructor)
+      ;;      ("Font Weig%_ht" :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)
       "-----"
-      ["%_Edit Init (.emacs) File"
+      ["Edit I%_nit 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"))
+       (progn (find-file (or user-init-file "~/.xemacs/init.el"))
              (or (eq major-mode 'emacs-lisp-mode)
                  (emacs-lisp-mode)))]
-      ["%_Save Options to .emacs File" customize-save-customized]
+      ["%_Save Options to Init File" customize-save-customized]
       )
 
      ("%_Buffers"
@@ -1407,9 +1414,9 @@ which will not be used as accelerators."
       ("XEmacs %_FAQ"
        ["%_FAQ (local)" xemacs-local-faq]
        ["FAQ via %_WWW" xemacs-www-faq
-       :active (boundp 'browse-url-browser-function)]
+       :active (fboundp 'browse-url)]
        ["%_Home Page" xemacs-www-page
-       :active (boundp 'browse-url-browser-function)])
+       :active (fboundp 'browse-url)])
       ("%_Tutorials"
        :filter tutorials-menu-filter)
       ("%_Samples"
@@ -1477,15 +1484,17 @@ Adds `Load .emacs' button to menubar when starting up with -q."
 ;;; The Bookmarks menu
 
 (defun bookmark-menu-filter (&rest ignore)
+  (declare (special bookmark-alist))
   (let ((definedp (and (boundp 'bookmark-alist)
                       bookmark-alist
                       t)))
     `(,(if definedp
           '("%_Jump to Bookmark"
             :filter (lambda (&rest junk)
-                      (mapcar #'(lambda (bmk)
-                                  `[,bmk (bookmark-jump ',bmk)])
-                              (bookmark-all-names))))
+                      (submenu-generate-accelerator-spec
+                       (mapcar #'(lambda (bmk)
+                                   `[,bmk (bookmark-jump ',bmk)])
+                               (bookmark-all-names)))))
         ["%_Jump to Bookmark" nil nil])
       ["Set %_Bookmark" bookmark-set
        :active (fboundp 'bookmark-set)]
@@ -1500,9 +1509,10 @@ Adds `Load .emacs' button to menubar when starting up with -q."
       ,(if definedp
           '("%_Delete Bookmark"
             :filter (lambda (&rest junk)
-                      (mapcar #'(lambda (bmk)
-                                  `[,bmk (bookmark-delete ',bmk)])
-                              (bookmark-all-names))))
+                      (submenu-generate-accelerator-spec
+                       (mapcar #'(lambda (bmk)
+                                   `[,bmk (bookmark-delete ',bmk)])
+                               (bookmark-all-names)))))
         ["%_Delete Bookmark" nil nil])
       ["%_Edit Bookmark List" bookmark-bmenu-list      ,definedp]
       "---"
@@ -1517,7 +1527,7 @@ 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))
+(defvar buffers-menu-omit-chars-list '(?b ?p ?l ?d))
 
 (defcustom buffers-menu-max-size 25
   "*Maximum number of entries which may appear on the \"Buffers\" menu.
@@ -1806,6 +1816,7 @@ 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."
+  (declare (special language-environment-list))
   (let ((n 0))
     (mapcar (lambda (env-sym)
              (setq n (1+ n))
@@ -1847,35 +1858,37 @@ If this is a relative filename, it is put into the same directory as your
 ;;; The Help menu
 
 (defun tutorials-menu-filter (menu-items)
-   (append
+  (declare (special language-info-alist
+                   current-language-environment
+                   tutorial-supported-languages))
+  (append
+   (if (featurep 'mule)
+       (if (assq 'tutorial
+                (assoc current-language-environment language-info-alist))
+          `([,(concat "%_Default (" current-language-environment ")")
+             help-with-tutorial]))
+     '(["%_English" help-with-tutorial]))
+   (submenu-generate-accelerator-spec
     (if (featurep 'mule)
-       (if (assq 'tutorial
-                 (assoc current-language-environment language-info-alist))
-           `([,(concat "%_Default (" current-language-environment ")")
-              help-with-tutorial]))
-      '(["%_English" help-with-tutorial]))
-    (submenu-generate-accelerator-spec
-     (if (featurep 'mule)
-        ;; Mule tutorials.
-        (mapcan #'(lambda (lang)
-                    (let ((tut (assq 'tutorial lang)))
-                      (and tut
-                           (not (string= (car lang) "ASCII"))
-                           ;; skip current language, since we already
-                           ;; included it first
-                           (not (string= (car lang)
-                                         current-language-environment))
-                           `([,(car lang)
-                              (help-with-tutorial nil ,(cdr tut))]))))
-                language-info-alist)
-       ;; Non mule tutorials.
-       (mapcar #'(lambda (lang)
-                  `[,(car lang)
-                    (help-with-tutorial ,(format "TUTORIAL.%s"
-                                                 (cadr lang)))])
-              tutorial-supported-languages)))))
+       ;; Mule tutorials.
+       (mapcan #'(lambda (lang)
+                   (let ((tut (assq 'tutorial lang)))
+                     (and tut
+                          (not (string= (car lang) "ASCII"))
+                          ;; skip current language, since we already
+                          ;; included it first
+                          (not (string= (car lang)
+                                        current-language-environment))
+                          `([,(car lang)
+                             (help-with-tutorial nil ,(cdr tut))]))))
+               language-info-alist)
+      ;; Non mule tutorials.
+      (mapcar #'(lambda (lang)
+                 `[,(car lang)
+                   (help-with-tutorial ,(format "TUTORIAL.%s"
+                                                (cadr lang)))])
+             tutorial-supported-languages)))))
 
-\f
 (set-menubar default-menubar)
 
 \f
@@ -1903,133 +1916,12 @@ If this is a relative filename, it is put into the same directory as your
     ["U%_nsplit Window" delete-other-windows]
     ))
 
-(defvar global-popup-menu nil
-  "The global popup menu.  This is present in all modes.
-See the function `popup-menu' for a description of menu syntax.")
-
-(defvar mode-popup-menu nil
-  "The mode-specific popup menu.  Automatically buffer local.
-This is appended to the default items in `global-popup-menu'.
-See the function `popup-menu' for a description of menu syntax.")
-(make-variable-buffer-local 'mode-popup-menu)
-
 ;; In an effort to avoid massive menu clutter, this mostly worthless menu is
 ;; superseded by any local popup menu...
 (setq-default mode-popup-menu default-popup-menu)
 
-(defvar activate-popup-menu-hook nil
-  "Function or functions run before a mode-specific popup menu is made visible.
-These functions are called with no arguments, and should interrogate and
-modify the value of `global-popup-menu' or `mode-popup-menu' as desired.
-Note: this hook is only run if you use `popup-mode-menu' for activating the
-global and mode-specific commands; if you have your own binding for button3,
-this hook won't be run.")
-
-(defun popup-mode-menu ()
-  "Pop up a menu of global and mode-specific commands.
-The menu is computed by combining `global-popup-menu' and `mode-popup-menu'."
-  (interactive "@_")
-  (run-hooks 'activate-popup-menu-hook)
-  (popup-menu
-   (cond ((and global-popup-menu mode-popup-menu)
-         ;; Merge global-popup-menu and mode-popup-menu
-         (check-menu-syntax mode-popup-menu)
-         (let* ((title (car mode-popup-menu))
-                (items (cdr mode-popup-menu))
-                mode-filters)
-           ;; Strip keywords from local menu for attaching them at the top
-           (while (and items
-                       (keywordp (car items)))
-             ;; Push both keyword and its argument.
-             (push (pop items) mode-filters)
-             (push (pop items) mode-filters))
-           (setq mode-filters (nreverse mode-filters))
-           ;; If mode-filters contains a keyword already present in
-           ;; `global-popup-menu', you will probably lose.
-           (append (list (car global-popup-menu))
-                   mode-filters
-                   (cdr global-popup-menu)
-                   '("---" "---")
-                   (if popup-menu-titles (list title))
-                   (if popup-menu-titles '("---" "---"))
-                   items)))
-        (t
-         (or mode-popup-menu
-             global-popup-menu
-             (error "No menu defined in this buffer"))))))
-
-(defun popup-buffer-menu (event)
-  "Pop up a copy of the Buffers menu (from the menubar) where the mouse is clicked."
-  (interactive "e")
-  (let ((window (and (event-over-text-area-p event) (event-window event)))
-       (bmenu nil))
-    (or window
-       (error "Pointer must be in a normal window"))
-    (select-window window)
-    (if current-menubar
-       (setq bmenu (assoc "%_Buffers" current-menubar)))
-    (if (null bmenu)
-       (setq bmenu (assoc "%_Buffers" default-menubar)))
-    (if (null bmenu)
-       (error "Can't find the Buffers menu"))
-    (popup-menu bmenu)))
-
-(defun popup-menubar-menu (event)
-  "Pop up a copy of menu that also appears in the menubar."
-  (interactive "e")
-  (let ((window (and (event-over-text-area-p event) (event-window event)))
-       popup-menubar)
-    (or window
-       (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
-    ;; 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))
-    ))
-
-(global-set-key 'button3 'popup-mode-menu)
-;; shift button3 and shift button2 are reserved for Hyperbole
-(global-set-key '(meta control button3) 'popup-buffer-menu)
-;; The following command is way too dangerous with Custom.
-;; (global-set-key '(meta shift button3) 'popup-menubar-menu)
-
-;; Here's a test of the cool new menu features (from Stig).
-
-;;(setq mode-popup-menu
-;;      '("Test Popup Menu"
-;;        :filter cdr
-;;        ["this item won't appear because of the menu filter" ding t]
-;;        "--:singleLine"
-;;        "singleLine"
-;;        "--:doubleLine"
-;;        "doubleLine"
-;;        "--:singleDashedLine"
-;;        "singleDashedLine"
-;;        "--:doubleDashedLine"
-;;        "doubleDashedLine"
-;;        "--:noLine"
-;;        "noLine"
-;;        "--:shadowEtchedIn"
-;;        "shadowEtchedIn"
-;;        "--:shadowEtchedOut"
-;;        "shadowEtchedOut"
-;;        "--:shadowDoubleEtchedIn"
-;;        "shadowDoubleEtchedIn"
-;;        "--:shadowDoubleEtchedOut"
-;;        "shadowDoubleEtchedOut"
-;;        "--:shadowEtchedInDash"
-;;        "shadowEtchedInDash"
-;;        "--:shadowEtchedOutDash"
-;;        "shadowEtchedOutDash"
-;;        "--:shadowDoubleEtchedInDash"
-;;        "shadowDoubleEtchedInDash"
-;;        "--:shadowDoubleEtchedOutDash"
-;;        "shadowDoubleEtchedOutDash"
-;;        ))
+\f
+;; misc
 
 (defun xemacs-splash-buffer ()
   "Redisplay XEmacs splash screen in a buffer."
index cdf247b..de084e1 100644 (file)
@@ -461,6 +461,199 @@ menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
   (enable-menu-item-1 path t nil))
 
 \f
+
+;;;;;;; popup menus
+
+(defvar global-popup-menu nil
+  "The global popup menu.  This is present in all modes.
+See the function `popup-menu' for a description of menu syntax.")
+
+(defvar mode-popup-menu nil
+  "The mode-specific popup menu.  Automatically buffer local.
+This is appended to the default items in `global-popup-menu'.
+See the function `popup-menu' for a description of menu syntax.")
+(make-variable-buffer-local 'mode-popup-menu)
+
+(defvar activate-popup-menu-hook nil
+  "Function or functions run before a mode-specific popup menu is made visible.
+These functions are called with no arguments, and should interrogate and
+modify the value of `global-popup-menu' or `mode-popup-menu' as desired.
+Note: this hook is only run if you use `popup-mode-menu' for activating the
+global and mode-specific commands; if you have your own binding for button3,
+this hook won't be run.")
+
+(defvar last-popup-menu-event nil
+  "The mouse event that invoked the last popup menu.
+NOTE: This is EXPERIMENTAL and may change at any time.")
+
+(defun popup-mode-menu (&optional event)
+  "Pop up a menu of global and mode-specific commands.
+The menu is computed by combining `global-popup-menu' and `mode-popup-menu'
+with any items derived from the `context-menu' property of the extent where the
+button was clicked."
+  (interactive "_e")
+  (setq last-popup-menu-event
+       (or (and event (button-event-p event) event)
+           (let* ((mouse-pos (mouse-position))
+                  (win (car mouse-pos))
+                  (x (cadr mouse-pos))
+                  (y (cddr mouse-pos))
+                  (edges (window-pixel-edges win))
+                  (winx (first edges))
+                  (winy (second edges))
+                  (x (+ x winx))
+                  (y (+ y winy)))
+             (make-event 'button-press
+                         `(button 3 x ,x y ,y channel ,(window-frame win)
+                                  timestamp ,(current-event-timestamp
+                                              (cdfw-console win)))))))
+  (run-hooks 'activate-popup-menu-hook)
+  (let* ((context-window (and event (event-window event)))
+        (context-point (and event (event-point event)))
+        (context-extents (and context-window
+                              context-point
+                              (extents-at context-point
+                                          (window-buffer context-window)
+                                          'context-menu)))
+        (context-menu-items
+         (apply 'append (mapcar #'(lambda (extent)
+                                    (extent-property extent 'context-menu))
+                                context-extents))))
+    (popup-menu
+     (cond ((and global-popup-menu mode-popup-menu)
+           ;; Merge global-popup-menu and mode-popup-menu
+           (check-menu-syntax mode-popup-menu)
+           (let* ((title (car mode-popup-menu))
+                  (items (cdr mode-popup-menu))
+                  mode-filters)
+             ;; Strip keywords from local menu for attaching them at the top
+             (while (and items
+                         (keywordp (car items)))
+               ;; Push both keyword and its argument.
+               (push (pop items) mode-filters)
+               (push (pop items) mode-filters))
+             (setq mode-filters (nreverse mode-filters))
+             ;; If mode-filters contains a keyword already present in
+             ;; `global-popup-menu', you will probably lose.
+             (append (list (car global-popup-menu))
+                     mode-filters
+                     (cdr global-popup-menu)
+                     '("---" "---")
+                     (if popup-menu-titles (list title))
+                     (if popup-menu-titles '("---" "---"))
+                     items
+                     context-menu-items)))
+          (t
+           (append
+            (or mode-popup-menu
+                global-popup-menu
+                (error "No menu defined in this buffer"))
+            context-menu-items))))
+
+    (while (popup-up-p)
+      (dispatch-event (next-event)))
+
+    ))
+  
+(defun popup-buffer-menu (event)
+  "Pop up a copy of the Buffers menu (from the menubar) where the mouse is clicked."
+  (interactive "e")
+  (let ((window (and (event-over-text-area-p event) (event-window event)))
+       (bmenu nil))
+    (or window
+       (error "Pointer must be in a normal window"))
+    (select-window window)
+    (if current-menubar
+       (setq bmenu (assoc "%_Buffers" current-menubar)))
+    (if (null bmenu)
+       (setq bmenu (assoc "%_Buffers" default-menubar)))
+    (if (null bmenu)
+       (error "Can't find the Buffers menu"))
+    (popup-menu bmenu)))
+
+(defun popup-menubar-menu (event)
+  "Pop up a copy of menu that also appears in the menubar."
+  (interactive "e")
+  (let ((window (and (event-over-text-area-p event) (event-window event)))
+       popup-menubar)
+    (or window
+       (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
+    ;; 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))
+    ))
+
+(defun menu-call-at-event (form &optional event default-behavior-fallback)
+  "Call FORM while temporarily setting point to the position in EVENT.
+NOTE: This is EXPERIMENTAL and may change at any time.
+
+FORM is called the way forms in menu specs are: i.e. if a symbol, it's called
+with `call-interactively', otherwise with `eval'.  EVENT defaults to
+`last-popup-menu-event', making this function especially useful in popup
+menus.  The buffer and point are set temporarily within a `save-excursion'.
+If EVENT is not a mouse event, or was not over a buffer, nothing
+happens unless DEFAULT-BEHAVIOR-FALLBACK is non-nil, in which case the
+FORM is called normally."
+  (or event (setq event last-popup-menu-event))
+  (let ((buf (event-buffer event))
+       (p (event-closest-point event)))
+    (cond ((and buf p (> p 0))
+          (save-excursion
+            (set-buffer buf)
+            (goto-char p)
+            (if (symbolp form)
+                (call-interactively form)
+              (eval form))))
+         (default-behavior-fallback
+           (if (symbolp form)
+               (call-interactively form)
+             (eval form))))))
+
+(global-set-key 'button3 'popup-mode-menu)
+;; shift button3 and shift button2 are reserved for Hyperbole
+(global-set-key '(meta control button3) 'popup-buffer-menu)
+;; The following command is way too dangerous with Custom.
+;; (global-set-key '(meta shift button3) 'popup-menubar-menu)
+
+;; Here's a test of the cool new menu features (from Stig).
+
+;;(setq mode-popup-menu
+;;      '("Test Popup Menu"
+;;        :filter cdr
+;;        ["this item won't appear because of the menu filter" ding t]
+;;        "--:singleLine"
+;;        "singleLine"
+;;        "--:doubleLine"
+;;        "doubleLine"
+;;        "--:singleDashedLine"
+;;        "singleDashedLine"
+;;        "--:doubleDashedLine"
+;;        "doubleDashedLine"
+;;        "--:noLine"
+;;        "noLine"
+;;        "--:shadowEtchedIn"
+;;        "shadowEtchedIn"
+;;        "--:shadowEtchedOut"
+;;        "shadowEtchedOut"
+;;        "--:shadowDoubleEtchedIn"
+;;        "shadowDoubleEtchedIn"
+;;        "--:shadowDoubleEtchedOut"
+;;        "shadowDoubleEtchedOut"
+;;        "--:shadowEtchedInDash"
+;;        "shadowEtchedInDash"
+;;        "--:shadowEtchedOutDash"
+;;        "shadowEtchedOutDash"
+;;        "--:shadowDoubleEtchedInDash"
+;;        "shadowDoubleEtchedInDash"
+;;        "--:shadowDoubleEtchedOutDash"
+;;        "shadowDoubleEtchedOutDash"
+;;        ))
+
 (defun get-popup-menu-response (menu-desc &optional event)
   "Pop up the given menu and wait for a response.
 This blocks until the response is received, and returns the misc-user
index 6343c2d..34d2ddb 100644 (file)
@@ -52,7 +52,7 @@
 
 (defcustom minibuffer-history-uniquify t
   "*Non-nil means when adding an item to a minibuffer history, remove
-previous occurances of the same item from the history list first,
+previous occurrences of the same item from the history list first,
 rather than just consing the new element onto the front of the list."
   :type 'boolean
   :group 'minibuffer)
@@ -1329,6 +1329,15 @@ If N is negative, find the previous or Nth previous match."
            current-minibuffer-point (point)))
     (let ((narg (- minibuffer-history-position n))
          (minimum (if minibuffer-default -1 0)))
+      ;; a weird special case here; when in repeat-complex-command, we're
+      ;; trying to edit the top command, and minibuffer-history-position
+      ;; points to 1, the next-to-top command.  in this case, the top
+      ;; command in the history is suppressed in favor of the one being
+      ;; edited, and there is no more command below it, except maybe the
+      ;; default.
+      (if (and (zerop narg) (eq minibuffer-history-position
+                               initial-minibuffer-history-position))
+         (setq minimum (1+ minimum)))
       (cond ((< narg minimum)
             (error (if minibuffer-default
                        "No following item in %s"
@@ -1342,7 +1351,7 @@ If N is negative, find the previous or Nth previous match."
          (progn