Mercurial > hg > xemacs-beta
changeset 114:8619ce7e4c50 r20-1b9
Import from CVS: tag r20-1b9
line wrap: on
line diff
--- a/CHANGES-beta Mon Aug 13 09:20:50 2007 +0200 +++ b/CHANGES-beta Mon Aug 13 09:21:54 2007 +0200 @@ -1,4 +1,29 @@ -*- indented-text -*- +to 20.1 beta9 +-- VM-6.21 +-- tm-7.106 +-- Garbage Collection patches courtesy of David Moore +-- time.el update +-- minor build tweaks +-- EFS integration/bug fix patches courtesy of Michael Sperber +-- MULE safe char-before added +-- preceding-char, following-char are obsolete and broken, do not use them +-- user-mail-address now uses the function +-- miscellaneous bug fixes +-- Egg patches courtesy of Jareth Hein +-- corrections to lib-src script setup in --srcdir configuration +-- itimer.el-1.05 +-- hyperbole-4.023 +-- cc-mode.el-4.387 +-- floating-toolbar.el-1.02 +-- balloon-help.el-1.05 +-- W3-3.0.71 +-- VM-6.20 +-- Custom-1.65 +-- Gnus-5.4.33 +-- strip unimplemented subwindows subr code +-- GIF correction courtesy Darrell Kindred + to 20.1 beta8 -- GIF crash fix courtesy of David Moore -- Fix for problem dumping comint with sparcworks
--- a/ChangeLog Mon Aug 13 09:20:50 2007 +0200 +++ b/ChangeLog Mon Aug 13 09:21:54 2007 +0200 @@ -1,3 +1,24 @@ +Fri Mar 21 21:26:01 1997 Steven L Baur <steve@altair.xemacs.org> + + * XEmacs-19.15-b103 is released. + * XEmacs-20.0-b9 is released. + + * Makefile.in (top_distclean): Add `Installation' to distclean + rule. + +Fri Mar 21 20:05:29 1997 Darrell Kindred <dkindred@cmu.edu> + + * Makefile.in (autoloads): Pass $(MAKE) to update-elc.sh and + update-autoloads.sh. + +Thu Mar 20 20:14:16 1997 Steven L Baur <steve@altair.xemacs.org> + + * XEmacs-19.15-b102 is released. + +Tue Mar 18 21:52:36 1997 Steven L Baur <steve@altair.xemacs.org> + + * XEmacs-19.15-b101 is released. + Mon Mar 17 19:09:29 1997 Steven L Baur <steve@altair.xemacs.org> * XEmacs-20.1-b8 is released.
--- a/Makefile.in Mon Aug 13 09:20:50 2007 +0200 +++ b/Makefile.in Mon Aug 13 09:21:54 2007 +0200 @@ -230,7 +230,7 @@ # Build XEmacs and recompile out-of-date and missing .elc files along # the way. all-elc all-elcs: src/paths.h src/Emacs.ad.h lib-src lwlib dump-elcs src - sh ${srcdir}/lib-src/update-elc.sh + MAKE='$(MAKE)' sh ${srcdir}/lib-src/update-elc.sh # Sub-target for all-elc. dump-elc dump-elcs: FRC.dump-elcs @@ -238,7 +238,7 @@ CC='${CC}' CFLAGS='${CFLAGS}' MAKE='${MAKE}' autoloads: src - sh ${srcdir}/lib-src/update-autoloads.sh + MAKE='$(MAKE)' sh ${srcdir}/lib-src/update-autoloads.sh # We force the rebuilding of src/paths.h because the user might give # different values for the various directories. Since we use @@ -502,7 +502,7 @@ ### `make distclean' should leave only the files that were in the ### distribution. top_distclean=\ - rm -f config.status config-tmp-* build-install ; \ + rm -f config.status config-tmp-* build-install Installation ; \ rm -f Makefile ${SUBDIR_MAKEFILES}; \ (cd lock && rm -f *)
--- a/configure Mon Aug 13 09:20:50 2007 +0200 +++ b/configure Mon Aug 13 09:21:54 2007 +0200 @@ -3352,6 +3352,11 @@ with_tooltalk='yes' fi +# having CDE requires Motif +if test "${with_cde}" = "yes" ; then + motif_libs="-lXm -lXt" +fi + # # See if we can find OffiX. # @@ -4461,14 +4466,14 @@ # set defaults for finding WNN includes and libs # if test "${with_wnn}" = "yes" ; then - for arg in "-I${wnn_includes}" "-I/usr/X11R6/include" + for arg in "-I${wnn_includes}" "-I/usr/X11R6/include/wnn" "-I/usr/include/wnn" do if test -f `echo "${arg}/wnnerror.h" | sed 's/^\-I//'` ; then C_SWITCH_SITE="${C_SWITCH_SITE} ${arg}" wnn_includes=${arg} fi done - for arg in "-L${wnn_libraries}" "-I/usr/X11R6/lib" + for arg in "-L${wnn_libraries}" "-L/usr/X11R6/lib" "-L/usr/lib" do if test -f `echo "${arg}/libwnn.a" | sed 's/^\-L//'` ; then LD_SWITCH_SITE="${LD_SWITCH_SITE} ${arg}" @@ -4488,7 +4493,7 @@ canna_includes=${arg} fi done - for arg in "-L${canna_libraries}" "-I/usr/X11R6/lib" + for arg in "-L${canna_libraries}" "-L/usr/X11R6/lib" do if test -f `echo "${arg}/libcanna.a" | sed 's/^\-L//'` ; then LD_SWITCH_SITE="${LD_SWITCH_SITE} ${arg}"
--- a/configure.in Mon Aug 13 09:20:50 2007 +0200 +++ b/configure.in Mon Aug 13 09:21:54 2007 +0200 @@ -2306,6 +2306,11 @@ with_tooltalk='yes' fi +# having CDE requires Motif +if test "${with_cde}" = "yes" ; then + motif_libs="-lXm -lXt" +fi + # # See if we can find OffiX. # @@ -2677,14 +2682,14 @@ # set defaults for finding WNN includes and libs # if test "${with_wnn}" = "yes" ; then - for arg in "-I${wnn_includes}" "-I/usr/X11R6/include" + for arg in "-I${wnn_includes}" "-I/usr/X11R6/include/wnn" "-I/usr/include/wnn" do if test -f `echo "${arg}/wnnerror.h" | sed 's/^\-I//'` ; then C_SWITCH_SITE="${C_SWITCH_SITE} ${arg}" wnn_includes=${arg} fi done - for arg in "-L${wnn_libraries}" "-I/usr/X11R6/lib" + for arg in "-L${wnn_libraries}" "-L/usr/X11R6/lib" "-L/usr/lib" do if test -f `echo "${arg}/libwnn.a" | sed 's/^\-L//'` ; then LD_SWITCH_SITE="${LD_SWITCH_SITE} ${arg}" @@ -2704,7 +2709,7 @@ canna_includes=${arg} fi done - for arg in "-L${canna_libraries}" "-I/usr/X11R6/lib" + for arg in "-L${canna_libraries}" "-L/usr/X11R6/lib" do if test -f `echo "${arg}/libcanna.a" | sed 's/^\-L//'` ; then LD_SWITCH_SITE="${LD_SWITCH_SITE} ${arg}"
--- a/etc/SERVICE Mon Aug 13 09:20:50 2007 +0200 +++ b/etc/SERVICE Mon Aug 13 09:21:54 2007 +0200 @@ -40,6 +40,40 @@ ** Please keep the entries in this file alphabetical ** +Altrasoft <info@altrasoft.com> +4880 Stevens Creek Blvd., Suite 205 +San Jose, CA 95129-1034 ++1 408 243 3300 +http://www.altrasoft.com + +Altrasoft provides corporate-quality support, development and user +documentation for GNU Emacs, XEmacs and InfoDock. (InfoDock is a turnkey +information management and software development toolset built atop emacs, +written by one of our associates.) Emacs distributions for a variety of +platforms are also available, as is support for other emacs variants, such as +those often found on PCs. + +Our unique focus on emacs-related work allows us to attract expert talent in +this area to keep you on the leading edge of productivity, especially if you +do software development work. We do the porting, patching, coding, +integrating, debugging, documenting and testing so that your people spend +much more productive time on their mainline tasks. + +Standard support packages include help on all aspects of the packages +supported, including all tools shipped as a standard part of the original +package distribution. In general, we want to give you an unbelievably strong +level of support, so where we can, we will also answer questions concerning +any add-on Lisp code that is used at your site. Setup and customization +help, bug fixes, and announcements of new releases are, of course, included. + +Support rates start at $1,000 USD, for single user support for one year. +Discounts are available for group contracts. We also offer Golden Support +contracts for those who need the absolute best in mission-critical support; +contact us for details. Hourly development rates and fixed bid work are +available. + +Updated 20-March-1997. + Joseph Arceneaux <jla@ai.mit.edu> PO Box 460633 http://www.samsara.com/~jla San Francisco, CA 94146-0633
--- a/etc/time/0.xpm Mon Aug 13 09:20:50 2007 +0200 +++ b/etc/time/0.xpm Mon Aug 13 09:21:54 2007 +0200 @@ -3,8 +3,8 @@ /* width height ncolors chars_per_pixel */ "9 13 2 1", /* colors */ -"` s None c None", -"a c #CB1E1C", +"` c None s ledbg", +"a c #CA1E1C s ledfg", /* pixels */ "`````````", "````aaaaa",
--- a/etc/time/1.xpm Mon Aug 13 09:20:50 2007 +0200 +++ b/etc/time/1.xpm Mon Aug 13 09:21:54 2007 +0200 @@ -3,8 +3,8 @@ /* width height ncolors chars_per_pixel */ "9 13 2 1", /* colors */ -"` s None c None", -"a c #CA1E1C", +"` s ledbg c None", +"a s ledfg c #CA1E1C", /* pixels */ "`````````", "`````````",
--- a/etc/time/2.xpm Mon Aug 13 09:20:50 2007 +0200 +++ b/etc/time/2.xpm Mon Aug 13 09:21:54 2007 +0200 @@ -3,8 +3,8 @@ /* width height ncolors chars_per_pixel */ "9 13 2 1", /* colors */ -"a c #CB1D1C", -"` s None c None", +"` c None s ledbg", +"a c #CA1E1C s ledfg", /* pixels */ "`````````", "````aaaaa",
--- a/etc/time/3.xpm Mon Aug 13 09:20:50 2007 +0200 +++ b/etc/time/3.xpm Mon Aug 13 09:21:54 2007 +0200 @@ -3,8 +3,8 @@ /* width height ncolors chars_per_pixel */ "9 13 2 1", /* colors */ -"` s None c None", -"a c #CB1D1C", +"` c None s ledbg", +"a c #CA1E1C s ledfg", /* pixels */ "`````````", "````aaaaa",
--- a/etc/time/4.xpm Mon Aug 13 09:20:50 2007 +0200 +++ b/etc/time/4.xpm Mon Aug 13 09:21:54 2007 +0200 @@ -3,8 +3,8 @@ /* width height ncolors chars_per_pixel */ "9 13 2 1", /* colors */ -"` s None c None", -"a c #CA1E1C", +"` c None s ledbg", +"a c #CA1E1C s ledfg", /* pixels */ "`````````", "`````````",
--- a/etc/time/5.xpm Mon Aug 13 09:20:50 2007 +0200 +++ b/etc/time/5.xpm Mon Aug 13 09:21:54 2007 +0200 @@ -3,8 +3,8 @@ /* width height ncolors chars_per_pixel */ "9 13 2 1", /* colors */ -"` s None c None", -"a c #CB1D1C", +"` c None s ledbg", +"a c #CA1E1C s ledfg", /* pixels */ "`````````", "````aaaaa",
--- a/etc/time/6.xpm Mon Aug 13 09:20:50 2007 +0200 +++ b/etc/time/6.xpm Mon Aug 13 09:21:54 2007 +0200 @@ -3,8 +3,8 @@ /* width height ncolors chars_per_pixel */ "9 13 2 1", /* colors */ -"` s None c None", -"a c #CB1E1C", +"` c None s ledbg", +"a c #CA1E1C s ledfg", /* pixels */ "`````````", "````aaaaa",
--- a/etc/time/7.xpm Mon Aug 13 09:20:50 2007 +0200 +++ b/etc/time/7.xpm Mon Aug 13 09:21:54 2007 +0200 @@ -3,8 +3,8 @@ /* width height ncolors chars_per_pixel */ "9 13 2 1", /* colors */ -"` s None c None", -"a c #CB1E1C", +"` c None s ledbg", +"a c #CA1E1C s ledfg", /* pixels */ "`````````", "````aaaaa",
--- a/etc/time/8.xpm Mon Aug 13 09:20:50 2007 +0200 +++ b/etc/time/8.xpm Mon Aug 13 09:21:54 2007 +0200 @@ -3,8 +3,8 @@ /* width height ncolors chars_per_pixel */ "9 13 2 1", /* colors */ -"` s None c None", -"a c #CB1E1C", +"` c None s ledbg", +"a c #CA1E1C s ledfg", /* pixels */ "`````````", "````aaaaa",
--- a/etc/time/9.xpm Mon Aug 13 09:20:50 2007 +0200 +++ b/etc/time/9.xpm Mon Aug 13 09:21:54 2007 +0200 @@ -3,8 +3,8 @@ /* width height ncolors chars_per_pixel */ "9 13 2 1", /* colors */ -"` s None c None", -"a c #CB1E1C", +"` c None s ledbg", +"a c #CA1E1C s ledfg", /* pixels */ "`````````", "````aaaaa",
--- a/etc/time/am.xpm Mon Aug 13 09:20:50 2007 +0200 +++ b/etc/time/am.xpm Mon Aug 13 09:21:54 2007 +0200 @@ -3,8 +3,8 @@ /* width height ncolors chars_per_pixel */ "4 13 2 1", /* colors */ -"` s None c None", -"a c #CA1E1C", +"` c None s ledbg", +"a c #CA1E1C s ledfg", /* pixels */ "````", "``aa",
--- a/etc/time/dp.xpm Mon Aug 13 09:20:50 2007 +0200 +++ b/etc/time/dp.xpm Mon Aug 13 09:21:54 2007 +0200 @@ -3,8 +3,8 @@ /* width height ncolors chars_per_pixel */ "9 13 2 1", /* colors */ -"` s None c None", -"a c #CA1E1C", +"` c None s ledbg", +"a c #CA1E1C s ledfg", /* pixels */ "`````````", "`````````",
--- a/etc/time/l-0.0.xpm Mon Aug 13 09:20:50 2007 +0200 +++ b/etc/time/l-0.0.xpm Mon Aug 13 09:21:54 2007 +0200 @@ -1,21 +1,22 @@ /* XPM */ static char *noname[] = { /* width height ncolors chars_per_pixel */ -"10 13 1 1", +"10 13 2 1", /* colors */ -" s None c None", +"` s None c None", +". s pad-color c #606060", /* pixels */ -" ", -" ", -" ", -" ", -" ", -" ", -" ", -" ", -" ", -" ", -" ", -" ", -" " +"``````....", +"``````....", +"`````.....", +"`````.....", +"````......", +"````......", +"```.......", +"```.......", +"``........", +"``........", +"`.........", +"`.........", +".........." };
--- a/etc/time/l-0.5.xpm Mon Aug 13 09:20:50 2007 +0200 +++ b/etc/time/l-0.5.xpm Mon Aug 13 09:21:54 2007 +0200 @@ -1,22 +1,23 @@ /* XPM */ static char *noname[] = { /* width height ncolors chars_per_pixel */ -"10 13 2 1", +"10 13 3 1", /* colors */ -" s None c None", -"a c #2AD244", +"` s None c None", +"a c #0AB224", +". s pad-color c #606060", /* pixels */ -" ", -" ", -" ", -" ", -" ", -" ", -" ", -" ", -" ", -" ", -" ", -" aaaaaaaaa", -" " +"``````....", +"``````....", +"`````.....", +"`````.....", +"````......", +"````......", +"```.......", +"```.......", +"``........", +"``........", +"`.........", +"`aaaaaaaaa", +".........." };
--- a/etc/time/l-1.0.xpm Mon Aug 13 09:20:50 2007 +0200 +++ b/etc/time/l-1.0.xpm Mon Aug 13 09:21:54 2007 +0200 @@ -1,22 +1,23 @@ /* XPM */ static char *noname[] = { /* width height ncolors chars_per_pixel */ -"10 13 2 1", +"10 13 3 1", /* colors */ -" s None c None", -"a c #2AD244", +"` s None c None", +"a c #0AB224", +". s pad-color c #606060", /* pixels */ -" ", -" ", -" ", -" ", -" ", -" ", -" ", -" ", -" ", -" aaaaaaaa", -" ", -" aaaaaaaaa", -" " +"``````....", +"``````....", +"`````.....", +"`````.....", +"````......", +"````......", +"```.......", +"```.......", +"``........", +"``aaaaaaaa", +"`.........", +"`aaaaaaaaa", +".........." };
--- a/etc/time/l-1.5.xpm Mon Aug 13 09:20:50 2007 +0200 +++ b/etc/time/l-1.5.xpm Mon Aug 13 09:21:54 2007 +0200 @@ -1,23 +1,24 @@ /* XPM */ static char *noname[] = { /* width height ncolors chars_per_pixel */ -"10 13 3 1", +"10 13 4 1", /* colors */ -" s None c None", +"` s None c None", "a c #2AD244", "b c #DEE614", +". s pad-color c #606060", /* pixels */ -" ", -" ", -" ", -" ", -" ", -" ", -" ", -" bbbbbbb", -" ", -" aaaaaaaa", -" ", -" aaaaaaaaa", -" " +"``````....", +"``````....", +"`````.....", +"`````.....", +"````......", +"````......", +"```.......", +"```bbbbbbb", +"``........", +"``aaaaaaaa", +"`.........", +"`aaaaaaaaa", +".........." };
--- a/etc/time/l-2.0.xpm Mon Aug 13 09:20:50 2007 +0200 +++ b/etc/time/l-2.0.xpm Mon Aug 13 09:21:54 2007 +0200 @@ -1,23 +1,24 @@ /* XPM */ static char *noname[] = { /* width height ncolors chars_per_pixel */ -"10 13 3 1", +"10 13 4 1", /* colors */ -" s None c None", -"a c #2AD244", +"` s None c None", +"a c #0AB224", "b c #DEE614", +". s pad-color c #606060", /* pixels */ -" ", -" ", -" ", -" ", -" ", -" bbbbbb", -" ", -" bbbbbbb", -" ", -" aaaaaaaa", -" ", -" aaaaaaaaa", -" " +"``````....", +"``````....", +"`````.....", +"`````.....", +"````......", +"````bbbbbb", +"```.......", +"```bbbbbbb", +"``........", +"``aaaaaaaa", +"`.........", +"`aaaaaaaaa", +".........." };
--- a/etc/time/l-2.5.xpm Mon Aug 13 09:20:50 2007 +0200 +++ b/etc/time/l-2.5.xpm Mon Aug 13 09:21:54 2007 +0200 @@ -1,24 +1,25 @@ /* XPM */ static char *noname[] = { /* width height ncolors chars_per_pixel */ -"10 13 4 1", +"10 13 5 1", /* colors */ -" s None c None", +"a s None c None", "` c #FE0204", -"b c #2AD244", +"b c #0AB224", "c c #DEE614", +". s pad-color c #606060", /* pixels */ -" ", -" ", -" ", -" `````", -" ", -" cccccc", -" ", -" ccccccc", -" ", -" bbbbbbbb", -" ", -" bbbbbbbbb", -" " +"aaaaaa....", +"aaaaaa....", +"aaaaa.....", +"aaaaa`````", +"aaaa......", +"aaaacccccc", +"aaa.......", +"aaaccccccc", +"aa........", +"aabbbbbbbb", +"a.........", +"abbbbbbbbb", +".........." };
--- a/etc/time/l-3.0.xpm Mon Aug 13 09:20:50 2007 +0200 +++ b/etc/time/l-3.0.xpm Mon Aug 13 09:21:54 2007 +0200 @@ -1,24 +1,25 @@ /* XPM */ static char *noname[] = { /* width height ncolors chars_per_pixel */ -"10 13 4 1", +"10 13 5 1", /* colors */ -" s None c None", +"a s None c None", "` c #FE0204", -"b c #2AD244", +"b c #0AB224", "c c #DEE614", +". s pad-color c #606060", /* pixels */ -" ", -" ````", -" ", -" `````", -" ", -" cccccc", -" ", -" ccccccc", -" ", -" bbbbbbbb", -" ", -" bbbbbbbbb", -" " +"aaaaaa....", +"aaaaaa````", +"aaaaa.....", +"aaaaa`````", +"aaaa......", +"aaaacccccc", +"aaa.......", +"aaaccccccc", +"aa........", +"aabbbbbbbb", +"a.........", +"abbbbbbbbb", +".........." };
--- a/etc/time/l-jtl-0.0.xpm Mon Aug 13 09:20:50 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,22 +0,0 @@ -/* XPM */ -static char *noname[] = { -/* width height ncolors chars_per_pixel */ -"10 13 2 1", -/* colors */ -"` s None c None", -". c #606060", -/* pixels */ -"``````````", -"``````....", -"`````.....", -"`````.....", -"````......", -"````......", -"```.......", -"```.......", -"``........", -"``........", -"`.........", -"`.........", -".........." -};
--- a/etc/time/l-jtl-0.5.xpm Mon Aug 13 09:20:50 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,23 +0,0 @@ -/* XPM */ -static char *noname[] = { -/* width height ncolors chars_per_pixel */ -"10 13 3 1", -/* colors */ -"` s None c None", -"a c #0AB224", -". c #606060", -/* pixels */ -"``````````", -"``````....", -"`````.....", -"`````.....", -"````......", -"````......", -"```.......", -"```.......", -"``........", -"``........", -"`.........", -"`aaaaaaaaa", -".........." -};
--- a/etc/time/l-jtl-1.0.xpm Mon Aug 13 09:20:50 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,23 +0,0 @@ -/* XPM */ -static char *noname[] = { -/* width height ncolors chars_per_pixel */ -"10 13 3 1", -/* colors */ -"` s None c None", -"a c #0AB224", -". c #606060", -/* pixels */ -"``````````", -"``````....", -"`````.....", -"`````.....", -"````......", -"````......", -"```.......", -"```.......", -"``........", -"``aaaaaaaa", -"`.........", -"`aaaaaaaaa", -".........." -};
--- a/etc/time/l-jtl-1.5.xpm Mon Aug 13 09:20:50 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,24 +0,0 @@ -/* XPM */ -static char *noname[] = { -/* width height ncolors chars_per_pixel */ -"10 13 4 1", -/* colors */ -"` s None c None", -"a c #2AD244", -"b c #DEE614", -". c #606060", -/* pixels */ -"``````````", -"``````....", -"`````.....", -"`````.....", -"````......", -"````......", -"```.......", -"```bbbbbbb", -"``........", -"``aaaaaaaa", -"`.........", -"`aaaaaaaaa", -".........." -};
--- a/etc/time/l-jtl-2.0.xpm Mon Aug 13 09:20:50 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,24 +0,0 @@ -/* XPM */ -static char *noname[] = { -/* width height ncolors chars_per_pixel */ -"10 13 4 1", -/* colors */ -"` s None c None", -"a c #0AB224", -"b c #DEE614", -". c #606060", -/* pixels */ -"``````````", -"``````....", -"`````.....", -"`````.....", -"````......", -"````bbbbbb", -"```.......", -"```bbbbbbb", -"``........", -"``aaaaaaaa", -"`.........", -"`aaaaaaaaa", -".........." -};
--- a/etc/time/l-jtl-2.5.xpm Mon Aug 13 09:20:50 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,25 +0,0 @@ -/* XPM */ -static char *noname[] = { -/* width height ncolors chars_per_pixel */ -"10 13 5 1", -/* colors */ -"a s None c None", -"` c #FE0204", -"b c #0AB224", -"c c #DEE614", -". c #606060", -/* pixels */ -"aaaaaaaaaa", -"aaaaaa....", -"aaaaa.....", -"aaaaa`````", -"aaaa......", -"aaaacccccc", -"aaa.......", -"aaaccccccc", -"aa........", -"aabbbbbbbb", -"a.........", -"abbbbbbbbb", -".........." -};
--- a/etc/time/l-jtl-3.0.xpm Mon Aug 13 09:20:50 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,25 +0,0 @@ -/* XPM */ -static char *noname[] = { -/* width height ncolors chars_per_pixel */ -"10 13 5 1", -/* colors */ -"a s None c None", -"` c #FE0204", -"b c #0AB224", -"c c #DEE614", -". c #606060", -/* pixels */ -"aaaaaaaaaa", -"aaaaaa````", -"aaaaa.....", -"aaaaa`````", -"aaaa......", -"aaaacccccc", -"aaa.......", -"aaaccccccc", -"aa........", -"aabbbbbbbb", -"a.........", -"abbbbbbbbb", -".........." -};
--- a/etc/time/pm.xpm Mon Aug 13 09:20:50 2007 +0200 +++ b/etc/time/pm.xpm Mon Aug 13 09:21:54 2007 +0200 @@ -3,8 +3,8 @@ /* width height ncolors chars_per_pixel */ "4 13 2 1", /* colors */ -"` s None c None", -"a c #CA1E1C", +"` c None s ledbg", +"a c #CA1E1C s ledfg", /* pixels */ "````", "````",
--- a/etc/vm/gear.xpm Mon Aug 13 09:20:50 2007 +0200 +++ b/etc/vm/gear.xpm Mon Aug 13 09:21:54 2007 +0200 @@ -1,9 +1,10 @@ /* XPM */ static char *gear[] = { /* width height num_colors chars_per_pixel */ -" 24 30 241 2", +" 24 30 242 2", /* colors */ ".. c #aaaaaa s background", +"zz c #aaaaaa", ".# c #8e8e8e", ".a c #4d4d4d", ".b c #9f9f9f", @@ -254,18 +255,18 @@ "......#K#X.H.4...p...3.G.J.I.i.i.i.i.6ab.z.r....", "......#N.m.4.3.3.G.G.J.J.W.z.i.i.i.n.i.i.i.I....", ".....J.6.r.4.3.G.G.J.W.W#K#X.n.6#t.i.i.i.i.n.#..", -"..#K.0.0.0.3.G.J.J.W.W#K.....#.H.#.n.i.i.i.i#t..", -"...G.H.3.3.G.J.J.W.W#K.....r.raB#X.6.i.i.i.aaB..", -"...4.3.G.G.J.J.W#K#K.....r.raB#X#X#i.n.i.n#i....", +"..#K.0.0.0.3.G.J.J.W.W#Kzzzz.#.H.#.n.i.i.i.i#t..", +"...G.H.3.3.G.J.J.W.W#Kzzzz.r.raB#X.6.i.i.i.aaB..", +"...4.3.G.G.J.J.W#K#Kzzzz.r.raB#X#X#i.n.i.n#i....", "..#X.r.G.J.J#K.W#K.raB.r.raB#X.#.#.c.a.n.i.6....", "..aB.p.r.J.W#K#KaB.p.m#NaB#X.#.#.c.l.z.i.i.m....", -"....aBaB.W#K#K..#t.n.i.h.#.#.#.c#iab.i.i.i.i#g.I", -"....#K#K#K.....r.a.z.a.i#X.c.c#i.l.a.i.i.i.i.i.6", -"...W.H.....r.raB.a.I.m.i.l.##i.l.l.I.i.i.i.n.h#t", -"...J.G...r.raB#X#tab#t.i.I...l#N#N#N.a.p.n.h.6#t", +"....aBaB.W#K#Kzz#t.n.i.h.#.#.#.c#iab.i.i.i.i#g.I", +"....#K#K#Kzzzz.r.a.z.a.i#X.c.c#i.l.a.i.i.i.i.i.6", +"...W.Hzzzz.r.raB.a.I.m.i.l.##i.l.l.I.i.i.i.n.h#t", +"...J.Gzz.r.raB#X#tab#t.i.Izz.l#N#N#N.a.p.n.h.6#t", ".....3.r.raB#X#X#N.p.p#g.m#K.l#N#N#t.I.I.h.6ab.l", ".....3aBaB#X#X.#.c.c.i.i#t.r#N#t#t.I.6.6ababab..", -".....3.#.c.#.c.c.c...l.p.J.l#t.I.I.I.6.6.pab....", +".....3.#.c.#.c.c.czz.l.p.J.l#t.I.I.I.6.6.pab....", "....#X.a.p#N.c#i#i#i#K.G.c#t.I.I.6.6abab.n.p....", "..........#t#i#i.l#N#N#t.I.I.I.6.6ab.m.z.i.naB..", "...........J.l#N#N#N#t.I.I.6.6.a.a.h.i.i.i#i....",
--- a/lib-src/ChangeLog Mon Aug 13 09:20:50 2007 +0200 +++ b/lib-src/ChangeLog Mon Aug 13 09:21:54 2007 +0200 @@ -1,3 +1,13 @@ +Wed Mar 19 10:38:04 1997 Steven L Baur <steve@altair.xemacs.org> + + * Makefile.in.in (SCRIPTS): Link gzip-el.sh in --srcdir + configuration. + +Tue Mar 18 17:49:14 1997 Steven L Baur <steve@altair.xemacs.org> + + * update-elc.sh (EMACS): Removed $XEMACS backdoor. We will make + the .elcs *only* with the freshly built XEmacs. + Mon Mar 17 10:12:03 1997 Steven L Baur <steve@altair.xemacs.org> * Makefile.in.in (INSTALLABLE_SCRIPTS): Add install-sid and
--- a/lib-src/Makefile.in.in Mon Aug 13 09:20:50 2007 +0200 +++ b/lib-src/Makefile.in.in Mon Aug 13 09:21:54 2007 +0200 @@ -115,7 +115,7 @@ /* Like UTILITIES, but they are not system-dependent, and should not be deleted by the distclean target. */ TM_SCRIPTS=tm-au tm-file tm-html tm-image tm-mpeg tm-plain tm-ps tmdecode -SCRIPTS= rcs2log vcdiff install-sid send-pr $(TM_SCRIPTS) +SCRIPTS= rcs2log vcdiff gzip-el.sh install-sid send-pr $(TM_SCRIPTS) EXECUTABLES= ${UTILITIES} ${INSTALLABLES} ${SCRIPTS} ${INSTALLABLE_SCRIPTS} @@ -274,7 +274,12 @@ ${LN_S} ${srcdir}/$@ $@ tmdecode : ${LN_S} ${srcdir}/$@ $@ - +gzip-el.sh: + ${LN_S} ${srcdir}/$@ $@ +install-sid: + ${LN_S} ${srcdir}/$@ $@ +send-pr: + ${LN_S} ${srcdir}/$@ $@ #ifdef MOVEMAIL_NEEDS_BLESSING blessmail:
--- a/lib-src/emacsserver.c Mon Aug 13 09:20:50 2007 +0200 +++ b/lib-src/emacsserver.c Mon Aug 13 09:21:54 2007 +0200 @@ -61,13 +61,18 @@ #include <sys/types.h> #include <sys/file.h> -#include <sys/socket.h> #include <sys/signal.h> #include <sys/stat.h> /* Needed for chmod, at least on Linux */ #include <sys/un.h> #include <stdio.h> #include <errno.h> #include "../src/sysproc.h" /* Needed for select */ +#ifndef SOCK_STREAM +/* this is normally included by src/sysproc.h. might be safe to omit + * it entirely. lousy ultrix's sys/socket.h chokes if it's included + * twice, so we can't include unconditionally. */ +#include <sys/socket.h> +#endif void main ()
--- a/lib-src/update-elc.sh Mon Aug 13 09:20:50 2007 +0200 +++ b/lib-src/update-elc.sh Mon Aug 13 09:21:54 2007 +0200 @@ -25,37 +25,33 @@ exit 1 fi -# Determine xemacs executable to use for compilation. -if test -n "$XEMACS" ; then - EMACS="$XEMACS" -elif test -x ./src/xemacs ; then - EMACS="./src/xemacs" -elif test -x "$EMACS" ; then - : -else - EMACS=xemacs -fi -case "$EMACS" in - */* ) : ;; # Pathname specified - *) # Need to find executable on PATH - for dir in `echo $PATH | sed 's/:/ /g'` ; do - if test -x "dir/xemacs" ; then - EMACS="$dir/$EMACS" - break - fi - done ;; -esac -# Canonicalize -EMACS=`cd \`dirname $EMACS\` ; pwd | sed 's:^/tmp_mnt::'`/`basename $EMACS` +EMACS="./src/xemacs" export EMACS -echo "Recompiling in `pwd|sed 's:^/tmp_mnt::'`" -echo " with $EMACS..." +echo " (using $EMACS)" + +# fuckin' sysv, man... +if [ "`uname -r | sed 's/\(.\).*/\1/'`" -gt 4 ]; then + echon() + { + /bin/echo $* '\c' + } +else + echon() + { + echo -n $* + } +fi + +REAL=`cd \`dirname $EMACS\` ; pwd | sed 's|^/tmp_mnt||'`/`basename $EMACS` +BYTECOMP="$REAL -batch -q -no-site-file " +echo "Recompiling in `pwd|sed 's|^/tmp_mnt||'`" +echo " with $REAL..." + +$EMACS -batch -q -l `pwd`/lisp/prim/cleantree -f batch-remove-old-elc lisp prune_vc="( -name SCCS -o -name RCS -o -name CVS ) -prune -o" -$EMACS -batch -q -l `pwd`/lisp/prim/cleantree -f batch-remove-old-elc lisp - # $els is a list of all .el files # $elcs is a list of all .elc files els=/tmp/update-elc-1.$$ elcs=/tmp/update-elc-2.$$ @@ -65,26 +61,26 @@ find lisp/. $prune_vc -name '*.elc' -print | sed 's/elc$/el/' | sort > $elcs -echo "Deleting .elc files without .el files..." +echon "Deleting .elc files without .el files..." comm -13 $els $elcs | sed -e '\!/vm.el!d' -e 's/el$/elc/' | \ while read file ; do echo rm "$file" ; rm "$file" ; done -echo "Deleting .elc files without .el files... Done" +echo done. # Compute patterns to ignore when searching for files -ignore_dirs="its quail" # ### Not ported yet... +ignore_dirs="quail" # ### Not ported yet... # Only use Mule XEmacs to compile Mule-specific elisp dirs -echo "Checking for Mule support..." +echon "Checking for Mule support..." lisp_prog='(princ (featurep (quote mule)))' mule_p="`$EMACS -batch -no-site-file -eval \"$lisp_prog\"`" if test "$mule_p" = nil ; then echo No - ignore_dirs="$ignore_dirs mule" + ignore_dirs="$ignore_dirs its egg mule" elif test "$mule_p" = t; then echo Yes else - echo "Error determining presence of mule support" + echo "Error -- call Martin" exit 1; fi @@ -92,14 +88,13 @@ # with the latest version (assuming we're compiling the lisp dir of the emacs # we're running, which might not be the case, but often is.) echo "Checking the byte compiler..." -BYTECOMP="$EMACS -batch -q -no-site-file -l bytecomp" $BYTECOMP -f batch-byte-recompile-directory lisp/bytecomp # Byte-compile VM first, because other packages depend on it, # but it depends on nothing (Kyle is like that). ignore_dirs="$ignore_dirs vm" echo "Compiling in lisp/vm"; -(cd lisp/vm && ${MAKE:-make} EMACS=$EMACS autoload) +(cd lisp/vm && ${MAKE:-make} EMACS=$REAL autoload) echo "lisp/vm done." # Prepare for byte-compiling directories with directory-specific instructions @@ -109,7 +104,7 @@ ignore_dirs="$ignore_dirs $dir" make_special_commands="$make_special_commands \ echo \"Compiling in lisp/$dir\"; \ -(cd \"lisp/$dir\" && ${MAKE:-make} EMACS=$EMACS ${1+$*}); \ +(cd \"lisp/$dir\" && ${MAKE:-make} EMACS=$REAL ${1+$*}); \ echo \"lisp/$dir done.\";" } @@ -118,7 +113,7 @@ #make_special viper elc make_special efs make_special gnus some -make_special w3 +make_special w3 xemacs-w3 make_special hyperbole elc make_special oobr HYPB_ELC='' elc make_special eos -k # not stricly necessary...
--- a/lisp/ChangeLog Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/ChangeLog Mon Aug 13 09:21:54 2007 +0200 @@ -1,3 +1,51 @@ +Fri Mar 21 19:16:46 1997 Steven L Baur <steve@altair.xemacs.org> + + * mule/mule-coding.el (enable-multibyte-characters): MULE + compatabile variable. + +Thu Mar 20 13:28:17 1997 Steven L Baur <steve@altair.xemacs.org> + + * bytecomp/bytecomp.el (byte-compile-output-docform): Ebola fix. + (byte-compile-lambda): Ebola fix. + + * prim/obsolete.el (following-char): Make this turkey obsolete. + (preceding-char): Ditto. (Suggested by Richard Mlynarik). + +Wed Mar 19 10:12:09 1997 Steven L Baur <steve@altair.xemacs.org> + + * modes/sendmail.el (sendmail-send-it): Use function for + user-mail-address. + (user-mail-address): Autoload. + + * pcl-cvs/pcl-cvs.el (cvs-changelog-ours-p): Use function for + user-mail-address. + + * prim/startup.el (load-init-file): Only set user-mail-address if + non-interactive. + + * utils/smtpmail.el (smtpmail-send-it): Use function for + user-mail-address. + (smtpmail-via-smtp): Ditto. + + * packages/add-log.el (add-log-mailing-address): Use new function + to obtaion email address. + (add-change-log-entry): Ditto. + + * prim/device.el (device-pixel-depth): New alias for + `device-bitplanes'. + + * comint/comint-xemacs.el (comint): Fix typo in defgroup. + +Tue Mar 18 11:16:28 1997 Steven L Baur <steve@altair.xemacs.org> + + * prim/loadup.el: ls-lisp doesn't exist now. + + * comint/comint-xemacs.el (comint): Touch up fixes from Per + Abrahamsen. + + * prim/glyphs.el (subwindow-image-instance-p): Change doc string + to reflect unimplemented status. + Mon Mar 17 15:34:06 1997 Steven L Baur <steve@altair.xemacs.org> * comint/comint.el (comint-input-setup): Require comint-xemacs.
--- a/lisp/bytecomp/byte-optimize.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/bytecomp/byte-optimize.el Mon Aug 13 09:21:54 2007 +0200 @@ -1173,7 +1173,11 @@ (setq op (logand op 248)) (cond ((eq tem 6) (setq ptr (1+ ptr)) ;offset in next byte - (aref bytes ptr)) + ;; char-to-int to avoid downstream problems + ;; caused by chars appearing where ints are + ;; expected. In bytecode the bytes in the + ;; opcode string are always interpreted as ints. + (char-to-int (aref bytes ptr))) ((eq tem 7) (setq ptr (1+ ptr)) ;offset in next 2 bytes (+ (aref bytes ptr) @@ -1197,7 +1201,11 @@ ((and (>= op byte-rel-goto) (<= op byte-insertN)) (setq ptr (1+ ptr)) ;offset in next byte - (aref bytes ptr)))) + ;; Use char-to-int to avoid downstream problems caused by + ;; chars appearing where ints are expected. In bytecode + ;; the bytes in the opcode string are always interpreted as + ;; ints. + (char-to-int (aref bytes ptr))))) ;;; This de-compiler is used for inline expansion of compiled functions,
--- a/lisp/bytecomp/bytecomp.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/bytecomp/bytecomp.el Mon Aug 13 09:21:54 2007 +0200 @@ -1812,7 +1812,7 @@ ;; negate POSITION. (if (and (stringp (nth (nth 1 info) form)) (> (length (nth (nth 1 info) form)) 0) - (eq (aref (nth (nth 1 info) form) 0) ?*)) + (char= (aref (nth (nth 1 info) form) 0) ?*)) (setq position (- position))))) (if preface @@ -2336,7 +2336,7 @@ (prin1-to-string (car rest)))) ((memq (car rest) '(t nil)) (byte-compile-warn "constant in arglist: %s" (car rest))) - ((and (= ?\& (aref (symbol-name (car rest)) 0)) + ((and (char= ?\& (aref (symbol-name (car rest)) 0)) (not (memq (car rest) '(&optional &rest)))) (byte-compile-warn "unrecognised `&' keyword in arglist: %s" (car rest))))
--- a/lisp/bytecomp/disass.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/bytecomp/disass.el Mon Aug 13 09:21:54 2007 +0200 @@ -266,3 +266,7 @@ ) (insert "\n"))))) nil) + +(provide 'disass) + +;;; disass.el ends here
--- a/lisp/comint/comint-xemacs.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/comint/comint-xemacs.el Mon Aug 13 09:21:54 2007 +0200 @@ -31,20 +31,20 @@ ;;; Code: +(defgroup comint nil + "General command interpreter in a window stuff." + :group 'processes) + (defface comint-input-face '((((class color) (background dark)) (:foreground "red")) (((class color) (background light)) (:foreground "blue")) - (((class mono)) - (:bold t)) - (((class grayscale)) - (:bold t)) (t (:bold t))) "How to display user input for comint shells." - :group 'comint-input-face) + :group 'comint)
--- a/lisp/custom/ChangeLog Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/custom/ChangeLog Mon Aug 13 09:21:54 2007 +0200 @@ -1,5 +1,17 @@ +Tue Mar 18 14:42:31 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * Version 1.65 released. + +Tue Mar 18 11:03:02 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * cus-face.el (custom-face-attributes): Removed `:invert'. + (custom-invert-face): Removed. + Mon Mar 17 11:32:51 1997 Per Abrahamsen <abraham@dina.kvl.dk> + * wid-edit.el (widget-file-action): Spelling correction by Greg + Stark <gsstark@mit.edu>. + * Version 1.64 released. Mon Mar 17 10:43:10 1997 Per Abrahamsen <abraham@dina.kvl.dk> @@ -7,7 +19,7 @@ * cus-edit.el (custom-group-menu-create): Split definition into XEmacs and Emacs. XEmacs uses :filter. Emacs limits `custom-menu-nesting'. - (custom-menu-create): Do noy limit `custom-menu-nesting' here. + (custom-menu-create): Do not limit `custom-menu-nesting' here. (custom-menu-update): Removed XEmacs support. * custom.el (custom-help-menu): Use `custom-menu-create' in XEmacs
--- a/lisp/custom/cus-edit.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/custom/cus-edit.el Mon Aug 13 09:21:54 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.64 +;; Version: 1.65 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -1808,8 +1808,8 @@ (defun custom-group-menu-create (widget symbol) "Ignoring WIDGET, create a menu entry for customization group SYMBOL." `( ,(custom-unlispify-menu-entry symbol t) - :filter (lambda (&rest junk) - (cdr (custom-menu-create ',symbol))))) + :filter (lambda (&rest junk) + (cdr (custom-menu-create ',symbol))))) ;; But emacs can't. (defun custom-group-menu-create (widget symbol) "Ignoring WIDGET, create a menu entry for customization group SYMBOL."
--- a/lisp/custom/cus-face.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/custom/cus-face.el Mon Aug 13 09:21:54 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.64 +;; Version: 1.65 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -111,33 +111,33 @@ ;; Too hard to do right on XEmacs. (defalias 'initialize-face-resources 'ignore))) -(if (string-match "XEmacs" emacs-version) - ;; Xemacs. - (defun custom-invert-face (face &optional frame) - "Swap the foreground and background colors of face FACE. -If the colors are not specified in the face, use the default colors." - (interactive (list (read-face-name "Reverse face: "))) - (let ((fg (color-name (face-foreground face frame) frame)) - (bg (color-name (face-background face frame) frame))) - (set-face-foreground face bg frame) - (set-face-background face fg frame))) - ;; Emacs. - (defun custom-invert-face (face &optional frame) - "Swap the foreground and background colors of face FACE. -If the colors are not specified in the face, use the default colors." - (interactive (list (read-face-name "Reverse face: "))) - (let ((fg (or (face-foreground face frame) - (face-foreground 'default frame) - (frame-property (or frame (selected-frame)) - 'foreground-color) - "black")) - (bg (or (face-background face frame) - (face-background 'default frame) - (frame-property (or frame (selected-frame)) - 'background-color) - "white"))) - (set-face-foreground face bg frame) - (set-face-background face fg frame)))) +;;(if (string-match "XEmacs" emacs-version) +;; ;; Xemacs. +;; (defun custom-invert-face (face &optional frame) +;; "Swap the foreground and background colors of face FACE. +;;If the colors are not specified in the face, use the default colors." +;; (interactive (list (read-face-name "Reverse face: "))) +;; (let ((fg (color-name (face-foreground face frame) frame)) +;; (bg (color-name (face-background face frame) frame))) +;; (set-face-foreground face bg frame) +;; (set-face-background face fg frame))) +;; ;; Emacs. +;; (defun custom-invert-face (face &optional frame) +;; "Swap the foreground and background colors of face FACE. +;;If the colors are not specified in the face, use the default colors." +;; (interactive (list (read-face-name "Reverse face: "))) +;; (let ((fg (or (face-foreground face frame) +;; (face-foreground 'default frame) +;; (frame-property (or frame (selected-frame)) +;; 'foreground-color) +;; "black")) +;; (bg (or (face-background face frame) +;; (face-background 'default frame) +;; (frame-property (or frame (selected-frame)) +;; 'background-color) +;; "white"))) +;; (set-face-foreground face bg frame) +;; (set-face-background face fg frame)))) (defcustom custom-background-mode nil "The brightness of the background. @@ -249,14 +249,14 @@ :value "white" :help-echo "Set background color.") set-face-background) - (:invert (const :format "Invert Face\n" - :sibling-args (:help-echo "\ -Reverse the foreground and background color. -If you haven't specified them for the face, the default colors will be used.") - t) - (lambda (face value &optional frame) - ;; We don't use VALUE. - (custom-invert-face face frame))) + ;; (:invert (const :format "Invert Face\n" + ;; :sibling-args (:help-echo " + ;;Reverse the foreground and background color. + ;;If you haven't specified them for the face, the default colors will be used.") + ;; t) + ;; (lambda (face value &optional frame) + ;; ;; We don't use VALUE. + ;; (custom-invert-face face frame))) (:stipple (editable-field :format "Stipple: %v" :help-echo "Name of background bitmap file.") set-face-stipple))
--- a/lisp/custom/custom.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/custom/custom.el Mon Aug 13 09:21:54 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.64 +;; Version: 1.65 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary:
--- a/lisp/custom/wid-browse.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/custom/wid-browse.el Mon Aug 13 09:21:54 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: extensions -;; Version: 1.64 +;; Version: 1.65 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary:
--- a/lisp/custom/wid-edit.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/custom/wid-edit.el Mon Aug 13 09:21:54 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: extensions -;; Version: 1.64 +;; Version: 1.65 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -2158,7 +2158,7 @@ (file (file-name-nondirectory value)) (menu-tag (widget-apply widget :menu-tag-get)) (must-match (widget-get widget :must-match)) - (answer (read-file-name (concat menu-tag ": (defalt `" value "') ") + (answer (read-file-name (concat menu-tag ": (default `" value "') ") dir nil must-match file))) (widget-value-set widget (abbreviate-file-name answer)) (widget-apply widget :notify widget event)
--- a/lisp/custom/widget-example.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/custom/widget-example.el Mon Aug 13 09:21:54 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.64 +;; Version: 1.65 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ (require 'widget)
--- a/lisp/custom/widget.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/custom/widget.el Mon Aug 13 09:21:54 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.64 +;; Version: 1.65 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary:
--- a/lisp/efs/Makefile Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/Makefile Mon Aug 13 09:21:54 2007 +0200 @@ -2,7 +2,7 @@ # # File: Makefile # Release: $efs release: 1.15 $ -# Version: $Revision: 1.3 $ +# Version: $Revision: 1.4 $ # RCS: # Description: Makefile for byte-compiling efs and dired. # Author: Andy Norman, HPLabs, Bristol, UK. @@ -84,10 +84,18 @@ COREOBJS = efs-defun.elc efs-ovwrt.elc efs-fnh.elc efs-cu.elc efs-netrc.elc \ efs.elc efs-dired.elc efs-report.elc \ efs-cp-p.elc +CORESRC = efs-defun.el efs-ovwrt.el efs-fnh.el efs-cu.el efs-netrc.el \ + efs.el efs-dired.el efs-report.el \ + efs-cp-p.el \ + efs-dump.el DOBJS = default-dir.elc dired.elc dired-mob.elc dired-oas.elc \ dired-rgxp.elc dired-shell.elc dired-vir.elc dired-xy.elc \ dired-grep.elc dired-uu.elc \ dired-cmpr.elc dired-diff.elc dired-help.elc dired-sex.elc +DSRC = default-dir.el dired.el dired-mob.el dired-oas.el \ + dired-rgxp.el dired-shell.el dired-vir.el dired-xy.el \ + dired-grep.el dired-uu.el \ + dired-cmpr.el dired-diff.el dired-help.el dired-sex.el EFSOBJS = $(COREOBJS) efs-auto.elc \ efs-cms.elc efs-cms-knet.elc efs-dos-distinct.elc efs-nos-ve.elc \ efs-gwp.elc efs-kerberos.elc efs-hell.elc efs-ka9q.elc \ @@ -95,10 +103,22 @@ efs-pc.elc efs-ti-explorer.elc efs-ti-twenex.elc \ efs-tops-20.elc efs-dl.elc efs-guardian.elc efs-coke.elc \ efs-vms.elc efs-vos.elc efs-plan9.elc efs-ms-unix.elc +EFSSRC = $(CORESRC) efs-auto.el \ + efs-cms.el efs-cms-knet.el efs-dos-distinct.el efs-nos-ve.el \ + efs-gwp.el efs-kerberos.el efs-hell.el efs-ka9q.el \ + efs-mpe.el efs-mts.el efs-mvs.el efs-netware.el \ + efs-pc.el efs-ti-explorer.el efs-ti-twenex.el \ + efs-tops-20.el efs-dl.el efs-guardian.el efs-coke.el \ + efs-vms.el efs-vos.el efs-plan9.el efs-ms-unix.el VMOBJS = efs-vm.elc +VMSRC = efs-vm.el +DUMPSRC = efs-dump.el GEOBJS = dired-fsf.elc dired-mule.elc efs-dired-mule.elc \ passwd.elc diff.elc auto-save.elc +GESRC = dired-fsf.el dired-mule.el efs-dired-mule.el \ + passwd.el diff.el auto-save.el XEOBJS = dired-faces.elc dired-xemacs.elc +XESRC = dired-faces.el dired-xemacs.el OBJS = $(DOBJS) $(EFSOBJS) $(VMOBJS) $(GEOBJS) $(XEOBJS) \ efs-18.elc efs-19.elc efs-19.23.elc \ efs-l19.11.elc efs-x19.15.elc \ @@ -195,6 +215,8 @@ # backward compatibility files fn-handler.elc: fn-handler.el emacs-19.elc: emacs-19.el +# auto-save package +auto-save.elc: auto-save.el # Core targets core: $(COREOBJS) @@ -229,6 +251,7 @@ efs: $(EFSOBJS) dired: $(DOBJS) all: $(OBJS) +info: efs.info # Making for a specific emacs version 18: emacs-19.elc fn-handler.elc efs dired efs-18.elc dired-mule.elc \ @@ -247,6 +270,21 @@ @echo "Installing in $(LISPDIR)..." @ls -C `ls *.el 2>&1 | grep -v "fixup"` 2> /dev/null cp `ls *.el | grep -v "fixup"` $(LISPDIR) +install_xemacs: + @echo "Installing source in $(LISPDIR)..." + cp $(EFSSRC) $(DSRC) $(XESRC) efs-x19.15.el $(LISPDIR) + cp $(DUMPSRC) $(LISPDIR) + cp Makefile README fixup.el $(LISPDIR) +diff_xemacs: + for f in $(EFSSRC) $(DSRC) $(XESRC) efs-x19.15.el \ + $(DUMPSRC) Makefile README fixup.el; do \ + if [ -e $(LISPDIR)/$$f ]; \ + then\ + diff -c $(LISPDIR)/$$f $$f; \ + else \ + diff -c /dev/null $$f; \ + fi \ + done install_all: install_src install clean: rm -f $(OBJS)
--- a/lisp/efs/default-dir.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/default-dir.el Mon Aug 13 09:21:54 2007 +0200 @@ -3,7 +3,7 @@ ;; ;; File: default-dir.el ;; RCS: -;; Version: $Revision: 1.3 $ +;; Version: $Revision: 1.4 $ ;; Description: Defines the function default-directory, for fancy handling ;; of the initial contents in the minibuffer when reading ;; file names. @@ -58,86 +58,156 @@ ;;; Overloads -(if (or (featurep 'mule) - (boundp 'MULE)) - (progn +(cond + ((or (featurep 'mule) + (boundp 'MULE)) - (defun default-dir-find-file (file &optional coding-system) - "Documented as original" - (interactive - (list - (expand-file-name - (read-file-name "Find file: " (default-directory))) - (and current-prefix-arg - (read-coding-system "Coding-system: ")))) - (default-dir-real-find-file file coding-system)) + (defun default-dir-find-file (file &optional coding-system) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Find file: " (default-directory))) + (and current-prefix-arg + (read-coding-system "Coding-system: ")))) + (default-dir-real-find-file file coding-system)) + + (defun default-dir-find-file-other-window (file &optional coding-system) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Find file in other window: " (default-directory))) + (and current-prefix-arg + (read-coding-system "Coding-system: ")))) + (default-dir-real-find-file-other-window file coding-system)) - (defun default-dir-find-file-other-window (file &optional coding-system) - "Documented as original" - (interactive - (list - (expand-file-name - (read-file-name "Find file in other window: " (default-directory))) - (and current-prefix-arg - (read-coding-system "Coding-system: ")))) - (default-dir-real-find-file-other-window file coding-system)) + (defun default-dir-find-file-read-only (file &optional coding-system) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Find file read-only: " (default-directory) nil t)) + (and current-prefix-arg + (read-coding-system "Coding-system: ")))) + (default-dir-real-find-file-read-only file coding-system)) - (defun default-dir-find-file-read-only (file &optional coding-system) - "Documented as original" - (interactive - (list - (expand-file-name - (read-file-name "Find file read-only: " (default-directory) nil t)) - (and current-prefix-arg - (read-coding-system "Coding-system: ")))) - (default-dir-real-find-file-read-only file coding-system)) + (if (fboundp 'find-file-read-only-other-window) + (progn + (defun default-dir-find-file-read-only-other-window + (file &optional coding-system) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name + "Find file read-only in other window: " + (default-directory) nil t)) + (and current-prefix-arg + (read-coding-system "Coding-system: ")))) + (default-dir-real-find-file-read-only-other-window file + coding-system)))) + + (if (fboundp 'find-file-other-frame) + (progn + (defun default-dir-find-file-other-frame + (file &optional coding-system) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Find file in other frame: " + (default-directory))) + (and current-prefix-arg + (read-coding-system "Coding-system: ")))) + (default-dir-real-find-file-other-frame file + coding-system)))) - (if (fboundp 'find-file-read-only-other-window) - (progn - (defun default-dir-find-file-read-only-other-window - (file &optional coding-system) - "Documented as original" - (interactive - (list - (expand-file-name - (read-file-name - "Find file read-only in other window: " - (default-directory) nil t)) - (and current-prefix-arg - (read-coding-system "Coding-system: ")))) - (default-dir-real-find-file-read-only-other-window file - coding-system)))) + (if (fboundp 'find-file-read-only-other-frame) + (progn + (defun default-dir-find-file-read-only-other-frame + (file &optional coding-system) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Find file read-only in other frame: " + (default-directory) nil t)) + (and current-prefix-arg + (read-coding-system "Coding-system: ")))) + (default-dir-real-find-file-read-only-other-frame file + coding-system))))) + + (default-dir-find-file-takes-coding-system + ;; This lossage is due to the fact that XEmacs 20.x without mule + ;; still accepts an optional argument for find-file related + ;; functions. Things like advice.el insist on passing nil for + ;; optional arguments, and the interaction screws things up. + ;; Therefore these functions accept an optional dummy coding-system + ;; argument. + + (defun default-dir-find-file (file &optional coding-system) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Find file: " (default-directory))))) + (default-dir-real-find-file file coding-system)) + + (defun default-dir-find-file-other-window (file &optional coding-system) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Find file in other window: " (default-directory))))) + (default-dir-real-find-file-other-window file coding-system)) - (if (fboundp 'find-file-other-frame) - (progn - (defun default-dir-find-file-other-frame - (file &optional coding-system) - "Documented as original" - (interactive - (list - (expand-file-name - (read-file-name "Find file in other frame: " - (default-directory))) - (and current-prefix-arg - (read-coding-system "Coding-system: ")))) - (default-dir-real-find-file-other-frame file - coding-system)))) + (defun default-dir-find-file-read-only (file &optional coding-system) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Find file read-only: " (default-directory) nil t)))) + (default-dir-real-find-file-read-only file coding-system)) - (if (fboundp 'find-file-read-only-other-frame) - (progn - (defun default-dir-find-file-read-only-other-frame - (file &optional coding-system) - "Documented as original" - (interactive - (list - (expand-file-name - (read-file-name "Find file read-only in other frame: " - (default-directory) nil t)) - (and current-prefix-arg - (read-coding-system "Coding-system: ")))) - (default-dir-real-find-file-read-only-other-frame file - coding-system))))) + (if (fboundp 'find-file-read-only-other-window) + (progn + (defun default-dir-find-file-read-only-other-window + (file &optional coding-system) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name + "Find file read-only in other window: " + (default-directory) nil t)))) + (default-dir-real-find-file-read-only-other-window file)))) + (if (fboundp 'find-file-other-frame) + (progn + (defun default-dir-find-file-other-frame + (file &optional coding-system) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Find file in other frame: " + (default-directory))))) + (default-dir-real-find-file-other-frame file)))) + + (if (fboundp 'find-file-read-only-other-frame) + (progn + (defun default-dir-find-file-read-only-other-frame + (file &optional coding-system) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Find file read-only in other frame: " + (default-directory) nil t)))) + (default-dir-real-find-file-read-only-other-frame file))))) + + (t (defun default-dir-find-file (file) "Documented as original" (interactive @@ -194,7 +264,9 @@ (expand-file-name (read-file-name "Find file read-only in other frame: " (default-directory) nil t)))) - (default-dir-real-find-file-read-only-other-frame file))))) + (default-dir-real-find-file-read-only-other-frame file)))))) + + (efs-overwrite-fn "default-dir" 'find-file 'default-dir-find-file) (efs-overwrite-fn "default-dir" 'find-file-other-window @@ -282,23 +354,15 @@ (efs-overwrite-fn "default-dir" 'shell-command 'default-dir-shell-command) -;; Is advice about? -(if (featurep 'advice) - (defadvice cd (before default-dir-cd activate compile) - (interactive - (list - (expand-file-name - (read-file-name "Change default directory: " (default-directory)))))) +(defun default-dir-cd (dir) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Change default directory: " (default-directory))))) + (default-dir-real-cd dir)) - (defun default-dir-cd (dir) - "Documented as original" - (interactive - (list - (expand-file-name - (read-file-name "Change default directory: " (default-directory))))) - (default-dir-real-cd dir)) - - (efs-overwrite-fn "default-dir" 'cd 'default-dir-cd)) +(efs-overwrite-fn "default-dir" 'cd 'default-dir-cd) (defun default-dir-set-visited-file-name (filename) "Documented as original"
--- a/lisp/efs/dired-faces.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/dired-faces.el Mon Aug 13 09:21:54 2007 +0200 @@ -1,7 +1,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; File: dired-faces.el -;; Dired Version: $Revision: 1.1 $ +;; Dired Version: $Revision: 1.2 $ ;; RCS: ;; Description: rudimentary face customization support for dired ;; Author: Mike Sperber <sperber@informatik.uni-tuebingen.de> @@ -68,12 +68,6 @@ "Face used for interactive permissions." :group 'dired) -(defface dired-face-deleted '((((class color)) - (:foreground "yellow3")) - (t (:reverse t))) - "Face used to indicate deleted files." - :group 'dired) - (defface dired-face-socket '((((class color)) (:foreground "magenta")) (t (:bold nil)))
--- a/lisp/efs/dired-shell.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/dired-shell.el Mon Aug 13 09:21:54 2007 +0200 @@ -1,7 +1,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; File: dired-shell.el -;; Dired Version: $Revision: 1.1 $ +;; Dired Version: $Revision: 1.2 $ ;; RCS: ;; Description: Commands for running shell commands on marked files. ;; @@ -15,21 +15,28 @@ ;;; Variables (defvar dired-postscript-print-command - (concat - (if (boundp 'lpr-command) - lpr-command - (if (memq system-type - '(usg-unix-v hpux silicon-graphics-unix)) - "lp" - "lpr")) - (if (and (boundp 'lpr-switches) lpr-switches) - (concat " " - (mapconcat 'identity lpr-switches " ") - " ") - " ")) - "Command to print a postscript file.") + (condition-case nil + (progn + (require 'ps-print) + (concat ps-lpr-command + " " + (ps-flatten-list (mapcar 'ps-eval-switch ps-lpr-switches)))) + (error + (concat + (if (boundp 'lpr-command) + lpr-command + (if (memq system-type + '(usg-unix-v hpux silicon-graphics-unix)) + "lp" + "lpr")) + (if (and (boundp 'lpr-switches) lpr-switches) + (concat " " + (mapconcat 'identity lpr-switches " ") + " ") + " ")))) + "Command to print a postscript file.") -(defvar dired-text-print-command (concat dired-postscript-print-command " -p") +(defvar dired-text-print-command (concat dired-postscript-print-command "-p ") "Command to print a text file.") (defvar dired-print-program-alist
--- a/lisp/efs/dired-xemacs.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/dired-xemacs.el Mon Aug 13 09:21:54 2007 +0200 @@ -1,7 +1,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; File: dired-xemacs.el -;; Dired Version: $Revision: 1.2 $ +;; Dired Version: $Revision: 1.3 $ ;; RCS: ;; Description: dired functions for XEmacs ;; Author: Mike Sperber <sperber@informatik.uni-tuebingen.de> @@ -274,7 +274,7 @@ "Installs the Dired menu at the menubar." (if (null dired-help-menu) (dired-setup-menus)) - (if current-menubar + (if (and (featurep 'menubar) current-menubar) (progn (let ((buffer-menubar (copy-sequence current-menubar))) (delete (assoc "Edit" buffer-menubar) buffer-menubar)
--- a/lisp/efs/dired.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/dired.el Mon Aug 13 09:21:54 2007 +0200 @@ -5,7 +5,7 @@ ;; ;; File: dired.el ;; RCS: -;; Dired Version: $Revision: 1.3 $ +;; Dired Version: $Revision: 1.4 $ ;; Description: The DIRectory EDitor is for manipulating, and running ;; commands on files in a directory. ;; Authors: FSF, @@ -36,7 +36,7 @@ ;;; Dired Version -(defconst dired-version (substring "$Revision: 1.3 $" 11 -2) +(defconst dired-version (substring "$Revision: 1.4 $" 11 -2) "The revision number of Tree Dired (as a string). Don't forget to mention this when reporting bugs to: @@ -92,9 +92,24 @@ ((< ver 18) (error "dired does not work with emacs version %s" emacs-version)))) -;; Load default-dir last, because we want its interactive specs. -(require 'default-dir) - +;; We duplicate default-dir stuff to avoid its overwrites unless +;; they are explicitly requested. + +(defvar default-directory-function nil + "A function to call to compute the default-directory for the current buffer. +If this is nil, the function default-directory will return the value of the +variable default-directory. +Buffer local.") +(make-variable-buffer-local 'default-directory-function) + +(defun default-directory () + " Returns the default-directory for the current buffer. +Will use the variable default-directory-function if it non-nil." + (if default-directory-function + (funcall default-directory-function) + (if (string-match "Lucid" emacs-version) + (abbreviate-file-name default-directory t) + (abbreviate-file-name default-directory)))) ;;;;---------------------------------------------------------------- ;;;; Customizable variables @@ -143,7 +158,7 @@ For example: - \(setq dired-compresssion-method-alist + \(setq dired-compression-method-alist \(cons '\(frobnicate \".frob\" \(\"frob\"\) \(\"frob\" \"-d\"\) \"-f\"\) dired-compression-method-alist\)\) => \(\(frobnicate \".frob\" \(\"frob\"\) \(\"frob\" \"-d\"\)\) @@ -207,7 +222,7 @@ ;;;###autoload (defvar dired-chown-program (if (memq system-type '(hpux dgux usg-unix-v)) "chown" "/etc/chown") - "*Name of chown command (usully `chown' or `/etc/chown').") + "*Name of chown command (usually `chown' or `/etc/chown').") ;;;###autoload (defvar dired-gnutar-program nil @@ -3776,7 +3791,7 @@ Optional CHAR indicates a marker character to use." (let (buffer-read-only) (if (memq (or char dired-marker-char) '(?\ ?\n ?\r)) - (error "Invalid marker charcter %c" dired-marker-char)) + (error "Invalid marker character %c" dired-marker-char)) (or char (setq char dired-marker-char)) (dired-repeat-over-lines arg
--- a/lisp/efs/efs-auto.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/efs-auto.el Mon Aug 13 09:21:54 2007 +0200 @@ -3,12 +3,11 @@ ;; ;; File: efs-auto.el ;; Release: $efs release: 1.15 $ -;; Version: $Revision: 1.1 $ +;; Version: $Revision: 1.2 $ ;; RCS: ;; Description: Simple way of autoloading efs ;; Author: Andy Norman, Dawn ;; Created: Thu Sep 24 09:50:08 1992 -;; Modified: Sun Nov 27 11:45:28 1994 by sandy on gandalf ;; Language: Emacs-Lisp ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -37,7 +36,7 @@ (defconst efs-auto-version (concat (substring "$efs release: 1.15 $" 14 -2) "/" - (substring "$Revision: 1.1 $" 11 -2))) + (substring "$Revision: 1.2 $" 11 -2))) ;;; Interactive functions that should be accessible from here.
--- a/lisp/efs/efs-cms-knet.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/efs-cms-knet.el Mon Aug 13 09:21:54 2007 +0200 @@ -3,7 +3,7 @@ ;; ;; File: efs-cms-knet.el ;; Release: $efs release: 1.15 $ -;; Version: $Revision: 1.1 $ +;; Version: $Revision: 1.2 $ ;; RCS: ;; Description: CMS support for efs using KNET/VM server ;; Authors: Sandy Rutherford <sandy@ibm550.sissa.it> @@ -23,7 +23,7 @@ (defconst efs-cms-knet-version (concat (substring "$efs release: 1.15 $" 14 -2) "/" - (substring "$Revision: 1.1 $" 11 -2))) + (substring "$Revision: 1.2 $" 11 -2))) ;;;; ------------------------------------------------------------ ;;;; CMS support for KNET-VM server
--- a/lisp/efs/efs-cp-p.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/efs-cp-p.el Mon Aug 13 09:21:54 2007 +0200 @@ -3,7 +3,7 @@ ;; ;; File: efs-cp-p.el ;; Release: $efs release: 1.15 $ -;; Version: $Revision: 1.1 $ +;; Version: $Revision: 1.2 $ ;; RCS: ;; Description: Support for preserving file modtimes with copies. i.e. cp -p ;; Author: Sandy Rutherford <sandy@ibm550.sissa.it> @@ -24,7 +24,7 @@ (defconst efs-cp-p-version (concat (substring "$efs release: 1.15 $" 14 -2) "/" - (substring "$Revision: 1.1 $" 11 -2))) + (substring "$Revision: 1.2 $" 11 -2))) (defvar efs-local-timezone nil) ;; cache.
--- a/lisp/efs/efs-cu.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/efs-cu.el Mon Aug 13 09:21:54 2007 +0200 @@ -3,7 +3,7 @@ ;; ;; File: efs-cu.el ;; Release: $efs release: 1.15 $ -;; Version: $Revision: 1.3 $ +;; Version: $Revision: 1.4 $ ;; RCS: ;; Description: Common utilities needed by efs files. ;; Author: Sandy Rutherford <sandy@ibm550.sissa.it> @@ -26,7 +26,7 @@ ;;;; Use configuration variables. ;;;; ------------------------------------------------------------ -(defvar efs-default-user nil +(defvar efs-default-user "anonymous" "*User name to use when none is specied in a pathname. If a string, than this string is used as the default user name. @@ -55,7 +55,7 @@ (defconst efs-cu-version (concat (substring "$efs release: 1.15 $" 14 -2) "/" - (substring "$Revision: 1.3 $" 11 -2))) + (substring "$Revision: 1.4 $" 11 -2))) (defconst efs-case-insensitive-host-types '(vms cms mts ti-twenex ti-explorer dos mvs tops-20 mpe ka9q dos-distinct @@ -86,6 +86,7 @@ (substring efs-path-user-at-host-format 3) "Format to return `host:' strings for completion in root directory.") +;;;###autoload (defvar efs-path-root-regexp "^/[^/:]+:" "Regexp to match the `/user@host:' root of an efs full path.") @@ -619,12 +620,12 @@ (defun efs-code-string (string) ;; Encode a string, using `efs-passwd-seed'. This is nil-potent, ;; meaning applying it twice decodes. - (if (and (fboundp 'int-char) (fboundp 'char-int)) + (if (and (fboundp 'int-to-char) (fboundp 'char-to-int)) (mapconcat (function (lambda (c) (char-to-string - (int-char (logxor (efs-get-passwd-seed) (char-int c)))))) + (int-to-char (logxor (efs-get-passwd-seed) (char-to-int c)))))) string "") (mapconcat (function
--- a/lisp/efs/efs-defun.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/efs-defun.el Mon Aug 13 09:21:54 2007 +0200 @@ -3,7 +3,7 @@ ;; ;; File: efs-defun.el ;; Release: $efs release: 1.15 $ -;; Version: $Revision: 1.1 $ +;; Version: $Revision: 1.2 $ ;; RCS: ;; Description: efs-defun allows for OS-dependent coding of functions ;; Author: Sandy Rutherford <sandy@ibm550.sissa.it> @@ -136,7 +136,7 @@ (defconst efs-defun-version (concat (substring "$efs release: 1.15 $" 14 -2) "/" - (substring "$Revision: 1.1 $" 11 -2))) + (substring "$Revision: 1.2 $" 11 -2))) (defconst efs-key-obarray (make-vector 7 0))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/efs/efs-dump.el Mon Aug 13 09:21:54 2007 +0200 @@ -0,0 +1,18 @@ +;; -*-Emacs-Lisp-*- +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; File: efs-dump.el +;; Release: $efs release: 1.15 $ +;; Version: $Revision: 1.1 $ +;; RCS: +;; Description: Install a bare-bones EFS hook into file-name-handler-alist +;; for dumping +;; Author: Mike Sperber <sperber@informatik.uni-tuebingen.de> +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;###autoload +(setq file-name-handler-alist + (cons + (cons efs-path-root-regexp 'efs-file-handler-function) + file-name-handler-alist))
--- a/lisp/efs/efs-gwp.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/efs-gwp.el Mon Aug 13 09:21:54 2007 +0200 @@ -3,7 +3,7 @@ ;; ;; File: efs-gwp.el ;; Release: $efs release: 1.15 $ -;; Version: $Revision: 1.1 $ +;; Version: $Revision: 1.2 $ ;; RCS: ;; Description: Support for efs to use an interactive gateway. ;; Author: Andy Norman, Dawn @@ -77,7 +77,7 @@ (defconst efs-gwp-version (concat (substring "$efs release: 1.15 $" 14 -2) "/" - (substring "$Revision: 1.1 $" 11 -2))) + (substring "$Revision: 1.2 $" 11 -2))) (defvar efs-gwp-running t) (defvar efs-gwp-status nil)
--- a/lisp/efs/efs-ms-unix.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/efs-ms-unix.el Mon Aug 13 09:21:54 2007 +0200 @@ -3,7 +3,7 @@ ;; ;; File: efs-ms-unix.el ;; Release: $efs release: 1.15 $ -;; Version: $Revision: 1.1 $ +;; Version: $Revision: 1.2 $ ;; RCS: ;; Description: efs support for the Microsoft PC FTP server in unix mode. ;; Author: Sandy Rutherford <sandy@tsmi19.sissa.it> @@ -19,7 +19,7 @@ (defconst efs-ms-unix-version (concat (substring "$efs release: 1.15 $" 14 -2) "/" - (substring "$Revision: 1.1 $" 11 -2))) + (substring "$Revision: 1.2 $" 11 -2))) (defvar efs-ms-unix-month-and-time-regexp (concat
--- a/lisp/efs/efs-netrc.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/efs-netrc.el Mon Aug 13 09:21:54 2007 +0200 @@ -3,12 +3,11 @@ ;; ;; File: efs-netrc.el ;; Release: $efs release: 1.15 $ -;; Version: $Revision: 1.1 $ +;; Version: $Revision: 1.2 $ ;; RCS: ;; Description: Parses ~/.netrc file, and does completion in /. ;; Author: Sandy Rutherford <sandy@ibm550.sissa.it> ;; Created: Fri Jan 28 19:32:47 1994 by sandy on ibm550 -;; Modified: Sun Nov 27 18:38:50 1994 by sandy on gandalf ;; Language: Emacs-Lisp ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -33,7 +32,7 @@ (defconst efs-netrc-version (concat (substring "$efs release: 1.15 $" 14 -2) "/" - (substring "$Revision: 1.1 $" 11 -2))) + (substring "$Revision: 1.2 $" 11 -2))) ;; Make the byte compiler happy. (defvar dired-directory) @@ -58,6 +57,7 @@ ;;;; Host / User / Account mapping support. ;;;; ------------------------------------------------------------ +;;;###autoload (defun efs-set-passwd (host user passwd) "For a given HOST and USER, set or change the associated PASSWORD." (interactive (list (read-string "Host: ") @@ -370,6 +370,7 @@ (list nil) res)))) +;;;###autoload (defun efs-root-file-name-all-completions (file dir) ;; Generates all completions in the root directory. (let ((file-name-handler-alist (efs-file-name-handler-alist-sans-fn @@ -378,6 +379,7 @@ (file-name-all-completions file dir)))) +;;;###autoload (defun efs-root-file-name-completion (file dir) ;; Calculates completions in the root directory to include remote hosts. (let ((file-name-handler-alist (efs-file-name-handler-alist-sans-fn
--- a/lisp/efs/efs-ovwrt.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/efs-ovwrt.el Mon Aug 13 09:21:54 2007 +0200 @@ -3,11 +3,10 @@ ;; ;; File: efs-ovwrt.el ;; Release: $efs release: 1.15 $ -;; Version: $Revision: 1.1 $ +;; Version: $Revision: 1.2 $ ;; RCS: ;; Description: Utilities for overwriting functions with new definitions. ;; Author: Andy Norman <ange@hplb.hpl.hp.com> -;; Modified: Sun Nov 27 18:40:20 1994 by sandy on gandalf ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -20,7 +19,7 @@ (defconst efs-ovwrt-version (concat (substring "$efs release: 1.15 $" 14 -2) "/" - (substring "$Revision: 1.1 $" 11 -2))) + (substring "$Revision: 1.2 $" 11 -2))) (defvar efs-overwrite-fmt "Note: This function has been modified to work with %s.") @@ -66,9 +65,12 @@ ;; later after some other code has been loaded on top of our stuff. (or (fboundp saved) - (progn + (let ((advised-p (and (featurep 'advice) + (ad-is-advised fun)))) + (if advised-p (ad-deactivate fun)) (fset saved (symbol-function fun)) - (fset fun new))) + (fset fun new) + (if advised-p (ad-activate fun)))) ;; Rewrite the doc string on the new function. This should ;; be done every time the file is loaded (or a function is redefined),
--- a/lisp/efs/efs-pc.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/efs-pc.el Mon Aug 13 09:21:54 2007 +0200 @@ -3,7 +3,7 @@ ;; ;; File: efs-pc.el ;; Release: $efs release: 1.15 $ -;; Version: $Revision: 1.1 $ +;; Version: $Revision: 1.2 $ ;; RCS: ;; Description: PC support for efs ;; Author: Sandy Rutherford <sandy@tsmi19.sissa.it> @@ -31,7 +31,7 @@ (defconst efs-pc-version (concat (substring "$efs release: 1.15 $" 14 -2) "/" - (substring "$Revision: 1.1 $" 11 -2))) + (substring "$Revision: 1.2 $" 11 -2))) ;;;----------------------------------------------------------------- ;;; PC support for efs @@ -260,7 +260,7 @@ ;; Neither DOS nor OS/2 allows us to end the name of a directory ;; with an "\". ;; Adding *.* to the end also allows us to distinguish plain files from - ;; directries. All DOS servers seem to understand this except + ;; directories. All DOS servers seem to understand this except ;; Frontier Technologies' super-tcp server. ((string-match "/$" dir-path) (concat (efs-fix-pc-path dir-path) "*.*"))
--- a/lisp/efs/efs-plan9.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/efs-plan9.el Mon Aug 13 09:21:54 2007 +0200 @@ -3,7 +3,7 @@ ;; ;; File: efs-plan9.el ;; Release: $efs release: 1.15 $ -;; Version: $Revision: 1.1 $ +;; Version: $Revision: 1.2 $ ;; RCS: ;; Description: efs support for the Plan 9 FTP Server ;; Author: Sandy Rutherford <sandy@ibm550.sissa.it> @@ -24,7 +24,7 @@ (defconst efs-plan9-version (concat (substring "$efs release: 1.15 $" 14 -2) "/" - (substring "$Revision: 1.1 $" 11 -2))) + (substring "$Revision: 1.2 $" 11 -2))) (efs-defun efs-fix-dir-path plan9 (dir-path) ;; Convert DIR-PATH from UN*X-ish to Plan 9. Does nothing actually.
--- a/lisp/efs/efs-report.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/efs-report.el Mon Aug 13 09:21:54 2007 +0200 @@ -3,12 +3,11 @@ ;; ;; File: efs-report.el ;; Release: $efs release: 1.15 $ -;; Version: $Revision: 1.1 $ +;; Version: $Revision: 1.2 $ ;; RCS: ;; Description: Function to report efs bugs in a usable way. ;; Author: Andy Norman, Dawn ;; Created: Tue May 18 08:34:45 1993 -;; Modified: Sun Nov 27 18:41:45 1994 by sandy on gandalf ;; Language: Emacs-Lisp ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -23,7 +22,7 @@ (defconst efs-report-version (concat (substring "$efs release: 1.15 $" 14 -2) "/" - (substring "$Revision: 1.1 $" 11 -2))) + (substring "$Revision: 1.2 $" 11 -2))) (defconst efs-report-salutations ["Dear bug team:" @@ -163,6 +162,7 @@ ?\n ?\ ) (insert subj))))) +;;;###autoload (defun efs-report-bug (&optional default-host default-user blurb no-confirm) "Submit a bug report for efs." (interactive)
--- a/lisp/efs/efs-ti-explorer.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/efs-ti-explorer.el Mon Aug 13 09:21:54 2007 +0200 @@ -3,7 +3,7 @@ ;; ;; File: efs-ti-explorer.el ;; Release: $efs release: 1.15 $ -;; Version: $Revision: 1.1 $ +;; Version: $Revision: 1.2 $ ;; RCS: ;; Description: Explorer support for efs ;; Author: Jamie Zawinski <jwz@lucid.com> @@ -22,7 +22,7 @@ (defconst efs-ti-explorer-version (concat (substring "$efs release: 1.15 $" 14 -2) "/" - (substring "$Revision: 1.1 $" 11 -2))) + (substring "$Revision: 1.2 $" 11 -2))) ;;;; ------------------------------------------------------------ ;;;; Explorer support.
--- a/lisp/efs/efs-ti-twenex.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/efs-ti-twenex.el Mon Aug 13 09:21:54 2007 +0200 @@ -3,7 +3,7 @@ ;; ;; File: efs-ti-twenex.el ;; Release: $efs release: 1.15 $ -;; Version: $Revision: 1.1 $ +;; Version: $Revision: 1.2 $ ;; RCS: ;; Description: Support for a TI lisp machine in Twenex emulation mode. ;; Author: Jamie Zawinski <jwz@lucid.com> @@ -22,7 +22,7 @@ (defconst efs-ti-twenex-version (concat (substring "$efs release: 1.15 $" 14 -2) "/" - (substring "$Revision: 1.1 $" 11 -2))) + (substring "$Revision: 1.2 $" 11 -2))) ;;;; ------------------------------------------------------------ ;;;; Twenex support.
--- a/lisp/efs/efs-tops-20.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/efs-tops-20.el Mon Aug 13 09:21:54 2007 +0200 @@ -3,7 +3,7 @@ ;; ;; File: efs-tops-20.el ;; Release: $efs release: 1.15 $ -;; Version: $Revision: 1.1 $ +;; Version: $Revision: 1.2 $ ;; RCS: ;; Description: TOPS-20 support for efs ;; Author: Sandy Rutherford <sandy@math.ubc.ca, sandy@itp.ethz.ch> @@ -22,7 +22,7 @@ (defconst efs-tops-20-version (concat (substring "$efs release: 1.15 $" 14 -2) "/" - (substring "$Revision: 1.1 $" 11 -2))) + (substring "$Revision: 1.2 $" 11 -2))) ;;;; ------------------------------------------------------------ ;;;; TOPS-20 support
--- a/lisp/efs/efs-x19.15.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/efs-x19.15.el Mon Aug 13 09:21:54 2007 +0200 @@ -3,24 +3,22 @@ ;; ;; File: efs-x19.15.el ;; Release: $efs release: 1.15 $ -;; Version: $Revision: 1.2 $ +;; Version: $Revision: 1.3 $ ;; RCS: ;; Description: efs support for XEmacs, versions 19.15, and later. ;; Author: Sandy Rutherford <sandy@ibm550.sissa.it> ;; Created: Tue Aug 2 17:40:32 1994 by sandy on ibm550 -;; Modified: by Mike Sperber ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (provide 'efs-x19\.15) (require 'efs-cu) -(require 'default-dir) (require 'efs-ovwrt) (defconst efs-x19\.15-version (concat (substring "$efs release: 1.15 $" 14 -2) "/" - (substring "$Revision: 1.2 $" 11 -2))) + (substring "$Revision: 1.3 $" 11 -2))) ;;; Functions requiring special defs. for these XEmacs versions.
--- a/lisp/efs/efs.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/efs/efs.el Mon Aug 13 09:21:54 2007 +0200 @@ -3,7 +3,7 @@ ;; ;; File: efs.el ;; Release: $efs release: 1.15 $ -;; Version: $Revision: 1.3 $ +;; Version: $Revision: 1.4 $ ;; RCS: ;; Description: Transparent FTP support for the original GNU Emacs ;; from FSF and Lucid Emacs @@ -73,12 +73,8 @@ ;;; Documentation: ;;; -------------------------------------------------------------- ;;; -;;; Currently efs does not have a tex info file, and what you are -;;; reading represents the only efs documentation. Please report any -;;; errors or omissions in this documentation to the "bugs" address -;;; below. Eventually, a tex info file should be written. If you have -;;; any problems with efs, please read this section *before* -;;; submitting a bug report. +;;; If you have any problems with efs, please read this section +;;; *before* submitting a bug report. ;;; Installation: ;;; @@ -309,7 +305,7 @@ ;;; Gateways: ;;; -;;; Sometimes it is neccessary for the FTP process to be run on a different +;;; Sometimes it is necessary for the FTP process to be run on a different ;;; machine than the machine running GNU Emacs. This can happen when the ;;; local machine has restrictions on what hosts it can access. ;;; @@ -906,7 +902,7 @@ ;;; efs|Andy Norman and Sandy Rutherford ;;; |ange@hplb.hpl.hp.com and sandy@ibm550.sissa.it ;;; |transparent FTP Support for GNU Emacs -;;; |$Date: 1997/02/24 01:13:11 $|$efs release: 1.15 beta $| +;;; |$Date: 1997/03/22 06:01:58 $|$efs release: 1.15 beta $| ;;; Host and listing type notation: ;;; @@ -1053,7 +1049,7 @@ (defconst efs-version (concat (substring "$efs release: 1.15 $" 14 -2) "/" - (substring "$Revision: 1.3 $" 11 -2))) + (substring "$Revision: 1.4 $" 11 -2))) (defconst efs-time-zero 1970) ; we count time from midnight, Jan 1, 1970 GMT. @@ -4161,6 +4157,7 @@ ;;;; pretty much scrap metal.) ;;;; --------------------------------------------------------------------- +;;;###autoload (defun efs-nslookup-host (host) "Attempt to resolve the given HOSTNAME using nslookup if possible." (interactive "sHost: ") @@ -10730,6 +10727,7 @@ ;;;; File name handlers ;;;; ------------------------------------------------------------ +;;;###autoload (defun efs-file-handler-function (operation &rest args) "Function to call special file handlers for remote files." (let ((handler (get operation 'efs)))
--- a/lisp/egg/egg-jisx0201.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/egg/egg-jisx0201.el Mon Aug 13 09:21:54 2007 +0200 @@ -22,7 +22,8 @@ ;;; 93.8.3 modified for Mule Ver.1.1 by K.Handa <handa@etl.go.jp> ;;; Not to define regexp of Japanese word in this file. -(provide 'jisx0201) +(require 'egg) +(provide 'egg-jisx0201) (defvar *katakana-alist* '(( 161 . "(I'(B" ) @@ -142,8 +143,8 @@ (let ((regexp (if arg "\\cS\\|\\cK\\|\\cH" "\\cS\\|\\cK"))) (while (re-search-forward regexp (point-max) (point-max)) (let* ((ch (preceding-char)) - (ch1 (char-component ch 1)) - (ch2 (char-component ch 2))) + (ch1 (char-octet ch 0)) + (ch2 (char-octet ch 1))) (cond ((= ?\241 ch1) (let ((val (cdr (assq ch2 *katakana-kigou-alist*)))) (if val (progn
--- a/lisp/egg/egg-wnn.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/egg/egg-wnn.el Mon Aug 13 09:21:54 2007 +0200 @@ -1,4 +1,4 @@ -;;; wnn-egg.el --- a inputting method communicating with [jck]server +;;; egg-wnn.el --- a inputting method communicating with [jck]server ;; Author: Satoru Tomura (tomura@etl.go.jp), and ;; Toshiaki Shingu (shingu@cpr.canon.co.jp) @@ -89,6 +89,7 @@ ;;; Code: +(require 'egg) (make-variable-buffer-local 'wnn-server-type) (make-variable-buffer-local 'cwnn-zhuyin) @@ -117,10 +118,12 @@ ;;; $B0J2<$N(B its mode $B4X78$N4X?t$O!"(Begg.el $B$GDj5A$5$l$F$$$k$,!"(B ;;; $B$?$+$J$G$O(B its mode $B$N@ZBX$($KF14|$7$F!"(Bjserver/cserver, ;;; pinyin/zhuyin $B$N@ZBX$($b9T$J$$$?$$$N$G!":FDj5A$7$F$$$k!#(B -;;; $B=>$C$F!"(Begg.el, wnn-egg.el $B$N=g$K%m!<%I$7$J$1$l$P$J$i$J$$!#(B +;;; $B=>$C$F!"(Begg.el, egg-wnn.el $B$N=g$K%m!<%I$7$J$1$l$P$J$i$J$$!#(B (defun its:select-mode (name) +"Switch ITS mode to NAME or prompt for it if called interactivly. +After changing, its:select-mode-hook is called." (interactive (list (completing-read "ITS mode: " its:*mode-alist*))) (if (its:get-mode-map name) (progn @@ -131,6 +134,8 @@ ) (defun its:select-mode-from-menu () +"Select ITS mode from menu. +After changing, its:select-mode-hook is called." (interactive) (setcar (nthcdr 2 its:*select-mode-menu*) its:*mode-alist*) (setq its:*current-map* (menu:select-from-menu its:*select-mode-menu*)) @@ -153,6 +158,8 @@ )))) (defun its:next-mode () +"Switch to next mode in list its:*standard-modes* +After changing, its:select-mode-hook is called." (interactive) (let ((pos (its:find its:*current-map* its:*standard-modes*))) (setq its:*current-map* @@ -162,6 +169,8 @@ (run-hooks 'its:select-mode-hook))) (defun its:previous-mode () +"Switch to previous mode in list its:*standard-modes* +After changing, its:select-mode-hook is called." (interactive) (let ((pos (its:find its:*current-map* its:*standard-modes*))) (setq its:*current-map* @@ -201,7 +210,7 @@ (defvar egg:*sai-henkan-end* nil) (defvar egg:*old-bunsetu-suu* nil) -(defun wnn-egg:kill-emacs-function () +(defun egg-wnn:kill-emacs-function () (let ((wnn-server-type)) (setq wnn-server-type 'jserver) (close-wnn) @@ -210,20 +219,93 @@ (setq wnn-server-type 'kserver) (close-wnn))) -(add-hook 'kill-emacs-hook 'wnn-egg:kill-emacs-function) +(add-hook 'kill-emacs-hook 'egg-wnn:kill-emacs-function) (defun egg:error (form &rest mesg) (apply 'notify (or form "%s") mesg) (apply 'error (or form "%s") mesg)) +(defun wnn-toggle-english-messages () +"Toggle whether wnn reports info in english or the native language of the server." + (interactive) + (setq wnn-english-messages (not wnn-english-messages))) + +(defvar wnn-english-messages nil "*If non-nil, display messages from the [jck]server in English") + +(make-symbol "english-mess") + (defun egg:msg-get (message) (or - (nth 1 (assoc message (nth 1 (assoc wnn-server-type *egg-message-alist*)))) + (nth 1 (assoc message (nth 1 (assoc (if wnn-english-messages 'english-mess wnn-server-type) + *egg-message-alist*)))) (format "No message. Check *egg-message-alist* %s %s" wnn-server-type message))) (defvar *egg-message-alist* - '((jserver + '((english-mess + ((open-wnn "Connected with Wnn on host %s") + (no-rcfile "No egg-startup-file on %s") + (file-saved "Wnn dictionary and frequency data recorded.") + (henkan-mode-indicator "$B4A(B") + (begin-henkan "$BJQ493+;OJ8;zNs(B: ") + (end-henkan "$BJQ49=*N;J8;zNs(B: ") + (kugiri-dai "$BBgJ8@a6h@Z$jJ8;zNs(B: ") + (kugiri-sho "$B>.J8@a6h@Z$jJ8;zNs(B: ") + (face-henkan "$BJQ496h4VI=<(B0@-(B: ") + (face-dai "$BBgJ8@a6h4VI=<(B0@-(B: ") + (face-sho "$B>.J8@a6h4VI=<(B0@-(B: ") + (jikouho "$B<!8uJd(B:") + (off-msg "%s %s(%s:%s) turned off.") + (henkan-help "Kanji conversion mode: +$BJ8@a0\F0(B + \\[henkan-first-bunsetu]\t$B@hF,J8@a(B\t\\[henkan-last-bunsetu]\t$B8eHxJ8@a(B + \\[henkan-backward-bunsetu]\t$BD>A0J8@a(B\t\\[henkan-forward-bunsetu]\t$BD>8eJ8@a(B +$BJQ49JQ99(B + $BBgJ8@a<!8uJd(B \\[henkan-next-kouho-dai]\t$B>.J8@a<!8uJd(B \\[henkan-next-kouho-sho] + $BA08uJd(B \\[henkan-previous-kouho] \t$B<!8uJd(B \\[henkan-next-kouho] + $BBgJ8@a?-$7(B \\[henkan-bunsetu-nobasi-dai] \t$BBgJ8@a=L$a(B \\[henkan-bunsetu-chijime-dai] + $B>.J8@a?-$7(B \\[henkan-bunsetu-nobasi-sho] \t$B>.J8@a=L$a(B \\[henkan-bunsetu-chijime-sho] + $BBgJ8@aJQ498uJdA*Br(B \\[henkan-select-kouho-dai] \t$B>.J8@aJQ498uJdA*Br(B \\[henkan-select-kouho-sho] +$BJQ493NDj(B + $BA4J8@a3NDj(B \\[henkan-kakutei] \t$BD>A0J8@a$^$G3NDj(B \\[henkan-kakutei-before-point] +$BJQ49Cf;_(B \\[henkan-quit] +") + (hinsimei "Hinshi (product/noun) name:") + (jishotouroku-yomi "Dictionary entry for$B!X(B%s$B!Y(B reading:") + (touroku-jishomei "Name of dictionary:" ) + (registerd "Dictonary entry$B!X(B%s$B!Y(B(%s: %s) registered in %s.") + (yomi "Reading$B!'(B") + (no-yomi "No dictionary entry for $B!X(B%s$B!Y(B.") + (jisho "Dictionary:") + (hindo "Frequency:") + (kanji "Kanji:") + (register-notify "Dictonary entry$B!X(B%s$B!Y(B(%s: %s) registered in %s.") + (cannot-remove "Cannot delete entry from system dictionary.") + (enter-hindo "Enter frequency:") + (remove-notify "Dictonary entry$B!X(B%s$B!Y(B(%s) removed from %s.") + (removed "Dictonary entry$B!X(B%s$B!Y(B(%s) removed from %s.") + (jishomei "Dictionary name:" ) + (comment "Comment:") + (jisho-comment "Dictionary:%s: comment:%s") + (param ("$B#N(B ( $BBg(B ) $BJ8@a2r@O$N#N(B" + "$BBgJ8@aCf$N>.J8@a$N:GBg?t(B" + "$B448l$NIQEY$N%Q%i%a!<%?(B" + "$B>.J8@aD9$N%Q%i%a!<%?(B" + "$B448lD9$N%Q%i%a!<%?(B" + "$B:#;H$C$?$h%S%C%H$N%Q%i%a!<%?(B" + "$B<-=q$N%Q%i%a!<%?(B" + "$B>.J8@a$NI>2ACM$N%Q%i%a!<%?(B" + "$BBgJ8@aD9$N%Q%i%a!<%?(B" + "$B>.J8@a?t$N%Q%i%a!<%?(B" + "$B5?;wIJ;l(B $B?t;z$NIQEY(B" + "$B5?;wIJ;l(B $B%+%J$NIQEY(B" + "$B5?;wIJ;l(B $B1Q?t$NIQEY(B" + "$B5?;wIJ;l(B $B5-9f$NIQEY(B" + "$B5?;wIJ;l(B $BJD3g8L$NIQEY(B" + "$B5?;wIJ;l(B $BIUB08l$NIQEY(B" + "$B5?;wIJ;l(B $B3+3g8L$NIQEY(B")) + )) + (jserver ((open-wnn "$B%[%9%H(B %s $B$N(B Wnn $B$r5/F0$7$^$7$?(B") (no-rcfile "%s $B>e$K(B egg-startup-file $B$,$"$j$^$;$s!#(B") (file-saved "Wnn$B$NIQEY>pJs!&<-=q>pJs$rB`Hr$7$^$7$?!#(B") @@ -458,6 +540,10 @@ ;; ###jhod Currently very broken. Needs to be rewritten for the new ;; wnn-server-set-param (defun set-wnn-param (&rest param) +"Set parameters for the current wnn session. +Uses property list PARAM, or prompts if called interactivly. + +Currently very broken." (interactive) ; (open-wnn-if-disconnected) (let ((current-param (wnn-server-get-param)) @@ -601,6 +687,7 @@ (cons name (delete name list))) (defun set-wnn-host-name (name) +"Set egg/wnn to connect to jserver on host NAME, or prompt for it." (interactive "sHost name: ") (let ((wnn-server-type 'jserver)) (close-wnn)) (setq jserver-list @@ -610,6 +697,7 @@ (fset 'set-jserver-host-name (symbol-function 'set-wnn-host-name)) (defun set-cwnn-host-name (name) +"Set egg/wnn to connect to cserver on host NAME, or prompt for it." (interactive "sHost name: ") (let ((wnn-server-type 'cserver)) (close-wnn)) (setq cserver-list @@ -619,6 +707,7 @@ (fset 'set-cserver-host-name (symbol-function 'set-cwnn-host-name)) (defun set-kwnn-host-name (name) +"Set egg/wnn to connect to kserver on host NAME, or prompt for it." (interactive "sHost name: ") (let ((wnn-server-type 'kserver)) (close-wnn)) (setq kserver-list @@ -695,10 +784,12 @@ (run-hooks 'egg:open-wnn-hook)))) (defun disconnect-wnn () +"Dump connection to Wnn servers, discarding dictionary and frequency changes." (interactive) (if (wnn-server-isconnect) (wnn-server-close))) (defun close-wnn () +"Cleanly shutdown connection to Wnn servers, saving data and calling egg:close-wnn-hook" (interactive) (if (wnn-server-isconnect) (progn @@ -1010,6 +1101,7 @@ (setq i (1+ i))))) (defun henkan-kakutei () + "Accept the current henkan region" (interactive) (egg:bunsetu-face-off) (egg:henkan-face-off) @@ -1060,6 +1152,7 @@ ;; end of patch (defun henkan-kakutei-before-point () +"Accept the henkan region before point, and put the rest back into a fence." (interactive) (egg:bunsetu-face-off) (egg:henkan-face-off) @@ -1100,7 +1193,9 @@ (use-local-map fence-mode-map) (egg:mode-line-display)) +;; ### Should probably put this on a key. (defun sai-henkan () +"Reconvert last henkan entry." (interactive) (if egg:henkan-mode-in-use nil (let ((finished nil)) @@ -1131,8 +1226,8 @@ ;; make dai-bunsetu extent and sho-bunsetu extent if they do not exist. ;; put thier faces to extents and move them to each bunsetu. (let* ((bunsetu-begin *bunsetu-number*) - (bunsetu-end) - (bunsetu-suu (wnn-server-bunsetu-suu))) + (bunsetu-end)) +; (bunsetu-suu (wnn-server-bunsetu-suu))) ; dai bunsetu (if egg:*dai-bunsetu-face* (progn @@ -1252,7 +1347,7 @@ (defun henkan-goto-kouho (kouho-number) ; (egg:bunsetu-face-off) (let ((point (point)) - (yomi (bunsetu-yomi *bunsetu-number*)) +; (yomi (bunsetu-yomi *bunsetu-number*)) (max) (min)) (setq kouho-number @@ -1330,8 +1425,7 @@ (bunsetu-length-henko l))) (defun bunsetu-length-henko (length) - (let ((i 0) - (r (wnn-server-bunsetu-henkou *bunsetu-number* length egg:*dai*)) + (let ((r (wnn-server-bunsetu-henkou *bunsetu-number* length egg:*dai*)) (start (max 0 (1- *bunsetu-number*)))) (cond((null r) (egg:error (wnn-server-get-msg))) @@ -1749,7 +1843,7 @@ (if (= (current-column) 0) 1 0) -1) *diced-dict-info*)) - (hindo (nth 2 dict-item)) +; (hindo (nth 2 dict-item)) (dict-number (nth 3 dict-item)) (serial-number (nth 4 dict-item)) ) @@ -1760,13 +1854,13 @@ (defun diced-hindo-set (&optional newhindo) (interactive) (if (null newhindo) - (setq newhindo (read-minibuffer (egg:msg-get 'enter-hindo)))) + (setq newhindo (read-expression (egg:msg-get 'enter-hindo)))) (let* ((dict-item (nth (+ (count-lines (point-min) (point)) (if (= (current-column) 0) 1 0) -1) *diced-dict-info*)) - (hindo (nth 2 dict-item)) +; (hindo (nth 2 dict-item)) (dict-number (nth 3 dict-item)) (serial-number (nth 4 dict-item)) ) @@ -1793,10 +1887,10 @@ (kanji (nth 0 dict-item)) (bunpo (nth 1 dict-item)) (hinshi (wnn-server-hinsi-name bunpo)) - (hindo (nth 2 dict-item)) +; (hindo (nth 2 dict-item)) (dict-number (nth 3 dict-item)) (dict-name (wnn-dict-name dict-number (wnn-server-dict-list))) - (sys-dict-p (null (memq dict-number (wnn-server-hinsi-dicts -1)))) +; (sys-dict-p (null (memq dict-number (wnn-server-hinsi-dicts -1)))) (serial-number (nth 4 dict-item)) ) (if (notify-yes-or-no-p (egg:msg-get 'remove-notify) @@ -1829,7 +1923,7 @@ (if (eobp) (forward-line -1))) (defun diced-mode () - "Mode for \"editing\" dictionaries. + "Mode for \"editing\" Wnn dictionaries. In diced, you are \"editing\" a list of the entries in dictionaries. You can move using the usual cursor motion commands. Letters no longer insert themselves. Instead, @@ -1926,6 +2020,6 @@ hindo hyoka daihyoka kangovect) t))))))))) -(provide 'wnn-egg) +(provide 'egg-wnn) -;;; wnn-egg.el ends here +;;; egg-wnn.el ends here
--- a/lisp/egg/egg.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/egg/egg.el Mon Aug 13 09:21:54 2007 +0200 @@ -396,19 +396,22 @@ ;; XEmacs addition: (and remove disable-undo variable) ;; For Emacs V18/Nemacs compatibility -(and (not (fboundp 'buffer-disable-undo)) - (fboundp 'buffer-flush-undo) - (defalias 'buffer-disable-undo 'buffer-flush-undo)) +;(and (not (fboundp 'buffer-disable-undo)) +; (fboundp 'buffer-flush-undo) +; (defalias 'buffer-disable-undo 'buffer-flush-undo)) ;; 97.2.4 Created by J.Hein to simulate Mule-2.3 -(defun read-event () - "Cheap 'n cheesy event filter to facilitate translation from Mule-2.3" - (let ((event (make-event))) - (while (progn - (next-event event) - (not (key-press-event-p event))) - (dispatch-event event)) - (event-key event))) +(defun egg-read-event () + "FSFmacs event emulator that shoves non key events into +unread-command-events to facilitate translation from Mule-2.3" + (let ((event (make-event)) + (ch nil)) + (next-command-event event) + (if (key-press-event-p event) + (setq ch (event-key event)) + (setq unread-command-events (list event))) + (deallocate-event event) + ch)) (eval-when-compile (require 'egg-jsymbol)) @@ -683,7 +686,7 @@ ) ;; end of patch (while (not finished) - (let ((ch (read-event))) + (let ((ch (egg-read-event))) (setq quit-flag nil) (cond ((eq ch ?\C-a) @@ -1615,7 +1618,12 @@ (defun its:peek-char () (if (= (point) its:*buff-e*) (if its:*interactive* - (setq unread-command-events (list (character-to-event(read-event)))) + (let ((ch (egg-read-event))) + (if ch + (progn + (setq unread-command-events (list (character-to-event ch))) + ch) + nil)) nil) (following-char))) @@ -1624,7 +1632,7 @@ (progn (setq its:*char-from-buff* nil) (if its:*interactive* - (read-event) + (egg-read-event) nil)) (let ((ch (following-char))) (setq its:*char-from-buff* t) @@ -1816,7 +1824,7 @@ (ch 0)) (while (not (eq ch ?\^L)) (insert "<" (nth (car action-output)output) ">") - (setq ch (read-event)) + (setq ch (egg-read-event)) (cond ((eq ch ?\^N) (setcar action-output (mod (1+ (car action-output)) (length output)))) @@ -2115,7 +2123,6 @@ ;; (load-library "its-hankaku") ;; (load-library "its-zenkaku") - (defvar its:*current-map* nil) (make-variable-buffer-local 'its:*current-map*) ;; 92.3.13 by K.Handa @@ -2378,6 +2385,9 @@ 'egg-self-insert-command global-map) +;; wire us into pending-delete +(put 'egg-self-insert-command 'pending-delete t) + ;;; ;;; Currently entries C-\ and C-^ at global-map are undefined. ;;; @@ -2398,7 +2408,7 @@ (define-key mule-keymap "Z" 'its:select-zenkaku-upcase) ;;; -;;; auto fill controll +;;; auto fill control ;;; (defun egg:do-auto-fill () @@ -2581,7 +2591,8 @@ (defun enter-fence-mode () ;; XEmacs change: - (buffer-disable-undo (current-buffer)) +; (buffer-disable-undo (current-buffer)) + (undo-boundary) (setq egg:*in-fence-mode* t) (egg:mode-line-display) ;;;(setq egg:*global-map-backup* (current-global-map)) @@ -2692,7 +2703,11 @@ its:*previous-map* nil)) (egg:quit-egg-mode)) -(defvar egg-insert-after-hook nil) +;; jhod: This seems bogus to me, as it should be called either after each +;; egg-self-insert, or after accepting input, but not both. Otherwise, I can't +;; really think of a use for it. +(defvar egg-insert-after-hook nil "Hook to run when egg inserts a character +in the buffer") (make-variable-buffer-local 'egg-insert-after-hook) (defvar egg-exit-hook nil @@ -2718,7 +2733,7 @@ (set-marker egg:*region-start* nil) (set-marker egg:*region-end* nil) ;; XEmacs change: - (buffer-enable-undo (current-buffer)) +; (buffer-enable-undo (current-buffer)) (if egg-insert-after-hook (run-hooks 'egg-insert-after-hook)) ) @@ -2728,6 +2743,16 @@ (delete-region egg:*region-start* egg:*region-end*) (fence-exit-mode)) +(defun fence-mouse-protect () + "Cancel entry in progress if mouse events occur." + (if egg:*in-fence-mode* + (save-excursion + (its:reset-input) + (fence-cancel-input)))) + +(if (boundp 'mouse-track-cleanup-hook) + (add-hook 'mouse-track-cleanup-hook 'fence-mouse-protect)) + (defun fence-mode-help-command () "Display documentation for fence-mode." (interactive)
--- a/lisp/gnus/ChangeLog Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/gnus/ChangeLog Mon Aug 13 09:21:54 2007 +0200 @@ -1,3 +1,129 @@ +Thu Mar 20 17:33:54 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no> + + * gnus.el: Gnus v5.4.33 is released. + +Thu Mar 20 16:01:38 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * gnus-sum.el (gnus-build-get-header): Don't fold case. + + * nnfolder.el (nnfolder-read-folder): Would always parse the + entire mbox. + + * gnus-sum.el (gnus-summary-read-group-1): Return right value. + + * gnus-start.el (gnus-slave-save-newsrc): Set file modes. + + * nneething.el (nneething-open-server): New function. + (nneething-possibly-change-directory): Redefined. + +Wed Mar 19 21:16:48 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no> + + * gnus.el: Gnus v5.4.32 is released. + +Wed Mar 19 21:06:07 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * nnmail.el (nnmail-cache-accepted-message-ids): Bogus. + +Wed Mar 19 20:53:34 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no> + + * gnus.el: Gnus v5.4.31 is released. + +Wed Mar 19 14:29:26 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * nnmh.el (nnmh-request-accept-article): Ditto. + + * nnbabyl.el (nnbabyl-request-accept-article): Ditto. + + * nnmbox.el (nnmbox-request-accept-article): Ditto. + + * nnfolder.el (nnfolder-request-accept-article): Ditto. + + * nnml.el (nnml-request-accept-article): Cache or not. + + * gnus-sum.el (gnus-summary-read-group): Don't recurse. + (gnus-summary-ignore-duplicates): New variable. + (gnus-get-newsgroup-headers): Use it. + (gnus-nov-parse-line): Ditto. + + * message.el (message-reply): Remove excessive white space in + headers. + + * nnfolder.el (nnfolder-read-folder): Work when ignoring active + file. + + * nnmail.el (nnmail-process-unix-mail-format): Narrow to the right + portion. + (nnmail-process-mmdf-mail-format): Ditto. + + * gnus.el (gnus-group-remove-parameter): New function. + (gnus-group-set-parameter): Use it. + (gnus-group-add-parameter): Ditto. + + * gnus-msg.el (gnus-post-news): Check first whether + to-list/to-address exists before adding. + +Tue Mar 18 23:54:17 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no> + + * gnus.el: Gnus v5.4.30 is released. + +Tue Mar 18 23:43:50 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * gnus-group.el (gnus-group-subscribe): Doc fix. + +Tue Mar 18 23:39:08 1997 Lance A. Brown <brown9@niehs.nih.gov> + + * gnus-sum.el (gnus-update-marks): Articles->list. + +Tue Mar 18 23:07:35 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * gnus-sum.el (gnus-summary-update-article-line): Don't pass nil + on as subject string. + + * gnus-group.el (gnus-group-read-group): Revert to old + definition. + + * gnus-sum.el (gnus-summary-read-group-1): New function. + (gnus-summary-read-group): Use it. + +Tue Mar 18 17:56:26 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no> + + * gnus.el: Gnus v5.4.29 is released. + +Tue Mar 18 14:29:49 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * gnus-group.el (gnus-group-read-ephemeral-group): Would set virt + ser too much. + (gnus-group-read-group): Return right value. + + * nnml.el (nnml-generate-nov-databases-1): Save active. + + * gnus-msg.el (gnus-summary-supersede-article): Place point in the + with buffer. + (gnus-inews-add-to-address): Prompt before adding. + + * gnus-art.el (article-strip-leading-space): Not a new command + and keystroke (HTDW Jaari fix). + + * nnfolder.el (nnfolder-close-group): Don't push bogus entries + onto alist. + +Tue Mar 18 14:28:27 1997 Jan Vroonhof <vroonhof@math.ethz.ch> + + * nnfolder.el (nnfolder-request-scan): Check whether buffer really + is live. + +Tue Mar 18 13:53:00 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * gnus-group.el (gnus-group-read-group): Iterate instead of + recurse. + + * nnfolder.el (nnfolder-request-accept-article): Don't insert into + Message-ID cache. + * nnbabyl.el (nnbabyl-request-accept-article): Ditto. + * nnmbox.el (nnmbox-request-accept-article): Ditto. + * nnml.el (nnml-request-accept-article): Ditto. + * nnmh.el (nnmh-request-accept-article): Ditto. + Tue Mar 18 00:35:06 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no> * gnus.el: Gnus v5.4.28 is released.
--- a/lisp/gnus/gnus-art.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/gnus/gnus-art.el Mon Aug 13 09:21:54 2007 +0200 @@ -1018,6 +1018,17 @@ (while (re-search-forward "\n\n\n+" nil t) (replace-match "\n\n" t t))))) +(defun article-strip-leading-space () + "Remove all white space from the beginning of the lines in the article." + (interactive) + (save-excursion + (let ((inhibit-point-motion-hooks t) + buffer-read-only) + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (while (re-search-forward "^[ \t]+" nil t) + (replace-match "" t t))))) + (defun article-strip-blank-lines () "Strip leading, trailing and multiple blank lines." (interactive) @@ -1669,6 +1680,7 @@ article-remove-trailing-blank-lines article-strip-leading-blank-lines article-strip-multiple-blank-lines + article-strip-leading-space article-strip-blank-lines article-date-local article-date-original
--- a/lisp/gnus/gnus-group.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/gnus/gnus-group.el Mon Aug 13 09:21:54 2007 +0200 @@ -1563,9 +1563,9 @@ (require (car method)) (when (boundp saddr) (unless (assq saddr method) - (nconc method `((,saddr ,(cadr method))))) - (setf (cadr method) (format "%s-%d" (cadr method) - (incf gnus-ephemeral-group-server))))) + (nconc method `((,saddr ,(cadr method)))) + (setf (cadr method) (format "%s-%d" (cadr method) + (incf gnus-ephemeral-group-server)))))) (let ((group (if (gnus-group-foreign-p group) group (gnus-group-prefixed-name group method)))) (gnus-sethash @@ -2538,7 +2538,7 @@ (gnus-group-unsubscribe-current-group n 'unsubscribe)) (defun gnus-group-subscribe (&optional n) - "Unsubscribe the current group." + "Subscribe the current group." (interactive "P") (gnus-group-unsubscribe-current-group n 'subscribe))
--- a/lisp/gnus/gnus-msg.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/gnus/gnus-msg.el Mon Aug 13 09:21:54 2007 +0200 @@ -308,13 +308,10 @@ (message-supersede) (push `((lambda () - (gnus-cache-possibly-remove-article ,article nil nil nil t))) - message-send-actions) - (push - `((lambda () (when (buffer-name (get-buffer ,gnus-summary-buffer)) (save-excursion (set-buffer (get-buffer ,gnus-summary-buffer)) + (gnus-cache-possibly-remove-article ,article nil nil nil t) (gnus-summary-mark-as-read ,article gnus-canceled-mark))))) message-send-actions)))) @@ -407,8 +404,10 @@ (message-mail (or to-address to-list)) ;; Arrange for mail groups that have no `to-address' to ;; get that when the user sends off the mail. - (push (list 'gnus-inews-add-to-address pgroup) - message-send-actions)) + (when (and (not to-list) + (not to-address)) + (push (list 'gnus-inews-add-to-address pgroup) + message-send-actions))) (set-buffer gnus-article-copy) (message-wide-reply to-address))) (when yank @@ -726,7 +725,9 @@ (gnus-alive-p)) ;; This mail group doesn't have a `to-list', so we add one ;; here. Magic! - (gnus-group-add-parameter group (cons 'to-list to-address))))) + (when (gnus-y-or-n-p + (format "Do you want to add this as `to-list': %s " to-address)) + (gnus-group-add-parameter group (cons 'to-list to-address)))))) (defun gnus-put-message () "Put the current message in some group and return to Gnus."
--- a/lisp/gnus/gnus-start.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/gnus/gnus-start.el Mon Aug 13 09:21:54 2007 +0200 @@ -943,7 +943,6 @@ gnus-active-hashtb) (when new-newsgroups (gnus-subscribe-hierarchical-interactive new-newsgroups)) - ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>. (if (> groups 0) (gnus-message 5 "%d new newsgroup%s arrived." groups (if (> groups 1) "s have" " has")) @@ -2304,7 +2303,8 @@ (set-buffer gnus-dribble-buffer) (let ((slave-name (make-temp-name (concat gnus-current-startup-file "-slave-")))) - (gnus-write-buffer slave-name)))) + (gnus-write-buffer slave-name) + (set-file-modes slave-name (file-modes gnus-current-startup-file))))) (defun gnus-master-read-slave-newsrc () (let ((slave-files
--- a/lisp/gnus/gnus-sum.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/gnus/gnus-sum.el Mon Aug 13 09:21:54 2007 +0200 @@ -288,6 +288,11 @@ :group 'gnus-article-headers :type 'boolean) +(defcustom gnus-summary-ignore-duplicates nil + "*If non-nil, ignore articles with identical Message-ID headers." + :group 'gnus-summary + :type 'boolean) + (defcustom gnus-single-article-buffer t "*If non-nil, display all articles in the same buffer. If nil, each group will get its own article buffer." @@ -1312,7 +1317,8 @@ "t" gnus-article-remove-trailing-blank-lines "l" gnus-article-strip-leading-blank-lines "m" gnus-article-strip-multiple-blank-lines - "a" gnus-article-strip-blank-lines) + "a" gnus-article-strip-blank-lines + "s" gnus-article-strip-leading-space) (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map) "v" gnus-version @@ -1514,7 +1520,8 @@ ["Leading" gnus-article-strip-leading-blank-lines t] ["Multiple" gnus-article-strip-multiple-blank-lines t] ["Trailing" gnus-article-remove-trailing-blank-lines t] - ["All of the above" gnus-article-strip-blank-lines t]) + ["All of the above" gnus-article-strip-blank-lines t] + ["Leading space" gnus-article-strip-leading-space t]) ["Overstrike" gnus-article-treat-overstrike t] ["Emphasis" gnus-article-emphasize t] ["Word wrap" gnus-article-fill-cited-article t] @@ -2460,6 +2467,22 @@ If SHOW-ALL is non-nil, already read articles are also listed. If NO-ARTICLE is non-nil, no article is selected initially. If NO-DISPLAY, don't generate a summary buffer." + (let (result) + (while (and group + (null (setq result + (let ((gnus-auto-select-next nil)) + (gnus-summary-read-group-1 + group show-all no-article + kill-buffer no-display)))) + (eq gnus-auto-select-next 'quietly)) + (set-buffer gnus-group-buffer) + (if (not (equal group (gnus-group-group-name))) + (setq group (gnus-group-group-name)) + (setq group nil))) + result)) + +(defun gnus-summary-read-group-1 (group show-all no-article + kill-buffer no-display) ;; Killed foreign groups can't be entered. (when (and (not (gnus-group-native-p group)) (not (gnus-gethash group gnus-newsrc-hashtb))) @@ -2560,7 +2583,7 @@ (not no-display)) (progn ;; This newsgroup is empty. - (gnus-summary-catchup-and-exit nil t) ;Without confirmations. + (gnus-summary-catchup-and-exit nil t) (gnus-message 6 "No unread news") (when kill-buffer (gnus-kill-or-deaden-summary kill-buffer)) @@ -2596,10 +2619,10 @@ (select-window (get-buffer-window gnus-group-buffer t)) (when (gnus-group-goto-group group) (recenter)) - (select-window owin)))) - ;; Mark this buffer as "prepared". - (setq gnus-newsgroup-prepared t) - t)))) + (select-window owin))) + ;; Mark this buffer as "prepared". + (setq gnus-newsgroup-prepared t) + t))))) (defun gnus-summary-prepare () "Generate the summary buffer." @@ -2869,19 +2892,21 @@ (prog1 (save-excursion (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while (and (not found) (search-forward id nil t)) - (beginning-of-line) - (setq found (looking-at - (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s" - (regexp-quote id)))) - (or found (beginning-of-line 2))) - (when found - (beginning-of-line) - (and - (setq header (gnus-nov-parse-line - (read (current-buffer)) deps)) - (gnus-parent-id (mail-header-references header))))) + (let ((case-fold-search nil)) + (goto-char (point-min)) + (while (and (not found) + (search-forward id nil t)) + (beginning-of-line) + (setq found (looking-at + (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s" + (regexp-quote id)))) + (or found (beginning-of-line 2))) + (when found + (beginning-of-line) + (and + (setq header (gnus-nov-parse-line + (read (current-buffer)) deps)) + (gnus-parent-id (mail-header-references header)))))) (when header (let ((number (mail-header-number header))) (push number gnus-newsgroup-limit) @@ -2916,17 +2941,18 @@ (memq article gnus-newsgroup-expirable) ;; Only insert the Subject string when it's different ;; from the previous Subject string. - (unless (gnus-subject-equal - (condition-case () - (mail-header-subject - (gnus-data-header - (cadr - (gnus-data-find-list - article - (gnus-data-list t))))) - (error "")) - (mail-header-subject header)) - (mail-header-subject header)) + (if (gnus-subject-equal + (condition-case () + (mail-header-subject + (gnus-data-header + (cadr + (gnus-data-find-list + article + (gnus-data-list t))))) + (error "")) + (mail-header-subject header)) + (mail-header-subject header) + "") nil (cdr (assq article gnus-newsgroup-scored)) (memq article gnus-newsgroup-processable)) (when length @@ -3832,7 +3858,7 @@ gnus-save-score list) (let* ((arts list) - (prev (cons nil articles)) + (prev (cons nil list)) (all prev)) (while arts (if (or (not (consp (car arts))) @@ -4178,9 +4204,20 @@ (if (boundp (setq id-dep (intern id dependencies))) (if (and (car (symbol-value id-dep)) (not force-new)) - ;; An article with this Message-ID has already been seen, - ;; so we rename the Message-ID. - (progn + ;; An article with this Message-ID has already been seen. + (if gnus-summary-ignore-duplicates + ;; We ignore this one, except we add + ;; any additional Xrefs (in case the two articles + ;; came from different servers). + (progn + (mail-header-set-xref + (car (symbol-value id-dep)) + (concat (or (mail-header-xref + (car (symbol-value id-dep))) + "") + (or (mail-header-xref header) ""))) + (setq header nil)) + ;; We rename the Message-ID. (set (setq id-dep (intern (setq id (nnmail-message-id)) dependencies)) @@ -4267,9 +4304,20 @@ (if (boundp (setq id-dep (intern id dependencies))) (if (and (car (symbol-value id-dep)) (not force-new)) - ;; An article with this Message-ID has already been seen, - ;; so we rename the Message-ID. - (progn + ;; An article with this Message-ID has already been seen. + (if gnus-summary-ignore-duplicates + ;; We ignore this one, except we add any additional + ;; Xrefs (in case the two articles came from different + ;; servers. + (progn + (mail-header-set-xref + (car (symbol-value id-dep)) + (concat (or (mail-header-xref + (car (symbol-value id-dep))) + "") + (or (mail-header-xref header) ""))) + (setq header nil)) + ;; We rename the Message-ID. (set (setq id-dep (intern (setq id (nnmail-message-id)) dependencies))
--- a/lisp/gnus/gnus.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/gnus/gnus.el Mon Aug 13 09:21:54 2007 +0200 @@ -226,7 +226,7 @@ :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "5.4.28" +(defconst gnus-version-number "5.4.33" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) @@ -2244,8 +2244,8 @@ (defun gnus-group-add-parameter (group param) "Add parameter PARAM to GROUP." (let ((info (gnus-get-info group))) - (if (not info) - () ; This is a dead group. We just ignore it. + (when info + (gnus-group-remove-parameter group (if (consp param) (car param) param)) ;; Cons the new param to the old one and update. (gnus-group-set-info (cons param (gnus-info-params info)) group 'params)))) @@ -2253,8 +2253,8 @@ (defun gnus-group-set-parameter (group name value) "Set parameter NAME to VALUE in GROUP." (let ((info (gnus-get-info group))) - (if (not info) - () ; This is a dead group. We just ignore it. + (when info + (gnus-group-remove-parameter group name) (let ((old-params (gnus-info-params info)) (new-params (list (cons name value)))) (while old-params @@ -2264,6 +2264,17 @@ (setq old-params (cdr old-params))) (gnus-group-set-info new-params group 'params))))) +(defun gnus-group-remove-parameter (group name) + "Remove parameter NAME from GROUP." + (let ((info (gnus-get-info group))) + (when info + (let ((params (gnus-info-params info))) + (when params + (setq params (delq name params)) + (while (assq name params) + (setq params (delq (assq name params) params))) + (gnus-info-set-params info params)))))) + (defun gnus-group-add-score (group &optional score) "Add SCORE to the GROUP score. If SCORE is nil, add 1 to the score of GROUP."
--- a/lisp/gnus/md5.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/gnus/md5.el Mon Aug 13 09:21:54 2007 +0200 @@ -11,7 +11,7 @@ ;; This is a direct translation into Emacs LISP of the reference C ;; implementation of the MD5 Message-Digest Algorithm written by RSA ;; Data Security, Inc. -;; +;; ;; The algorithm takes a message (that is, a string of bytes) and ;; computes a 16-byte checksum or "digest" for the message. This digest ;; is supposed to be cryptographically strong in the sense that if you @@ -20,7 +20,7 @@ ;; space of messages. However, the robustness of the algorithm has not ;; been proven, and a similar algorithm (MD4) was shown to be unsound, ;; so treat with caution! -;; +;; ;; The C algorithm uses 32-bit integers; because GNU Emacs ;; implementations provide 28-bit integers (with 24-bit integers on ;; versions prior to 19.29), the code represents a 32-bit integer as the @@ -33,12 +33,12 @@ ;; To compute the MD5 Message Digest for a message M (represented as a ;; string or as a vector of bytes), call -;; +;; ;; (md5-encode M) -;; +;; ;; which returns the message digest as a vector of 16 bytes. If you ;; need to supply the message in pieces M1, M2, ... Mn, then call -;; +;; ;; (md5-init) ;; (md5-update M1) ;; (md5-update M2) @@ -50,17 +50,17 @@ ;; Copyright (C) 1995 by Gareth Rees ;; Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm -;; +;; ;; md5.el is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by the ;; Free Software Foundation; either version 2, or (at your option) any ;; later version. -;; +;; ;; md5.el is distributed in the hope that it will be useful, but WITHOUT ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;; for more details. -;; +;; ;; The original copyright notice is given below, as required by the ;; licence for the original code. This code is distributed under *both* ;; RSA's original licence and the GNU General Public Licence. (There @@ -155,9 +155,9 @@ ;; for rounds 1, 2, 3 and 4 respectively. Each function follows this ;; pattern of computation (where ROTATE(x,y) means rotate 32-bit value x ;; by y bits to the left): -;; +;; ;; FF(a,b,c,d,x,s,ac) = ROTATE(a + F(b,c,d) + x + ac,s) + b -;; +;; ;; so we use the macro `md5-make-step' to construct each one. The ;; helper functions F, G, H and I operate on 16-bit numbers; the full ;; operation splits its inputs, operates on the halves separately and @@ -190,7 +190,7 @@ (md5-make-step md5-II md5-I) (defun md5-init () - "Initialize the state of the message-digest routines." + "Initialise the state of the message-digest routines." (aset md5-bits 0 0) (aset md5-bits 1 0) (aset md5-bits 2 0) @@ -360,51 +360,49 @@ c (md5-II c d a b (aref in 2) 15 '(10967 . 53947)) b (md5-II b c d a (aref in 9) 21 '(60294 . 54161))) - (aset md5-buffer 0 (md5-add (aref md5-buffer 0) a)) - (aset md5-buffer 1 (md5-add (aref md5-buffer 1) b)) - (aset md5-buffer 2 (md5-add (aref md5-buffer 2) c)) - (aset md5-buffer 3 (md5-add (aref md5-buffer 3) d)))) + (aset md5-buffer 0 (md5-add (aref md5-buffer 0) a)) + (aset md5-buffer 1 (md5-add (aref md5-buffer 1) b)) + (aset md5-buffer 2 (md5-add (aref md5-buffer 2) c)) + (aset md5-buffer 3 (md5-add (aref md5-buffer 3) d)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Here begins the merger with the XEmacs API and the md5.el from the URL ;;; package. Courtesy wmperry@spry.com ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(eval-and-compile - (unless (fboundp 'md5) - (defun md5 (object &optional start end) - "Return the MD5 (a secure message digest algorithm) of an object. +(defun md5 (object &optional start end) + "Return the MD5 (a secure message digest algorithm) of an object. OBJECT is either a string or a buffer. Optional arguments START and END denote buffer positions for computing the hash of a portion of OBJECT." - (let ((buffer nil)) - (unwind-protect - (save-excursion - (setq buffer (generate-new-buffer " *md5-work*")) - (set-buffer buffer) - (cond - ((bufferp object) - (insert-buffer-substring object start end)) - ((stringp object) - (insert (if (or start end) - (substring object start end) - object))) - (t nil)) - (prog1 - (if (<= (point-max) md5-maximum-internal-length) - (mapconcat - (function (lambda (node) (format "%02x" node))) - (md5-encode (buffer-string)) - "") - (call-process-region (point-min) (point-max) - (or shell-file-name "/bin/sh") - t buffer nil - "-c" md5-program) - ;; MD5 digest is 32 chars long - ;; mddriver adds a newline to make neaten output for tty - ;; viewing, make sure we leave it behind. - (buffer-substring (point-min) (+ (point-min) 32))) - (kill-buffer buffer))) - (and buffer (kill-buffer buffer) nil)))))) + (let ((buffer nil)) + (unwind-protect + (save-excursion + (setq buffer (generate-new-buffer " *md5-work*")) + (set-buffer buffer) + (cond + ((bufferp object) + (insert-buffer-substring object start end)) + ((stringp object) + (insert (if (or start end) + (substring object start end) + object))) + (t nil)) + (prog1 + (if (<= (point-max) md5-maximum-internal-length) + (mapconcat + (function (lambda (node) (format "%02x" node))) + (md5-encode (buffer-string)) + "") + (call-process-region (point-min) (point-max) + (or shell-file-name "/bin/sh") + t buffer nil + "-c" md5-program) + ;; MD5 digest is 32 chars long + ;; mddriver adds a newline to make neaten output for tty + ;; viewing, make sure we leave it behind. + (buffer-substring (point-min) (+ (point-min) 32))) + (kill-buffer buffer))) + (and buffer (kill-buffer buffer) nil)))) (provide 'md5)
--- a/lisp/gnus/message.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/gnus/message.el Mon Aug 13 09:21:54 2007 +0200 @@ -3007,6 +3007,9 @@ (insert (if (bolp) "" ", ") (or to "")) (insert (if mct (concat (if (bolp) "" ", ") mct) "")) (insert (if cc (concat (if (bolp) "" ", ") cc) "")) + (goto-char (point-min)) + (while (re-search-forward "[ \t]+" nil t) + (replace-match " " t t)) ;; Remove addresses that match `rmail-dont-reply-to-names'. (insert (prog1 (rmail-dont-reply-to (buffer-string)) (erase-buffer)))
--- a/lisp/gnus/nnbabyl.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/gnus/nnbabyl.el Mon Aug 13 09:21:54 2007 +0200 @@ -333,7 +333,8 @@ (save-excursion (while (re-search-backward "^X-Gnus-Newsgroup: " beg t) (delete-region (point) (progn (forward-line 1) (point))))) - (nnmail-cache-insert (nnmail-fetch-field "message-id")) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-insert (nnmail-fetch-field "message-id"))) (setq result (car (nnbabyl-save-mail (if (stringp group) (list (cons group (nnbabyl-active-number group))) @@ -344,7 +345,8 @@ (goto-char (match-end 0)) (insert-buffer-substring buf) (when last - (nnmail-cache-insert (nnmail-fetch-field "message-id")) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-insert (nnmail-fetch-field "message-id"))) (save-buffer) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) result))))
--- a/lisp/gnus/nneething.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/gnus/nneething.el Mon Aug 13 09:21:54 2007 +0200 @@ -55,7 +55,6 @@ "Current news group directory.") (defvoo nneething-status-string "") -(defvoo nneething-group-alist nil) (defvoo nneething-message-id-number 0) (defvoo nneething-work-buffer " *nneething work*") @@ -151,28 +150,27 @@ (setq nneething-current-directory nil) t) +(deffoo nneething-open-server (server &optional defs) + (nnheader-init-server-buffer) + (if (nneething-server-opened server) + t + (unless (assq 'nneething-directory defs) + (setq defs (append defs (list (list 'nneething-directory server))))) + (nnoo-change-server 'nneething server defs))) + ;;; Internal functions. -(defun nneething-possibly-change-directory (group &optional dir) - (when group - (if (and nneething-group - (string= group nneething-group)) - t - (let (entry) - (if (setq entry (assoc group nneething-group-alist)) - (progn - (setq nneething-group group) - (setq nneething-directory (nth 1 entry)) - (setq nneething-map (nth 2 entry)) - (setq nneething-active (nth 3 entry))) - (setq nneething-group group) - (setq nneething-directory dir) - (setq nneething-map nil) - (setq nneething-active (cons 1 0)) - (nneething-create-mapping) - (push (list group dir nneething-map nneething-active) - nneething-group-alist)))))) +(defun nneething-possibly-change-directory (group &optional server) + (when (and server + (not (nneething-server-opened server))) + (nneething-open-server server)) + (when (and group + (not (equal nneething-group group))) + (setq nneething-group group) + (setq nneething-map nil) + (setq nneething-active (cons 1 0)) + (nneething-create-mapping))) (defun nneething-map-file () ;; We make sure that the .nneething directory exists.
--- a/lisp/gnus/nnfolder.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/gnus/nnfolder.el Mon Aug 13 09:21:54 2007 +0200 @@ -225,7 +225,7 @@ (let ((bufs nnfolder-buffer-alist)) (save-excursion (while bufs - (if (not (buffer-name (nth 1 (car bufs)))) + (if (not (buffer-live-p (nth 1 (car bufs)))) (setq nnfolder-buffer-alist (delq (car bufs) nnfolder-buffer-alist)) (set-buffer (nth 1 (car bufs))) @@ -246,7 +246,8 @@ (equal group nnfolder-current-group)) (let ((inf (assoc group nnfolder-buffer-alist))) (when inf - (when nnfolder-current-group + (when (and nnfolder-current-group + nnfolder-current-buffer) (push (list nnfolder-current-group nnfolder-current-buffer) nnfolder-buffer-alist)) (setq nnfolder-buffer-alist @@ -374,7 +375,8 @@ (forward-line -1) (while (re-search-backward (concat "^" nnfolder-article-marker) nil t) (delete-region (point) (progn (forward-line 1) (point)))) - (nnmail-cache-insert (nnmail-fetch-field "message-id")) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-insert (nnmail-fetch-field "message-id"))) (setq result (car (nnfolder-save-mail (if (stringp group) @@ -385,7 +387,8 @@ (save-excursion (nnfolder-possibly-change-folder (or (caar art-group) group)) (nnfolder-save-buffer) - (nnmail-cache-close)))) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-close))))) (nnmail-save-active nnfolder-group-alist nnfolder-active-file) (unless result (nnheader-report 'nnfolder "Couldn't store article")) @@ -644,7 +647,8 @@ (let ((delim (concat "^" message-unix-mail-delimiter)) (marker (concat "\n" nnfolder-article-marker)) (number "[0-9]+") - (active (cadr (assoc group nnfolder-group-alist))) + (active (or (cadr (assoc group nnfolder-group-alist)) + (cons 1 0))) (scantime (assoc group nnfolder-scantime-alist)) (minid (lsh -1 -1)) maxid start end newscantime @@ -677,10 +681,8 @@ (when (not (or nnfolder-distrust-mbox (< maxid 2))) (goto-char (point-max)) - (if (not (re-search-backward marker nil t)) - (goto-char (point-min)) - (when (not (nnmail-search-unix-mail-delim)) - (goto-char (point-min))))) + (unless (re-search-backward marker nil t) + (goto-char (point-min)))) ;; Keep track of the active number on our own, and insert it back ;; into the active list when we're done. Also, prime the pump to
--- a/lisp/gnus/nnmail.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/gnus/nnmail.el Mon Aug 13 09:21:54 2007 +0200 @@ -160,6 +160,11 @@ :type '(choice (const :tag "nnmail-expiry-wait" nil) (function :format "%v" nnmail-))) +(defcustom nnmail-cache-accepted-message-ids nil + "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache." + :group 'nnmail + :type 'boolean) + (defcustom nnmail-spool-file (or (getenv "MAIL") (concat "/usr/spool/mail/" (user-login-name))) @@ -853,8 +858,8 @@ ;; if there is no head-body delimiter, we search a bit manually. (while (and (looking-at "From \\|[^ \t]+:") (not (eobp))) - (forward-line 1) - (point)))) + (forward-line 1)) + (point))) ;; Find the Message-ID header. (goto-char (point-min)) (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t) @@ -937,8 +942,8 @@ ;; if there is no head-body delimiter, we search a bit manually. (while (and (looking-at "From \\|[^ \t]+:") (not (eobp))) - (forward-line 1) - (point)))) + (forward-line 1)) + (point))) ;; Find the Message-ID header. (goto-char (point-min)) (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t)
--- a/lisp/gnus/nnmbox.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/gnus/nnmbox.el Mon Aug 13 09:21:54 2007 +0200 @@ -304,7 +304,8 @@ (forward-line -1) (while (re-search-backward "^X-Gnus-Newsgroup: " nil t) (delete-region (point) (progn (forward-line 1) (point)))) - (nnmail-cache-insert (nnmail-fetch-field "message-id")) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-insert (nnmail-fetch-field "message-id"))) (setq result (nnmbox-save-mail (if (stringp group) (list (cons group (nnmbox-active-number group))) @@ -314,7 +315,8 @@ (goto-char (point-max)) (insert-buffer-substring buf) (when last - (nnmail-cache-close) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-close)) (nnmail-save-active nnmbox-group-alist nnmbox-active-file) (save-buffer)))) (car result)))
--- a/lisp/gnus/nnmh.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/gnus/nnmh.el Mon Aug 13 09:21:54 2007 +0200 @@ -290,7 +290,8 @@ (deffoo nnmh-request-accept-article (group &optional server last noinsert) (nnmh-possibly-change-directory group server) (nnmail-check-syntax) - (nnmail-cache-insert (nnmail-fetch-field "message-id")) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-insert (nnmail-fetch-field "message-id"))) (prog1 (if (stringp group) (and @@ -302,7 +303,7 @@ (nnmail-activate 'nnmh) (car (nnmh-save-mail (nnmail-article-group 'nnmh-active-number) noinsert)))) - (when last + (when (and last nnmail-cache-accepted-message-ids) (nnmail-cache-close)))) (deffoo nnmh-request-replace-article (article group buffer)
--- a/lisp/gnus/nnml.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/gnus/nnml.el Mon Aug 13 09:21:54 2007 +0200 @@ -313,7 +313,8 @@ (nnml-possibly-change-directory group server) (nnmail-check-syntax) (let (result) - (nnmail-cache-insert (nnmail-fetch-field "message-id")) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-insert (nnmail-fetch-field "message-id"))) (if (stringp group) (and (nnmail-activate 'nnml) @@ -328,7 +329,8 @@ (nnmail-article-group 'nnml-active-number)))) (when last (nnmail-save-active nnml-group-alist nnml-active-file) - (nnmail-cache-close) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-close)) (nnml-save-nov)))) result)) @@ -682,11 +684,11 @@ (nnml-open-server (or (nnoo-current-server 'nnml) "")) (setq nnml-directory (expand-file-name nnml-directory)) ;; Recurse down the directories. - (nnml-generate-nov-databases-1 nnml-directory) + (nnml-generate-nov-databases-1 nnml-directory nil t) ;; Save the active file. (nnmail-save-active nnml-group-alist nnml-active-file)) -(defun nnml-generate-nov-databases-1 (dir &optional seen) +(defun nnml-generate-nov-databases-1 (dir &optional seen no-active) "Regenerate the NOV database in DIR." (interactive "DRegenerate NOV in: ") (setq dir (file-name-as-directory dir)) @@ -706,7 +708,9 @@ (when files (funcall nnml-generate-active-function dir) ;; Generate the nov file. - (nnml-generate-nov-file dir files))))) + (nnml-generate-nov-file dir files) + (unless no-active + (nnmail-save-active nnml-group-alist nnml-active-file)))))) (defvar files) (defun nnml-generate-active-info (dir)
--- a/lisp/gnus/pop3.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/gnus/pop3.el Mon Aug 13 09:21:54 2007 +0200 @@ -4,7 +4,7 @@ ;; Author: Richard L. Pieri <ratinox@peorth.gweep.net> ;; Keywords: mail, pop3 -;; Version: 1.3 +;; Version: 1.3c ;; This file is part of GNU Emacs. @@ -37,8 +37,7 @@ (require 'mail-utils) (provide 'pop3) -(eval-and-compile - (if (not (fboundp 'md5)) (autoload 'md5 "md5"))) +(defconst pop3-version "1.3c") (defvar pop3-maildrop (or user-login-name (getenv "LOGNAME") (getenv "USER") nil) "*POP3 maildrop.") @@ -53,8 +52,9 @@ "*Password to use when connecting to POP server.") (defvar pop3-authentication-scheme 'pass - "*POP3 authentication scheme. Defaults to 'pass, for the standard -USER/PASS authentication. Other valid values are 'apop.") + "*POP3 authentication scheme. +Defaults to 'pass, for the standard USER/PASS authentication. Other valid +values are 'apop.") (defvar pop3-timestamp nil "Timestamp returned when initially connected to the POP server. @@ -85,9 +85,16 @@ (pop3-retr process n crashbuf) (save-excursion (set-buffer crashbuf) - (append-to-file (point-min) (point-max) crashbox)) + (append-to-file (point-min) (point-max) crashbox) + (set-buffer (process-buffer process)) + (while (> (buffer-size) 5000) + (goto-char (point-min)) + (forward-line 50) + (delete-region (point-min) (point)))) (pop3-dele process n) - (setq n (+ 1 n))) + (setq n (+ 1 n)) + (if pop3-debug (sit-for 1) (sit-for 0.1)) + ) (pop3-quit process) (kill-buffer crashbuf) ) @@ -272,8 +279,7 @@ ;; TRANSACTION STATE (defun pop3-stat (process) - "Return a list of the number of messages in the maildrop and the size -of the maildrop." + "Return the number of messages in the maildrop and the maildrop's size." (pop3-send-command process "STAT") (let ((response (pop3-read-response process t))) (list (string-to-int (nth 1 (pop3-string-to-list response))) @@ -285,8 +291,7 @@ This function currently does nothing.") (defun pop3-retr (process msg crashbuf) - "Retrieve message-id MSG from the server and place the contents in -buffer CRASHBUF." + "Retrieve message-id MSG to buffer CRASHBUF." (pop3-send-command process (format "RETR %s" msg)) (pop3-read-response process) (let ((start pop3-read-point) end) @@ -304,6 +309,11 @@ (goto-char start)) (setq pop3-read-point (point-marker)) (goto-char (match-beginning 0)) + (backward-char 2) + (if (not (looking-at "\r\n")) + (insert "\r\n")) + (re-search-forward "\\.\r\n") + (goto-char (match-beginning 0)) (setq end (point-marker)) (pop3-clean-region start end) (pop3-munge-message-separator start end) @@ -339,8 +349,9 @@ ;; UPDATE (defun pop3-quit (process) - "Tell server to remove all messages marked as deleted, unlock the -maildrop, and close the connection." + "Close connection to POP3 server. +Tell server to remove all messages marked as deleted, unlock the maildrop, +and close the connection." (pop3-send-command process "QUIT") (pop3-read-response process t) (if process
--- a/lisp/hyperbole/ChangeLog Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/ChangeLog Mon Aug 13 09:21:54 2007 +0200 @@ -1,3 +1,77 @@ +Thu Mar 13 22:01:52 1997 Bob Weiner <weiner@infodock.com> + +* wrolo.el (rolo-toggle-datestamps): Added. +* hui-mini.el (hui:menus): Added Cust/Toggle-Rolodex-Dates entry. +* hui-menu.el (hui-menu-options): Added Customization/Toggle-Rolodex-Dates + item. +* wrolo.el (rolo-add): Added wrolo-add-hook, executed after the record + is added. + (rolo-edit): Added wrolo-edit-hook, executed after point is + successfully moved to the record to edit. These can be used, for + example, to add and update date entries in address records. + (rolo-current-date): Added. + (rolo-set-date): Added and used as default wrolo-add-hook and + wrolo-edit-hook settings. + +Mon Mar 10 12:17:15 1997 Bob Weiner <weiner@infodock.com> + +* hsys-w3.el (www-url): Eliminated call of external Web browser if not + running under a window system. + +Sun Mar 9 01:32:03 1997 Bob Weiner <weiner@infodock.com> + +* hpath.el (hpath:url-at-p): + (hpath:www-at-p): Fixed bug that referred to an optional match + component without checking if it was matched. + (hpath:url-p): Changed doc to reflect that pathname can be optional. + +* hsite-ex.el: Added (require 'hyperbole) to ensure that this file + is loaded if hsite.el is autoloaded, e.g. under XEmacs. + +Thu Mar 6 14:14:05 1997 Bob Weiner <weiner@infodock.com> + +* hui-mini.el (hyperbole): Added autoload special comment. + +Wed Mar 5 01:14:47 1997 Bob Weiner <weiner@infodock.com> + +* kotl/kotl-mode.el (kotl-mode:center-line): +* kotl/kview.el (kcell-view:line): Changed calls to + kotl-mode:beginning-of-line to kotl-mode:start-of-line to avoid an + XEmacs byte compiler bug in some versions. The bug shows up when + kotl-mode:center-line is called on the first line of a cell and the + cell label is centered along with the line (the label should not + move). + +Tue Mar 4 20:45:52 1997 Bob Weiner <weiner@infodock.com> + +* hsite-ex.el (hpath:find-alist): Modified to use `xv' to display xpm + files; it is more robust than `sxpm' in the face of limited colors. + +Mon Mar 3 12:06:49 1997 Bob Weiner <weiner@infodock.com> + +* hui-menu.el (infodock-hyperbole-menu): Added :config 'Hyperbole + configurator to the menu so users can hide the Hyperbole + menu from the menubar if they don't use it, via menubar-configuration, + under XEmacs and InfoDock. + +Sun Mar 2 22:35:26 1997 Bob Weiner <weiner@infodock.com> + +* kotl/kotl-mode.el (kotl-mode:set-cell-attribute): Changed + read-expression to read-minibuffer since GNU Emacs doesn't + have the former. + +Fri Feb 28 23:31:57 1997 Bob Weiner <weiner@infodock.com> + +* kotl/kprop-xe.el (kproperty:put): Fixed problem with internal handling + of text property protocols within newer versions of XEmacs. The + `text-prop' symbol can no longer be set to `t'. It must be set to + a symbol from the property list of the extent that carries + text-properties. + +============================================================================== +V4.023 changes ^^^^: +============================================================================== + Sat Feb 22 14:30:14 1997 Bob Weiner <weiner@infodock.com> * hypb.el (hypb:ida-logo-keymap): Added conditional for Emacs keybinding.
--- a/lisp/hyperbole/Makefile Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/Makefile Mon Aug 13 09:21:54 2007 +0200 @@ -4,7 +4,7 @@ # AUTHOR: Bob Weiner # # ORIG-DATE: 15-Jun-94 at 03:42:38 -# LAST-MOD: 23-Feb-97 at 23:22:48 by Bob Weiner +# LAST-MOD: 18-Mar-97 at 00:45:58 by Bob Weiner # # This file is part of Hyperbole. # Available for use and distribution under the same terms as GNU Emacs. @@ -98,7 +98,7 @@ # NO CHANGES REQUIRED BELOW HERE. # ########################################################################## -HYPB_VERSION = 4.022 +HYPB_VERSION = 4.023 # Libraries that must be pre-loaded before trying to byte-compile anything. PRELOADS = $(SITE_PRELOADS) -l ./hversion.el -l ./hyperbole.el -l ./hsite.el
--- a/lisp/hyperbole/README Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/README Mon Aug 13 09:21:54 2007 +0200 @@ -11,7 +11,7 @@ # Tel: +1 408-243-3300 # # ORIG-DATE: 19-Oct-91 at 03:27:47 -# LAST-MOD: 23-Feb-97 at 23:25:29 by Bob Weiner +# LAST-MOD: 17-Mar-97 at 21:14:10 by Bob Weiner # # See the Copyright section below for license information. @@ -165,13 +165,16 @@ =========================================================================== -* What's New in V4.02-V4.022 +* What's New in V4.02-V4.023 =========================================================================== (See "ChangeLog" for more complete details of changes.) ACTION AND ASSIST KEYS + - Action Key clicks on HTTP URLs use the Emacs internal web browser + if not running under a window system. + - Support for new ID-edit mode (a part of InfoDock) that allows rapid, cutting, copying and yanking of regions plus fast display management. In this mode, the Action and Assist keys yank the previously selected @@ -231,6 +234,14 @@ ROLODEX + - Date stamps are added to each rolodex entry when created and updated + when edited. This feature can be toggled on and off with: + M-x rolo-toggle-datestamps RET, or via the Toggle-Rolodex-Dates menu + item on the Customization menu. + + - wrolo-add-hook is called after a new entry is added. + wrolo-edit-hook is called after an entry is displayed for editing. + - Rolo-edit, bound to {e} in the rolodex match buffer, now works properly if the rolodex is loaded before the rest of the Hyperbole system.
--- a/lisp/hyperbole/hpath.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/hpath.el Mon Aug 13 09:21:54 2007 +0200 @@ -9,7 +9,7 @@ ;; ORG: InfoDock Associates ;; ;; ORIG-DATE: 1-Nov-91 at 00:44:23 -;; LAST-MOD: 16-Feb-97 at 02:34:35 by Bob Weiner +;; LAST-MOD: 20-Mar-97 at 11:52:51 by Bob Weiner ;;; ************************************************************************ ;;; Public variables @@ -552,15 +552,15 @@ 4 = optional username 4 = host and domain to connect to 5 = optional port number to use - 6 = pathname to access." - ;; WWW URL format: [URL:]<protocol>:/[<user>@]<domain>[:<port>]/<path> - ;; or [URL:]<protocol>://[<user>@]<domain>[:<port>]<path> + 6 = optional pathname to access." + ;; WWW URL format: [URL:]<protocol>:/[<user>@]<domain>[:<port>][/<path>] + ;; or [URL:]<protocol>://[<user>@]<domain>[:<port>][<path>] ;; Avoid [a-z]:/path patterns since these may be disk paths on OS/2, DOS or ;; Windows. (if (looking-at "\\(URL:\\)?\\([a-zA-Z][a-zA-Z]+\\)://?\\([^@/: \t\n\^M]+@\\)?\\([^/:@ \t\n\^M\"`']+\\)\\(:[0-9]+\\)?\\([/~][^]@ \t\n\^M\"`'\)\}>]*\\)?") (save-excursion - (goto-char (match-end 6)) - (skip-chars-backward ".?#!*()") + (goto-char (match-end 0)) + (skip-chars-backward ".,?#!*()") (buffer-substring (match-beginning 2) (point))))) (defun hpath:url-p (obj) @@ -571,9 +571,9 @@ 3 = optional username 4 = host and domain to connect to 5 = optional port number to use - 6 = pathname to access." - ;; WWW URL format: [URL:]<protocol>:/[<user>@]<domain>[:<port>]/<path> - ;; or [URL:]<protocol>://[<user>@]<domain>[:<port>]<path> + 6 = optional pathname to access." + ;; WWW URL format: [URL:]<protocol>:/[<user>@]<domain>[:<port>][/<path>] + ;; or [URL:]<protocol>://[<user>@]<domain>[:<port>][<path>] ;; Avoid [a-z]:/path patterns since these may be disk paths on OS/2, DOS or ;; Windows. (and (stringp obj) @@ -590,9 +590,9 @@ (cond ((not include-start-and-end-p) (hpath:url-at-p)) ((hpath:url-at-p) - (list (buffer-substring (match-beginning 2) (match-end 6)) + (list (buffer-substring (match-beginning 2) (match-end 0)) (match-beginning 2) - (match-end 6)))))) + (match-end 0)))))) (defun hpath:www-p (path) "Returns non-nil iff PATH is a world-wide-web link reference."
--- a/lisp/hyperbole/hsite-ex.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/hsite-ex.el Mon Aug 13 09:21:54 2007 +0200 @@ -9,7 +9,7 @@ ;; ORG: InfoDock Associates ;; ;; ORIG-DATE: 15-Apr-91 at 00:48:49 -;; LAST-MOD: 17-Feb-97 at 18:34:17 by Bob Weiner +;; LAST-MOD: 8-Mar-97 at 22:52:36 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; Available for use and distribution under the same terms as GNU Emacs.
--- a/lisp/hyperbole/hsys-w3.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/hsys-w3.el Mon Aug 13 09:21:54 2007 +0200 @@ -9,7 +9,7 @@ ;; ORG: Motorola Inc. ;; ;; ORIG-DATE: 7-Apr-94 at 17:17:39 by Bob Weiner -;; LAST-MOD: 3-Nov-95 at 23:14:34 by Bob Weiner +;; LAST-MOD: 10-Mar-97 at 12:17:08 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; Available for use and distribution under the same terms as GNU Emacs. @@ -66,7 +66,9 @@ '(highlight-headers-follow-url-netscape highlight-headers-follow-url-mosaic)) (require 'highlight-headers)) - (funcall action-key-url-function url)) + (if window-system + (funcall action-key-url-function url) + (w3-fetch url))) (defun www-url:help (&optional but) "Displays history list of www nodes previously visited with the W3 browser."
--- a/lisp/hyperbole/hui-em19-b.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/hui-em19-b.el Mon Aug 13 09:21:54 2007 +0200 @@ -6,10 +6,10 @@ ;; KEYWORDS: faces, hypermedia ;; ;; AUTHOR: Bob Weiner -;; ORG: Brown U. +;; ORG: InfoDock Associates ;; ;; ORIG-DATE: 21-Aug-92 -;; LAST-MOD: 24-Oct-95 at 19:54:59 by Bob Weiner +;; LAST-MOD: 26-Feb-97 at 01:58:45 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; It is for use with GNU Emacs V19. @@ -75,7 +75,7 @@ (defun hproperty:but-add (start end face) "Add between START and END a button using FACE in current buffer. -If 'hproperty:but-emphasize-p' is non-nil when this is called, emphasize that +If `hproperty:but-emphasize-p' is non-nil when this is called, emphasize that button is selectable whenever the mouse cursor moves over it." (let ((but (make-overlay start end))) (overlay-put but 'face face) @@ -106,7 +106,7 @@ If REGEXP-MATCH is non-nil, only buttons matching this argument are highlighted. -If 'hproperty:but-emphasize-p' is non-nil when this is called, emphasize that +If `hproperty:but-emphasize-p' is non-nil when this is called, emphasize that button is selectable whenever the mouse cursor moves over it." (interactive) (hproperty:but-clear)
--- a/lisp/hyperbole/hui-menu.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/hui-menu.el Mon Aug 13 09:21:54 2007 +0200 @@ -9,7 +9,7 @@ ;; ORG: InfoDock Associates ;; ;; ORIG-DATE: 28-Oct-94 at 10:59:44 -;; LAST-MOD: 19-Feb-97 at 10:50:57 by Bob Weiner +;; LAST-MOD: 14-Mar-97 at 01:35:02 by Bob Weiner ;; ;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. ;; @@ -117,6 +117,12 @@ ["Scrolls-Proportionally" (setq smart-scroll-proportional t) :style radio :selected smart-scroll-proportional] + ) + '("----" + ["Toggle-Rolodex-Dates" rolo-toggle-datestamps + :style toggle :selected (and (boundp 'wrolo-add-hook) + (listp wrolo-add-hook) + (memq 'rolo-set-date wrolo-add-hook))] )) "Untitled menu of Hyperbole options.") @@ -126,6 +132,7 @@ (delq nil (list "Hyperbole" + :config 'Hyperbole '["About" (hypb:display-file-with-logo (expand-file-name "ABOUT" hyperb:dir)) t] '["Manual" (id-info "(hyperbole.info)Top") t]
--- a/lisp/hyperbole/hui-mini.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/hui-mini.el Mon Aug 13 09:21:54 2007 +0200 @@ -9,7 +9,7 @@ ;; ORG: InfoDock Associates ;; ;; ORIG-DATE: 15-Oct-91 at 20:13:17 -;; LAST-MOD: 6-Mar-97 at 14:08:46 by Bob Weiner +;; LAST-MOD: 17-Mar-97 at 21:28:26 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; Available for use and distribution under the same terms as GNU Emacs. @@ -99,6 +99,16 @@ "Sets where referents are displayed.") ("Smart-Key-at-Eol/" (menu . cust-eol) "Sets how scrolling via end of line presses works.") + ("Toggle-Rolo-Dates" + (if (and (boundp 'wrolo-add-hook) (listp wrolo-add-hook) + (memq 'rolo-set-date wrolo-add-hook)) + (progn (remove-hook 'wrolo-add-hook 'rolo-set-date) + (remove-hook 'wrolo-edit-hook 'rolo-set-date) + (message "Rolodex date stamps are now turned off.")) + (add-hook 'wrolo-add-hook 'rolo-set-date) + (add-hook 'wrolo-edit-hook 'rolo-set-date) + (message "Rolodex date stamps are now turned on.")) + "Toggle whether date stamps are update when rolodex entries are edited.") ("URL-Display/" (menu . cust-urls) "Sets where URLs are displayed."))) '(cust-eol . (("Smart Key press at eol scrolls>") @@ -326,7 +336,6 @@ (progn (beep) nil) (unwind-protect (progn - (require 'hyperbole) (require 'hsite) ;; Since "hui-mini" may be loaded without loading ;; all of Hyperbole. (hyperb:init-menubar)
--- a/lisp/hyperbole/hui-xe-but.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/hui-xe-but.el Mon Aug 13 09:21:54 2007 +0200 @@ -6,10 +6,10 @@ ;; KEYWORDS: faces, hypermedia ;; ;; AUTHOR: Bob Weiner -;; ORG: Brown U. +;; ORG: InfoDock Associates ;; ;; ORIG-DATE: 21-Aug-92 -;; LAST-MOD: 24-Oct-95 at 19:55:08 by Bob Weiner +;; LAST-MOD: 26-Feb-97 at 01:58:01 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; It is for use with XEmacs, a modified version of GNU Emacs V19. @@ -69,7 +69,7 @@ (defun hproperty:but-add (start end face) "Add between START and END a button using FACE in current buffer. -If 'hproperty:but-emphasize-p' is non-nil when this is called, emphasize that +If `hproperty:but-emphasize-p' is non-nil when this is called, emphasize that button is selectable whenever the mouse cursor moves over it." (let ((but (make-extent start end))) (set-extent-face but face) @@ -96,7 +96,7 @@ If REGEXP-MATCH is non-nil, only buttons matching this argument are highlighted. -If 'hproperty:but-emphasize-p' is non-nil when this is called, emphasize that +If `hproperty:but-emphasize-p' is non-nil when this is called, emphasize that button is selectable whenever the mouse cursor moves over it." (interactive) (hproperty:but-clear)
--- a/lisp/hyperbole/hversion.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/hversion.el Mon Aug 13 09:21:54 2007 +0200 @@ -1,6 +1,6 @@ ;;!emacs ;; -;; LCD-ENTRY: hyperbole|Bob Weiner|hyperbole@infodock.com|Everyday Info Manager|23-Feb-97|4.022|ftp://ftp.xemacs.org/pub/infodock +;; LCD-ENTRY: hyperbole|Bob Weiner|hyperbole@infodock.com|Everyday Info Manager|17-Mar-97|4.023|ftp://ftp.xemacs.org/pub/infodock ;; ;; FILE: hversion.el ;; SUMMARY: Hyperbole version, system and load path information. @@ -11,7 +11,7 @@ ;; ORG: InfoDock Associates ;; ;; ORIG-DATE: 1-Jan-94 -;; LAST-MOD: 23-Feb-97 at 23:22:37 by Bob Weiner +;; LAST-MOD: 17-Mar-97 at 21:08:15 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; Available for use and distribution under the same terms as GNU Emacs. @@ -26,7 +26,7 @@ ;;; Public variables ;;; ************************************************************************ -(defconst hyperb:version "04.022" "Hyperbole revision number.") +(defconst hyperb:version "04.023" "Hyperbole revision number.") ;;; Support button highlighting and flashing under XEmacs. ;;;
--- a/lisp/hyperbole/hvm.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/hvm.el Mon Aug 13 09:21:54 2007 +0200 @@ -6,10 +6,10 @@ ;; KEYWORDS: hypermedia, mail ;; ;; AUTHOR: Bob Weiner -;; ORG: Brown U. +;; ORG: InfoDock Associates ;; ;; ORIG-DATE: 10-Oct-91 at 01:51:12 -;; LAST-MOD: 31-Oct-96 at 22:36:19 by Bob Weiner +;; LAST-MOD: 20-Mar-97 at 14:52:54 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; Available for use and distribution under the same terms as GNU Emacs. @@ -372,7 +372,10 @@ ;;; Overlay this function from "vm-folder.el" called whenever new mail is ;;; incorporated so that it will highlight Hyperbole buttons when possible. ;; Returns non-nil if there were any new messages. -(defun vm-assimilate-new-messages (&optional dont-read-attributes gobble-order) +(defun vm-assimilate-new-messages (&optional + dont-read-attributes + gobble-order + labels) (let ((tail-cons (vm-last vm-message-list)) b-list new-messages) (save-excursion @@ -401,17 +404,49 @@ (setq new-messages (if tail-cons (cdr tail-cons) vm-message-list)) (vm-set-numbering-redo-start-point new-messages) (vm-set-summary-redo-start-point new-messages)) + ;; copy the new-messages list because sorting might scramble + ;; it. Also something the user does when + ;; vm-arrived-message-hook is run might affect it. + ;; vm-assimilate-new-messages returns this value so it must + ;; not be mangled. + (setq new-messages (copy-sequence new-messages)) + ;; add the labels + (if (and labels (boundp 'vm-burst-digest-messages-inherit-labels) + vm-burst-digest-messages-inherit-labels) + (let ((mp new-messages)) + (while mp + (vm-set-labels-of (car mp) (copy-sequence labels)) + (setq mp (cdr mp))))) (if vm-summary-show-threads (progn ;; get numbering and summary of new messages done now ;; so that the sort code only has to worry about the ;; changes it needs to make. (vm-update-summary-and-mode-line) - ;; copy the new-messages list because sorting might - ;; scramble it. vm-assimilate-new-messages returns - ;; this value. - (setq new-messages (copy-sequence new-messages)) (vm-sort-messages "thread"))) + (if (and vm-arrived-message-hook + new-messages + ;; tail-cons == nil means vm-message-list was empty. + ;; Thus new-messages == vm-message-list. In this + ;; case, run the hooks only if this is not the first + ;; time vm-assimilate-new-messages has been called + ;; in this folder. gobble-order non-nil is a good + ;; indicator that this is the first time because the + ;; order is gobbled only once per visit and always + ;; the first time vm-assimilate-new-messages is + ;; called. + (or tail-cons (null gobble-order))) + (let ((new-messages new-messages)) + ;; seems wise to do this so that if the user runs VM + ;; command here they start with as much of a clean + ;; slate as we can provide, given we're currently deep + ;; in the guts of VM. + (vm-update-summary-and-mode-line) + (while new-messages + (vm-run-message-hook (car new-messages) 'vm-arrived-message-hook) + (setq new-messages (cdr new-messages))))) + (vm-update-summary-and-mode-line) + (run-hooks 'vm-arrived-messages-hook) (if (and new-messages vm-virtual-buffers) (save-excursion (setq b-list vm-virtual-buffers)
--- a/lisp/hyperbole/hyperbole.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/hyperbole.el Mon Aug 13 09:21:54 2007 +0200 @@ -11,7 +11,7 @@ ;; ORG: InfoDock Associates ;; ;; ORIG-DATE: 6-Oct-92 at 11:52:51 -;; LAST-MOD: 19-Feb-97 at 10:57:44 by Bob Weiner +;; LAST-MOD: 15-Mar-97 at 17:09:40 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; Available for use and distribution under the same terms as GNU Emacs. @@ -118,7 +118,7 @@ ;;; Provides a site standard way to easily switch between the Hyperbole mouse ;;; bindings and a set of personal mouse bindings. You may instead show -;;; users how to bind this to a key via 'hyperb:init-hook' (see +;;; users how to bind this to a key via `hyperb:init-hook' (see ;;; Hyperbole Manual). ;;; (or (global-key-binding "\C-ct") @@ -130,7 +130,7 @@ (interactive "P") (if arg (assist-key) (action-key))) -;;; A value of t for 'hkey-init' below will cause the Hyperbole +;;; A value of t for `hkey-init' below will cause the Hyperbole ;;; context-sensitive keys to be bound to keyboard keys, in addition to any ;;; mouse key bindings. Comment it out or set it to nil if you don't want ;;; these bindings. Or change the bindings in the succeeding lines. @@ -407,16 +407,17 @@ ) ;;; Hyperbole rolodex main entry points. -(autoload 'rolo-add "wrolo" "Add an entry to rolodex" t) -(autoload 'rolo-display-matches "wrolo" "Redisplay previous rolodex matches" t) -(autoload 'rolo-edit "wrolo" "Edit an existing rolodex entry" t) -(autoload 'rolo-fgrep "wrolo" "Rolodex string search" t) -(autoload 'rolo-grep "wrolo" "Rolodex regexp search" t) -(autoload 'rolo-kill "wrolo" "Delete an existing rolodex entry" t) -(autoload 'rolo-logic "wrolo-logic" "Logical rolodex search filters." t) -(autoload 'rolo-sort "wrolo" "Sort rolodex entries" t) -(autoload 'rolo-word "wrolo" "Rolodex string search for a word" t) -(autoload 'rolo-yank "wrolo" "Insert a rolodex entry into current buffer" t) +(autoload 'rolo-add "wrolo" "Add an entry to rolodex" t) +(autoload 'rolo-display-matches "wrolo" "Redisplay previous rolodex matches" t) +(autoload 'rolo-edit "wrolo" "Edit an existing rolodex entry" t) +(autoload 'rolo-fgrep "wrolo" "Rolodex string search" t) +(autoload 'rolo-grep "wrolo" "Rolodex regexp search" t) +(autoload 'rolo-kill "wrolo" "Delete an existing rolodex entry" t) +(autoload 'rolo-logic "wrolo-logic" "Logical rolodex search filters." t) +(autoload 'rolo-sort "wrolo" "Sort rolodex entries" t) +(autoload 'rolo-toggle-datestamps "wrolo" "Toggle datestamp insertion." t) +(autoload 'rolo-word "wrolo" "Rolodex string search for a word" t) +(autoload 'rolo-yank "wrolo" "Insert a rolodex entry into current buffer" t) ;;; Hyperbole Key autoloads. (autoload 'Info-handle-in-note "hmous-info" @@ -485,14 +486,14 @@ ;;; ;;; Hyperbole mail composer support configuration. ;;; -(var:append 'mail-mode-hook '((lambda () (require 'hsmail)))) -(var:append 'mh-letter-mode-hook '((lambda () (require 'hsmail)))) -(var:append 'vm-mail-mode-hook '((lambda () (require 'hsmail)))) +(var:append 'mail-mode-hook (list (function (lambda () (require 'hsmail))))) +(var:append 'mh-letter-mode-hook (list (function (lambda () (require 'hsmail))))) +(var:append 'vm-mail-mode-hook (list (function (lambda () (require 'hsmail))))) ;;; ************************************************************************ ;;; Frame function aliases. ;;; ************************************************************************ -;; Create all needed 'frame-' aliases for all 'screen-' functions, e.g. +;; Create all needed `frame-' aliases for all `screen-' functions, e.g. ;; screen-width. (if (fboundp 'selected-frame) nil
--- a/lisp/hyperbole/kotl/kfile.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/kotl/kfile.el Mon Aug 13 09:21:54 2007 +0200 @@ -8,7 +8,8 @@ ;; AUTHOR: Bob Weiner & Kellie Clark ;; ;; ORIG-DATE: 10/31/93 -;; LAST-MOD: 1-Nov-95 at 00:46:41 by Bob Weiner +;; LAST-MOD: 6-Mar-97 at 01:17:51 by Bob Weiner + ;;; ************************************************************************ ;;; Other required Elisp libraries ;;; ************************************************************************ @@ -152,13 +153,13 @@ Return the new view." (let (ver-string) (cond ((not (bufferp buffer)) - (error "(kfile:read): Argument must be a buffer, '%s'." buffer)) + (error "(kfile:read): Argument must be a buffer, `%s'." buffer)) ((not existing-file-p) (kfile:create buffer)) ((progn (set-buffer buffer) (not (setq ver-string (kfile:is-p)))) - (error "(kfile:read): '%s' is not a koutline file." buffer)) + (error "(kfile:read): `%s' is not a koutline file." buffer)) ((equal ver-string "Kotl-4.0") (kfile:read-v4-or-v3 buffer nil)) ((equal ver-string "Kotl-3.0") @@ -167,7 +168,7 @@ (kfile:read-v2 buffer)) ((equal ver-string "Kotl-1.0") (error "(kfile:read): V1 koutlines are no longer supported")) - (t (error "(kfile:read): '%s' has unknown kotl version, %s." + (t (error "(kfile:read): `%s' has unknown kotl version, %s." buffer ver-string))))) (defun kfile:read-v2 (buffer) @@ -323,7 +324,7 @@ (set-marker opoint nil) nil))) -;;; Next function is adapted from 'file-write' of GNU Emacs 19, copyright FSF, +;;; Next function is adapted from `file-write' of GNU Emacs 19, copyright FSF, ;;; under the GPL. (defun kfile:write (file) "Write current outline to FILE." @@ -529,6 +530,6 @@ ;;; ************************************************************************ (defvar kfile:escape-newlines t - "Value of print-escape-newlines used by 'kfile:print-to-string' function.") + "Value of print-escape-newlines used by `kfile:print-to-string' function.") (provide 'kfile)
--- a/lisp/hyperbole/kotl/kfill.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/kotl/kfill.el Mon Aug 13 09:21:54 2007 +0200 @@ -7,7 +7,8 @@ ;; ;; AUTHOR: Bob Weiner ;; ORIG-DATE: 23-Jan-94 -;; LAST-MOD: 15-Jan-97 at 11:54:12 by Bob Weiner +;; LAST-MOD: 6-Mar-97 at 01:18:10 by Bob Weiner + ;;; ************************************************************************ ;;; Public variables ;;; ************************************************************************ @@ -103,7 +104,7 @@ (kfill:fill-paragraph arg skip-prefix-remove)))) ;;; -;;; Redefine this function so that it sets 'fill-prefix-prev' also. +;;; Redefine this function so that it sets `fill-prefix-prev' also. ;;; (defun set-fill-prefix (&optional turn-off) "Set the fill-prefix to the current line up to point.
--- a/lisp/hyperbole/kotl/kimport.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/kotl/kimport.el Mon Aug 13 09:21:54 2007 +0200 @@ -8,7 +8,8 @@ ;; AUTHOR: Bob Weiner & Kellie Clark ;; ;; ORIG-DATE: 15-Nov-93 at 11:57:05 -;; LAST-MOD: 1-Nov-95 at 23:19:09 by Bob Weiner +;; LAST-MOD: 6-Mar-97 at 01:18:33 by Bob Weiner + ;;; ************************************************************************ ;;; Other required Elisp libraries ;;; ************************************************************************ @@ -133,7 +134,7 @@ (message "Imported %d of %d Augment statements." count total))) ;;; -;;; Emacs outliner style files, leading '*' cell delimiters +;;; Emacs outliner style files, leading `*' cell delimiters ;;; ;;;###autoload @@ -213,7 +214,7 @@ Text paragraphs are imported as a sequence of same level cells. Koutlines are imported with their structure intact. -The variable, 'paragraph-start,' is used to determine paragraphs." +The variable, `paragraph-start,' is used to determine paragraphs." (interactive "FImport from text/koutline buffer/file: \nFInsert cells into koutline buffer/file: \nP") (let ((klabel "1") (output-level 1) (count 0) initially-empty-output no-renumber orig-point total) @@ -540,7 +541,7 @@ the total number of paragraphs in IMPORT-FROM, used to show a running tally of the imported paragraphs. -The variable, 'paragraph-start' is used to determine paragraphs." +The variable, `paragraph-start' is used to determine paragraphs." (set-buffer import-from) (let* ((count 0) start end contents) ;; Next line is needed when importing into an existing kview.
--- a/lisp/hyperbole/kotl/klabel.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/kotl/klabel.el Mon Aug 13 09:21:54 2007 +0200 @@ -8,7 +8,8 @@ ;; AUTHOR: Bob Weiner & Kellie Clark ;; ;; ORIG-DATE: 17-Apr-94 -;; LAST-MOD: 1-Nov-95 at 02:33:23 by Bob Weiner +;; LAST-MOD: 6-Mar-97 at 01:19:02 by Bob Weiner + ;;; ************************************************************************ ;;; Public variables ;;; ************************************************************************ @@ -47,7 +48,7 @@ ((eq label-type 'partial-alpha) (error "(klabel:level): Can't compute the level of a partial-alpha label")) - (t (error "(klabel:level): Invalid label type setting: '%s'" + (t (error "(klabel:level): Invalid label type setting: `%s'" label-type))))) (defun klabel:parent (label) @@ -69,7 +70,7 @@ (error "(klabel:child-id): Can't compute child of idstamp label")))) (t (error - "(klabel-type:child): Invalid label type setting: '%s'" + "(klabel-type:child): Invalid label type setting: `%s'" label-type)))) (defun klabel-type:increment (label-type) @@ -96,7 +97,7 @@ (error "(klabel:increment-no): 0 cell cannot have a sibling") (error "(klabel:increment-id): Can't compute sibling of idstamp label"))))) (t (error - "(klabel:increment): Invalid label type setting: '%s'" + "(klabel:increment): Invalid label type setting: `%s'" label-type)))) (defun klabel-type:parent (label-type) @@ -127,7 +128,7 @@ (error "(klabel:parent-id): Can't compute parent of idstamp label")))) (t (error - "(klabel-type:parent): Invalid label type setting: '%s'" + "(klabel-type:parent): Invalid label type setting: `%s'" label-type)))) ;;; @@ -211,7 +212,7 @@ (concat (substring label 0 (match-beginning 0)) (int-to-string (1+ (string-to-int (substring label (match-beginning 0))))))) - (t (error "(klabel:increment-legal): Invalid label, '%s'" label)))) + (t (error "(klabel:increment-legal): Invalid label, `%s'" label)))) (defun klabel:level-legal (label) "Return outline level as an integer of legal-style LABEL. @@ -243,10 +244,10 @@ ;; It must be one of the following symbols: ;; no for no labels, ;; id for permanent idstamp labels, e.g. 001, 002, etc. -;; alpha for '1a2' full alphanumeric labels -;; legal for '1.1.2' labels -;; partial-alpha for partial alphanumeric labels, e.g. '2' for node '1a2' -;; star for multi-star labeling, e.g. '***'. +;; alpha for `1a2' full alphanumeric labels +;; legal for `1.1.2' labels +;; partial-alpha for partial alphanumeric labels, e.g. `2' for node `1a2' +;; star for multi-star labeling, e.g. `***'. ;; ;; Functions to compute sibling and child labels for particular label types. @@ -352,7 +353,7 @@ (if (re-search-backward "\\(\\`\\|[\n\r][\n\r]\\)[ \t]*0[0-9]+" nil t) (goto-char (match-end 0))))))))) - (error "(kview:to-label-end): Invalid label type: '%s'" label-type))) + (error "(kview:to-label-end): Invalid label type: `%s'" label-type))) (defun klabel-type:star-label (prev-label &optional child-p) "Return full star label, e.g. ***, for cell following PREV-LABEL's cell. @@ -379,7 +380,7 @@ ((eq label-type 'no) "") ((eq label-type 'star) "*") (t (error - "(klabel-type:set-labels): Invalid label type: '%s'" + "(klabel-type:set-labels): Invalid label type: `%s'" label-type)))) (let ((klabel-type:changing-flag t)) (klabel-type:update-labels-from-point label-type first-label))))) @@ -603,7 +604,7 @@ is signaled." (if (not (kotl-label:is-p label)) (error - "(kotl-label:increment): First arg, '%s', must be a kotl-label." + "(kotl-label:increment): First arg, `%s', must be a kotl-label." label)) (let ((int-p) (val 0)) (if (or (setq int-p (kotl-label:integer-p label)) @@ -613,13 +614,13 @@ (progn (setq int-p (string-to-int label)) (if (> (setq val (+ int-p n)) 0) (kotl-label:create val) - (error "(kotl-label:increment): Decrement of '%s' by '%d' is less than 1." label n))) + (error "(kotl-label:increment): Decrement of `%s' by `%d' is less than 1." label n))) ;; alpha-p (if (<= 0 (setq val (+ n (kotl-label:alpha-to-int label)))) (kotl-label:create (kotl-label:int-to-alpha val)) - (error "(kotl-label:increment): Decrement of '%s' by '%d' is illegal." label n))) - (error "(kotl-label:increment): label, '%s', must be all digits or alpha characters" label)))) + (error "(kotl-label:increment): Decrement of `%s' by `%d' is illegal." label n))) + (error "(kotl-label:increment): label, `%s', must be all digits or alpha characters" label)))) (defun kotl-label:increment-alpha (label) "Return alphabetic LABEL incremented by 1. @@ -694,7 +695,7 @@ For example, the full label \"1a2\" has kotl-label \"2\", as does \"1.1.2\"." (if (string-match "[0-9]+$\\|[a-zA-Z]+$" label) (substring label (match-beginning 0)) - (error "(klabel:to-kotl-label): Invalid label, '%s'" label))) + (error "(klabel:to-kotl-label): Invalid label, `%s'" label))) (defun klabel-type:update-labels-from-point (label-type first-label) (let ((label-sep-len (kview:label-separator-length kview)))
--- a/lisp/hyperbole/kotl/klink.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/kotl/klink.el Mon Aug 13 09:21:54 2007 +0200 @@ -8,7 +8,7 @@ ;; AUTHOR: Bob Weiner & Kellie Clark ;; ;; ORIG-DATE: 15-Nov-93 at 12:15:16 -;; LAST-MOD: 6-Jan-97 at 19:00:58 by Bob Weiner +;; LAST-MOD: 6-Mar-97 at 01:19:19 by Bob Weiner ;; ;; DESCRIPTION: ;; @@ -65,7 +65,7 @@ (defun klink:create (reference) "Insert at point an implicit link to REFERENCE. REFERENCE should be a cell-ref or a string containing \"filename, cell-ref\". -See documentation for 'kcell:ref-to-id' for valid cell-ref formats." +See documentation for `kcell:ref-to-id' for valid cell-ref formats." (interactive ;; Don't change the name or delete default-dir used here. It is referenced ;; in "hargs.el" for argument getting. @@ -98,7 +98,7 @@ (if cell-ref (insert ", " cell-ref)) (insert ">")) (cell-ref (insert "<@ " cell-ref ">")) - (t (error "(klink:create) Invalid reference, '%s'" reference))))) + (t (error "(klink:create) Invalid reference, `%s'" reference))))) (defun klink:at-p () "Return non-nil iff point is within a klink. @@ -161,7 +161,7 @@ < [-!&] pathname > < @ cell-ref > -See documentation for 'kcell:ref-to-id' for valid cell-ref formats." +See documentation for `kcell:ref-to-id' for valid cell-ref formats." (interactive "sKotl link specifier: ") (or (stringp link) (error "(link-to-kotl): Non-string link argument, %s" @@ -216,7 +216,7 @@ |viewspec :augment-viewspec (ignored for now) -See documentation for 'kcell:ref-to-id' for valid cell-ref formats." +See documentation for `kcell:ref-to-id' for valid cell-ref formats." (or (stringp reference) (error "(klink:parse): Non-string reference argument, %s"
--- a/lisp/hyperbole/kotl/kmenu.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/kotl/kmenu.el Mon Aug 13 09:21:54 2007 +0200 @@ -6,12 +6,11 @@ ;; KEYWORDS: mouse, outlines, wp ;; ;; AUTHOR: Bob Weiner -;; ORG: Motorola, Inc., PPG ;; ;; ORIG-DATE: 28-Mar-94 at 11:22:09 -;; LAST-MOD: 22-Oct-96 at 01:30:50 by Bob Weiner +;; LAST-MOD: 6-Mar-97 at 01:20:03 by Bob Weiner ;; -;; Copyright (C) 1994-1995 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1997 Free Software Foundation, Inc. ;; ;; This file is part of Hyperbole. ;;
--- a/lisp/hyperbole/kotl/kotl-mode.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/kotl/kotl-mode.el Mon Aug 13 09:21:54 2007 +0200 @@ -8,7 +8,7 @@ ;; AUTHOR: Bob Weiner & Kellie Clark ;; ;; ORIG-DATE: 6/30/93 -;; LAST-MOD: 5-Dec-96 at 18:55:22 by Bob Weiner +;; LAST-MOD: 6-Mar-97 at 01:15:42 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; Available for use and distribution under the same terms as GNU Emacs. @@ -157,7 +157,7 @@ (opoint (point-marker)) (bocp) start) - (setq start (kotl-mode:beginning-of-line)) + (setq start (kotl-mode:start-of-line)) (if (setq bocp (kotl-mode:bocp)) (progn ;; Add a temporary fill-prefix since this is the 1st line of the cell @@ -522,7 +522,7 @@ ((and (markerp val) (marker-position val)) (princ (marker-position val) (current-buffer))) (t - (error "Register '%c' does not contain text" register)))) + (error "Register `%c' does not contain text" register)))) (if (not arg) (exchange-point-and-mark))) (defun kotl-mode:just-one-space () @@ -1296,7 +1296,7 @@ (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. (or arg (setq arg 1)) (or (integer-or-marker-p arg) - (error "(kotl-mode:beginning-of-cell): Wrong type arg, integer-or-marker, '%s'" arg)) + (error "(kotl-mode:beginning-of-cell): Wrong type arg, integer-or-marker, `%s'" arg)) (if (= arg 1) (goto-char (kcell-view:start)) (kotl-mode:backward-cell (1- arg))) @@ -1311,7 +1311,7 @@ (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. (or arg (setq arg 1)) (or (integer-or-marker-p arg) - (error "(kotl-mode:start-of-line): Wrong type arg, integer-or-marker, '%s'" arg)) + (error "(kotl-mode:start-of-line): Wrong type arg, integer-or-marker, `%s'" arg)) (forward-line (1- arg)) (if (eolp) nil @@ -1319,7 +1319,9 @@ (beginning-of-line)))) (point)) -(defalias 'kotl-mode:beginning-of-line 'kotl-mode:start-of-line) +;;; This ensures that the key bound to `beginning-of-line' is replaced in +;;; kotl-mode. +(fset 'kotl-mode:beginning-of-line 'kotl-mode:start-of-line) (defun kotl-mode:beginning-of-tree () "Move point to the level 1 root of the current cell's tree. @@ -1369,7 +1371,7 @@ (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. (or arg (setq arg 1)) (or (integer-or-marker-p arg) - (error "(kotl-mode:end-of-cell): Wrong type arg, integer-or-marker, '%s'" arg)) + (error "(kotl-mode:end-of-cell): Wrong type arg, integer-or-marker, `%s'" arg)) (if (= arg 1) (goto-char (kcell-view:end-contents)) (kotl-mode:forward-cell (1- arg))) @@ -1384,7 +1386,7 @@ (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. (or arg (setq arg 1)) (or (integer-or-marker-p arg) - (error "(kotl-mode:finish-of-line): Wrong type arg, integer-or-marker, '%s'" arg)) + (error "(kotl-mode:finish-of-line): Wrong type arg, integer-or-marker, `%s'" arg)) (forward-line (1- arg)) (end-of-line) ;; May have to move backwards to before label if support labels @@ -1540,7 +1542,7 @@ (point)) (defun kotl-mode:goto-cell (cell-ref &optional error-p) - "Move point to start of cell given by CELL-REF. (See 'kcell:ref-to-id'.) + "Move point to start of cell given by CELL-REF. (See `kcell:ref-to-id'.) Return point iff CELL-REF is found within current view. With a prefix argument, CELL-REF is assigned the argument value for use as an idstamp. @@ -1554,7 +1556,7 @@ (read-string "Goto cell label or id: ")))) (setq cell-ref (or (kcell:ref-to-id cell-ref) - (error "(kotl-mode:goto-cell): Invalid cell reference, '%s'" cell-ref))) + (error "(kotl-mode:goto-cell): Invalid cell reference, `%s'" cell-ref))) (let* ((opoint (point)) (found) cell-id kvspec) @@ -1589,7 +1591,7 @@ (t (goto-char opoint) nil)) (if (and (not found) (or error-p (interactive-p))) - (error "(kotl-mode:goto-cell): No '%s' cell in this view" cell-ref) + (error "(kotl-mode:goto-cell): No `%s' cell in this view" cell-ref) ;; Activate any viewspec associated with cell-ref. (if kvspec (kvspec:activate kvspec)))) found)) @@ -2249,10 +2251,10 @@ (setq attribute (intern attribute) value (kcell-view:get-attr attribute)) (if value - (setq value (read-expression + (setq value (read-minibuffer (format "Change value of \"%s\" to: " attribute) (prin1-to-string value))) - (setq value (read-expression + (setq value (read-minibuffer (format "Set value of \"%s\" to: " attribute)))) (list attribute value nil))) (kcell-view:set-attr attribute value pos) @@ -2558,7 +2560,7 @@ (prog1 (buffer-substring bol eol) (delete-region bol eol))) - (error "(kotl-mode:delete-line): Invalid position, '%d'" (point))))) + (error "(kotl-mode:delete-line): Invalid position, `%d'" (point))))) (defun kotl-mode:indent-line (arg) ;; Disallow the indent-line command. @@ -2619,7 +2621,7 @@ (defun kotl-mode:print-attributes (kview) "Print to the `standard-output' stream the attributes of the current visible kcell. -Takes argument KVIEW (so it can be used with 'kview:map-tree' and so that +Takes argument KVIEW (so it can be used with `kview:map-tree' and so that KVIEW is bound correctly) but always operates upon the current view." ;; Move to start of visible cell to avoid printing attributes for an ;; invisible kcell which point may be over.
--- a/lisp/hyperbole/kotl/kview.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/kotl/kview.el Mon Aug 13 09:21:54 2007 +0200 @@ -8,7 +8,8 @@ ;; AUTHOR: Bob Weiner & Kellie Clark ;; ;; ORIG-DATE: 6/30/93 -;; LAST-MOD: 2-Nov-95 at 00:52:52 by Bob Weiner +;; LAST-MOD: 6-Mar-97 at 01:16:42 by Bob Weiner + ;;; ************************************************************************ ;;; Other required Lisp Libraries ;;; ************************************************************************ @@ -43,10 +44,10 @@ It must be one of the following symbols: no for no labels id for permanent idstamp labels, e.g. 001, 002, etc. - alpha for '1a2' full alphanumeric labels - legal for '1.1.2' labels - partial-alpha for partial alphanumeric labels, e.g. '2' for node '1a2' - star for multi-star labeling, e.g. '***'.") + alpha for `1a2' full alphanumeric labels + legal for `1.1.2' labels + partial-alpha for partial alphanumeric labels, e.g. `2' for node `1a2' + star for multi-star labeling, e.g. `***'.") (defvar kview:default-level-indent 3 "*Default number of spaces to indent each succeeding level in koutlines.") @@ -294,9 +295,9 @@ (if pos (goto-char pos)) (if (kview:valid-position-p) (buffer-substring - (kotl-mode:beginning-of-line) + (kotl-mode:start-of-line) (kotl-mode:end-of-line)) - (error "(kcell-view:line): Invalid position, '%d'" (point))))) + (error "(kcell-view:line): Invalid position, `%d'" (point))))) (defun kcell-view:next (&optional visible-p label-sep-len) "Move to start of next cell within current view. @@ -402,7 +403,7 @@ (defun kcell-view:reference (&optional pos relative-dir) "Return a reference to the kcell at optional POS or point for use in a link. The reference is a string of the form, \"<kcell-file, cell-ref>\" where -cell-ref is as described in the documentation for 'kcell:ref-to-id'. +cell-ref is as described in the documentation for `kcell:ref-to-id'. Kcell-file is made relative to optional RELATIVE-DIR before it is returned." (format "<%s, %s=%s>" (hpath:relative-to buffer-file-name relative-dir) (kcell-view:label pos) (kcell-view:idstamp pos))) @@ -473,21 +474,21 @@ BLANK-LINES, LEVELS-TO-SHOW, and LINES-TO-SHOW may also be given, otherwise default values are used. See documentation of: - 'kview:default-label-type' for LABEL-TYPE, - 'kview:default-level-indent' for LEVEL-INDENT, - 'kview:default-label-separator' for LABEL-SEPARATOR, - 'kview:default-label-min-width' for LABEL-MIN-WIDTH, - 'kview:default-blank-lines' for BLANK-LINES, - 'kview:default-levels-to-show' for LEVELS-TO-SHOW, - 'kview:default-lines-to-show' for LINES-TO-SHOW." + `kview:default-label-type' for LABEL-TYPE, + `kview:default-level-indent' for LEVEL-INDENT, + `kview:default-label-separator' for LABEL-SEPARATOR, + `kview:default-label-min-width' for LABEL-MIN-WIDTH, + `kview:default-blank-lines' for BLANK-LINES, + `kview:default-levels-to-show' for LEVELS-TO-SHOW, + `kview:default-lines-to-show' for LINES-TO-SHOW." (let ((buf (get-buffer buffer-name))) (cond ((null buf) - (error "(kview:create): No such buffer, '%s'." buffer-name)) + (error "(kview:create): No such buffer, `%s'." buffer-name)) ((or (null id-counter) (= id-counter 0)) (setq id-counter 0)) ((not (integerp id-counter)) - (error "(kview:create): 2nd arg, '%s', must be an integer." id-counter))) + (error "(kview:create): 2nd arg, `%s', must be an integer." id-counter))) (set-buffer buf) (if (and (boundp 'kview) (eq (kview:buffer kview) buf)) ;; Don't recreate view if it exists. @@ -731,7 +732,7 @@ FUNC is called so that it may test against this value. `Label-sep-len' contains the label separator length. -See also 'kview:map-siblings' and 'kview:map-tree'." +See also `kview:map-siblings' and `kview:map-tree'." (save-excursion (set-buffer (kview:buffer kview)) (let ((results) @@ -760,7 +761,7 @@ FUNC is called so that it may test against this value. `Label-sep-len' contains the label separator length. -See also 'kview:map-branch' and 'kview:map-tree'." +See also `kview:map-branch' and `kview:map-tree'." (save-excursion (set-buffer (kview:buffer kview)) (let ((results) @@ -787,7 +788,7 @@ FUNC is called so that it may test against this value. `Label-sep-len' contains the label separator length. -See also 'kview:map-branch' and 'kview:map-siblings'." +See also `kview:map-branch' and `kview:map-siblings'." (let ((results) (label-sep-len (kview:label-separator-length kview))) (save-excursion @@ -924,7 +925,7 @@ label-type (intern new-type-str))))) (if (not (memq new-type '(alpha legal id no partial-alpha star))) - (error "(kview:set-label-type): Invalid label type, '%s'." new-type)) + (error "(kview:set-label-type): Invalid label type, `%s'." new-type)) ;; Disable use of partial-alpha for now since it is broken. (if (eq new-type 'partial-alpha) (error "(kview:set-label-type): Partial-alpha labels don't work, choose another type")) @@ -948,9 +949,9 @@ (>= (current-column) (kcell-view:indent))) ((not (integer-or-marker-p pos)) (error "(kview:valid-position-p): Argument POS not an integer -or marker, '%s'" pos)) +or marker, `%s'" pos)) ((or (< pos (point-min)) (> pos (point-max))) - (error "(kview:valid-position-p): Invalid POS argument, '%d'" + (error "(kview:valid-position-p): Invalid POS argument, `%d'" pos)) (t (save-excursion (goto-char pos)
--- a/lisp/hyperbole/kotl/kvspec.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/kotl/kvspec.el Mon Aug 13 09:21:54 2007 +0200 @@ -8,7 +8,7 @@ ;; AUTHOR: Bob Weiner ;; ;; ORIG-DATE: 21-Oct-95 at 15:17:07 -;; LAST-MOD: 4-Dec-96 at 15:36:12 by Bob Weiner +;; LAST-MOD: 6-Mar-97 at 01:17:04 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; Available for use and distribution under the same terms as GNU Emacs. @@ -122,7 +122,7 @@ "Show NUM lines per cell." (if (and (integerp num) (>= num 0)) nil - (error "(kvspec:show-lines-per-cell): Invalid lines per cell, '%d'" num)) + (error "(kvspec:show-lines-per-cell): Invalid lines per cell, `%d'" num)) (kview:set-attr kview 'lines-to-show num) (let (start end count) (if (zerop num) @@ -181,7 +181,7 @@ ;;; ************************************************************************ (defun kvspec:blank-lines () - "Turn blank lines on or off according to 'kvspec:current'." + "Turn blank lines on or off according to `kvspec:current'." (let ((modified-p (buffer-modified-p)) (buffer-read-only)) (if (string-match "b" kvspec:current) @@ -234,12 +234,12 @@ kvspec:label-type-alist))))))))) (defun kvspec:elide () - "Turn ellipses display following clipped cells on or off according to 'kvspec:current'." + "Turn ellipses display following clipped cells on or off according to `kvspec:current'." (setq selective-display-ellipses (if (string-match "e" kvspec:current) t))) (defun kvspec:hide-levels () - "Show a set number of cell levels according to 'kvspec:current'." + "Show a set number of cell levels according to `kvspec:current'." ;; "l" means use value of kview:default-levels-to-show. ;; "l0" means show all levels. (let (levels) @@ -256,7 +256,7 @@ (kvspec:levels-to-show levels)))) (defun kvspec:lines-to-show () - "Show a set number of lines per cell according to 'kvspec:current'." + "Show a set number of lines per cell according to `kvspec:current'." ;; "c" means use value of kview:default-lines-to-show. ;; "c0" means show all lines. (cond ((not (string-match "c\\([0-9]+\\)?" kvspec:current)) @@ -270,7 +270,7 @@ (t (kvspec:show-lines-per-cell kview:default-lines-to-show)))) (defun kvspec:numbering () - "Set the type of numbering (label) display according to 'kvspec:current'." + "Set the type of numbering (label) display according to `kvspec:current'." (if (not (string-match "n\\([.*~0-2]\\)?" kvspec:current)) nil ;; "n" means use value of kview:default-label-type. @@ -315,7 +315,7 @@ (setq mf (cdr mf))))))))) (defun kvspec:update-view () - "Update view according to current setting of local 'kvspec:current' variable." + "Update view according to current setting of local `kvspec:current' variable." (let ((modified-p (buffer-modified-p)) (buffer-read-only)) (save-excursion @@ -374,7 +374,7 @@ (defvar kvspec:string-format " <|%s>" "Format of the kview spec modeline display. -It must contain a '%s' which is replaced with the current set of view spec +It must contain a `%s' which is replaced with the current set of view spec characters at run-time.") (provide 'kvspec)
--- a/lisp/hyperbole/wrolo.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/hyperbole/wrolo.el Mon Aug 13 09:21:54 2007 +0200 @@ -15,13 +15,12 @@ ;; Tel: +1 408-243-3300 ;; ;; ORIG-DATE: 7-Jun-89 at 22:08:29 -;; LAST-MOD: 17-Feb-97 at 15:32:20 by Bob Weiner +;; LAST-MOD: 14-Mar-97 at 01:32:23 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; Available for use and distribution under the same terms as GNU Emacs. ;; -;; Copyright (C) 1989, '90, '91, '92, '95 Free Software Foundation, Inc. -;; Copyright (C) 1996 InfoDock Associates +;; Copyright (C) 1989, '90, '91, '92, '95, '96, '97 Free Software Foundation, Inc. ;; ;; DESCRIPTION: ;; @@ -63,7 +62,7 @@ ;; ;; SETUP: ;; -;; The variable 'rolo-file-list' is a list of files to search for +;; The variable `rolo-file-list' is a list of files to search for ;; matching rolodex entries. To add personal files to rolo-file-list, ;; when you find these functions are useful for any sort of list lookup, ;; add the following to your ~/.emacs file (substituting where you see @@ -71,9 +70,9 @@ ;; ;; (setq rolo-file-list (append rolo-file-list '("<file1>" "<file2>"))) ;; -;; We recommend that entries in 'rolo-file-list' have ".otl" suffixes +;; We recommend that entries in `rolo-file-list' have ".otl" suffixes ;; so that they do not conflict with file names that other rolodex -;; programs might use and so that they are edited in 'outline-mode' by +;; programs might use and so that they are edited in `outline-mode' by ;; default. If you want the latter behavior, uncomment and add something ;; like the following to one of your GNU Emacs initialization files: ;; @@ -98,7 +97,7 @@ ;; message, the rolodex add function will extract the sender's name ;; and e-mail address and prompt you with the name as a default. If ;; you accept it, it will enter the name and the email address using -;; the format given by the 'rolo-email-format' variable. See its +;; the format given by the `rolo-email-format' variable. See its ;; documentation if you want to change its value. ;; ;; @@ -139,8 +138,8 @@ ;; parent/child to locate a child entry below a parent entry, e.g. ;; from the example near the top, we could give Company/Manager/Underlings. ;; -;; Here is a snippet from our group rolodex file. The ';'s should be -;; removed of course and the '*'s should begin at the start of the +;; Here is a snippet from our group rolodex file. The `;'s should be +;; removed of course and the `*'s should begin at the start of the ;; line. If a rolodex file begins with two separator lines whose ;; first three characters are "===", then these lines and any text ;; between them are prepended to the output buffer whenever any @@ -160,43 +159,43 @@ ;; FOR PROGRAMMERS: ;; ;; Entries in rolodex files are separated by patterns matching -;; 'rolo-entry-regexp'. Each entry may have any number of sub-entries +;; `rolo-entry-regexp'. Each entry may have any number of sub-entries ;; which represent the next level down in the entry hierarchy. ;; Sub-entries' separator patterns are always longer than their parents'. -;; For example, if an entry began with '*' then its sub-entries would begin -;; with '**' and so on. Blank lines in rolodex files will not end up where +;; For example, if an entry began with `*' then its sub-entries would begin +;; with `**' and so on. Blank lines in rolodex files will not end up where ;; you want them if you use the rolo-sort commands; therefore, blank lines ;; are not recommended. If you change the value of -;; 'rolo-entry-regexp', you will have to modify 'rolo-sort'. +;; `rolo-entry-regexp', you will have to modify `rolo-sort'. ;; ;; The following additional functions are provided: ;; -;; 'rolo-sort-level' sorts a specific level of entries in a rolodex file; -;; 'rolo-map-level' runs a user specified function on a specific level of +;; `rolo-sort-level' sorts a specific level of entries in a rolodex file; +;; `rolo-map-level' runs a user specified function on a specific level of ;; entries in a rolodex file; -;; 'rolo-fgrep-file', same as 'rolo-fgrep' but operates on a single file; -;; 'rolo-grep-file', same as 'rolo-grep' but operates on a single file; -;; 'rolo-display-matches', display last set of rolodex matches, if any; -;; 'rolo-toggle-narrow-to-entry' toggles between display of current entry +;; `rolo-fgrep-file', same as `rolo-fgrep' but operates on a single file; +;; `rolo-grep-file', same as `rolo-grep' but operates on a single file; +;; `rolo-display-matches', display last set of rolodex matches, if any; +;; `rolo-toggle-narrow-to-entry' toggles between display of current entry ;; and display of all matching entries. ;; ;; ;; MOD HISTORY: ;; ;; 12/17/89 -;; Added internal 'rolo-shrink-window' function for use in +;; Added internal `rolo-shrink-window' function for use in ;; compressing/uncompressing the rolo view window to/from a size just ;; large enough for the selected entry. This is useful when a search ;; turns up more entries than desired. ;; ;; 02/21/90 -;; Modified 'rolo-grep-file' and 'rolo-map-level' so they only set buffers +;; Modified `rolo-grep-file' and `rolo-map-level' so they only set buffers ;; read-only the first time they are read in. This way, if someone edits a ;; rolodex file and then does a rolo-fgrep or other function, the buffer ;; will not be back in read-only mode. ;; ;; 04/18/91 -;; Modified 'rolo-grep-file' to expand any hidden entries in rolo file +;; Modified `rolo-grep-file' to expand any hidden entries in rolo file ;; before doing a search. ;; ;; 12/24/91 @@ -261,6 +260,10 @@ (defvar rolo-save-buffers-after-use t "*Non-nil means save rolodex file after an entry is killed.") +;; Insert or update the entry date each time an entry is added or edited. +(add-hook 'wrolo-add-hook 'rolo-set-date) +(add-hook 'wrolo-edit-hook 'rolo-set-date) + (defvar wrolo-yank-reformat-function nil "*Value is a function of two arguments, START and END, invoked after a rolo-yank. It should reformat the region given by the arguments to some preferred style. @@ -290,19 +293,19 @@ (format rolo-email-format entry email) entry) current-prefix-arg)))) (if (or (not (stringp name)) (string= name "")) - (error "(rolo-add): Invalid name: '%s'" name)) + (error "(rolo-add): Invalid name: `%s'" name)) (if (and (interactive-p) file) (setq file (completing-read "File to add to: " (mapcar 'list rolo-file-list)))) (if (null file) (setq file (car rolo-file-list))) (cond ((and file (or (not (stringp file)) (string= file ""))) - (error "(rolo-add): Invalid file: '%s'" file)) + (error "(rolo-add): Invalid file: `%s'" file)) ((and (file-exists-p file) (not (file-readable-p file))) - (error "(rolo-add): File not readable: '%s'" file)) + (error "(rolo-add): File not readable: `%s'" file)) ((not (file-writable-p file)) - (error "(rolo-add): File not writable: '%s'" file))) + (error "(rolo-add): File not writable: `%s'" file))) (set-buffer (or (get-file-buffer file) (find-file-noselect file))) - (if (interactive-p) (message "Locating insertion point for '%s'..." name)) + (if (interactive-p) (message "Locating insertion point for `%s'..." name)) (let ((parent "") (level "") end) (widen) (goto-char 1) (while (setq end (string-match "/" name)) @@ -313,7 +316,7 @@ (regexp-quote parent)) nil t) (setq level (buffer-substring (match-beginning 1) (match-end 1))) - (error "(rolo-add): '%s' category not found in \"%s\"." + (error "(rolo-add): `%s' category not found in \"%s\"." parent file))) (narrow-to-region (point) (progn (rolo-to-entry-end t level) (point))) @@ -356,13 +359,14 @@ (widen) (rolo-to-buffer (current-buffer)) (goto-char opoint)) + (run-hooks 'wrolo-add-hook) (if (interactive-p) (message "Edit entry at point."))))) ;;;###autoload (defun rolo-display-matches (&optional display-buf return-to-buffer) "Display optional DISPLAY-BUF buffer of previously found rolodex matches. -If DISPLAY-BUF is nil, use the value in 'rolo-display-buffer'. +If DISPLAY-BUF is nil, use the value in `rolo-display-buffer'. Second arg RETURN-TO-BUFFER is the buffer to leave point within after the display." (interactive) (or display-buf (setq display-buf (get-buffer rolo-display-buffer))) @@ -391,15 +395,15 @@ ;;;###autoload (defun rolo-edit (&optional name file) - "Edits a rolodex entry given by optional NAME within 'rolo-file-list'. + "Edits a rolodex entry given by optional NAME within `rolo-file-list'. With prefix argument, prompts for optional FILE to locate entry within. -With no NAME arg, simply displays FILE or first entry in 'rolo-file-list' in an +With no NAME arg, simply displays FILE or first entry in `rolo-file-list' in an editable mode. NAME may be of the form: parent/child to edit child below a parent entry which begins with the parent string." (interactive "sName to edit in rolo: \nP") (if (string-equal name "") (setq name nil)) (and name (not (stringp name)) - (error "(rolo-edit): Invalid name: '%s'" name)) + (error "(rolo-edit): Invalid name: `%s'" name)) (if (and (interactive-p) current-prefix-arg) (if (= (length rolo-file-list) 1) (setq file (car rolo-file-list)) @@ -409,7 +413,7 @@ (or file (setq file (car file-list))) (if (null name) (progn (if (not (file-writable-p file)) - (error "(rolo-edit): File not writable: '%s'" file)) + (error "(rolo-edit): File not writable: `%s'" file)) (find-file-other-window file) (setq buffer-read-only nil)) (if (setq found-point (rolo-to name file-list)) (progn @@ -417,10 +421,10 @@ (if (file-writable-p file) (setq buffer-read-only nil) (message - "(rolo-edit): Entry found but file not writable: '%s'" file) + "(rolo-edit): Entry found but file not writable: `%s'" file) (beep)) (rolo-to-buffer (current-buffer))) - (message "(rolo-edit): '%s' not found." name) + (message "(rolo-edit): `%s' not found." name) (beep) (rolo-to-buffer (or (get-file-buffer (car file-list)) (find-file-noselect (car file-list)))) @@ -428,7 +432,8 @@ (widen) ;; Rolo-to-buffer may have moved point from its desired location, so ;; restore it. - (if found-point (goto-char found-point))))) + (if found-point (goto-char found-point)) + (run-hooks 'wrolo-edit-hook)))) (defun rolo-edit-entry () "Edit the source entry of the rolodex match buffer entry at point. @@ -526,14 +531,14 @@ ;;;###autoload (defun rolo-kill (name &optional file) - "Kills a rolodex entry given by NAME within 'rolo-file-list'. + "Kills a rolodex entry given by NAME within `rolo-file-list'. With prefix argument, prompts for optional FILE to locate entry within. NAME may be of the form: parent/child to kill child below a parent entry which begins with the parent string. Returns t if entry is killed, nil otherwise." (interactive "sName to kill in rolo: \nP") (if (or (not (stringp name)) (string= name "")) - (error "(rolo-kill): Invalid name: '%s'" name)) + (error "(rolo-kill): Invalid name: `%s'" name)) (if (and (interactive-p) current-prefix-arg) (setq file (completing-read "Entry's File: " (mapcar 'list rolo-file-list)))) @@ -572,9 +577,9 @@ (message "Aborted"))) (funcall kill-op start level))) (message - "(rolo-kill): Entry found but file not writable: '%s'" file) + "(rolo-kill): Entry found but file not writable: `%s'" file) (beep))) - (message "(rolo-kill): '%s' not found." name) + (message "(rolo-kill): `%s' not found." name) (beep)) killed)) @@ -630,7 +635,7 @@ ;;;###autoload (defun rolo-sort (&optional rolo-file) "Sorts up to 14 levels of entries in ROLO-FILE (default is personal rolo). -Assumes entries are delimited by one or more '*'characters. +Assumes entries are delimited by one or more `*'characters. Returns list of number of groupings at each entry level." (interactive (list (let ((default "") @@ -682,6 +687,22 @@ level-regexp max-groupings))) +;;;###autoload +(defun rolo-toggle-datestamps (&optional arg) + "Toggle whether datestamps are updated when rolodex entries are modified. +With optional ARG, turn them on iff ARG is positive." + (interactive "P") + (if (or (and arg (<= (prefix-numeric-value arg) 0)) + (and (not (and arg (> (prefix-numeric-value arg) 0))) + (boundp 'wrolo-add-hook) (listp wrolo-add-hook) + (memq 'rolo-set-date wrolo-add-hook))) + (progn (remove-hook 'wrolo-add-hook 'rolo-set-date) + (remove-hook 'wrolo-edit-hook 'rolo-set-date) + (message "Rolodex date stamps are now turned off.")) + (add-hook 'wrolo-add-hook 'rolo-set-date) + (add-hook 'wrolo-edit-hook 'rolo-set-date) + (message "Rolodex date stamps are now turned on."))) + (defun rolo-toggle-narrow-to-entry () "Toggle between display of current entry and display of all matched entries. Useful when bound to a mouse key." @@ -783,7 +804,7 @@ (widen) (goto-char 1) ;; Ensure no entries in outline mode are hidden. - ;; Uses 'show-all' function from outline.el. + ;; Uses `show-all' function from outline.el. (and (search-forward "\C-m" nil t) (show-all)) (if (re-search-forward rolo-hdr-regexp nil t 2) @@ -846,7 +867,7 @@ (outline-regexp rolo-entry-regexp) (buffer-read-only) (level-len)) - ;; Load 'outline' library since its functions are used here. + ;; Load `outline' library since its functions are used here. (if (not (boundp 'outline-mode-map)) (load-library "outline")) (goto-char (point-min)) @@ -890,7 +911,7 @@ rolo-entry-regexp nil t) (progn (beginning-of-line) (point)) (point-max)))) - ;; Remember last expression in 'progn' + ;; Remember last expression in `progn' ;; must always return non-nil. (goto-char start))) (not grouping-end))) @@ -925,6 +946,14 @@ rolo-buf)) (buffer-list)))) +(defun rolo-current-date () + "Return the current date (a string) in a form used for rolodex entry insertion." + (let ((year-month-day (htz:date-parse (current-time-string)))) + (format "\t%02s/%02s/%s" + (aref year-month-day 1) + (aref year-month-day 2) + (aref year-month-day 0)))) + (defun rolo-display-to-entry-end () "Go to end of current entry, ignoring sub-entries." (if (re-search-forward (concat rolo-hdr-regexp "\\|" @@ -952,7 +981,7 @@ hproperty:highlight-face))))))) (defun rolo-kill-buffer (&optional rolo-buf) - "Kills optional ROLO-BUF if unchanged and 'rolo-kill-buffers-after-use' is t. + "Kills optional ROLO-BUF if unchanged and `rolo-kill-buffers-after-use' is t. Default is current buffer." (or rolo-buf (setq rolo-buf (current-buffer))) (and rolo-kill-buffers-after-use (not (buffer-modified-p rolo-buf)) @@ -960,7 +989,7 @@ (defun rolo-name-and-email () "If point is in a mail message, returns list of (name email-addr) of sender. -Name is returned as 'last, first-and-middle'." +Name is returned as `last, first-and-middle'." (let ((email) (name) (from)) (save-window-excursion (if (or (hmail:lister-p) (hnews:lister-p)) @@ -996,7 +1025,7 @@ (list name email)))) (defun rolo-name-at () - "If point is within an entry in 'rolo-display-buffer', returns entry, else nil." + "If point is within an entry in `rolo-display-buffer', returns entry, else nil." (if (string-equal (buffer-name) rolo-display-buffer) (save-excursion (if (or (looking-at rolo-entry-regexp) @@ -1013,12 +1042,28 @@ (or (/= (point-min) 1) (/= (1+ (buffer-size)) (point-max)))) (defun rolo-save-buffer (&optional rolo-buf) - "Saves optional ROLO-BUF if changed and 'rolo-save-buffers-after-use' is t. + "Saves optional ROLO-BUF if changed and `rolo-save-buffers-after-use' is t. Default is current buffer. Used, for example, after a rolo entry is killed." (or rolo-buf (setq rolo-buf (current-buffer))) (and rolo-save-buffers-after-use (buffer-modified-p rolo-buf) (set-buffer rolo-buf) (save-buffer))) +(defun rolo-set-date () + "Add a line with the current date at the end of the current rolodex entry. +Suitable for use as an entry in `wrolo-add-hook' and `wrolo-edit-hook'. +The default date format is MM/DD/YYYY. Rewrite `rolo-current-date' to +return a different format, if you prefer." + (save-excursion + (skip-chars-forward "*") + (rolo-to-entry-end) + (skip-chars-backward " \t\n\r\f") + (skip-chars-backward "^\n\r\f") + (if (looking-at "\\s-+[-0-9./]+\\s-*$") ;; a date + (progn (delete-region (point) (match-end 0)) + (insert (rolo-current-date))) + (end-of-line) + (insert "\n" (rolo-current-date))))) + (defun rolo-shrink-window () (let* ((lines (count-lines (point-min) (point-max))) (height (window-height)) @@ -1034,7 +1079,7 @@ (defun rolo-to (name &optional file-list) "Moves point to entry for NAME within optional FILE-LIST. -'rolo-file-list' is used as default when FILE-LIST is nil. +`rolo-file-list' is used as default when FILE-LIST is nil. Leaves point immediately after match for NAME within entry. Switches internal current buffer but does not alter the frame. Returns point where matching entry begins or nil if not found." @@ -1044,9 +1089,9 @@ (setq file (car file-list) file-list (cdr file-list)) (cond ((and file (or (not (stringp file)) (string= file ""))) - (error "(rolo-to): Invalid file: '%s'" file)) + (error "(rolo-to): Invalid file: `%s'" file)) ((and (file-exists-p file) (not (file-readable-p file))) - (error "(rolo-to): File not readable: '%s'" file))) + (error "(rolo-to): File not readable: `%s'" file))) (set-buffer (or (get-file-buffer file) (find-file-noselect file))) (let ((case-fold-search t) (real-name name) (parent "") (level) end) (widen) (goto-char 1) @@ -1068,7 +1113,7 @@ (t;; Found parent but not child (setq buffer-read-only nil) (rolo-to-buffer (current-buffer)) - (error "(rolo-to): '%s' part of name not found in \"%s\"." + (error "(rolo-to): `%s' part of name not found in \"%s\"." parent file))) (if level (narrow-to-region (point)
--- a/lisp/its/its-han-kata.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/its/its-han-kata.el Mon Aug 13 09:21:54 2007 +0200 @@ -20,7 +20,7 @@ ;;; 92.9.24 created for Mule Ver.0.9.6 by K.Shibata <shibata@sgi.co.jp> -(require 'jisx0201) +(require 'egg-jisx0201) (its-define-mode "roma-han-kata" "(I1'(B" t) @@ -35,7 +35,7 @@ (its-defrule "N" "(I](B") -(defvar enable-double-n-syntax nil "*Enable ""nn"" input for ""(I](B"" ") +(defvar enable-double-n-syntax nil "*Enable \"nn\" input for \"(I](B\"") (its-defrule-conditional "n" ((not enable-double-n-syntax) "(I](B")
--- a/lisp/modes/cc-mode.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/modes/cc-mode.el Mon Aug 13 09:21:54 2007 +0200 @@ -6,8 +6,8 @@ ;; 1987 Dave Detlefs and Stewart Clamen ;; 1985 Richard M. Stallman ;; Created: a long, long, time ago. adapted from the original c-mode.el -;; Version: 4.379 -;; Last Modified: 1997/03/10 00:59:10 +;; Version: 4.387 +;; Last Modified: 1997/03/21 20:25:33 ;; Keywords: c languages oop ;; NOTE: Read the commentary below for the right way to submit bug reports! @@ -32,18 +32,19 @@ ;;; Commentary: -;; This package provides modes in GNU Emacs for editing C, C++, -;; Objective-C, and Java code. It is intended to be a replacement for -;; c-mode.el (a.k.a. BOCM -- Boring Old C-Mode), c++-mode.el, -;; cplus-md.el, and cplus-md1.el, all of which are in some way -;; ancestors of this file. A number of important improvements have -;; been made, briefly: complete K&R C, ANSI C, `ARM' C++, Objective-C, -;; and Java support with consistent indentation across all modes, more -;; intuitive indentation controlling variables, compatibility across -;; all known Emacsen, nice new features, and tons of bug fixes. This -;; package is called "CC Mode" to distinguish it from its ancestors, -;; but there is no cc-mode command. Usage and programming details are -;; contained in an accompanying texinfo manual. +;; This package provides GNU Emacs major modes for editing C, C++, +;; Objective-C, and Java code. As of the latest Emacs and XEmacs +;; releases, it is the default package for editing these languages. +;; This package is called "CC Mode", and should be spelled exactly +;; this way. It supports K&R and ANSI C, ANSI C++, Objective-C, and +;; Java, with a consistent indentation model across all modes. This +;; indentation model is intuitive and very flexible, so that almost +;; any desired style of indentation can be supported. Installation, +;; usage, and programming details are contained in an accompanying +;; texinfo manual. + +;; CC Mode's immediate ancestors were, c++-mode.el, cplus-md.el, and +;; cplus-md1.el.. ;; NOTE: This mode does not perform font-locking (a.k.a syntactic ;; coloring, keyword highlighting, etc.) for any of the supported @@ -68,22 +69,6 @@ ;; BYTE-COMPILER WARNINGS (you'd be surprised at how many people don't ;; follow this advice :-). -;; As of this writing (24-Feb-1997), CC Mode comes with the latest -;; Emacs and XEmacs distributions (19.34 and 19.14 respectively), but -;; is no longer pre-loaded by default. To use the latest version of -;; CC Mode, you need only make sure that this copy of cc-mode.el is -;; found first on your load-path. - -;; If your Emacs is pre-loaded with any version of cc-mode.el, -;; c-mode.el, or c++-mode.el, you will need to consult the -;; cc-mode.texinfo manual for details on upgrading your Emacs. - -;; There are four major mode entry points provided by this package, -;; one for editing C++ code, one for editing C code (both K&R and -;; ANSI), one for editing Objective-C code, and one for editing Java -;; code. The commands are M-x c-mode, M-x c++-mode, M-x objc-mode, -;; and M-x java-mode. - ;; Many, many thanks go out to all the folks on the beta test list. ;; Without their patience, testing, insight, code contributions, and ;; encouragement CC Mode would be a far inferior package. @@ -421,8 +406,14 @@ (defvar c-electric-pound-behavior nil "*List of behaviors for electric pound insertion. Only currently supported behavior is `alignleft'.") + (defvar c-label-minimum-indentation 1 - "*Minimum indentation for labels and case tags in `gnu' style.") + "*Minimum indentation for lines inside of top-level constructs. +This variable typically only affects code using the `gnu' style, which +mandates a minimum of one space in front of every line inside +top-level constructs. Specifically, the function +`c-gnu-impose-minimum' on your `c-special-indent-hook' is what +enforces this.") (defvar c-progress-interval 5 "*Interval used to update progress status during long re-indentation. @@ -1213,7 +1204,7 @@ (defconst c-inher-key (concat "\\(\\<static\\>\\s +\\)?" c-C++-class-key "[ \t]+" c-symbol-key - "\\([ \t]*:[ \t]*\\)?\\s *[^;]") + "\\([ \t]*:[ \t]*\\)\\s *[^;]") "Regexp describing a class inheritance declaration.") (defconst c-switch-label-key "\\(\\(case[( \t]+\\S .*\\)\\|default[ \t]*\\):" @@ -1239,10 +1230,14 @@ (defconst c-C++-friend-key "friend[ \t]+\\|template[ \t]*<.+>[ \t]*friend[ \t]+" "Regexp describing friend declarations in C++ classes.") -(defconst c-C++-comment-start-regexp "/[/*]" - "Dual comment value for `c-comment-start-regexp'.") -(defconst c-C-comment-start-regexp "/\\*" - "Single comment style value for `c-comment-start-regexp'.") + +;; comment starter definitions for various languages. the language +;; modes will set c-comment-start-regexp to this value. +(defconst c-C++-comment-start-regexp "/[/*]") +(defconst c-C-comment-start-regexp "/[*]") +;; We need to match all 3 Java style comments +;; 1) Traditional C block; 2) javadoc /** ...; 3) C++ style +(defconst c-Java-comment-start-regexp "/\\(/\\|[*][*]?\\)") (defconst c-ObjC-method-key (concat @@ -1453,7 +1448,7 @@ comment-end "" comment-multi-line nil c-conditional-key c-Java-conditional-key - c-comment-start-regexp c-C++-comment-start-regexp + c-comment-start-regexp c-Java-comment-start-regexp c-class-key c-Java-class-key c-method-key c-Java-method-key c-double-slash-is-comments-p t @@ -1597,6 +1592,11 @@ ;; macros must be defined before first use +(defmacro c-add-syntax (symbol &optional relpos) + ;; a simple macro to append the syntax in symbol to the syntax list. + ;; try to increase performance by using this macro + (` (setq syntax (cons (cons (, symbol) (, relpos)) syntax)))) + (defmacro c-point (position) ;; Returns the value of point at certain commonly referenced POSITIONs. ;; POSITION can be one of the following symbols: @@ -2563,6 +2563,12 @@ (progn (beginning-of-line) (skip-chars-forward " \t*" (c-point 'eol)) + ;; kludge alert, watch out for */, in + ;; which case fill-prefix should *not* + ;; be "*"! + (if (and (= (following-char) ?/) + (= (preceding-char) ?*)) + (forward-char -1)) (point))) ;; If the comment is only one line followed @@ -2605,7 +2611,9 @@ (goto-char comment-start-place) (search-backward "/*")) (if (and (not c-hanging-comment-starter-p) - (looking-at "/\\*[ \t]*$")) + (looking-at + (concat c-comment-start-regexp + "[ \t]*$"))) (forward-line 1)) ;; Protect text before the comment ;; start by excluding it. Add @@ -3851,11 +3859,6 @@ ;; defuns for calculating the syntactic state and indenting a single ;; line of C/C++/ObjC code -(defmacro c-add-syntax (symbol &optional relpos) - ;; a simple macro to append the syntax in symbol to the syntax list. - ;; try to increase performance by using this macro - (` (setq syntax (cons (cons (, symbol) (, relpos)) syntax)))) - (defun c-most-enclosing-brace (state) ;; return the bufpos of the most enclosing brace that hasn't been ;; narrowed out by any enclosing class, or nil if none was found @@ -4931,8 +4934,9 @@ ;; we now have to figure out where this comment begins. (goto-char here) (back-to-indentation) - (if (re-search-forward "[*]+/" (c-point 'eol) t) - (forward-comment -1) + (if (looking-at "[*]+/") + (progn (goto-char (match-end 0)) + (forward-comment -1)) (goto-char (cdr langelem)) (back-to-indentation)))) (- (current-column) cs-curcol)) @@ -5199,7 +5203,7 @@ ;; defuns for submitting bug reports -(defconst c-version "4.379" +(defconst c-version "4.387" "CC Mode version number.") (defconst c-mode-help-address "bug-gnu-emacs@prep.ai.mit.edu, cc-mode-help@python.org" @@ -5220,7 +5224,10 @@ (interactive) ;; load in reporter (let ((reporter-prompt-for-summary-p t) - (reporter-dont-compact-list '(c-offsets-alist))) + (reporter-dont-compact-list '(c-offsets-alist)) + (style c-indentation-style) + (hook c-special-indent-hook) + (c-features c-emacs-features)) (and (if (y-or-n-p "Do you want to submit a report on CC Mode? ") t (message "") nil) @@ -5247,6 +5254,7 @@ 'c-hanging-colons-alist 'c-hanging-comment-starter-p 'c-hanging-comment-ender-p + 'c-indent-comments-syntactically-p 'c-tab-always-indent 'c-recognize-knr-p 'c-label-minimum-indentation @@ -5259,15 +5267,15 @@ (function (lambda () (insert - "Buffer Style: " c-indentation-style "\n\n" - (if c-special-indent-hook + "Buffer Style: " style "\n\n" + (if hook (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n" "c-special-indent-hook is set to '" - (format "%s" c-special-indent-hook) + (format "%s" hook) ".\nPerhaps this is your problem?\n" "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n") "\n") - (format "c-emacs-features: %s\n" c-emacs-features) + (format "c-emacs-features: %s\n" c-features) ))) nil "Dear Barry,"
--- a/lisp/modes/sendmail.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/modes/sendmail.el Mon Aug 13 09:21:54 2007 +0200 @@ -295,20 +295,29 @@ :group 'message :type 'boolean) +;;;###autoload (defun user-mail-address () "Query the user for his mail address, unless it is already known." (interactive) - (when query-user-mail-address - (setq user-mail-address - (read-string "Your mail address? " (cons user-mail-address 0))) - (setq query-user-mail-address nil) - ;; TODO: Run sanity check from Gnus here. - (when (y-or-n-p "Save address for future sessions? ") - (put 'user-mail-address 'saved-value - (list user-mail-address)) - (put 'query-user-mail-address 'saved-value '(nil)) - (custom-save-all))) - user-mail-address) + (when (and (not noninteractive) query-user-mail-address) + (let ((addr (or user-mail-address + (concat (user-login-name) "@" + (or mail-host-address + (system-name)))))) + (setq user-mail-address + (read-string "Your mail address? " (cons addr 0))) + (setq query-user-mail-address nil) + ;; TODO: Run sanity check from Gnus here. + (when (y-or-n-p "Save address for future sessions? ") + (put 'user-mail-address 'saved-value + (list user-mail-address)) + (put 'query-user-mail-address 'saved-value '(nil)) + (custom-save-all))) + (if user-mail-address + user-mail-address + (setq user-mail-address (concat (user-login-name) "@" + (or mail-host-address + (system-name))))))) (defun mail-setup (to subject in-reply-to cc replybuffer actions) (or mail-default-reply-to @@ -630,7 +639,7 @@ ;; they put one in themselves. (goto-char (point-min)) (if (not (re-search-forward "^From:" delimline t)) - (let* ((login user-mail-address) + (let* ((login (user-mail-address)) (fullname (user-full-name))) (cond ((eq mail-from-style 'angles) (insert "From: " fullname)
--- a/lisp/mu/mu-cite.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/mu/mu-cite.el Mon Aug 13 09:21:54 2007 +0200 @@ -6,7 +6,7 @@ ;; MINOURA Makoto <minoura@netlaputa.or.jp> ;; Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp> ;; Maintainer: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp> -;; Version: $Revision: 1.5 $ +;; Version: $Revision: 1.6 $ ;; Keywords: mail, news, citation ;; This file is part of MU (Message Utilities). @@ -54,7 +54,7 @@ ;;; (defconst mu-cite/RCS-ID - "$Id: mu-cite.el,v 1.5 1997/03/16 03:05:20 steve Exp $") + "$Id: mu-cite.el,v 1.6 1997/03/22 06:02:28 steve Exp $") (defconst mu-cite/version (get-version-string mu-cite/RCS-ID)) @@ -95,21 +95,8 @@ ;;; @ field ;;; -(defvar mu-cite/get-field-value-method-alist - (list (cons 'mh-letter-mode - (function - (lambda (name) - (if (and (stringp mh-sent-from-folder) - (numberp mh-sent-from-msg)) - (save-excursion - (set-buffer mh-sent-from-folder) - (set-buffer mh-show-buffer) - (and (boundp 'mime::preview/article-buffer) - (bufferp mime::preview/article-buffer) - (set-buffer mime::preview/article-buffer)) - (std11-field-body name) - )) - ))))) +(defvar mu-cite/get-field-value-method-alist nil + "Alist major-mode vs. function to get field-body of header.") (defun mu-cite/get-field-value (name) (or (std11-field-body name)
--- a/lisp/mule/mule-coding.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/mule/mule-coding.el Mon Aug 13 09:21:54 2007 +0200 @@ -254,3 +254,7 @@ (set-coding-category-system 'iso-8-1 'ctext) (set-coding-category-system 'iso-lock-shift 'iso-2022-lock) (set-coding-category-system 'no-conversion 'no-conversion) + +(make-compatible-variable 'enable-multibyte-characters "Unimplemented") + +;;; mule-coding.el ends here
--- a/lisp/packages/add-log.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/packages/add-log.el Mon Aug 13 09:21:54 2007 +0200 @@ -55,7 +55,7 @@ ;; So that the dump-time value doesn't go into loaddefs.el with the autoload. (or add-log-mailing-address - (setq add-log-mailing-address user-mail-address)) + (setq add-log-mailing-address (user-mail-address))) (defvar change-log-font-lock-keywords '(("^[SMTWF].+" . font-lock-function-name-face) ; Date line. @@ -168,7 +168,7 @@ (or add-log-full-name (setq add-log-full-name (user-full-name))) (or add-log-mailing-address - (setq add-log-mailing-address user-mail-address)) + (setq add-log-mailing-address (user-mail-address))) (if whoami (progn (setq add-log-full-name (read-string "Full name: " add-log-full-name))
--- a/lisp/packages/balloon-help.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/packages/balloon-help.el Mon Aug 13 09:21:54 2007 +0200 @@ -57,7 +57,7 @@ (provide 'balloon-help) -(defvar balloon-help-version "1.04" +(defvar balloon-help-version "1.05" "Version string for Balloon Help.") (defvar balloon-help-mode t @@ -138,8 +138,6 @@ as the X server gets around to displaying it. Nil means it will be invisible as soon as the X server decides to hide it.") -(defvar balloon-help-bar-cursor nil) - (defun balloon-help-mode (&optional arg) "Toggle Balloon Help mode. With arg, turn Balloon Help mode on iff arg is positive. @@ -183,6 +181,16 @@ (let* ((buffer (event-buffer event)) (frame (event-frame event)) (point (and buffer (event-point event))) + (modeline-point (and buffer (event-modeline-position event))) + (modeline-extent (and modeline-point + (map-extents + (function (lambda (e ignored) e)) + (symbol-value-in-buffer + 'generated-modeline-string + buffer) + modeline-point modeline-point + nil nil + 'balloon-help))) (glyph-extent (event-glyph-extent event)) (glyph-extent (if (and glyph-extent (extent-property glyph-extent @@ -194,7 +202,7 @@ (button (if (and button (toolbar-button-help-string button)) button nil)) - (object (or glyph-extent extent button)) + (object (or modeline-extent glyph-extent extent button)) (id balloon-help-timeout-id)) (if (null object) (if (and balloon-help-frame @@ -278,7 +286,6 @@ (get-buffer-create " *balloon-help*"))) (if (not (frame-live-p balloon-help-frame)) (setq balloon-help-frame (balloon-help-make-help-frame))) - (setq bar-cursor t) (set-buffer balloon-help-buffer) (erase-buffer) (insert help) @@ -309,7 +316,6 @@ (balloon-help-expose-help-frame)))))) (defun balloon-help-undisplay-help () - (setq bar-cursor balloon-help-bar-cursor) (balloon-help-hide-help-frame)) (defun balloon-help-hide-help-frame () @@ -347,11 +353,14 @@ (defun balloon-help-make-junk-frame () (let ((window-min-height 1) (window-min-width 1)) - (make-frame '(minibuffer t initially-unmapped t width 1 height 1)))) + (save-excursion + (set-buffer (generate-new-buffer "*junk-frame-buffer*")) + (prog1 + (make-frame '(minibuffer t initially-unmapped t width 1 height 1)) + (rename-buffer " *junk-frame-buffer*" t))))) (defun balloon-help-make-help-frame () (save-excursion - (setq balloon-help-bar-cursor bar-cursor) (set-buffer balloon-help-buffer) (set-buffer-menubar nil) (let* ((x (balloon-help-compute-help-frame-x-location))
--- a/lisp/packages/font-lock.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/packages/font-lock.el Mon Aug 13 09:21:54 2007 +0200 @@ -770,8 +770,10 @@ (setq font-lock-old-extent nil))) (defun font-lock-pre-idle-hook () - (if font-lock-old-extent - (font-lock-fontify-glumped-region))) + (condition-case nil + (if font-lock-old-extent + (font-lock-fontify-glumped-region)) + (error (warn "Error caught in `font-lock-pre-idle-hook'")))) (defvar font-lock-always-fontify-immediately nil "Set this to non-nil to disable font-lock deferral.") @@ -2269,9 +2271,11 @@ '(2 font-lock-reference-face) (list (concat "\\=\\.\\(" java-font-lock-identifier-regexp "\\)") - nil nil '(1 (if (= (char-after (match-end 0)) ?.) - 'font-lock-reference-face - 'font-lock-type-face)))) + nil nil '(1 (let ((c (char-after (match-end 0)))) + (if (and (characterp c) + (= c ?.)) + 'font-lock-reference-face + 'font-lock-type-face))))) ;; Constructors: (list (concat
--- a/lisp/packages/gnuserv.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/packages/gnuserv.el Mon Aug 13 09:21:54 2007 +0200 @@ -5,7 +5,7 @@ ; Copying is permitted under those conditions described by the GNU ; General Public License. ; -; Copyright (C) 1989-1994 Free Software Foundation, Inc. +; Copyright (C) 1989-1996 Free Software Foundation, Inc. ; ; Author: Andy Norman (ange@hplb.hpl.hp.com) based on ; 'lisp/server.el' from the 18.52 GNU Emacs distribution. @@ -53,6 +53,12 @@ ; ; Ben Wing <wing@666.com> May/1996 ; patch to get TTY terminal type correct. +; +; Jan Vroonhof <vroonhof@math.ethz.ch> July/1996 +; ported the server-temp-file-regexp feature from server.el +; ported server hooks from server.el +; ported kill-*-query functions from server.el (and made it optional) +; synced other behaviour with server.el @@ -74,11 +80,29 @@ (defvar server-done-function 'kill-buffer "*A function of one argument, a buffer, which removes the buffer after editing. -Functions such as 'kill-buffer' and 'bury-buffer' are good values.") +Functions such as 'kill-buffer' and 'bury-buffer' are good values. See also +`server-done-temp-file-function'") + +(defvar server-done-temp-file-function 'kill-buffer + "*A function of one argument, a buffer, which removes the buffer after editing a +temporary file. Functions such as 'kill-buffer' and 'bury-buffer' are +good values. See also `server-done-function'") (defvar server-program "gnuserv" "*The program to use as the edit server") + + (defvar server-visit-hook nil + "*List of hooks to call when visiting a file for the Emacs server.") + +;; defined by server.el but obsolete? +;; (defvar server-switch-hook nil +;; "*List of hooks to call when switching to a buffer for the Emacs server.") + +(defvar server-done-hook nil + "*List of hooks to call when done editing a buffer for the Emacs server.") + + (defvar server-process nil "The current server process") @@ -97,15 +121,39 @@ that can be given to the server process to identify a client. When a buffer is killed, it is removed from this list.") +(defvar server-kill-quietly nil + "If this variable is set then don't confirm kills of buffers with + clients attached") + + (defvar server-buffer-clients nil "List of client ids for clients requesting editing of the current buffer.") +(defvar server-temp-file-regexp "^/tmp/Re\\|/draft$" + "*Regexp which should match filenames of temporary files +which are deleted and reused after each edit +by the programs that invoke the emacs server.") + +(defvar server-make-temp-file-backup nil + "Non-nil makes the server backup temporary files also") + (make-variable-buffer-local 'server-buffer-clients) (setq-default server-buffer-clients nil) (or (assq 'server-buffer-clients minor-mode-alist) (setq minor-mode-alist (cons '(server-buffer-clients " Server") minor-mode-alist))) +(defun server-temp-file-p (buffer) + "Return non-nil if BUFFER contains a file considered temporary. +These are files whose names suggest they are repeatedly +reused to pass information to another program. + +The variable `server-temp-file-regexp' controls which filenames +are considered temporary." + (and (buffer-file-name buffer) + (string-match server-temp-file-regexp (buffer-file-name buffer)))) + + (defun server-log (string) "If a *server* buffer exists, write STRING to it for logging purposes." (if (get-buffer "*server*") @@ -200,7 +248,7 @@ ;; make gnuserv-start an alias to server-start, for backward compatibility (fset 'server-start (function gnuserv-start)) - +; Can gnuserv handle commands in close succesion? (See server.el line 283) JV (defun server-write-to-client (client form) "Write the given form to the given client via the server process." (if (and client @@ -246,7 +294,8 @@ (select-frame (make-frame nil device)) (if (not file) (switch-to-buffer (get-buffer-create "*scratch*")) - (find-file file)))) + (find-file file))) + (run-hooks 'server-visit-hook)) (defun server-find-file (file) "Edit file FILENAME. @@ -301,7 +350,8 @@ (find-file file)) (select-screen (create-screen (find-file-noselect file))))) - (t (find-file file))))) ;; emacs18+ + (t (find-file file)))) ;; emacs18+ + (run-hooks 'server-visit-hook)) (defun server-edit-files-quickly (list) @@ -411,6 +461,34 @@ (setq old-clients (cdr old-clients)))))))) +;; Ask before killing a server buffer. +;; It was suggested to release its client instead, +;; but I think that is dangerous--the client would proceed +;; using whatever is on disk in that file. -- rms. +(defun server-kill-buffer-query-function () + (or server-kill-quietly + (not server-buffer-clients) + (yes-or-no-p (format "Buffer `%s' still has clients; kill it? " + (buffer-name (current-buffer)))))) + +(add-hook 'kill-buffer-query-functions + 'server-kill-buffer-query-function) + +(defun server-kill-emacs-query-function () + (let (live-client + (tail server-clients)) + ;; See if any clients have any buffers that are still alive. + (while tail + (if (memq t (mapcar 'stringp (mapcar 'buffer-name (cdr (car tail))))) + (setq live-client t)) + (setq tail (cdr tail))) + (or server-kill-quietly + (not live-client) + (yes-or-no-p "Server buffers still have clients; exit anyway? ")))) + +(add-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function) + + (defun server-kill-all-local-variables () "Eliminate all the buffer-local variable values of the current buffer. This buffer will then see the default values of all variables. @@ -438,6 +516,7 @@ "Mark BUFFER as \"done\" for its client(s). Buries the buffer, and returns another server buffer as a suggestion for the new current buffer." + ; Note we do NOT return a list with a killed flag, doesn't seem usefull to me. JV (let ((next-buffer nil) (old-clients server-clients)) (while old-clients @@ -445,6 +524,13 @@ (or next-buffer (setq next-buffer (nth 1 (memq buffer client)))) (delq buffer client) + ;; Delete all dead buffers from CLIENT. (Why? JV , copyed from server.el) + (let ((tail client)) + (while tail + (and (bufferp (car tail)) + (null (buffer-name (car tail))) + (delq (car tail) client)) + (setq tail (cdr tail)))) ;; If client now has no pending buffers, ;; tell it that it is done, and forget it entirely. (if (cdr client) @@ -452,13 +538,16 @@ (if (buffer-name buffer) (save-excursion (set-buffer buffer) - (setq server-buffer-clients nil))) + (setq server-buffer-clients nil) + (run-hooks 'server-done-hook))) ; Order is important here -- ; server-kill-buffer tries to notify clients that ; they are done, too, but if we try and notify twice, ; we are h0zed -- Hunter Kelly 3/3/97 (setq server-clients (delq client server-clients)) - (funcall server-done-function buffer) + (if (server-temp-file-p buffer) + (funcall server-done-temp-file-function buffer) + (funcall server-done-function buffer)) (server-write-to-client (car client) nil))) (setq old-clients (cdr old-clients))) next-buffer)) @@ -477,22 +566,32 @@ (let ((buffer (current-buffer))) (if server-buffer-clients (progn - (if (mh-draft-p buffer) + (if (mh-draft-p buffer);; Does this comflict with temp-file ? JV (progn (save-buffer) (write-region (point-min) (point-max) (concat buffer-file-name "~")) (kill-buffer buffer)) - (if (and (buffer-modified-p) - (y-or-n-p (concat "Save file " buffer-file-name "? "))) - (save-buffer buffer))) + (if (server-temp-file-p buffer) + ;; For a temp file, save, and do NOT make a non-numeric backup + ;; Why does server.el explicitly back up temporary files? + (let ((version-control nil) + (buffer-backed-up (not server-make-temp-file-backup))) + (save-buffer)) + (if (and (buffer-modified-p) + (y-or-n-p (concat "Save file " buffer-file-name "? "))) + (save-buffer buffer)))) (server-buffer-done buffer))))) (defun server-edit (&optional arg) - "Switch to next server editing buffer and mark current one as \"done\". -If a server buffer is current, it is marked \"done\" and optionally saved. -MH <draft> files are always saved and backed up, no questions asked. -When all of a client's buffers are marked as \"done\", the client is notified. + "Switch to next server editing +buffer and mark current one as \"done\". If a server buffer is +current, it is marked \"done\" and optionally saved. MH <draft> files +are always saved and backed up, no questions asked. Files that match +server-temp-file-regexp are considered temporary and are saved +unconditionally and +backed up if server-make-temp-file-backup is non-nil. When all of a +client's buffers are marked as \"done\", the client is notified. If invoked with a prefix argument, or if there is no server process running, starts server process and that is all. Invoked by \\[server-edit]. @@ -504,7 +603,7 @@ (memq (process-status server-process) '(signal exit))) (server-start nil) (if server-buffer-clients - (progn (server-switch-buffer (server-done)) + (progn (server-done-and-switch) (cond ((fboundp 'console-type) ;; XEmacs 19.14+ (or (and (equal (console-type) 'x) gnuserv-frame @@ -531,10 +630,11 @@ "(server-edit): Use only on buffers created by external programs.") ))) -(defun server-switch-buffer (next-buffer) +(defun server-switch-buffer-internal (next-buffer always) "Switch to NEXT-BUFFER if a live buffer, otherwise switch to another buffer -with gnuserv clients. If no such buffer is available, simply choose another -one." +with gnuserv clients. If no such buffer is available, we switch to +another normal buffer if `always' is non-nil!" + ;; switching (if next-buffer (if (and (bufferp next-buffer) (buffer-name next-buffer)) @@ -542,11 +642,28 @@ ;; If NEXT-BUFFER is a dead buffer, ;; remove the server records for it ;; and try the next surviving server buffer. - (server-switch-buffer - (server-buffer-done next-buffer))) - (if server-clients - (server-switch-buffer (nth 1 (car server-clients))) - (switch-to-buffer (other-buffer))))) + (server-switch-buffer-internal + (server-buffer-done next-buffer) always)) + (if server-clients + (server-switch-buffer-internal (nth 1 (car server-clients)) always) + (if always + (switch-to-buffer (other-buffer)))))) + +;; For compatability +(defun server-switch-buffer (next-buffer) + (server-switch-buffer-internal next-buffer t)) + +;; The below function calles server-done and switches to the next +;; sensible buffer. This implementation works regardless of the values +;; of server-*-function and doens't need the tail recursion +;; variable passing of server.el. It is more transparant too. JV +(defun server-done-and-switch () + "Be done with the current buffer and switch to another server buffer + if there is one, otherwise just switch buffer" + (let ((old-current (current-buffer))) + (server-switch-buffer-internal (server-done) nil) + (if (eq old-current (current-buffer)) + (switch-to-buffer (other-buffer))))) (global-set-key "\C-x#" 'server-edit)
--- a/lisp/packages/time.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/packages/time.el Mon Aug 13 09:21:54 2007 +0200 @@ -38,6 +38,9 @@ ;;; the old mechanism for specifying what is to be displayed. ;;; The starting variable to look at is `display-time-form-list' +;;; Thanks to Mike Scheidler for the idea to make the time led's fore- and +;;; background color customizable + ;;; Code: (require 'itimer) @@ -141,6 +144,11 @@ (start-itimer "display-time" 'display-time-function display-time-interval display-time-interval)) +(defun display-time-stop () + (interactive) + (delete-itimer "display-time") + (setq display-time-string nil)) + (defcustom display-time-show-icons-maybe t "Use icons for time, load and mail status if possible and not specified different explicitely" @@ -163,11 +171,37 @@ :group 'display-time :type 'string) -(defcustom display-time-display-pad t - "Wether the load indicator is displayed with a trapezoidal \"pad\" -in the background" +(defcustom display-time-display-pad "grey35" + "How the load indicator's trapezoidal \"pad\" is to be displayed. +This can be 'transparent or a string describing the color it should have" + :group 'display-time + :type '(choice :tag "Value" + (const transparent) + (string :tag "Color"))) + +(defcustom display-time-display-time-foreground "firebrick" + "How the time LEDs foreground is to be displayed. +This can be 'modeline (foreground color of the Modeline) +or a string describing the color it should have" :group 'display-time - :type 'boolean) + :type '(choice :tag "Value" + (const modline) + (string :tag "Color"))) + +(defcustom display-time-display-time-background 'transparent + "How the time LEDs background is to be displayed. +This can be 'transparent or a string describing the color it should have" + :group 'display-time + :type '(choice :tag "Value" + (const transparent) + (string :tag "Color"))) + + +(defvar display-time-display-pad-old nil) + +(defvar display-time-display-time-fg-old nil) + +(defvar display-time-display-time-bg-old nil) (defcustom display-time-load-list (list 0.2 0.5 0.8 1.1 1.8 2.6) @@ -175,108 +209,149 @@ which correspond to the six different icons to be displayed as a load indicator" :group 'display-time - :type '(list (number :tag "Threshold 1 load") - (number :tag "Threshold 2 load") - (number :tag "Threshold 3 load") - (number :tag "Threshold 4 load") - (number :tag "Threshold 5 load") - (number :tag "Threshold 6 load"))) + :type '(list (number :tag "Threshold 1") + (number :tag "Threshold 2") + (number :tag "Threshold 3") + (number :tag "Threshold 4") + (number :tag "Threshold 5") + (number :tag "Threshold 6"))) (defun display-time-string-to-char-list (str) (mapcar (function identity) str)) -(if (featurep 'xpm) +(defun display-time-generate-load-glyphs (&optional force) + (let* ((pad-color (if (symbolp display-time-display-pad) + (list "pad-color" '(face-background 'modeline)) + (list "pad-color" display-time-display-pad))) + (xpm-color-symbols (append (list pad-color) xpm-color-symbols))) + (if (and (featurep 'xpm) + (or force (not (equal display-time-display-pad + display-time-display-pad-old)))) + (progn + (setq display-time-load-0.0-glyph + (cons (make-extent nil nil) + (make-glyph + (concat display-time-icons-dir "l-0.0.xpm")))) + (setq display-time-load-0.5-glyph + (cons (make-extent nil nil) + (make-glyph + (concat display-time-icons-dir "l-0.5.xpm")))) + (setq display-time-load-1.0-glyph + (cons (make-extent nil nil) + (make-glyph + (concat display-time-icons-dir "l-1.0.xpm")))) + (setq display-time-load-1.5-glyph + (cons (make-extent nil nil) + (make-glyph + (concat display-time-icons-dir "l-1.5.xpm")))) + (setq display-time-load-2.0-glyph + (cons (make-extent nil nil) + (make-glyph + (concat display-time-icons-dir "l-2.0.xpm")))) + (setq display-time-load-2.5-glyph + (cons (make-extent nil nil) + (make-glyph + (concat display-time-icons-dir "l-2.5.xpm")))) + (setq display-time-load-3.0-glyph + (cons (make-extent nil nil) + (make-glyph + (concat display-time-icons-dir "l-3.0.xpm")))) + (setq display-time-display-pad-old display-time-display-pad) + )))) + + +(defun display-time-generate-time-glyphs (&optional force) + (let* ((ledbg (if (symbolp display-time-display-time-background) + (list "ledbg" '(face-background 'modeline)) + (list "ledbg" display-time-display-time-background))) + (ledfg (if (symbolp display-time-display-time-foreground) + (list "ledfg" '(face-foreground 'modeline)) + (list "ledfg" display-time-display-time-foreground))) + (xpm-color-symbols (append (list ledbg) + (list ledfg) xpm-color-symbols))) + (if (and (featurep 'xpm) + (or force (not (equal display-time-display-time-background + display-time-display-time-bg-old)) + (not (equal display-time-display-time-foreground + display-time-display-time-fg-old)))) + (progn + (setq display-time-1-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "1.xpm")))) + (setq display-time-2-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "2.xpm")))) + (setq display-time-3-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "3.xpm")))) + (setq display-time-4-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "4.xpm")))) + (setq display-time-5-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "5.xpm")))) + (setq display-time-6-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "6.xpm")))) + (setq display-time-7-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "7.xpm")))) + (setq display-time-8-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "8.xpm")))) + (setq display-time-9-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "9.xpm")))) + (setq display-time-0-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "0.xpm")))) + (setq display-time-:-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "dp.xpm")))) + (setq display-time-am-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "am.xpm")))) + (setq display-time-pm-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "pm.xpm")))) + (setq display-time-display-time-fg-old + display-time-display-time-foreground + display-time-display-time-bg-old + display-time-display-time-background) + )))) + + (if (featurep 'xpm) (progn (defvar display-time-mail-sign (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "letter.xpm")))) + (make-glyph (concat display-time-icons-dir "letter.xpm")))) (defvar display-time-no-mail-sign (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "no-letter.xpm")))) - (defvar display-time-1-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "1.xpm")))) - (defvar display-time-2-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "2.xpm")))) - (defvar display-time-3-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "3.xpm")))) - (defvar display-time-4-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "4.xpm")))) - (defvar display-time-5-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "5.xpm")))) - (defvar display-time-6-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "6.xpm")))) - (defvar display-time-7-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "7.xpm")))) - (defvar display-time-8-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "8.xpm")))) - (defvar display-time-9-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "9.xpm")))) - (defvar display-time-0-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "0.xpm")))) - (defvar display-time-:-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "dp.xpm")))) - (defvar display-time-load-0.0-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "l-0.0.xpm")))) - (defvar display-time-load-0.5-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "l-0.5.xpm")))) - (defvar display-time-load-1.0-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "l-1.0.xpm")))) - (defvar display-time-load-1.5-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "l-1.5.xpm")))) - (defvar display-time-load-2.0-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "l-2.0.xpm")))) - (defvar display-time-load-2.5-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "l-2.5.xpm")))) - (defvar display-time-load-3.0-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "l-3.0.xpm")))) - (defvar display-time-load-0.0-jtl-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "l-jtl-0.0.xpm")))) - (defvar display-time-load-0.5-jtl-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "l-jtl-0.5.xpm")))) - (defvar display-time-load-1.0-jtl-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "l-jtl-1.0.xpm")))) - (defvar display-time-load-1.5-jtl-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "l-jtl-1.5.xpm")))) - (defvar display-time-load-2.0-jtl-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "l-jtl-2.0.xpm")))) - (defvar display-time-load-2.5-jtl-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "l-jtl-2.5.xpm")))) - (defvar display-time-load-3.0-jtl-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "l-jtl-3.0.xpm")))) - (defvar display-time-am-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "am.xpm")))) - (defvar display-time-pm-glyph - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "pm.xpm")))) + (make-glyph (concat display-time-icons-dir "no-letter.xpm")))) + (defvar display-time-1-glyph nil) + (defvar display-time-2-glyph nil) + (defvar display-time-3-glyph nil) + (defvar display-time-4-glyph nil) + (defvar display-time-5-glyph nil) + (defvar display-time-6-glyph nil) + (defvar display-time-7-glyph nil) + (defvar display-time-8-glyph nil) + (defvar display-time-9-glyph nil) + (defvar display-time-0-glyph nil) + (defvar display-time-:-glyph nil) + (defvar display-time-am-glyph nil) + (defvar display-time-pm-glyph nil) + (defvar display-time-load-0.0-glyph nil) + (defvar display-time-load-0.5-glyph nil) + (defvar display-time-load-1.0-glyph nil) + (defvar display-time-load-1.5-glyph nil) + (defvar display-time-load-2.0-glyph nil) + (defvar display-time-load-2.5-glyph nil) + (defvar display-time-load-3.0-glyph nil) + (display-time-generate-time-glyphs 'force) + (display-time-generate-load-glyphs 'force) )) - (defun display-time-can-do-graphical-display (&optional textual) (and display-time-show-icons-maybe (not textual) @@ -289,6 +364,7 @@ (let ((list (display-time-string-to-char-list time-string)) elem tmp) (if (not (display-time-can-do-graphical-display textual)) time-string + (display-time-generate-time-glyphs) (while (setq elem (pop list)) (push (eval (intern-soft (concat "display-time-" (char-to-string elem) @@ -308,11 +384,11 @@ result elem) (if (not (display-time-can-do-graphical-display textual)) load-string + (display-time-generate-load-glyphs) (while (>= load-number (cdr (setq elem (pop alist)))) (setq result (eval (intern-soft (concat "display-time-load-" (number-to-string (car elem)) - (if display-time-display-pad "-jtl") "-glyph"))))) result))) @@ -410,7 +486,7 @@ mail-text: The same as above, but will not use a glyph" :group 'display-time - :type '(repeat (choice :tag "Toggle Symbol/String" + :type '(repeat (choice :tag "Symbol/String" (const :tag "Date" date) (const :tag "Time" time) (const :tag "Time (text)" time-text)
--- a/lisp/pcl-cvs/ChangeLog Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/pcl-cvs/ChangeLog Mon Aug 13 09:21:54 2007 +0200 @@ -1,3 +1,7 @@ +Wed Mar 19 23:25:26 1997 Steven L Baur <steve@altair.xemacs.org> + + * pcl-cvs.el (cvs-changelog-ours-p): Use function. + Sat Dec 21 22:37:37 1996 Neal Becker <neal@ctd.comsat.com> * pcl-cvs.el: Synched with pcl-cvs.el from cvs-1.9.
--- a/lisp/pcl-cvs/pcl-cvs.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/pcl-cvs/pcl-cvs.el Mon Aug 13 09:21:54 2007 +0200 @@ -1,10 +1,10 @@ ;;; ;;;#ident "@(#)OrigId: pcl-cvs.el,v 1.93 1993/05/31 22:44:00 ceder Exp " ;;; -;;;#ident "@(#)cvs/contrib/pcl-cvs:$Name: r20-0b33 $:$Id: pcl-cvs.el,v 1.2 1996/12/28 21:03:03 steve Exp $" +;;;#ident "@(#)cvs/contrib/pcl-cvs:$Name: r20-1b9 $:$Id: pcl-cvs.el,v 1.3 1997/03/22 06:02:36 steve Exp $" ;;; ;;; pcl-cvs.el -- A Front-end to CVS 1.3 or later. -;;; Release 1.05-CVS-$Name: r20-0b33 $. +;;; Release 1.05-CVS-$Name: r20-1b9 $. ;;; Copyright (C) 1991, 1992, 1993 Per Cederqvist ;;; This program is free software; you can redistribute it and/or modify @@ -126,7 +126,7 @@ ;;; END OF THINGS TO CHECK WHEN INSTALLING ;;; -------------------------------------------------------- -(defconst pcl-cvs-version "1.05-CVS-$Name: r20-0b33 $" +(defconst pcl-cvs-version "1.05-CVS-$Name: r20-1b9 $" "A string denoting the current release version of pcl-cvs.") ;; You are NOT allowed to disable this message by default. However, you @@ -139,8 +139,8 @@ (defconst cvs-startup-message (if cvs-inhibit-copyright-message - "PCL-CVS release 1.05-CVS-$Name: r20-0b33 $" - "PCL-CVS release 1.05 from CVS release $Name: r20-0b33 $. + "PCL-CVS release 1.05-CVS-$Name: r20-1b9 $" + "PCL-CVS release 1.05 from CVS release $Name: r20-1b9 $. Copyright (C) 1992, 1993 Per Cederqvist Pcl-cvs comes with absolutely no warranty; for details consult the manual. This is free software, and you are welcome to redistribute it under certain @@ -724,7 +724,7 @@ \\[cvs-mode-undo-local-changes] Revert the last checked in version - discard your changes to the file. Entry to this mode runs cvs-mode-hook. -This description is updated for release 1.05-CVS-$Name: r20-0b33 $ of pcl-cvs. +This description is updated for release 1.05-CVS-$Name: r20-1b9 $ of pcl-cvs. All bindings: \\{cvs-mode-map}" @@ -1013,7 +1013,7 @@ (insert "Pcl-cvs Version: " "@(#)OrigId: pcl-cvs.el,v 1.93 1993/05/31 22:44:00 ceder Exp\n") (insert "CVS Version: " - "@(#)lisp/pcl-cvs:$Name: r20-0b33 $:$Id: pcl-cvs.el,v 1.2 1996/12/28 21:03:03 steve Exp $\n\n") + "@(#)lisp/pcl-cvs:$Name: r20-1b9 $:$Id: pcl-cvs.el,v 1.3 1997/03/22 06:02:36 steve Exp $\n\n") (insert (format "--- Contents of stdout buffer (%d chars) ---\n" (length stdout))) (insert stdout) @@ -1410,6 +1410,13 @@ (setcdr head (list fileinfo)) (setq head (cdr head))))))) + ;; Patch failure message with CVS client. + ;; Ignore, since a failed patch implies that the file proper + ;; subsequently will be fetched from the server. + ((looking-at + "^[0-9]+ out of [0-9]+ hunks failed--saving rejects to ") + (forward-line 1)) + ;; Error messages from CVS (incomplete) ((looking-at @@ -1534,6 +1541,13 @@ (re-search-forward cvs-update-prog-output-skip-regexp) (forward-line 1)) + ;; Patch informational message with CVS client. + ;; Ignore, since this simply tells us that the patch in question + ;; already has been applied to the file. + ((looking-at + "^.* already contains the differences between .* and ") + (forward-line 1)) + (t (cvs-parse-error stdout-buffer stderr-buffer 'STDOUT (point) "cvs-parse-stdout")))))) @@ -3301,7 +3315,7 @@ (regexp-quote (if (and (boundp 'add-log-mailing-address) add-log-mailing-address) add-log-mailing-address - user-mail-address))))) + (user-mail-address)))))) (defun cvs-relative-path (base child) "Return a directory path relative to BASE for CHILD.
--- a/lisp/prim/about.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/prim/about.el Mon Aug 13 09:21:54 2007 +0200 @@ -180,10 +180,14 @@ (save-restriction (set who nil) (narrow-to-region (point) (point)) - (insert-file-contents who-xpm) + (let ((coding-system-for-read 'binary)) + (insert-file-contents who-xpm)) (if (looking-at "\037\235") ;may already be decompressed... - (call-process-region (point-min) (point-max) - "zcat" t t nil)) + (let ((coding-system-for-write 'binary) + process-input-coding-system + process-output-coding-system) + (call-process-region (point-min) (point-max) + "zcat" t t nil))) (set who (make-glyph (prog1 (buffer-string) (delete-region (point-min) (point-max))))) @@ -653,13 +657,14 @@ ((eq xref 'baw) (about-face "Barry Warsaw" 'bold) - (insert " <bwarsaw@cnri.reston.va.us> + (insert " <bwarsaw@python.org> Author of cc-mode for C++, C, and Objective-C editing, and Supercite for mail and news citing. Also various and sundry other Emacs utilities, fixes, enhancements and kludgery as whimsy, boredom, and ToT dictate (but not necessarily in that order). + See \"http://www.python.org/~bwarsaw\". Daddy © 1994 Warsaw @@ -824,7 +829,7 @@ Contributor of many dispersed improvements in the core Lisp code, and back-seat contributor for several of it's major packages. - ") (about-xref "Barry Warsaw" 'baw "Find out more about Barry Warsaw") (insert " <bwarsaw@cnri.reston.va.us> + ") (about-xref "Barry Warsaw" 'baw "Find out more about Barry Warsaw") (insert " <bwarsaw@python.org> Author of cc-mode for C++, C, and Objective-C editing, and Supercite for mail and news citing. Also various and sundry other Emacs utilities, fixes, enhancements and kludgery as whimsy,
--- a/lisp/prim/auto-autoloads.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/prim/auto-autoloads.el Mon Aug 13 09:21:54 2007 +0200 @@ -1304,7 +1304,7 @@ For example: - (setq dired-compresssion-method-alist + (setq dired-compression-method-alist (cons '(frobnicate \".frob\" (\"frob\") (\"frob\" \"-d\") \"-f\") dired-compression-method-alist)) => ((frobnicate \".frob\" (\"frob\") (\"frob\" \"-d\")) @@ -1321,7 +1321,7 @@ Can contain even `F', `b', `i' and `s'.") (defvar dired-chown-program (if (memq system-type '(hpux dgux usg-unix-v)) "chown" "/etc/chown") "\ -*Name of chown command (usully `chown' or `/etc/chown').") +*Name of chown command (usually `chown' or `/etc/chown').") (defvar dired-gnutar-program nil "\ *If non-nil, name of the GNU tar executable (e.g. \"tar\" or \"gnutar\"). @@ -1462,6 +1462,47 @@ ;;;*** +;;;### (autoloads nil "efs-cu" "efs/efs-cu.el") + +(defvar efs-path-root-regexp "^/[^/:]+:" "\ +Regexp to match the `/user@host:' root of an efs full path.") + +;;;*** + +;;;### (autoloads nil "efs-dump" "efs/efs-dump.el") + +(setq file-name-handler-alist (cons (cons efs-path-root-regexp 'efs-file-handler-function) file-name-handler-alist)) + +;;;*** + +;;;### (autoloads (efs-root-file-name-completion efs-root-file-name-all-completions efs-set-passwd) "efs-netrc" "efs/efs-netrc.el") + +(autoload 'efs-set-passwd "efs-netrc" "\ +For a given HOST and USER, set or change the associated PASSWORD." t nil) + +(autoload 'efs-root-file-name-all-completions "efs-netrc" nil nil nil) + +(autoload 'efs-root-file-name-completion "efs-netrc" nil nil nil) + +;;;*** + +;;;### (autoloads (efs-report-bug) "efs-report" "efs/efs-report.el") + +(autoload 'efs-report-bug "efs-report" "\ +Submit a bug report for efs." t nil) + +;;;*** + +;;;### (autoloads (efs-file-handler-function efs-nslookup-host) "efs" "efs/efs.el") + +(autoload 'efs-nslookup-host "efs" "\ +Attempt to resolve the given HOSTNAME using nslookup if possible." t nil) + +(autoload 'efs-file-handler-function "efs" "\ +Function to call special file handlers for remote files." nil nil) + +;;;*** + ;;;### (autoloads (electric-buffer-list) "ebuff-menu" "electric/ebuff-menu.el") (autoload 'electric-buffer-list "ebuff-menu" "\ @@ -2766,7 +2807,7 @@ ;;;*** -;;;### (autoloads (rolo-yank rolo-sort rolo-kill rolo-grep rolo-fgrep rolo-edit rolo-display-matches rolo-add) "wrolo" "hyperbole/wrolo.el") +;;;### (autoloads (rolo-yank rolo-toggle-datestamps rolo-sort rolo-kill rolo-grep rolo-fgrep rolo-edit rolo-display-matches rolo-add) "wrolo" "hyperbole/wrolo.el") (autoload 'rolo-add "wrolo" "\ Adds a new entry in personal rolodex for NAME. @@ -2777,13 +2818,13 @@ (autoload 'rolo-display-matches "wrolo" "\ Display optional DISPLAY-BUF buffer of previously found rolodex matches. -If DISPLAY-BUF is nil, use the value in 'rolo-display-buffer'. +If DISPLAY-BUF is nil, use the value in `rolo-display-buffer'. Second arg RETURN-TO-BUFFER is the buffer to leave point within after the display." t nil) (autoload 'rolo-edit "wrolo" "\ -Edits a rolodex entry given by optional NAME within 'rolo-file-list'. +Edits a rolodex entry given by optional NAME within `rolo-file-list'. With prefix argument, prompts for optional FILE to locate entry within. -With no NAME arg, simply displays FILE or first entry in 'rolo-file-list' in an +With no NAME arg, simply displays FILE or first entry in `rolo-file-list' in an editable mode. NAME may be of the form: parent/child to edit child below a parent entry which begins with the parent string." t nil) @@ -2818,7 +2859,7 @@ rolo-file-list." t nil) (autoload 'rolo-kill "wrolo" "\ -Kills a rolodex entry given by NAME within 'rolo-file-list'. +Kills a rolodex entry given by NAME within `rolo-file-list'. With prefix argument, prompts for optional FILE to locate entry within. NAME may be of the form: parent/child to kill child below a parent entry which begins with the parent string. @@ -2826,9 +2867,13 @@ (autoload 'rolo-sort "wrolo" "\ Sorts up to 14 levels of entries in ROLO-FILE (default is personal rolo). -Assumes entries are delimited by one or more '*'characters. +Assumes entries are delimited by one or more `*'characters. Returns list of number of groupings at each entry level." t nil) +(autoload 'rolo-toggle-datestamps "wrolo" "\ +Toggle whether datestamps are updated when rolodex entries are modified. +With optional ARG, turn them on iff ARG is positive." t nil) + (autoload 'rolo-yank "wrolo" "\ Inserts at point the first rolodex entry matching NAME. With optional prefix arg, REGEXP-P, treats NAME as a regular expression instead @@ -3840,7 +3885,7 @@ ;;;### (autoloads (ksh-mode) "ksh-mode" "modes/ksh-mode.el") (autoload 'ksh-mode "ksh-mode" "\ -ksh-mode $Revision: 1.16 $ - Major mode for editing (Bourne, Korn or Bourne again) +ksh-mode $Revision: 1.17 $ - Major mode for editing (Bourne, Korn or Bourne again) shell scripts. Special key bindings and commands: \\{ksh-mode-map} @@ -4602,7 +4647,7 @@ ;;;*** -;;;### (autoloads (mail-other-frame mail-other-window mail mail-mode) "sendmail" "modes/sendmail.el") +;;;### (autoloads (mail-other-frame mail-other-window mail mail-mode user-mail-address) "sendmail" "modes/sendmail.el") (defvar mail-from-style 'angles "\ *Specifies how \"From:\" fields look. @@ -4663,6 +4708,9 @@ *Text inserted at end of mail buffer when a message is initialized. If t, it means to insert the contents of the file `mail-signature-file'.") +(autoload 'user-mail-address "sendmail" "\ +Query the user for his mail address, unless it is already known." t nil) + (autoload 'mail-mode "sendmail" "\ Major mode for editing mail to be sent. Like Text Mode but with these additional commands: @@ -5192,7 +5240,7 @@ (autoload 'vhdl-mode "vhdl-mode" "\ Major mode for editing VHDL code. -vhdl-mode $Revision: 1.16 $ +vhdl-mode $Revision: 1.17 $ To submit a problem report, enter `\\[vhdl-submit-bug-report]' from a vhdl-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the
--- a/lisp/prim/custom-load.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/prim/custom-load.el Mon Aug 13 09:21:54 2007 +0200 @@ -6,6 +6,7 @@ (put 'gnus-message 'custom-loads '("message")) (put 'gnus-summary-sort 'custom-loads '("gnus-sum")) (put 'nnmail-procmail 'custom-loads '("nnmail")) +(put 'ssl 'custom-loads '("ssl")) (put 'widgets 'custom-loads '("wid-browse" "wid-edit")) (put 'environment 'custom-loads '("cus-edit")) (put 'gnus-article-buttons 'custom-loads '("gnus-art")) @@ -20,15 +21,15 @@ (put 'gnus-article-washing 'custom-loads '("gnus-art")) (put 'mail 'custom-loads '("gnus" "message")) (put 'gnus-summary-exit 'custom-loads '("gnus-sum")) -(put 'comint-input-face 'custom-loads '("comint-xemacs")) (put 'gnus-article-saving 'custom-loads '("gnus-art")) (put 'gnus-extract-view 'custom-loads '("gnus-sum" "gnus-uu")) +(put 'comint 'custom-loads '("comint-xemacs")) (put 'gnus-group-listing 'custom-loads '("gnus-group")) (put 'gnus-summary 'custom-loads '("gnus-sum" "gnus")) (put 'message-headers 'custom-loads '("message")) (put 'gnus-group-select 'custom-loads '("gnus-sum")) (put 'display-time 'custom-loads '("time")) -(put 'hypermedia 'custom-loads '("wid-edit")) +(put 'hypermedia 'custom-loads '("wid-edit" "w3-cus")) (put 'w3-advanced 'custom-loads '("w3-cus")) (put 'w3-menus 'custom-loads '("w3-cus")) (put 'gnus-summary-mail 'custom-loads '("gnus-sum")) @@ -89,12 +90,14 @@ (put 'faces 'custom-loads '("cus-edit" "wid-edit" "gnus" "message")) (put 'gnus-various 'custom-loads '("gnus-sum")) (put 'gnus-article-highlight 'custom-loads '("gnus-art")) -(put 'emacs 'custom-loads '("cus-edit" "dired-faces")) +(put 'emacs 'custom-loads '("cus-edit" "dired-faces" "ssl")) +(put 'processes 'custom-loads '("comint-xemacs")) (put 'news 'custom-loads '("gnus" "message")) (put 'w3-hooks 'custom-loads '("w3-cus")) (put 'message-insertion 'custom-loads '("message")) (put 'wp 'custom-loads '("cus-edit")) (put 'message-faces 'custom-loads '("message")) +(put 'w3 'custom-loads '("w3-cus" "w3-script")) (put 'gnus-score-files 'custom-loads '("gnus-score")) (put 'gnus-summary-marks 'custom-loads '("gnus-sum")) (put 'picons 'custom-loads '("gnus-picon")) @@ -104,3 +107,4 @@ (put 'message-buffers 'custom-loads '("message")) (put 'editing 'custom-loads '("cus-edit")) (put 'gnus-article-mime 'custom-loads '("gnus-art" "gnus-sum")) +(put 'w3-scripting 'custom-loads '("w3-script"))
--- a/lisp/prim/device.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/prim/device.el Mon Aug 13 09:21:54 2007 +0200 @@ -70,3 +70,6 @@ (defalias 'valid-device-type-p 'valid-console-type-p) (defalias 'device-type-list 'console-type-list) +(defalias 'device-pixel-depth 'device-bitplanes) + +;;; device.el ends here
--- a/lisp/prim/glyphs.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/prim/glyphs.el Mon Aug 13 09:21:54 2007 +0200 @@ -465,7 +465,8 @@ (and (image-instance-p object) (eq 'pointer (image-instance-type object)))) (defun subwindow-image-instance-p (object) - "t if OBJECT is an image instance of type `subwindow'." + "t if OBJECT is an image instance of type `subwindow'. +Subwindows are not implemented in this version of XEmacs." (and (image-instance-p object) (eq 'subwindow (image-instance-type object)))) ;;;;;;;;;; the built-in glyphs
--- a/lisp/prim/help.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/prim/help.el Mon Aug 13 09:21:54 2007 +0200 @@ -181,11 +181,10 @@ (defun help-mode-quit () "Exits from help mode, possibly restoring the previous window configuration." (interactive) - (cond ((local-variable-p 'help-window-config (current-buffer)) - (let ((config help-window-config)) - (kill-local-variable 'help-window-config) - (bury-buffer) - (set-window-configuration config))) + (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)) ((one-window-p) (bury-buffer)) (t @@ -345,8 +344,8 @@ This just displays the buffer in another window, rather than selecting the window.") -(defvar help-window-config nil) - +(defvar help-window-max-height .5 + "*Proportion of frame to use for help windows.") ;; Use this function for displaying help when C-h something is pressed ;; or in similar situations. Do *not* use it when you are displaying ;; a help message and then prompting for input in the minibuffer -- @@ -357,7 +356,12 @@ ;;; requirement of caller to code a lambda form in THUNK -- mrb (defun with-displaying-help-buffer (thunk) (let ((winconfig (current-window-configuration)) - (was-one-window (one-window-p))) + (was-one-window (one-window-p)) + (help-not-visible + (not (and (windows-of-buffer "*Help*") ;shortcut + (member (selected-frame) + (mapcar 'window-frame + (windows-of-buffer "*Help*"))))))) (prog1 (with-output-to-temp-buffer "*Help*" (prog1 (funcall thunk) (save-excursion @@ -368,7 +372,11 @@ (progn (save-excursion (set-buffer (window-buffer helpwin)) - (set (make-local-variable 'help-window-config) winconfig)) + ;;If the *Help* buffer is already displayed on this + ;; frame, don't override the previous configuration + (if help-not-visible + (set-frame-property (selected-frame) + 'help-window-config winconfig))) (if help-selects-help-window (select-window helpwin)) (cond ((eq helpwin (selected-window)) @@ -381,6 +389,11 @@ (message (substitute-command-keys "Type \\[switch-to-buffer-other-window] to restore the other window, \\[scroll-other-window] to scroll the help.")))) (when temp-buffer-shrink-to-fit + (let* ((help-window-size (round (* help-window-max-height + (frame-height (window-frame helpwin))))) + (size (window-displayed-height helpwin))) + (if (< size help-window-size) + (enlarge-window (- help-window-size size) nil helpwin))) (shrink-window-if-larger-than-buffer helpwin)))))))) (defun describe-key (key)
--- a/lisp/prim/itimer.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/prim/itimer.el Mon Aug 13 09:21:54 2007 +0200 @@ -22,6 +22,7 @@ ;; `itimer' feature means Emacs-Lisp programmers get: ;; itimerp +;; itimer-live-p ;; itimer-value ;; itimer-restart ;; itimer-function @@ -45,7 +46,7 @@ ;; ;; See the doc strings of these functions for more information. -(defvar itimer-version "1.04" +(defvar itimer-version "1.05" "Version number of the itimer package.") (defvar itimer-list nil @@ -159,6 +160,13 @@ "Returns non-nil iff OBJ is an itimer." (and (consp obj) (eq (length obj) 8))) +(defun itimer-live-p (obj) + "Returns non-nil iff OBJ is an itimer and is active. +``Active'' means Emacs will run it when it expires. +`activate-timer' must be called on a itimer to make it active. +Itimers started with `start-itimer' are automatically active." + (and (itimerp obj) (memq obj itimer-list))) + (defun itimer-name (itimer) "Returns the name of ITIMER." (check-itimer itimer) @@ -268,7 +276,7 @@ (check-itimer itimer) (setcar (nthcdr 5 itimer) flag)) -(defun set-itimer-function-arguments (itimer &rest arguments) +(defun set-itimer-function-arguments (itimer &optional arguments) "Set the function arguments of ITIMER to be ARGUMENTS. The function of ITIMER will be called with ARGUMENTS when itimer expires. Returns ARGUMENTS." @@ -700,6 +708,9 @@ (let* ((current-itimer itimer) (quit-flag nil) (inhibit-quit nil) + ;; for FSF Emacs timer.el emulation under XEmacs. + ;; eldoc expect this to be done, apparently. + (this-command nil) itimer itimers time-elapsed) (if (itimer-uses-arguments current-itimer) (apply (itimer-function current-itimer) @@ -787,10 +798,10 @@ (defun itimer-timer-wakeup () (let ((inhibit-quit t)) - (cond ;((fboundp 'cancel-timer) - ; (cancel-timer itimer-timer)) - ((fboundp 'disable-timeout) - (disable-timeout itimer-timer))) + (cond ((fboundp 'disable-timeout) + (disable-timeout itimer-timer)) + ((fboundp 'cancel-timer) + (cancel-timer itimer-timer))) (setq itimer-timer (add-timeout itimer-short-interval 'itimer-timer-driver nil nil))))
--- a/lisp/prim/loadup.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/prim/loadup.el Mon Aug 13 09:21:54 2007 +0200 @@ -147,10 +147,10 @@ (load-gc "vmsproc") (load-gc "vms-patch")) ((eq system-type 'windows-nt) - (load-gc "ls-lisp") + ;; (load-gc "ls-lisp") (load-gc "winnt")) ((eq system-type 'ms-dos) - (load-gc "ls-lisp") + ;; (load-gc "ls-lisp") (load-gc "dos-fns") (load-gc "disp-table"))) ; needed to setup ibm-pc char set, ; see internal.el
--- a/lisp/prim/obsolete.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/prim/obsolete.el Mon Aug 13 09:21:54 2007 +0200 @@ -613,4 +613,8 @@ ;; likewise with int-char. (define-compatible-function-alias 'int-char 'int-to-char) +;; Two loser functions which shouldn't be used. +(make-obsolete 'following-char 'char-after) +(make-obsolete 'preceding-char 'char-after) + ;;; obsolete.el ends here
--- a/lisp/prim/startup.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/prim/startup.el Mon Aug 13 09:21:54 2007 +0200 @@ -606,10 +606,12 @@ (setq init-file-loaded t) ;; Do this here in case the init file sets mail-host-address. - (or user-mail-address - (setq user-mail-address (concat (user-login-name) "@" - (or mail-host-address - (system-name))))) + ;; Don't do this here unless noninteractive, it is frequently wrong. -sb + ;; (or user-mail-address + (when noninteractive + (setq user-mail-address (concat (user-login-name) "@" + (or mail-host-address + (system-name))))) (run-hooks 'after-init-hook) nil)
--- a/lisp/psgml/ChangeLog Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/psgml/ChangeLog Mon Aug 13 09:21:54 2007 +0200 @@ -1,3 +1,8 @@ +Wed Mar 19 22:58:40 1997 Steven L Baur <steve@altair.xemacs.org> + + * psgml-html.el (html-helper-address-string): Use + user-mail-address function. + Mon Jan 27 13:12:41 1997 Jin S. Choi <jsc@atype.com> * psgml.el: Fix location of CATALOG in `sgml-validate-command'.
--- a/lisp/psgml/psgml-html.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/psgml/psgml-html.el Mon Aug 13 09:21:54 2007 +0200 @@ -49,7 +49,7 @@ ;; Set this to be whatever signature you want on the bottom of your pages. (defvar html-helper-address-string - (concat "<a href=\"mailto:" user-mail-address "\">" + (concat "<a href=\"mailto:" (user-mail-address) "\">" (user-full-name) "</a>") "*The default author string of each file.")
--- a/lisp/tl/emu-x20.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/tl/emu-x20.el Mon Aug 13 09:21:54 2007 +0200 @@ -3,7 +3,7 @@ ;; Copyright (C) 1994,1995,1996,1997 MORIOKA Tomohiko ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> -;; Version: $Id: emu-x20.el,v 1.5 1997/03/16 03:05:43 steve Exp $ +;; Version: $Id: emu-x20.el,v 1.6 1997/03/22 06:02:43 steve Exp $ ;; Keywords: emulation, compatibility, Mule, XEmacs ;; This file is part of XEmacs. @@ -27,10 +27,6 @@ ;; This module requires XEmacs 20.1 b6 or later with mule. -;;; Commentary: - -;; This module requires XEmacs 20.1 b6 or later with mule. - ;;; Code: (require 'cyrillic)
--- a/lisp/tm/tm-edit.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/tm/tm-edit.el Mon Aug 13 09:21:54 2007 +0200 @@ -6,7 +6,7 @@ ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; Created: 1994/08/21 renamed from mime.el -;; Version: $Revision: 1.8 $ +;; Version: $Revision: 1.9 $ ;; Keywords: mail, news, MIME, multimedia, multilingual ;; This file is part of tm (Tools for MIME). @@ -120,7 +120,7 @@ ;;; (defconst mime-editor/RCS-ID - "$Id: tm-edit.el,v 1.8 1997/02/15 22:21:28 steve Exp $") + "$Id: tm-edit.el,v 1.9 1997/03/22 06:02:45 steve Exp $") (defconst mime-editor/version (get-version-string mime-editor/RCS-ID)) @@ -1760,16 +1760,17 @@ (tag (buffer-substring beg end)) ) (delete-region beg end) - (setq contype (mime-editor/get-contype tag)) - (setq encoding (mime-editor/get-encoding tag)) - (insert (concat prefix "--" boundary "\n")) - (save-restriction - (narrow-to-region (point)(point)) - (insert "Content-Type: " contype "\n") - (if encoding - (insert "Content-Transfer-Encoding: " encoding "\n")) - (mime/encode-message-header) - ) + (let ((contype (mime-editor/get-contype tag)) + (encoding (mime-editor/get-encoding tag)) + ) + (insert (concat prefix "--" boundary "\n")) + (save-restriction + (narrow-to-region (point)(point)) + (insert "Content-Type: " contype "\n") + (if encoding + (insert "Content-Transfer-Encoding: " encoding "\n")) + (mime/encode-message-header) + )) t))) (defun mime-editor/translate-region (beg end &optional boundary multipart)
--- a/lisp/tm/tm-vm.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/tm/tm-vm.el Mon Aug 13 09:21:54 2007 +0200 @@ -9,7 +9,7 @@ ;; Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> ;; Created: 1994/10/29 -;; Version: $Revision: 1.2 $ +;; Version: $Revision: 1.3 $ ;; Keywords: mail, MIME, multimedia, multilingual, encoded-word ;; This file is part of tm (Tools for MIME). @@ -46,7 +46,7 @@ (require 'vm-summary) (require 'vm-menu) (require 'vm-toolbar) - +(require 'vm-mime) ;;; @ Variables @@ -103,7 +103,7 @@ ;;; @@ System/Information variables (defconst tm-vm/RCS-ID - "$Id: tm-vm.el,v 1.2 1997/02/15 22:21:30 steve Exp $") + "$Id: tm-vm.el,v 1.3 1997/03/22 06:02:46 steve Exp $") (defconst tm-vm/version (get-version-string tm-vm/RCS-ID)) ; Ensure vm-menu-mail-menu gets properly defined *before* tm-vm/vm-emulation-map @@ -286,8 +286,8 @@ (define-key vm-mode-map "\et" 'tm-vm/toggle-preview-mode) ; Disable VM 6 built-in MIME handling -(setq vm-display-using-mime nil) -(setq vm-send-using-mime nil) +(setq vm-display-using-mime nil + vm-send-using-mime nil) ;;; @ MIME encoded-words @@ -298,30 +298,18 @@ (or tm-vm/use-tm-patch (progn -;;; -(defvar tm-vm/chop-full-name-function 'tm-vm/default-chop-full-name) -(setq vm-chop-full-name-function tm-vm/chop-full-name-function) +(defadvice vm-compile-format (around tm activate) + "MIME decoding support through TM added." + (let ((vm-display-using-mime t)) + ad-do-it)) -(defun tm-vm/default-chop-full-name (address) - (let* ((ret (vm-default-chop-full-name address)) - (full-name (car ret)) - ) - (if (stringp full-name) - (cons (mime-eword/decode-string full-name) - (cdr ret)) - ret))) +(defadvice vm-tokenized-summary-insert (around tm activate) + "MIME decoding support through TM added." + (let ((vm-display-using-mime t)) + ad-do-it)) -(defadvice vm-su-subject (after tm activate) - "MIME decoding support through TM added." - (setq ad-return-value (mime-eword/decode-string ad-return-value))) - -(defadvice vm-su-full-name (after tm activate) - "MIME decoding support through TM added." - (setq ad-return-value (mime-eword/decode-string ad-return-value))) - -(defadvice vm-su-to-names (after tm activate) - "MIME decoding support through TM added." - (setq ad-return-value (mime-eword/decode-string ad-return-value))) +(fset 'vm-decode-mime-encoded-words-in-string 'mime-eword/decode-string) +(fset 'vm-reencode-mime-encoded-words-in-string 'mime-eword/encode-string) )) @@ -398,6 +386,12 @@ ;;; @ MIME Viewer +(setq mime-viewer/code-converter-alist + (append + (list (cons 'vm-mode 'mime-charset/decode-buffer) + (cons 'vm-virtual-mode 'mime-charset/decode-buffer)) + mime-viewer/code-converter-alist)) + ;;; @@ MIME-Preview buffer management (defvar tm-vm/system-state nil) @@ -743,11 +737,9 @@ 'vm-virtual-mode (function tm-vm/following-method)) - (set-alist 'mime-viewer/quitting-method-alist 'vm-mode 'tm-vm/quit-view-message) - (set-alist 'mime-viewer/quitting-method-alist 'vm-virtual-mode 'tm-vm/quit-view-message) @@ -1204,7 +1196,9 @@ )))) (defadvice vm-forward-message (around tm-aware activate) - "Extended to support rfc1521 multipart digests and to work properly in MIME-Preview buffers." + "Extended to support rfc1521 digests (roughly equivalent to what +VM does when vm-forwarding-digest-type is 'mime but using message/rfc822 +when appropriate." (if (not (equal vm-forwarding-digest-type "rfc1521")) ad-do-it (if mime::preview/article-buffer
--- a/lisp/tm/tmh-comp.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/tm/tmh-comp.el Mon Aug 13 09:21:54 2007 +0200 @@ -6,7 +6,7 @@ ;; OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp> ;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; Created: 1996/2/29 (separated from tm-mh-e.el) -;; Version: $Id: tmh-comp.el,v 1.4 1997/03/16 03:05:47 steve Exp $ +;; Version: $Id: tmh-comp.el,v 1.5 1997/03/22 06:02:46 steve Exp $ ;; Keywords: mail, MH, MIME, multimedia, encoded-word, multilingual ;; This file is part of tm (Tools for MIME). @@ -515,6 +515,31 @@ 'mh-insert-letter 'tm-mh-e/insert-letter mh-letter-mode-map) +;;; @ for mu-cite +;;; + +(call-after-loaded + 'mu-cite + (function + (lambda () + (set-alist 'mu-cite/get-field-value-method-alist + 'mh-letter-mode + (function + (lambda (name) + (if (and (stringp mh-sent-from-folder) + (numberp mh-sent-from-msg)) + (save-excursion + (set-buffer mh-sent-from-folder) + (set-buffer mh-show-buffer) + (and (boundp 'mime::preview/article-buffer) + (bufferp mime::preview/article-buffer) + (set-buffer mime::preview/article-buffer)) + (std11-field-body name) + )) + ))) + ))) + + ;;; @ end ;;;
--- a/lisp/utils/floating-toolbar.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/utils/floating-toolbar.el Mon Aug 13 09:21:54 2007 +0200 @@ -86,7 +86,7 @@ (require 'toolbar) (require 'x) -(defvar floating-toolbar-version "1.01" +(defvar floating-toolbar-version "1.02" "Version string for the floating-toolbar package.") (defvar floating-toolbar-use-sound nil @@ -312,7 +312,11 @@ (defun floating-toolbar-make-junk-frame () (let ((window-min-height 1) (window-min-width 1)) - (make-frame '(minibuffer t initially-unmapped t width 1 height 1)))) + (save-excursion + (set-buffer (generate-new-buffer "*junk-frame-buffer*")) + (prog1 + (make-frame '(minibuffer t initially-unmapped t width 1 height 1)) + (rename-buffer " *junk-frame-buffer*" t))))) (defun floating-toolbar-make-toolbar-frame (x y) (save-excursion
--- a/lisp/utils/mail-extr.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/utils/mail-extr.el Mon Aug 13 09:21:54 2007 +0200 @@ -237,6 +237,9 @@ "*Whether to throw away information in UUCP addresses by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\".") +(defvar mail-extr-mailbox-match-case-fold t + "*Non-nil if mailbox and name matching should ignore case.") + ;;---------------------------------------------------------------------- ;; what orderings are meaningful????? ;;(defvar mail-operator-precedence-list '(?! ?% ?@)) @@ -1412,7 +1415,10 @@ mbox-beg mbox-end) (while (and names-match-flag (< i buffer-length)) - (or (eq (downcase (char-after (+ i (point-min)))) + (or (eq (let ((c (char-after (+ i (point-min))))) + (if mail-extr-mailbox-match-case-fold + (downcase c) + c)) (downcase (char-after (+ i buffer-length (point-min))))) (setq names-match-flag nil))
--- a/lisp/utils/smtpmail.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/utils/smtpmail.el Mon Aug 13 09:21:54 2007 +0200 @@ -139,7 +139,7 @@ ;; they put one in themselves. (goto-char (point-min)) (if (not (re-search-forward "^From:" delimline t)) - (let* ((login user-mail-address) + (let* ((login (user-mail-address)) (fullname (user-full-name))) (cond ((eq mail-from-style 'angles) (insert "From: " fullname) @@ -270,7 +270,7 @@ ;; MAIL FROM: <sender> ; (smtpmail-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtpmail-fqdn))) - (smtpmail-send-command process (format "MAIL FROM: <%s>" user-mail-address)) + (smtpmail-send-command process (format "MAIL FROM: <%s>" (user-mail-address))) (if (or (null (car (setq response-code (smtpmail-read-response process)))) (not (integerp (car response-code)))
--- a/lisp/version.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/version.el Mon Aug 13 09:21:54 2007 +0200 @@ -25,7 +25,7 @@ (defconst emacs-version "20.1" "Version numbers of this version of Emacs.") -(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid (beta8)"))) +(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid (beta9)"))) (defconst emacs-major-version (progn (or (string-match "^[0-9]+" emacs-version)
--- a/lisp/vm/vm-autoload.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/vm/vm-autoload.el Mon Aug 13 09:21:54 2007 +0200 @@ -977,6 +977,8 @@ (autoload (quote vm-parent-of) "vm-message" nil nil t) +(autoload (quote vm-references-of) "vm-message" nil nil t) + (autoload (quote vm-mirror-data-of) "vm-message" nil nil t) (autoload (quote vm-edit-buffer-of) "vm-message" nil nil t) @@ -1089,6 +1091,8 @@ (autoload (quote vm-set-parent-of) "vm-message" nil nil t) +(autoload (quote vm-set-references-of) "vm-message" nil nil t) + (autoload (quote vm-set-mirror-data-of) "vm-message" nil nil t) (autoload (quote vm-set-edit-buffer-of) "vm-message" nil nil t) @@ -2043,7 +2047,7 @@ Prefix arg N means print the current message and the next N - 1 messages. Prefix arg -N means print the current message and the previous N - 1 messages. -The variables `vm-print-command' controls what command is run to +The variable `vm-print-command' controls what command is run to print the message, and `vm-print-command-switches' is a list of switches to pass to the command. @@ -2188,7 +2192,7 @@ (autoload (quote vm-mode) "vm-startup" "Major mode for reading mail. -This is VM 6.19. +This is VM 6.21. Commands: h - summarize folder contents @@ -2390,10 +2394,12 @@ vm-mime-digest-headers vm-mime-display-function vm-mime-external-content-types-alist + vm-mime-ignore-mime-version vm-mime-internal-content-types vm-mime-max-message-size vm-mode-hook vm-mosaic-program + vm-mosaic-program-switches vm-move-after-deleting vm-move-after-killing vm-move-after-undeleting @@ -2401,6 +2407,7 @@ vm-mutable-frames vm-mutable-windows vm-netscape-program + vm-netscape-program-switches vm-pop-bytes-per-session vm-pop-max-message-size vm-pop-md5-program @@ -2630,6 +2637,8 @@ (autoload (quote vm-unthread-message) "vm-thread" nil nil nil) +(autoload (quote vm-th-references) "vm-thread" nil nil nil) + (autoload (quote vm-th-parent) "vm-thread" nil nil nil) (autoload (quote vm-th-thread-indentation) "vm-thread" nil nil nil)
--- a/lisp/vm/vm-folder.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/vm/vm-folder.el Mon Aug 13 09:21:54 2007 +0200 @@ -2414,6 +2414,7 @@ (condition-case () (progn (delete-file buffer-file-name) + (clear-visited-file-modtime) (message "%s removed" buffer-file-name)) ;; no can do, oh well. (error nil))) @@ -2738,77 +2739,88 @@ (vm-pop-ok-to-ask interactive) crash in maildrop popdrop (got-mail nil)) - (while triples - (setq in (expand-file-name (nth 0 (car triples)) vm-folder-directory) - maildrop (nth 1 (car triples)) - crash (nth 2 (car triples))) - (if (eq (current-buffer) (vm-get-file-buffer in)) - (let (retrieval-function) - (if (file-exists-p crash) - (progn - (message "Recovering messages from %s..." crash) - (setq got-mail (or (vm-gobble-crash-box crash) got-mail)) - (message "Recovering messages from %s... done" crash))) - (setq popdrop (and vm-recognize-pop-maildrops - (string-match vm-recognize-pop-maildrops - maildrop) - ;; maildrop with password clipped - (vm-safe-popdrop-string maildrop))) - (if (or popdrop - (and (not (equal 0 (nth 7 (file-attributes maildrop)))) - (file-readable-p maildrop))) - (progn - (setq crash (expand-file-name crash vm-folder-directory)) - (if (not popdrop) - (setq maildrop (expand-file-name maildrop) - retrieval-function 'vm-spool-move-mail) - (setq retrieval-function 'vm-pop-move-mail)) - (if (if got-mail - ;; don't allow errors to be signaled unless no - ;; mail has been appended to the incore - ;; copy of the folder. otherwise the - ;; user will wonder where the mail is, - ;; since it is not in the crash box or - ;; the spool file and doesn't _appear_ to - ;; be in the folder either. - (condition-case error-data - (funcall retrieval-function maildrop crash) - (error (message "%s signaled: %s" - (if popdrop - 'vm-pop-move-mail - 'vm-spool-move-mail) - error-data) - (sleep-for 2) - ;; we don't know if mail was - ;; put into the crash box or - ;; not, so return t just to be - ;; safe. - t ) - (quit (message "quitting from %s..." - (if popdrop - 'vm-pop-move-mail - 'vm-spool-move-mail)) - (sleep-for 1) - ;; we don't know if mail was - ;; put into the crash box or - ;; not, so return t just to be - ;; safe. - t )) - (funcall retrieval-function maildrop crash)) - (if (vm-gobble-crash-box crash) - (progn - (setq got-mail t) - (message "Got mail from %s." - (or popdrop maildrop))))))))) - (setq triples (cdr triples))) - ;; not really correct, but it is what the user expects to see. - (if got-mail - (setq vm-spooled-mail-waiting nil)) - (intern (buffer-name) vm-buffers-needing-display-update) - (vm-update-summary-and-mode-line) - (if got-mail - (run-hooks 'vm-retrieved-spooled-mail-hook)) - got-mail )) + (if (and (not (verify-visited-file-modtime (current-buffer))) + (or (null interactive) + (not (yes-or-no-p + (format + "Folder %s changed on disk, discard those changes? " + (buffer-name (current-buffer))))))) + (progn + (message "Folder %s changed on disk, consider M-x revert-buffer" + (buffer-name (current-buffer))) + (sleep-for 1) + nil ) + (while triples + (setq in (expand-file-name (nth 0 (car triples)) vm-folder-directory) + maildrop (nth 1 (car triples)) + crash (nth 2 (car triples))) + (if (eq (current-buffer) (vm-get-file-buffer in)) + (let (retrieval-function) + (if (file-exists-p crash) + (progn + (message "Recovering messages from %s..." crash) + (setq got-mail (or (vm-gobble-crash-box crash) got-mail)) + (message "Recovering messages from %s... done" crash))) + (setq popdrop (and vm-recognize-pop-maildrops + (string-match vm-recognize-pop-maildrops + maildrop) + ;; maildrop with password clipped + (vm-safe-popdrop-string maildrop))) + (if (or popdrop + (and (not (equal 0 (nth 7 (file-attributes maildrop)))) + (file-readable-p maildrop))) + (progn + (setq crash (expand-file-name crash vm-folder-directory)) + (if (not popdrop) + (setq maildrop (expand-file-name maildrop) + retrieval-function 'vm-spool-move-mail) + (setq retrieval-function 'vm-pop-move-mail)) + (if (if got-mail + ;; don't allow errors to be signaled unless no + ;; mail has been appended to the incore + ;; copy of the folder. otherwise the + ;; user will wonder where the mail is, + ;; since it is not in the crash box or + ;; the spool file and doesn't _appear_ to + ;; be in the folder either. + (condition-case error-data + (funcall retrieval-function maildrop crash) + (error (message "%s signaled: %s" + (if popdrop + 'vm-pop-move-mail + 'vm-spool-move-mail) + error-data) + (sleep-for 2) + ;; we don't know if mail was + ;; put into the crash box or + ;; not, so return t just to be + ;; safe. + t ) + (quit (message "quitting from %s..." + (if popdrop + 'vm-pop-move-mail + 'vm-spool-move-mail)) + (sleep-for 1) + ;; we don't know if mail was + ;; put into the crash box or + ;; not, so return t just to be + ;; safe. + t )) + (funcall retrieval-function maildrop crash)) + (if (vm-gobble-crash-box crash) + (progn + (setq got-mail t) + (message "Got mail from %s." + (or popdrop maildrop))))))))) + (setq triples (cdr triples))) + ;; not really correct, but it is what the user expects to see. + (if got-mail + (setq vm-spooled-mail-waiting nil)) + (intern (buffer-name) vm-buffers-needing-display-update) + (vm-update-summary-and-mode-line) + (if got-mail + (run-hooks 'vm-retrieved-spooled-mail-hook)) + got-mail ))) (defun vm-safe-popdrop-string (drop) (or (and (string-match "^\\([^:]+\\):[^:]+:[^:]+:\\([^:]+\\):[^:]+" drop)
--- a/lisp/vm/vm-message.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/vm/vm-message.el Mon Aug 13 09:21:54 2007 +0200 @@ -139,10 +139,15 @@ ;; sortable subject, re: garbage removed (defmacro vm-sortable-subject-of (message) (list 'aref (list 'aref message 3) 17)) +;; tokenized summary entry (defmacro vm-summary-of (message) (list 'aref (list 'aref message 3) 18)) +;; parent of this message, as determined by threading (defmacro vm-parent-of (message) (list 'aref (list 'aref message 3) 19)) +;; message IDs parsed from References header +(defmacro vm-references-of (message) + (list 'aref (list 'aref message 3) 20)) ;; extra data shared by virtual messages if vm-virtual-mirror is non-nil (defmacro vm-mirror-data-of (message) (list 'aref message 4)) ;; if message is being edited, this is the buffer being used. @@ -262,6 +267,8 @@ (list 'aset (list 'aref message 3) 18 val)) (defmacro vm-set-parent-of (message val) (list 'aset (list 'aref message 3) 19 val)) +(defmacro vm-set-references-of (message val) + (list 'aset (list 'aref message 3) 20 val)) (defmacro vm-set-mirror-data-of (message data) (list 'aset message 4 data)) (defmacro vm-set-edit-buffer-of (message buf)
--- a/lisp/vm/vm-mime.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/vm/vm-mime.el Mon Aug 13 09:21:54 2007 +0200 @@ -48,7 +48,7 @@ m (condition-case data (vm-mime-parse-entity m) - (vm-mime-error (apply 'message (cdr data))))) + (vm-mime-error (message "%s" (car (cdr data)))))) (vm-mime-layout-of m)))) (defun vm-mm-encoded-header (m) @@ -384,7 +384,9 @@ (cond ((= char ?\n) (vm-insert-char char 1 nil work-buffer) (setq cols 0)) - ((and (= char 32) (not (= ?\n (char-after (1+ inputpos))))) + ((and (= char 32) + (not (= (1+ inputpos) end)) + (not (= ?\n (char-after (1+ inputpos))))) (vm-insert-char char 1 nil work-buffer) (vm-increment cols)) ((or (< char 33) (> char 126) (= char 61) @@ -418,7 +420,6 @@ (defun vm-decode-mime-message-headers (m) (let ((case-fold-search t) (buffer-read-only nil) - (did-decode nil) charset encoding match-start match-end start end) (save-excursion (goto-char (vm-headers-of m)) @@ -433,7 +434,6 @@ ;; character set properly. (if (not (vm-mime-charset-internally-displayable-p charset)) nil - (setq did-decode t) (delete-region end match-end) (condition-case data (cond ((string-match "B" encoding) @@ -447,16 +447,7 @@ (insert "**invalid encoded word**") (delete-region (point) end))) (vm-mime-charset-decode-region charset start end) - (delete-region match-start start))) - ;; if we did some decoding, re-electrify the headers since - ;; some of the extents might have been wiped by the - ;; decoding process. - (if did-decode - (save-restriction - (narrow-to-region (vm-headers-of m) (vm-text-of m)) - (vm-energize-urls) - (vm-highlight-headers-maybe) - (vm-energize-headers-and-xfaces)))))) + (delete-region match-start start)))))) (defun vm-decode-mime-encoded-words () (let ((case-fold-search t) @@ -632,8 +623,6 @@ (let ((case-fold-search t) version type qtype encoding id description disposition qdisposition boundary boundary-regexp start multipart-list c-t c-t-e done p returnval) - (and m (message "Parsing MIME message...")) - (prog1 (catch 'return-value (save-excursion (if m @@ -701,7 +690,7 @@ (cond ((null m) t) ((null version) (throw 'return-value 'none)) - ((string= version "1.0") t) + ((or vm-mime-ignore-mime-version (string= version "1.0")) t) (t (vm-mime-error "Unsupported MIME version: %s" version))) (cond ((and m (null type)) (throw 'return-value @@ -814,9 +803,7 @@ (vm-marker (point)) (vm-marker (point-max)) (nreverse multipart-list) - nil ))))) - (and m (message "Parsing MIME message... done")) - ))) + nil ))))))) (defun vm-mime-parse-entity-safe (&optional m c-t c-t-e) (or c-t (setq c-t '("text/plain" "charset=us-ascii"))) @@ -930,7 +917,8 @@ (and (vm-toolbar-support-possible-p) vm-use-toolbar (vm-toolbar-install-toolbar)) (and (vm-menu-support-possible-p) - (vm-menu-install-menus))) + (vm-menu-install-menus)) + (run-hooks 'vm-presentation-mode-hook)) (setq vm-presentation-buffer-handle b))) (setq b vm-presentation-buffer-handle vm-presentation-buffer vm-presentation-buffer-handle @@ -1081,9 +1069,7 @@ (let ((charset (or (vm-mime-get-parameter layout "charset") "us-ascii"))) (vm-mime-charset-internally-displayable-p charset))) -;; commented out until I decide whether W3 is safe to use in -;; light of the porposed javascript extension and the possibility -;; of executing arbitrary Emacs-Lisp code embedded in a page. +;; commented out until w3-region behavior gets worked out ;; ;; ((vm-mime-types-match "text/html" type) ;; (condition-case () @@ -1277,7 +1263,10 @@ (if (vectorp layout) (progn (vm-decode-mime-layout layout) - (delete-region (point) (point-max))))) + (delete-region (point) (point-max)))) + (vm-energize-urls) + (vm-highlight-headers-maybe) + (vm-energize-headers-and-xfaces)) (set-buffer-modified-p modified)))) (save-excursion (set-buffer vm-mail-buffer) (setq vm-mime-decoded 'decoded)) @@ -1349,9 +1338,7 @@ (defun vm-mime-display-button-text (layout) (vm-mime-display-button-xxxx layout t)) -;; commented out until I decide whether W3 is safe to use in -;; light of the proposed javascript extension and the possibility -;; of executing arbitrary Emacs-Lisp code embedded in a page. +;; commented out until w3-region behavior is worked out ;; ;;(defun vm-mime-display-internal-text/html (layout) ;; (let ((buffer-read-only nil) @@ -1374,7 +1361,7 @@ ;; (message "Inlining text/html... done") ;; t )) -(defun vm-mime-display-internal-text/plain (layout &optional ignore-urls) +(defun vm-mime-display-internal-text/plain (layout &optional no-highlighting) (let ((start (point)) end old-size (buffer-read-only nil) (charset (or (vm-mime-get-parameter layout "charset") "us-ascii"))) @@ -1389,7 +1376,7 @@ (setq old-size (buffer-size)) (vm-mime-charset-decode-region charset start end) (set-marker end (+ end (- (buffer-size) old-size))) - (or ignore-urls (vm-energize-urls-in-message-region start end)) + (or no-highlighting (vm-energize-urls-in-message-region start end)) (goto-char end) t ))) @@ -1594,7 +1581,8 @@ (vm-mode)) ;; temp buffer, don't offer to save it. (setq buffer-offer-save nil) - (vm-display nil nil (list this-command) '(vm-mode startup))) + (vm-display (or vm-presentation-buffer (current-buffer)) t + (list this-command) '(vm-mode startup))) t ) (fset 'vm-mime-display-button-multipart/digest 'vm-mime-display-internal-multipart/digest) @@ -2590,7 +2578,10 @@ (delete-char 1))) ((stringp object) (let ((coding-system-for-read 'no-conversion)) - (insert-file-contents-literally object)))) + (insert-before-markers " ") + (forward-char -1) + (insert-file-contents-literally object) + (delete-char 1)))) ;; gather information about the object from the extent. (if (setq already-mimed (vm-extent-property e 'vm-mime-encoded)) (setq layout (vm-mime-parse-entity @@ -2895,7 +2886,7 @@ (vm-insert-region-from-buffer mail-buffer) (goto-char (point-min)) (or (vm-mail-mode-get-header-contents "From") - (insert "From: " (or user-mail-address (user-login-name)) "\n")) + (insert "From: " (user-login-name) "\n")) (or (vm-mail-mode-get-header-contents "Message-ID") (insert "Message-ID: <fake@fake.fake>\n")) (or (vm-mail-mode-get-header-contents "Date")
--- a/lisp/vm/vm-minibuf.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/vm/vm-minibuf.el Mon Aug 13 09:21:54 2007 +0200 @@ -181,8 +181,10 @@ (while keymaps (setq keymap (car keymaps)) (cond ((vm-mouse-xemacs-mouse-p) - (define-key keymap 'button1 command) - (define-key keymap 'button2 command)) + (define-key keymap 'button1 'ignore) + (define-key keymap 'button2 'ignore) + (define-key keymap 'button1up command) + (define-key keymap 'button2up command)) ((vm-mouse-fsfemacs-mouse-p) (define-key keymap [down-mouse-1] 'ignore) (define-key keymap [drag-mouse-1] 'ignore)
--- a/lisp/vm/vm-misc.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/vm/vm-misc.el Mon Aug 13 09:21:54 2007 +0200 @@ -376,6 +376,7 @@ (defun vm-menu-support-possible-p () (or (and (boundp 'window-system) (or (eq window-system 'x) + (eq window-system 'ns) ;; NextStep (eq window-system 'win32))) (and (fboundp 'device-type) (eq (device-type) 'x))))
--- a/lisp/vm/vm-mouse.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/vm/vm-mouse.el Mon Aug 13 09:21:54 2007 +0200 @@ -191,11 +191,13 @@ (defun vm-mouse-send-url-to-netscape (url &optional new-netscape new-window) (message "Sending URL to Netscape...") (if new-netscape - (vm-run-background-command vm-netscape-program url) - (or (equal 0 (vm-run-command vm-netscape-program "-remote" - (concat "openURL(" url - (if new-window ", new-window" "") - ")"))) + (apply 'vm-run-background-command vm-netscape-program + (append vm-netscape-program-switches (list url))) + (or (equal 0 (apply 'vm-run-command vm-netscape-program "-remote" + (append (list (concat "openURL(" url + (if new-window ", new-window" "") + ")")) + vm-netscape-program-switches))) (vm-mouse-send-url-to-netscape url t new-window))) (message "Sending URL to Netscape... done")) @@ -227,10 +229,10 @@ (not (equal 0 (vm-run-command "kill" "-USR1" pid)))) (setq new-mosaic t))))) (if new-mosaic - (vm-run-background-command vm-mosaic-program url)) + (apply 'vm-run-background-command vm-mosaic-program + (append vm-mosaic-program-switches (list url)))) (message "Sending URL to Mosaic... done")) - (defun vm-mouse-install-mouse () (cond ((vm-mouse-xemacs-mouse-p) (if (null (lookup-key vm-mode-map 'button2))
--- a/lisp/vm/vm-page.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/vm/vm-page.el Mon Aug 13 09:21:54 2007 +0200 @@ -164,7 +164,7 @@ ;; answer about where the end of the message is going to be ;; visible when redisplay finally does occur. (defun vm-howl-if-eom () - (let ((w (vm-get-visible-buffer-window (current-buffer)))) + (let ((w (get-buffer-window (current-buffer)))) (and w (save-excursion (save-window-excursion @@ -450,8 +450,7 @@ (if (or vm-highlight-url-face vm-url-browser) (save-restriction (widen) - (narrow-to-region start - end) + (narrow-to-region start end) (vm-energize-urls))))) (defun vm-highlight-headers-maybe () @@ -499,7 +498,8 @@ (defun vm-preview-current-message () (vm-save-buffer-excursion - (setq vm-system-state 'previewing) + (setq vm-system-state 'previewing + vm-mime-decoded nil) (if vm-real-buffers (vm-make-virtual-copy (car vm-message-pointer))) @@ -562,7 +562,11 @@ (not (vm-buffer-variable-value vm-mail-buffer 'vm-mime-decoded)) (not vm-mime-decoded)) (not (vm-mime-plain-message-p (car vm-message-pointer))) - (vm-decode-mime-message)) + (condition-case data + (vm-decode-mime-message) + (vm-mime-error (vm-set-mime-layout-of (car vm-message-pointer) + (car (cdr data))) + (message "%s" (car (cdr data)))))) (vm-save-buffer-excursion (save-excursion (save-excursion
--- a/lisp/vm/vm-reply.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/vm/vm-reply.el Mon Aug 13 09:21:54 2007 +0200 @@ -130,8 +130,10 @@ (concat "^" (regexp-quote mail-header-separator) "$") nil 0)) (forward-char 1) (while mlist - (vm-yank-message (car mlist)) - (goto-char (point-max)) + (save-restriction + (narrow-to-region (point) (point)) + (vm-yank-message (car mlist)) + (goto-char (point-max))) (setq mlist (cdr mlist))))) (run-hooks 'vm-reply-hook) (run-hooks 'vm-mail-mode-hook))) @@ -576,7 +578,15 @@ "Like vm-forward-message but always forwards all the headers." (interactive) (let ((vm-forwarded-headers nil) - (vm-unforwarded-header-regexp "only-drop-this-header")) + (vm-unforwarded-header-regexp "only-drop-this-header") + ;; set these because vm-forward-message calls vm-send-digest + ;; if there is more than one message to be forwarded. + (vm-rfc934-digest-headers nil) + (vm-rfc934-digest-discard-header-regexp "only-drop-this-header") + (vm-rfc1153-digest-headers nil) + (vm-rfc1153-digest-discard-header-regexp "only-drop-this-header") + (vm-mime-digest-headers nil) + (vm-mime-digest-discard-header-regexp "only-drop-this-header")) (vm-forward-message))) (defun vm-forward-message () @@ -991,6 +1001,9 @@ (and newsgroups (insert "Newsgroups: " newsgroups "\n")) (and in-reply-to (insert "In-Reply-To: " in-reply-to "\n")) (and references (insert "References: " references "\n")) + (insert "X-Mailer: VM " vm-version " under " + (if (vm-fsfemacs-19-p) "Emacs " "") + emacs-version "\n") ;; REPLYTO support for FSF Emacs v19.29 (and (eq mail-default-reply-to t) (setq mail-default-reply-to (getenv "REPLYTO")))
--- a/lisp/vm/vm-save.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/vm/vm-save.el Mon Aug 13 09:21:54 2007 +0200 @@ -501,7 +501,7 @@ Prefix arg N means print the current message and the next N - 1 messages. Prefix arg -N means print the current message and the previous N - 1 messages. -The variables `vm-print-command' controls what command is run to +The variable `vm-print-command' controls what command is run to print the message, and `vm-print-command-switches' is a list of switches to pass to the command.
--- a/lisp/vm/vm-startup.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/vm/vm-startup.el Mon Aug 13 09:21:54 2007 +0200 @@ -275,7 +275,7 @@ (defun vm-mode (&optional read-only) "Major mode for reading mail. -This is VM 6.19. +This is VM 6.21. Commands: h - summarize folder contents @@ -477,10 +477,12 @@ vm-mime-digest-headers vm-mime-display-function vm-mime-external-content-types-alist + vm-mime-ignore-mime-version vm-mime-internal-content-types vm-mime-max-message-size vm-mode-hook vm-mosaic-program + vm-mosaic-program-switches vm-move-after-deleting vm-move-after-killing vm-move-after-undeleting @@ -488,6 +490,7 @@ vm-mutable-frames vm-mutable-windows vm-netscape-program + vm-netscape-program-switches vm-pop-bytes-per-session vm-pop-max-message-size vm-pop-md5-program @@ -922,11 +925,13 @@ 'vm-mime-digest-headers 'vm-mime-display-function 'vm-mime-external-content-types-alist + 'vm-mime-ignore-mime-version 'vm-mime-internal-content-types 'vm-mime-max-message-size 'vm-mode-hook 'vm-mode-hooks 'vm-mosaic-program + 'vm-mosaic-program-switches 'vm-move-after-deleting 'vm-move-after-undeleting 'vm-move-messages-physically @@ -934,6 +939,7 @@ 'vm-mutable-frames 'vm-mutable-windows 'vm-netscape-program + 'vm-netscape-program-switches 'vm-pop-bytes-per-session 'vm-pop-max-message-size 'vm-pop-messages-per-session @@ -946,7 +952,8 @@ 'vm-quit-hook 'vm-recognize-pop-maildrops 'vm-reply-hook - 'vm-reply-ignored-addresses +;; don't feed the spammers or crackers +;; 'vm-reply-ignored-addresses 'vm-reply-ignored-reply-tos 'vm-reply-subject-prefix 'vm-resend-bounced-discard-header-regexp @@ -1059,6 +1066,10 @@ (or (vm-load-window-configurations vm-window-configuration-file) (setq vm-window-configurations vm-default-window-configuration))) (setq vm-buffers-needing-display-update (make-vector 29 0)) + ;; default value of vm-mime-button-face is 'gui-button-face + ;; this face doesn't exist by default in FSF Emacs 19.34. + ;; Create it. + (and (fboundp 'make-face) (make-face 'gui-button-face)) (and (vm-mouse-support-possible-p) (vm-mouse-install-mouse)) (and (vm-menu-support-possible-p)
--- a/lisp/vm/vm-thread.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/vm/vm-thread.el Mon Aug 13 09:21:54 2007 +0200 @@ -42,7 +42,7 @@ ;; no need to schedule reindents of reparented messages ;; unless there were already messages present. (schedule-reindents message-list) - parent parent-sym id id-sym date) + parent parent-sym id id-sym date refs old-parent-sym) (while mp (setq parent (vm-th-parent (car mp)) id (vm-su-message-id (car mp)) @@ -55,25 +55,69 @@ (if parent (progn (setq parent-sym (intern parent vm-thread-obarray)) - (if (not (boundp id-sym)) - (set id-sym parent-sym)) + (cond ((or (not (boundp id-sym)) + (null (symbol-value id-sym)) + (eq (symbol-value id-sym) parent-sym)) + (set id-sym parent-sym)) + (t + (setq old-parent-sym (symbol-value id-sym)) + (put old-parent-sym 'children + (let ((kids (get old-parent-sym 'children)) + (msgs (get id-sym 'messages))) + (while msgs + (setq kids (delq (car msgs) kids) + msgs (cdr msgs))) + kids )) + (set id-sym parent-sym) + (if schedule-reindents + (vm-thread-mark-for-summary-update + (get id-sym 'messages))))) (put parent-sym 'children (cons (car mp) (get parent-sym 'children)))) - (set id-sym nil)) - ;; we need to make sure the asets below are an atomic group. + (if (not (boundp id-sym)) + (set id-sym nil))) + ;; use the references header to set parenting information + ;; for ancestors of this message. This does not override + ;; a parent pointer for a message if it already exists. + (if (cdr (setq refs (vm-th-references (car mp)))) + (let (parent-sym id-sym msgs) + (setq parent-sym (intern (car refs) vm-thread-obarray) + refs (cdr refs)) + (while refs + (setq id-sym (intern (car refs) vm-thread-obarray)) + (if (and (boundp id-sym) (symbol-value id-sym)) + nil + (set id-sym parent-sym) + (if (setq msgs (get id-sym 'messages)) + (put parent-sym 'children + (append msgs (get parent-sym 'children)))) + (if schedule-reindents + (vm-thread-mark-for-summary-update msgs))) + (setq parent-sym id-sym + refs (cdr refs))))) (if vm-thread-using-subject + ;; inhibit-quit because we need to make sure the asets + ;; below are an atomic group. (let* ((inhibit-quit t) (subject (vm-so-sortable-subject (car mp))) (subject-sym (intern subject vm-thread-subject-obarray))) + ;; if this subject never seen before create the + ;; information vector. (if (not (boundp subject-sym)) (set subject-sym (vector id-sym (vm-so-sortable-datestring (car mp)) nil (list (car mp)))) + ;; this subject seen before (aset (symbol-value subject-sym) 3 (cons (car mp) (aref (symbol-value subject-sym) 3))) (if (string< date (aref (symbol-value subject-sym) 1)) (let* ((vect (symbol-value subject-sym)) (i-sym (aref vect 0))) + ;; optimization: if we know that this message + ;; already has a parent, then don't bother + ;; adding it to the list of child messages + ;; since we know that it will be threaded and + ;; unthreaded using the parent information. (if (or (not (boundp i-sym)) (null (symbol-value i-sym))) (aset vect 2 (append (get i-sym 'messages) @@ -88,6 +132,11 @@ (if schedule-reindents (let ((inhibit-quit nil)) (vm-thread-mark-for-summary-update (aref vect 2))))) + ;; optimization: if we know that this message + ;; already has a parent, then don't bother adding + ;; it to the list of child messages, since we + ;; know that it will be threaded and unthreaded + ;; using the parent information. (if (null parent) (aset (symbol-value subject-sym) 2 (cons (car mp) @@ -152,9 +201,9 @@ ;; remove message struct from thread data. ;; ;; optional second arg non-nil means forget information that -;; might be different if the mesage contents changed. +;; might be different if the message contents changed. ;; -;; message must be a real message +;; message must be a real (non-virtual) message (defun vm-unthread-message (message &optional message-changing) (save-excursion (let ((mp (cons message (vm-virtual-messages-of message))) @@ -206,15 +255,19 @@ (vm-thread-mark-for-summary-update children)))))))) (setq mp (cdr mp)))))) +(defun vm-th-references (m) + (or (vm-references-of m) + (vm-set-references-of + m + (let (references) + (setq references (vm-get-header-contents m "References:" " ")) + (and references (vm-parse references "[^<]*\\(<[^>]+>\\)")))))) + (defun vm-th-parent (m) (or (vm-parent-of m) (vm-set-parent-of m - (or (let (references) - (setq references (vm-get-header-contents m "References:" " ")) - (and references - (car (vm-last - (vm-parse references "[^<]*\\(<[^>]+>\\)"))))) + (or (car (vm-last (vm-th-references m))) (let (in-reply-to) (setq in-reply-to (vm-get-header-contents m "In-Reply-To:" " ")) (and in-reply-to
--- a/lisp/vm/vm-vars.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/vm/vm-vars.el Mon Aug 13 09:21:54 2007 +0200 @@ -381,7 +381,7 @@ MIME (Multipurpose Internet Mail Extensions) is a set of extensions to the standard Internet message format that allows reliable tranmission and reception of arbitrary data including -images, audio and video as well as traditional text. +images, audio and video as well as ordinary text. A non-nil value for this variable means that VM will recognize MIME encoded messages and display them as specified by the @@ -390,6 +390,14 @@ A nil value means VM will not display MIME messages any differently than any other message.") +(defvar vm-mime-ignore-mime-version nil + "*Non-nil value means ignore the version number in the MIME-Version +header. VM only knows how to decode and display MIME version 1.0 +messages. Some systems scramble the MIME-Version header, causing +VM to believe that it cannot display a message that it actually +can display. You can set vm-mime-ignore-mime-version non-nil if +you use such systems.") + ;; try to avoid bad interaction with TM (defvar vm-send-using-mime (not (featurep 'mime-setup)) "*Non-nil value means VM should support sending messages using MIME. @@ -576,7 +584,7 @@ (setq vm-mime-charset-font-alist '( - (\"iso-8859-7\" . \"-*-*-medium-r-normal--16-160-72-72-c-80-iso8859-7\") + (\"iso-8859-7\" . \"-*-*-medium-r-normal-*-16-160-72-72-c-80-iso8859-7\") ) ) @@ -589,15 +597,7 @@ Note that under FSF Emacs any fonts you use must be the same size as your default font. XEmacs does not have this limitation.") -(defvar vm-mime-button-face - (cond ((and (fboundp 'find-face) - (fboundp 'device-type)) - (or (and (not (eq (device-type) 'tty)) (find-face 'gui-button-face) - 'gui-button-face) - (and (find-face 'bold-italic) 'bold-italic))) - ((fboundp 'facep) - (or (and (facep 'gui-button-face) 'gui-button-face) - (and (facep 'bold-italic) 'bold-italic)))) +(defvar vm-mime-button-face 'gui-button-face "*Face used for text in buttons that trigger the display of MIME objects.") (defvar vm-mime-8bit-composition-charset "iso-8859-1" @@ -1202,7 +1202,9 @@ (defvar vm-digest-identifier-header-format "X-Digest: %s\n" "*Header to insert into messages burst from a digest. -Value should be a format string of the same type as vm-summary-format that describes a header to be inserted into each message burst from a digest. The format string must end with a newline.") +Value should be a format string of the same type as vm-summary-format +that describes a header to be inserted into each message burst from a +digest. The format string must end with a newline.") (defvar vm-digest-burst-type "guess" "*Value specifies the default digest type offered by vm-burst-digest @@ -1220,7 +1222,7 @@ rfc934 digests separate messages on any line that begins with a few dashes, but doesn't require lines with only dashes or lines with a specific number of dashes. In the text of the message, any line -beginning with dashes is textually modified to be preceeded by a dash +beginning with dashes is textually modified to be preceded by a dash and a space to prevent confusion with message separators. MIME digests use whatever boundary that is specified by the @@ -2192,6 +2194,12 @@ "*List of hook functions to run when a VM virtual folder buffer is created. The current buffer will be that buffer when the hooks are run.") +(defvar vm-presentation-mode-hook nil + "*List of hook functions to run when a VM presentation buffer is created. +The current buffer will be that buffer when the hooks are run. +Presentation buffers are used to display messages when some type of decoding +must be done to the message to make it presentable. E.g. MIME decoding.") + (defvar vm-quit-hook nil "*List of hook functions to run when you quit VM. This applies to any VM quit command.") @@ -2289,10 +2297,16 @@ "*Name of program to use to run Netscape. vm-mouse-send-url-to-netscape uses this.") +(defvar vm-netscape-program-switches nil + "*List of command line switches to pass to Netscape.") + (defvar vm-mosaic-program "Mosaic" "*Name of program to use to run Mosaic. vm-mouse-send-url-to-mosaic uses this.") +(defvar vm-mosaic-program-switches nil + "*List of command line switches to pass to Mosaic.") + (defvar vm-temp-file-directory "/tmp" "*Name of a directory where VM can put temporary files. This name must not end with a slash.") @@ -2768,7 +2782,7 @@ "Non-nil value means that vm-minibuffer-complete-word should automatically append a space to words that complete unambiguously.") (defconst vm-attributes-vector-length 9) -(defconst vm-cache-vector-length 20) +(defconst vm-cache-vector-length 21) (defconst vm-softdata-vector-length 18) (defconst vm-location-data-vector-length 6) (defconst vm-mirror-data-vector-length 5)
--- a/lisp/vm/vm-version.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/vm/vm-version.el Mon Aug 13 09:21:54 2007 +0200 @@ -2,7 +2,7 @@ (provide 'vm-version) -(defconst vm-version "6.19" +(defconst vm-version "6.21" "Version number of VM.") (defun vm-version ()
--- a/lisp/vm/vm-virtual.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/vm/vm-virtual.el Mon Aug 13 09:21:54 2007 +0200 @@ -509,7 +509,9 @@ ;; set the message pointer to a new value if it is ;; now invalid. (cond - ((equal "Q" (vm-message-id-number-of (car vm-message-pointer))) + ((and vm-message-pointer + (equal "Q" (vm-message-id-number-of + (car vm-message-pointer)))) (vm-garbage-collect-message) (setq vmp vm-message-pointer) (while (and vm-message-pointer
--- a/lisp/w3/ChangeLog Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/w3/ChangeLog Mon Aug 13 09:21:54 2007 +0200 @@ -1,5 +1,127 @@ +Wed Mar 19 20:53:23 1997 Steven L Baur <steve@altair.xemacs.org> + +* Makefile (xemacs-w3): Special target for XEmacs Build. + +Thu Mar 20 06:22:29 1997 William M. Perry <wmperry@aventail.com> + +* w3-parse.el:Added more transitions for error handling of raw 'td' or + 'th' outside of a 'tr' in tablebody. + +* url.el (url-default-callback): asynch downloads should now be cached + +* w3-script.el (w3-do-scripting): Customized, turned off by default + +Wed Mar 19 20:53:23 1997 Steven L Baur <steve@altair.xemacs.org> + +* Makefile (xemacs-w3): Special target for XEmacs Build. + +Wed Mar 19 05:56:56 1997 William M. Perry <wmperry@aventail.com> + +* font.el (x-font-families-for-device): Just in case + font-default-family-for-device fails under Emacs/NT, return "monospace" + at the front of the list. + +* url-vars.el (url-privacy-level): Now defaults to not sending your email + address in HTTP requests. + +Tue Mar 18 13:09:13 1997 William M. Perry <wmperry@aventail.com> + +* url-cookie.el (url-cookie-handle-set-cookie): Fixed variable typos - + doh. Today just hasn't been my day. + +* Emacs-W3 3.0.70 released + +* We now pass all tests on the forms tester page + http://www.research.digital.com/nsl/formtest/home.html + +* w3-display.el (w3-display-node): Better handling of <select multiple> + and <select> in general. + +* w3-forms.el (w3-form-encode-xwfu): Encode : and / in xwfu, since the + form tester expects it. + +* url-cookie.el (url-cookie-trusted-urls): New variable - list of regexps + of URLs that you will accept cookies from without question. + (url-cookie-untrusted-urls): New variable - list of regexps of URLs that + you will _never_ accept cookies from. + (url-cookie-handle-set-cookie): Use them + (url-cookie-handle-set-cookie): When asking whether to allow a site to + set a cookie, show the cookies they are wanting to set. + +Tue Mar 18 06:47:46 1997 Thierry Emery <Thierry.Emery@aar.alcatel-alsthom.fr> + +* w3-display.el: Latest round of patches for <frames> support. + +* w3-cus.el (w3-display-frames): can now have 4 values. + nil no frame display whatsoever (currently the default) + 'as-links display frame hyperlinks, but do not fetch them + 'ask display frame hyperlinks and ask whether to fetch them + t display frame hyperlinks and fetch them + +Tue Mar 18 06:47:46 1997 William M. Perry <wmperry@aventail.com> + +* w3-parse.el (w3-parse-buffer): Duh, don't do `=' comparison on results + of char-after, since it is nil at the end of the buffer. + +Mon Mar 17 08:44:46 1997 William M. Perry <wmperry@aventail.com> + +* Emacs-W3 3.0.69 released + +* w3-sysdp.el (buffer-substring-no-properties): Added stub + +* url-gopher.el (url-gopher-retrieve): Ditto. + +* url.el: Ditto + +* w3-parse.el: Removed all sorts of fun (following-char) commands that can + cause ebola warnings under XEmacs 20.x + +* w3.el (w3-popup-info): Default to the URL under point instead of the + documents URL + +* w3-auto.el: updated autoloads - made sure everything was interactive if + appropriate. + +* w3-menu.el (w3-popup-menu): If w3-popup-menu-on-mouse-3 is nil, call + whatever button3 is bound to in global-map + +* w3-display.el: Added XEmacs version of frame-char-height and + frame-char-width + (w3-frames): If w3-display-frames is non-nil, then do a refresh with it + bound locally, so everything should just work. + +* url.el (url-do-setup): Global history file now defaults to ~/.w3/history + (url-do-setup): Cookie storage now defaults to ~/.w3/cookies + +Mon Mar 17 06:51:07 1997 Paul Stodghill <stodghil@CS.Cornell.EDU> + +* mm.el (mm-temporary-directory): Initialize variable from TMPDIR + environment variable + +Fri Mar 14 13:35:56 1997 William M. Perry <wmperry@aventail.com> + +* w3-forms.el (w3-form-create-custom): Fixed the 'custom' input type for + new filenames in the widget/custom package. + +* ssl.el (ssl-certificate-verification-depth): New variable to control how + far up a cert chain to look. + (ssl-view-certificate-program-name): New variable. + (ssl-view-certificate-program-arguments): New variable. + (ssl-certificate-directory-style): New variable. + (ssl-rehash-program-name): New variable. + (ssl-certificate-directory): New variable. + (ssl-program-arguments): Use some of them. + (ssl-accept-ca-certificate): Use the rest. + +* css.el (css-parse-args): Removed old code that could cause infinite loop + in stylesheet parsing on bad things like "foo=bar" instead of "foo:bar" + +* w3-cus.el: Added better groupings for the customization stuff. + Thu Mar 13 19:54:50 1997 William M. Perry <wmperry@aventail.com> +* Emacs-W3 3.0.68 released + * w3-cus.el: Added customization support for Emacs-W3 * w3.el (w3-mail-current-document): Use url-mail-command instead of
--- a/lisp/w3/Makefile Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/w3/Makefile Mon Aug 13 09:21:54 2007 +0200 @@ -61,7 +61,13 @@ .el.elc: $(EMACS) $(BATCHFLAGS) $(DEPS) -f batch-byte-compile $< -w3: docomp.el $(OBJECTS) +w3: check-custom docomp.el $(OBJECTS) + @echo Build of w3 complete... + +xemacs-w3: docomp.el $(OBJECTS) + @echo Build of w3 complete... + +xemacs-w3: docomp.el $(OBJECTS) @echo Build of w3 complete... all: w3.info w3 @@ -80,6 +86,9 @@ clean: $(RM) $(OBJECTS) +check-custom: + @./custom-check $(EMACS) + w3.info: w3.txi @$(MAKEINFO) w3.txi
--- a/lisp/w3/css.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/w3/css.el Mon Aug 13 09:21:54 2007 +0200 @@ -1,7 +1,7 @@ ;;; css.el -- Cascading Style Sheet parser ;; Author: wmperry -;; Created: 1997/03/07 01:12:31 -;; Version: 1.29 +;; Created: 1997/03/14 22:02:39 +;; Version: 1.30 ;; Keywords: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -621,7 +621,7 @@ (while (not (eobp)) (skip-chars-forward ";, \n\t") (setq name-pos (point)) - (skip-chars-forward "^ \n\t:=,;") + (skip-chars-forward "^ \n\t:,;") (downcase-region name-pos (point)) (setq name (intern (buffer-substring name-pos (point)))) (skip-chars-forward " \t\n")
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/custom-check Mon Aug 13 09:21:54 2007 +0200 @@ -0,0 +1,26 @@ +#!/bin/sh +EMACS=${1:-emacs} +if [ -z "$HOME" ]; then + HOME=`(cd ; pwd)` +fi + +if [ -n "$WIDGETDIR" ]; then + echo "WIDGETDIR environment variable set, good good" + exit 0 +fi + +WITH=`${EMACS} -batch -l ${HOME}/.emacs -eval '(princ (locate-library "custom"))' | cut -f3- |xargs dirname` +WITHOUT=`${EMACS} -batch -eval '(princ (locate-library "custom"))' | cut -f3- |xargs dirname` + +if [ "${WITH}" = "${WITHOUT}" ]; then + exit 0 +else + echo "WARNING -- WARNING -- WARNING" + echo "Found custom in different places with and without ${HOME}/.emacs" + echo + echo "This could cause potential problems. Please recompile with" + echo "the environment variable WIDGETDIR set correctly. Try this" + echo "command:" + echo "make WIDGETDIR=${WITH}" + exit 1 +fi
--- a/lisp/w3/font.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/w3/font.el Mon Aug 13 09:21:54 2007 +0200 @@ -1,7 +1,7 @@ ;;; font.el --- New font model ;; Author: wmperry -;; Created: 1997/03/10 15:18:19 -;; Version: 1.36 +;; Created: 1997/03/19 18:28:10 +;; Version: 1.38 ;; Keywords: faces ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -64,7 +64,7 @@ (defconst font-window-system-mappings '((x . (x-font-create-name x-font-create-object)) (ns . (ns-font-create-name ns-font-create-object)) - (win32 . (x-font-create-name x-font-create-object)) ; Change? FIXME + (win32 . (x-font-create-name x-font-create-object)) (pm . (x-font-create-name x-font-create-object)) ; Change? FIXME (tty . (tty-font-create-plist tty-font-create-object))) "An assoc list mapping device types to the function used to create @@ -533,7 +533,7 @@ (normal (mapcar (function (lambda (x) (if x (aref x 0)))) (aref menu 1)))) (sort (unique (nconc scaled normal)) 'string-lessp)))) - (mapcar 'car font-family-mappings))) + (cons "monospace" (mapcar 'car font-family-mappings)))) (defvar font-default-cache nil) @@ -572,7 +572,7 @@ ;; (if font-running-xemacs ;; (format "%dpx" (face-height 'default device)) (font-size (font-default-object-for-device device))) - + (defun x-font-create-name (fontobj &optional device) (if (and (not (or (font-family fontobj) (font-weight fontobj)
--- a/lisp/w3/mm.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/w3/mm.el Mon Aug 13 09:21:54 2007 +0200 @@ -305,7 +305,7 @@ (defvar mm-download-directory nil "*Where downloaded files should go by default.") -(defvar mm-temporary-directory "/tmp" +(defvar mm-temporary-directory (or (getenv "TMPDIR") "/tmp") "*Where temporary files go.")
--- a/lisp/w3/ssl.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/w3/ssl.el Mon Aug 13 09:21:54 2007 +0200 @@ -1,7 +1,7 @@ ;;; ssl.el,v --- ssl functions for emacsen without them builtin ;; Author: wmperry -;; Created: 1997/03/09 23:02:56 -;; Version: 1.8 +;; Created: 1997/03/15 00:29:34 +;; Version: 1.11 ;; Keywords: comm ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -26,16 +26,118 @@ ;;; Boston, MA 02111-1307, USA. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar ssl-program-name "ssl" - "*The program to run in a subprocess to open an SSL connection.") +(require 'cl) +(require 'base64) + +(eval-and-compile + (condition-case () + (require 'custom) + (error nil)) + (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) + nil ;; We've got what we needed + ;; We have the old custom-library, hack around it! + (defmacro defgroup (&rest args) + nil) + (defmacro defcustom (var value doc &rest args) + (` (defvar (, var) (, value) (, doc)))))) + +(defgroup ssl nil + "Support for `Secure Sockets Layer' encryption." + :group 'emacs) + +(defcustom ssl-certificate-directory "~/.w3/certs/" + "*Directory to store CA certificates in" + :group 'ssl + :type 'directory) + +(defcustom ssl-rehash-program-name "c_rehash" + "*Program to run after adding a cert to a directory . +Run with one argument, the directory name." + :group 'ssl + :type 'string) -(defvar ssl-program-arguments '(host port) +(defcustom ssl-view-certificate-program-name "x509" + "*The program to run to provide a human-readable view of a certificate." + :group 'ssl + :type 'string) + +(defcustom ssl-view-certificate-program-arguments '("-text" "-inform" "DER") + "*Arguments that should be passed to the certificate viewing program. +The certificate is piped to it. +Maybe a way of passing a file should be implemented" + :group 'ssl + :type 'list) + +(defcustom ssl-certificate-directory-style 'ssleay + "*Style of cert database to use, the only valid value right now is `ssleay'. +This means a directory of pem encoded certificates with hash symlinks." + :group 'ssl + :type '(choice (const :tag "SSLeay" :value ssleay))) + +(defcustom ssl-certificate-verification-depth 0 + "*How far up the certificate chain we should verify." + :group 'ssl + :type 'integer) + +(defcustom ssl-program-name "s_client" + "*The program to run in a subprocess to open an SSL connection." + :group 'ssl + :type 'string) + +(defcustom ssl-program-arguments + '("-quiet" + "-host" host + "-port" service + "-verify" ssl-certificate-verification-depth + "-CApath" ssl-certificate-directory + ) "*Arguments that should be passed to the program `ssl-program-name'. This should be used if your SSL program needs command line switches to specify any behaviour (certificate file locations, etc). The special symbols 'host and 'port may be used in the list of arguments and will be replaced with the hostname and service/port that will be connected -to.") +to." + :group 'ssl + :type 'list) + +(defun ssl-accept-ca-certificate () + "Ask if the user is willing to accept a new CA certificate. The buffer-name +should be the intended name of the certificate, and the buffer should probably +be in DER encoding" + ;; TODO, check if it is really new or if we already know it + (let* ((process-connection-type nil) + (tmpbuf (generate-new-buffer "X509 CA Certificate Information")) + (response (save-excursion + (and (eq 0 + (apply 'call-process-region + (point-min) (point-max) + ssl-view-certificate-program-name + nil tmpbuf t + ssl-view-certificate-program-arguments)) + (switch-to-buffer tmpbuf) + (goto-char (point-min)) + (or (recenter) t) + (yes-or-no-p + "Accept this CA to vouch for secure server identities? ") + (kill-buffer tmpbuf))))) + (if (not response) + nil + (if (not (file-directory-p ssl-certificate-directory)) + (make-directory ssl-certificate-directory)) + (case ssl-certificate-directory-style + (ssleay + (base64-encode-region (point-min) (point-max)) + (goto-char (point-min)) + (insert "-----BEGIN CERTIFICATE-----\n") + (goto-char (point-max)) + (insert "-----END CERTIFICATE-----\n") + (let ((f (expand-file-name + (concat (file-name-sans-extension (buffer-name)) ".pem") + ssl-certificate-directory))) + (write-file f) + (call-process ssl-rehash-program-name + nil nil nil + (expand-file-name ssl-certificate-directory)))))))) (defun open-ssl-stream (name buffer host service) "Open a SSL connection for a service to a host.
--- a/lisp/w3/url-cookie.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/w3/url-cookie.el Mon Aug 13 09:21:54 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-cookie.el --- Netscape Cookie support ;; Author: wmperry -;; Created: 1997/02/18 23:34:20 -;; Version: 1.11 +;; Created: 1997/03/19 00:42:23 +;; Version: 1.14 ;; Keywords: comm, data, processes, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -268,6 +268,12 @@ "A regular expression of top-level domains that only require two matching '.'s in the domain name in order to set a cookie.") +(defvar url-cookie-trusted-urls nil + "*A list of regular expressions matching URLs to always accept cookies from.") + +(defvar url-cookie-untrusted-urls nil + "*A list of regular expressions matching URLs to never accept cookies from.") + (defun url-cookie-host-can-set-p (host domain) (let ((numdots 0) (tmp domain) @@ -298,6 +304,9 @@ (domain (or (cdr-safe (assoc* "domain" args :test 'url-header-comparison)) (url-host url-current-object))) + (current-url (url-view-url t)) + (trusted url-cookie-trusted-urls) + (untrusted url-cookie-untrusted-urls) (expires (cdr-safe (assoc* "expires" args :test 'url-header-comparison))) (path (or (cdr-safe (assoc* "path" args :test @@ -324,14 +333,40 @@ (url-match expires 3) " " (url-match expires 4) " [" (url-match expires 5) "]"))) + (while (consp trusted) + (if (string-match (car trusted) current-url) + (setq trusted (- (match-end 0) (match-beginning 0))) + (pop trusted))) + (while (consp untrusted) + (if (string-match (car untrusted) current-url) + (setq untrusted (- (match-end 0) (match-beginning 0))) + (pop untrusted))) + (if (and trusted untrusted) + ;; Choose the more specific match + (if (> trusted untrusted) + (setq untrusted nil) + (setq trusted nil))) (cond + (untrusted + ;; The site was explicity marked as untrusted by the user + nil) ((and (listp url-privacy-level) (memq 'cookies url-privacy-level)) ;; user never wants cookies nil) ((and url-cookie-confirmation - (not (funcall url-confirmation-func - (format "Allow %s to set a cookie? " - (url-host url-current-object))))) + (not trusted) + (save-window-excursion + (with-output-to-temp-buffer "*Cookie Warning*" + (mapcar + (function + (lambda (x) + (princ (format "%s - %s" (car x) (cdr x))))) rest)) + (prog1 + (not (funcall url-confirmation-func + (format "Allow %s to set these cookies? " + (url-host url-current-object)))) + (if (get-buffer "*Cookie Warning*") + (kill-buffer "*Cookie Warning*"))))) ;; user wants to be asked, and declined. nil) ((url-cookie-host-can-set-p (url-host url-current-object) domain)
--- a/lisp/w3/url-gopher.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/w3/url-gopher.el Mon Aug 13 09:21:54 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-gopher.el --- Gopher Uniform Resource Locator retrieval code ;; Author: wmperry -;; Created: 1997/02/18 23:34:30 -;; Version: 1.6 +;; Created: 1997/03/18 01:02:58 +;; Version: 1.7 ;; Keywords: comm, data, processes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -456,8 +456,7 @@ (nth 1 descr)))) (if url-use-hypertext-gopher (url-do-gopher descr) - (gopher-dispatch-object (vector (if (= 0 - (string-to-char (nth 2 descr))) + (gopher-dispatch-object (vector (if (= 0 (length (nth 2 descr))) ?1 (string-to-char (nth 2 descr))) (nth 2 descr) (nth 2 descr)
--- a/lisp/w3/url-vars.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/w3/url-vars.el Mon Aug 13 09:21:54 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-vars.el --- Variables for Uniform Resource Locator tool ;; Author: wmperry -;; Created: 1997/03/14 06:51:57 -;; Version: 1.35 +;; Created: 1997/03/20 18:03:50 +;; Version: 1.39 ;; Keywords: comm, data, processes, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -26,7 +26,7 @@ ;;; Boston, MA 02111-1307, USA. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defconst url-version (let ((x "p3.0.68")) +(defconst url-version (let ((x "p3.0.71")) (if (string-match "State: \\([^ \t\n]+\\)" x) (substring x (match-beginning 1) (match-end 1)) x)) @@ -109,7 +109,7 @@ exists, and is readable, then it will be viewed instead of automatically creating the directory listing.") -(defvar url-privacy-level 'none +(defvar url-privacy-level '(email) "*How private you want your requests to be. HTTP/1.0 has header fields for various information about the user, including operating system information, email addresses, the last page you visited, etc.
--- a/lisp/w3/url.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/w3/url.el Mon Aug 13 09:21:54 2007 +0200 @@ -1,13 +1,13 @@ ;;; url.el --- Uniform Resource Locator retrieval tool ;; Author: wmperry -;; Created: 1997/03/09 06:19:51 -;; Version: 1.62 +;; Created: 1997/03/20 15:45:21 +;; Version: 1.66 ;; Keywords: comm, data, processes, hypermedia ;;; LCD Archive Entry: ;;; url|William M. Perry|wmperry@cs.indiana.edu| ;;; Functions for retrieving/manipulating URLs| -;;; 1997/03/09 06:19:51|1.62|Location Undetermined +;;; 1997/03/20 15:45:21|1.66|Location Undetermined ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -922,7 +922,7 @@ (setq url-cookie-file (or url-cookie-file - (expand-file-name "~/.w3cookies"))) + (expand-file-name "~/.w3/cookies"))) (setq url-global-history-file (or url-global-history-file @@ -931,7 +931,7 @@ (and (memq system-type '(axp-vms vax-vms)) (expand-file-name "~/mosaic.global-history")) (condition-case () - (expand-file-name "~/.mosaic-global-history") + (expand-file-name "~/.w3/history") (error nil)))) ;; Parse the global history file if it exists, so that it can be used @@ -1020,6 +1020,9 @@ (run-hooks 'url-load-hook) (setq url-setup-done t))) +(defvar url-get-url-filename-chars "%.?@a-zA-Z0-9---()_/:~=&" + "Valid characters in a URL") + ;;;###autoload (defun url-get-url-at-point (&optional pt) "Get the URL closest to point, but don't change your @@ -1028,7 +1031,7 @@ ;; Not at all perfect - point must be right in the name. (save-excursion (if pt (goto-char pt)) - (let ((filename-chars "%.?@a-zA-Z0-9---()_/:~=&") start url) + (let (start url) (save-excursion ;; first see if you're just past a filename (if (not (eobp)) @@ -1037,16 +1040,16 @@ (skip-chars-backward " \n\t\r({[]})") (if (not (bobp)) (backward-char 1))))) - (if (string-match (concat "[" filename-chars "]") - (char-to-string (following-char))) + (if (and (char-after (point)) + (string-match (eval-when-compile + (concat "[" url-get-url-filename-chars "]")) + (char-to-string (char-after (point))))) (progn - (skip-chars-backward filename-chars) + (skip-chars-backward url-get-url-filename-chars) (setq start (point)) - (skip-chars-forward filename-chars)) + (skip-chars-forward url-get-url-filename-chars)) (setq start (point))) - (setq url (if (fboundp 'buffer-substring-no-properties) - (buffer-substring-no-properties start (point)) - (buffer-substring start (point))))) + (setq url (buffer-substring-no-properties start (point)))) (if (string-match "^URL:" url) (setq url (substring url 4 nil))) (if (string-match "\\.$" url) @@ -1334,7 +1337,7 @@ (defun url-default-callback (buf) (url-download-minor-mode nil) - (url-store-in-cache) + (url-store-in-cache buf) (cond ((save-excursion (set-buffer buf) (and url-current-callback-func
--- a/lisp/w3/w3-auto.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/w3/w3-auto.el Mon Aug 13 09:21:54 2007 +0200 @@ -4,26 +4,26 @@ (autoload 'w3-about "w3-about") ;; Hotlist handling -(autoload 'w3-read-html-bookmarks "w3-hot") -(autoload 'w3-hotlist-apropos "w3-hot") -(autoload 'w3-hotlist-refresh "w3-hot") -(autoload 'w3-hotlist-delete "w3-hot") -(autoload 'w3-hotlist-rename-entry "w3-hot") -(autoload 'w3-hotlist-append "w3-hot") +(autoload 'w3-read-html-bookmarks "w3-hot" nil t) +(autoload 'w3-hotlist-apropos "w3-hot" nil t) +(autoload 'w3-hotlist-refresh "w3-hot" nil t) +(autoload 'w3-hotlist-delete "w3-hot" nil t) +(autoload 'w3-hotlist-rename-entry "w3-hot" nil t) +(autoload 'w3-hotlist-append "w3-hot" nil t) (autoload 'w3-parse-hotlist "w3-hot") (autoload 'w3-use-hotlist "w3-hot" nil t) -(autoload 'w3-hotlist-add-document-at-point "w3-hot") -(autoload 'w3-hotlist-add-document "w3-hot") +(autoload 'w3-hotlist-add-document-at-point "w3-hot" nil t) +(autoload 'w3-hotlist-add-document "w3-hot" nil t) ;; Printing -(autoload 'w3-print-this-url "w3-print") -(autoload 'w3-print-url-under-point "w3-print") +(autoload 'w3-print-this-url "w3-print" nil t) +(autoload 'w3-print-url-under-point "w3-print" nil t) (autoload 'w3-parse-tree-to-latex "w3-latex") -(autoload 'w3-show-dvi "w3-latex") +(autoload 'w3-show-dvi "w3-latex" nil t) ;; Stylesheet stuff (autoload 'w3-handle-style "w3-style") -(autoload 'w3-display-stylesheet "w3-style" "" t) +(autoload 'w3-display-stylesheet "w3-style" nil t) ;; Setup stuff (autoload 'url-do-setup "url") @@ -46,7 +46,7 @@ (autoload 'widget-at "wid-edit") ;; Preferences -(autoload 'w3-preferences-edit "w3-prefs" "" t) +(autoload 'w3-preferences-edit "w3-prefs" nil t) (defvar widget-field-new nil)
--- a/lisp/w3/w3-cus.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/w3/w3-cus.el Mon Aug 13 09:21:54 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-cus.el --- Customization support for Emacs-W3 ;; Author: wmperry -;; Created: 1997/03/14 06:51:36 -;; Version: 1.3 +;; Created: 1997/03/18 20:30:34 +;; Version: 1.5 ;; Keywords: comm, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -32,9 +32,43 @@ (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) nil ;; We've got what we needed ;; We have the old custom-library, hack around it! + (defmacro defgroup (&rest args) + nil) (defmacro defcustom (var value doc &rest args) (` (defvar (, var) (, value) (, doc)))))) +(defgroup w3 nil + "Emacs-W3 - the web browser of choice." + :group 'hypermedia) + +(defgroup w3-files nil + "Emacs-W3 configuration files." + :group 'w3) + +(defgroup w3-images nil + "Controlling image handling." + :group 'w3) + +(defgroup w3-printing nil + "Various options for hardcopy from web pages." + :group 'w3) + +(defgroup w3-menus nil + "The look of menus in Emacs-W3" + :group 'w3) + +(defgroup w3-parsing nil + "Options relating to HTML parsing" + :group 'w3) + +(defgroup w3-display nil + "Variables relating to how web pages are displayed." + :group 'w3) + +(defgroup w3-hooks nil + "Hooks relating to Emacs-W3." + :group 'w3) + ;;; File related variables (defcustom w3-configuration-directory "~/.w3/" "*Directory where Emacs-w3 can find its configuration files" @@ -80,9 +114,16 @@ ;;; Display related variables (defcustom w3-display-frames nil - "*Fetch frames - not optimal." + "*Fetch frames - can be: +nil no frame display whatsoever +'as-links display frame hyperlinks, but do not fetch them +'ask display frame hyperlinks and ask whether to fetch them +t display frame hyperlinks and fetch them." :group 'w3-display - :type 'boolean) + :type '(choice (const :tag "Do not display frames" :value nil) + (const :tag "Show hyperlinks" :value as-links) + (const :tag "Show hyperlinks, ask whether to retrieve them" :value ask) + (const :tag "Automatically retrieve frames" :value t))) (defcustom w3-do-incremental-display nil "*Whether to do incremental display of pages or not."
--- a/lisp/w3/w3-display.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/w3/w3-display.el Mon Aug 13 09:21:54 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-display.el --- display engine v99999 ;; Author: wmperry -;; Created: 1997/03/14 06:33:15 -;; Version: 1.147 +;; Created: 1997/03/18 23:20:40 +;; Version: 1.150 ;; Keywords: faces, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1668,13 +1668,9 @@ (frameset (if w3-display-frames (progn - (push 'frameset w3-frameset-structure) - (let ((cols (assq 'cols args)) - (rows (assq 'rows args))) - (if rows - (setq w3-frameset-dimensions (push rows w3-frameset-dimensions))) - (if cols - (setq w3-frameset-dimensions (push cols w3-frameset-dimensions)))) + (push (list 'frameset + (or (assq 'cols args) (assq 'rows args))) + w3-frameset-structure) (w3-handle-content node)) (w3-handle-content node))) (frame @@ -1685,7 +1681,7 @@ (w3-get-attribute 'title) (w3-get-attribute 'alt) "Unknown frame name"))) - (push 'frame w3-frameset-structure) + (push (list 'frame name href) w3-frameset-structure) (w3-handle-content (list tag args (list @@ -1694,10 +1690,7 @@ (list 'a (cons (cons 'href href) args) - (list - (car w3-frame-labels) - name - (cdr w3-frame-labels))))))))) + (list "Fetch frame: " name)))))))) (w3-handle-empty-tag))) (noframes (if w3-display-frames @@ -1918,17 +1911,18 @@ (lambda (n) (setq tmp (w3-normalize-spaces (apply 'concat (nth 2 n))) - tmp (cons tmp - (or - (cdr-safe - (assq 'value (nth 1 n))) - tmp))) + tmp (vector tmp + (or + (cdr-safe + (assq 'value (nth 1 n))) + tmp) + (assq 'selected (nth 1 n)))) (if (assq 'selected (nth 1 n)) - (setq value (car tmp))) + (setq value (aref tmp 0))) tmp)) (nth 2 node)))) (if (not value) - (setq value (caar options))) + (setq value (aref (car options) 0))) (setq plist (plist-put plist 'value value)) (if multiple (progn @@ -1941,11 +1935,18 @@ (list 'input (list (cons 'name name) (cons 'type "checkbox") - (cons 'value (car opt)))) - " " (car opt) (list 'br nil nil))))) + (cons (if (aref opt 2) + 'checked + '__bogus__) "yes") + (cons 'value (aref opt 1)))) + " " (aref opt 0) (list 'br nil nil))))) options)) (setq node (list 'p nil options)) (w3-handle-content node)) + (setq options (mapcar (function + (lambda (x) + (cons (aref x 0) (aref x 1)))) + options)) (setq plist (plist-put plist 'type 'option) plist (plist-put plist 'options options)) (w3-form-add-element plist w3-active-faces) @@ -2119,63 +2120,66 @@ (cl-puthash url (buffer-name) url-history-list) (if (fboundp 'w3-shuffle-history-menu) (w3-shuffle-history-menu))))) - ) + (w3-maybe-fetch-frames)) + +(defun w3-maybe-fetch-frames () + (if w3-frameset-structure + (cond ((or (eq w3-display-frames t) + (and (eq w3-display-frames 'ask) + (y-or-n-p "Fetch frames? "))) + (w3-frames) + t)))) (defun w3-frames (&optional new-frame) "Set up and fetch W3 frames. With optional prefix, do so in a new frame." (interactive "P") + (if (not w3-display-frames) + (let ((w3-display-frames t)) + (w3-refresh-buffer))) (let* ((old-asynch url-be-asynchronous) - (structure (reverse w3-frameset-structure)) - (dims (or (reverse w3-frameset-dimensions) - t))) + (structure (reverse w3-frameset-structure))) (if new-frame (select-frame (make-frame-command))) - (goto-char (point-min)) (setq-default url-be-asynchronous nil) ;; set up frames - (while (and structure dims) - (let* ((current-dims (list (car dims))) - (cols (cdr-safe (assq 'cols current-dims))) - (rows (cdr-safe (assq 'rows current-dims)))) - (if (eq (car structure) 'frameset) - (pop structure)) - ;; columns ? - (if cols - (setq cols (w3-decode-frameset-dimensions cols (window-width))) - ;; rows ? - (if rows - (setq rows (w3-decode-frameset-dimensions rows (window-height))) - ;; default: columns of equal width - (let ((nb-windows 0)) - (save-excursion - (while (re-search-forward w3-frame-regexp nil t) - (setq nb-windows (1+ nb-windows)))) - (let ((fwidth (/ (window-width) nb-windows))) - (while (> nb-windows 0) - (push fwidth cols) - (setq nb-windows (1- nb-windows))))))) - (while (eq (car structure) 'frame) - (if (re-search-forward w3-frame-regexp nil t) - (progn - (if (cdr cols) - (split-window-horizontally (min (car cols) - (- (window-width) 12))) - (if (cdr rows) - (split-window-vertically (min (car rows) - (- (window-height) 12))))) - (pop cols) - (pop rows) - (goto-char (+ (match-beginning 0) 5)) - (let ((name (buffer-substring-no-properties (match-beginning 1) (match-end 1))) - (w3-notify 'semibully)) - (w3-widget-button-press) - (setq w3-frame-name name - w3-target-window-distances nil)) - (other-window 1))) - (pop structure))) - (if (consp dims) - (pop dims) - (setq dims nil))) + (while structure + (if (eq (car (car structure)) 'frameset) + (let* ((current-dims (cdr (car structure))) + (cols (cdr-safe (assq 'cols current-dims))) + (rows (cdr-safe (assq 'rows current-dims)))) + (pop structure) + ;; columns ? + (if cols + (setq cols (w3-decode-frameset-dimensions cols (window-width) window-min-width)) + ;; rows ? + (if rows + (setq rows (w3-decode-frameset-dimensions rows (window-height) window-min-height)) + ;; default: columns of equal width + (let ((nb-windows 0) + (frames structure)) + (while (and frames (eq (car (car frames)) 'frame)) + (setq nb-windows (1+ nb-windows))) + (let ((fwidth (/ (window-width) nb-windows))) + (while (> nb-windows 0) + (push fwidth cols) + (setq nb-windows (1- nb-windows))))))) + (while (eq (car (car structure)) 'frame) + (cond ((cdr cols) + (split-window-horizontally (car cols)) + (pop cols)) + ((cdr rows) + (split-window-vertically (car rows)) + (pop rows))) + (let ((href (nth 2 (car structure))) + (name (nth 1 (car structure))) + (url-working-buffer url-default-working-buffer) ; in case url-multiple-p is t + (w3-notify 'semibully)) + (w3-fetch href) + (setq w3-frame-name name + w3-target-window-distances nil)) + (other-window 1) + (pop structure))) + (pop structure))) ;; compute target window distances (let ((origin-buffer (current-buffer)) (stop nil)) @@ -2204,7 +2208,21 @@ (setq stop t))) window-distances)) -(defun w3-decode-frameset-dimensions (dims available-dimension) +(if (not (fboundp 'frame-char-height)) + (defun frame-char-height (&optional frame) + "Height in pixels of a line in the font in frame FRAME. +If FRAME is omitted, the selected frame is used. +For a terminal frame, the value is always 1." + (font-height (face-font 'default frame)))) + +(if (not (fboundp 'frame-char-width)) + (defun frame-char-width (&optional frame) + "Width in pixels of characters in the font in frame FRAME. +If FRAME is omitted, the selected frame is used. +For a terminal screen, the value is always 1." + (font-width (face-font 'default frame)))) + +(defun w3-decode-frameset-dimensions (dims available-dimension min-dim) "Returns numbers of lines or columns in Emacs, computed from specified frameset dimensions" (let ((dimensions nil)) (if dims @@ -2228,7 +2246,7 @@ ;; absolute number: pixel height (push (max (1+ (/ (car (read-from-string match)) (frame-char-height))) - window-min-height) + min-dim) dimensions))) (setq remaining-available-dimension (- remaining-available-dimension (car dimensions)))))))
--- a/lisp/w3/w3-forms.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/w3/w3-forms.el Mon Aug 13 09:21:54 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-forms.el --- Emacs-w3 forms parsing code for new display engine ;; Author: wmperry -;; Created: 1997/03/07 14:26:02 -;; Version: 1.77 +;; Created: 1997/03/18 23:20:04 +;; Version: 1.79 ;; Keywords: faces, help, comm, data, languages ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -249,7 +249,9 @@ (make-variable-buffer-local 'w3-custom-options) (defun w3-form-create-custom (el face) - (require 'custom-edit) + (condition-case () + (require 'cus-edit) + (error (require 'custom-edit))) (let* ((name (w3-form-element-name el)) (var-name (w3-form-element-value el)) (type (plist-get (w3-form-element-plist el) 'custom-type)) @@ -885,7 +887,6 @@ (lambda (char) (cond ((= char ? ) "+") - ((memq char '(?: ?/)) (char-to-string char)) ((memq char url-unreserved-chars) (char-to-string char)) (t (upcase (format "%%%02x" char)))))) (mule-encode-string chunk) ""))
--- a/lisp/w3/w3-menu.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/w3/w3-menu.el Mon Aug 13 09:21:54 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-menu.el --- Menu functions for emacs-w3 ;; Author: wmperry -;; Created: 1997/03/13 19:25:10 -;; Version: 1.32 +;; Created: 1997/03/18 00:45:01 +;; Version: 1.34 ;; Keywords: menu, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -27,6 +27,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (require 'w3-vars) +(require 'w3-mouse) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Spiffy new menus (for both Emacs and XEmacs) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -676,47 +677,49 @@ (defun w3-popup-menu (e) "Pop up a menu of common w3 commands" (interactive "e") - (mouse-set-point e) - (let* ((glyph (event-glyph e)) - (widget (or (and glyph (glyph-property glyph 'widget)) - (widget-at (point)))) - (parent (and widget (widget-get widget :parent))) - (href (or (and widget (widget-get widget 'href)) - (and parent (widget-get parent 'href)))) - (imag (or (and widget (widget-get widget 'src)) - (and parent (widget-get parent 'src)))) - (menu (copy-tree w3-popup-menu)) - url val trunc-url) - (if href - (progn - (setq url href) - (if url (setq trunc-url (url-truncate-url-for-viewing - url - w3-max-menu-width))) + (if (not w3-popup-menu-on-mouse-3) + (call-interactively (lookup-key global-map (vector w3-mouse-button3))) + (mouse-set-point e) + (let* ((glyph (event-glyph e)) + (widget (or (and glyph (glyph-property glyph 'widget)) + (widget-at (point)))) + (parent (and widget (widget-get widget :parent))) + (href (or (and widget (widget-get widget 'href)) + (and parent (widget-get parent 'href)))) + (imag (or (and widget (widget-get widget 'src)) + (and parent (widget-get parent 'src)))) + (menu (copy-tree w3-popup-menu)) + url val trunc-url) + (if href + (progn + (setq url href) + (if url (setq trunc-url (url-truncate-url-for-viewing + url + w3-max-menu-width))) + (setcdr menu (append (cdr menu) + '("---") + (mapcar + (function + (lambda (x) + (vector (format (car x) trunc-url) + (list (cdr x) url) t))) + w3-hyperlink-menu))))) + (if imag + (progn + (setq url imag + trunc-url (url-truncate-url-for-viewing url + w3-max-menu-width)) + (setcdr menu (append (cdr menu) + '("---") + (mapcar + (function + (lambda (x) + (vector (format (car x) trunc-url) + (list (cdr x) url) t))) + w3-graphlink-menu))))) + (if (not (w3-menubar-active)) (setcdr menu (append (cdr menu) - '("---") - (mapcar - (function - (lambda (x) - (vector (format (car x) trunc-url) - (list (cdr x) url) t))) - w3-hyperlink-menu))))) - (if imag - (progn - (setq url imag - trunc-url (url-truncate-url-for-viewing url - w3-max-menu-width)) - (setcdr menu (append (cdr menu) - '("---") - (mapcar - (function - (lambda (x) - (vector (format (car x) trunc-url) - (list (cdr x) url) t))) - w3-graphlink-menu))))) - (if (not (w3-menubar-active)) - (setcdr menu (append (cdr menu) - '("---" ["Show Menubar" w3-toggle-menubar t])))) - (popup-menu menu))) + '("---" ["Show Menubar" w3-toggle-menubar t])))) + (popup-menu menu)))) (provide 'w3-menu)
--- a/lisp/w3/w3-parse.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/w3/w3-parse.el Mon Aug 13 09:21:54 2007 +0200 @@ -264,11 +264,11 @@ (while (progn (skip-chars-forward "^\"\\\t\n\r") (not (eobp))) - (insert "\\" (cdr (assq (following-char) '((?\" . "\"") - (?\\ . "\\") - (?\t . "t") - (?\n . "n") - (?\r . "r"))))) + (insert "\\" (cdr (assq (char-after (point)) '((?\" . "\"") + (?\\ . "\\") + (?\t . "t") + (?\n . "n") + (?\r . "r"))))) (delete-char 1)) (insert "\"") (buffer-string))) @@ -450,7 +450,7 @@ ;; is not a function character in the SGML declaration. ) - ((eq ?& (following-char)) + ((eq ?& (char-after (point))) ;; We are either looking at an undefined reference or a & that does ;; not start a reference (in which case we should not have been called). ;; Skip over the &. @@ -1530,6 +1530,7 @@ nil (((tbody) *close) ;; error handling + ((td th) tr *same error) ((%body.content) tr *same error)) nil)]) (end-tag-omissible . t)) @@ -2116,7 +2117,7 @@ ;; character, or end of buffer. (cond - ((= ?< (following-char)) + ((eq ?< (char-after (point))) ;; We are looking at a tag, comment, markup declaration, SGML marked ;; section, SGML processing instruction, or non-markup "<". @@ -2131,8 +2132,8 @@ (setq w3-p-d-tag-name (intern (buffer-substring (match-beginning 1) (match-end 1)))) - (setq w3-p-d-end-tag-p (= ?/ (following-char))) - (setq between-tags-end (1- (point))) + (setq w3-p-d-end-tag-p (eq ?/ (char-after (point))) + between-tags-end (1- (point))) (goto-char (match-end 0)) ;; Read the attributes from a start-tag. @@ -2244,7 +2245,7 @@ (buffer-substring (point-min) (point-max))))) (t (error "impossible attribute value")))) - ((memq (following-char) '(?\" ?')) + ((memq (char-after (point)) '(?\" ?')) ;; Missing terminating quote character. (narrow-to-region (point) (progn @@ -2348,15 +2349,15 @@ ;; Process the end of the tag. (skip-chars-forward " \t\n\r") - (cond ((= ?> (following-char)) + (cond ((eq ?> (char-after (point))) ;; Ordinary tag end. (forward-char 1)) - ((and (= ?/ (following-char)) + ((and (eq ?/ (char-after (point))) (not w3-p-d-end-tag-p)) ;; This is a NET-enabling start-tag. (setq net-tag-p t) (forward-char 1)) - ((= ?< (following-char)) + ((eq ?< (char-after (point))) ;; *** Strictly speaking, the following text has to ;; lexically be STAGO or ETAGO, which means that it ;; can't match some other lexical unit. @@ -2373,7 +2374,7 @@ ((looking-at "/?>") ;; We are looking at an empty tag (<>, </>). - (setq w3-p-d-end-tag-p (= ?/ (following-char))) + (setq w3-p-d-end-tag-p (eq ?/ (char-after (point)))) (setq w3-p-d-tag-name (if w3-p-d-end-tag-p (w3-element-name w3-p-d-current-element) ;; *** Strictly speaking, if OMITTAG NO, then @@ -2435,7 +2436,7 @@ ;; declarations, a goal for the future. (w3-debug-html "Bad <! syntax.") (skip-chars-forward "^>") - (if (= ?> (following-char)) + (if (eq ?> (char-after (point))) (forward-char)))) (point)))) @@ -2462,7 +2463,7 @@ ((memq 'RCDATA keywords)) ((memq 'INCLUDE keywords)) ((memq 'TEMP keywords)))))) - (or (= ?\[ (following-char)) + (or (eq ?\[ (char-after (point))) ;; I probably shouldn't even check this, since it is so ;; impossible. (error "impossible ??")) @@ -2503,7 +2504,7 @@ (point) (progn (skip-chars-forward "^>") - (if (= ?> (following-char)) + (if (eq ?> (char-after (point))) (forward-char)) (point)))) (t @@ -2512,16 +2513,16 @@ ;; again. ))) - ((= ?& (following-char)) + ((eq ?& (char-after (point))) (w3-expand-entity-at-point-maybe)) - ((and (= ?\] (following-char)) + ((and (eq ?\] (char-after (point))) w3-p-d-in-parsed-marked-section (looking-at "]]>")) ;; *** handle the end of a parsed marked section. (error "***unimplemented***")) - ((and (= ?/ (following-char)) + ((and (eq ?/ (char-after (point))) w3-p-d-null-end-tag-enabled) ;; We are looking at a null end tag. (setq w3-p-d-end-tag-p t) @@ -2554,8 +2555,8 @@ ((looking-at (eval-when-compile (concat "[" (w3-invalid-sgml-chars) "]"))) (w3-debug-html - (format "Invalid SGML character: %c" (following-char))) - (insert (or (cdr-safe (assq (following-char) + (format "Invalid SGML character: %c" (char-after (point)))) + (insert (or (cdr-safe (assq (char-after (point)) ;; These characters are apparently ;; from a Windows character set. '((146 . "'") @@ -2610,7 +2611,7 @@ (or (setq content (w3-element-content w3-p-d-current-element)) ;; *** Strictly speaking, in SGML the record end is ;; carriage return, not line feed. - (if (= ?\n (char-after between-tags-start)) + (if (eq ?\n (char-after between-tags-start)) (setq between-tags-start (1+ between-tags-start)))) (if (= between-tags-start (point)) ;; Do nothing. @@ -2739,7 +2740,7 @@ "</[a-z>]\\|&") nil 'move) (goto-char (match-beginning 0))) - (= ?& (following-char))) + (eq ?& (char-after (point)))) (w3-expand-entity-at-point-maybe))))))) (t ;; The element is illegal here. We'll just discard the start
--- a/lisp/w3/w3-prefs.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/w3/w3-prefs.el Mon Aug 13 09:21:54 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-prefs.el --- Preferences panels for Emacs-W3 ;; Author: wmperry -;; Created: 1997/03/14 06:31:17 -;; Version: 1.19 +;; Created: 1997/03/14 23:49:47 +;; Version: 1.20 ;; Keywords: hypermedia, preferences ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -219,7 +219,7 @@ (while todo (setq cur (car todo) todo (cdr todo) - doc (documentation-property cur 'variable-documentation)) ;; (get cur 'variable-documentation)) + doc (documentation-property cur 'variable-documentation)) (if (string-match "^\\*" doc) (setq doc (substring doc 1 nil))) (setq pt (point))
--- a/lisp/w3/w3-script.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/w3/w3-script.el Mon Aug 13 09:21:54 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-script.el --- Scripting support ;; Author: wmperry -;; Created: 1997/03/08 01:28:33 -;; Version: 1.6 +;; Created: 1997/03/20 14:22:28 +;; Version: 1.7 ;; Keywords: hypermedia, scripting ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -44,9 +44,15 @@ ;; onabort ; User cancelled loading an image ;; onerror ; Error occurred loading an image -(defvar w3-do-scripting t +(defgroup w3-scripting nil + "When, where, how, and why to enable client-side scripting." + :group 'w3) + +(defcustom w3-do-scripting nil "*Whether to handle client-side scripting or not. -If you are ultra-paranoid, set this to `nil'") +If you are adventurous, set this to `t'" + :group 'w3-scripting + :type 'boolean) (defvar w3-current-scripting-language 'elisp) (make-variable-buffer-local 'w3-current-scripting-language)
--- a/lisp/w3/w3-sysdp.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/w3/w3-sysdp.el Mon Aug 13 09:21:54 2007 +0200 @@ -420,6 +420,12 @@ object) (setq start next)))) +(sysdep-defun buffer-substring-no-properties (st nd) + "Return the characters of part of the buffer, without the text properties. +The two arguments START and END are character positions; +they can be in either order." + (buffer-substring st nd)) + ;; Property list functions ;; (sysdep-defun plist-put (plist prop val)
--- a/lisp/w3/w3-vars.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/w3/w3-vars.el Mon Aug 13 09:21:54 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-vars.el,v --- All variable definitions for emacs-w3 ;; Author: wmperry -;; Created: 1997/03/14 06:51:56 -;; Version: 1.108 +;; Created: 1997/03/20 18:03:49 +;; Version: 1.112 ;; Keywords: comm, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -33,7 +33,7 @@ (require 'w3-cus) ; Grab everything that is customized (defconst w3-version-number - (let ((x "p3.0.68")) + (let ((x "p3.0.71")) (if (string-match "State:[ \t\n]+.\\([^ \t\n]+\\)" x) (setq x (substring x (match-beginning 1) (match-end 1))) (setq x (substring x 1))) @@ -41,7 +41,7 @@ (function (lambda (x) (if (= x ?-) "." (char-to-string x)))) x "")) "Version # of w3-mode.") -(defconst w3-version-date (let ((x "1997/03/14 06:51:56")) +(defconst w3-version-date (let ((x "1997/03/20 18:03:49")) (if (string-match "Date: \\([^ \t\n]+\\)" x) (substring x (match-beginning 1) (match-end 1)) x)) @@ -364,17 +364,8 @@ "*A buffer-local variable holding positions and urls of images within the buffer.") -(defvar w3-frame-labels '("FRAME(" . ")") - "Strings surrounding a frame name") - -(defvar w3-frame-regexp "FRAME(\\([^)]+\\))" - "Regexp for finding a frame hyperlink") - (defvar w3-frameset-structure nil - "Frameset structure") - -(defvar w3-frameset-dimensions nil - "Frameset dimensions") + "Frameset structure, heap of '(frameset ({cols|rows} \"<dimensions>\")) and '(<frame name> <href>)") (defvar w3-frame-name nil "Frame name") @@ -475,7 +466,6 @@ w3-base-target w3-target-window-distances w3-frameset-structure - w3-frameset-dimensions ) "A list of variables that should be preserved when entering w3-mode.")
--- a/lisp/w3/w3.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/w3/w3.el Mon Aug 13 09:21:54 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3.el --- Main functions for emacs-w3 on all platforms/versions ;; Author: wmperry -;; Created: 1997/03/14 06:39:41 -;; Version: 1.98 +;; Created: 1997/03/18 20:31:29 +;; Version: 1.100 ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -472,8 +472,9 @@ (progn (push-mark (point) t) (w3-find-specific-link (url-match url 1)))) - (message "Reusing URL. To reload, type %s." - (substitute-command-keys "\\[w3-reload-document]"))))))) + (or (w3-maybe-fetch-frames) + (message "Reusing URL. To reload, type %s." + (substitute-command-keys "\\[w3-reload-document]")))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1226,7 +1227,8 @@ (defun w3-popup-info (&optional url) "Show information about the link under point. (All SGML attributes)" - (interactive (list (w3-read-url-with-default))) + (interactive (list (or (w3-view-this-url t) + (w3-read-url-with-default)))) (let (dat widget) (if (interactive-p) nil
--- a/lisp/x11/x-compose.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/x11/x-compose.el Mon Aug 13 09:21:54 2007 +0200 @@ -269,6 +269,7 @@ ;;; compose-map. (set-keymap-name compose-acute-map 'compose-acute-map) +(set-keymap-default-binding compose-acute-map 'self-insert-command) (define-key compose-acute-map " " "'") (define-key compose-acute-map "'" [acute]) (define-key compose-acute-map "A" [Aacute]) @@ -285,6 +286,7 @@ (define-key compose-acute-map "y" [yacute]) (set-keymap-name compose-grave-map 'compose-grave-map) +(set-keymap-default-binding compose-grave-map 'self-insert-command) (define-key compose-grave-map " " [grave]) (define-key compose-grave-map "A" [Agrave]) (define-key compose-grave-map "E" [Egrave]) @@ -298,11 +300,13 @@ (define-key compose-grave-map "u" [ugrave]) (set-keymap-name compose-cedilla-map 'compose-cedilla-map) +(set-keymap-default-binding compose-cedilla-map 'self-insert-command) (define-key compose-cedilla-map "," [cedilla]) (define-key compose-cedilla-map "C" [Ccedilla]) (define-key compose-cedilla-map "c" [ccedilla]) (set-keymap-name compose-diaeresis-map 'compose-diaeresis-map) +(set-keymap-default-binding compose-diaeresis-map 'self-insert-command) (define-key compose-diaeresis-map " " [diaeresis]) (define-key compose-diaeresis-map "\"" [diaeresis]) (define-key compose-diaeresis-map "A" [Adiaeresis]) @@ -318,6 +322,7 @@ (define-key compose-diaeresis-map "y" [ydiaeresis]) (set-keymap-name compose-circumflex-map 'compose-circumflex-map) +(set-keymap-default-binding compose-circumflex-map 'self-insert-command) (define-key compose-circumflex-map " " "^") (define-key compose-circumflex-map "/" "|") (define-key compose-circumflex-map "!" [brokenbar]) @@ -340,6 +345,7 @@ (define-key compose-circumflex-map "u" [ucircumflex]) (set-keymap-name compose-tilde-map 'compose-tilde-map) +(set-keymap-default-binding compose-tilde-map 'self-insert-command) (define-key compose-tilde-map " " "~") (define-key compose-tilde-map "A" [Atilde]) (define-key compose-tilde-map "N" [Ntilde]) @@ -349,6 +355,7 @@ (define-key compose-tilde-map "o" [otilde]) (set-keymap-name compose-ring-map 'compose-ring-map) +(set-keymap-default-binding compose-ring-map 'self-insert-command) (define-key compose-ring-map " " [degree]) (define-key compose-ring-map "A" [Aring]) (define-key compose-ring-map "a" [aring]) @@ -358,6 +365,7 @@ ;;; that are not accessible via "dead" keys. (set-keymap-name compose-map 'compose-map) +(set-keymap-default-binding compose-map 'self-insert-command) (define-key compose-map " '" "'") (define-key compose-map " ^" "^") (define-key compose-map " `" "`")
--- a/lwlib/xlwmenu.c Mon Aug 13 09:20:50 2007 +0200 +++ b/lwlib/xlwmenu.c Mon Aug 13 09:21:54 2007 +0200 @@ -2338,7 +2338,11 @@ *inside_menu = False; /* Find the window */ +#if 1 for (i = mw->menu.old_depth - 1; i >= 0; i--) +#else + for (i = 0; i <= mw->menu.old_depth - 1; i++) +#endif { ws = &mw->menu.windows [i]; if (ws && motion_event_is_in_menu (mw, ev, i, &relative_pos))
--- a/man/custom.texi Mon Aug 13 09:20:50 2007 +0200 +++ b/man/custom.texi Mon Aug 13 09:21:54 2007 +0200 @@ -13,7 +13,7 @@ @comment node-name, next, previous, up @top The Customization Library -Version: 1.64 +Version: 1.65 @menu * Introduction::
--- a/man/gnus.texi Mon Aug 13 09:20:50 2007 +0200 +++ b/man/gnus.texi Mon Aug 13 09:21:54 2007 +0200 @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Gnus 5.4.28 Manual +@settitle Gnus 5.4.33 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -287,7 +287,7 @@ @tex @titlepage -@title Gnus 5.4.28 Manual +@title Gnus 5.4.33 Manual @author by Lars Magne Ingebrigtsen @page @@ -323,7 +323,7 @@ spool or your mbox file. All at the same time, if you want to push your luck. -This manual corresponds to Gnus 5.4.28 +This manual corresponds to Gnus 5.4.33. @end ifinfo @@ -6030,6 +6030,12 @@ Do all the three commands above (@code{gnus-article-strip-blank-lines}). +@item W E s +@kindex W E s (Summary) +@findex gnus-article-strip-leading-space +Remove all white space from the beginning of all lines of the article +body (@code{gnus-article-strip-leading-space}). + @end table @@ -6755,6 +6761,17 @@ it to, for instance, highlight lines or modify the look of the buffer in some other ungodly manner. I don't care. +@vindex gnus-summary-ignore-duplicates +@item gnus-summary-ignore-duplicates +When Gnus discovers two articles that have the same @code{Message-ID}, +it has to do something drastic. No articles are allowed to have the +same @code{Message-ID}, but this may happen when reading mail from some +sources. Gnus allows you to customize what happens with this variable. +If it is @code{nil} (which is the default), Gnus will rename the +@code{Message-ID} (for display purposes only) and display the article as +any other article. If this variable is @code{t}, it won't display the +article---it'll be as if it never existed. + @end table @@ -8856,6 +8873,12 @@ @findex delete-file Function called to delete files. It is @code{delete-file} by default. +@item nnmail-cache-accepted-message-ids +@vindex nnmail-cache-accepted-message-ids +If non-@code{nil}, put the @code{Message-ID}s of articles imported into +the backend (via @code{Gcc}, for instance) into the mail duplication +discovery cache. The default is @code{nil}. + @end table
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/man/hypb-mouse.txt Mon Aug 13 09:21:54 2007 +0200 @@ -0,0 +1,69 @@ +============================================================================== + Smart Keys +Context Action Key Assist Key +============================================================================== +Hyperbole + On a menu item Item is activated Item help + On an explicit button Button is activated Button help + Reading argument + 1st press at an arg value Value copied to minibuffer <- same + 2nd press at an arg value Value used as argument <- same + In minibuffer Minibuf arg is applied Completion help + On an implicit button Button is activated Button help + Within an outline cell Collapses and expands Shows tree props + Left of an outline cell Creates a klink Moves a tree + Wrolo Match Buffer Edits entries and mails to e-mail addresses + +Mouse or Keyboard Display Control + Line end, not end of buffer + smart-scroll-proportional + = t (default) Makes curr line top line Bottom line + = nil Scrolls up a windowful Scrolls down + End of Any Help buffer Screen restored to previous state + +Mouse-only Control + Modeline down & wind release Resize window height <- same + Drag from shared window side + or from left of scroll bar Resize window width <- same + Drag between windows Create/modify a link but Swap window buffers + Horizontal drag within window + Left to right Scroll to buffer end Split window across + Right to left Scroll to buffer begin Delete window + Vertical drag within window Split window sideways <- same + Diagonal drag within window Save ring screen-config Restore ring config + Click in modeline + Left window edge Bury buffer Unbury bottom buf + Right window edge Info Smart Key summary + Otherwise Action Key Hook Assist Key Hook + +Special Modes + C,C++,Objective-C,Java Modes Jumps to id/include def Jumps to next def + Java Cross-Reference Tag Jumps to identifier def Jumps to next def + Assembly Language Mode Jumps to id/include def Jumps to next def + Any Lisp or Fortran Mode Jumps to id def Jumps to next def + Emacs Lisp Compiler Error Jumps to def with error <- same + Grep or Occur Match Jumps to match source line <- same + Multi-buffer Occur Match Jumps to match source line <- same + Outline Major/Minor Modes Collapses, expands, and moves outline entries + Man Apropos Displays man page entry <- same + Man Pages Follows cross refs, file refs and C code refs + Buffer Menu Saves, deletes and displays buffers + +Emacs Info Reader + Menu Entry or Cross Ref Jumps to referent <- same + Up, Next or Prev Header Jumps to referent Jumps to prior node + File entry of Header Jumps to top node Jumps to (DIR) node + End of current node Jumps to next node Jumps to prev node + Anywhere else Scrolls up a windowful Scrolls down a wind + +Subsystems + Calendar Scrolls or shows appts Scrolls/marks dates + Dired Mode Views and deletes files from directory listing + GNUS News Reader Toggles group subscriptions, gets new news, + and browses articles + Mail reader and Summaries Browses, deletes and expunges messages + OO-Browser Browses classes and elements + Tar Mode Views and edits files from tar archive files + +Any other context (defaults) Hyperbole top menu Smart Key summary +==============================================================================
--- a/man/hyperbole.texi Mon Aug 13 09:20:50 2007 +0200 +++ b/man/hyperbole.texi Mon Aug 13 09:21:54 2007 +0200 @@ -12,7 +12,7 @@ @c Tel: +1 408-243-3300 @c @c ORIG-DATE: 6-Nov-91 at 11:18:03 -@c LAST-MOD: 20-Feb-97 at 12:36:16 by Bob Weiner +@c LAST-MOD: 17-Mar-97 at 21:36:15 by Bob Weiner @c %**start of header (This is for running Texinfo on a region.) @setfilename ../info/hyperbole.info @@ -35,9 +35,9 @@ @sp 1 @center E-mail: <hyperbole@@infodock.com> (This is a mailing list.) @sp 2 -@center Edition 4.02 +@center Edition 4.023 @sp 2 -@center February 19, 1997 +@center March 17, 1997 @page @vskip 0pt plus 1filll @@ -2222,8 +2222,9 @@ @item Cust/ Customizes Hyperbole by setting major options. This includes where Hyperbole link referents are displayed, where URLs -are displayed and whether to use proportional or windowful scrolling -when a Smart Key is pressed at the end of a line. @xref{Configuring}. +are displayed, whether the date stamps are added to rolodex entries, and +whether to use proportional or windowful scrolling when a Smart Key is +pressed at the end of a line. @xref{Configuring}. @cindex menu, EBut @item Ebut/ @@ -3378,17 +3379,19 @@ @end group @end example -We call rolodex records, @dfn{entries}. Entries begin with a delimiter, -some number of `*' characters at the beginning of a line. Entries may +We call rolodex records, @dfn{entries}. Entries begin with a delimiter +of one or more `*' characters at the beginning of a line. Entries may be arranged in a hierarchy, where child entries begin with one more `*' -characters than do their parents. Top level entries begin with a single +character than do their parents. Top level entries begin with a single `*'. Beyond this initial delimiter, entries are completely free-form text. It is best to use a "lastname, firstname" format, however, when adding contact entries into a rolodex. Then the rolodex system will automatically keep your entries alphabetized as you enter them. You'll -also be able to sort them whenever you desire. +also be able to sort them whenever you desire. This is what the +rolodex will use if you accept the default entry that it prompts you +with when adding a new entry. Any search done on the rolodex scans the full text of each entry. During a search, the rolodex file header separator lines and anything in @@ -3491,9 +3494,23 @@ @section Rolo Keys @kindex e -@cindex rolodex, editing an entry +@cindex rolodex, editing +@cindex datestamps +@cindex rolodex, datestamps +@cindex customization, rolodex datestamps +@cindex menu, Toggle-Rolo-Dates +@cindex customization, rolodex edits +@cindex customization, rolodex additions +@vindex wrolo-edit-hook +@vindex wrolo-add-hook Use the @{@kbd{e}@} key to edit the entry at point within the rolodex -source file. +source file. A datestamp will be automatically added or updated at the +end of the entry, unless this feature has been turned off via the +Cust/Toggle-Rolo-Dates menu item. The variable, @var{wrolo-edit-hook}, +is evaluated after the update of the entry datestamp. This allows +programmed modification of the way rolodex edits work. The variable, +@var{wrolo-add-hook}, works the same way but is evaluated when a new +entry is first added. @cindex wrolo menu @cindex rolodex keys @@ -3602,8 +3619,8 @@ setting: @code{(setq rolo-save-buffers-after-use nil)}. @vindex rolo-email-format -When adding an entry from within a buffer containing a mail message, the -rolodex add function will extract the sender's name and e-mail address +When adding an entry from within a buffer that contains a mail message, +the rolodex add function will extract the sender's name and e-mail address and prompt you with the name as a default. If you accept it, it will enter the name and the email address using the format given by the @var{rolo-email-format} variable. See its documentation if you want to
--- a/man/lispref/mule.texi Mon Aug 13 09:20:50 2007 +0200 +++ b/man/lispref/mule.texi Mon Aug 13 09:21:54 2007 +0200 @@ -203,11 +203,11 @@ A documentation string describing the charset. @item registry A regular expression matching the font registry field for this character -set. For example, both the @code{ascii} and @code{latin-1} charsets -use the registry @code{"ISO8859-1"}. This field is used to choose -an appropriate font when the user gives a general font specification -such as @samp{-*-courier-medium-r-*-140-*}, i.e. a 14-point upright -medium-weight Courier font. +set. For example, both the @code{ascii} and @code{latin-iso8859-1} +charsets use the registry @code{"ISO8859-1"}. This field is used to +choose an appropriate font when the user gives a general font +specification such as @samp{-*-courier-medium-r-*-140-*}, i.e. a +14-point upright medium-weight Courier font. @item dimension Number of position codes used to index a character in the character set. XEmacs/MULE can only handle character sets of dimension 1 or 2. @@ -251,8 +251,8 @@ it set to 1, position codes 33 through 126 map to font indices 161 through 254 (i.e. the same number but with the high bit set). For example, for a font whose registry is ISO8859-1, the left half of the -font (octets 0x20 - 0x7F) is the @code{ascii} charset, while the -right half (octets 0xA0 - 0xFF) is the @code{latin-1} charset. +font (octets 0x20 - 0x7F) is the @code{ascii} charset, while the right +half (octets 0xA0 - 0xFF) is the @code{latin-iso8859-1} charset. @item ccl-program A compiled CCL program used to convert a character in this charset into an index into the font. This is in addition to the @code{graphic} @@ -404,22 +404,22 @@ -------------------------------------------------------------- ascii 94 B 0 l2r ISO8859-1 control-1 94 0 l2r --- -latin-1 94 A 1 l2r ISO8859-1 -latin-2 96 B 1 l2r ISO8859-2 -latin-3 96 C 1 l2r ISO8859-3 -latin-4 96 D 1 l2r ISO8859-4 -cyrillic 96 L 1 l2r ISO8859-5 -arabic 96 G 1 r2l ISO8859-6 -greek 96 F 1 l2r ISO8859-7 -hebrew 96 H 1 r2l ISO8859-8 -latin-5 96 M 1 l2r ISO8859-9 -thai 96 T 1 l2r TIS620 -japanese-jisx0201-kana 94 I 1 l2r JISX0201.1976 -japanese-jisx0201-roman 94 J 0 l2r JISX0201.1976 +latin-iso8859-1 94 A 1 l2r ISO8859-1 +latin-iso8859-2 96 B 1 l2r ISO8859-2 +latin-iso8859-3 96 C 1 l2r ISO8859-3 +latin-iso8859-4 96 D 1 l2r ISO8859-4 +cyrillic-iso8859-5 96 L 1 l2r ISO8859-5 +arabic-iso8859-6 96 G 1 r2l ISO8859-6 +greek-iso8859-7 96 F 1 l2r ISO8859-7 +hebrew-iso8859-8 96 H 1 r2l ISO8859-8 +latin-iso8859-9 96 M 1 l2r ISO8859-9 +thai-tis620 96 T 1 l2r TIS620 +katakana-jisx0201 94 I 1 l2r JISX0201.1976 +latin-jisx0201 94 J 0 l2r JISX0201.1976 japanese-jisx0208-1978 94x94 @@ 0 l2r JISX0208.1978 japanese-jisx0208 94x94 B 0 l2r JISX0208.19(83|90) japanese-jisx0212 94x94 D 0 l2r JISX0212 -chinese-gb 94x94 A 0 l2r GB2312 +chinese-gb2312 94x94 A 0 l2r GB2312 chinese-cns11643-1 94x94 G 0 l2r CNS11643.1 chinese-cns11643-2 94x94 H 0 l2r CNS11643.2 chinese-big5-1 94x94 0 0 l2r Big5 @@ -473,13 +473,13 @@ (should be 0 or 1) of char @var{ch}. @var{n} defaults to 0 if omitted. @end defun -@defun charsets-in-region start end &optional buffer +@defun find-charset-region start end &optional buffer This function returns a list of the charsets in the region between @var{start} and @var{end}. @var{buffer} defaults to the current buffer if omitted. @end defun -@defun charsets-in-string string +@defun find-charset-string string This function returns a list of the charsets in @var{string}. @end defun @@ -777,8 +777,8 @@ @item no-conversion No conversion. Use this for binary files and such. On output, graphic characters that are not in ASCII or Latin-1 will be replaced by a -@samp{?}. (For a no-conversion-encoded buffer, these characters will only be -present if you explicitly insert them.) +@samp{?}. (For a no-conversion-encoded buffer, these characters will +only be present if you explicitly insert them.) @item shift-jis Shift-JIS (a Japanese encoding commonly used in PC operating systems). @item iso2022
--- a/man/message.texi Mon Aug 13 09:20:50 2007 +0200 +++ b/man/message.texi Mon Aug 13 09:21:54 2007 +0200 @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Message Manual +@settitle Message 5.4.33 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -12,7 +12,7 @@ @ifinfo -This file documents Messa, the Emacs message composition mode. +This file documents Message, the Emacs message composition mode. Copyright (C) 1996 Free Software Foundation, Inc. @@ -39,7 +39,7 @@ @tex @titlepage -@title Message Manual +@title Message 5.4.33 Manual @author by Lars Magne Ingebrigtsen @page @@ -79,6 +79,10 @@ * Key Index:: List of Message mode keys. @end menu +This manual corresponds to Message 5.4.33. Message is distributed with +the Gnus distribution bearing the same version number as this manual +has. + @node Interface @chapter Interface
--- a/man/widget.texi Mon Aug 13 09:20:50 2007 +0200 +++ b/man/widget.texi Mon Aug 13 09:21:54 2007 +0200 @@ -1,6 +1,6 @@ \input texinfo.tex -@c $Id: widget.texi,v 1.8 1997/03/18 03:27:04 steve Exp $ +@c $Id: widget.texi,v 1.9 1997/03/22 06:03:13 steve Exp $ @c %**start of header @setfilename widget @@ -15,7 +15,7 @@ @comment node-name, next, previous, up @top The Emacs Widget Library -Version: 1.64 +Version: 1.65 @menu * Introduction::
--- a/src/ChangeLog Mon Aug 13 09:20:50 2007 +0200 +++ b/src/ChangeLog Mon Aug 13 09:21:54 2007 +0200 @@ -1,3 +1,68 @@ +Fri Mar 21 20:19:09 1997 Steven L Baur <steve@altair.xemacs.org> + + * Makefile.in.in: strip inline.o. + +Fri Mar 21 18:54:04 1997 David Moore <dmoore@ucsd.edu> + + * fileio.c (call2_check_string_or_nil): New function. + (Ffile_name_directory): Use it. + (Fsubstitute_in_file_name): Use it. + + * fileio.c (Fexpand_file_name): GC protect against file handlers. + (Fdelete_file): ditto + (Ffile_writable_p): ditto + (Ffile_directory_p): ditto + (Ffile_regular_p): ditto + (Fset_file_modes): ditto + (Ffile_newer_than_file_p): ditto + (Fset_visited_file_modtime): ditto + + *fileio.c (Ffile_truename): Unneccessary GC protection. + (Fdelete_directory): Fix broken caller-must-GC-protect call. + + * filelock.c (lock_file): New comments warning that this function + may kill the current buffer. + (unlock_file): ditto + (Flock_buffer): ditto + (Funlock_buffer): ditto + (unlock_buffer): ditto + + * filelock.c (unlock_all_files): GC protect against unlock_file + killing random buffers. + + * buffer.c (Fkill_buffer): GC protect against unlock_file killing + the buffer. + + * insdel.c (prepare_to_modify_buffer): GC protect against + lock_file() killing the buffer. + +Fri Mar 21 19:11:15 1997 Steven L Baur <steve@altair.xemacs.org> + + * mule-coding.c (vars_of_mule_coding): Add + enable-multibyte-characters for MULE compatibility. + +Thu Mar 20 13:25:26 1997 Steven L Baur <steve@altair.xemacs.org> + + * glyphs-x.c: Implement a dummy function to insert a fake EOI + marker if called. Based on code from William Perry. + +Wed Mar 19 10:49:05 1997 Steven L Baur <steve@altair.xemacs.org> + + * menubar-x.c (pre_activate_callback): Attempt to avoid recursive + expansion of submenus via :filter expansion. + + * glyphs-x.c (x_print_image_instance): Move define of + HAVE_SUBWINDOWS to glyphs-x.h. + (our_skip_input_data): Implement with some error checking based on + patch by Dominic Froud. + + * glyphs-x.h (HAVE_SUBWINDOWS): Define to keep inline.c from + barfing. + +Tue Mar 18 11:15:23 1997 Steven L Baur <steve@altair.xemacs.org> + + * glyphs-x.c: Strip unimplemented subwindows code. + Mon Mar 17 15:40:12 1997 David Moore <dmoore@ucsd.edu> * glyphs-x.c (our_own_dgif_slurp_from_gif2x11_c): Only get the
--- a/src/Makefile.in.in Mon Aug 13 09:20:50 2007 +0200 +++ b/src/Makefile.in.in Mon Aug 13 09:21:54 2007 +0200 @@ -911,7 +911,7 @@ frame.o \ general.o getloadavg.o GIF_OBJS glyphs.o GUI_OBJS \ hash.o \ - indent.o inline.o insdel.o intl.o \ + indent.o insdel.o intl.o \ keymap.o $(RTC_PATCH_O) \ lread.o lstream.o \ macros.o marker.o md5.o MENUBAR_OBJS minibuf.o MOCKLISPOBJS \ @@ -1382,7 +1382,7 @@ ${libsrc}DOC: ${libsrc}make-docfile ${obj_src} ${mule_obj_src} ${lisp} #endif rm -f ${libsrc}DOC - ${libsrc}make-docfile -d ${srcdir} -i ../site-packages \ + ${libsrc}make-docfile -d ${srcdir} -i ${libsrc}../site-packages \ ${obj_src} ${mule_obj_src} \ ${mallocdocsrc} ${rallocdocsrc} ${lispdir}version.el \ ${lisp} > ${libsrc}DOC @@ -1937,8 +1937,6 @@ glyphs.o: mule-charset.h gui-x.o: mule-charset.h indent.o: mule-charset.h -inline.o: mule-charset.h -inline.o: mule-coding.h input-method-xlib.o: mule-charset.h input-method-xlib.o: mule-coding.h insdel.o: mule-charset.h @@ -2946,40 +2944,6 @@ indent.o: specifier.h indent.o: toolbar.h indent.o: window.h -inline.o: $(LWLIBSRCDIR)/lwlib.h -inline.o: blocktype.h -inline.o: buffer.h -inline.o: bufslots.h -inline.o: bytecode.h -inline.o: chartab.h -inline.o: config.h -inline.o: conslots.h -inline.o: console-x.h -inline.o: console.h -inline.o: device.h -inline.o: dynarr.h -inline.o: elhash.h -inline.o: events.h -inline.o: extents.h -inline.o: faces.h -inline.o: frame.h -inline.o: frameslots.h -inline.o: glyphs-x.h -inline.o: glyphs.h -inline.o: gui-x.h -inline.o: keymap.h -inline.o: lstream.h -inline.o: objects.h -inline.o: opaque.h -inline.o: process.h -inline.o: redisplay.h -inline.o: scrollbar.h -inline.o: specifier.h -inline.o: syntax.h -inline.o: systime.h -inline.o: toolbar.h -inline.o: window.h -inline.o: xintrinsic.h input-method-xlib.o: EmacsFrame.h input-method-xlib.o: blocktype.h input-method-xlib.o: buffer.h
--- a/src/buffer.c Mon Aug 13 09:20:50 2007 +0200 +++ b/src/buffer.c Mon Aug 13 09:21:54 2007 +0200 @@ -986,6 +986,8 @@ { int count = specpdl_depth (); /* lock_file() and unlock_file() currently use current_buffer */ + /* #### - dmoore, what if lock_file or unlock_file kill + the current buffer? */ record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); set_buffer_internal (buf); if (!already && !NILP (flag)) @@ -1306,14 +1308,14 @@ to kill the buffer. This must be done after the questions since anything can happen within yes-or-no-p. */ + /* Might have been deleted during the last question above */ + if (!BUFFER_LIVE_P (b)) + return Qnil; + /* Don't kill the minibuffer now current. */ if (EQ (buf, XWINDOW (minibuf_window)->buffer)) return Qnil; - /* Might have been deleted during the last question above */ - if (!BUFFER_LIVE_P (b)) - return Qnil; - /* When we kill a base buffer, kill all its indirect buffers. We do it at this stage so nothing terrible happens if they ask questions or their hooks get errors. */ @@ -1342,8 +1344,23 @@ /* Now there is no question: we can kill the buffer. */ #ifdef CLASH_DETECTION - /* Unlock this buffer's file, if it is locked. */ + /* Unlock this buffer's file, if it is locked. unlock_buffer + can both GC and kill the current buffer, and wreak general + havok by running lisp code. */ + GCPRO1 (buf); unlock_buffer (b); + UNGCPRO; + b = XBUFFER (buf); + + if (!BUFFER_LIVE_P (b)) + return Qnil; + + if (b == current_buffer) + { + Fset_buffer (Fother_buffer (buf, Qnil, Qnil)); + if (b == current_buffer) + return Qnil; + } #endif /* CLASH_DETECTION */ {
--- a/src/device-x.c Mon Aug 13 09:20:50 2007 +0200 +++ b/src/device-x.c Mon Aug 13 09:21:54 2007 +0200 @@ -99,8 +99,8 @@ /* helper functions */ /************************************************************************/ -struct device * -get_device_from_display (Display *dpy) +static struct device * +get_device_from_display_1 (Display *dpy) { Lisp_Object devcons, concons; @@ -111,11 +111,25 @@ return d; } - /* Only devices we are actually managing should ever be used as an - argument to this function. */ - abort (); + return 0; +} + +struct device * +get_device_from_display (Display *dpy) +{ + struct device *d = get_device_from_display_1 (dpy); - return 0; /* suppress compiler warning */ + if (!d) { + /* This isn't one of our displays. Let's crash? */ + stderr_out + ("\n%s: Fatal X Condition. Asked about display we don't own: \"%s\"\n", + (STRINGP (Vinvocation_name) ? + (char *) XSTRING_DATA (Vinvocation_name) : "xemacs"), + DisplayString (dpy) ? DisplayString (dpy) : "???"); + abort(); + } + + return d; } struct device * @@ -600,8 +614,12 @@ { /* This function can GC */ Lisp_Object dev; - struct device *d = get_device_from_display (disp); - XSETDEVICE (dev, d); + struct device *d = get_device_from_display_1 (disp); + + if (d) + XSETDEVICE (dev, d); + else + dev = Qnil; if (NILP (find_nonminibuffer_frame_not_on_device (dev))) { @@ -629,7 +647,8 @@ QLength (disp)); } - enqueue_magic_eval_event (io_error_delete_device, dev); + if (d) + enqueue_magic_eval_event (io_error_delete_device, dev); return 0; }
--- a/src/dgif_lib.c Mon Aug 13 09:20:50 2007 +0200 +++ b/src/dgif_lib.c Mon Aug 13 09:21:54 2007 +0200 @@ -915,6 +915,7 @@ SavedImage *sp; ExtensionBlock *ep; GifByteType *ExtData; + int ExtCode; /* Some versions of malloc dislike 0-length requests */ GifFile->SavedImages = (SavedImage *)xmalloc(sizeof(SavedImage)); @@ -941,7 +942,12 @@ break; case EXTENSION_RECORD_TYPE: - + /* This code fails if no image_desc record has been read + yet. I don't know if that's legal, but I've seen GIFs + that start with an extension record. XEmacs doesn't use + the extension records anyway, so we'll just ignore them. + - dkindred@cs.cmu.edu */ +#if 0 if (DGifGetExtension(GifFile,&sp->Function,&ExtData)==GIF_ERROR) return(GIF_ERROR); else @@ -965,6 +971,17 @@ memcpy(ep->Bytes,ExtData,ep->ByteCount * sizeof(char)); } } +#else + /* Skip any extension blocks in the file. */ + if (DGifGetExtension (GifFile, &ExtCode, &ExtData) + == GIF_ERROR) + return GIF_ERROR; + + while (ExtData != NULL) { + if (DGifGetExtensionNext (GifFile, &ExtData) == GIF_ERROR) + return GIF_ERROR; + } +#endif break; case TERMINATE_RECORD_TYPE:
--- a/src/editfns.c Mon Aug 13 09:20:50 2007 +0200 +++ b/src/editfns.c Mon Aug 13 09:21:54 2007 +0200 @@ -631,20 +631,42 @@ return Qnil; } -DEFUN ("char-after", Fchar_after, 1, 2, 0, /* +DEFUN ("char-after", Fchar_after, 0, 2, 0, /* Return character in BUFFER at position POS. POS is an integer or a buffer pointer. If POS is out of range, the value is nil. If BUFFER is nil, the current buffer is assumed. +if POS is nil, the value of point is assumed. */ (pos, buffer)) { struct buffer *b = decode_buffer (buffer, 1); - Bufpos n = get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD); + Bufpos n = (NILP (pos) ? BUF_PT (b) : + get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD)); if (n < 0 || n == BUF_ZV (b)) return Qnil; - return (make_char (BUF_FETCH_CHAR (b, n))); + return make_char (BUF_FETCH_CHAR (b, n)); +} + +DEFUN ("char-before", Fchar_before, 0, 2, 0, /* +Return character in BUFFER before position POS. +POS is an integer or a buffer pointer. +If POS is out of range, the value is nil. +If BUFFER is nil, the current buffer is assumed. +if POS is nil, the value of point is assumed. +*/ + (pos, buffer)) +{ + struct buffer *b = decode_buffer (buffer, 1); + Bufpos n = ((NILP (pos) ? BUF_PT (b) : + get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD))); + + n--; + + if (n < BUF_BEGV (b)) + return Qnil; + return make_char (BUF_FETCH_CHAR (b, n)); } @@ -2104,6 +2126,7 @@ DEFSUBR (Ffollowing_char); DEFSUBR (Fpreceding_char); DEFSUBR (Fchar_after); + DEFSUBR (Fchar_before); DEFSUBR (Finsert); DEFSUBR (Finsert_string); DEFSUBR (Finsert_before_markers);
--- a/src/fileio.c Mon Aug 13 09:20:50 2007 +0200 +++ b/src/fileio.c Mon Aug 13 09:21:54 2007 +0200 @@ -115,6 +115,11 @@ DOESNT_RETURN report_file_error (CONST char *string, Lisp_Object data) { + /* #### dmoore - This uses current_buffer, better make sure no one + has GC'd the current buffer. File handlers are giving me a headache + maybe I'll just always protect current_buffer around all of those + calls. */ + /* mrb: #### Needs to be fixed at a lower level; errstring needs to be MULEized. The following at least prevents a crash... */ Lisp_Object errstring = build_ext_string (strerror (errno), FORMAT_BINARY); @@ -378,6 +383,16 @@ } static Lisp_Object +call2_check_string_or_nil (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1) +{ + /* This function can GC */ + Lisp_Object result = call2 (fn, arg0, arg1); + if (!NILP (result)) + CHECK_STRING (result); + return (result); +} + +static Lisp_Object call3_check_string (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2) { @@ -408,14 +423,8 @@ call the corresponding file handler. */ handler = Ffind_file_name_handler (file, Qfile_name_directory); if (!NILP (handler)) - { - Lisp_Object retval = call2 (handler, Qfile_name_directory, - file); - - if (!NILP (retval)) - CHECK_STRING (retval); - return retval; - } + return (call2_check_string_or_nil (handler, Qfile_name_directory, + file)); #ifdef FILE_SYSTEM_CASE file = FILE_SYSTEM_CASE (file); @@ -883,6 +892,7 @@ Bufbyte *tmp, *defdir; #endif /* DOS_NT */ Lisp_Object handler; + struct gcpro gcpro1; CHECK_STRING (name); @@ -911,7 +921,11 @@ if (!NILP (defalt)) { + struct gcpro gcpro1; + + GCPRO1 (defalt); /* might be current_buffer->directory */ handler = Ffind_file_name_handler (defalt, Qexpand_file_name); + UNGCPRO; if (!NILP (handler)) return call3 (handler, Qexpand_file_name, name, defalt); } @@ -934,7 +948,7 @@ { struct gcpro gcpro1; - GCPRO1 (name); + GCPRO1 (defalt); /* may be current_buffer->directory */ defalt = Fexpand_file_name (defalt, Qnil); UNGCPRO; } @@ -947,6 +961,8 @@ name = FILE_SYSTEM_CASE (name); #endif + /* #### dmoore - this is ugly, clean this up. Looks like nm + pointing into name should be safe during all of this, though. */ nm = XSTRING_DATA (name); #ifdef MSDOS @@ -1391,9 +1407,7 @@ CHECK_STRING (filename); - GCPRO1 (filename); expanded_name = Fexpand_file_name (filename, defalt); - UNGCPRO; if (!STRINGP (expanded_name)) return Qnil; @@ -1528,14 +1542,8 @@ call the corresponding file handler. */ handler = Ffind_file_name_handler (string, Qsubstitute_in_file_name); if (!NILP (handler)) - { - Lisp_Object retval = call2 (handler, Qsubstitute_in_file_name, - string); - - if (!NILP (retval)) - CHECK_STRING (retval); - return retval; - } + return (call2_check_string_or_nil (handler, Qsubstitute_in_file_name, + string)); nm = XSTRING_DATA (string); #ifdef MSDOS @@ -1984,18 +1992,16 @@ /* This function can GC */ char dir [MAXPATHLEN]; Lisp_Object handler; - struct gcpro gcpro1; - GCPRO1 (dirname); CHECK_STRING (dirname); dirname = Fexpand_file_name (dirname, Qnil); + GCPRO1 (dirname); handler = Ffind_file_name_handler (dirname, Qmake_directory_internal); UNGCPRO; if (!NILP (handler)) - return (call2 (handler, Qmake_directory_internal, - dirname)); + return (call2 (handler, Qmake_directory_internal, dirname)); if (XSTRING_LENGTH (dirname) > (sizeof (dir) - 1)) { @@ -2031,10 +2037,11 @@ Lisp_Object handler; struct gcpro gcpro1; + CHECK_STRING (dirname); + GCPRO1 (dirname); - CHECK_STRING (dirname); - dirname = - Fdirectory_file_name (Fexpand_file_name (dirname, Qnil)); + dirname = Fexpand_file_name (dirname, Qnil); + dirname = Fdirectory_file_name (dirname); handler = Ffind_file_name_handler (dirname, Qdelete_directory); UNGCPRO; @@ -2057,10 +2064,10 @@ Lisp_Object handler; struct gcpro gcpro1; - GCPRO1 (filename); CHECK_STRING (filename); filename = Fexpand_file_name (filename, Qnil); + GCPRO1 (filename); handler = Ffind_file_name_handler (filename, Qdelete_file); UNGCPRO; if (!NILP (handler)) @@ -2551,10 +2558,16 @@ ? Qt : Qnil); + GCPRO1 (abspath); dir = Ffile_name_directory (abspath); + UNGCPRO; #if defined (VMS) || defined (MSDOS) if (!NILP (dir)) - dir = Fdirectory_file_name (dir); + { + GCPRO1(dir); + dir = Fdirectory_file_name (dir); + UNGCPRO; + } #endif /* VMS or MSDOS */ return (check_writable (!NILP (dir) ? (char *) XSTRING_DATA (dir) : "") @@ -2626,7 +2639,7 @@ Lisp_Object handler; struct gcpro gcpro1; - GCPRO1 (filename); + GCPRO1 (current_buffer->directory); abspath = expand_and_dir_to_file (filename, current_buffer->directory); UNGCPRO; @@ -2665,6 +2678,8 @@ return call2 (handler, Qfile_accessible_directory_p, filename); + /* #### dmoore - this gcpro on filename should be unneccesary since + the caller should ahve already protected it. */ GCPRO1 (filename); if (NILP (Ffile_directory_p (filename))) { @@ -2682,15 +2697,20 @@ */ (filename)) { - REGISTER Lisp_Object abspath; + Lisp_Object abspath; struct stat st; Lisp_Object handler; - + struct gcpro gcpro1; + + GCPRO1 (current_buffer->directory); abspath = expand_and_dir_to_file (filename, current_buffer->directory); + UNGCPRO; /* If the file name has special constructs in it, call the corresponding file handler. */ + GCPRO1 (abspath); handler = Ffind_file_name_handler (abspath, Qfile_regular_p); + UNGCPRO; if (!NILP (handler)) return call2 (handler, Qfile_regular_p, abspath); @@ -2710,7 +2730,7 @@ Lisp_Object handler; struct gcpro gcpro1; - GCPRO1 (filename); + GCPRO1 (current_buffer->directory); abspath = expand_and_dir_to_file (filename, current_buffer->directory); UNGCPRO; @@ -2742,9 +2762,9 @@ /* This function can GC */ Lisp_Object abspath; Lisp_Object handler; - struct gcpro gcpro1, gcpro2; + struct gcpro gcpro1; - GCPRO2 (filename, mode); + GCPRO1 (current_buffer->directory); abspath = Fexpand_file_name (filename, current_buffer->directory); CHECK_INT (mode); UNGCPRO; @@ -2821,22 +2841,20 @@ struct stat st; int mtime1; Lisp_Object handler; - struct gcpro gcpro1, gcpro2; + struct gcpro gcpro1, gcpro2, gcpro3; CHECK_STRING (file1); CHECK_STRING (file2); abspath1 = Qnil; - GCPRO2 (abspath1, file2); - abspath1 = expand_and_dir_to_file (file1, - current_buffer->directory); - abspath2 = expand_and_dir_to_file (file2, - current_buffer->directory); - UNGCPRO; + abspath2 = Qnil; + + GCPRO3 (abspath1, abspath2, current_buffer->directory); + abspath1 = expand_and_dir_to_file (file1, current_buffer->directory); + abspath2 = expand_and_dir_to_file (file2, current_buffer->directory); /* If the file name has special constructs in it, call the corresponding file handler. */ - GCPRO2 (abspath1, abspath2); handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p); if (NILP (handler)) handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p); @@ -2890,12 +2908,13 @@ int saverrno = 0; Charcount inserted = 0; int speccount; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; Lisp_Object handler = Qnil, val; int total; Bufbyte read_buf[READ_BUF_SIZE]; int mc_count; struct buffer *buf = current_buffer; + Lisp_Object curbuf; int not_regular = 0; if (buf->base_buffer && ! NILP (visit)) @@ -2906,7 +2925,12 @@ val = Qnil; - GCPRO4 (filename, val, visit, handler); + /* #### dmoore - should probably check in various places to see if + curbuf was killed and if so signal an error? */ + + XSETBUFFER (curbuf, buf); + + GCPRO5 (filename, val, visit, handler, curbuf); mc_count = (NILP (replace)) ? begin_multiple_change (buf, BUF_PT (buf), BUF_PT (buf)) : @@ -3358,6 +3382,12 @@ struct buffer *given_buffer; Bufpos start1, end1; + /* #### dmoore - if Fexpand_file_name or handlers kill the buffer, + we should signal an error rather than blissfully continuing + along. ARGH, this function is going to lose lose lose. We need + to protect the current_buffer from being destroyed, but the + multiple return points make this a pain in the butt. */ + #ifdef DOS_NT int buffer_file_type = NILP (current_buffer->buffer_file_type) ? O_TEXT : O_BINARY; @@ -3376,6 +3406,7 @@ { Lisp_Object handler; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; + GCPRO5 (start, filename, visit, visit_file, lockname); if (visiting_other) @@ -3415,8 +3446,11 @@ #ifdef CLASH_DETECTION if (!auto_saving) { - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - GCPRO4 (start, filename, visit_file, lockname); + Lisp_Object curbuf; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; + + XSETBUFFER (curbuf, current_buffer); + GCPRO5 (start, filename, visit_file, lockname, curbuf); lock_file (lockname); UNGCPRO; } @@ -4061,11 +4095,10 @@ Lisp_Object filename; struct stat st; Lisp_Object handler; - struct gcpro gcpro1, gcpro2; + struct gcpro gcpro1, gcpro2, gcpro3; - GCPRO2 (filename, time_list); - filename = Fexpand_file_name (current_buffer->filename, - Qnil); + GCPRO3 (filename, time_list, current_buffer->filename); + filename = Fexpand_file_name (current_buffer->filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -4117,16 +4150,16 @@ if (!set_time_to_use) { Lisp_Object filename = Qnil; - struct gcpro gcpro1, gcpro2; - GCPRO2 (buf, filename); + struct gcpro gcpro1; + GCPRO1 (filename); + /* #### dmoore - do we need to protect XBUFFER (buf)->filename? + What if a ^(*&^&*^*& handler renames a buffer? I think I'm + getting a headache now. */ if (STRINGP (XBUFFER (buf)->filename)) - filename = Fexpand_file_name (XBUFFER (buf)->filename, - Qnil); + filename = Fexpand_file_name (XBUFFER (buf)->filename, Qnil); else filename = Qnil; - - UNGCPRO; if (!NILP (filename) && !NILP (Ffile_exists_p (filename))) { @@ -4134,7 +4167,6 @@ /* If the file name has special constructs in it, call the corresponding file handler. */ - GCPRO1 (filename); handler = Ffind_file_name_handler (filename, Qset_buffer_modtime); UNGCPRO; if (!NILP (handler)) @@ -4149,11 +4181,14 @@ } } else - time_to_use = time ((time_t *) 0); + { + UNGCPRO; + time_to_use = time ((time_t *) 0); + } } XBUFFER (buf)->modtime = time_to_use; - + return Qnil; }
--- a/src/filelock.c Mon Aug 13 09:20:50 2007 +0200 +++ b/src/filelock.c Mon Aug 13 09:21:54 2007 +0200 @@ -196,7 +196,11 @@ void lock_file (Lisp_Object fn) { - /* This function can GC */ + /* This function can GC. */ + /* dmoore - and can destroy current_buffer and all sorts of other + mean nasty things with pointy teeth. If you call this make sure + you protect things right. */ + REGISTER Lisp_Object attack, orig_fn; REGISTER char *lfname; struct gcpro gcpro1, gcpro2; @@ -337,6 +341,11 @@ void unlock_file (Lisp_Object fn) { + /* This function can GC. */ + /* dmoore - and can destroy current_buffer and all sorts of other + mean nasty things with pointy teeth. If you call this make sure + you protect things right. */ + REGISTER char *lfname; if (NILP (Vlock_directory) || NILP (Vsuperlock_file)) return; CHECK_STRING (fn); @@ -395,9 +404,13 @@ void unlock_all_files (void) { - REGISTER Lisp_Object tail; + /* This function can GC. */ + + Lisp_Object tail; REGISTER struct buffer *b; + struct gcpro gcpro1; + GCPRO1 (tail); for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCDR (tail)) { @@ -406,6 +419,7 @@ BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) unlock_file (b->file_truename); } + UNGCPRO; } @@ -417,6 +431,10 @@ (fn)) { /* This function can GC */ + /* dmoore - and can destroy current_buffer and all sorts of other + mean nasty things with pointy teeth. If you call this make sure + you protect things right. */ + if (NILP (fn)) fn = current_buffer->file_truename; CHECK_STRING (fn); @@ -432,6 +450,11 @@ */ ()) { + /* This function can GC */ + /* dmoore - and can destroy current_buffer and all sorts of other + mean nasty things with pointy teeth. If you call this make sure + you protect things right. */ + if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer) && STRINGP (current_buffer->file_truename)) unlock_file (current_buffer->file_truename); @@ -444,6 +467,10 @@ void unlock_buffer (struct buffer *buffer) { + /* This function can GC */ + /* dmoore - and can destroy current_buffer and all sorts of other + mean nasty things with pointy teeth. If you call this make sure + you protect things right. */ if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer) && STRINGP (buffer->file_truename)) unlock_file (buffer->file_truename);
--- a/src/glyphs-x.c Mon Aug 13 09:20:50 2007 +0200 +++ b/src/glyphs-x.c Mon Aug 13 09:21:54 2007 +0200 @@ -140,8 +140,10 @@ } write_c_string (")", printcharfun); break; +#if HAVE_SUBWINDOWS case IMAGE_SUBWINDOW: /* #### implement me */ +#endif default: break; } @@ -202,8 +204,10 @@ if (IMAGE_INSTANCE_X_NPIXELS (p1) != IMAGE_INSTANCE_X_NPIXELS (p2)) return 0; break; +#if HAVE_SUBWINDOWS case IMAGE_SUBWINDOW: /* #### implement me */ +#endif break; default: break; @@ -221,8 +225,10 @@ case IMAGE_COLOR_PIXMAP: case IMAGE_POINTER: return IMAGE_INSTANCE_X_NPIXELS (p); +#if HAVE_SUBWINDOWS case IMAGE_SUBWINDOW: /* #### implement me */ +#endif return 0; default: return 0; @@ -1053,7 +1059,9 @@ #include "jerror.h" /* The in-core jpeg code doesn't work, so I'm avoiding it for now. -sb */ -#define USE_TEMP_FILES_FOR_JPEG_IMAGES 1 +/* Late-breaking update, we're going to give it a try, I think it's */ +/* fixed now -sb */ +/*#define USE_TEMP_FILES_FOR_JPEG_IMAGES 1*/ #define USE_TEMP_FILES_FOR_PNG_IMAGES 1 static void @@ -1175,8 +1183,16 @@ METHODDEF boolean #endif our_fill_input_buffer (j_decompress_ptr cinfo) { - ERREXIT(cinfo,JERR_INPUT_EOF); - return FALSE; + /* Insert a fake EOI marker */ + struct jpeg_source_mgr *src = (struct jpeg_source_mgr *) cinfo->src; + static JOCTET buffer[2]; + + buffer[0] = (JOCTET) 0xFF; + buffer[1] = (JOCTET) JPEG_EOI; + + src->next_input_byte = buffer; + src->bytes_in_buffer = 2; + return TRUE; } #if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61) @@ -1185,6 +1201,19 @@ METHODDEF void #endif our_skip_input_data (j_decompress_ptr cinfo, long num_bytes) { + struct jpeg_source_mgr *src = NULL; + + src = (struct jpeg_source_mgr *) cinfo->src; + + if (!src) { + return; + } else if (num_bytes > src->bytes_in_buffer) { + ERREXIT(cinfo, JERR_INPUT_EOF); + /*NOTREACHED*/ + } + + src->bytes_in_buffer -= num_bytes; + src->next_input_byte += num_bytes; } #if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61) @@ -1199,8 +1228,8 @@ struct jpeg_source_mgr pub; } our_jpeg_source_mgr; -static void jpeg_memory_src (j_decompress_ptr cinfo, JOCTET *data, - unsigned int len) +static void +jpeg_memory_src (j_decompress_ptr cinfo, JOCTET *data, unsigned int len) { struct jpeg_source_mgr *src = NULL; @@ -1605,6 +1634,7 @@ return Qnil; } +#if 0 /* We provide our own version of DGifSlurp() because the standardly provided one doesn't handle interlaced GIFs. This is based on code in gif2x11.c. */ @@ -1711,6 +1741,7 @@ return GIF_OK; } +#endif static void gif_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, @@ -1760,10 +1791,12 @@ signal_simple_error ("Unable to decode GIF", build_string (EmacsPrintGifError ())); } -#if 1 +#if 0 if (our_own_dgif_slurp_from_gif2x11_c(unwind.giffile) != GIF_OK) #else - /* DGifSlurp() doesn't handle interlaced files. */ + /* DGifSlurp() doesn't handle interlaced files. */ + /* Actually, it does, sort of. It just sets the Interlace flag + and stores RasterBits in interlaced order. We handle that below. */ if (DGifSlurp (unwind.giffile) != GIF_OK) #endif goto gif_decode_error; @@ -1802,7 +1835,12 @@ int width = unwind.giffile->SWidth; int depth; int bitmap_pad; - int i, j; + int i, j, row, pass, interlace; + /* interlaced gifs have rows in this order: + 0, 8, 16, ..., 4, 12, 20, ..., 2, 6, 10, ..., 1, 3, 5, ... */ + static int InterlacedOffset[] = { 0, 4, 2, 1 }; + static int InterlacedJumps[] = { 8, 8, 4, 2 }; + depth = DefaultDepthOfScreen (scr); @@ -1835,14 +1873,35 @@ optimization routines from XPM (they're in turn mostly copied from the Xlib source code). */ + /* Note: We just use the first image in the file and ignore the rest. + We check here that that image covers the full "screen" size. + I don't know whether that's always the case. + -dkindred@cs.cmu.edu */ + if (unwind.giffile->SavedImages[0].ImageDesc.Height != height + || unwind.giffile->SavedImages[0].ImageDesc.Width != width + || unwind.giffile->SavedImages[0].ImageDesc.Left != 0 + || unwind.giffile->SavedImages[0].ImageDesc.Top != 0) + signal_simple_error ("First image in GIF file is not full size", + instantiator); + + interlace = unwind.giffile->SavedImages[0].ImageDesc.Interlace; + pass = 0; + row = interlace ? InterlacedOffset[pass] : 0; for (i = 0; i < height; i++) - for (j = 0; j < width; j++) - XPutPixel (unwind.ximage, j, i, - unwind.pixels[(unsigned char) - /* incorrect signed declaration - of RasterBits[] */ - (unwind.giffile->SavedImages-> - RasterBits[i * width + j])]); + { + if (interlace && row >= height) + row = InterlacedOffset[++pass]; + + for (j = 0; j < width; j++) + XPutPixel (unwind.ximage, j, row, + unwind.pixels[(unsigned char) + /* incorrect signed declaration + of RasterBits[] */ + (unwind.giffile->SavedImages[0]. + RasterBits[i * width + j])]); + + row += interlace ? InterlacedJumps[pass] : 1; + } } /* 4. Now create the pixmap and set up the image instance */ @@ -3433,6 +3492,7 @@ } +#if HAVE_SUBWINDOWS /************************************************************************/ /* subwindows */ /************************************************************************/ @@ -3708,7 +3768,7 @@ return subwindow; } - +#endif /************************************************************************/ /* initialization */ @@ -3717,6 +3777,7 @@ void syms_of_glyphs_x (void) { +#if HAVE_SUBWINDOWS defsymbol (&Qsubwindowp, "subwindowp"); DEFSUBR (Fmake_subwindow); @@ -3727,6 +3788,7 @@ DEFSUBR (Fsubwindow_xid); DEFSUBR (Fresize_subwindow); DEFSUBR (Fforce_subwindow_map); +#endif defkeyword (&Q_mask_file, ":mask-file"); defkeyword (&Q_mask_data, ":mask-data");
--- a/src/glyphs-x.h Mon Aug 13 09:20:50 2007 +0200 +++ b/src/glyphs-x.h Mon Aug 13 09:21:54 2007 +0200 @@ -72,6 +72,9 @@ #define XIMAGE_INSTANCE_X_NPIXELS(i) \ IMAGE_INSTANCE_X_NPIXELS (XIMAGE_INSTANCE (i)) +/* Set to 1 if you wish to implement this feature */ +# define HAVE_SUBWINDOWS 0 +# if HAVE_SUBWINDOWS /**************************************************************************** * Subwindow Object * ****************************************************************************/ @@ -95,6 +98,7 @@ int being_displayed; /* used to detect when needs to be unmapped */ }; +# endif #endif /* HAVE_X_WINDOWS */ #endif /* _XEMACS_GLYPHS_X_H_ */
--- a/src/inline.c Mon Aug 13 09:20:50 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,78 +0,0 @@ -/* Repository for inline functions - Copyright (C) 1995 Sun Microsystems, Inc. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -/* The purpose of this file is so that there is at least one actual - definition of each inline function. This is needed under GCC. The - reason is that under GCC we declare our inline functions `extern - inline', which causes the inlined version to get used only for - inlining, and in other cases to generate an external reference to - the function. This is more efficient that declaring out inline - functions `static inline', which (in many cases) would cause a separate - version of the function to get inserted into every source file that - included the corresponding header file. - - Some compilers that recognize `inline' may not do the same - `extern inline' business, so on those we just do `static inline'. - */ - -#define DONT_EXTERN_INLINE_FUNCTIONS - -#include <config.h> -#include "lisp.h" -#include "buffer.h" -#include "bytecode.h" -#include "console.h" -#include "device.h" -#include "events.h" -#include "elhash.h" -#include "extents.h" -#include "faces.h" -#include "frame.h" -#include "glyphs.h" -#include "keymap.h" -#include "lstream.h" -#include "objects.h" -#include "opaque.h" -#include "process.h" -#include "specifier.h" -#include "syntax.h" -#include "toolbar.h" -#include "window.h" - -#ifdef HAVE_DATABASE -#include "database.h" -#endif - -#ifdef HAVE_X_WINDOWS -#include "console-x.h" -#include "glyphs-x.h" -#include "gui-x.h" -#endif - -#ifdef MULE -#include "mule-coding.h" -#endif - -#ifdef TOOLTALK -#include <tt_c.h> -#include "tooltalk.h" -#endif
--- a/src/insdel.c Mon Aug 13 09:20:50 2007 +0200 +++ b/src/insdel.c Mon Aug 13 09:21:54 2007 +0200 @@ -2275,10 +2275,18 @@ int lockit) { /* This function can GC */ + /* dmoore - This function can also kill the buffer buf, the current + buffer, and do anything it pleases. So if you call it, be + careful. */ + Lisp_Object buffer; + struct gcpro gcpro1; + barf_if_buffer_read_only (buf, start, end); /* if this is the first modification, see about locking the buffer's file */ + XSETBUFFER (buffer, buf); + GCPRO1 (buffer); if (!NILP (buf->filename) && lockit && BUF_SAVE_MODIFF (buf) >= BUF_MODIFF (buf)) { @@ -2287,8 +2295,6 @@ /* Make binding buffer-file-name to nil effective. */ lock_file (buf->file_truename); #else - Lisp_Object buffer; - XSETBUFFER (buffer, buf); /* At least warn if this file has changed on disk since it was visited.*/ if (NILP (Fverify_visited_file_modtime (buffer)) && !NILP (Ffile_exists_p (buf->filename))) @@ -2296,6 +2302,11 @@ buf->filename); #endif /* not CLASH_DETECTION */ } + UNGCPRO; + + /* #### dmoore - is this reasonable in case of buf being killed above? */ + if (!BUFFER_LIVE_P (buf)) + return; signal_before_change (buf, start, end);
--- a/src/keymap.c Mon Aug 13 09:20:50 2007 +0200 +++ b/src/keymap.c Mon Aug 13 09:21:54 2007 +0200 @@ -2378,8 +2378,11 @@ if (!EQ (buffer, Vmouse_grabbed_buffer)) /* already pushed */ { + Lisp_Object map = XBUFFER (buffer)->keymap; + get_relevant_minor_maps (buffer, &closure); - relevant_map_push (XBUFFER (buffer)->keymap, &closure); + if (!NILP(map)) + relevant_map_push (map, &closure); } } } @@ -2618,6 +2621,8 @@ assert (EVENTP (event0)); nmaps = get_relevant_keymaps (event0, countof (maps), maps); + if (nmaps > countof (maps)) + nmaps = countof (maps); return (process_event_binding_result (lookup_events (event0, nmaps, maps, accept_default))); }
--- a/src/menubar-x.c Mon Aug 13 09:20:50 2007 +0200 +++ b/src/menubar-x.c Mon Aug 13 09:21:54 2007 +0200 @@ -358,7 +358,7 @@ assert (hack_wv->type == INCREMENTAL_TYPE); VOID_TO_LISP (submenu_desc, hack_wv->call_data); wv = menu_item_descriptor_to_widget_value (submenu_desc, SUBMENU_TYPE, - 1, 1); + 1, 0); if (!wv) { wv = xmalloc_widget_value ();
--- a/src/mule-canna.c Mon Aug 13 09:20:50 2007 +0200 +++ b/src/mule-canna.c Mon Aug 13 09:21:54 2007 +0200 @@ -28,8 +28,8 @@ /* - Authors: Akira Kon (we need a current email address) - Ichiro Hirakura (hirakura@uxp.bs2.mt.nec.co.jp) + Authors: Akira Kon (kon@uxd.fc.nec.co.jp) + Ichiro Hirakura (hirakura@uxd.fc.nec.co.jp) Functions defined in this file are
--- a/src/mule-coding.c Mon Aug 13 09:20:50 2007 +0200 +++ b/src/mule-coding.c Mon Aug 13 09:21:54 2007 +0200 @@ -74,6 +74,8 @@ Lisp_Object Vcoding_system_hashtable; +int enable_multibyte_characters; + /* Additional information used by the ISO2022 decoder and detector. */ struct iso2022_decoder { @@ -4724,6 +4726,15 @@ Coding system used to convert pathnames when accessing files. */ ); Vpathname_coding_system = Qnil; + + DEFVAR_BOOL ("enable-multibyte-characters", &enable_multibyte_characters /* +Non-nil means the buffer contents are regarded as multi-byte form +of characters, not a binary code. This affects the display, file I/O, +and behaviors of various editing commands. + +Setting this to nil does not do anything. +*/ ); + enable_multibyte_characters = 1; } void
--- a/src/process.c Mon Aug 13 09:20:50 2007 +0200 +++ b/src/process.c Mon Aug 13 09:21:54 2007 +0200 @@ -2203,6 +2203,11 @@ int i; struct Lisp_Process *p; + if (exited_processes_index <= 0) + { + return; + } + #ifdef EMACS_BLOCK_SIGNAL EMACS_BLOCK_SIGNAL (SIGCHLD); #endif @@ -2285,6 +2290,11 @@ static void record_exited_processes (int block_sigchld) { + if (!sigchld_happened) + { + return; + } + #ifdef EMACS_BLOCK_SIGNAL if (block_sigchld) EMACS_BLOCK_SIGNAL (SIGCHLD);
--- a/src/puresize.h Mon Aug 13 09:20:50 2007 +0200 +++ b/src/puresize.h Mon Aug 13 09:21:54 2007 +0200 @@ -31,11 +31,16 @@ /* Basic amount of purespace to use, in the absence of extra things configured in. */ + +/* This computation is Barbra Streisand, BS #if (LONGBITS == 64) # define BASE_PURESIZE 938000 #else # define BASE_PURESIZE 563000 -#endif +#endif +*/ + +#define BASE_PURESIZE 1400000 /* If any particular systems need to change the base puresize, they should define SYSTEM_PURESIZE_EXTRA. Note that this can be