# HG changeset patch # User cvs # Date 1186988856 -7200 # Node ID 6a378aca36af2e076d719709b9650b14ad2e6aca # Parent ebca3d831cea1c1f137d6c935e3cbddb4f5d0661 Import from CVS: tag r20-0b91 diff -r ebca3d831cea -r 6a378aca36af CHANGES-beta --- a/CHANGES-beta Mon Aug 13 09:06:45 2007 +0200 +++ b/CHANGES-beta Mon Aug 13 09:07:36 2007 +0200 @@ -1,4 +1,13 @@ -*- indented-text -*- +to 20.0 beta91 +-- func-menu.el-2.45 +-- ediff-2.64 +-- viper-2.92 +-- w3-3.0.50 +-- html 3.2 final dtd added. +-- Miscellaneous bug fixes +-- ps-print.el-3.05 Courtesy of Jacques Duthen Prestataire + to 20.0 beta90 -- ediff-2.64 -- viper-2.92 diff -r ebca3d831cea -r 6a378aca36af ChangeLog --- a/ChangeLog Mon Aug 13 09:06:45 2007 +0200 +++ b/ChangeLog Mon Aug 13 09:07:36 2007 +0200 @@ -1,4 +1,40 @@ +Wed Jan 22 21:07:17 1997 Steven L Baur + * XEmacs 20.0-b91 (prerelease 2) is released. + + * configure.in (--with-scrollbars): Add Athena3d as a toolkit + type. + + * lwlib/lwlib-Xaw.c (xaw_update_one_widget): Let Athena 3d have 0 + borderwidth. + (xaw_scrollbar_scroll): Use SCROLLBAR_LINE_UP and + SCROLLBAR_LINE_DOWN since that's current the only to get to the + bottom of the buffer. :-( + +Tue Jan 21 20:01:19 1997 Steven L. Baur + + * configure.in (beta): Add LWLIB_USES_ATHENA for odd + configurations that use both Motif and Athena. + + * etc/sgml/HTML32.dtd: html-3.2 final dtd added. + +Wed Jan 15 12:55:19 1997 Steven L Baur + + * info/dir (Gnus): Updated spelling and info. + +Mon Jan 13 13:37:27 1997 Steven L Baur + + * configure.in: Remove assignment of NON_GNU_CPP for irix-6.0. + +Mon Jan 13 00:36:01 1997 Martin Buchholz + + * lib-src/make-docfile.c (scan_lisp_file): eliminate doc-string + warnings for ccl-read-* + Sat Jan 11 12:05:31 1997 Steven L Baur + + * etc/sample.emacs: Remove code snippet that wipes out the cycle + buffer modeline feature. + * XEmacs 20.0 beta90 (prerelease 1) is released. * XEmacs 19.15 beta90 (prerelease 1) is released. diff -r ebca3d831cea -r 6a378aca36af configure --- a/configure Mon Aug 13 09:06:45 2007 +0200 +++ b/configure Mon Aug 13 09:07:36 2007 +0200 @@ -202,8 +202,9 @@ --with-menubars=TYPE Use TYPE menubars (lucid, motif, or no). The Lucid widgets emulate Motif (mostly) but are faster. *WARNING* The Motif menubar is currently broken. ---with-scrollbars=TYPE Use TYPE scrollbars (lucid, motif, athena, or no). ---with-dialogs=TYPE Use TYPE dialog boxes (motif, athena, or no). +--with-scrollbars=TYPE Use TYPE scrollbars (lucid, motif, athena, + athena3d, or no). +--with-dialogs=TYPE Use TYPE dialog boxes (motif, athena, athena3d, or no). (Lucid menubars and scrollbars are the default. Motif dialog boxes will be used if Motif can be found.) @@ -698,6 +699,7 @@ case "${val}" in l | lu | luc | luci | lucid ) val=lucid ;; m | mo | mot | moti | motif ) val=motif ;; + athena3d | athena-3d ) val=athena3d ;; a | at | ath | athe | athen | athena ) val=athena ;; n | no | non | none ) val=no ;; * ) @@ -1033,6 +1035,7 @@ cydra*-cydrome-sysv* ) machine=cydra5 opsys=usg5-3 ;; ## Data General AViiON Machines + i586-dg-dgux*R4* | i586-dg-dgux5.4.4* ) machine=aviion opsys=dgux5-4r4 ;; m88k-dg-dgux5.4R3* | m88k-dg-dgux5.4.3* ) machine=aviion opsys=dgux5-4r3 ;; m88k-dg-dgux5.4R2* | m88k-dg-dgux5.4.2* ) machine=aviion opsys=dgux5-4r2 ;; m88k-dg-dgux* ) machine=aviion opsys=dgux ;; @@ -1272,7 +1275,7 @@ ## Iris 4D mips-sgi-irix3.* ) machine=iris4d opsys=irix3-3 ;; mips-sgi-irix4.* ) machine=iris4d opsys=irix4-0 ;; - mips-sgi-irix6* ) machine=iris4d opsys=irix6-0 NON_GNU_CPP=/lib/cpp ;; + mips-sgi-irix6* ) machine=iris4d opsys=irix6-0 ;; mips-sgi-irix5.[3-9]* ) machine=iris4d opsys=irix5-3 ;; mips-sgi-irix5.2* ) machine=iris4d opsys=irix5-2 ;; mips-sgi-irix5.1* ) machine=iris4d opsys=irix5-1 ;; @@ -4084,6 +4087,12 @@ test "${with_menubars}" = "motif" -o \ "${with_scrollbars}" = "motif" -o \ "${with_dialogs}" = "motif" && with_motif="yes" +test "${with_menubars}" = "athena" -o \ + "${with_scrollbars}" = "athena" -o \ + "${with_dialogs}" = "athena" && with_athena="yes" +test "${with_menubars}" = "athena3d" -o \ + "${with_scrollbars}" = "athena3d" -o \ + "${with_dialogs}" = "athena3d" && with_athena="yes" test "${with_menubars}" = "" && with_menubars="lucid" test "${with_menubars}" = "athena" && with_menubars="lucid" test "${with_scrollbars}" = "" && with_scrollbars="lucid" @@ -4187,6 +4196,32 @@ " } +if test "${with_scrollbars}" = "athena3d"; then + +{ +test -n "$verbose" && \ +echo " defining LWLIB_SCROLLBARS_ATHENA" +echo "#define" LWLIB_SCROLLBARS_ATHENA "1" >> confdefs.h +DEFS="$DEFS -DLWLIB_SCROLLBARS_ATHENA=1" +ac_sed_defs="${ac_sed_defs}\${ac_dA}LWLIB_SCROLLBARS_ATHENA\${ac_dB}LWLIB_SCROLLBARS_ATHENA\${ac_dC}1\${ac_dD} +\${ac_uA}LWLIB_SCROLLBARS_ATHENA\${ac_uB}LWLIB_SCROLLBARS_ATHENA\${ac_uC}1\${ac_uD} +\${ac_eA}LWLIB_SCROLLBARS_ATHENA\${ac_eB}LWLIB_SCROLLBARS_ATHENA\${ac_eC}1\${ac_eD} +" +} + + +{ +test -n "$verbose" && \ +echo " defining LWLIB_SCROLLBARS_ATHENA3D" +echo "#define" LWLIB_SCROLLBARS_ATHENA3D "1" >> confdefs.h +DEFS="$DEFS -DLWLIB_SCROLLBARS_ATHENA3D=1" +ac_sed_defs="${ac_sed_defs}\${ac_dA}LWLIB_SCROLLBARS_ATHENA3D\${ac_dB}LWLIB_SCROLLBARS_ATHENA3D\${ac_dC}1\${ac_dD} +\${ac_uA}LWLIB_SCROLLBARS_ATHENA3D\${ac_uB}LWLIB_SCROLLBARS_ATHENA3D\${ac_uC}1\${ac_uD} +\${ac_eA}LWLIB_SCROLLBARS_ATHENA3D\${ac_eB}LWLIB_SCROLLBARS_ATHENA3D\${ac_eC}1\${ac_eD} +" +} + +fi test "${with_dialogs}" = "motif" && { test -n "$verbose" && \ @@ -4211,6 +4246,32 @@ " } +if test "${with_dialogs}" = "athena3d"; then + +{ +test -n "$verbose" && \ +echo " defining LWLIB_DIALOGS_ATHENA" +echo "#define" LWLIB_DIALOGS_ATHENA "1" >> confdefs.h +DEFS="$DEFS -DLWLIB_DIALOGS_ATHENA=1" +ac_sed_defs="${ac_sed_defs}\${ac_dA}LWLIB_DIALOGS_ATHENA\${ac_dB}LWLIB_DIALOGS_ATHENA\${ac_dC}1\${ac_dD} +\${ac_uA}LWLIB_DIALOGS_ATHENA\${ac_uB}LWLIB_DIALOGS_ATHENA\${ac_uC}1\${ac_uD} +\${ac_eA}LWLIB_DIALOGS_ATHENA\${ac_eB}LWLIB_DIALOGS_ATHENA\${ac_eC}1\${ac_eD} +" +} + + +{ +test -n "$verbose" && \ +echo " defining LWLIB_DIALOGS_ATHENA3D" +echo "#define" LWLIB_DIALOGS_ATHENA3D "1" >> confdefs.h +DEFS="$DEFS -DLWLIB_DIALOGS_ATHENA3D=1" +ac_sed_defs="${ac_sed_defs}\${ac_dA}LWLIB_DIALOGS_ATHENA3D\${ac_dB}LWLIB_DIALOGS_ATHENA3D\${ac_dC}1\${ac_dD} +\${ac_uA}LWLIB_DIALOGS_ATHENA3D\${ac_uB}LWLIB_DIALOGS_ATHENA3D\${ac_uC}1\${ac_uD} +\${ac_eA}LWLIB_DIALOGS_ATHENA3D\${ac_eB}LWLIB_DIALOGS_ATHENA3D\${ac_eC}1\${ac_eD} +" +} + +fi ############################################################################ # # @@ -6296,6 +6357,18 @@ " } +test "${with_athena}" = yes && +{ +test -n "$verbose" && \ +echo " defining LWLIB_USES_ATHENA" +echo "#define" LWLIB_USES_ATHENA "1" >> confdefs.h +DEFS="$DEFS -DLWLIB_USES_ATHENA=1" +ac_sed_defs="${ac_sed_defs}\${ac_dA}LWLIB_USES_ATHENA\${ac_dB}LWLIB_USES_ATHENA\${ac_dC}1\${ac_dD} +\${ac_uA}LWLIB_USES_ATHENA\${ac_uB}LWLIB_USES_ATHENA\${ac_uC}1\${ac_uD} +\${ac_eA}LWLIB_USES_ATHENA\${ac_eB}LWLIB_USES_ATHENA\${ac_eC}1\${ac_eD} +" +} + test "${with_toolbars}" = yes && { test -n "$verbose" && \ @@ -6830,8 +6903,10 @@ test "$with_scrollbars" = lucid && echo " Using the Lucid scrollbar." test "$with_scrollbars" = motif && echo " Using the Motif scrollbar." test "$with_scrollbars" = athena && echo " Using the Athena scrollbar." +test "$with_scrollbars" = athena3d && echo " Using the Athena-3d scrollbar." test "$with_dialogs" = motif && echo " Using the Motif dialog boxes." test "$with_dialogs" = athena && echo " Using the Athena dialog boxes." +test "$with_dialogs" = athena3d && echo " Using the Athena-3d dialog boxes." test "${use_union_type}" = yes && echo " Using the union type for Lisp_Objects." test "${debug}" = yes && echo " Compiling in extra code for debugging." diff -r ebca3d831cea -r 6a378aca36af configure.in --- a/configure.in Mon Aug 13 09:06:45 2007 +0200 +++ b/configure.in Mon Aug 13 09:07:36 2007 +0200 @@ -218,8 +218,9 @@ --with-menubars=TYPE Use TYPE menubars (lucid, motif, or no). The Lucid widgets emulate Motif (mostly) but are faster. *WARNING* The Motif menubar is currently broken. ---with-scrollbars=TYPE Use TYPE scrollbars (lucid, motif, athena, or no). ---with-dialogs=TYPE Use TYPE dialog boxes (motif, athena, or no). +--with-scrollbars=TYPE Use TYPE scrollbars (lucid, motif, athena, + athena3d, or no). +--with-dialogs=TYPE Use TYPE dialog boxes (motif, athena, athena3d, or no). (Lucid menubars and scrollbars are the default. Motif dialog boxes will be used if Motif can be found.) @@ -714,6 +715,7 @@ case "${val}" in l | lu | luc | luci | lucid ) val=lucid ;; m | mo | mot | moti | motif ) val=motif ;; + athena3d | athena-3d ) val=athena3d ;; a | at | ath | athe | athen | athena ) val=athena ;; n | no | non | none ) val=no ;; * ) @@ -1039,6 +1041,7 @@ cydra*-cydrome-sysv* ) machine=cydra5 opsys=usg5-3 ;; ## Data General AViiON Machines + i586-dg-dgux*R4* | i586-dg-dgux5.4.4* ) machine=aviion opsys=dgux5-4r4 ;; m88k-dg-dgux5.4R3* | m88k-dg-dgux5.4.3* ) machine=aviion opsys=dgux5-4r3 ;; m88k-dg-dgux5.4R2* | m88k-dg-dgux5.4.2* ) machine=aviion opsys=dgux5-4r2 ;; m88k-dg-dgux* ) machine=aviion opsys=dgux ;; @@ -1278,7 +1281,7 @@ ## Iris 4D mips-sgi-irix3.* ) machine=iris4d opsys=irix3-3 ;; mips-sgi-irix4.* ) machine=iris4d opsys=irix4-0 ;; - mips-sgi-irix6* ) machine=iris4d opsys=irix6-0 NON_GNU_CPP=/lib/cpp ;; + mips-sgi-irix6* ) machine=iris4d opsys=irix6-0 ;; mips-sgi-irix5.[3-9]* ) machine=iris4d opsys=irix5-3 ;; mips-sgi-irix5.2* ) machine=iris4d opsys=irix5-2 ;; mips-sgi-irix5.1* ) machine=iris4d opsys=irix5-1 ;; @@ -2537,6 +2540,12 @@ test "${with_menubars}" = "motif" -o \ "${with_scrollbars}" = "motif" -o \ "${with_dialogs}" = "motif" && with_motif="yes" +test "${with_menubars}" = "athena" -o \ + "${with_scrollbars}" = "athena" -o \ + "${with_dialogs}" = "athena" && with_athena="yes" +test "${with_menubars}" = "athena3d" -o \ + "${with_scrollbars}" = "athena3d" -o \ + "${with_dialogs}" = "athena3d" && with_athena="yes" test "${with_menubars}" = "" && with_menubars="lucid" test "${with_menubars}" = "athena" && with_menubars="lucid" test "${with_scrollbars}" = "" && with_scrollbars="lucid" @@ -2552,8 +2561,16 @@ test "${with_scrollbars}" = "lucid" && AC_DEFINE(LWLIB_SCROLLBARS_LUCID) test "${with_scrollbars}" = "motif" && AC_DEFINE(LWLIB_SCROLLBARS_MOTIF) test "${with_scrollbars}" = "athena" && AC_DEFINE(LWLIB_SCROLLBARS_ATHENA) +if test "${with_scrollbars}" = "athena3d"; then + AC_DEFINE(LWLIB_SCROLLBARS_ATHENA) + AC_DEFINE(LWLIB_SCROLLBARS_ATHENA3D) +fi test "${with_dialogs}" = "motif" && AC_DEFINE(LWLIB_DIALOGS_MOTIF) test "${with_dialogs}" = "athena" && AC_DEFINE(LWLIB_DIALOGS_ATHENA) +if test "${with_dialogs}" = "athena3d"; then + AC_DEFINE(LWLIB_DIALOGS_ATHENA) + AC_DEFINE(LWLIB_DIALOGS_ATHENA3D) +fi ############################################################################ # # @@ -2992,6 +3009,7 @@ IF_YES_AC_DEFINE(rel_alloc, REL_ALLOC) IF_YES_AC_DEFINE(LISP_FLOAT_TYPE, LISP_FLOAT_TYPE) IF_YES_AC_DEFINE(with_motif, LWLIB_USES_MOTIF) +IF_YES_AC_DEFINE(with_athena, LWLIB_USES_ATHENA) IF_YES_AC_DEFINE(with_toolbars, HAVE_TOOLBARS) IF_YES_AC_DEFINE(with_tty, HAVE_TTY) IF_YES_AC_DEFINE(with_tooltalk, TOOLTALK) @@ -3122,8 +3140,10 @@ test "$with_scrollbars" = lucid && echo " Using the Lucid scrollbar." test "$with_scrollbars" = motif && echo " Using the Motif scrollbar." test "$with_scrollbars" = athena && echo " Using the Athena scrollbar." +test "$with_scrollbars" = athena3d && echo " Using the Athena-3d scrollbar." test "$with_dialogs" = motif && echo " Using the Motif dialog boxes." test "$with_dialogs" = athena && echo " Using the Athena dialog boxes." +test "$with_dialogs" = athena3d && echo " Using the Athena-3d dialog boxes." test "${use_union_type}" = yes && echo " Using the union type for Lisp_Objects." test "${debug}" = yes && echo " Compiling in extra code for debugging." diff -r ebca3d831cea -r 6a378aca36af etc/sample.emacs --- a/etc/sample.emacs Mon Aug 13 09:06:45 2007 +0200 +++ b/etc/sample.emacs Mon Aug 13 09:07:36 2007 +0200 @@ -38,34 +38,34 @@ ;; and such. ;; Make F1 invoke help -(global-set-key 'f1 'help-command) +(global-set-key [f1] 'help-command) ;; Make F2 be `undo' -(global-set-key 'f2 'undo) +(global-set-key [f2] 'undo) ;; Make F3 be `find-file' ;; Note: it does not currently work to say ;; (global-set-key 'f3 "\C-x\C-f") ;; The reason is that macros can't do interactive things properly. ;; This is an extremely longstanding bug in Emacs. Eventually, ;; it will be fixed. (Hopefully ..) -(global-set-key 'f3 'find-file) +(global-set-key [f3] 'find-file) ;; Make F4 be "mark", F5 be "copy", F6 be "paste" ;; Note that you can set a key sequence either to a command or to another ;; key sequence. -(global-set-key 'f4 'set-mark-command) -(global-set-key 'f5 "\M-w") -(global-set-key 'f6 "\C-y") +(global-set-key [f4] 'set-mark-command) +(global-set-key [f5] "\M-w") +(global-set-key [f6]"\C-y") ;; Shift-F4 is "pop mark off of stack" (global-set-key '(shift f4) (lambda () (interactive) (set-mark-command t))) ;; Make F7 be `save-buffer' -(global-set-key 'f7 'save-buffer) +(global-set-key [f7] 'save-buffer) ;; Make F8 be "start macro", F9 be "end macro", F10 be "execute macro" -(global-set-key 'f8 'start-kbd-macro) -(global-set-key 'f9 'end-kbd-macro) -(global-set-key 'f10 'call-last-kbd-macro) +(global-set-key [f8] 'start-kbd-macro) +(global-set-key [f9] 'end-kbd-macro) +(global-set-key [f10] 'call-last-kbd-macro) ;; Here's an alternative binding if you don't use keyboard macros: ;; Make F8 be `save-buffer' followed by `delete-window'. @@ -98,21 +98,6 @@ ;; When running ispell, consider all 1-3 character words as correct. (setq ispell-extra-args '("-W" "3")) - ;; Change the way the buffer name is displayed in the - ;; modeline. The variable for this is called - ;; 'modeline-buffer-identification but was called - ;; 'mode-line-buffer-identification in older XEmacsen. - (if (boundp 'modeline-buffer-identification) - ;; Note that if you want to put more than one form in the - ;; `THEN' clause of an IF-THEN-ELSE construct, you have to - ;; surround the forms with `progn'. You don't have to - ;; do this for the `ELSE' clauses. - (progn - (setq-default modeline-buffer-identification '("XEmacs: %17b")) - (setq modeline-buffer-identification '("XEmacs: %17b"))) - (setq-default mode-line-buffer-identification '("XEmacs: %17b")) - (setq mode-line-buffer-identification '("XEmacs: %17b"))) - (cond ((or (not (fboundp 'device-type)) (equal (device-type) 'x)) ;; Code which applies only when running emacs under X goes here. diff -r ebca3d831cea -r 6a378aca36af etc/sgml/HTML32.dtd --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/sgml/HTML32.dtd Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,598 @@ + + + + + ... + + -- + > + + + + + + + + + + + + + + + + + + + + + + +]]> + + + + + + +%ISOlat1; + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +]]> + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +]]> + + + + + + diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-A-up.xbm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-A-up.xbm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,6 @@ +#define ediff-A-up_width 15 +#define ediff-A-up_height 15 +static char ediff-A-up_bits[] = { + 0x00,0x80,0x00,0x80,0x00,0x80,0xc0,0x81,0xe0,0x83,0x60,0x83,0x70,0x87,0x30, + 0x86,0x38,0x8e,0xf8,0x8f,0x18,0x8c,0x18,0x8c,0x00,0x80,0x00,0x80,0x00,0x80 + }; diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-A-up.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-A-up.xpm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,24 @@ +/* XPM */ +static char *ediff_A[] = { +/* width height num_colors chars_per_pixel */ +" 15 15 2 1", +/* colors */ +". c blue", +"# c Gray75 s backgroundToolBarColor", +/* pixels */ +"###############", +"###############", +"###############", +"######...######", +"#####.....#####", +"#####..#..#####", +"####...#...####", +"####..###..####", +"###...###...###", +"###.........###", +"###..#####..###", +"###..#####..###", +"###############", +"###############", +"###############", +}; \ No newline at end of file diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-A-xx.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-A-xx.xpm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,24 @@ +/* XPM */ +static char *ediff_A[] = { +/* width height num_colors chars_per_pixel */ +" 15 15 2 1", +/* colors */ +". c gray60", +"# c Gray75 s backgroundToolBarColor", +/* pixels */ +"###############", +"###############", +"###############", +"######...######", +"#####.....#####", +"#####..#..#####", +"####...#...####", +"####..###..####", +"###...###...###", +"###.........###", +"###..#####..###", +"###..#####..###", +"###############", +"###############", +"###############", +}; \ No newline at end of file diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-B-up.xbm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-B-up.xbm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,6 @@ +#define ediff-B-up_width 15 +#define ediff-B-up_height 15 +static char ediff-B-up_bits[] = { + 0x00,0x80,0x00,0x80,0xf8,0x81,0xf8,0x83,0x38,0x87,0x38,0x86,0xf8,0x83,0xf8, + 0x87,0x38,0x8e,0x38,0x8c,0x38,0x8e,0xf8,0x87,0xf8,0x83,0x00,0x80,0x00,0x80 + }; diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-B-up.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-B-up.xpm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,25 @@ +/* XPM */ +static char *ediff-B-up[] = { +/* width height num_colors chars_per_pixel */ +" 15 15 2 1", +/* colors */ +". c blue", +"# c Gray75 s backgroundToolBarColor", +/* pixels */ +"###############", +"###############", +"###......######", +"###.......#####", +"###...##...####", +"###...###..####", +"###.......#####", +"###........####", +"###...###...###", +"###...####..###", +"###...###...###", +"###........####", +"###.......#####", +"###############", +"###############", +"###############" +}; \ No newline at end of file diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-B-xx.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-B-xx.xpm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,25 @@ +/* XPM */ +static char *ediff-B-up[] = { +/* width height num_colors chars_per_pixel */ +" 15 15 2 1", +/* colors */ +". c gray60", +"# c Gray75 s backgroundToolBarColor", +/* pixels */ +"###############", +"###############", +"###......######", +"###.......#####", +"###...##...####", +"###...###..####", +"###.......#####", +"###........####", +"###...###...###", +"###...####..###", +"###...###...###", +"###........####", +"###.......#####", +"###############", +"###############", +"###############" +}; \ No newline at end of file diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-help.xbm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-help.xbm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,6 @@ +#define ediff-help_width 15 +#define ediff-help_height 15 +static char ediff-help_bits[] = { + 0x00,0x80,0xf0,0x83,0x0c,0x86,0xe4,0x8c,0x74,0x8d,0xb4,0x8c,0x58,0x86,0x20, + 0x83,0xa0,0x83,0xa0,0x81,0xc0,0x80,0x20,0x83,0x20,0x83,0xc0,0x81,0x00,0x80 + }; diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-help.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-help.xpm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,26 @@ +/* XPM */ +static char *help[] = { +/* width height num_colors chars_per_pixel */ +" 15 15 3 1", +/* colors */ +". c #000000", +"b c Gray75 s backgroundToolBarColor", +"c c #ffff00", +/* pixels */ +"bbbbbbbbbbbbbbb", +"bbbb......bbbbb", +"bbb.ccccc..bbbb", +"bb.cc...cc..bbb", +"bb.c..bb.c..bbb", +"bb.c..b.cc..bbb", +"bbb..b.cc..bbbb", +"bbbbb.cc..bbbbb", +"bbbbb.c..bbbbbb", +"bbbbb.c..bbbbbb", +"bbbbbb..bbbbbbb", +"bbbbb.cc..bbbbb", +"bbbbb.cc..bbbbb", +"bbbbbb...bbbbbb", +"bbbbbbbbbbbbbbb" +"bbbbbbbbbbbbbbb" +}; diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-next.xbm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-next.xbm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,6 @@ +#define ediff-next_width 15 +#define ediff-next_height 15 +static char ediff-next_bits[] = { + 0x00,0x80,0x80,0x80,0x80,0x83,0x80,0x82,0xfe,0x8c,0x02,0x8a,0xfa,0xb7,0xfa, + 0xbf,0xfa,0x9f,0xfe,0x8f,0xfe,0x87,0x80,0x83,0x80,0x81,0x80,0x80,0x00,0x80 + }; diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-next.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-next.xpm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,25 @@ +/* XPM */ +static char * file[] = { +/* width height num_colors chars_per_pixel */ +"15 15 5 1", +" c Gray75 s backgroundToolBarColor", +". c black", +"X c white", +"o c black", +"O c black", +" ", +" . ", +" .. ", +" .X. ", +" .......XX. ", +" .XXXXXXXoX. ", +" .XooooooooX. ", +" .Xoooooooooo. ", +" .XooooooooO. ", +" .oOOOOOOoO. ", +" .......OO. ", +" .O. ", +" .. ", +" . ", +" ", +}; diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-prev.xbm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-prev.xbm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,6 @@ +#define ediff-prev_width 15 +#define ediff-prev_height 15 +static char ediff-prev_bits[] = { + 0x00,0x80,0x00,0x81,0x80,0x81,0x40,0x81,0x20,0xbf,0x50,0xa0,0xe8,0xaf,0xfc, + 0xaf,0xf8,0xaf,0xf0,0xbf,0xe0,0xbf,0xc0,0x81,0x80,0x81,0x00,0x81,0x00,0x80 + }; diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-prev.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-prev.xpm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,23 @@ +/* XPM */ +static char * left-arrow_xpm[] = { +/* width height num_colors chars_per_pixel */ +"15 15 3 1", +" c Gray75 s backgroundToolBarColor", +". c black", +"X c white", +" ", +" . ", +" .. ", +" .X. ", +" .XX...... ", +" .X.XXXXXX. ", +" .X.......X. ", +" ..........X. ", +" .........X. ", +" .......... ", +" ......... ", +" ... ", +" .. ", +" . ", +" ", +}; diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-quit.xbm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-quit.xbm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,6 @@ +#define ediff-quit_width 15 +#define ediff-quit_height 15 +static char ediff-quit_bits[] = { + 0x00,0x80,0x06,0xb0,0x1e,0x98,0x3c,0x8c,0x70,0x82,0xe0,0x83,0xc0,0x81,0xe0, + 0x83,0x70,0x86,0x38,0x8c,0x1c,0x88,0x1c,0x90,0x08,0x80,0x00,0x80,0x00,0x80 + }; diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-quit.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-quit.xpm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,26 @@ +/* XPM */ +static char *delete[] = { +/* width height num_colors chars_per_pixel */ +" 15 15 4 1", +/* colors */ +". c #808080", +"# c #800000", +"a c #ffffff", +"b c #c0c0c0", +/* pixels */ +"bbbbbbbbbbbbbbb", +"b##abbbbbbbb##a", +"b####abbbbb##ab", +"bb####abbb##abb", +"bbbb###ab#abbbb", +"bbbbb#####abbbb", +"bbbbbb###abbbbb", +"bbbbb#####abbbb", +"bbbb###ab##abbb", +"bbb###abbb##abb", +"bb###abbbbb#abb", +"bb###abbbbbb#ab", +"bbb#abbbbbbbbbb", +"bbb#abbbbbbbbbb", +"bbbbbbbbbbbbbbb", +}; diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-refine.xbm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-refine.xbm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,6 @@ +#define ediff-refine_width 15 +#define ediff-refine_height 15 +static char ediff-refine_bits[] = { + 0x00,0x80,0x80,0x80,0x84,0x90,0x8c,0x98,0x98,0x8c,0xf0,0x87,0xe0,0x83,0xe0, + 0x83,0xe0,0x83,0xf0,0x87,0x98,0x8c,0x8c,0x98,0x84,0x90,0x80,0x80,0x00,0x80 + }; diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-refine.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-refine.xpm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,24 @@ +/* XPM */ +static char *help[] = { +/* width height num_colors chars_per_pixel */ +" 15 15 2 1", +/* colors */ +"# c #000000", +"a c Gray75 s backgroundToolBarColor", +/* pixels */ +"aaaaaaaaaaaaaaa", +"aaaaaaa#aaaaaaa", +"aa#aaaa#aaaa#aa", +"aa##aaa#aaa##aa", +"aaa##aa#aa##aaa", +"aaaa#######aaaa", +"aaaaa#####aaaaa", +"aaaaa#####aaaaa", +"aaaaa#####aaaaa", +"aaaa#######aaaa", +"aaa##aa#aa##aaa", +"aa##aaa#aaa##aa", +"aa#aaaa#aaaa#aa", +"aaaaaaa#aaaaaaa", +"aaaaaaaaaaaaaaa", +}; \ No newline at end of file diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-save-xx.xbm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-save-xx.xbm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,6 @@ +#define disk-xx_width 15 +#define disk-xx_height 15 +static char disk-xx_bits[] = { + 0x00,0x00,0x0a,0x28,0x00,0x00,0x0a,0x28,0x00,0x00,0x0a,0x28,0x00,0x00,0xfa, + 0x2f,0x00,0x00,0x02,0x20,0x00,0x00,0x0a,0x29,0x00,0x00,0xf8,0x3f,0x00,0x00 + }; diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-save-xx.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-save-xx.xpm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,25 @@ +/* XPM */ +static char * disk[] = { +"15 15 5 1", +"X c Gray75 s backgroundToolBarColor", +"o c Gray60", +"O c Gray60", +"+ c Gray90", +"@ c Gray40", +"XXXXXXXXXXXXXXX", +"XXXXXXXXXXXXXXX", +"XoooooooooooooX", +"XoOo+++++++oOoX", +"XoOo+++++++oOoX", +"XoOo+++++++oOoX", +"XoOo+++++++oOoX", +"XoOoooooooooOoX", +"XoOOOOOOOOOOOoX", +"XoOoooooooooOoX", +"XoOo@@@@o++oOoX", +"XoOo@@@@o++oOoX", +"XoOo@@@@o++oOoX", +"XXooooooooooooX", +"XXXXXXXXXXXXXXX", +"XXXXXXXXXXXXXXX" +}; diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-save.xbm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-save.xbm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,6 @@ +#define disk-up_width 15 +#define disk-up_height 15 +static char disk-up_bits[] = { + 0x00,0x00,0xfe,0x3f,0x0a,0x28,0x0a,0x28,0x0a,0x38,0x0a,0x28,0x0a,0x28,0xfa, + 0x2f,0x02,0x20,0xfa,0x2f,0x0a,0x29,0x0a,0x29,0x0c,0x29,0xf8,0x3f,0x00,0x00 + }; diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-save.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-save.xpm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,25 @@ +/* XPM */ +static char * disk[] = { +"15 15 5 1", +"X c Gray75 s backgroundToolBarColor", +"o c black", +"O c Gray60", +"+ c Gray90", +"@ c Gray40", +"XXXXXXXXXXXXXXX", +"XXXXXXXXXXXXXXX", +"XoooooooooooooX", +"XoOo+++++++oOoX", +"XoOo+++++++oOoX", +"XoOo+++++++oOoX", +"XoOo+++++++oOoX", +"XoOoooooooooOoX", +"XoOOOOOOOOOOOoX", +"XoOoooooooooOoX", +"XoOo@@@@o++oOoX", +"XoOo@@@@o++oOoX", +"XoOo@@@@o++oOoX", +"XXooooooooooooX", +"XXXXXXXXXXXXXXX", +"XXXXXXXXXXXXXXX" +}; diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-toggle-split-up.xbm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-toggle-split-up.xbm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,6 @@ +#define ediff-toggle-split-up_width 15 +#define ediff-toggle-split-up_height 15 +static char ediff-toggle-split-up_bits[] = { + 0x00,0x80,0xfe,0x87,0xfe,0x87,0x00,0x80,0x00,0xb0,0x7e,0xb0,0x1e,0xb0,0x1e, + 0xb0,0x3e,0xb2,0x72,0xb3,0xe2,0xb3,0xc0,0xb3,0xc0,0xb3,0xf0,0xb7,0x00,0x80 + }; diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-toggle-split-up.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-toggle-split-up.xpm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,25 @@ +/* XPM */ +static char *ediff-toggle-split-up[] = { +/* width height num_colors chars_per_pixel */ +" 15 15 3 1", +/* colors */ +"# c #000000", +"a c firebrick", +"f c Gray75 s backgroundToolBarColor", +/* pixels */ +"fffffffffffffff", +"faaaaaaaaaaffff", +"faaaaaaaaaaffff", +"fffffffffffffff", +"ffffffffffffaaf", +"f######fffffaaf", +"f####fffffffaaf", +"f####fffffffaaf", +"f#####fff#ffaaf", +"f#ff###ff#ffaaf", +"f#fff#####ffaaf", +"ffffff####ffaaf", +"ffffff####ffaaf", +"ffff######ffaaf", +"fffffffffffffff", +}; diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-update.xbm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-update.xbm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,6 @@ +#define ediff-update_width 15 +#define ediff-update_height 15 +static char ediff-update_bits[] = { + 0x00,0x80,0x78,0x80,0xcc,0x99,0x04,0x9b,0x04,0x9c,0x04,0x9e,0x0c,0x9f,0x00, + 0x80,0x7c,0x98,0x3c,0x90,0x1c,0x90,0x6c,0x90,0xcc,0x99,0x00,0x8f,0x00,0x80 + }; diff -r ebca3d831cea -r 6a378aca36af etc/toolbar/ediff-update.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/toolbar/ediff-update.xpm Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,25 @@ +/* XPM */ +static char *update[] = { +/* width height num_colors chars_per_pixel */ +" 15 15 3 1", +/* colors */ +". c #000000", +"a c #000080", +"c c Gray75 s backgroundToolBarColor", +/* pixels */ +"ccccccccccccccc", +"ccc.aaacccccccc", +"cc.acccaacccacc", +"ccaccccccacaacc", +"ccacccccccaaacc", +"ccaccccccaaaacc", +"cc.accccaaaaacc", +"ccccccccccccccc", +"ccaaaaacccca.cc", +"ccaaaaccccccacc", +"ccaaacccccccacc", +"ccaacaccccccacc", +"ccacccaaccca.cc", +"ccccccccaaa.ccc", +"ccccccccccccccc", +}; \ No newline at end of file diff -r ebca3d831cea -r 6a378aca36af etc/w3/stylesheet --- a/etc/w3/stylesheet Mon Aug 13 09:06:45 2007 +0200 +++ b/etc/w3/stylesheet Mon Aug 13 09:07:36 2007 +0200 @@ -1,11 +1,27 @@ -/* File: default.css +/****************************************************************************** +** File: default.css ** Purpose: Default Stylesheet for Emacs-W3 ** Info: Copyright (c) 1995 William M. Perry ** Created: William M. Perry , Aug-31-1995 ** Maintainer: William M. Perry ** ** This contains the top level fallback default styles for Emacs-w3 -*/ +** +****************************************************************************** +** +** To specify device-dependent styles, you must mark a section with +** :devicetype: +** If you are not using 'devicetype', then anything up to the next +** :xxx: media descriptor is ignored. +** +** There are a few special Emacs-W3 sections +** +** emacs - only include this chunk if you are using Emacs 19 +** speech - only include this chunk if you are using Emacspeak for audio +** xemacs - only include this chunk if you are using XEmacs +** normal - always include this chunk (useful for switching out of another +** device-type block +******************************************************************************/ /* ** Headers @@ -14,7 +30,7 @@ h1,h2,h3, h4,h5,h6 { display: block; - font-family : utopia charter times itc-zapf-chancery inja; + font-family : serif; font-weight : bold; } @@ -23,57 +39,74 @@ ** we only use them under XEmacs. Hopefully, this will change soon. */ -:xemacs: - h1 { font-size : 24pt } - h2 { font-size : 18pt } - h3 { font-size : 16pt } - h4 { font-size : 14pt } - h5 { font-size : 12pt } - h6 { font-size : 10pt } +@media xemacs { + h1 { font-size : +12pt } + h2 { font-size : +6pt } + h3 { font-size : +4pt } + h5 { font-size : -2pt } + h6 { font-size : -4pt } +/* +** Emacs-19 also doesn't handle how Emacs-W3 changes this type of font +** very well, so lets only do it under XEmacs for now. Emacs-19 can only +** do monospaced fonts anyway, so its redundant. +*/ + pre,xmp, + plaintext { font-family: monospace } +key,code,tt { font-family: monospace } +} // @media xemacs /* ** Best we can do under Emacs-19 is use the default font and try to make ** the headers stand out somehow. */ -:emacs: +@media emacs { h1,h2,h3, -h4,h5,h6 { font-style: small-caps; text-decoration: underline } +h4,h5,h6 { + font-style: small-caps; + text-decoration: underline; + color: blue; + } -:normal: +strong,em { color: red } + dfn { font-style: italic } + s,strike { color: green } + +} // @media emacs + p { display: block } + pre,xmp { display: block; white-space: pre; } +blockquote{ display: block; margin-left: 5; margin-right: 5; } /* ** List formatting instructions */ - dl,ul,ol { - display: block; - margin-left: 5em - } + ul { display: block; } + ol { display: block; } + dl { display: block; } + dir { display: block; } + menu { display: block; } + dt { font-weight: bold; display: list-item } + dd { display: list-item; margin-left: 5; } + li { display: list-item; margin-left: 5; } + ul li { list-style: circle; } + ol li { list-style: decimal; } - li { display: list-item } - dt { font-weight: bold; display: block } - dd { insert-before: 3em; display: list-item } - -/* -** All items that require fixed-width fonts -*/ - - pre,xmp, - plaintext { font-family: monospace; display: block } -key,code,tt { font-family: monospace } +/* These are to make nested list items look better */ +ul ul,ol ul,ol ol,ul ol { display: line; } /* ** All logical emphasis tags, the way god intended */ - strong,em { font-weight: bold } - dfn { font-style: italic } + div { display: line; } + strong,em { font-weight: bold } + dfn { font-style: italic } s,strike { text-decoration: line-through } - sub { text-position: sub } - sup { text-position: sup } - secret { text-transform: rot13 } + sub { text-position: sub } + sup { text-position: sup } + secret { text-transform: rot13 } /* ** Physical emphasis - spawn of evil @@ -82,13 +115,12 @@ i { font-style: italic } u { text-decoration: underline } blink { text-decoration: blink } - + center { display: line; text-align: center; } /* ** Various and sundry */ - br { display: list-item } - hr { display: list-item } - hr[SRC] { replace: {SRC} } + br { display: line } + hr { display: line; text-align: center; } /* @@ -96,34 +128,39 @@ */ a { cursor: hand2 } -a.link { color: #FF0000 } -a.visited { color: #B22222 } -a.active { color: #FF0000 } +a:link { color: #FF0000 } +a:visited { color: #B22222 } +a:active { color: #FF0000 } + +/* +** Table formatting +*/ +table { display: block; } + th { display: block; font-weight: bold; text-align: center; } + td { display: block; text-align: left; } +caption { display: block; text-align: center; } /* ** Various other character-level formatting issues */ - address { align : right } -abstract { font-style : bold & italic ; align : indent } - quote { font-style : italic ; align : indent } + address { text-align: right; display: line; } +abstract { font-style: bold & italic ; text-align : indent } + quote { font-style: italic ; text-align : indent } /* ** Now for monochrome defaults -** Anything up to the next :xxx: media descriptor is only used if -** you are on that type of media. */ -:mono: - a.link { color: black; text-decoration: underline } -a.visited { color: black; text-decoration: underline } - a.active { color: white } - +@media mono { + a:link { color: black; text-decoration: underline } +a:visited { color: black; text-decoration: underline } + a:active { color: white } +} // @media mono /* ** All the TTY specific formatting */ -:tty: - +@media tty { /* ** First, handle some stuff for generic TTYs to emulate our old ** behaviour with w3-delimit-links and a subset of w3-delimit-emphasis @@ -135,20 +172,19 @@ insert-after: * } -a.visited{ - insert.before: "{{"; - insert.after: "}}" +a:visited{ + insert-before: "{{"; + insert-after: "}}" } -a.link { - insert.before: "[["; - insert.after: "]]" +a:link { + insert-before: "[["; + insert-after: "]]" } +} // @media tty -/* End Generic TTY */ -:ansi-tty: - +@media ansi-tty { /* ** Now comes the cool TTY stuff. You will need to be using XEmacs 19.14 ** or later (or Emacs 19.30 under DOS) in order to get any benefit from @@ -172,6 +208,38 @@ h1,h2,h3, h4,h5,h6 { color : cyan } -a.visited { color : magenta } - a.link { color : red } - a.active { color : yellow } +a:visited { color : magenta } + a:link { color : red } + a:active { color : yellow } +} // @media ansi-tty + +@media speech { +h1,h2,h3, +h4,h5,h6 { voice-family: paul; stress: 2; richness: 9; } + h1 { pitch: 1; pitch-range: 9; } + h2 { pitch: 2; pitch-range: 8; } + h3 { pitch: 3; pitch-range: 7; } + h4 { pitch: 4; pitch-range: 6; } + h5 { pitch: 5; pitch-range: 5; } + h6 { pitch: 6; pitch-range: 4; } + +li,dt,dd { pitch: 6; richness: 6; } + dt { stress: 8; } + +pre,xmp,plaintext,key,code,tt { pitch: 1; + pitch-range: 1; + stress: 1; + richness: 8; + } + em { pitch: 6; pitch-range: 6; stress: 6; richness: 5; } + strong { pitch: 6; pitch-range: 6; stress: 9; richness: 9; } + dfn { pitch: 7; pitch-range: 6; stress: 6; } +s,strike { richness: 0; } + i { pitch: 6; pitch-range: 6; stress: 6; richness: 5 } + b { pitch: 6; pitch-range: 6; stress: 9; richness: 9; } + u { richness: 0; } + a:link { voice-family: harry; } +a:visited { voice-family: betty;} + a:active { voice-family: betty; pitch-range: 8; pitch: 8 } + +} // @media speech diff -r ebca3d831cea -r 6a378aca36af info/dir --- a/info/dir Mon Aug 13 09:06:45 2007 +0200 +++ b/info/dir Mon Aug 13 09:07:36 2007 +0200 @@ -54,7 +54,7 @@ * External-Widget:: Use XEmacs as a text widget inside of another program. * Forms:: A package for editing databases by filling in forms. -* GNUS:: An NNTP-based newsreader for XEmacs. +* Gnus:: A netnews and mail reader for XEmacs. * Hyperbole:: A programmable information management and hypertext system. * ILISP:: Multi-dialect inferior LISP interface. * Ispell:: Interactive spelling corrector. diff -r ebca3d831cea -r 6a378aca36af lib-src/make-docfile.c --- a/lib-src/make-docfile.c Mon Aug 13 09:06:45 2007 +0200 +++ b/lib-src/make-docfile.c Mon Aug 13 09:07:36 2007 +0200 @@ -827,8 +827,17 @@ /* Skip until the first newline; remember the two previous chars. */ while (c != '\n' && c >= 0) { + /* ### Kludge -- Ignore any ESC x x ISO2022 sequences */ + if (c == 27) + { + getc (infile); + getc (infile); + goto nextchar; + } + c2 = c1; c1 = c; + nextchar: c = getc (infile); } @@ -960,7 +969,7 @@ } } -#ifdef DEBUG +#if 0 /* causes crash */ else if (! strcmp (buffer, "if") || ! strcmp (buffer, "byte-code")) ; diff -r ebca3d831cea -r 6a378aca36af lib-src/tm-au --- a/lib-src/tm-au Mon Aug 13 09:06:45 2007 +0200 +++ b/lib-src/tm-au Mon Aug 13 09:07:36 2007 +0200 @@ -1,6 +1,6 @@ #!/bin/sh - # -# $Id: tm-au,v 1.3 1997/01/11 20:13:51 steve Exp $ +# $Id: tm-au,v 1.4 1997/01/23 05:29:22 steve Exp $ # PATH=${PATH:-/usr/bin:/bin}:`dirname $0 2>/dev/null`; export PATH @@ -22,14 +22,15 @@ echo "$2; $3 ->" tmdecode $3 $1 $filename if [ "$AUDIOSERVER" = "" ]; then - if [ `uname` = "IRIX" ]; then - sfplay $filename - else - cat $filename > /dev/audio - fi + case "`uname`" in + IRIX ) sfplay $filename ;; + OSF1 ) decsound -play $filename ;; + * ) cat $filename > /dev/audio ;; + esac else - autool -v 40 $filename + autool -v 40 $filename fi + trap 'rm -f $filename' 0 1 2 3 13 15 ;; "extract") diff -r ebca3d831cea -r 6a378aca36af lisp/ChangeLog --- a/lisp/ChangeLog Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/ChangeLog Mon Aug 13 09:07:36 2007 +0200 @@ -1,3 +1,91 @@ +Thu Jan 9 13:32:01 1997 Jacques Duthen Prestataire + + * ps-print.el: Merge patch from [simon] Oct 8, 1996 Simon Marshall + + (ps-print-version): Fix value. + (cl lisp-float-type): Require them. + (ps-number-of-columns ps-*-font-size): Try to select defaults + better suited when `ps-landscape-mode' is non-nil. + (ps-*-faces): Change default for Font Lock mode faces when + `ps-print-color-p' is nil. + (ps-right-header): Replace `time-stamp-yy/mm/dd' + by `time-stamp-mon-dd-yyyy'. + (ps-end-file ps-begin-page): Fix bug in page count for Ghostview. + (ps-generate-postscript-with-faces): Replace `ps-sorter' by + `car-less-than-car'. + (ps-plot ps-generate): Replace `%d' by `%3d'. + +Wed Jan 22 15:32:39 1997 Greg Klanderman + + * modes/rsz-minibuf.el (resize-minibuffer-setup): Resize the + minibuffer earlier than the first received event. + +Wed Jan 22 15:29:08 1997 Barry A. Warsaw + + * modes/imenu.el (imenu-add-to-menubar): Don't attempt anything if + menu-bar lookup fails. + +Wed Jan 22 01:03:42 1997 Martin Buchholz + + * lisp/x11/x-font-menu.el: Make font menus work better in a + Japanese environment. + +Tue Jan 21 19:56:26 1997 Martin Buchholz + + * lisp/mule/mule-init.el (init-mule): Get Japanese man pages working. + +Fri Jan 17 17:22:54 1997 Hrvoje Niksic + + * man.el (Manual-mode): Don't mess with scrollbars if they aren't + present. + +Tue Jan 21 19:52:45 1997 Steven L Baur + + * utils/timezone.el (timezone-parse-date): Fix Y2K bug. + +Tue Jan 21 19:32:44 1997 Barry A. Warsaw + + * prim/files.el (hack-local-variables-prop-line): XEmacs should + not query to set local variables in the -*- line if there aren't + any to set! + +Thu Jan 16 18:24:20 1997 Steven L Baur + + * psgml/psgml.el: Use newer interface form for nsgmls. + +Thu Jan 16 04:06:24 1997 Steven L Baur + + * comint/telnet.el (rsh): (Mostly) correct dealing with detection + of password prompt at login. + +Thu Jan 16 03:28:25 1997 Martin Buchholz + + * modes/view.el (View-scroll-lines-forward): Correct format typo. + +Mon Jan 13 22:50:23 1997 David Moore + + * packages/compile.el: Clean up regexps. + +Sun Jan 12 20:50:08 1997 Steven L Baur + + * modes/m4-mode.el: Changed m4-program to point to /usr/bin/m4. + +Sun Jan 12 18:49:30 1997 $B + + * mule/mule-misc.el: `-columns' -> `-width' and define `-columns' + alias + Import definition of `truncate-string-to-width' from Emacs/mule-delta. + +Sun Jan 12 13:57:11 1997 Kyle Jones + + * prim/window.el (shrink-window-if-larger-than-buffer): Don't let + readjusted window change the buffer order stack. + +Sat Jan 11 20:12:47 1997 Vinnie Shelton + + * utils/finder.el (finder-insert-at-column): Correct off-by-one + error affecting long file names. + Fri Jan 10 22:27:58 1997 Shane Holder * utils/bench.el: New version. @@ -532,7 +620,7 @@ * utils/smtpmail.el: New file from Emacs 19.34. -Fri Dec 6 09:28:04 1996 MORIOKA Tomohiko +Fri Dec 6 09:28:04 1996 $B * prim/startup.el (set-default-load-path): Set default-load-path dynamically since file-detect.el is dumped with XEmacs. diff -r ebca3d831cea -r 6a378aca36af lisp/comint/telnet.el --- a/lisp/comint/telnet.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/comint/telnet.el Mon Aug 13 09:07:36 2007 +0200 @@ -68,7 +68,7 @@ (defvar telnet-count 0 "Number of output strings read from the telnet process while looking for the initial password.") -(make-variable-buffer-local 'telnet-count) +;; (make-variable-buffer-local 'telnet-count) (defvar telnet-program "telnet" "Program to run to open a telnet connection.") @@ -254,7 +254,6 @@ (if port (concat " " port) "") "\n")) (setq comint-input-sender 'telnet-simple-send) - (setq telnet-count telnet-initial-count) ;; run last so that hooks can change things. (telnet-mode)))) @@ -273,6 +272,7 @@ mode-name "Telnet" comint-prompt-regexp telnet-prompt-pattern) (use-local-map telnet-mode-map) + (set (make-local-variable 'telnet-count) telnet-initial-count) (run-hooks 'telnet-mode-hook)) ;;;###autoload (add-hook 'same-window-regexps "\\*rsh-[^-]*\\*\\(\\|<[0-9]*>\\)") @@ -303,8 +303,10 @@ ;; antisocial than echoing a password, and more likely than connecting ;; to a non-Unix rsh host these days... ;; - ;; (set-process-filter (get-process name) 'telnet-initial-filter) - (set-process-filter (get-process name) 'telnet-filter) + ;; I disagree with the above. -sb + ;; + (set-process-filter (get-process name) 'telnet-initial-filter) + ;; (set-process-filter (get-process name) 'telnet-filter) ;; run last so that hooks can change things. (telnet-mode))) diff -r ebca3d831cea -r 6a378aca36af lisp/dired/dired.el --- a/lisp/dired/dired.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/dired/dired.el Mon Aug 13 09:07:36 2007 +0200 @@ -852,7 +852,9 @@ case-fold-search nil buffer-read-only t selective-display t ; for subdirectory hiding - modeline-buffer-identification '("Dired: %17b")) + modeline-buffer-identification + (list (cons modeline-buffer-id-left-extent "Dired: ") + (cons modeline-buffer-id-right-extent "%17b"))) (set (make-local-variable 'revert-buffer-function) (function dired-revert)) (set (make-local-variable 'page-delimiter) diff -r ebca3d831cea -r 6a378aca36af lisp/ediff/Makefile --- a/lisp/ediff/Makefile Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/ediff/Makefile Mon Aug 13 09:07:36 2007 +0200 @@ -27,12 +27,10 @@ # --------- ONLY AUTHORIZED PERSONNEL BEYOND THIS POINT!!! ------------ EDIFF = ediff-init.el ediff-help.el ediff-diff.el ediff-merg.el \ ediff-wind.el ediff-util.el ediff-mult.el ediff-vers.el \ - ediff-ptch.el ediff.el ediff-hook.el -# ediff-tbar.el + ediff-ptch.el ediff.el ediff-hook.el ediff-tbar.el EDIFFelc = ediff-init.elc ediff-help.elc ediff-diff.elc ediff-merg.elc \ ediff-wind.elc ediff-util.elc ediff-mult.elc ediff-vers.elc \ - ediff-ptch.elc ediff.elc ediff-hook.elc -# ediff-tbar.elc + ediff-ptch.elc ediff.elc ediff-hook.elc ediff-tbar.elc all: hello elc goodbye dvi info diff -r ebca3d831cea -r 6a378aca36af lisp/ediff/README --- a/lisp/ediff/README Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/ediff/README Mon Aug 13 09:07:36 2007 +0200 @@ -1,6 +1,6 @@ **** EDIFF -- a comprehensive interface to diff for Emacs 19 and XEmacs 19 -**** This version of Ediff requires *at least* Emacs 19.30 or XEmacs 19.14 +**** This version of Ediff requires *at least* Emacs 19.34 or XEmacs 19.14 This directory: @@ -20,8 +20,9 @@ ediff-mult.el -- Ediff Emacs Lisp code ediff-vers.el -- Ediff Emacs Lisp code ediff-ptch.el -- Ediff Emacs Lisp code -ediff-tbar.el -- Ediff Emacs Lisp code -- this one only for XEmacs +ediff-tbar.el -- Ediff Emacs Lisp code -- for XEmacs only ediff-hook.el -- Ediff Emacs Lisp code +toolbar/ -- Ediff toolbar icons -- for XEmacs only To install Ediff do: @@ -57,42 +58,17 @@ for Emacs 18). An even better thing would be to edit Makefile directly as indicated in the comments there. -For manual installation, copy ediff*.elc into a directory on your load-path. - -For more details, read documentation at the beginning of the file ediff.el - -To install on-line documentation, you need to install the Info files -by copying - -ediff.info* - -into your Info directory (which is emacs-root-dir/info, -if emacs-root-dir is the root directory of the installation). - -Then edit the file +4. Under XEmacs, copy the icons in the `toolbar' directory into + the-directory-where-xemacs-installed/etc/toolbar/ -emacs-root-dir/info/dir - -to include the root menu item for Ediff (check how other menu -items look like in this file). - -In Emacs, this item should look like this: - -* Ediff: (ediff.info). A Visual Interface to Unix Diff and Patch Utilities - -In XEmacs, it looks like: - -* Ediff:: A Visual Interface to Unix Diff and Patch Utilities - - -Normally, all Ediff menus and autoloads are already defined in Emacs, so u +Normally, all Ediff menus and autoloads are already defined in Emacs, so you don't need to define anything in your .emacs to run Ediff. However, if it was announced that this distribution of Ediff contains -new features, you may have to put +new features, you may need to put (require 'ediff-hook) in your .emacs to take advantage of these new features. This doesn't load -Ediff, but readies it for any taks u assign to it. When this version of -Ediff gets installed in the standard Emacs distribution, you may remove +Ediff, but readies Emacs for the things to come. When this version of +Ediff gets installed in the standard Emacs distribution, you can remove the above require-statement (but leaving it in does no harm). diff -r ebca3d831cea -r 6a378aca36af lisp/ediff/ediff-diff.el --- a/lisp/ediff/ediff-diff.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/ediff/ediff-diff.el Mon Aug 13 09:07:36 2007 +0200 @@ -1,6 +1,6 @@ ;;; ediff-diff.el --- diff-related utilities -;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. ;; Author: Michael Kifer @@ -29,7 +29,7 @@ (defvar ediff-default-variant) (eval-when-compile - (let ((load-path (cons "." load-path))) + (let ((load-path (cons (expand-file-name ".") load-path))) (or (featurep 'ediff-init) (load "ediff-init.el" nil nil 'nosuffix)) (or (featurep 'ediff-util) diff -r ebca3d831cea -r 6a378aca36af lisp/ediff/ediff-help.el --- a/lisp/ediff/ediff-help.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/ediff/ediff-help.el Mon Aug 13 09:07:36 2007 +0200 @@ -1,6 +1,6 @@ ;;; ediff-help.el --- Code related to the contents of Ediff help buffers -;; Copyright (C) 1996 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. ;; Author: Michael Kifer @@ -29,7 +29,7 @@ (defvar ediff-multiframe) (eval-when-compile - (let ((load-path (cons "." load-path))) + (let ((load-path (cons (expand-file-name ".") load-path))) (or (featurep 'ediff-init) (load "ediff-init.el" nil nil 'nosuffix)) )) diff -r ebca3d831cea -r 6a378aca36af lisp/ediff/ediff-hook.el --- a/lisp/ediff/ediff-hook.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/ediff/ediff-hook.el Mon Aug 13 09:07:36 2007 +0200 @@ -1,6 +1,6 @@ ;;; ediff-hook.el --- setup for Ediff's menus and autoloads -;; Copyright (C) 1995, 1996 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc. ;; Author: Michael Kifer @@ -25,6 +25,8 @@ ;;; These must be placed in menu-bar.el in Emacs ;; +;; (define-key menu-bar-tools-menu [ediff-misc] +;; '("Ediff Miscellanea" . menu-bar-ediff-misc-menu)) ;; (define-key menu-bar-tools-menu [epatch] ;; '("Apply Patch" . menu-bar-epatch-menu)) ;; (define-key menu-bar-tools-menu [ediff-merge] @@ -36,6 +38,7 @@ (defvar ediff-menu) (defvar ediff-merge-menu) (defvar epatch-menu) +(defvar ediff-misc-menu) ;; end pacifier ;; allow menus to be set up without ediff-wind.el being loaded @@ -43,32 +46,16 @@ (defun ediff-xemacs-init-menus () - (setq ediff-window-setup-function - (if (console-on-window-system-p) - 'ediff-setup-windows-multiframe - 'ediff-setup-windows-plain)) (if (featurep 'menubar) (progn - (add-menu-button - '("Tools") - ["Use separate frame for Ediff control buffer" - ediff-toggle-multiframe - :style toggle - :selected (eq ediff-window-setup-function 'ediff-setup-windows-multiframe)] - "00-Browser...") - ;;(add-menu-button - ;; '("Tools") - ;; ["Use a toolbar with Ediff control buffer" - ;; ediff-toggle-use-toolbar - ;; :style toggle - ;; :selected (ediff-use-toolbar-p)] - ;; "00-Browser...") (add-submenu '("Tools") ediff-menu "OO-Browser...") (add-submenu '("Tools") ediff-merge-menu "OO-Browser...") (add-submenu '("Tools") epatch-menu "OO-Browser...") + (add-submenu + '("Tools") ediff-misc-menu "OO-Browser...") (add-menu-button '("Tools") ["-------" nil nil] "OO-Browser...") @@ -95,9 +82,6 @@ "---" ["Regions Word-by-word..." ediff-regions-wordwise t] ["Regions Line-by-line..." ediff-regions-linewise t] - "---" - ["List Ediff Sessions..." ediff-show-registry t] - ["Ediff Manual..." ediff-documentation t] )) (defvar ediff-merge-menu '("Merge" @@ -117,17 +101,28 @@ ["Directory Revisions..." ediff-merge-directory-revisions t] ["Directory Revisions with Ancestor..." ediff-merge-directory-revisions-with-ancestor t] - "---" - ["List Ediff Sessions..." ediff-show-registry t] - ["Ediff Manual..." ediff-documentation t] )) (defvar epatch-menu '("Apply Patch" ["To a file..." ediff-patch-file t] ["To a buffer..." ediff-patch-buffer t] - "---" + )) + (defvar ediff-misc-menu + '("Ediff Miscellanea" + ["Ediff Manual..." ediff-documentation t] ["List Ediff Sessions..." ediff-show-registry t] - ["Ediff Manual..." ediff-documentation t] + ["Use separate frame for Ediff control buffer..." + ediff-toggle-multiframe + :style toggle + :selected (if (and (featurep 'ediff-util) + (boundp 'ediff-window-setup-function)) + (eq ediff-window-setup-function + 'ediff-setup-windows-multiframe))] + ["Use a toolbar with Ediff control buffer" + ediff-toggle-use-toolbar + :style toggle + :selected (if (featurep 'ediff-tbar) + (ediff-use-toolbar-p))] )) ;; put these menus before Object-Oriented-Browser in Tools menu @@ -139,6 +134,10 @@ ;; Emacs--only if menu-bar is loaded ((featurep 'menu-bar) ;; initialize menu bar keymaps + (defvar menu-bar-ediff-misc-menu + (make-sparse-keymap "Ediff Miscellanea")) + (fset 'menu-bar-ediff-misc-menu + (symbol-value 'menu-bar-ediff-misc-menu)) (defvar menu-bar-epatch-menu (make-sparse-keymap "Apply Patch")) (fset 'menu-bar-epatch-menu (symbol-value 'menu-bar-epatch-menu)) (defvar menu-bar-ediff-merge-menu (make-sparse-keymap "Merge")) @@ -148,14 +147,6 @@ (fset 'menu-bar-ediff-menu (symbol-value 'menu-bar-ediff-menu)) ;; define ediff-menu - (define-key menu-bar-ediff-menu [ediff-doc] - '("Ediff Manual..." . ediff-documentation)) - (define-key menu-bar-ediff-menu [emultiframe] - '("Toggle separate control buffer frame..." - . ediff-toggle-multiframe)) - (define-key menu-bar-ediff-menu [eregistry] - '("List Ediff Sessions..." . ediff-show-registry)) - (define-key menu-bar-ediff-menu [separator-ediff-manual] '("--")) (define-key menu-bar-ediff-menu [window] '("This Window and Next Window" . compare-windows)) (define-key menu-bar-ediff-menu [ediff-windows-linewise] @@ -188,15 +179,6 @@ '("Two Files..." . ediff-files)) ;; define merge menu - (define-key menu-bar-ediff-merge-menu [ediff-doc2] - '("Ediff Manual..." . ediff-documentation)) - (define-key menu-bar-ediff-merge-menu [emultiframe2] - '("Toggle separate control buffer frame..." - . ediff-toggle-multiframe)) - (define-key menu-bar-ediff-merge-menu [eregistry2] - '("List Ediff Sessions..." . ediff-show-registry)) - (define-key - menu-bar-ediff-merge-menu [separator-ediff-merge-manual] '("--")) (define-key menu-bar-ediff-merge-menu [ediff-merge-dir-revisions-with-ancestor] '("Directory Revisions with Ancestor..." @@ -230,18 +212,20 @@ '("Files..." . ediff-merge-files)) ;; define epatch menu - (define-key menu-bar-epatch-menu [ediff-doc3] - '("Ediff Manual..." . ediff-documentation)) - (define-key menu-bar-epatch-menu [emultiframe3] - '("Toggle separate control buffer frame..." - . ediff-toggle-multiframe)) - (define-key menu-bar-epatch-menu [eregistry3] - '("List Ediff Sessions..." . ediff-show-registry)) - (define-key menu-bar-epatch-menu [separator-epatch] '("--")) (define-key menu-bar-epatch-menu [ediff-patch-buffer] '("To a Buffer..." . ediff-patch-buffer)) (define-key menu-bar-epatch-menu [ediff-patch-file] - '("To a File..." . ediff-patch-file))) + '("To a File..." . ediff-patch-file)) + + ;; define ediff miscellanea + (define-key menu-bar-ediff-misc-menu [emultiframe] + '("Toggle use of separate control buffer frame..." + . ediff-toggle-multiframe)) + (define-key menu-bar-ediff-misc-menu [eregistry] + '("List Ediff Sessions..." . ediff-show-registry)) + (define-key menu-bar-ediff-misc-menu [ediff-doc] + '("Ediff Manual..." . ediff-documentation)) + ) ) ; cond @@ -345,13 +329,11 @@ "ediff-util" "Toggle the use of separate frame for Ediff control buffer." t) - (condition-case nil - (if (string-match "XEmacs" emacs-version) - (autoload 'ediff-toggle-use-toolbar - "ediff-tbar" - "Toggle the use of Ediff toolbar." - t)) - (error)) + (autoload 'ediff-toggle-use-toolbar + "ediff-util" + "Toggle the use of Ediff toolbar." + t) + ) ; if purify-flag diff -r ebca3d831cea -r 6a378aca36af lisp/ediff/ediff-init.el --- a/lisp/ediff/ediff-init.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/ediff/ediff-init.el Mon Aug 13 09:07:36 2007 +0200 @@ -1,6 +1,6 @@ ;;; ediff-init.el --- Macros, variables, and defsubsts used by Ediff -;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. ;; Author: Michael Kifer @@ -32,6 +32,10 @@ (defvar ediff-mouse-pixel-threshold) (defvar ediff-whitespace) (defvar ediff-multiframe) + +(and noninteractive + (eval-when-compile + (load "ange-ftp" 'noerror))) ;; end pacifier ;; Is it XEmacs? @@ -90,7 +94,7 @@ (ediff-defvar-local ediff-buffer-C nil "") ;; Ancestor buffer (ediff-defvar-local ediff-ancestor-buffer nil "") -;; The control buffer of ediff. +;; The Ediff control buffer (ediff-defvar-local ediff-control-buffer nil "") ;;; Macros @@ -625,8 +629,8 @@ ;;;; warn if it is a wrong version of emacs -;;(if (or (ediff-check-version '< 19 29 'emacs) -;; (ediff-check-version '< 19 12 'xemacs)) +;;(if (or (ediff-check-version '< 19 35 'emacs) +;; (ediff-check-version '< 19 15 'xemacs)) ;; (progn ;; (with-output-to-temp-buffer ediff-msg-buffer ;; (switch-to-buffer ediff-msg-buffer) @@ -635,9 +639,9 @@ ;; ;;This version of Ediff requires ;; -;;\t Emacs 19.29 and higher +;;\t Emacs 19.35 and higher ;;\t OR -;;\t XEmacs 19.12 and higher +;;\t XEmacs 19.15 and higher ;; ;;It is unlikely to work under Emacs version %s ;;that you are using... " emacs-version)) diff -r ebca3d831cea -r 6a378aca36af lisp/ediff/ediff-merg.el --- a/lisp/ediff/ediff-merg.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/ediff/ediff-merg.el Mon Aug 13 09:07:36 2007 +0200 @@ -1,6 +1,6 @@ ;;; ediff-merg.el --- merging utilities -;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. ;; Author: Michael Kifer @@ -33,7 +33,7 @@ (defvar ediff-window-config-saved) (eval-when-compile - (let ((load-path (cons "." load-path))) + (let ((load-path (cons (expand-file-name ".") load-path))) (or (featurep 'ediff-init) (load "ediff-init.el" nil nil 'nosuffix)) (or (featurep 'ediff-util) diff -r ebca3d831cea -r 6a378aca36af lisp/ediff/ediff-mult.el --- a/lisp/ediff/ediff-mult.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/ediff/ediff-mult.el Mon Aug 13 09:07:36 2007 +0200 @@ -1,6 +1,6 @@ ;;; ediff-mult.el --- support for multi-file/multi-buffer processing in Ediff -;; Copyright (C) 1995, 1996 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc. ;; Author: Michael Kifer @@ -667,7 +667,8 @@ " `=':\tmark identical files in each session\n\n")) (if (and (stringp regexp) (> (length regexp) 0)) - (insert (format "Filter-through regular expression: %s\n" regexp))) + (insert + (format "\n*** Filter-through regular expression: %s\n" regexp))) (if (and ediff-autostore-merges (ediff-merge-metajob) (stringp merge-autostore-dir)) (insert (format @@ -821,7 +822,8 @@ DEL: previous line\n\n") (if (and (stringp regexp) (> (length regexp) 0)) - (insert (format "Filter-through regular expression: %s\n" regexp))) + (insert + (format "\n*** Filter-through regular expression: %s\n" regexp))) (insert "\n") (insert (format "\n%-27s%-26s" (ediff-truncate-string-left diff -r ebca3d831cea -r 6a378aca36af lisp/ediff/ediff-ptch.el --- a/lisp/ediff/ediff-ptch.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/ediff/ediff-ptch.el Mon Aug 13 09:07:36 2007 +0200 @@ -1,6 +1,6 @@ ;;; ediff-ptch.el --- Ediff's patch support -;; Copyright (C) 1996 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. ;; Author: Michael Kifer @@ -34,13 +34,11 @@ (defvar ediff-shell) (eval-when-compile - (let ((load-path (cons "." load-path))) + (let ((load-path (cons (expand-file-name ".") load-path))) (or (featurep 'ediff-init) (load "ediff-init.el" nil nil 'nosuffix)) (or (featurep 'ediff) (load "ediff.el" nil nil 'nosuffix)) - (or (featurep 'ange-ftp) - (load "ange-ftp" 'noerror)) )) ;; end pacifier diff -r ebca3d831cea -r 6a378aca36af lisp/ediff/ediff-tbar.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/ediff/ediff-tbar.el Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,371 @@ +;;; ediff-tbar.el --- A toolbar for Ediff control buffer + +;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. + +;; Author: Marc Paquette + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(provide 'ediff-tbar) + +;; compiler pacifier +(defvar toolbar-icon-directory) + +(eval-when-compile + (let ((load-path (cons (expand-file-name ".") load-path))) + (or (featurep 'ediff-init) + (load "ediff-init.el" nil nil 'nosuffix)) + (or (featurep 'ediff-util) + (load "ediff-util.el" nil nil 'nosuffix)) + )) +;; end pacifier + +(require 'ediff-init) + +(defvar ediff-use-toolbar-p nil + "If t, Ediff will use a toolbar for the control frame. +This has an effect only if your emacs supports Toolbars. +Currently, XEmacs does, but not Emacs. +Do not change the value of this variable interactively. +This should be done only via the menu bar or by executing +`ediff-toggle-use-toolbar'.") + +(defvar ediff-toolbar-height 21 + "The height of the Ediff toolbar. +The value must match the actual size of the toolbar icons.") + +(defvar ediff-toolbar-width 200.0 + "The width of the Ediff toolbar. +The value must match the actual width of the toolbar. +Here's an example: + There are 10 buttons, each 15 pixels large, and the shadows occupy 2 + pixels each side, and the last button is right-justified (so we reserve + about 30 pixels for fill space) = 200 pixels.") + +(defun ediff-has-toolbar-support-p () + (and ediff-xemacs-p + (featurep 'toolbar) + (console-on-window-system-p))) + +(defun ediff-use-toolbar-p () + (and (ediff-has-toolbar-support-p) ;Can it do it ? + ediff-use-toolbar-p)) ;Does the user want it ? + +;; Here the toolbar width is not the same width talked about in XEmacs +;; lispref info documentation : it is the minimal width needed by +;; ediff's toolbar to display all buttons, for an horizontal toolbar. +;; Ideally, we would query the toolbar for the width of each button +;; and add them, but I didn't find query functions in the doc on +;; toolbars. Therefore, I use a static number of pixels that should +;; be adjusted if the toolbar gets more or loses some buttons. --marcpa +(defun ediff-compute-toolbar-width () + (if (not (ediff-use-toolbar-p)) + 0 + (ceiling (/ ediff-toolbar-width (font-instance-width (face-font-instance 'default)))))) + +(defvar ediff-toolbar-next-icon + (if (featurep 'toolbar) + (toolbar-make-button-list + (expand-file-name + (if (featurep 'xpm) "ediff-next.xpm" "ediff-next.xbm") + toolbar-icon-directory))) + "Next difference icon in toolbar.") + +(defvar ediff-toolbar-previous-icon + (if (featurep 'toolbar) + (toolbar-make-button-list + (expand-file-name + (if (featurep 'xpm) "ediff-prev.xpm" "ediff-prev.xbm") + toolbar-icon-directory))) + "Previous difference icon in toolbar.") + +(defvar ediff-toolbar-A-icon + (if (featurep 'toolbar) + (toolbar-make-button-list + (expand-file-name + ;; UP + (if (featurep 'xpm) "ediff-A-up.xpm" "ediff-A-up.xbm") + toolbar-icon-directory) + (expand-file-name + ;; DOWN + (if (featurep 'xpm) "ediff-A-up.xpm" "ediff-A-up.xbm") + toolbar-icon-directory) + (expand-file-name + ;; DISABLED + (if (featurep 'xpm) "ediff-A-xx.xpm" "ediff-A-up.xbm") + toolbar-icon-directory) + )) + "Select diff A icon in toolbar.") + +(defvar ediff-toolbar-B-icon + (if (featurep 'toolbar) + (toolbar-make-button-list + (expand-file-name + ;; UP + (if (featurep 'xpm) "ediff-B-up.xpm" "ediff-B-up.xbm") + toolbar-icon-directory) + (expand-file-name + ;; DOWN + (if (featurep 'xpm) "ediff-B-up.xpm" "ediff-B-up.xbm") + toolbar-icon-directory) + (expand-file-name + ;; DISABLED + (if (featurep 'xpm) "ediff-B-xx.xpm" "ediff-B-up.xbm") + toolbar-icon-directory) + )) + "Select diff B icon in toolbar.") + +(defvar ediff-toolbar-toggle-split-icon + (if (featurep 'toolbar) + (toolbar-make-button-list + (expand-file-name + ;; UP + (if (featurep 'xpm) + "ediff-toggle-split-up.xpm" "ediff-toggle-split-up.xbm") + toolbar-icon-directory) + )) + "Toggle split mode between side-to-side and one-on-top-of-another.") + +(defvar ediff-toolbar-save-icon + (if (featurep 'toolbar) + (toolbar-make-button-list + (expand-file-name + ;; UP + (if (featurep 'xpm) "ediff-save.xpm" "ediff-save.xbm") + toolbar-icon-directory) + (expand-file-name + ;; DOWN + (if (featurep 'xpm) "ediff-save.xpm" "ediff-save.xbm") + toolbar-icon-directory) + (expand-file-name + ;; DISABLED + (if (featurep 'xpm) "ediff-save-xx.xpm" "ediff-save-xx.xbm") + toolbar-icon-directory) + )) + "Save merge buffer.") + +(defvar ediff-toolbar-quit-icon + (if (featurep 'toolbar) + (toolbar-make-button-list + (expand-file-name + (if (featurep 'xpm) "ediff-quit.xpm" "ediff-quit.xbm") + toolbar-icon-directory))) + "Exit Ediff session.") + +(defvar ediff-toolbar-help-icon + (if (featurep 'toolbar) + (toolbar-make-button-list + (expand-file-name + (if (featurep 'xpm) "ediff-help.xpm" "ediff-help.xbm") + toolbar-icon-directory))) + "Show Ediff help.") + +(defvar ediff-toolbar-refresh-icon + (if (featurep 'toolbar) + (toolbar-make-button-list + (expand-file-name + (if (featurep 'xpm) "ediff-update.xpm" "ediff-update.xbm") + toolbar-icon-directory))) + "Refresh Ediff display (aka recenter).") + +(defvar ediff-toolbar-refine-icon + (if (featurep 'toolbar) + (toolbar-make-button-list + (expand-file-name + ;; UP + (if (featurep 'xpm) "ediff-refine.xpm" "ediff-refine.xbm") + toolbar-icon-directory) + )) + "Refine current difference region by computing fine diffs.") + +(defun ediff-toolbar-previous-difference () + (interactive) + (let ((ediff-grab-mouse nil)) + (ediff-previous-difference 1))) + +(defun ediff-toolbar-next-difference () + (interactive) + (let ((ediff-grab-mouse nil)) + (ediff-next-difference 1))) + +(defun ediff-toolbar-select/copy-A () + (interactive) + (let ((ediff-grab-mouse nil)) + (cond ((or (ediff-merge-job) + (ediff-merge-with-ancestor-job)) + (ediff-copy-A-to-C nil)) + (t + (ediff-copy-A-to-B nil))))) + +(defun ediff-toolbar-select/copy-B () + (interactive) + (let ((ediff-grab-mouse nil)) + (cond ((or (ediff-merge-job) + (ediff-merge-with-ancestor-job)) + (ediff-copy-B-to-C nil)) + (t + (ediff-copy-B-to-A nil))))) + +(defun ediff-toolbar-toggle-split () + (interactive) + (let ((ediff-grab-mouse nil)) + (ediff-toggle-split))) + + +(defun ediff-toolbar-save () + (interactive) + (ediff-barf-if-not-control-buffer) + (if (ediff-merge-job) + (ediff-maybe-save-and-delete-merge 'save-and-continue) + ;; 2-way or 3-way compare: save modified buffers + (mapcar (function + (lambda (type) + (let ((ebuf (ediff-get-buffer type))) + (and (ediff-buffer-live-p ebuf) + (ediff-eval-in-buffer ebuf + (and (buffer-modified-p) + (save-buffer))))))) + '(A B C)))) + + +(defun ediff-toolbar-quit () + (interactive) + (let ((ediff-grab-mouse nil)) + (ediff-quit nil))) + +(defun ediff-toolbar-help () + (interactive) + (ediff-toggle-help)) + +(defun ediff-toolbar-refresh () + "Recenter" + (interactive) + (let ((ediff-grab-mouse nil)) + (ediff-recenter))) + +(defun ediff-toolbar-refine () + "Refine current difference region by computing fine diffs." + (interactive) + (let ((ediff-grab-mouse nil)) + (ediff-make-or-kill-fine-diffs 'make-them))) + +(defun ediff-toolbar-refine-needed-p () + (and (> ediff-current-difference 0) + (> ediff-auto-refine-limit + (- (ediff-get-diff-posn 'A 'end ediff-current-difference) + (ediff-get-diff-posn 'A 'beg ediff-current-difference))))) + +(defvar ediff-toolbar + (if (featurep 'toolbar) + '([ediff-toolbar-refine-icon + ediff-toolbar-refine + t + ;;; The toolbar is not automatically refreshed (in 19.14) + ;;; when :activep changes state. + ;;(ediff-toolbar-refine-needed-p) + "Refine current difference region by computing fine diffs."] + [ediff-toolbar-previous-icon + ediff-toolbar-previous-difference + t + "Go to the previous difference."] + [ediff-toolbar-next-icon + ediff-toolbar-next-difference + t + "Advance to the next difference."] + [ediff-toolbar-A-icon + ediff-toolbar-select/copy-A + (not (ediff-3way-comparison-job)) + "Select/Copy difference A."] + [ediff-toolbar-B-icon + ediff-toolbar-select/copy-B + (not (ediff-3way-comparison-job)) + "Select/Copy difference B."] + [ediff-toolbar-save-icon + ediff-toolbar-save + t + "Save buffers modified in this session."] + [ediff-toolbar-refresh-icon + ediff-toolbar-refresh + t + "Refresh Ediff display (aka recenter)."] + [ediff-toolbar-toggle-split-icon + ediff-toolbar-toggle-split + t + "Toggle split mode between side-to-side and one-on-top-of-another."] + [ediff-toolbar-help-icon + ediff-toolbar-help + t + "Toggle short/long help."] + nil + [ediff-toolbar-quit-icon + ediff-toolbar-quit + t + "Quit this ediff session."] + ))) + +(defvar ediff-toolbar-3way + (if (featurep 'toolbar) + '([ediff-toolbar-refine-icon + ediff-toolbar-refine + t + ;;; The toolbar is not automatically refreshed (in 19.14) + ;;; when :activep changes state. + ;;(ediff-toolbar-refine-needed-p) + "Refine current difference region by computing fine diffs."] + [ediff-toolbar-previous-icon + ediff-toolbar-previous-difference + t + "Go to the previous difference."] + [ediff-toolbar-next-icon + ediff-toolbar-next-difference + t + "Advance to the next difference."] + [ediff-toolbar-save-icon + ediff-toolbar-save + t + "Save buffers modified in this session."] + [ediff-toolbar-refresh-icon + ediff-toolbar-refresh + t + "Refresh Ediff display (aka recenter)."] + [ediff-toolbar-toggle-split-icon + ediff-toolbar-toggle-split + t + "Toggle split mode between side-to-side and one-on-top-of-another."] + [ediff-toolbar-help-icon + ediff-toolbar-help + t + "Toggle short/long help."] + nil + [ediff-toolbar-quit-icon + ediff-toolbar-quit + t + "Quit this ediff session."] + ))) + + + +;;; Local Variables: +;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun) +;;; eval: (put 'ediff-eval-in-buffer 'lisp-indent-hook 1) +;;; eval: (put 'ediff-eval-in-buffer 'edebug-form-spec '(form body)) +;;; End: + +;;; ediff-tbar.el ends here diff -r ebca3d831cea -r 6a378aca36af lisp/ediff/ediff-util.el --- a/lisp/ediff/ediff-util.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/ediff/ediff-util.el Mon Aug 13 09:07:36 2007 +0200 @@ -1,6 +1,6 @@ ;;; ediff-util.el --- the core commands and utilities of ediff -;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. ;; Author: Michael Kifer @@ -29,10 +29,14 @@ (defvar ediff-patch-diagnostics) (defvar ediff-patchbufer) (defvar ediff-toolbar) +(defvar ediff-toolbar-3way) +(defvar bottom-toolbar) +(defvar bottom-toolbar-visible-p) +(defvar bottom-toolbar-height) (defvar mark-active) (eval-when-compile - (let ((load-path (cons "." load-path))) + (let ((load-path (cons (expand-file-name ".") load-path))) (or (featurep 'ediff-init) (load "ediff-init.el" nil nil 'nosuffix)) (or (featurep 'ediff-help) @@ -515,8 +519,10 @@ ediff-split-window-function (ediff-multiframe-setup-p) ediff-wide-display-p)) + + ;; In multiframe, toolbar is set in ediff-setup-control-frame (if (not (ediff-multiframe-setup-p)) - (ediff-make-bottom-toolbar)) ; checks if toolbar is requested + (ediff-make-bottom-toolbar)) ; this checks if toolbar is requested (goto-char (point-min)) (skip-chars-forward ediff-whitespace))) @@ -1181,33 +1187,21 @@ ;;;###autoload (defun ediff-toggle-multiframe () - "Switch from the multiframe display to single-frame display and back. -For a permanent change, set the variable `ediff-window-setup-function', + "Switch from multiframe display to single-frame display and back. +To change the default, set the variable `ediff-window-setup-function', which see." (interactive) - (let (set-func window-setup-func) + (let (window-setup-func) (or (ediff-window-display-p) (error "%sEmacs is not running as a window application" (if ediff-emacs-p "" "X"))) - ;;(setq set-func (if (ediff-in-control-buffer-p) 'setq 'setq-default)) - (cond ((eq ediff-window-setup-function 'ediff-setup-windows-multiframe) - ;; (eval - ;; (list - ;; set-func - ;; 'ediff-window-setup-function ''ediff-setup-windows-plain)) - (setq window-setup-func 'ediff-setup-windows-plain) - ) + (setq window-setup-func 'ediff-setup-windows-plain)) ((eq ediff-window-setup-function 'ediff-setup-windows-plain) (if (ediff-in-control-buffer-p) (ediff-kill-bottom-toolbar)) - ;;(eval - ;; (list - ;; set-func - ;; 'ediff-window-setup-function 'ediff-setup-windows-multiframe)) - (setq window-setup-func 'ediff-setup-windows-multiframe) - )) + (setq window-setup-func 'ediff-setup-windows-multiframe))) ;; change default (setq-default ediff-window-setup-function window-setup-func) @@ -1220,6 +1214,33 @@ (if (ediff-in-control-buffer-p) (ediff-recenter 'no-rehighlight)))) + +;;;###autoload +(defun ediff-toggle-use-toolbar () + "Enable or disable Ediff toolbar. +Works only in versions of Emacs that support toolbars. +To change the default, set the variable `ediff-use-toolbar-p', which see." + (interactive) + (if (featurep 'ediff-tbar) + (progn + (or (ediff-window-display-p) + (error "%sEmacs is not running as a window application" + (if ediff-emacs-p "" "X"))) + (if (ediff-use-toolbar-p) + (ediff-kill-bottom-toolbar)) + ;; do this only after killing the toolbar + (setq ediff-use-toolbar-p (not ediff-use-toolbar-p)) + + (mapcar (function (lambda(buf) + (ediff-eval-in-buffer buf + ;; force redisplay + (setq ediff-window-config-saved "") + ))) + ediff-session-registry) + (if (ediff-in-control-buffer-p) + (ediff-recenter 'no-rehighlight))))) + + ;; if was using toolbar, kill it (defun ediff-kill-bottom-toolbar () ;; Using ctl-buffer or ediff-control-window for LOCALE does not @@ -1233,13 +1254,25 @@ (set-specifier bottom-toolbar (list (selected-frame) nil)) (set-specifier bottom-toolbar-visible-p (list (selected-frame) nil))))) -;; if wants to use toolbar, make it -(defun ediff-make-bottom-toolbar () - (if (ediff-use-toolbar-p) +;; If wants to use toolbar, make it. +;; If not, zero the toolbar for XEmacs. +;; Do nothing for Emacs. +(defun ediff-make-bottom-toolbar (&optional frame) + (if (ediff-window-display-p) (progn - (set-specifier bottom-toolbar (list (selected-frame) ediff-toolbar)) - (set-specifier bottom-toolbar-visible-p (list (selected-frame) t)) - (set-specifier bottom-toolbar-height (list (selected-frame) 34))))) + (setq frame (or frame (selected-frame))) + (cond ((ediff-use-toolbar-p) ; this checks for XEmacs + (set-specifier + bottom-toolbar + (list frame (if (ediff-3way-comparison-job) + ediff-toolbar-3way ediff-toolbar))) + (set-specifier bottom-toolbar-visible-p (list frame t)) + (set-specifier bottom-toolbar-height + (list frame ediff-toolbar-height))) + (ediff-xemacs-p + (set-specifier bottom-toolbar-height (list frame 0))) + )) + )) ;; Merging @@ -2202,13 +2235,15 @@ temporarily reverses the meaning of this variable." (interactive "P") (ediff-barf-if-not-control-buffer) - (if (y-or-n-p (format "Quit this Ediff session%s? " - (if (ediff-buffer-live-p ediff-meta-buffer) - " & show containing session group" ""))) - (progn - (message "") - (ediff-really-quit reverse-default-keep-variants)) - (message ""))) + (let ((ctl-buf (current-buffer))) + (if (y-or-n-p (format "Quit this Ediff session%s? " + (if (ediff-buffer-live-p ediff-meta-buffer) + " & show containing session group" ""))) + (progn + (message "") + (set-buffer ctl-buf) + (ediff-really-quit reverse-default-keep-variants)) + (message "")))) ;; Perform the quit operations. @@ -2422,27 +2457,33 @@ (buffer-name ediff-buffer-C))))) (ediff-kill-buffer-carefully ediff-buffer-C)))) -(defun ediff-maybe-save-and-delete-merge () +(defun ediff-maybe-save-and-delete-merge (&optional save-and-continue) "Default hook to run on quitting a merge job. +This can also be used to save merge buffer in the middle of an Ediff session. + +If the optional SAVE-AND-CONTINUE argument is non-nil, save merge buffer and +continue. Otherwise: If `ediff-autostore-merges' is nil, this does nothing. If it is t, it saves the merge buffer in the file `ediff-merge-store-file' -or asks the user, if the latter is nil. It then then asks the user whether to +or asks the user, if the latter is nil. It then asks the user whether to delete the merge buffer. If `ediff-autostore-merges' is neither nil nor t, the merge buffer is saved only if this merge job is part of a group, i.e., was invoked from within `ediff-merge-directories', `ediff-merge-directory-revisions', and such." - (let ((merge-store-file ediff-merge-store-file)) + (let ((merge-store-file ediff-merge-store-file) + (ediff-autostore-merges ; fake ediff-autostore-merges, if necessary + (if save-and-continue t ediff-autostore-merges))) (if ediff-autostore-merges (cond ((stringp ediff-merge-store-file) ;; store, ask to delete - (ediff-write-merge-buffer-then-kill - ediff-buffer-C merge-store-file 'show-file)) + (ediff-write-merge-buffer-and-maybe-kill + ediff-buffer-C merge-store-file 'show-file save-and-continue)) ((eq ediff-autostore-merges t) ;; ask for file name (setq merge-store-file - (read-file-name "Save the result of the merge in: ")) - (ediff-write-merge-buffer-then-kill - ediff-buffer-C merge-store-file)) + (read-file-name "Save the merge buffer in file: ")) + (ediff-write-merge-buffer-and-maybe-kill + ediff-buffer-C merge-store-file nil save-and-continue)) ((and (ediff-buffer-live-p ediff-meta-buffer) (ediff-eval-in-buffer ediff-meta-buffer (ediff-merge-metajob))) @@ -2451,12 +2492,16 @@ ;; of the merge. ;; Ask where to save anyway--will decide what to do here later. (setq merge-store-file - (read-file-name "The result of the merge goes into: ")) - (ediff-write-merge-buffer-then-kill - ediff-buffer-C merge-store-file)))) + (read-file-name "Save the merge buffer in file: ")) + (ediff-write-merge-buffer-and-maybe-kill + ediff-buffer-C merge-store-file nil save-and-continue)))) )) -(defun ediff-write-merge-buffer-then-kill (buf file &optional show-file) +;; write merge buffer. If the optional argument save-and-continue is non-nil, +;; then don't kill the merge buffer +(defun ediff-write-merge-buffer-and-maybe-kill (buf file + &optional + show-file save-and-continue) (ediff-eval-in-buffer buf (if (or (not (file-exists-p file)) (y-or-n-p (format "File %s exists, overwrite? " file))) @@ -2466,7 +2511,9 @@ (progn (message "Merge buffer saved in: %s" file) (sit-for 2))) - (if (y-or-n-p "Merge buffer saved in file. Now kill the buffer? ") + (if (and + (not save-and-continue) + (y-or-n-p "Merge buffer saved in file. Now kill the buffer? ")) (ediff-kill-buffer-carefully buf)))))) ;; The default way of suspending Ediff. diff -r ebca3d831cea -r 6a378aca36af lisp/ediff/ediff-vers.el --- a/lisp/ediff/ediff-vers.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/ediff/ediff-vers.el Mon Aug 13 09:07:36 2007 +0200 @@ -1,6 +1,6 @@ ;;; ediff-vers.el --- version control interface to Ediff -;;; Copyright (C) 1995, 1996 Free Software Foundation, Inc. +;;; Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc. ;; Author: Michael Kifer @@ -32,11 +32,12 @@ (defvar cvs-cookie-handle) (defvar ediff-temp-file-prefix) -(eval-when-compile - (load "pcl-cvs" 'noerror) - (load "rcs" 'noerror) - (load "generic-sc" 'noerror) - (load "vc" 'noerror)) +(and noninteractive + (eval-when-compile + (load "pcl-cvs" 'noerror) + (load "rcs" 'noerror) + (load "generic-sc" 'noerror) + (load "vc" 'noerror))) ;; end pacifier ;; VC.el support diff -r ebca3d831cea -r 6a378aca36af lisp/ediff/ediff-wind.el --- a/lisp/ediff/ediff-wind.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/ediff/ediff-wind.el Mon Aug 13 09:07:36 2007 +0200 @@ -1,6 +1,6 @@ ;;; ediff-wind.el --- window manipulation utilities -;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. ;; Author: Michael Kifer @@ -38,13 +38,13 @@ (defvar ediff-diff-status) (eval-when-compile - (let ((load-path (cons "." load-path))) + (let ((load-path (cons (expand-file-name ".") load-path))) (or (featurep 'ediff-init) (load "ediff-init.el" nil nil 'nosuffix)) + (or (featurep 'ediff-util) + (load "ediff-util.el" nil nil 'nosuffix)) (or (featurep 'ediff-help) (load "ediff-help.el" nil nil 'nosuffix)) - (or (featurep 'ediff-util) - (load "ediff-util.el" nil nil 'nosuffix)) (or (featurep 'ediff-tbar) (load "ediff-tbar.el" 'noerror nil 'nosuffix)) )) @@ -878,16 +878,19 @@ fheight lines fwidth (max (+ (ediff-help-message-line-length) 2) (ediff-compute-toolbar-width)) - adjusted-parameters (append (list - ;; possibly change surrogate minibuffer - (cons 'minibuffer - (minibuffer-window - designated-minibuffer-frame)) - (cons 'width fwidth) - (cons 'height fheight)) - (funcall - ediff-control-frame-position-function - ctl-buffer fwidth fheight))) + adjusted-parameters ;;(append + (list + ;; possibly change surrogate minibuffer + (cons 'minibuffer + (minibuffer-window + designated-minibuffer-frame)) + (cons 'width fwidth) + (cons 'height fheight)) + ;;(funcall + ;;ediff-control-frame-position-function + ;;ctl-buffer fwidth fheight) + ;;) + ) (if ediff-use-long-help-message (setq adjusted-parameters (cons '(auto-raise . nil) adjusted-parameters))) @@ -896,8 +899,10 @@ ;; are changed. (if ediff-xemacs-p (progn + (set-specifier top-toolbar-height (list ctl-frame 2)) + (sit-for 0) (set-specifier top-toolbar-height (list ctl-frame 0)) - (set-specifier bottom-toolbar-height (list ctl-frame 0)) + ;;(set-specifier bottom-toolbar-height (list ctl-frame 0)) (set-specifier left-toolbar-width (list ctl-frame 0)) (set-specifier right-toolbar-width (list ctl-frame 0)) )) @@ -910,11 +915,13 @@ (if (memq system-type '(emx windows-nt windows-95)) (modify-frame-parameters ctl-frame adjusted-parameters)) + ;; make or zap toolbar (if not requested) + (ediff-make-bottom-toolbar ctl-frame) + (goto-char (point-min)) - + (modify-frame-parameters ctl-frame adjusted-parameters) (make-frame-visible ctl-frame) - (ediff-make-bottom-toolbar) ; no effect if the toolbar is not requested ;; This works around a bug in 19.25 and earlier. There, if frame gets ;; iconified, the current buffer changes to that of the frame that @@ -930,6 +937,12 @@ (raise-frame ctl-frame))) (set-window-dedicated-p (selected-window) t) + + ;; Now move the frame. We must do it separately due to an obscure bug in + ;; XEmacs + (modify-frame-parameters + ctl-frame + (funcall ediff-control-frame-position-function ctl-buffer fwidth fheight)) ;; synchronize so the cursor will move to control frame ;; per RMS suggestion @@ -955,6 +968,7 @@ (ediff-eval-in-buffer ctl-buffer (run-hooks 'ediff-after-setup-control-frame-hook)) )) + (defun ediff-destroy-control-frame (ctl-buffer) (ediff-eval-in-buffer ctl-buffer @@ -1081,9 +1095,9 @@ ;; control buffer format (setq mode-line-format - (list (if (ediff-narrow-control-frame-p) " " "-- ") - mode-line-buffer-identification - " Quick Help")) + (if (ediff-narrow-control-frame-p) + (list " " mode-line-buffer-identification) + (list "-- " mode-line-buffer-identification " Quick Help"))) ;; control buffer id (setq mode-line-buffer-identification (if (ediff-narrow-control-frame-p) diff -r ebca3d831cea -r 6a378aca36af lisp/ediff/ediff.el --- a/lisp/ediff/ediff.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/ediff/ediff.el Mon Aug 13 09:07:36 2007 +0200 @@ -1,13 +1,13 @@ ;;; ediff.el --- a comprehensive visual interface to diff & patch -;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. ;; Author: Michael Kifer ;; Created: February 2, 1994 ;; Keywords: comparing, merging, patching, version control. (defconst ediff-version "2.64" "The current version of Ediff") -(defconst ediff-date "January 3, 1997" "Date of last update") +(defconst ediff-date "January 7, 1997" "Date of last update") ;; This file is part of GNU Emacs. @@ -109,9 +109,13 @@ (provide 'ediff) ;; Compiler pacifier +(and noninteractive + (eval-when-compile + (load-library "dired") + (load-library "info") + (load "pcl-cvs" 'noerror))) (eval-when-compile - (let ((load-path (cons "." load-path))) - (load "dired") + (let ((load-path (cons (expand-file-name ".") load-path))) (or (featurep 'ediff-init) (load "ediff-init.el" nil nil 'nosuffix)) (or (featurep 'ediff-mult) @@ -120,7 +124,6 @@ (load "ediff-ptch.el" nil nil 'nosuffix)) (or (featurep 'ediff-vers) (load "ediff-vers.el" nil nil 'nosuffix)) - (load "pcl-cvs" 'noerror) )) ;; end pacifier @@ -285,8 +288,8 @@ (ediff-eval-in-buffer (symbol-value buffer-name) (widen) ; Make sure the entire file is seen - (cond (file-magic ;; file has handler, such as jka-compr-handler or - ;; ange-ftp-hook-function--arrange for temp file + (cond (file-magic ; file has a handler, such as jka-compr-handler or + ;;; ange-ftp-hook-function--arrange for temp file (ediff-verify-file-buffer 'magic) (setq file (ediff-make-temp-file diff -r ebca3d831cea -r 6a378aca36af lisp/modes/imenu.el --- a/lisp/modes/imenu.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/modes/imenu.el Mon Aug 13 09:07:36 2007 +0200 @@ -787,12 +787,13 @@ (interactive "sImenu menu item name: ") (let ((newmap (make-sparse-keymap)) (menu-bar (lookup-key (current-local-map) [menu-bar]))) - (define-key newmap [menu-bar] - (append (make-sparse-keymap) menu-bar)) - (define-key newmap [menu-bar index] - (cons name (nconc (make-sparse-keymap "Imenu") - (make-sparse-keymap)))) - (use-local-map (append newmap (current-local-map)))) + (when menu-bar + (define-key newmap [menu-bar] + (append (make-sparse-keymap) menu-bar)) + (define-key newmap [menu-bar index] + (cons name (nconc (make-sparse-keymap "Imenu") + (make-sparse-keymap)))) + (use-local-map (append newmap (current-local-map))))) (add-hook 'menu-bar-update-hook 'imenu-update-menubar)) (defvar imenu-buffer-menubar nil) diff -r ebca3d831cea -r 6a378aca36af lisp/modes/m4-mode.el --- a/lisp/modes/m4-mode.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/modes/m4-mode.el Mon Aug 13 09:07:36 2007 +0200 @@ -28,7 +28,7 @@ ;; It also sets the font-lock syntax stuff for colorization ;; By Drew Csillag (drew@staff.prodigy.com) -;; $Id: m4-mode.el,v 1.1.1.1 1996/12/18 22:42:49 steve Exp $ +;; $Id: m4-mode.el,v 1.2 1997/01/23 05:29:30 steve Exp $ ;; History: @@ -69,7 +69,7 @@ ;;; Code: ;;path to the m4 program -(defvar m4-program "/usr/local/bin/m4") +(defvar m4-program "/usr/bin/m4") ;;thank god for make-regexp.el! (defvar m4-font-lock-keywords diff -r ebca3d831cea -r 6a378aca36af lisp/modes/rsz-minibuf.el --- a/lisp/modes/rsz-minibuf.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/modes/rsz-minibuf.el Mon Aug 13 09:07:36 2007 +0200 @@ -10,7 +10,7 @@ ;;; Keywords: minibuffer, window, frames, display ;;; Status: Known to work in FSF GNU Emacs 19.23 and Lucid Emacs 19.9. -;;; $Id: rsz-minibuf.el,v 1.1.1.1 1996/12/18 22:42:48 steve Exp $ +;;; $Id: rsz-minibuf.el,v 1.2 1997/01/23 05:29:30 steve Exp $ ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by @@ -159,10 +159,16 @@ (add-hook 'minibuffer-exit-hook 'resize-minibuffer-frame-restore nil t) (make-local-hook 'post-command-hook) - (add-hook 'post-command-hook 'resize-minibuffer-frame nil t)))) + (add-hook 'post-command-hook 'resize-minibuffer-frame nil t) + (unless (and (boundp 'icomplete-mode) + icomplete-mode) + (resize-minibuffer-frame))))) (t (make-local-hook 'post-command-hook) - (add-hook 'post-command-hook 'resize-minibuffer-window nil t)))))) + (add-hook 'post-command-hook 'resize-minibuffer-window nil t) + (unless (and (boundp 'icomplete-mode) + icomplete-mode) + (resize-minibuffer-window))))))) (defun resize-minibuffer-count-window-lines (&optional start end) "Return number of window lines occupied by text in region. diff -r ebca3d831cea -r 6a378aca36af lisp/modes/view.el --- a/lisp/modes/view.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/modes/view.el Mon Aug 13 09:07:36 2007 +0200 @@ -355,7 +355,7 @@ (scroll-up lines))) (cond ((pos-visible-in-window-p (point-max)) (goto-char (point-max)) - (message "%" + (message "%s" (substitute-command-keys "End. Type \\[view-exit] to quit viewing.")))) (move-to-window-line -1) diff -r ebca3d831cea -r 6a378aca36af lisp/mule/mule-files.el --- a/lisp/mule/mule-files.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/mule/mule-files.el Mon Aug 13 09:07:36 2007 +0200 @@ -54,6 +54,7 @@ ;; '(; ("\\.el$" . euc-japan) '(("\\.el$" . iso-2022-8) ("\\.info$" . iso-2022-8) + ("ChangeLog$" . iso-2022-8) ("\\.\\(gz\\|Z\\)$" . binary) ("/spool/mail/.*$" . convert-mbox-coding-system)) "Alist specifying the coding system used for particular files. diff -r ebca3d831cea -r 6a378aca36af lisp/mule/mule-init.el --- a/lisp/mule/mule-init.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/mule/mule-init.el Mon Aug 13 09:07:36 2007 +0200 @@ -119,7 +119,10 @@ ;; Translate remaining args on command line using pathname-coding-system (loop for arg in-ref command-line-args-left do (setf arg (decode-coding-string arg pathname-coding-system))) - + + ;; rman seems to be incompatible with encoded text + (setq Manual-use-rosetta-man nil) + ;; Make sure ls -l output is readable by dired and encoded using ;; pathname-coding-system (add-hook diff -r ebca3d831cea -r 6a378aca36af lisp/mule/mule-misc.el --- a/lisp/mule/mule-misc.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/mule/mule-misc.el Mon Aug 13 09:07:36 2007 +0200 @@ -53,16 +53,7 @@ (defun string-to-char-list (str) (mapcar 'identity str)) -;;; Slower, albeit more elegant, implementation?? -;; (defun string-columns (string) -;; "Return number of columns STRING occupies when displayed. -;; Uses the charset-columns attribute of the characters in STRING, -;; which may not accurately represent the actual display width in a -;; window system." -;; (loop for c across string -;; sum (charset-columns (char-charset c)))) - -(defun string-columns (string) +(defun string-width (string) "Return number of columns STRING occupies when displayed. Uses the charset-columns attribute of the characters in STRING, which may not accurately represent the actual display width when @@ -75,7 +66,8 @@ (setq i (1+ i))) col)) -(defalias 'string-width 'string-columns) +(defalias 'string-columns 'string-width) +(make-obsolete 'string-columns 'string-width) (defun delete-text-in-column (from to) "Delete the text between column FROM and TO (exclusive) of the current line. @@ -154,22 +146,76 @@ (null (car buffer-undo-list)) ) (setq buffer-undo-list (cdr buffer-undo-list)) )) + ;;; Common API emulation functions for GNU Emacs-merged Mule. ;;; As suggested by MORIOKA Tomohiko -(defun truncate-string (str width &optional start-column) - "Truncate STR to fit in WIDTH columns. -Optional non-nil arg START-COLUMN specifies the starting column." - (substring str (or start-column 0) width)) + +;; Following definition were imported from Emacs/mule-delta. + +(defun truncate-string-to-width (str width &optional start-column padding) + "Truncate string STR to fit in WIDTH columns. +Optional 1st arg START-COLUMN if non-nil specifies the starting column. +Optional 2nd arg PADDING if non-nil, space characters are padded at +the head and tail of the resulting string to fit in WIDTH if necessary. +If PADDING is nil, the resulting string may be narrower than WIDTH." + (or start-column + (setq start-column 0)) + (let ((len (length str)) + (idx 0) + (column 0) + (head-padding "") (tail-padding "") + ch last-column last-idx from-idx) + (condition-case nil + (while (< column start-column) + (setq ch (sref str idx) + column (+ column (char-width ch)) + idx (+ idx (char-bytes ch)))) + (args-out-of-range (setq idx len))) + (if (< column start-column) + (if padding (make-string width ?\ ) "") + (if (and padding (> column start-column)) + (setq head-padding (make-string (- column start-column) ?\ ))) + (setq from-idx idx) + (condition-case nil + (while (< column width) + (setq last-column column + last-idx idx + ch (sref str idx) + column (+ column (char-width ch)) + idx (+ idx (char-bytes ch)))) + (args-out-of-range (setq idx len))) + (if (> column width) + (setq column last-column idx last-idx)) + (if (and padding (< column width)) + (setq tail-padding (make-string (- width column) ?\ ))) + (setq str (substring str from-idx idx)) + (if padding + (concat head-padding str tail-padding) + str)))) + +;;; For backward compatiblity ... +;;;###autoload +(defalias 'truncate-string 'truncate-string-to-width) +(make-obsolete 'truncate-string 'truncate-string-to-width) + +;; end of imported definition + (defalias 'sref 'aref) (defalias 'map-char-concat 'mapcar) -(defun char-bytes (chr) 1) -(defun char-length (chr) 1) +(defun char-bytes (character) + "Return number of length a CHARACTER occupies in a string or buffer. +It returns only 1 in XEmacs. It is for compatibility with MULE 2.3." + 1) +(defalias 'char-length 'char-bytes) -(defun char-columns (character) +(defun char-width (character) "Return number of columns a CHARACTER occupies when displayed." (charset-columns (char-charset character))) +(defalias 'char-columns 'char-width) +(make-obsolete 'char-columns 'char-width) + (defalias 'charset-description 'charset-doc-string) (defalias 'find-charset-string 'charsets-in-string) @@ -177,44 +223,16 @@ (defun find-non-ascii-charset-string (string) "Return a list of charsets in the STRING except ascii. -For compatibility with Mule" +It might be available for compatibility with Mule 2.3, +because its `find-charset-string' ignores ASCII charset." (delq 'ascii (charsets-in-string string))) (defun find-non-ascii-charset-region (start end) - "Return a list of charsets except ascii -in the region between START and END. -For compatibility with Mule" + "Return a list of charsets except ascii in the region between START and END. +It might be available for compatibility with Mule 2.3, +because its `find-charset-string' ignores ASCII charset." (delq 'ascii (charsets-in-region start end))) -;(defun truncate-string-to-column (str width &optional start-column) -; "Truncate STR to fit in WIDTH columns. -;Optional non-nil arg START-COLUMN specifies the starting column." -; (or start-column -; (setq start-column 0)) -; (let ((max-width (string-width str)) -; (len (length str)) -; (from 0) -; (column 0) -; to-prev to ch) -; (if (>= width max-width) -; (setq width max-width)) -; (if (>= start-column width) -; "" -; (while (< column start-column) -; (setq ch (aref str from) -; column (+ column (char-width ch)) -; from (+ from (char-octets ch)))) -; (if (< width max-width) -; (progn -; (setq to from) -; (while (<= column width) -; (setq ch (aref str to) -; column (+ column (char-width ch)) -; to-prev to -; to (+ to (char-octets ch)))) -; (setq to to-prev))) -; (substring str from to)))) - ;;; Language environments diff -r ebca3d831cea -r 6a378aca36af lisp/packages/compile.el --- a/lisp/packages/compile.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/packages/compile.el Mon Aug 13 09:07:36 2007 +0200 @@ -154,9 +154,9 @@ ;; MIPS lint pass; looks good for SunPro lint also ;; TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomon.c due to truncation - ("[^ ]+ (\\([0-9]+\\)) in \\([^ ]+\\)" 2 1) + ("\n[^ \n]+ (\\([0-9]+\\)) in \\([^ \n]+\\)" 2 1) ;; name defined but never used: LinInt in cmap_calc.c(199) - ("in \\([^(]+\\)(\\([0-9]+\\))$" 1 2) + ("in \\([^(\n]+\\)(\\([0-9]+\\))$" 1 2) ;; Ultrix 3.0 f77: ;; fort: Severe: addstf.f, line 82: Missing operator or delimiter symbol @@ -226,7 +226,7 @@ ;; Sun ada (VADS, Solaris): ;; /home3/xdhar/rcds_rc/main.a, line 361, char 6:syntax error: "," inserted - ("\n\\([^, ]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3) + ("\n\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3) ) "Alist that specifies how to match errors in compiler output. Each elt has the form (REGEXP FILE-IDX LINE-IDX [COLUMN-IDX FILE-FORMAT...]) diff -r ebca3d831cea -r 6a378aca36af lisp/packages/func-menu.el --- a/lisp/packages/func-menu.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/packages/func-menu.el Mon Aug 13 09:07:36 2007 +0200 @@ -1,8 +1,8 @@ ;;; func-menu.el --- Jump to a function within a buffer. ;;; ;;; David Hughes -;;; Last modified: David Hughes 2nd May 1996 -;;; Version: 2.43 +;;; Last modified: David Hughes 13th January 1997 +;;; Version: 2.45 ;;; Keywords: tools, c, lisp ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -43,8 +43,8 @@ ;;; addition, the name of the function before point is optionally displayed in ;;; the modeline. ;;; -;;; Support for non X Windows versions of Emacs: -;;; ============================================ +;;; Support for non X Window versions of Emacs: +;;; =========================================== ;;; This package can also be used for non X versions of Emacs. In this case, ;;; only modeline display and completing read input from the minibuffer are ;;; possible. @@ -58,6 +58,15 @@ ;;; Acknowledgements: ;;; ================= ;;; +;;; Fix to fume-function-name-regexp-c +;;; Jonathan Edwards +;;; +;;; Speedup for fume-cc-inside-comment +;;; Peter Pezaris +;;; +;;; Made menu placement more flexible +;;; Bob Weiner +;;; ;;; Fortran90 regexp ;;; John Turner ;;; @@ -65,6 +74,7 @@ ;;; Andy Piper ;;; ;;; Java support +;;; Bob Weiner ;;; Heddy Boubaker ;;; ;;; Patch for fume-rescan-buffer{-trigger} @@ -140,6 +150,7 @@ ;;; Thomas Plass ;;; ;;; Extensions to fume-function-name-regexp-lisp +;;; Vladimir Alexiev ;;; Kari Heinola ;;; Milo A. Chan ;;; Jack Repenning @@ -162,7 +173,7 @@ ;;; Philippe Queinnec ;;; ;;; Assembly support -;;; Bob Weiner +;;; Bob Weiner ;;; ;;; Removal of cl dependencies ;;; Russell Ritchie @@ -202,14 +213,14 @@ ;;;;;;;;;;;;;;;;;;;;;;;; Environment Initialisation ;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defconst fume-version "2.43") +(defconst fume-version "2.45") (defconst fume-developer "David Hughes ") (defun fume-about () (interactive) (sit-for 0) - (message "Func-Menu version %s, ¨ 1996 %s" fume-version fume-developer)) + (message "Func-Menu version %s, © 1996 %s" fume-version fume-developer)) (defconst fume-running-xemacs (string-match "XEmacs\\|Lucid" emacs-version)) @@ -365,11 +376,11 @@ (cond ((fboundp 'add-submenu) (defconst fume-add-submenu 'add-submenu) (defun fume-munge-menu-args (menu-name submenu before) - (list nil (cons menu-name submenu) before))) + (list fume-menu-path (cons menu-name submenu) before))) (t (defconst fume-add-submenu 'add-menu) (defun fume-munge-menu-args (menu-name submenu before) - (list nil menu-name submenu before)))) + (list fume-menu-path menu-name submenu before)))) (defun fume-add-submenu (menu-name submenu before) (apply fume-add-submenu (fume-munge-menu-args menu-name submenu before))) @@ -397,10 +408,16 @@ (defvar fume-buffer-name "*Function List*" "Name of buffer used to list functions when fume-list-functions called") -(fume-defvar-local - fume-menubar-menu-name "Functions" +(defvar fume-menubar-menu-name "Functions" "*Set this to the string you want to appear in the menubar") +;;; Bob Weiner +(defvar fume-menu-path nil + "Menubar menu under which the function menu should be installed. +Nil means install it on the menubar itself. Otherwise, it should be a list +of strings, each string names a successively deeper menu under which the +new menu should be located.") + (defvar fume-menubar-menu-location "Buffers" "*Set this nil if you want the menu to appear last on the menubar. Otherwise set this to the menu you want \"Functions\" to appear in front of.") @@ -520,21 +537,16 @@ ;;; Lisp ;;; -;;; Jack Repenning -;;; Cedric Beust +;;; Vladimir Alexiev (defvar fume-function-name-regexp-lisp (concat - "\\(^(defun+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)" - "\\|" - "\\(^(defsubst+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)" - "\\|" - "\\(^(defmacro+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)" - "\\|" - "\\(^(defadvice+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)" - "\\|" - "\\(^(de+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)" - "\\|" - "\\(^(dmd+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)" + "^[ \t]*" ; Allow whitespace |(or (fboundp 'foo) + ; for the construct | (defun foo () + "(\\(def[^vc][a-z]*\\)" ; Allow (def* except (defvar, (defconst + "\\s-+" ; At least one whitespace + "'?[#:?A-Za-z0-9_+>-]+" ; Allow (defalias 'foo 'bar) + "\\s-*" ; Whitespace + "\\(nil\\|(\\)" ; nil or (arg list ) "Expression to get lisp function names") @@ -543,11 +555,11 @@ ;;; Danny Bar-Dov (defvar fume-function-name-regexp-c (concat - "^[a-zA-Z0-9]+\\s-?" ; type specs; there can be no - "\\([a-zA-Z0-9_*]+\\s-+\\)?" ; more than 3 tokens, right? + "^[a-zA-Z0-9_]+\\s-?" ; type specs; there can be no + "\\([a-zA-Z0-9_*]+\\s-+\\)?" ; more than 3 tokens, right? "\\([a-zA-Z0-9_*]+\\s-+\\)?" - "\\([*&]+\\s-*\\)?" ; pointer - "\\([a-zA-Z0-9_*]+\\)[ \t\n]*(" ; name + "\\([*&]+\\s-*\\)?" ; pointer + "\\([a-zA-Z0-9_*]+\\)[ \t\n]*(" ; name ) "Expression to get C function names") @@ -787,6 +799,7 @@ (defvar fume-function-name-regexp-make "^\\(\\(\\$\\s(\\)?\\(\\w\\|\\.\\)+\\(:sh\\)?\\(\\s)\\)?\\)\\s *\\(::?\\|\\+?=\\)" "Expression to get makefile target names") +(add-hook 'makefile-mode-hook 'fume-add-menubar-entry) ;;; Directory Listings ;;; @@ -819,6 +832,12 @@ "^\\(task\\|function\\|module\\|primitive\\)[ \t]+\\([A-Za-z0-9_+-]*\\)[ \t]*(?" "Expression to get verilog module names") +;;; Idl +;;; +;;; Lubos Pochman +(defvar fume-function-name-regexp-idl + (cons "^\\s *\\([pP][rR][oO]\\|[fF][uU][nN][cC][tT][iI][oO][nN]\\)\\s +\\([A-Za-z][A-Za-z0-9_$]*\\)" 2) + "Expression to get Idl function Names") ;;; Assembly (defvar fume-function-name-regexp-asm @@ -919,6 +938,9 @@ ;; Verilog (verilog-mode . fume-function-name-regexp-verilog) + ;; Idl + (idl-mode . fume-function-name-regexp-idl) + ;; Assembly (asm-mode . fume-function-name-regexp-asm) ) @@ -937,7 +959,11 @@ ;; Search for the function (if (re-search-forward fume-function-name-regexp nil t) (let ((char (progn - (backward-up-list 1) + (if (string-match + "[({[]" + (char-to-string (char-after (1- (point))))) + (backward-char) + (forward-word -1)) (save-excursion (goto-char (scan-sexps (point) 1)) (skip-chars-forward "[ \t\n]") @@ -985,6 +1011,7 @@ (cons (buffer-substring beg end) beg)))) ;;; Specialised routine to get the next C function name in the buffer. +;;; Modified 16/12/96: Jerome Bertorelle ;;; (defun fume-find-next-c-function-name (buffer) "Searches for the next C function in BUFFER." @@ -999,7 +1026,7 @@ (following-char))))) ;; Skip this function name if it is a prototype declaration. (if (eq char ?\;) - (fume-find-next-function-name buffer) + (fume-find-next-c-function-name buffer) (let (beg name) ;; Get the function name and position @@ -1018,63 +1045,44 @@ (format "%s %s" name (buffer-substring beg (point)))))))) - ;; kludge to avoid 'void' in menu - (if (string-match "^void\\s-*" name) - (fume-find-next-function-name buffer) + ;; kludge to avoid 'void' etc in menu + (if (string-match "^void$\\|^if$\\|^switch$\\|^while$" name) + (fume-find-next-c-function-name buffer) (cons name beg))))))) +;;; Peter Pezaris +;;; (defun fume-cc-inside-comment () - (let ((here (point)) - (bol-point (save-excursion (beginning-of-line) (point)))) - (or - (save-excursion (and (re-search-backward "\/\/" bol-point t 1) t)) - (save-excursion - (and - (re-search-backward "\\(/[*]\\)\\|\\([*]/\\)" (point-min) t 1) - (looking-at "/[*]") - (goto-char here) - (or (beginning-of-line 1) t) - (re-search-forward "[ \t]*/?[*][ \t]*" here t 1) - t))))) + (memq (buffer-syntactic-context) '(comment block-comment))) ;;; ;;; ;;; +;;; - speedup, David Hughes 24th November 1996 ;;; (defun fume-match-find-next-function-name (buffer) - "General next function name in BUFFER finder using match. -The regexp is assumed to be a two item list the car of which is the regexp to -use, and the cdr of which is the match position of the function name." + ;; General next function name in BUFFER finder using match. + ;; The regexp is assumed to be a two item list the car of which is the regexp + ;; to use, and the cdr of which is the match position of the function name (set-buffer buffer) - (let ((result nil) - (continue t) - (regexp (car fume-function-name-regexp))) - (while continue - ;; Search for the function - (if (re-search-forward regexp nil t) - (if (fume-cc-inside-comment) - () ; skip spurious finds in comments - (let ((first-token (save-excursion - (re-search-backward regexp nil t) - (prog1 (fume-what-looking-at) - (re-search-forward regexp nil t)))) - (last-char (progn - (backward-up-list 1) - (save-excursion - (goto-char (scan-sexps (point) 1)) - (following-char))))) - ;; Skip function name if it's a prototype or typedef declaration - (if (or (eq last-char ?\;) (string= first-token "typedef")) - nil - (setq result - ;; Get function name and position including scope - (cons (buffer-substring - (match-beginning (cdr fume-function-name-regexp)) - (point)) - (match-beginning (cdr fume-function-name-regexp))) - continue nil)))) - (setq continue nil))) - result)) + (let ((r (car fume-function-name-regexp)) + (p (cdr fume-function-name-regexp))) + (catch 'found + (while (re-search-forward r nil t) + (catch 'skip + (if (fume-cc-inside-comment) (throw 'skip t)) + (save-excursion + (re-search-backward r nil t) + (if (string= "typedef" (fume-what-looking-at)) (throw 'skip t)) + (re-search-forward r nil t)) + (backward-up-list 1) + (save-excursion + (goto-char (scan-sexps (point) 1)) + (if (eq ?\; (following-char)) (throw 'skip t))) ; skip prototypes + (throw + 'found + (cons (buffer-substring (setq p (match-beginning p)) (point)) p)))) + nil))) ;;; Specialised routine to find the next Perl function ;;; @@ -1083,6 +1091,7 @@ (fume-find-next-sexp buffer)) ;;; Specialised routine to find the next Java function +;;; Bob Weiner ;;; Heddy Boubaker ;;; (defun fume-find-next-java-function-name (buffer) @@ -1095,12 +1104,15 @@ (forward-sexp) (if (and (looking-at "[^;(]*{") (not (fume-cc-inside-comment))) - ;; This is a method definition and we're not - ;; in a comment. + ;; This is a method definition and we're not in a comment (let ((str (buffer-substring beg end))) - (or (string-match "if\\|switch\\|catch\\|for\\|while" str) - ;; These constructs look like methods definitions - ;; but are not. + ;; Bob Weiner added exact match + ;; delimiters so function names that happen to contain + ;; any of these terms are not eliminated. The old version + ;; would ignore "notify()" since it contained "if". + (or (string-match "\\`\\(if\\|switch\\|catch\\|for\\|while\\)\\'" + str) + ;; These constructs look like method definitions but are not (cons str beg))) (fume-find-next-java-function-name buffer))))) @@ -1370,8 +1382,20 @@ (end (match-end 2))) (cons (buffer-substring beg end) beg)))) +;;; Specialised routine to get the next idl function in the buffer +;;; +;;; Lubos Pochman +(defun fume-find-next-idl-function-name (buffer) + "Searches for the next idl function in BUFFER." + (set-buffer buffer) + (if (re-search-forward (car fume-function-name-regexp-idl) nil t) + (let ((beg (match-beginning (cdr fume-function-name-regexp-idl))) + (end (match-end (cdr fume-function-name-regexp-idl)))) + (cons (buffer-substring beg end) beg)))) + + ;;; Assembly -;;; Bob Weiner +;;; Bob Weiner ;;; (defun fume-find-next-asm-function-name (buffer) "Searches for the next assembler function in BUFFER." @@ -1417,6 +1441,7 @@ (sgml-mode . fume-find-next-sgml-element-name) (tcl-mode . fume-match-find-next-function-name) (verilog-mode . fume-find-next-verilog-function-name) + (idl-mode . fume-find-next-idl-function-name) ) "The connection between a mode and the defun that finds function names. @@ -1426,12 +1451,10 @@ ;;;;;;;;;;;;;;;;;;;;;;;; General utility functions ;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Routine to refresh the modeline +;;; modeline refresh routine ;;; -(if (fboundp 'redraw-modeline) ; faster built-in method - (defalias 'fume-refresh-modeline 'redraw-modeline) - (defun fume-refresh-modeline () ; use old kludge method - (set-buffer-modified-p (buffer-modified-p)))) +(or (fboundp 'redraw-modeline) + (defun redraw-modeline () (set-buffer-modified-p (buffer-modified-p)))) ;;; Smart mouse positioning ;;; @@ -1464,18 +1487,18 @@ ;;; Routines to add/remove/update function menu from menubar ;;; -(defsubst fume-add-menubar-entry () +(defun fume-add-menubar-entry () (interactive) (save-window-excursion (function-menu t))) -(defsubst fume-remove-menubar-entry () +(defun fume-remove-menubar-entry () (interactive) (cond ((and fume-running-xemacs current-menubar) (delete-menu-item (list fume-menubar-menu-name)) ;; force update of the menubar - (fume-refresh-modeline)))) + (redraw-modeline)))) -(defsubst fume-update-menubar-entry () +(defun fume-update-menubar-entry () "Returns t if menubar was updated. Nil otherwise" (and fume-running-xemacs fume-not-tty @@ -1483,7 +1506,7 @@ (fume-add-menubar-entry) t)) -(defsubst fume-trim-string (string) +(defun fume-trim-string (string) "Returns STRING with leading and trailing whitespace removed." (if (string-match "^[ \t]*" (setq string (format "%s" string))) (setq string (substring string (match-end 0)))) @@ -1493,52 +1516,55 @@ (defvar fume-syntax-table nil) -(defsubst fume-what-looking-at () - (let (name - (orig-syntax-table (copy-syntax-table (syntax-table)))) - (if fume-syntax-table - () - (setq fume-syntax-table (copy-syntax-table)) - (modify-syntax-entry ?: "w" fume-syntax-table)) - (unwind-protect - (progn - (set-syntax-table fume-syntax-table) - (save-excursion - (while (looking-at "\\sw\\|\\s_") (forward-char 1)) - (if (re-search-backward "\\sw\\|\\s_" nil t) - (let ((beg (progn (forward-char 1) (point)))) - (forward-sexp -1) - (while (looking-at "\\s'") (forward-char 1)) - (setq name (buffer-substring beg (point))))))) - (set-syntax-table orig-syntax-table) - name))) +(defun fume-what-looking-at (&optional check-primary-selection-p) + (or (and check-primary-selection-p + primary-selection-extent + (condition-case () + (prog1 (buffer-substring (region-beginning) (region-end)) + (and zmacs-regions (zmacs-deactivate-region) (sit-for 0))) + (error nil))) + (let (name + (orig-syntax-table (copy-syntax-table (syntax-table)))) + (if fume-syntax-table + () + (setq fume-syntax-table (copy-syntax-table)) + (modify-syntax-entry ?: "w" fume-syntax-table)) + (unwind-protect + (progn + (set-syntax-table fume-syntax-table) + (save-excursion + (while (looking-at "\\sw\\|\\s_") (forward-char 1)) + (if (re-search-backward "\\sw\\|\\s_" nil t) + (let ((beg (progn (forward-char 1) (point)))) + (forward-sexp -1) + (while (looking-at "\\s'") (forward-char 1)) + (setq name (buffer-substring beg (point))))))) + (set-syntax-table orig-syntax-table) + name)))) -;;; Find function name that point is in. -;;; The trick is to start from the end... +;;; Find function name that point is in +;;; (trick is to start from the end) ;;; -(defsubst fume-function-before-point () +(defun fume-function-before-point () (if (or fume-modeline-funclist (fume-rescan-buffer) fume-modeline-funclist) - (let (result - (pt (point))) + (let ((p (point))) (save-excursion (catch 'found (mapcar (function - (lambda (p) - (goto-char (cdr p)) + (lambda (x) + (goto-char (cdr x)) (beginning-of-line 1) - (if (>= pt (point)) - (throw 'found (setq result (car p)))))) - fume-modeline-funclist)) - result)))) + (if (>= p (point)) (throw 'found (car x))))) + fume-modeline-funclist) nil))))) ;;; Routines to add a buffer local post command hook ;;; -(defsubst fume-post-command-hook-p (hook) +(defun fume-post-command-hook-p (hook) (memq hook (if fume-use-local-post-command-hook local-post-command-hook post-command-hook))) -(defsubst fume-add-post-command-hook (hook &optional append) +(defun fume-add-post-command-hook (hook &optional append) (or (fume-post-command-hook-p hook) (cond (fume-use-local-post-command-hook (add-hook 'local-post-command-hook hook append)) @@ -1550,7 +1576,7 @@ (make-local-variable 'post-command-hook) (add-hook 'post-command-hook hook append))))) -(defsubst fume-remove-post-command-hook (hook) +(defun fume-remove-post-command-hook (hook) (and (fume-post-command-hook-p hook) (cond (fume-use-local-post-command-hook (remove-hook 'local-post-command-hook hook)) @@ -1561,7 +1587,7 @@ ;;; Routine to install the modeline feature ;;; -(defsubst fume-maybe-install-modeline-feature () +(defun fume-maybe-install-modeline-feature () (cond ((and fume-display-in-modeline-p (fume-set-defaults)) (or fume-modeline-funclist (fume-post-command-hook-p 'fume-tickle-modeline) @@ -1594,8 +1620,8 @@ (cond ((not fume-display-in-modeline-p) (fume-remove-post-command-hook 'fume-tickle-modeline) (fume-add-post-command-hook 'fume-maybe-install-modeline-feature))) - ;; force an update of the mode line - (fume-refresh-modeline)) + ;; force update of the modeline + (redraw-modeline)) (fume-defvar-local fume-modeline-buffer-identification-0 nil "Storage for original modeline-buffer-identification") @@ -1645,18 +1671,18 @@ ;;; Sort function to sort items depending on their function-name ;;; An item looks like (NAME . POSITION). ;;; -(defsubst fume-sort-by-name (item1 item2) +(defun fume-sort-by-name (item1 item2) (or (string-lessp (car item1) (car item2)) (string-equal (car item1) (car item2)))) ;;; Sort function to sort items depending on their position ;;; -(defsubst fume-sort-by-position (item1 item2) +(defun fume-sort-by-position (item1 item2) (<= (cdr item1) (cdr item2))) ;;; Support function to calculate relative position in buffer ;;; -(defsubst fume-relative-position () +(defun fume-relative-position () (let ((pos (point)) (total (buffer-size))) (if (> total 50000) @@ -1668,7 +1694,7 @@ ;;; Split LIST into sublists of max length N ;;; Example (fume-split '(1 2 3 4 5 6 7 8) 3)-> '((1 2 3) (4 5 6) (7 8)) ;;; -(defsubst fume-split (list n) +(defun fume-split (list n) (let ((i 0) result sublist @@ -1782,7 +1808,7 @@ (let ((fume-scanning-message nil)) (fume-rescan-buffer)))))) -(defsubst fume-install-rescan-buffer-trigger () +(defun fume-install-rescan-buffer-trigger () (cond ((not (fume-post-command-hook-p 'fume-rescan-buffer-trigger)) (fume-add-post-command-hook 'fume-rescan-buffer-trigger 'append) ;; Make narrow-to-region tickle func-menu @@ -1864,6 +1890,9 @@ ;; Reset dirty flag (setq fume-funclist-dirty-p nil)) +(defun fume-scan-buffer () + (or fume-funclist (progn (fume-set-defaults) (fume-rescan-buffer)))) + ;;; Routine to position cursor ;;; (defun fume-goto-function (fn pos) @@ -1921,12 +1950,14 @@ ;;; Interface for Key bindings ;;; -(defun function-menu (&optional use-menubar) +(defun function-menu (&optional use-menubar return-only) "Pop up a menu of functions for selection with the mouse. +Jumps to the selected function. A mark is set at the old position, +so you can easily go back with C-u \\[set-mark-command]. With a prefix arg adds the menu to the current menubar. -Jumps to the selected function. A mark is set at the old position, -so you can easily go back with C-u \\[set-mark-command]." +Optional second argument, RETURN-ONLY if non-nil simply returns +the basic menu of functions." (interactive "P") (setq use-menubar @@ -1982,51 +2013,60 @@ (or (> count 1) (setq function-menu-items (cdr (car function-menu-items)))) - (setq function-menu - (` ((,@ function-menu-items) - "----" - ["Display full list of functions" - fume-list-functions t] - [(, (concat "Rescan buffer : " (buffer-name))) - (fume-rescan-buffer (, (null use-menubar))) t] - "----" - ["Toggle modeline display" - fume-toggle-modeline-display t] - ["Toggle buffer auto rescanning" - fume-toggle-auto-rescanning t] - ["About Func-Menu" fume-about t]))) + (if return-only + nil + (setq function-menu + (` ((,@ function-menu-items) + "----" + ["Display full list of functions" + fume-list-functions t] + [(, (concat "Rescan buffer : " (buffer-name))) + (fume-rescan-buffer (, (null use-menubar))) t] + "----" + ["Toggle modeline display" + fume-toggle-modeline-display t] + ["Toggle buffer auto rescanning" + fume-toggle-auto-rescanning t] + ["About Func-Menu" fume-about t]))) - (cond (use-menubar - (fume-remove-menubar-entry) - (set-buffer-menubar (copy-sequence current-menubar)) - (fume-add-submenu - fume-menubar-menu-name - (` ((,@ function-menu) - "----" - ["Remove Function Menu from menubar" - fume-remove-menubar-entry t])) - fume-menubar-menu-location)) + (cond (use-menubar + (fume-remove-menubar-entry) + (set-buffer-menubar (copy-sequence current-menubar)) + (fume-add-submenu + fume-menubar-menu-name + (` ((,@ function-menu) + "----" + ["Remove Function Menu from menubar" + fume-remove-menubar-entry t])) + fume-menubar-menu-location)) - ((and fume-not-tty ; trap tty segmentation faults... - (not (popup-menu-up-p))) - (or (fume-update-menubar-entry) - (setq function-menu - (cons - ["Put Function Menu into menubar" - (function-menu t) t] - (cons "----" function-menu)))) + ((and fume-not-tty ; trap tty segmentation faults... + (not (popup-menu-up-p))) + (or (fume-update-menubar-entry) + (setq function-menu + (cons + ["Put Function Menu into menubar" + (function-menu t) t] + (cons "----" function-menu)))) - (if fume-auto-position-popup - (fume-set-mouse-position)) + (if fume-auto-position-popup + (fume-set-mouse-position)) - (popup-menu (cons "Functions" function-menu))))))))) + (popup-menu + (cons fume-menubar-menu-name function-menu))))) + + ;; Return basic function menu for display by another function + function-menu-items))))) (defun fume-mouse-function-goto (event) "Goto function clicked on or prompt in minibuffer (with completion)." (interactive "@e") - (goto-char (event-point event)) - (let ((fume-no-prompt-on-valid-default t)) - (fume-prompt-function-goto))) + (let ((orig-pos (point))) + (goto-char (event-point event)) + (let ((fume-no-prompt-on-valid-default t)) + (fume-prompt-function-goto)) + (or (= orig-pos (point)) + (push-mark orig-pos (null fume-scanning-message))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;; Keyboard access to func-menu for tty users ;;;;;;;;;;;;;; @@ -2045,34 +2085,28 @@ "Goto function prompted for in minibuffer (with completion). With prefix arg, jumps to function in a different window." (interactive "P") - (and (interactive-p) current-prefix-arg (setq other-window-p t)) - (let* ((default-name (fume-what-looking-at)) + (let* ((default-name (fume-what-looking-at t)) (OrigBuffer (current-buffer)) - (TargetBuffer - (if (eq major-mode 'fume-list-mode) fume-list-srcbuffer OrigBuffer)) - (fume-no-prompt-on-valid-default - (or fume-no-prompt-on-valid-default - (eq major-mode 'fume-list-mode)))) + (flistMode (eq major-mode 'fume-list-mode)) + (no-prompt (or flistMode fume-no-prompt-on-valid-default)) + (TargetBuffer (if flistMode fume-list-srcbuffer OrigBuffer))) (switch-to-buffer TargetBuffer) - ;; Create funclist and set defaults - (cond ((null fume-funclist) - (fume-set-defaults) - (fume-rescan-buffer))) + (fume-scan-buffer) ;; Create funclist and set defaults if required (let* (;; verify default-name is a valid function name (default-exists-p (assoc default-name fume-funclist)) ;; Prompt for function name in minibuffer, unless there is a valid ;; function name at point & fume-no-prompt-on-valid-default set to t (function-name - (if (and default-exists-p - fume-no-prompt-on-valid-default) + (if (and default-exists-p no-prompt) "" - (completing-read - (format "Goto function%s%s: " - (if other-window-p " other window" "") - (if default-exists-p - (concat " (" default-name ")") - "")) - fume-funclist nil t))) + (let ((this-command last-command)) ; preserve last-command + (completing-read + (format "Goto function%s%s: " + (if other-window-p " other window" "") + (if default-exists-p + (concat " (" default-name ")") + "")) + fume-funclist nil t)))) ;; Use default function name if just RET was pressed (function-name (if (and default-exists-p (string= "" function-name)) default-name @@ -2082,7 +2116,10 @@ (cond ((not (string= "" function-name)) (if other-window-p (cond ((prog1 (one-window-p) - (switch-to-buffer-other-window TargetBuffer)) + (if (not (windowp other-window-p)) + (switch-to-buffer-other-window TargetBuffer) + (select-window other-window-p) + (switch-to-buffer TargetBuffer))) (other-window 1) (shrink-window-if-larger-than-buffer) (other-window 1))) @@ -2097,26 +2134,24 @@ (defun fume-prompt-function-goto-other-window () (interactive) - (let ((current-prefix-arg 1)) - (call-interactively 'fume-prompt-function-goto))) + (fume-prompt-function-goto t)) -(defun fume-list-functions-show-fn-other-window () +(defun fume-list-functions-show-fn-other-window (&optional window) (interactive) (beginning-of-line) (select-window - (prog1 (selected-window) - (fume-prompt-function-goto-other-window)))) + (prog1 (selected-window) (fume-prompt-function-goto (or window t))))) -(defun fume-list-functions-show-prev-fn-other-window () +(defun fume-list-functions-show-prev-fn-other-window (&optional window) (interactive) (forward-line -1) - (fume-list-functions-show-fn-other-window)) + (fume-list-functions-show-fn-other-window window)) -(defun fume-list-functions-show-next-fn-other-window () +(defun fume-list-functions-show-next-fn-other-window (&optional window) (interactive) (forward-line 1) (beginning-of-line) - (fume-list-functions-show-fn-other-window)) + (fume-list-functions-show-fn-other-window window)) (defun fume-list-functions-help () (interactive) @@ -2185,6 +2220,7 @@ (defun fume-list-functions (&optional this-window) "Creates a temporary buffer listing functions found in the current buffer" (interactive "P") + (fume-scan-buffer) ;; Create funclist and set defaults if required (let ((func-near-point (format "^%s$" (fume-function-before-point)))) (cond ((or fume-function-name-regexp (fume-maybe-install-modeline-feature)) (save-excursion @@ -2229,3 +2265,5 @@ (error "Func-Menu is not operative in this buffer"))))) (provide 'func-menu) + +;;; end of file diff -r ebca3d831cea -r 6a378aca36af lisp/packages/hyper-apropos.el --- a/lisp/packages/hyper-apropos.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/packages/hyper-apropos.el Mon Aug 13 09:07:36 2007 +0200 @@ -336,8 +336,9 @@ buffer-read-only t truncate-lines t hypropos-last-regexp regexp - modeline-buffer-identification (concat "Hyper Apropos: " - "\"" regexp "\"")) + modeline-buffer-identification + (list (cons modeline-buffer-id-left-extent "Hyper Apropos: ") + (cons modeline-buffer-id-right-extent (concat "\"" regexp "\"")))) (setq mode-motion-hook 'mode-motion-highlight-line) (use-local-map hypropos-map) (run-hooks 'hyper-apropos-mode-hook)) diff -r ebca3d831cea -r 6a378aca36af lisp/packages/info.el --- a/lisp/packages/info.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/packages/info.el Mon Aug 13 09:07:36 2007 +0200 @@ -834,17 +834,19 @@ (defun Info-set-mode-line () (setq modeline-buffer-identification - (concat - "Info: (" - (if Info-current-file - (let ((name (file-name-nondirectory Info-current-file))) - (if (string-match "\\.info$" name) - (substring name 0 -5) - name)) - "") - ")" - (or Info-current-node "")))) - + (list (cons modeline-buffer-id-left-extent "Info: ") + (cons modeline-buffer-id-right-extent + (concat + "(" + (if Info-current-file + (let ((name (file-name-nondirectory Info-current-file))) + (if (string-match "\\.info$" name) + (substring name 0 -5) + name)) + "") + ")" + (or Info-current-node "")))))) + ;; Go to an info node specified with a filename-and-nodename string ;; of the sort that is found in pointers in nodes. diff -r ebca3d831cea -r 6a378aca36af lisp/packages/man.el --- a/lisp/packages/man.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/packages/man.el Mon Aug 13 09:07:36 2007 +0200 @@ -610,7 +610,8 @@ ;; overran by a couple of chars. (setq truncate-lines t) ;; turn off horizontal scrollbars in this buffer - (set-specifier scrollbar-height (cons (current-buffer) 0)) + (when (featurep 'scrollbar) + (set-specifier scrollbar-height (cons (current-buffer) 0))) (run-hooks 'Manual-mode-hook)) (defun Manual-last-page () diff -r ebca3d831cea -r 6a378aca36af lisp/packages/mode-motion+.el --- a/lisp/packages/mode-motion+.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/packages/mode-motion+.el Mon Aug 13 09:07:36 2007 +0200 @@ -1134,8 +1134,9 @@ (progn ;; (message "%s" (event-window event)) (move-to-window-line - (if (< emacs-minor-version 12) - (- (event-y event) + (if (and (= emacs-major-version 19) + (< emacs-minor-version 12)) + (- (event-y event) (nth 1 (window-edges window))) (event-y event))) (beginning-of-line) diff -r ebca3d831cea -r 6a378aca36af lisp/packages/ps-print.el --- a/lisp/packages/ps-print.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/packages/ps-print.el Mon Aug 13 09:07:36 2007 +0200 @@ -2,51 +2,160 @@ ;; Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc. -;; Author: Jim Thompson -;; Maintainer: duthen@cegelec-red.fr (Jacques Duthen Prestataire) -;; Keywords: print, PostScript - -;; 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 +;; Author: Jim Thompson (was ) +;; Maintainer: Jacques Duthen +;; Keywords: print, PostScript +;; Time-stamp: <97/01/17 16:41:00 duthen> +;; Version: 3.05 + +(defconst ps-print-version "3.05" + "ps-print.el, v 3.05 <97/01/17 duthen> + +Jack's last change version -- this file may have been edited as part of +Emacs without changes to the version number. When reporting bugs, +please also report the version of Emacs, if any, that ps-print was +distributed with. + +Please send all bug fixes and enhancements to + Jacques Duthen . +") + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. -;; XEmacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. ;; LCD Archive Entry: ;; ps-print|James C. Thompson|thompson@wg2.waii.com| ;; Jim's Pretty-Good PostScript Generator for Emacs 19 (ps-print)| ;; 26-Feb-1994|2.8|~/packages/ps-print.el| +;; 3.05 [jack] <97/01/16 duthen> +;; Ben Wing took ps-print.el from the official 19.34 +;; GNU distribution: +;; -rw-rw-r-- 1 duthen 69315 Jul 22 1996 ps-print.el +;; He patched it for XEmacs. +;; Steven L Baur sent me this version which has +;; 26 diffs with 19.34. +;; I merge these 26 diffs into my 3.04 version. + +;; `ps-paper-type': ###autoload. +;; `ps-print-color-p' `ps-color-values': Replace pixel-components by +;; color-instance-rgb-components for XEmacs. +;; `ps-color-device': New function to dynamically test the device +;; color capability, added where ps-print-color-p is tested. +;; `ps-xemacs-face-kind-p': Fixed. +;; `ps-do-despool': Permit dynamic evaluation at print time of +;; ps-lpr-switches. +;; `ps-eval-switch' `ps-flatten-list' `ps-flatten-list-1': New for +;; the previous feature. +;; `ps-gnus-print-article-from-summary': Updated for Gnus 5. + + +;; 3.04 [jack] after [simon] Oct 8, 1996 Simon Marshall +;; `ps-print-version': +;; Fix value. +;; `cl' `lisp-float-type': +;; Require them. +;; `ps-number-of-columns' `ps-*-font-size': +;; Try to select defaults better suited when `ps-landscape-mode' is non-nil. +;; `ps-*-faces': +;; Change default for Font Lock mode faces when `ps-print-color-p' is nil. +;; `ps-right-header': +;; Replace `time-stamp-yy/mm/dd' by `time-stamp-mon-dd-yyyy'. +;; `ps-end-file' `ps-begin-page': +;; Fix bug in page count for Ghostview. +;; `ps-generate-postscript-with-faces': +;; Replace `ps-sorter' by `car-less-than-car'. +;; `ps-plot' `ps-generate': +;; Replace `%d' by `%3d'. + +;; 3.03 [jack] Sept 27, 1996 Jacques Duthen +;; Merge 31 diffs between 19.29 and 19.34 + +;; 3.02 [jack] June 26, 1996 Jacques Duthen +;; Add new page dimensions to `ps-page-dimensions-database' for `paper-type' +;; Improve landscape mode `ps-landscape-mode' and multiple columns +;; printing `ps-number-of-columns': +;; The text and the margins are no more scaled. +;; Simplify the semantics of `ps-inter-column' (space between columns). +;; Add error checking for negative `ps-print-width' and `ps-print-height'. +;; Change the semantics of `ps-top-margin' which is now the TOP MARGIN, +;; and add `ps-header-offset' instead of having `ps-top-margin' split in 2. +;; Add `ps-header-font-family', `ps-header-font-size' and +;; `ps-header-title-font-size' to control the header. +;; Add `ps-header-line-pad'. +;; Change the semantics of `ps-font-info-database' to have symbolic +;; font families. +;; Add new fonts to `ps-font-info-database': `Courier' `Helvetica' +;; `Times' `Palatino' `Helvetica-Narrow' `NewCenturySchlbk' +;; Make public `ps-font-family' and `ps-font-size' so that the user +;; can directly control the text font and size without loading ps-print. +;; Add error checking for unknown font families and a message giving +;; the exhaustive list of available font families. +;; Document how to install a new font family. +;; Add `/ReportAllFontInfo' to get all the font families of the printer. +;; Add the possibility to make `mixed' font families. +;; Add `ps-setup' to get the current setup. +;; Add tools `ps-line-lengths' `ps-nb-pages-buffer' `ps-nb-pages-region' +;; to help choose the font size. +;; Split `ps-print-prologue' in two to insert info from header fonts +;; Replace indexes by macro `ps-page-dimensions-get-width' +;; to get access to the dimensions list. +;; Add `ps-select-font' inside `ps-get-page-dimensions'. +;; Fix the "clumsy" `ps-page-height' management. +;; Move `ps-get-page-dimensions' to the beginning of `ps-begin-file' +;; to get early error checking. +;; Add sample setup `ps-jack-setup'. +;; +;; Rewrite a lot of postscript code and add comments inside it +;; (maybe they should not (or optionally) be included in the generated +;; Postscript). +;; Translate the origin to (lm, bm) to simplify the other moves. +;; Fix bug in `/HeaderOffset' with `/PrintStartY'. +;; Fix bug in `/SetHeaderLines'. +;; Change `/ReportFontInfo' for use by `/ReportAllFontInfo'. + +;; 3.01 [jack] June 4, 1996 Jacques Duthen +;; Manage float value for every variable representing a size. +;; Add `ps-font-info-database' `ps-inter-column' + +;; 3.00 [jack] May 17, 1996 Jacques Duthen +;; based on 2.8 Jim's Pretty-Good version: +;; Add `ps-landscape-mode' and `ps-number-of-columns' +;; for dumb multi-column landscape mode. + ;; Baseline-version: 2.8. (Jim's last change version -- this ;; file may have been edited as part of Emacs without changes to the ;; version number. When reporting bugs, please also report the ;; version of Emacs, if any, that ps-print was distributed with.) -;;; Synched up with: FSF 19.34. - ;;; Commentary: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; About ps-print ;; -------------- +;; ;; This package provides printing of Emacs buffers on PostScript ;; printers; the buffer's bold and italic text attributes are ;; preserved in the printer output. Ps-print is intended for use with ;; Emacs 19 or Lucid Emacs, together with a fontifying package such as ;; font-lock or hilit. ;; +;; ;; Using ps-print ;; -------------- ;; @@ -78,7 +187,7 @@ ;; spool - The PostScript image is saved temporarily in an ;; Emacs buffer. Many images may be spooled locally ;; before printing them. To send the spooled images -;; to the printer, use the command ps-despool. +;; to the printer, use the command `ps-despool'. ;; ;; The spooling mechanism was designed for printing lots of small ;; files (mail messages or netnews articles) to save paper that would @@ -86,7 +195,7 @@ ;; your output at the printer (it's easier to pick up one 50-page ;; printout than to find 50 single-page printouts). ;; -;; Ps-print has a hook in the kill-emacs-hooks so that you won't +;; Ps-print has a hook in the `kill-emacs-hooks' so that you won't ;; accidentally quit from Emacs while you have unprinted PostScript ;; waiting in the spool buffer. If you do attempt to exit with ;; spooled PostScript, you'll be asked if you want to print it, and if @@ -123,6 +232,7 @@ ;; ;; ;; Invoking Ps-Print +;; ----------------- ;; ;; To print your buffer, type ;; @@ -138,16 +248,16 @@ ;; to the printer; you will be prompted for the name of the file to ;; save the image to. The prefix argument is ignored by the commands ;; that spool their images, but you may save the spooled images to a -;; file by giving a prefix argument to ps-despool: +;; file by giving a prefix argument to `ps-despool': ;; ;; C-u M-x ps-despool ;; -;; When invoked this way, ps-despool will prompt you for the name of +;; When invoked this way, `ps-despool' will prompt you for the name of ;; the file to save to. ;; -;; Any of the ps-print- commands can be bound to keys; I recommend -;; binding ps-spool-buffer-with-faces, ps-spool-region-with-faces, and -;; ps-despool. Here are the bindings I use on my Sun 4 keyboard: +;; Any of the `ps-print-' commands can be bound to keys; I recommend +;; binding `ps-spool-buffer-with-faces', `ps-spool-region-with-faces', +;; and `ps-despool'. Here are the bindings I use on my Sun 4 keyboard: ;; ;; (global-set-key 'f22 'ps-spool-buffer-with-faces) ;f22 is prsc ;; (global-set-key '(shift f22) 'ps-spool-region-with-faces) @@ -155,111 +265,153 @@ ;; ;; ;; The Printer Interface +;; --------------------- ;; -;; The variables ps-lpr-command and ps-lpr-switches determine what +;; The variables `ps-lpr-command' and `ps-lpr-switches' determine what ;; command is used to send the PostScript images to the printer, and -;; what arguments to give the command. These are analogous to lpr- -;; command and lpr-switches. +;; what arguments to give the command. These are analogous to +;; `lpr-command' and `lpr-switches'. ;; -;; NOTE: ps-lpr-command and ps-lpr-switches take their initial values -;; from the variables lpr-command and lpr-switches. If you have -;; lpr-command set to invoke a pretty-printer such as enscript, -;; then ps-print won't work properly. ps-lpr-command must name +;; Make sure that they contain appropriate values for your system; +;; see the usage notes below and the documentation of these variables. +;; +;; NOTE: `ps-lpr-command' and `ps-lpr-switches' take their initial values +;; from the variables `lpr-command' and `lpr-switches'. If you have +;; `lpr-command' set to invoke a pretty-printer such as `enscript', +;; then ps-print won't work properly. `ps-lpr-command' must name ;; a program that does not format the files it prints. ;; ;; -;; How Ps-Print Deals With Fonts -;; -;; The ps-print-*-with-faces commands attempt to determine which faces -;; should be printed in bold or italic, but their guesses aren't -;; always right. For example, you might want to map colors into faces -;; so that blue faces print in bold, and red faces in italic. +;; The Page Layout +;; --------------- ;; -;; It is possible to force ps-print to consider specific faces bold or -;; italic, no matter what font they are displayed in, by setting the -;; variables ps-bold-faces and ps-italic-faces. These variables -;; contain lists of faces that ps-print should consider bold or -;; italic; to set them, put code like the following into your .emacs -;; file: +;; All dimensions are floats in PostScript points. +;; 1 inch == 2.54 cm == 72 points +;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points ;; -;; (setq ps-bold-faces '(my-blue-face)) -;; (setq ps-italic-faces '(my-red-face)) -;; -;; Faces like bold-italic that are both bold and italic should go in -;; *both* lists. +;; The variable `ps-paper-type' determines the size of paper ps-print +;; formats for; it should contain one of the symbols: +;; `a4' `a3' `letter' `legal' `letter-small' `tabloid' +;; `ledger' `statement' `executive' `a4small' `b4' `b5' ;; -;; Ps-print does not attempt to guess the sizes of fonts; all text is -;; rendered using the Courier font family, in 10 point size. To -;; change the font family, change the variables ps-font, ps-font-bold, -;; ps-font-italic, and ps-font-bold-italic; fixed-pitch fonts work -;; best, but are not required. To change the font size, change the -;; variable ps-font-size. -;; -;; If you change the font family or size, you MUST also change the -;; variables ps-line-height, ps-avg-char-width, and ps-space-width, or -;; ps-print cannot correctly place line and page breaks. +;; The variable `ps-landscape-mode' determines the orientation +;; of the printing on the page: +;; nil means `portrait' mode, non-nil means `landscape' mode. +;; There is no oblique mode yet, though this is easy to do in ps. + +;; In landscape mode, the text is NOT scaled: you may print 70 lines +;; in portrait mode and only 50 lignes in landscape mode. +;; The margins represent margins in the printed paper: +;; the top margin is the margin between the top of the page +;; and the printed header, whatever the orientation is. ;; -;; Ps-print keeps internal lists of which fonts are bold and which are -;; italic; these lists are built the first time you invoke ps-print. -;; For the sake of efficiency, the lists are built only once; the same -;; lists are referred in later invocations of ps-print. -;; -;; Because these lists are built only once, it's possible for them to -;; get out of sync, if a face changes, or if new faces are added. To -;; get the lists back in sync, you can set the variable -;; ps-build-face-reference to t, and the lists will be rebuilt the -;; next time ps-print is invoked. +;; The variable `ps-number-of-columns' determines the number of columns +;; both in landscape and portrait mode. +;; You can use: +;; - (the standard) one column portrait mode +;; - (my favorite) two columns landscape mode (which spares trees) +;; but also +;; - one column landscape mode for files with very long lines. +;; - multi-column portrait or landscape mode ;; ;; -;; How Ps-Print Deals With Color +;; Horizontal layout +;; ----------------- +;; +;; The horizontal layout is determined by the variables +;; `ps-left-margin' `ps-inter-column' `ps-right-margin' +;; as follows: +;; +;; ------------------------------------------ +;; | | | | | | | | +;; | lm | text | ic | text | ic | text | rm | +;; | | | | | | | | +;; ------------------------------------------ +;; +;; If `ps-number-of-columns' is 1, `ps-inter-column' is not relevant. +;; Usually, lm = rm > 0 and ic = lm +;; If (ic < 0), the text of adjacent columns can overlap. +;; +;; +;; Vertical layout +;; --------------- ;; -;; Ps-print detects faces with foreground and background colors -;; defined and embeds color information in the PostScript image. The -;; default foreground and background colors are defined by the -;; variables ps-default-fg and ps-default-bg. On black-and-white -;; printers, colors are displayed in grayscale. To turn off color -;; output, set ps-print-color-p to nil. +;; The vertical layout is determined by the variables +;; `ps-bottom-margin' `ps-top-margin' `ps-header-offset' +;; as follows: +;; +;; |--------| |--------| +;; | tm | | tm | +;; |--------| |--------| +;; | header | | | +;; |--------| | | +;; | ho | | | +;; |--------| or | text | +;; | | | | +;; | text | | | +;; | | | | +;; |--------| |--------| +;; | bm | | bm | +;; |--------| |--------| +;; +;; If `ps-print-header' is nil, `ps-header-offset' is not relevant. +;; The margins represent margins in the printed paper: +;; the top margin is the margin between the top of the page +;; and the printed header, whatever the orientation is. ;; ;; ;; Headers +;; ------- ;; -;; Ps-print can print headers at the top of each page; the default +;; Ps-print can print headers at the top of each column; the default ;; headers contain the following four items: on the left, the name of ;; the buffer and, if the buffer is visiting a file, the file's -;; directory; on the right, the page number and date of printing. The -;; default headers look something like this: +;; directory; on the right, the page number and date of printing. +;; The default headers look something like this: ;; ;; ps-print.el 1/21 ;; /home/jct/emacs-lisp/ps/new 94/12/31 ;; ;; When printing on duplex printers, left and right are reversed so -;; that the page numbers are toward the outside. +;; that the page numbers are toward the outside (cf. `ps-spool-duplex'). +;; +;; Headers are configurable: +;; To turn them off completely, set `ps-print-header' to nil. +;; To turn off the header's gaudy framing box, +;; set `ps-print-header-frame' to nil. ;; -;; Headers are configurable. To turn them off completely, set -;; ps-print-header to nil. To turn off the header's gaudy framing -;; box, set ps-print-header-frame to nil. Page numbers are printed in -;; "n/m" format, indicating page n of m pages; to omit the total page -;; count and just print the page number, set ps-show-n-of-n to nil. +;; The font family and size of text in the header are determined +;; by the variables `ps-header-font-family', `ps-header-font-size' and +;; `ps-header-title-font-size' (see below). +;; +;; The variable `ps-header-line-pad' determines the portion of a header +;; title line height to insert between the header frame and the text +;; it contains, both in the vertical and horizontal directions: +;; .5 means half a line. + +;; Page numbers are printed in `n/m' format, indicating page n of m pages; +;; to omit the total page count and just print the page number, +;; set `ps-show-n-of-n' to nil. ;; ;; The amount of information in the header can be changed by changing -;; the number of lines. To show less, set ps-header-lines to 1, and +;; the number of lines. To show less, set `ps-header-lines' to 1, and ;; the header will show only the buffer name and page number. To show -;; more, set ps-header-lines to 3, and the header will show the time of +;; more, set `ps-header-lines' to 3, and the header will show the time of ;; printing below the date. ;; ;; To change the content of the headers, change the variables -;; ps-left-header and ps-right-header. These variables are lists, -;; specifying top-to-bottom the text to display on the left or right -;; side of the header. Each element of the list should be a string or -;; a symbol. Strings are inserted directly into the PostScript -;; arrays, and should contain the PostScript string delimiters '(' and -;; ')'. +;; `ps-left-header' and `ps-right-header'. +;; These variables are lists, specifying top-to-bottom the text +;; to display on the left or right side of the header. +;; Each element of the list should be a string or a symbol. +;; Strings are inserted directly into the PostScript arrays, +;; and should contain the PostScript string delimiters '(' and ')'. ;; ;; Symbols in the header format lists can either represent functions ;; or variables. Functions are called, and should return a string to ;; show in the header. Variables should contain strings to display in ;; the header. In either case, function or variable, the PostScript -;; string delimeters are added by ps-print, and should not be part of +;; string delimiters are added by ps-print, and should not be part of ;; the returned value. ;; ;; Here's an example: say we want the left header to display the text @@ -277,56 +429,217 @@ ;; ;; (setq larry-var "Larry") ;; -;; and a literal for "Curly". Here's how ps-left-header should be +;; and a literal for "Curly". Here's how `ps-left-header' should be ;; set: ;; ;; (setq ps-left-header (list 'moe-func 'larry-var "(Curly)")) ;; ;; Note that Curly has the PostScript string delimiters inside his -;; quotes -- those aren't misplaced lisp delimiters! Without them, -;; PostScript would attempt to call the undefined function Curly, -;; which would result in a PostScript error. Since most printers -;; don't report PostScript errors except by aborting the print job, -;; this kind of error can be hard to track down. Consider yourself -;; warned. +;; quotes -- those aren't misplaced lisp delimiters! +;; +;; Without them, PostScript would attempt to call the undefined +;; function Curly, which would result in a PostScript error. +;; +;; Since most printers don't report PostScript errors except by +;; aborting the print job, this kind of error can be hard to track down. +;; +;; Consider yourself warned! ;; ;; ;; Duplex Printers +;; --------------- ;; ;; If you have a duplex-capable printer (one that prints both sides of -;; the paper), set ps-spool-duplex to t. Ps-print will insert blank -;; pages to make sure each buffer starts on the correct side of the -;; paper. Don't forget to set ps-lpr-switches to select duplex -;; printing for your printer. +;; the paper), set `ps-spool-duplex' to t. +;; Ps-print will insert blank pages to make sure each buffer starts +;; on the correct side of the paper. +;; Don't forget to set `ps-lpr-switches' to select duplex printing +;; for your printer. +;; +;; +;; Font managing +;; ------------- +;; +;; Ps-print now knows rather precisely some fonts: +;; the variable `ps-font-info-database' contains information +;; for a list of font families (currently mainly `Courier' `Helvetica' +;; `Times' `Palatino' `Helvetica-Narrow' `NewCenturySchlbk'). +;; Each font family contains the font names for standard, bold, italic +;; and bold-italic characters, a reference size (usually 10) and the +;; corresponding line height, width of a space and average character width. ;; +;; The variable `ps-font-family' determines which font family +;; is to be used for ordinary text. +;; If its value does not correspond to a known font family, +;; an error message is printed into the `*Messages*' buffer, +;; which lists the currently available font families. ;; -;; Paper Size +;; The variable `ps-font-size' determines the size (in points) +;; of the font for ordinary text, when generating Postscript. +;; Its value is a float. +;; +;; Similarly, the variable `ps-header-font-family' determines +;; which font family is to be used for text in the header. +;; The variable `ps-header-font-size' determines the font size, +;; in points, for text in the header. +;; The variable `ps-header-title-font-size' determines the font size, +;; in points, for the top line of text in the header. +;; +;; +;; Adding a new font family +;; ------------------------ +;; +;; To use a new font family, you MUST first teach ps-print +;; this font, ie add its information to `ps-font-info-database', +;; otherwise ps-print cannot correctly place line and page breaks. +;; +;; For example, assuming `Helvetica' is unkown, +;; you first need to do the following ONLY ONCE: +;; +;; - create a new buffer +;; - generate the PostScript image to a file (C-u M-x ps-print-buffer) +;; - open this file and find the line: +;; `% 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage' +;; - delete the leading `%' (which is the Postscript comment character) +;; - replace in this line `Courier' by the new font (say `Helvetica') +;; to get the line: +;; `3 cm 20 cm moveto 10 /Helvetica ReportFontInfo showpage' +;; - send this file to the printer (or to ghostscript). +;; You should read the following on the output page: +;; +;; For Helvetica 10 point, the line height is 11.56, the space width is 2.78 +;; and a crude estimate of average character width is 5.09243 +;; +;; - Add these values to the `ps-font-info-database': +;; (setq ps-font-info-database +;; (append +;; '((Helvetica ; the family name +;; "Helvetica" "Helvetica-Bold" "Helvetica-Oblique" "Helvetica-BoldOblique" +;; 10.0 11.56 2.78 5.09243)) +;; ps-font-info-database)) +;; - Now you can use this font family with any size: +;; (setq ps-font-family 'Helvetica) +;; - if you want to use this family in another emacs session, you must +;; put into your `~/.emacs': +;; (require 'ps-print) +;; (setq ps-font-info-database (append ...))) +;; if you don't want to load ps-print, you have to copy the whole value: +;; (setq ps-font-info-database '( )) +;; or, if you can wait until the `ps-print-hook' is implemented, do: +;; (add-hook 'ps-print-hook '(setq ps-font-info-database (append ...))) +;; This does not work yet, since there is no `ps-print-hook' yet. ;; -;; The variable ps-paper-type determines the size of paper ps-print -;; formats for; it should contain one of the symbols ps-letter, -;; ps-legal, or ps-a4. The default is ps-letter. +;; You can create new `mixed' font families like: +;; (my-mixed-family +;; "Courier-Bold" "Helvetica" +;; "Zapf-Chancery-MediumItalic" "NewCenturySchlbk-BoldItalic" +;; 10.0 10.55 6.0 6.0) +;; Now you can use your new font family with any size: +;; (setq ps-font-family 'my-mixed-family) +;; +;; You can get information on all the fonts resident in YOUR printer +;; by uncommenting the line: +;; % 3 cm 20 cm moveto ReportAllFontInfo showpage +;; +;; The postscript file should be sent to YOUR postscript printer. +;; If you send it to ghostscript or to another postscript printer, +;; you may get slightly different results. +;; Anyway, as ghostscript fonts are autoload, you won't get +;; much font info. +;; +;; +;; How Ps-Print Deals With Faces +;; ----------------------------- +;; +;; The ps-print-*-with-faces commands attempt to determine which faces +;; should be printed in bold or italic, but their guesses aren't +;; always right. For example, you might want to map colors into faces +;; so that blue faces print in bold, and red faces in italic. +;; +;; It is possible to force ps-print to consider specific faces bold or +;; italic, no matter what font they are displayed in, by setting the +;; variables `ps-bold-faces' and `ps-italic-faces'. These variables +;; contain lists of faces that ps-print should consider bold or +;; italic; to set them, put code like the following into your .emacs +;; file: +;; +;; (setq ps-bold-faces '(my-blue-face)) +;; (setq ps-italic-faces '(my-red-face)) +;; +;; Faces like bold-italic that are both bold and italic should go in +;; *both* lists. ;; -;; Make sure that the variables ps-lpr-command and ps-lpr-switches -;; contain appropriate values for your system; see the usage notes -;; below and the documentation of these variables. -;; +;; Ps-print keeps internal lists of which fonts are bold and which are +;; italic; these lists are built the first time you invoke ps-print. +;; For the sake of efficiency, the lists are built only once; the same +;; lists are referred in later invocations of ps-print. +;; +;; Because these lists are built only once, it's possible for them to +;; get out of sync, if a face changes, or if new faces are added. To +;; get the lists back in sync, you can set the variable +;; `ps-build-face-reference' to t, and the lists will be rebuilt the +;; next time ps-print is invoked. +;; +;; +;; How Ps-Print Deals With Color +;; ----------------------------- +;; +;; Ps-print detects faces with foreground and background colors +;; defined and embeds color information in the PostScript image. +;; The default foreground and background colors are defined by the +;; variables `ps-default-fg' and `ps-default-bg'. +;; On black-and-white printers, colors are displayed in grayscale. +;; To turn off color output, set `ps-print-color-p' to nil. +;; +;; +;; Utilities +;; --------- +;; +;; Some tools are provided to help you customize your font setup. +;; +;; `ps-setup' returns (some part of) the current setup. +;; +;; To avoid wrapping too many lines, you may want to adjust the +;; left and right margins and the font size. On UN*X systems, do: +;; pr -t file | awk '{printf "%3d %s\n", length($0), $0}' | sort -r | head +;; to determine the longest lines of your file. +;; Then, the command `ps-line-lengths' will give you the correspondance +;; between a line length (number of characters) and the maximum font +;; size which doesn't wrap such a line with the current ps-print setup. +;; +;; The commands `ps-nb-pages-buffer' and `ps-nb-pages-region' display +;; the correspondance between a number of pages and the maximum font +;; size which allow the number of lines of the current buffer or of +;; its current region to fit in this number of pages. +;; Note: line folding is not taken into account in this process +;; and could change the results. +;; +;; ;; New since version 1.5 ;; --------------------- +;; ;; Color output capability. -;; ;; Automatic detection of font attributes (bold, italic). +;; Configurable headers with page numbers. +;; Slightly faster. +;; Support for different paper sizes. +;; Better conformance to PostScript Document Structure Conventions. ;; -;; Configurable headers with page numbers. ;; -;; Slightly faster. +;; New since version 2.8 +;; --------------------- +;; +;; [jack] 960517 Jacques Duthen ;; -;; Support for different paper sizes. -;; -;; Better conformance to PostScript Document Structure Conventions. +;; Font familiy and float size for text and header. +;; Landscape mode. +;; Multiple columns. +;; Tools for page setup. ;; ;; ;; Known bugs and limitations of ps-print: ;; -------------------------------------- +;; ;; Although color printing will work in XEmacs 19.12, it doesn't work ;; well; in particular, bold or italic fonts don't print in the right ;; background color. @@ -335,12 +648,12 @@ ;; ;; Automatic font-attribute detection doesn't work well, especially ;; with hilit19 and older versions of get-create-face. Users having -;; problems with auto-font detection should use the lists ps-italic- -;; faces and ps-bold-faces and/or turn off automatic detection by -;; setting ps-auto-font-detect to nil. +;; problems with auto-font detection should use the lists +;; `ps-italic-faces' and `ps-bold-faces' and/or turn off automatic +;; detection by setting `ps-auto-font-detect' to nil. ;; ;; Automatic font-attribute detection doesn't work with XEmacs 19.12 -;; in tty mode; use the lists ps-italic-faces and ps-bold-faces +;; in tty mode; use the lists `ps-italic-faces' and `ps-bold-faces' ;; instead. ;; ;; Still too slow; could use some hand-optimization. @@ -354,18 +667,30 @@ ;; ;; Epoch and Emacs 18 not supported. At all. ;; +;; Fixed-pitch fonts work better for line folding, but are not required. ;; -;; Features to add: -;; --------------- -;; 2-up and 4-up capability. +;; `ps-nb-pages-buffer' and `ps-nb-pages-region' don't take care +;; of folding lines. +;; +;; +;; Things to change: +;; ---------------- ;; -;; Line numbers. -;; -;; Wide-print (landscape) capability. +;; Add `ps-print-hook' (I don't know how to do that (yet!)). +;; Add 4-up capability (really needed?). +;; Add line numbers (should not be too hard). +;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy). +;; Put one header per page over the columns (easy but needed?). +;; Improve the memory management for big files (hard?). +;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care +;; of folding lines. ;; ;; ;; Acknowledgements ;; ---------------- +;; Thanks to Jim Thompson for the 2.8 version I started from. +;; [jack] +;; ;; Thanks to Kevin Rodgers for adding support for ;; color and the invisible property. ;; @@ -391,39 +716,116 @@ ;;; Code: -(defconst ps-print-version "2.8" - "ps-print.el,v 2.8 1995/05/04 12:06:10 jct Exp - -Jim's last change version -- this file may have been edited as part of -Emacs without changes to the version number. When reporting bugs, -please also report the version of Emacs, if any, that ps-print was -distributed with. - -Please send all bug fixes and enhancements to - Jim Thompson .") +(eval-when-compile + (require 'cl)) + +(unless (featurep 'lisp-float-type) + (error "`ps-print' requires floating point support")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; User Variables: +;;; Interface to the command system + (defvar ps-lpr-command lpr-command "*The shell command for printing a PostScript file.") (defvar ps-lpr-switches lpr-switches "*A list of extra switches to pass to `ps-lpr-command'.") -(defvar ps-spool-duplex nil ; Not many people have duplex - ; printers, so default to nil. - "*Non-nil indicates spooling is for a two-sided printer. -For a duplex printer, the `ps-spool-*' commands will insert blank pages -as needed between print jobs so that the next buffer printed will -start on the right page. Also, if headers are turned on, the headers -will be reversed on duplex printers so that the page numbers fall to -the left on even-numbered pages.") +;;; Page layout + +;; All page dimensions are in PostScript points. +;; 1 inch == 2.54 cm == 72 points +;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points + +;; Letter 8.5 inch x 11.0 inch +;; Legal 8.5 inch x 14.0 inch +;; A4 8.26 inch x 11.69 inch = 21.0 cm x 29.7 cm + +;; LetterSmall 7.68 inch x 10.16 inch +;; Tabloid 11.0 inch x 17.0 inch +;; Ledger 17.0 inch x 11.0 inch +;; Statement 5.5 inch x 8.5 inch +;; Executive 7.5 inch x 10.0 inch +;; A3 11.69 inch x 16.5 inch = 29.7 cm x 42.0 cm +;; A4Small 7.47 inch x 10.85 inch +;; B4 10.125 inch x 14.33 inch +;; B5 7.16 inch x 10.125 inch + +(defvar ps-page-dimensions-database + (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54)) + (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54)) + (list 'letter (* 72 8.5) (* 72 11.0)) + (list 'legal (* 72 8.5) (* 72 14.0)) + (list 'letter-small (* 72 7.68) (* 72 10.16)) + (list 'tabloid (* 72 11.0) (* 72 17.0)) + (list 'ledger (* 72 17.0) (* 72 11.0)) + (list 'statement (* 72 5.5) (* 72 8.5)) + (list 'executive (* 72 7.5) (* 72 10.0)) + (list 'a4small (* 72 7.47) (* 72 10.85)) + (list 'b4 (* 72 10.125) (* 72 14.33)) + (list 'b5 (* 72 7.16) (* 72 10.125))) + "*List associating a symbolic paper type to its width and height. +see `ps-paper-type'.") ;;;###autoload -(defvar ps-paper-type 'ps-letter - "*Specifies the size of paper to format for. Should be one of -`ps-letter', `ps-legal', or `ps-a4'.") +(defvar ps-paper-type 'letter + "*Specifies the size of paper to format for. +Should be one of the paper types defined in `ps-page-dimensions-database', for +example `letter', `legal' or `a4'.") + +(defvar ps-landscape-mode 'nil + "*Non-nil means print in landscape mode.") + +(defvar ps-number-of-columns (if ps-landscape-mode 2 1) + "*Specifies the number of columns") + +;;; Horizontal layout + +;; ------------------------------------------ +;; | | | | | | | | +;; | lm | text | ic | text | ic | text | rm | +;; | | | | | | | | +;; ------------------------------------------ + +(defvar ps-left-margin (/ (* 72 2.0) 2.54) ; 2 cm + "*Left margin in points (1/72 inch).") + +(defvar ps-right-margin (/ (* 72 2.0) 2.54) ; 2 cm + "*Right margin in points (1/72 inch).") + +(defvar ps-inter-column (/ (* 72 2.0) 2.54) ; 2 cm + "*Horizontal space between columns in points (1/72 inch).") + +;;; Vertical layout + +;; |--------| +;; | tm | +;; |--------| +;; | header | +;; |--------| +;; | ho | +;; |--------| +;; | text | +;; |--------| +;; | bm | +;; |--------| + +(defvar ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm + "*Bottom margin in points (1/72 inch).") + +(defvar ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm + "*Top margin in points (1/72 inch).") + +(defvar ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm + "*Vertical space in points (1/72 inch) between the main text and the header.") + +(defvar ps-header-line-pad 0.15 + "*Portion of a header title line height to insert between the header frame +and the text it contains, both in the vertical and horizontal directions.") + +;;; Header setup (defvar ps-print-header t "*Non-nil means print a header at the top of each page. @@ -435,19 +837,114 @@ (defvar ps-print-header-frame t "*Non-nil means draw a gaudy frame around the header.") +(defvar ps-header-lines 2 + "*Number of lines to display in page header, when generating Postscript.") +(make-variable-buffer-local 'ps-header-lines) + (defvar ps-show-n-of-n t "*Non-nil means show page numbers as N/M, meaning page N of M. Note: page numbers are displayed as part of headers, see variable `ps-print-headers'.") +(defvar ps-spool-duplex nil ; Not many people have duplex + ; printers, so default to nil. + "*Non-nil indicates spooling is for a two-sided printer. +For a duplex printer, the `ps-spool-*' commands will insert blank pages +as needed between print jobs so that the next buffer printed will +start on the right page. Also, if headers are turned on, the headers +will be reversed on duplex printers so that the page numbers fall to +the left on even-numbered pages.") + +;;; Fonts + +(defvar ps-font-info-database + '((Courier ; the family key + "Courier" "Courier-Bold" "Courier-Oblique" "Courier-BoldOblique" + 10.0 10.55 6.0 6.0) + (Helvetica ; the family key + "Helvetica" "Helvetica-Bold" "Helvetica-Oblique" "Helvetica-BoldOblique" + 10.0 11.56 2.78 5.09243) + (Times + "Times-Roman" "Times-Bold" "Times-Italic" "Times-BoldItalic" + 10.0 11.0 2.5 4.71432) + (Palatino + "Palatino-Roman" "Palatino-Bold" "Palatino-Italic" "Palatino-BoldItalic" + 10.0 12.1 2.5 5.08676) + (Helvetica-Narrow + "Helvetica-Narrow" "Helvetica-Narrow-Bold" + "Helvetica-Narrow-Oblique" "Helvetica-Narrow-BoldOblique" + 10.0 11.56 2.2796 4.17579) + (NewCenturySchlbk + "NewCenturySchlbk-Roman" "NewCenturySchlbk-Bold" + "NewCenturySchlbk-Italic" "NewCenturySchlbk-BoldItalic" + 10.0 12.15 2.78 5.31162) + ;; got no bold for the next ones + (AvantGarde-Book + "AvantGarde-Book" "AvantGarde-Book" + "AvantGarde-BookOblique" "AvantGarde-BookOblique" + 10.0 11.77 2.77 5.45189) + (AvantGarde-Demi + "AvantGarde-Demi" "AvantGarde-Demi" + "AvantGarde-DemiOblique" "AvantGarde-DemiOblique" + 10.0 12.72 2.8 5.51351) + (Bookman-Demi + "Bookman-Demi" "Bookman-Demi" + "Bookman-DemiItalic" "Bookman-DemiItalic" + 10.0 11.77 3.4 6.05946) + (Bookman-Light + "Bookman-Light" "Bookman-Light" + "Bookman-LightItalic" "Bookman-LightItalic" + 10.0 11.79 3.2 5.67027) + ;; got no bold and no italic for the next ones + (Symbol + "Symbol" "Symbol" "Symbol" "Symbol" + 10.0 13.03 2.5 3.24324) + (Zapf-Dingbats + "Zapf-Dingbats" "Zapf-Dingbats" "Zapf-Dingbats" "Zapf-Dingbats" + 10.0 9.63 2.78 2.78) + (Zapf-Chancery-MediumItalic + "Zapf-Chancery-MediumItalic" "Zapf-Chancery-MediumItalic" + "Zapf-Chancery-MediumItalic" "Zapf-Chancery-MediumItalic" + 10.0 11.45 2.2 4.10811) +) + "*Font info database: font family (the key), name, bold, italic, bold-italic, +reference size, line height, space width, average character width. +To get the info for another specific font (say Helvetica), do the following: +- create a new buffer +- generate the PostScript image to a file (C-u M-x ps-print-buffer) +- open this file and delete the leading `%' (which is the Postscript + comment character) from the line + `% 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage' + to get the line + `3 cm 20 cm moveto 10 /Helvetica ReportFontInfo showpage' +- add the values to `ps-font-info-database'. +You can get all the fonts of YOUR printer using `ReportAllFontInfo'.") + +(defvar ps-font-family 'Courier + "Font family name for ordinary text, when generating Postscript.") + +(defvar ps-font-size (if ps-landscape-mode 7 8.5) + "Font size, in points, for ordinary text, when generating Postscript.") + +(defvar ps-header-font-family 'Helvetica + "Font family name for text in the header, when generating Postscript.") + +(defvar ps-header-font-size (if ps-landscape-mode 10 12) + "Font size, in points, for text in the header, when generating Postscript.") + +(defvar ps-header-title-font-size (if ps-landscape-mode 12 14) + "Font size, in points, for the top line of text in the header, +when generating Postscript.") + +;;; Colors + ;;;###autoload ;;; The 19.33 fsf version includes a test on pixel components instead ;;; of color-instance-rgb-components -(defvar ps-print-color-p (and (or (fboundp 'x-color-values) ; fsf - (fboundp 'color-instance-rgb-components)) +(defvar ps-print-color-p (or (fboundp 'x-color-values) ; fsf + (fboundp 'color-instance-rgb-components)) ; xemacs - (fboundp 'float)) -; Printing color requires both floating point and x-color-values. +; Printing color requires x-color-values. "*If non-nil, print the buffer's text in color.") (defvar ps-default-fg '(0.0 0.0 0.0) @@ -456,64 +953,42 @@ (defvar ps-default-bg '(1.0 1.0 1.0) "*RGB values of the default background color. Defaults to white.") -(defvar ps-font-size 10 - "*Font size, in points, for generating Postscript.") - -(defvar ps-font "Courier" - "*Font family name for ordinary text, when generating Postscript.") - -(defvar ps-font-bold "Courier-Bold" - "*Font family name for bold text, when generating Postscript.") - -(defvar ps-font-italic "Courier-Oblique" - "*Font family name for italic text, when generating Postscript.") - -(defvar ps-font-bold-italic "Courier-BoldOblique" - "*Font family name for bold italic text, when generating Postscript.") - -(defvar ps-avg-char-width (if (fboundp 'float) 5.6 6) - "*The average width, in points, of a character, for generating Postscript. -This is the value that ps-print uses to determine the length, -x-dimension, of the text it has printed, and thus affects the point at -which long lines wrap around. If you change the font or -font size, you will probably have to adjust this value to match.") - -(defvar ps-space-width (if (fboundp 'float) 5.6 6) - "*The width of a space character, for generating Postscript. -This value is used in expanding tab characters.") - -(defvar ps-line-height (if (fboundp 'float) 11.29 11) - "*The height of a line, for generating Postscript. -This is the value that ps-print uses to determine the height, -y-dimension, of the lines of text it has printed, and thus affects the -point at which page-breaks are placed. If you change the font or font -size, you will probably have to adjust this value to match. The -line-height is *not* the same as the point size of the font.") - (defvar ps-auto-font-detect t "*Non-nil means automatically detect bold/italic face attributes. nil means rely solely on the lists `ps-bold-faces', `ps-italic-faces', and `ps-underlined-faces'.") -(defvar ps-bold-faces '() +(defvar ps-bold-faces + (unless ps-print-color-p + '(font-lock-function-name-face + font-lock-builtin-face + font-lock-variable-name-face + font-lock-keyword-face + font-lock-warning-face)) "*A list of the \(non-bold\) faces that should be printed in bold font. This applies to generating Postscript.") -(defvar ps-italic-faces '() +(defvar ps-italic-faces + (unless ps-print-color-p + '(font-lock-variable-name-face + font-lock-string-face + font-lock-comment-face + font-lock-warning-face)) "*A list of the \(non-italic\) faces that should be printed in italic font. This applies to generating Postscript.") -(defvar ps-underlined-faces '() +(defvar ps-underlined-faces + (unless ps-print-color-p + '(font-lock-function-name-face + font-lock-type-face + font-lock-reference-face + font-lock-warning-face)) "*A list of the \(non-underlined\) faces that should be printed underlined. This applies to generating Postscript.") -(defvar ps-header-lines 2 - "*Number of lines to display in page header, when generating Postscript.") -(make-variable-buffer-local 'ps-header-lines) - (defvar ps-left-header (list 'ps-get-buffer-name 'ps-header-dirpart) - "*The items to display on the right part of the page header. + "*The items to display (each on a line) on the left part of the page header. This applies to generating Postscript. The value should be a list of strings and symbols, each representing an @@ -531,8 +1006,8 @@ (make-variable-buffer-local 'ps-left-header) (defvar ps-right-header - (list "/pagenumberstring load" 'time-stamp-yy/mm/dd 'time-stamp-hh:mm:ss) - "*The items to display on the left part of the page header. + (list "/pagenumberstring load" 'time-stamp-mon-dd-yyyy 'time-stamp-hh:mm:ss) + "*The items to display (each on a line) on the right part of the page header. This applies to generating Postscript. See the variable `ps-left-header' for a description of the format of @@ -689,6 +1164,85 @@ (interactive (list (ps-print-preprint current-prefix-arg))) (ps-do-despool filename)) +;;;###autoload +(defun ps-line-lengths () + "*Display the correspondance between a line length and a font size, +using the current ps-print setup. +Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head" + (interactive) + (ps-line-lengths-internal)) + +;;;###autoload +(defun ps-nb-pages-buffer (nb-lines) + "*Display an approximate correspondance between a font size and the number +of pages the current buffer would require to print +using the current ps-print setup." + (interactive (list (count-lines (point-min) (point-max)))) + (ps-nb-pages nb-lines)) + +;;;###autoload +(defun ps-nb-pages-region (nb-lines) + "*Display an approximate correspondance between a font size and the number +of pages the current region would require to print +using the current ps-print setup." + (interactive (list (count-lines (mark) (point)))) + (ps-nb-pages nb-lines)) + +;;;###autoload +(defun ps-setup () + "*Return the current setup" + (format " + (setq ps-print-color-p %s + ps-lpr-command \"%s\" + ps-lpr-switches %s + + ps-paper-type '%s + ps-landscape-mode %s + ps-number-of-columns %s + + ps-left-margin %s + ps-right-margin %s + ps-inter-column %s + ps-bottom-margin %s + ps-top-margin %s + ps-header-offset %s + ps-header-line-pad %s + ps-print-header %s + ps-print-header-frame %s + ps-header-lines %s + ps-show-n-of-n %s + ps-spool-duplex %s + + ps-font-family '%s + ps-font-size %s + ps-header-font-family '%s + ps-header-font-size %s + ps-header-title-font-size %s) +" + ps-print-color-p + ps-lpr-command + ps-lpr-switches + ps-paper-type + ps-landscape-mode + ps-number-of-columns + ps-left-margin + ps-right-margin + ps-inter-column + ps-bottom-margin + ps-top-margin + ps-header-offset + ps-header-line-pad + ps-print-header + ps-print-header-frame + ps-header-lines + ps-show-n-of-n + ps-spool-duplex + ps-font-family + ps-font-size + ps-header-font-family + ps-header-font-size + ps-header-title-font-size)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Utility functions and variables: @@ -705,7 +1259,10 @@ (require 'faces)) ; face-font, face-underline-p, ; x-font-regexp -(defun xemacs-color-device () +;; Return t if the device (which can be changed during an emacs +;; session) can handle colors. +;; This is function is not yet implemented for GNU emacs. +(defun ps-color-device () (if (and (eq ps-print-emacs-type 'xemacs) (>= emacs-minor-version 12)) (eq (device-class) 'color) @@ -713,12 +1270,41 @@ (require 'time-stamp) -(defvar ps-print-prologue "% ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4: -% If the ISOLatin1Encoding vector isn't known, define it. +(defvar ps-font nil + "Font family name for ordinary text, when generating Postscript.") + +(defvar ps-font-bold nil + "Font family name for bold text, when generating Postscript.") + +(defvar ps-font-italic nil + "Font family name for italic text, when generating Postscript.") + +(defvar ps-font-bold-italic nil + "Font family name for bold italic text, when generating Postscript.") + +(defvar ps-avg-char-width nil + "The average width, in points, of a character, for generating Postscript. +This is the value that ps-print uses to determine the length, +x-dimension, of the text it has printed, and thus affects the point at +which long lines wrap around.") + +(defvar ps-space-width nil + "The width of a space character, for generating Postscript. +This value is used in expanding tab characters.") + +(defvar ps-line-height nil + "The height of a line, for generating Postscript. +This is the value that ps-print uses to determine the height, +y-dimension, of the lines of text it has printed, and thus affects the +point at which page-breaks are placed. +The line-height is *not* the same as the point size of the font.") + +(defvar ps-print-prologue-1 + "% ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4: /ISOLatin1Encoding where { pop } { -% Define the ISO Latin-1 encoding vector. -% The first half is the same as the standard encoding, -% except for minus instead of hyphen at code 055. +% -- The ISO Latin-1 encoding vector isn't known, so define it. +% -- The first half is the same as the standard encoding, +% -- except for minus instead of hyphen at code 055. /ISOLatin1Encoding StandardEncoding 0 45 getinterval aload pop /minus @@ -726,12 +1312,12 @@ %*** NOTE: the following are missing in the Adobe documentation, %*** but appear in the displayed table: %*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240. -% ^Px +% 0200 (128) /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron -% ^Tx +% 0240 (160) /space /exclamdown /cent /sterling /currency /yen /brokenbar /section /dieresis /copyright /ordfeminine /guillemotleft @@ -740,7 +1326,7 @@ /acute /mu /paragraph /periodcentered /cedilla /onesuperior /ordmasculine /guillemotright /onequarter /onehalf /threequarters /questiondown -% ^Xx +% 0300 (192) /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla /Egrave /Eacute /Ecircumflex /Edieresis @@ -749,7 +1335,7 @@ /Ocircumflex /Otilde /Odieresis /multiply /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn /germandbls -% ^\\x +% 0340 (224) /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla /egrave /eacute /ecircumflex /edieresis @@ -763,21 +1349,16 @@ /reencodeFontISO { %def dup - length 5 add dict % Make a new font (a new dict - % the same size as the old - % one) with room for our new - % symbols. - - begin % Make the new font the - % current dictionary. + length 5 add dict % Make a new font (a new dict the same size + % as the old one) with room for our new symbols. + + begin % Make the new font the current dictionary. { 1 index /FID ne { def } { pop pop } ifelse - } forall % Copy each of the symbols - % from the old dictionary to - % the new except for the font - % ID. + } forall % Copy each of the symbols from the old dictionary + % to the new one except for the font ID. /Encoding ISOLatin1Encoding def % Override the encoding with % the ISOLatin1 encoding. @@ -785,14 +1366,27 @@ % Use the font's bounding box to determine the ascent, descent, % and overall height; don't forget that these values have to be % transformed using the font's matrix. - FontBBox - FontMatrix transform /Ascent exch def pop + +% ^ (x2 y2) +% | | +% | v +% | +----+ - - +% | | | ^ +% | | | | Ascent (usually > 0) +% | | | | +% (0 0) -> +--+----+--------> +% | | | +% | | v Descent (usually < 0) +% (x1 y1) --> +----+ - - + + FontBBox % -- x1 y1 x2 y2 + FontMatrix transform /Ascent exch def pop FontMatrix transform /Descent exch def pop - /FontHeight Ascent Descent sub def - - % Define these in case they're not in the FontInfo (also, here - % they're easier to get to. - /UnderlinePosition 1 def + /FontHeight Ascent Descent sub def % use `sub' because descent < 0 + + % Define these in case they're not in the FontInfo + % (also, here they're easier to get to. + /UnderlinePosition 1 def /UnderlineThickness 1 def % Get the underline position and thickness if they're defined. @@ -813,28 +1407,22 @@ } if - currentdict % Leave the new font on the - % stack - - end % Stop using the font as the - % current dictionary. - - definefont % Put the font into the font - % dictionary - - pop % Discard the returned font. + currentdict % Leave the new font on the stack + end % Stop using the font as the current dictionary. + definefont % Put the font into the font dictionary + pop % Discard the returned font. } bind def -/Font { +/DefFont { % Font definition findfont exch scalefont reencodeFontISO } def -/F { % Font select +/F { % Font selection findfont - dup /Ascent get /Ascent exch def - dup /Descent get /Descent exch def - dup /FontHeight get /FontHeight exch def - dup /UnderlinePosition get /UnderlinePosition exch def + dup /Ascent get /Ascent exch def + dup /Descent get /Descent exch def + dup /FontHeight get /FontHeight exch def + dup /UnderlinePosition get /UnderlinePosition exch def dup /UnderlineThickness get /UnderlineThickness exch def setfont } def @@ -847,15 +1435,23 @@ { mark 4 1 roll ] /bgcolor exch def } if } def +% B width C +% +-----------+ +% | Ascent (usually > 0) +% A + + +% | Descent (usually < 0) +% +-----------+ +% E width D + /dobackground { % width -- - currentpoint + currentpoint % -- width x y gsave newpath - moveto - 0 Ascent rmoveto - dup 0 rlineto - 0 Descent Ascent sub rlineto - neg 0 rlineto + moveto % A (x y) + 0 Ascent rmoveto % B + dup 0 rlineto % C + 0 Descent Ascent sub rlineto % D + neg 0 rlineto % E closepath bgcolor aload pop setrgbcolor fill @@ -878,20 +1474,23 @@ grestore } def -/eolbg { - currentpoint pop - PrintWidth LeftMargin add exch sub dobackground +/eolbg { % dobackground until right margin + PrintWidth % -- x-eol + currentpoint pop % -- cur-x + sub % -- width until eol + dobackground } def -/eolul { - currentpoint exch pop - PrintWidth LeftMargin add exch dounderline +/eolul { % idem for underline + PrintWidth % -- x-eol + currentpoint exch pop % -- x-eol cur-y + dounderline } def /SL { % Soft Linefeed bg { eolbg } if ul { eolul } if - currentpoint LineHeight sub LeftMargin exch moveto pop + 0 currentpoint exch pop LineHeight sub moveto } def /HL /SL load def % Hard Linefeed @@ -912,18 +1511,48 @@ /W { ul { sp1 } if - ( ) stringwidth % Get the width of a space - pop % Discard the Y component - mul % Multiply the width of a - % space by the number of - % spaces to plot + ( ) stringwidth % Get the width of a space in the current font. + pop % Discard the Y component. + mul % Multiply the width of a space + % by the number of spaces to plot bg { dup dobackground } if 0 rmoveto ul { dounderline } if } def +/BeginDoc { + % ---- save the state of the document (useful for ghostscript!) + /docState save def + % ---- [jack] Kludge: my ghostscript window is 21x27.7 instead of 21x29.7 + /JackGhostscript where { + pop 1 27.7 29.7 div scale + } if + LandscapeMode { + % ---- translate to bottom-right corner of Portrait page + LandscapePageHeight 0 translate + 90 rotate + } if + /ColumnWidth PrintWidth InterColumn add def + % ---- translate to lower left corner of TEXT + LeftMargin BottomMargin translate + % ---- define where printing will start + /f0 F % this installs Ascent + /PrintStartY PrintHeight Ascent sub def + /ColumnIndex 1 def +} def + +/EndDoc { + % ---- on last page but not last column, spit out the page + ColumnIndex 1 eq not { showpage } if + % ---- restore the state of the document (useful for ghostscript!) + docState restore +} def + /BeginDSCPage { - /vmstate save def + % ---- when 1st column, save the state of the page + ColumnIndex 1 eq { /pageState save def } if + % ---- save the state of the column + /columnState save def } def /BeginPage { @@ -931,71 +1560,90 @@ PrintHeaderFrame { HeaderFrame } if HeaderText } if - LeftMargin - BottomMargin PrintHeight add - moveto % move to where printing will - % start. + 0 PrintStartY moveto % move to where printing will start } def /EndPage { bg { eolbg } if ul { eolul } if - showpage % Spit out a page } def /EndDSCPage { - vmstate restore + ColumnIndex NumberOfColumns eq { + % ---- on last column, spit out the page + showpage + % ---- restore the state of the page + pageState restore + /ColumnIndex 1 def + } { % else + % ---- restore the state of the current column + columnState restore + % ---- and translate to the next column + ColumnWidth 0 translate + /ColumnIndex ColumnIndex 1 add def + } ifelse } def /ul false def /UL { /ul exch def } def -/h0 14 /Helvetica-Bold Font -/h1 12 /Helvetica Font - -/h1 F - -/HeaderLineHeight FontHeight def -/HeaderDescent Descent def -/HeaderPad 2 def - -/SetHeaderLines { - /HeaderOffset TopMargin 2 div def +/SetHeaderLines { % nb-lines -- /HeaderLines exch def - /HeaderHeight HeaderLines HeaderLineHeight mul HeaderPad 2 mul add def - /PrintHeight PrintHeight HeaderHeight sub def + % ---- bottom up + HeaderPad + HeaderLines 1 sub HeaderLineHeight mul add + HeaderTitleLineHeight add + HeaderPad add + /HeaderHeight exch def } def -/HeaderFrameStart { - LeftMargin BottomMargin PrintHeight add HeaderOffset add +% |---------| +% | tm | +% |---------| +% | header | +% |-+-------| <-- (x y) +% | ho | +% |---------| +% | text | +% |-+-------| <-- (0 0) +% | bm | +% |---------| + +/HeaderFrameStart { % -- x y + 0 PrintHeight HeaderOffset add } def /HeaderFramePath { - PrintWidth 0 rlineto - 0 HeaderHeight rlineto - PrintWidth neg 0 rlineto - 0 HeaderHeight neg rlineto + PrintWidth 0 rlineto + 0 HeaderHeight rlineto + PrintWidth neg 0 rlineto + 0 HeaderHeight neg rlineto } def /HeaderFrame { gsave 0.4 setlinewidth + % ---- fill a black rectangle (the shadow of the next one) HeaderFrameStart moveto 1 -1 rmoveto HeaderFramePath 0 setgray fill + % ---- do the next rectangle ... HeaderFrameStart moveto HeaderFramePath - gsave 0.9 setgray fill grestore - gsave 0 setgray stroke grestore + gsave 0.9 setgray fill grestore % filled with grey + gsave 0 setgray stroke grestore % drawn with black grestore } def /HeaderStart { HeaderFrameStart - exch HeaderPad add exch - HeaderLineHeight HeaderLines 1 sub mul add HeaderDescent sub HeaderPad add + exch HeaderPad add exch % horizontal pad + % ---- bottom up + HeaderPad add % vertical pad + HeaderDescent sub + HeaderLineHeight HeaderLines 1 sub mul add } def /strcat { @@ -1015,10 +1663,14 @@ /HeaderText { HeaderStart moveto - HeaderLinesRight HeaderLinesLeft + HeaderLinesRight HeaderLinesLeft % -- rightLines leftLines + + % ---- hack: `PN 1 and' == `PN 2 modulo' + + % ---- if duplex and even page number, then exchange left and right Duplex PageNumber 1 and 0 eq and { exch } if - { + { % ---- process the left lines aload pop exch F gsave @@ -1030,7 +1682,7 @@ HeaderStart moveto - { + { % ---- process the right lines aload pop exch F gsave @@ -1045,15 +1697,14 @@ /ReportFontInfo { 2 copy - /t0 3 1 roll Font + /t0 3 1 roll DefFont /t0 F /lh FontHeight def /sw ( ) stringwidth pop def /aw (01234567890abcdefghijklmnopqrstuvwxyz) dup length exch stringwidth pop exch div def - /t1 12 /Helvetica-Oblique Font + /t1 12 /Helvetica-Oblique DefFont /t1 F - 72 72 moveto gsave (For ) show 128 string cvs show @@ -1066,13 +1717,43 @@ (,) show grestore 0 FontHeight neg rmoveto - (and a crude estimate of average character width is ) show - aw 32 string cvs show - (.) show - showpage + gsave + (and a crude estimate of average character width is ) show + aw 32 string cvs show + (.) show + grestore + 0 FontHeight neg rmoveto +} def + +/cm { % cm to point + 72 mul 2.54 div +} def + +/ReportAllFontInfo { + FontDirectory + { % key = font name value = font dictionary + pop 10 exch ReportFontInfo + } forall } def -% 10 /Courier ReportFontInfo +% 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage +% 3 cm 20 cm moveto ReportAllFontInfo showpage + +") + +(defvar ps-print-prologue-2 + " +% ---- These lines must be kept together because... + +/h0 F +/HeaderTitleLineHeight FontHeight def + +/h1 F +/HeaderLineHeight FontHeight def +/HeaderDescent Descent def + +% ---- ...because `F' has a side-effect on `FontHeight' and `Descent' + ") ;; Start Editing Here: @@ -1095,64 +1776,39 @@ (defvar ps-razchunk 0) -(defvar ps-color-format (if (eq ps-print-emacs-type 'emacs) - - ;;Emacs understands the %f format; we'll - ;;use it to limit color RGB values to - ;;three decimals to cut down some on the - ;;size of the PostScript output. - "%0.3f %0.3f %0.3f" - - ;; Lucid emacsen will have to make do with - ;; %s (princ) for floats. - "%s %s %s")) +(defvar ps-color-format + (if (eq ps-print-emacs-type 'emacs) + + ;;Emacs understands the %f format; we'll + ;;use it to limit color RGB values to + ;;three decimals to cut down some on the + ;;size of the PostScript output. + "%0.3f %0.3f %0.3f" + + ;; Lucid emacsen will have to make do with + ;; %s (princ) for floats. + "%s %s %s")) ;; These values determine how much print-height to deduct when headers ;; are turned on. This is a pretty clumsy way of handling it, but ;; it'll do for now. -(defvar ps-header-title-line-height (if (fboundp 'float) 16.0 16));Helvetica 14 -(defvar ps-header-line-height (if (fboundp 'float) 13.7 14));Helvetica 12 -(defvar ps-header-pad 2) - -;; LetterSmall 7.68 inch 10.16 inch -;; Tabloid 11.0 inch 17.0 inch -;; Ledger 17.0 inch 11.0 inch -;; Statement 5.5 inch 8.5 inch -;; Executive 7.5 inch 10.0 inch -;; A3 11.69 inch 16.5 inch -;; A4Small 7.47 inch 10.85 inch -;; B4 10.125 inch 14.33 inch -;; B5 7.16 inch 10.125 inch - -;; All page dimensions are in PostScript points. - -(defvar ps-left-margin 72) ; 1 inch -(defvar ps-right-margin 72) ; 1 inch -(defvar ps-bottom-margin 36) ; 1/2 inch -(defvar ps-top-margin 72) ; 1 inch - -;; Letter 8.5 inch x 11.0 inch -(defvar ps-letter-page-height 792) ; 11 inches -(defvar ps-letter-page-width 612) ; 8.5 inches - -;; Legal 8.5 inch x 14.0 inch -(defvar ps-legal-page-height 1008) ; 14.0 inches -(defvar ps-legal-page-width 612) ; 8.5 inches - -;; A4 8.26 inch x 11.69 inch -(defvar ps-a4-page-height 842) ; 11.69 inches -(defvar ps-a4-page-width 595) ; 8.26 inches - -(defvar ps-pages-alist - (list (list 'ps-letter ps-letter-page-width ps-letter-page-height) - (list 'ps-legal ps-legal-page-width ps-legal-page-height) - (list 'ps-a4 ps-a4-page-width ps-a4-page-height))) - -;; Define some constants to index into the page lists. -(defvar ps-page-width-i 1) -(defvar ps-page-height-i 2) - -(defvar ps-page-dimensions nil) + +(defvar ps-header-font) +(defvar ps-header-title-font) + +(defvar ps-header-line-height) +(defvar ps-header-title-line-height) +(defvar ps-header-pad 0 + "Vertical and horizontal space in points (1/72 inch) between the header frame +and the text it contains.") + +;; Define accessors to the dimensions list. + +(defmacro ps-page-dimensions-get-width (dims) `(nth 0 ,dims)) +(defmacro ps-page-dimensions-get-height (dims) `(nth 1 ,dims)) + +(defvar ps-landscape-page-height) + (defvar ps-print-width nil) (defvar ps-print-height nil) @@ -1163,15 +1819,239 @@ (defvar ps-ref-italic-faces nil) (defvar ps-ref-underlined-faces nil) +(defvar ps-print-color-scale nil) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Internal functions +(defun ps-line-lengths-internal () + "Display the correspondance between a line length and a font size, +using the current ps-print setup. +Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head" + (let ((buf (get-buffer-create "*Line-lengths*")) + (ifs ps-font-size) ; initial font size + (icw ps-avg-char-width) ; initial character width + (print-width (progn (ps-get-page-dimensions) + ps-print-width)) + (ps-setup (ps-setup)) ; setup for the current buffer + (fs-min 5) ; minimum font size + cw-min ; minimum character width + nb-cpl-max ; maximum nb of characters per line + (fs-max 14) ; maximum font size + cw-max ; maximum character width + nb-cpl-min ; minimum nb of characters per line + fs ; current font size + cw ; current character width + nb-cpl ; current nb of characters per line + ) + (setq cw-min (/ (* icw fs-min) ifs) + nb-cpl-max (floor (/ print-width cw-min)) + cw-max (/ (* icw fs-max) ifs) + nb-cpl-min (floor (/ print-width cw-max))) + (setq nb-cpl nb-cpl-min) + (set-buffer buf) + (goto-char (point-max)) + (if (not (bolp)) (insert "\n")) + (insert ps-setup) + (insert "nb char per line / font size\n") + (while (<= nb-cpl nb-cpl-max) + (setq cw (/ print-width (float nb-cpl)) + fs (/ (* ifs cw) icw)) + (insert (format "%3s %s\n" nb-cpl fs)) + (setq nb-cpl (1+ nb-cpl))) + (insert "\n") + (display-buffer buf 'not-this-window))) + +(defun ps-nb-pages (nb-lines) + "Display an approximate correspondance between a font size and the number +of pages the number of lines would require to print +using the current ps-print setup." + (let ((buf (get-buffer-create "*Nb-Pages*")) + (ifs ps-font-size) ; initial font size + (ilh ps-line-height) ; initial line height + (page-height (progn (ps-get-page-dimensions) + ps-print-height)) + (ps-setup (ps-setup)) ; setup for the current buffer + (fs-min 4) ; minimum font size + lh-min ; minimum line height + nb-lpp-max ; maximum nb of lines per page + nb-page-min ; minimum nb of pages + (fs-max 14) ; maximum font size + lh-max ; maximum line height + nb-lpp-min ; minimum nb of lines per page + nb-page-max ; maximum nb of pages + fs ; current font size + lh ; current line height + nb-lpp ; current nb of lines per page + nb-page ; current nb of pages + ) + (setq lh-min (/ (* ilh fs-min) ifs) + nb-lpp-max (floor (/ page-height lh-min)) + nb-page-min (ceiling (/ (float nb-lines) nb-lpp-max)) + lh-max (/ (* ilh fs-max) ifs) + nb-lpp-min (floor (/ page-height lh-max)) + nb-page-max (ceiling (/ (float nb-lines) nb-lpp-min))) + (setq nb-page nb-page-min) + (set-buffer buf) + (goto-char (point-max)) + (if (not (bolp)) (insert "\n")) + (insert ps-setup) + (insert (format "%d lines\n" nb-lines)) + (insert "nb page / font size\n") + (while (<= nb-page nb-page-max) + (setq nb-lpp (ceiling (/ nb-lines (float nb-page))) + lh (/ page-height nb-lpp) + fs (/ (* ifs lh) ilh)) + (insert (format "%s %s\n" nb-page fs)) + (setq nb-page (1+ nb-page))) + (insert "\n") + (display-buffer buf 'not-this-window))) + +(defun ps-select-font () + "Choose the font name and size (scaling data)." + (let ((assoc (assq ps-font-family ps-font-info-database)) + l fn fb fi bi sz lh sw aw) + (if (null assoc) + (error "Don't have data to scale font %s. Known fonts families are %s" + ps-font-family + (mapcar 'car ps-font-info-database))) + (setq l (cdr assoc) + fn (prog1 (car l) (setq l (cdr l))) ; need `pop' + fb (prog1 (car l) (setq l (cdr l))) + fi (prog1 (car l) (setq l (cdr l))) + bi (prog1 (car l) (setq l (cdr l))) + sz (prog1 (car l) (setq l (cdr l))) + lh (prog1 (car l) (setq l (cdr l))) + sw (prog1 (car l) (setq l (cdr l))) + aw (prog1 (car l) (setq l (cdr l)))) + + (setq ps-font fn) + (setq ps-font-bold fb) + (setq ps-font-italic fi) + (setq ps-font-bold-italic bi) + ;; These data just need to be rescaled: + (setq ps-line-height (/ (* lh ps-font-size) sz)) + (setq ps-space-width (/ (* sw ps-font-size) sz)) + (setq ps-avg-char-width (/ (* aw ps-font-size) sz)) + ps-font-family)) + +(defun ps-select-header-font () + "Choose the font name and size (scaling data) for the header." + (let ((assoc (assq ps-header-font-family ps-font-info-database)) + l fn fb fi bi sz lh sw aw) + (if (null assoc) + (error "Don't have data to scale font %s. Known fonts families are %s" + ps-font-family + (mapcar 'car ps-font-info-database))) + (setq l (cdr assoc) + fn (prog1 (car l) (setq l (cdr l))) ; need `pop' + fb (prog1 (car l) (setq l (cdr l))) + fi (prog1 (car l) (setq l (cdr l))) + bi (prog1 (car l) (setq l (cdr l))) + sz (prog1 (car l) (setq l (cdr l))) + lh (prog1 (car l) (setq l (cdr l))) + sw (prog1 (car l) (setq l (cdr l))) + aw (prog1 (car l) (setq l (cdr l)))) + + ;; Font name + (setq ps-header-font fn) + (setq ps-header-title-font fb) + ;; Line height: These data just need to be rescaled: + (setq ps-header-title-line-height (/ (* lh ps-header-title-font-size) sz)) + (setq ps-header-line-height (/ (* lh ps-header-font-size) sz)) + ps-header-font-family)) + (defun ps-get-page-dimensions () - (setq ps-page-dimensions (assq ps-paper-type ps-pages-alist)) - (let ((ps-page-width (nth ps-page-width-i ps-page-dimensions)) - (ps-page-height (nth ps-page-height-i ps-page-dimensions))) - (setq ps-print-height (- ps-page-height ps-top-margin ps-bottom-margin)) - (setq ps-print-width (- ps-page-width ps-left-margin ps-right-margin)))) + (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database))) + page-width page-height) + (cond + ((null page-dimensions) + (error "`ps-paper-type' must be one of:\n%s" + (mapcar 'car ps-page-dimensions-database))) + ((< ps-number-of-columns 1) + (error "The number of columns %d should not be negative"))) + + (ps-select-font) + (ps-select-header-font) + + (setq page-width (ps-page-dimensions-get-width page-dimensions) + page-height (ps-page-dimensions-get-height page-dimensions)) + + ;; Landscape mode + (if ps-landscape-mode + ;; exchange width and height + (setq page-width (prog1 page-height (setq page-height page-width)))) + + ;; It is used to get the lower right corner (only in landscape mode) + (setq ps-landscape-page-height page-height) + + ;; | lm | text | ic | text | ic | text | rm | + ;; page-width == lm + n * pw + (n - 1) * ic + rm + ;; => pw == (page-width - lm -rm - (n - 1) * ic) / n + (setq ps-print-width + (/ (- page-width + ps-left-margin ps-right-margin + (* (1- ps-number-of-columns) ps-inter-column)) + ps-number-of-columns)) + (if (<= ps-print-width 0) + (error "Bad horizontal layout: +page-width == %s +ps-left-margin == %s +ps-right-margin == %s +ps-inter-column == %s +ps-number-of-columns == %s +| lm | text | ic | text | ic | text | rm | +page-width == lm + n * print-width + (n - 1) * ic + rm +=> print-width == %d !" + page-width + ps-left-margin + ps-right-margin + ps-inter-column + ps-number-of-columns + ps-print-width)) + + (setq ps-print-height + (- page-height ps-bottom-margin ps-top-margin)) + (if (<= ps-print-height 0) + (error "Bad vertical layout: +ps-top-margin == %s +ps-bottom-margin == %s +page-height == bm + print-height + tm +=> print-height == %d !" + ps-top-margin + ps-bottom-margin + ps-print-height)) + ;; If headers are turned on, deduct the height of the header from + ;; the print height. + (cond + (ps-print-header + (setq ps-header-pad + (* ps-header-line-pad ps-header-title-line-height)) + (setq ps-print-height + (- ps-print-height + ps-header-offset + ps-header-pad + ps-header-title-line-height + (* ps-header-line-height (- ps-header-lines 1)) + ps-header-pad)))) + (if (<= ps-print-height 0) + (error "Bad vertical layout: +ps-top-margin == %s +ps-bottom-margin == %s +ps-header-offset == %s +ps-header-pad == %s +header-height == %s +page-height == bm + print-height + tm - ho - hh +=> print-height == %d !" + ps-top-margin + ps-bottom-margin + ps-header-offset + ps-header-pad + (+ ps-header-pad + ps-header-title-line-height + (* ps-header-line-height (- ps-header-lines 1)) + ps-header-pad) + ps-print-height)))) (defun ps-print-preprint (&optional filename) (if (and filename @@ -1284,6 +2164,7 @@ (ps-output (format "/%s %s def\n" name (if bool "true" "false")))) (defun ps-begin-file () + (ps-get-page-dimensions) (setq ps-showpage-count 0) (ps-output ps-adobe-tag) @@ -1292,36 +2173,53 @@ (ps-output "%%Creator: " (user-full-name) "\n") (ps-output "%%CreationDate: " (time-stamp-hh:mm:ss) " " (time-stamp-mon-dd-yyyy) "\n") - (ps-output "%% DocumentFonts: Helvetica Helvetica-Bold " + (ps-output "%% DocumentFonts: " ps-font " " ps-font-bold " " ps-font-italic " " - ps-font-bold-italic "\n") + ps-font-bold-italic " " + ps-header-font " " ps-header-title-font "\n") (ps-output "%%Pages: (atend)\n") (ps-output "%%EndComments\n\n") - (ps-output-boolean "Duplex" ps-spool-duplex) - (ps-output-boolean "PrintHeader" ps-print-header) + (ps-output-boolean "LandscapeMode" ps-landscape-mode) + (ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns)) + + (ps-output (format "/LandscapePageHeight %s def\n" ps-landscape-page-height)) + (ps-output (format "/PrintWidth %s def\n" ps-print-width)) + (ps-output (format "/PrintHeight %s def\n" ps-print-height)) + + (ps-output (format "/LeftMargin %s def\n" ps-left-margin)) + (ps-output (format "/RightMargin %s def\n" ps-right-margin)) ; not used + (ps-output (format "/InterColumn %s def\n" ps-inter-column)) + + (ps-output (format "/BottomMargin %s def\n" ps-bottom-margin)) + (ps-output (format "/TopMargin %s def\n" ps-top-margin)) ; not used + (ps-output (format "/HeaderOffset %s def\n" ps-header-offset)) + (ps-output (format "/HeaderPad %s def\n" ps-header-pad)) + + (ps-output-boolean "PrintHeader" ps-print-header) (ps-output-boolean "PrintHeaderFrame" ps-print-header-frame) - (ps-output-boolean "ShowNofN" ps-show-n-of-n) - - (ps-output (format "/LeftMargin %d def\n" ps-left-margin)) - (ps-output (format "/RightMargin %d def\n" ps-right-margin)) - (ps-output (format "/BottomMargin %d def\n" ps-bottom-margin)) - (ps-output (format "/TopMargin %d def\n" ps-top-margin)) - - (ps-get-page-dimensions) - (ps-output (format "/PrintWidth %d def\n" ps-print-width)) - (ps-output (format "/PrintHeight %d def\n" ps-print-height)) - - (ps-output (format "/LineHeight %s def\n" ps-line-height)) - - (ps-output ps-print-prologue) - - (ps-output (format "/f0 %d /%s Font\n" ps-font-size ps-font)) - (ps-output (format "/f1 %d /%s Font\n" ps-font-size ps-font-bold)) - (ps-output (format "/f2 %d /%s Font\n" ps-font-size ps-font-italic)) - (ps-output (format "/f3 %d /%s Font\n" ps-font-size - ps-font-bold-italic)) - + (ps-output-boolean "ShowNofN" ps-show-n-of-n) + (ps-output-boolean "Duplex" ps-spool-duplex) + + (ps-output (format "/LineHeight %s def\n" ps-line-height)) + + (ps-output ps-print-prologue-1) + + ;; Header fonts + (ps-output ; /h0 14 /Helvetica-Bold Font + (format "/h0 %s /%s DefFont\n" ps-header-title-font-size ps-header-title-font)) + (ps-output ; /h1 12 /Helvetica Font + (format "/h1 %s /%s DefFont\n" ps-header-font-size ps-header-font)) + + (ps-output ps-print-prologue-2) + + ;; Text fonts + (ps-output (format "/f0 %s /%s DefFont\n" ps-font-size ps-font)) + (ps-output (format "/f1 %s /%s DefFont\n" ps-font-size ps-font-bold)) + (ps-output (format "/f2 %s /%s DefFont\n" ps-font-size ps-font-italic)) + (ps-output (format "/f3 %s /%s DefFont\n" ps-font-size ps-font-bold-italic)) + + (ps-output "\nBeginDoc\n\n") (ps-output "%%EndPrologue\n")) (defun ps-header-dirpart () @@ -1333,17 +2231,23 @@ ""))) (defun ps-get-buffer-name () - ;; Indulge me this little easter egg: - (if (string= (buffer-name) "ps-print.el") - "Hey, Cool! It's ps-print.el!!!" - (buffer-name))) + (cond + ;; Indulge Jim this little easter egg: + ((string= (buffer-name) "ps-print.el") + "Hey, Cool! It's ps-print.el!!!") + ;; Indulge Jack this other little easter egg: + ((string= (buffer-name) "sokoban.el") + "Super! C'est sokoban.el!") + (t (buffer-name)))) (defun ps-begin-job () (setq ps-page-count 0)) (defun ps-end-file () + (ps-output "\nEndDoc\n\n") (ps-output "%%Trailer\n") - (ps-output "%%Pages: " (format "%d\n" ps-showpage-count))) + (ps-output (format "%%%%Pages: %d\n" (1+ (/ (1- ps-page-count) + ps-number-of-columns))))) (defun ps-next-page () (ps-end-page) @@ -1352,36 +2256,28 @@ (defun ps-begin-page (&optional dummypage) (ps-get-page-dimensions) - (setq ps-width-remaining ps-print-width) + (setq ps-width-remaining ps-print-width) (setq ps-height-remaining ps-print-height) - ;; If headers are turned on, deduct the height of the header from - ;; the print height remaining. Clumsy clumsy clumsy. - (if ps-print-header - (setq ps-height-remaining - (- ps-height-remaining - ps-header-title-line-height - (* ps-header-line-height (- ps-header-lines 1)) - (* 2 ps-header-pad)))) - - (setq ps-page-count (+ ps-page-count 1)) - - (ps-output "\n%%Page: " - (format "%d %d\n" ps-page-count (+ 1 ps-showpage-count))) + ;; Print only when a new real page begins. + (when (zerop (mod ps-page-count ps-number-of-columns)) + (ps-output (format "\n%%%%Page: %d %d\n" + (1+ (/ ps-page-count ps-number-of-columns)) + (1+ (/ ps-page-count ps-number-of-columns))))) + (ps-output "BeginDSCPage\n") - (ps-output (format "/PageNumber %d def\n" ps-page-count)) + (ps-output (format "/PageNumber %d def\n" (incf ps-page-count))) (ps-output "/PageCount 0 def\n") - (if ps-print-header - (progn - (ps-generate-header "HeaderLinesLeft" ps-left-header) - (ps-generate-header "HeaderLinesRight" ps-right-header) - (ps-output (format "%d SetHeaderLines\n" ps-header-lines)))) + (when ps-print-header + (ps-generate-header "HeaderLinesLeft" ps-left-header) + (ps-generate-header "HeaderLinesRight" ps-right-header) + (ps-output (format "%d SetHeaderLines\n" ps-header-lines))) (ps-output "BeginPage\n") - (ps-set-font ps-current-font) - (ps-set-bg ps-current-bg) - (ps-set-color ps-current-color) + (ps-set-font ps-current-font) + (ps-set-bg ps-current-bg) + (ps-set-color ps-current-color) (ps-set-underline ps-current-underline-p)) (defun ps-end-page () @@ -1401,17 +2297,19 @@ (defun ps-next-line () (if (< ps-height-remaining ps-line-height) (ps-next-page) - (setq ps-width-remaining ps-print-width) + (setq ps-width-remaining ps-print-width) (setq ps-height-remaining (- ps-height-remaining ps-line-height)) (ps-hard-lf))) (defun ps-continue-line () (if (< ps-height-remaining ps-line-height) (ps-next-page) - (setq ps-width-remaining ps-print-width) + (setq ps-width-remaining ps-print-width) (setq ps-height-remaining (- ps-height-remaining ps-line-height)) (ps-soft-lf))) +;; [jack] Why hard and soft ? + (defun ps-hard-lf () (ps-output "HL\n")) @@ -1430,7 +2328,7 @@ (to (car wrappoint)) (string (buffer-substring from to))) (ps-output-string string) - (ps-output " S\n") ; + (ps-output " S\n") wrappoint)) (defun ps-basic-plot-whitespace (from to &optional bg-color) @@ -1461,14 +2359,12 @@ (if (< q-todo 100) (/ (* 100 q-done) q-todo) (/ q-done (/ q-todo 100)))) - (message "Formatting...%d%%" foo)))))) + (message "Formatting...%3d%%" foo)))))) (defun ps-set-font (font) (setq ps-current-font font) (ps-output (format "/f%d F\n" ps-current-font))) -(defvar ps-print-color-scale nil) - (defun ps-set-bg (color) (if (setq ps-current-bg color) (ps-output (format ps-color-format (nth 0 color) (nth 1 color) @@ -1548,11 +2444,8 @@ (defun ps-color-values (x-color) (cond ((fboundp 'x-color-values) (x-color-values x-color)) - ;; From fsf 19.33 - ;; ((fboundp 'pixel-components) - ;; (pixel-components x-color)) ((and (fboundp 'color-instance-rgb-components) - (xemacs-color-device)) + (ps-color-device)) (color-instance-rgb-components (if (color-instance-p x-color) x-color (if (color-specifier-p x-color) @@ -1597,13 +2490,13 @@ (foreground (nth 3 face-attr)) (background (nth 4 face-attr)) (fg-color (if (and ps-print-color-p - (xemacs-color-device) + (ps-color-device) foreground) (mapcar 'ps-color-value (ps-color-values foreground)) ps-default-color)) (bg-color (if (and ps-print-color-p - (xemacs-color-device) + (ps-color-device) background) (mapcar 'ps-color-value (ps-color-values background))))) @@ -1630,9 +2523,6 @@ (memq face kind-list)))) (defun ps-xemacs-face-kind-p (face kind kind-regex kind-list) - ;; fsf 19.33: - ;; (let* ((frame-font (or (face-font face) (face-font 'default))) - ;; (kind-cons (assq kind (x-font-properties frame-font))) (let* ((frame-font (or (face-font-instance face) (face-font-instance 'default))) (kind-cons (and frame-font @@ -1694,17 +2584,14 @@ (list (extent-end-position extent) 'pull extent))) nil) -(defun ps-sorter (a b) - (< (car a) (car b))) - (defun ps-extent-sorter (a b) (< (extent-priority a) (extent-priority b))) (defun ps-print-ensure-fontified (start end) (if (and (boundp 'lazy-lock-mode) lazy-lock-mode) (if (fboundp 'lazy-lock-fontify-region) - (lazy-lock-fontify-region start end) - (lazy-lock-fontify-buffer)))) + (lazy-lock-fontify-region start end) ; the new + (lazy-lock-fontify-buffer)))) ; the old (defun ps-generate-postscript-with-faces (from to) ;; Build the reference lists of faces if necessary. @@ -1717,7 +2604,7 @@ ;; that ps-print can be dumped into emacs. This expression can't be ;; evaluated at dump-time because X isn't initialized. (setq ps-print-color-scale - (if (and ps-print-color-p (xemacs-color-device)) + (if (and ps-print-color-p (ps-color-device)) (float (car (ps-color-values "white"))) 1.0)) ;; Generate some PostScript. @@ -1726,13 +2613,13 @@ (let ((face 'default) (position to)) (ps-print-ensure-fontified from to) - (cond ((or (eq ps-print-emacs-type 'lucid) (eq ps-print-emacs-type 'xemacs)) + (cond ((or (eq ps-print-emacs-type 'lucid) + (eq ps-print-emacs-type 'xemacs)) ;; Build the list of extents... (let ((a (cons 'dummy nil)) record type extent extent-list) (map-extents 'ps-mapper nil from to a) - (setq a (cdr a)) - (setq a (sort a 'ps-sorter)) + (setq a (sort (cdr a) 'car-less-than-car)) (setq extent-list nil) @@ -1843,7 +2730,7 @@ (save-restriction (narrow-to-region from to) (if ps-razzle-dazzle - (message "Formatting...%d%%" (setq ps-razchunk 0))) + (message "Formatting...%3d%%" (setq ps-razchunk 0))) (set-buffer buffer) (setq ps-source-buffer buffer) (setq ps-spool-buffer (get-buffer-create ps-spool-buffer-name)) @@ -1899,13 +2786,10 @@ (if ps-razzle-dazzle (message "Formatting...done"))))) -;; XEmacs change -(require 'message) ; Until We can get some sensible autoloads, or - ; message-flatten-list gets put somewhere decent. ;; Permit dynamic evaluation at print time of ps-lpr-switches (defun ps-do-despool (filename) (if (or (not (boundp 'ps-spool-buffer)) - (not ps-spool-buffer)) + (not (symbol-value 'ps-spool-buffer))) (message "No spooled PostScript to print") (ps-end-file) (ps-flush-output) @@ -1926,15 +2810,8 @@ (if (and (eq system-type 'ms-dos) (stringp dos-ps-printer)) (write-region (point-min) (point-max) dos-ps-printer t 0) (let ((binary-process-input t) ; for MS-DOS - (ps-lpr-sw (message-flatten-list ; XEmacs - (mapcar '(lambda (arg) ; Dynamic evaluation - (cond ((stringp arg) arg) - ((functionp arg) (apply arg nil)) - ((symbolp arg) (eval arg)) - ((consp arg) (apply (car arg) - (cdr arg))) - (t nil))) - ps-lpr-switches)))) + (ps-lpr-sw ; Dynamic evaluation + (ps-flatten-list (mapcar 'ps-eval-switch ps-lpr-switches)))) (apply 'call-process-region (point-min) (point-max) ps-lpr-command nil (if (fboundp 'start-process) 0 nil) @@ -1944,6 +2821,32 @@ (message "Printing...done"))) (kill-buffer ps-spool-buffer))) +;; Dynamic evaluation +(defun ps-eval-switch (arg) + (cond ((stringp arg) arg) + ((functionp arg) (apply arg nil)) + ((symbolp arg) (symbol-value arg)) + ((consp arg) (apply (car arg) (cdr arg))) + (t nil))) + +;; `ps-flatten-list' is defined here (copied from "message.el" and +;; enhanced to handle dotted pairs as well) until we can get some +;; sensible autoloads, or `flatten-list' gets put somewhere decent. + +;; (ps-flatten-list '((a . b) c (d . e) (f g h) i . j)) +;; => (a b c d e f g h i j) + +(defun ps-flatten-list (&rest list) + (ps-flatten-list-1 list)) + +(defun ps-flatten-list-1 (list) + (cond + ((null list) (list)) + ((consp list) + (append (ps-flatten-list-1 (car list)) + (ps-flatten-list-1 (cdr list)))) + (t (list list)))) + (defun ps-kill-emacs-check () (let (ps-buffer) (if (and (setq ps-buffer (get-buffer ps-spool-buffer-name)) @@ -2057,9 +2960,9 @@ ;; same thing for vm. (defun ps-vm-print-message-from-summary () (interactive) - (if vm-mail-buffer + (if (and (boundp 'vm-mail-buffer) (symbol-value 'vm-mail-buffer)) (save-excursion - (set-buffer vm-mail-buffer) + (set-buffer (symbol-value 'vm-mail-buffer)) (ps-spool-buffer-with-faces)))) ;; A hook to bind to bind to gnus-summary-setup-buffer to locally bind @@ -2092,8 +2995,8 @@ ;; WARNING! The following function is a *sample* only, and is *not* ;; meant to be used as a whole unless you understand what the effects -;; will be! (In fact, this is a copy if my setup for ps-print -- I'd -;; be very surprised if it was useful to *anybody*, without +;; will be! (In fact, this is a copy of Jim's setup for ps-print -- +;; I'd be very surprised if it was useful to *anybody*, without ;; modification.) (defun ps-jts-ps-setup () @@ -2108,7 +3011,43 @@ (setq ps-spool-duplex t) (setq ps-print-color-p nil) (setq ps-lpr-command "lpr") - (setq ps-lpr-switches '("-Jjct,duplex_long"))) + (setq ps-lpr-switches '("-Jjct,duplex_long")) + 'ps-jts-ps-setup) + +;; WARNING! The following function is a *sample* only, and is *not* +;; meant to be used as a whole unless it corresponds to your needs. +;; (In fact, this is a copy of Jack's setup for ps-print -- +;; I would not be that surprised if it was useful to *anybody*, +;; without modification.) + +(defun ps-jack-setup () + (setq ps-print-color-p 'nil + ps-lpr-command "lpr" + ps-lpr-switches (list) + + ps-paper-type 'a4 + ps-landscape-mode 't + ps-number-of-columns 2 + + ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm + ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm + ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm + ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm + ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm + ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm + ps-header-line-pad .15 + ps-print-header t + ps-print-header-frame t + ps-header-lines 2 + ps-show-n-of-n t + ps-spool-duplex nil + + ps-font-family 'Courier + ps-font-size 5.5 + ps-header-font-family 'Helvetica + ps-header-font-size 6 + ps-header-title-font-size 8) + 'ps-jack-setup) (provide 'ps-print) diff -r ebca3d831cea -r 6a378aca36af lisp/prim/auto-autoloads.el --- a/lisp/prim/auto-autoloads.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/prim/auto-autoloads.el Mon Aug 13 09:07:36 2007 +0200 @@ -1207,13 +1207,18 @@ ;;;*** -;;;### (autoloads (ediff-toggle-multiframe) "ediff-util" "ediff/ediff-util.el") +;;;### (autoloads (ediff-toggle-use-toolbar ediff-toggle-multiframe) "ediff-util" "ediff/ediff-util.el") (autoload 'ediff-toggle-multiframe "ediff-util" "\ -Switch from the multiframe display to single-frame display and back. -For a permanent change, set the variable `ediff-window-setup-function', +Switch from multiframe display to single-frame display and back. +To change the default, set the variable `ediff-window-setup-function', which see." t nil) +(autoload 'ediff-toggle-use-toolbar "ediff-util" "\ +Enable or disable Ediff toolbar. +Works only in versions of Emacs that support toolbars. +To change the default, set the variable `ediff-use-toolbar-p', which see." t nil) + ;;;*** ;;;### (autoloads (ediff-documentation ediff-version ediff-revision ediff-patch-buffer ediff-patch-file run-ediff-from-cvs-buffer ediff-merge-revisions-with-ancestor ediff-merge-revisions ediff-merge-buffers-with-ancestor ediff-merge-buffers ediff-merge-files-with-ancestor ediff-merge-files ediff-regions-linewise ediff-regions-wordwise ediff-windows-linewise ediff-windows-wordwise ediff-merge-directory-revisions-with-ancestor ediff-merge-directory-revisions ediff-merge-directories-with-ancestor ediff-merge-directories ediff-directories3 ediff-directory-revisions ediff-directories ediff-buffers3 ediff-buffers ediff-files3 ediff-files) "ediff" "ediff/ediff.el") @@ -3654,7 +3659,7 @@ ;;;### (autoloads (ksh-mode) "ksh-mode" "modes/ksh-mode.el") (autoload 'ksh-mode "ksh-mode" "\ -ksh-mode $Revision: 1.4 $ - Major mode for editing (Bourne, Korn or Bourne again) +ksh-mode $Revision: 1.5 $ - Major mode for editing (Bourne, Korn or Bourne again) shell scripts. Special key bindings and commands: \\{ksh-mode-map} @@ -4951,7 +4956,7 @@ (autoload 'vhdl-mode "vhdl-mode" "\ Major mode for editing VHDL code. -vhdl-mode $Revision: 1.4 $ +vhdl-mode $Revision: 1.5 $ 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 @@ -7010,13 +7015,14 @@ ;;;*** -;;;### (autoloads (ps-despool ps-spool-region-with-faces ps-spool-region ps-spool-buffer-with-faces ps-spool-buffer ps-print-region-with-faces ps-print-region ps-print-buffer-with-faces ps-print-buffer) "ps-print" "packages/ps-print.el") - -(defvar ps-paper-type 'ps-letter "\ -*Specifies the size of paper to format for. Should be one of -`ps-letter', `ps-legal', or `ps-a4'.") - -(defvar ps-print-color-p (and (or (fboundp 'x-color-values) (fboundp 'color-instance-rgb-components)) (fboundp 'float)) "\ +;;;### (autoloads (ps-setup ps-nb-pages-region ps-nb-pages-buffer ps-line-lengths ps-despool ps-spool-region-with-faces ps-spool-region ps-spool-buffer-with-faces ps-spool-buffer ps-print-region-with-faces ps-print-region ps-print-buffer-with-faces ps-print-buffer) "ps-print" "packages/ps-print.el") + +(defvar ps-paper-type 'letter "\ +*Specifies the size of paper to format for. +Should be one of the paper types defined in `ps-page-dimensions-database', for +example `letter', `legal' or `a4'.") + +(defvar ps-print-color-p (or (fboundp 'x-color-values) (fboundp 'color-instance-rgb-components)) "\ *If non-nil, print the buffer's text in color.") (autoload 'ps-print-buffer "ps-print" "\ @@ -7088,6 +7094,25 @@ the PostScript image in a file with that name. If FILENAME is a number, prompt the user for the name of the file to save in." t nil) +(autoload 'ps-line-lengths "ps-print" "\ +*Display the correspondance between a line length and a font size, +using the current ps-print setup. +Try: pr -t file | awk '{printf \"%3d %s +\", length($0), $0}' | sort -r | head" t nil) + +(autoload 'ps-nb-pages-buffer "ps-print" "\ +*Display an approximate correspondance between a font size and the number +of pages the current buffer would require to print +using the current ps-print setup." t nil) + +(autoload 'ps-nb-pages-region "ps-print" "\ +*Display an approximate correspondance between a font size and the number +of pages the current region would require to print +using the current ps-print setup." t nil) + +(autoload 'ps-setup "ps-print" "\ +*Return the current setup" nil nil) + ;;;*** ;;;### (autoloads (remote-compile) "rcompile" "packages/rcompile.el") @@ -9479,13 +9504,8 @@ (autoload 'w3-fetch "w3" "\ Retrieve a document over the World Wide Web. -The World Wide Web is a global hypertext system started by CERN in -Switzerland in 1991. - -The document should be specified by its fully specified -Uniform Resource Locator. The document will be parsed, printed, or -passed to an external viewer as appropriate. Variable -`mm-mime-info' specifies viewers for particular file types." t nil) +Defaults to URL of the current document, if any. +With prefix argument, use the URL of the hyperlink under point instead." t nil) (autoload 'w3-maybe-follow-link-mouse "w3" "\ Maybe follow a hypertext link under point. diff -r ebca3d831cea -r 6a378aca36af lisp/prim/files.el --- a/lisp/prim/files.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/prim/files.el Mon Aug 13 09:07:36 2007 +0200 @@ -1430,7 +1430,7 @@ ;; Parse the -*- line into the `result' alist. (cond ((not (search-forward "-*-" end t)) ;; doesn't have one. - nil) + (setq force t)) ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)") ;; Antiquated form: "-*- ModeName -*-". (setq result diff -r ebca3d831cea -r 6a378aca36af lisp/prim/window.el --- a/lisp/prim/window.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/prim/window.el Mon Aug 13 09:07:36 2007 +0200 @@ -294,23 +294,25 @@ ; 'menu-bar-lines params) 0))) (unwind-protect - (progn - (select-window (or window w)) + (let ((shrinkee (or window w))) + (set-buffer (window-buffer shrinkee)) (goto-char (point-min)) (while (pos-visible-in-window-p (- (point-max) - (if ignore-final-newline 1 0))) + (if ignore-final-newline 1 0)) + shrinkee) ;; defeat file locking... don't try this at home, kids! (setq buffer-file-name nil) (insert ?\n) (setq n (1+ n))) (if (> n 0) (shrink-window (min (1- n) - (- (window-height) - window-min-height))))) + (- (window-height shrinkee) + window-min-height)) + nil + shrinkee))) (delete-region (point-min) (point)) (set-buffer-modified-p modified) (goto-char p) - (select-window w) ;; Make sure we unbind buffer-read-only ;; with the proper current buffer. (set-buffer buffer)))))) diff -r ebca3d831cea -r 6a378aca36af lisp/psgml/ChangeLog --- a/lisp/psgml/ChangeLog Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/psgml/ChangeLog Mon Aug 13 09:07:36 2007 +0200 @@ -1,3 +1,7 @@ +Thu Jan 16 18:23:51 1997 Steven L Baur + + * psgml.el: Use newer interface form of nsgmls. + Wed Nov 20 19:40:05 1996 Lennart Staflin * psgml-parse.el (sgml-modify-dtd): set sgml-current-tree to diff -r ebca3d831cea -r 6a378aca36af lisp/psgml/psgml.el --- a/lisp/psgml/psgml.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/psgml/psgml.el Mon Aug 13 09:07:36 2007 +0200 @@ -1,5 +1,5 @@ ;;; psgml.el --- SGML-editing mode with parsing support -;; $Id: psgml.el,v 1.2 1997/01/03 03:10:28 steve Exp $ +;; $Id: psgml.el,v 1.3 1997/01/23 05:29:40 steve Exp $ ;; Copyright (C) 1993, 1994, 1995, 1996 Lennart Staflin ;; Copyright (C) 1992 Free Software Foundation, Inc. @@ -455,7 +455,9 @@ ;;; Its error messages can be parsed by next-error. ;;; The -s option suppresses output. -(defvar sgml-validate-command "nsgmls -s %s %s" +(defvar sgml-validate-command (concat "nsgmls -s -m " + data-directory + "CATALOG %s %s") "*The shell command to validate an SGML document. This is a `format' control string that by default should contain two diff -r ebca3d831cea -r 6a378aca36af lisp/tl/emu-x20.el --- a/lisp/tl/emu-x20.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/tl/emu-x20.el Mon Aug 13 09:07:36 2007 +0200 @@ -4,7 +4,7 @@ ;; Copyright (C) 1994,1995,1996 MORIOKA Tomohiko ;; Author: MORIOKA Tomohiko -;; Version: $Id: emu-x20.el,v 1.1.1.2 1996/12/21 20:50:48 steve Exp $ +;; Version: $Id: emu-x20.el,v 1.2 1997/01/23 05:29:40 steve Exp $ ;; Keywords: emulation, compatibility, Mule, XEmacs ;; This file is part of tl (Tiny Library). @@ -170,24 +170,24 @@ ;;; @ character ;;; -(defun char-bytes (chr) 1) +;(defun char-bytes (chr) 1) -(defun char-length (character) - "Return number of elements a CHARACTER occupies in a string or buffer. -\[emu-x20.el]" - 1) +;(defun char-length (character) +; "Return number of elements a CHARACTER occupies in a string or buffer. +;\[emu-x20.el]" +; 1) -(defun char-columns (character) - "Return number of columns a CHARACTER occupies when displayed. -\[emu-x20.el]" - (charset-columns (char-charset character)) - ) +;(defun char-columns (character) +; "Return number of columns a CHARACTER occupies when displayed. +;\[emu-x20.el]" +; (charset-columns (char-charset character)) +; ) ;;; @@ Mule emulating aliases ;;; ;;; You should not use them. -(defalias 'char-width 'char-columns) +;(defalias 'char-width 'char-columns) (defalias 'char-leading-char 'char-charset) @@ -206,34 +206,34 @@ ;;; @ string ;;; -(defun string-columns (string) - "Return number of columns STRING occupies when displayed. -\[emu-x20.el]" - (let ((col 0) - (len (length string)) - (i 0)) - (while (< i len) - (setq col (+ col (char-columns (aref string i)))) - (setq i (1+ i)) - ) - col)) +;(defun string-columns (string) +; "Return number of columns STRING occupies when displayed. +;\[emu-x20.el]" +; (let ((col 0) +; (len (length string)) +; (i 0)) +; (while (< i len) +; (setq col (+ col (char-columns (aref string i)))) +; (setq i (1+ i)) +; ) +; col)) -(defalias 'string-width 'string-columns) +;(defalias 'string-width 'string-columns) (defun string-to-int-list (str) (mapcar #'char-int str) ) -(defalias 'sref 'aref) +;(defalias 'sref 'aref) -(defun truncate-string (str width &optional start-column) - "Truncate STR to fit in WIDTH columns. -Optional non-nil arg START-COLUMN specifies the starting column. -\[emu-x20.el; Mule 2.3 emulating function]" - (or start-column - (setq start-column 0)) - (substring str start-column width) - ) +;(defun truncate-string (str width &optional start-column) +; "Truncate STR to fit in WIDTH columns. +;Optional non-nil arg START-COLUMN specifies the starting column. +;\[emu-x20.el; Mule 2.3 emulating function]" +; (or start-column +; (setq start-column 0)) +; (substring str start-column width) +; ) ;;; @ end diff -r ebca3d831cea -r 6a378aca36af lisp/tl/tl-str.el --- a/lisp/tl/tl-str.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/tl/tl-str.el Mon Aug 13 09:07:36 2007 +0200 @@ -4,7 +4,7 @@ ;; Author: MORIOKA Tomohiko ;; Version: -;; $Id: tl-str.el,v 1.1.1.2 1996/12/21 20:50:49 steve Exp $ +;; $Id: tl-str.el,v 1.2 1997/01/23 05:29:41 steve Exp $ ;; Keywords: string ;; This file is part of tl (Tiny Library). @@ -206,8 +206,8 @@ (substring filename 0 (match-beginning 0)) filename)) -(autoload 'replace-as-filename "filename") - +(autoload 'replace-as-filename "filename" + "Return safety filename from STRING. [filename.el]") ;;; @ symbol ;;; diff -r ebca3d831cea -r 6a378aca36af lisp/tm/tm-edit.el --- a/lisp/tm/tm-edit.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/tm/tm-edit.el Mon Aug 13 09:07:36 2007 +0200 @@ -6,7 +6,7 @@ ;; MORIOKA Tomohiko ;; Maintainer: MORIOKA Tomohiko ;; Created: 1994/08/21 renamed from mime.el -;; Version: $Revision: 1.4 $ +;; Version: $Revision: 1.5 $ ;; Keywords: mail, news, MIME, multimedia, multilingual ;; This file is part of tm (Tools for MIME). @@ -119,7 +119,7 @@ ;;; (defconst mime-editor/RCS-ID - "$Id: tm-edit.el,v 1.4 1997/01/11 20:14:11 steve Exp $") + "$Id: tm-edit.el,v 1.5 1997/01/23 05:29:42 steve Exp $") (defconst mime-editor/version (get-version-string mime-editor/RCS-ID)) @@ -649,14 +649,6 @@ ;;; @ functions ;;; -;; The following text was removed from the docstring of the subsequent -;; functions due to problems with the resulting autoload file. -sb - -;; --[[text/plain; charset=ISO-2022-JP]] -;; $B$3$l$O(B charset $B$r(B ISO-2022-JP $B$K;XDj$7$?F|K\8l$N(B plain $B%F%-%9(B -;; $B%H$G$9(B. - - ;;;###autoload (defun mime/editor-mode () "MIME minor mode for editing the tagged MIME message. diff -r ebca3d831cea -r 6a378aca36af lisp/utils/bench.el --- a/lisp/utils/bench.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/utils/bench.el Mon Aug 13 09:07:36 2007 +0200 @@ -1,11 +1,11 @@ ;;; bench.el --- benchmarking utility for emacsen ;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc. -;; $Id: bench.el,v 1.2 1997/01/11 20:14:12 steve Exp $ +;; $Id: bench.el,v 1.3 1997/01/23 05:29:43 steve Exp $ ;; $Source: /afs/informatik.uni-tuebingen.de/local/web/xemacs/xemacs-cvs/XEmacs/xemacs/lisp/utils/Attic/bench.el,v $ -;; $Revision: 1.2 $ +;; $Revision: 1.3 $ ;; $Author: steve $ -;; $Date: 1997/01/11 20:14:12 $ +;; $Date: 1997/01/23 05:29:43 $ ;; Author: Shane Holder ;; Adapted-By: Steve Baur @@ -325,7 +325,7 @@ ;----------------------------------------------------------------------------- (defconst bench-mark-insert-into-empty-buffer-num-words 100000) -(defun bench-handler-insert-into-empty-buffer () +(defun bench-handler-insert-into-empty-buffer (times) (set-buffer (get-buffer-create "*tmp*")) (bench-mark-insert-into-empty-buffer) (erase-buffer) @@ -340,7 +340,7 @@ ) ;============================================================================= -(defconst bench-version (let ((rcsvers "$Revision: 1.2 $")) +(defconst bench-version (let ((rcsvers "$Revision: 1.3 $")) (substring rcsvers 11 (- (length rcsvers) 2))) "*Version number of bench.el") diff -r ebca3d831cea -r 6a378aca36af lisp/utils/finder.el --- a/lisp/utils/finder.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/utils/finder.el Mon Aug 13 09:07:36 2007 +0200 @@ -210,7 +210,7 @@ (defun finder-insert-at-column (column &rest strings) "Insert list of STRINGS, at column COLUMN." - (if (> (current-column) column) (insert "\n")) + (if (>= (current-column) column) (insert "\n")) (move-to-column column) (let ((col (current-column))) (if (< col column) diff -r ebca3d831cea -r 6a378aca36af lisp/utils/timezone.el --- a/lisp/utils/timezone.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/utils/timezone.el Mon Aug 13 09:07:36 2007 +0200 @@ -191,7 +191,16 @@ (substring date (match-beginning year) (match-end year))) ;; It is now Dec 1992. 8 years before the end of the World. (if (< (length year) 4) - (setq year (concat "19" (substring year -2 nil)))) + ;; 2 digit years are bogus, so guess the century + (let ((yr (string-to-int year))) + (when (>= yr 100) + ;; What does a three digit year mean? + (setq yr (- yr 100))) + (setq year (format "%d%02d" + (if (< yr 70) + 20 + 19) + yr)))) (let ((string (substring date (match-beginning month) (+ (match-beginning month) 3)))) diff -r ebca3d831cea -r 6a378aca36af lisp/version.el --- a/lisp/version.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/version.el Mon Aug 13 09:07:36 2007 +0200 @@ -25,7 +25,7 @@ (defconst emacs-version "20.0" "Version numbers of this version of Emacs.") -(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid (beta90)"))) +(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid (beta91)"))) (defconst emacs-major-version (progn (or (string-match "^[0-9]+" emacs-version) diff -r ebca3d831cea -r 6a378aca36af lisp/viper/Makefile --- a/lisp/viper/Makefile Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/viper/Makefile Mon Aug 13 09:07:36 2007 +0200 @@ -26,9 +26,9 @@ # --------- ONLY AUTHORIZED PERSONNEL BEYOND THIS POINT!!! ------------ VIPER = viper.el viper-util.el viper-mous.el viper-ex.el \ - viper-macs.el viper-keym.el + viper-macs.el viper-keym.el viper-init.el VIPERelc = viper-util.elc viper-mous.elc viper-ex.elc viper-macs.elc \ - viper-keym.elc viper.elc + viper-keym.elc viper.elc viper-init.elc all: dvi info hello elc goodbye @@ -89,27 +89,31 @@ @echo "" $(TeX) viperCard.tex -viper-util.elc: viper-util.el +viper-init.elc: viper-init.el + @echo "" + $(EMACS) -batch -f batch-byte-compile viper-init.el + +viper-util.elc: viper-util.el viper-init.el @echo "" $(EMACS) -batch -f batch-byte-compile viper-util.el -viper-ex.elc: viper-ex.el viper-util.el +viper-ex.elc: viper-ex.el viper-util.el viper-init.el @echo "" $(EMACS) -batch -f batch-byte-compile viper-ex.el -viper-mous.elc: viper-mous.el viper-util.el +viper-mous.elc: viper-mous.el viper-util.el viper-init.el @echo "" $(EMACS) -batch -f batch-byte-compile viper-mous.el -viper-macs.elc: viper-macs.el viper-util.el +viper-macs.elc: viper-macs.el viper-util.el viper-init.el @echo "" $(EMACS) -batch -f batch-byte-compile viper-macs.el -viper-keym.elc: viper-keym.el viper-util.el +viper-keym.elc: viper-keym.el viper-util.el viper-init.el @echo "" $(EMACS) -batch -f batch-byte-compile viper-keym.el -viper.elc: viper.el viper-util.el +viper.elc: viper.el viper-util.el viper-init.el @echo "" $(EMACS) -batch -f batch-byte-compile viper.el diff -r ebca3d831cea -r 6a378aca36af lisp/viper/README --- a/lisp/viper/README Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/viper/README Mon Aug 13 09:07:36 2007 +0200 @@ -8,6 +8,7 @@ viper.el -- Viper Emacs Lisp code viper-macs.el -- Viper Emacs Lisp code viper-ex.el -- Viper Emacs Lisp code +viper-init.el -- Viper Emacs Lisp code viper-util.el -- Viper Emacs Lisp code viper-mous.el -- Viper Emacs Lisp code viper-keym.el -- Viper Emacs Lisp code @@ -75,41 +76,7 @@ mentioned in LISPDIR, INFODIR, and ETCDIR. 6. XEmacs users must invoke make with the parameter EMACS=xemacs - or whatever name is used to invoke XEmacs (some sites still use xemacs - for Emacs 18). An even better thing would be to edit Makefile directly - as indicated in the comments there. - -For manual installation, copy viper.elc into a directory on your load-path. - -To install on-line documentation, you need to install the Info files -by copying the files - -viper.info* - -into your Info directory (which is emacs-root-dir/info, -if emacs-root-dir is the root directory of the installation). - -Then edit the file - -emacs-root-dir/info/dir + or whatever name is used to invoke XEmacs (some backward sites + still use xemacs for Emacs 18). An even better thing would be to + edit Makefile directly as indicated in the comments there. -to include the root menu item for Viper (check how other menu -items look like in this file). - -In Emacs, this item should look like this: - -* Viper: (viper.info). A VI Plan to Rescue Emacs and a venomous VI PERil - -In XEmacs, it should look like: - -* Viper:: A VI Plan to Rescue Emacs and a venomous VI PERil - - -If you need a hard copy of the documentation, the files - -viper.dvi -viperCard.dvi - -contain the Viper manual and the quick reference card, respectively. - - diff -r ebca3d831cea -r 6a378aca36af lisp/viper/viper-ex.el --- a/lisp/viper/viper-ex.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/viper/viper-ex.el Mon Aug 13 09:07:36 2007 +0200 @@ -1,6 +1,6 @@ ;;; viper-ex.el --- functions implementing the Ex commands for Viper -;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. @@ -36,15 +36,16 @@ (defvar vip-case-fold-search) (eval-when-compile - (let ((load-path (cons "." load-path))) + (let ((load-path (cons (expand-file-name ".") load-path))) (or (featurep 'viper-util) (load "viper-util.el" nil nil 'nosuffix)) (or (featurep 'viper-keym) (load "viper-keym.el" nil nil 'nosuffix)) + (or (featurep 'viper) + (load "viper.el" nil nil 'nosuffix)) )) ;; end pacifier - (require 'viper-util) @@ -657,7 +658,8 @@ ;; Get an ex-address as a marker and set ex-flag if a flag is found (defun vip-get-ex-address () - (let ((address (point-marker)) (cont t)) + (let ((address (point-marker)) + (cont t)) (setq ex-token "") (setq ex-flag nil) (while cont @@ -1872,7 +1874,11 @@ (defun ex-write (q-flag) (vip-default-ex-addresses t) (vip-get-ex-file) - (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) + (let ((end (car ex-addresses)) + (beg (car (cdr ex-addresses))) + (orig-buf (current-buffer)) + (orig-buf-file-name (buffer-file-name)) + (buff-changed-p (buffer-modified-p)) temp-buf writing-same-file region file-exists writing-whole-file) (if (> beg end) (error vip-FirstAddrExceedsSecond)) @@ -1895,8 +1901,9 @@ buffer-file-name (not (file-directory-p buffer-file-name))) (setq ex-file - (concat ex-file (file-name-nondirectory buffer-file-name)))) - + (concat (file-name-as-directory ex-file) + (file-name-nondirectory buffer-file-name)))) + (setq file-exists (file-exists-p ex-file) writing-same-file (string= ex-file (buffer-file-name))) @@ -1904,34 +1911,52 @@ (if (not (buffer-modified-p)) (message "(No changes need to be saved)") (save-buffer) - (ex-write-info file-exists ex-file beg end)) - ;; writing some other file or portion of the currents - ;; file---create temp buffer for it - ;; disable undo in that buffer, for efficiency - (buffer-disable-undo (setq temp-buf (create-file-buffer ex-file))) - (unwind-protect - (save-excursion - (if (and file-exists - (not writing-same-file) - (not (yes-or-no-p - (format "File %s exists. Overwrite? " ex-file)))) - (error "Quit") - (vip-enlarge-region beg end) - (setq region (buffer-substring (point) (mark t))) - (set-buffer temp-buf) - (set-visited-file-name ex-file) - (erase-buffer) - (if (and file-exists ex-append) - (insert-file-contents ex-file)) - (goto-char (point-max)) - (insert region) - (save-buffer) - (ex-write-info file-exists ex-file (point-min) (point-max)) - )) - (set-buffer temp-buf) - (set-buffer-modified-p nil) - (kill-buffer temp-buf) - )) + (save-restriction + (widen) + (ex-write-info file-exists ex-file (point-min) (point-max)) + )) + ;; writing some other file or portion of the current file + (cond ((and file-exists + (not writing-same-file) + (not (yes-or-no-p + (format "File %s exists. Overwrite? " ex-file)))) + (error "Quit")) + ((and writing-whole-file (not ex-append)) + (unwind-protect + (progn + (set-visited-file-name ex-file) + (set-buffer-modified-p t) + (save-buffer)) + ;; restore the buffer file name + (set-visited-file-name orig-buf-file-name) + (set-buffer-modified-p buff-changed-p)) + (save-restriction + (widen) + (ex-write-info + file-exists ex-file (point-min) (point-max)))) + (t ; writing a region + (unwind-protect + (save-excursion + (vip-enlarge-region beg end) + (setq region (buffer-substring (point) (mark t))) + ;; create temp buffer for the region + (setq temp-buf (get-buffer-create " *ex-write*")) + (set-buffer temp-buf) + (set-visited-file-name ex-file 'noquerry) + (erase-buffer) + (if (and file-exists ex-append) + (insert-file-contents ex-file)) + (goto-char (point-max)) + (insert region) + (save-buffer) + (ex-write-info + file-exists ex-file (point-min) (point-max)) + )) + (set-buffer temp-buf) + (set-buffer-modified-p nil) + (kill-buffer temp-buf)) + )) + (set-buffer orig-buf) ;; this prevents the loss of data if writing part of the buffer (if (and (buffer-file-name) writing-same-file) (set-visited-file-modtime)) diff -r ebca3d831cea -r 6a378aca36af lisp/viper/viper-init.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/viper/viper-init.el Mon Aug 13 09:07:36 2007 +0200 @@ -0,0 +1,674 @@ +;;; viper-init.el --- some common definitions for Viper + +;; Copyright (C) 1997 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;; Code + +(provide 'viper-init) + +;; compiler pacifier +(defvar mark-even-if-inactive) +;; end pacifier + +;; Is it XEmacs? +(defconst vip-xemacs-p (string-match "\\(Lucid\\|XEmacs\\)" emacs-version)) +;; Is it Emacs? +(defconst vip-emacs-p (not vip-xemacs-p)) +;; Tell whether we are running as a window application or on a TTY +(defsubst vip-device-type () + (if vip-emacs-p + window-system + (device-type (selected-device)))) +;; in XEmacs: device-type is tty on tty and stream in batch. +(defun vip-window-display-p () + (and (vip-device-type) (not (memq (vip-device-type) '(tty stream pc))))) + +(defvar vip-ms-style-os-p (memq system-type '(ms-dos windows-nt windows-95)) + "Tells if Emacs is running under an MS-style OS: ms-dos, windows-nt, W95.") +(defvar vip-vms-os-p (memq system-type '(vax-vms axp-vms)) + "Tells if Emacs is running under VMS.") + +(defvar vip-force-faces nil + "If t, Viper will think that it is running on a display that supports faces. +This is provided as a temporary relief for users of face-capable displays +that Viper doesn't know about.") + +(defun vip-has-face-support-p () + (cond ((vip-window-display-p)) + (vip-force-faces) + (vip-emacs-p (memq (vip-device-type) '(pc))) + (vip-xemacs-p (memq (vip-device-type) '(tty pc))))) + +(defun vip-convert-standard-file-name (fname) + (if vip-emacs-p + (convert-standard-filename fname) + ;; hopefully, XEmacs adds this functionality + fname)) + + +;;; Macros + +(defmacro vip-deflocalvar (var default-value &optional documentation) + (` (progn + (defvar (, var) (, default-value) + (, (format "%s\n\(buffer local\)" documentation))) + (make-variable-buffer-local '(, var)) + ))) + +(defmacro vip-loop (count body) + "(vip-loop COUNT BODY) Execute BODY COUNT times." + (list 'let (list (list 'count count)) + (list 'while '(> count 0) + body + '(setq count (1- count)) + ))) + +(defmacro vip-buffer-live-p (buf) + (` (and (, buf) (get-buffer (, buf)) (buffer-name (get-buffer (, buf)))))) + +;; return buffer-specific macro definition, given a full macro definition +(defmacro vip-kbd-buf-alist (macro-elt) + (` (nth 1 (, macro-elt)))) +;; get a pair: (curr-buffer . macro-definition) +(defmacro vip-kbd-buf-pair (macro-elt) + (` (assoc (buffer-name) (vip-kbd-buf-alist (, macro-elt))))) +;; get macro definition for current buffer +(defmacro vip-kbd-buf-definition (macro-elt) + (` (cdr (vip-kbd-buf-pair (, macro-elt))))) + +;; return mode-specific macro definitions, given a full macro definition +(defmacro vip-kbd-mode-alist (macro-elt) + (` (nth 2 (, macro-elt)))) +;; get a pair: (major-mode . macro-definition) +(defmacro vip-kbd-mode-pair (macro-elt) + (` (assoc major-mode (vip-kbd-mode-alist (, macro-elt))))) +;; get macro definition for the current major mode +(defmacro vip-kbd-mode-definition (macro-elt) + (` (cdr (vip-kbd-mode-pair (, macro-elt))))) + +;; return global macro definition, given a full macro definition +(defmacro vip-kbd-global-pair (macro-elt) + (` (nth 3 (, macro-elt)))) +;; get global macro definition from an elt of macro-alist +(defmacro vip-kbd-global-definition (macro-elt) + (` (cdr (vip-kbd-global-pair (, macro-elt))))) + +;; last elt of a sequence +(defsubst vip-seq-last-elt (seq) + (elt seq (1- (length seq)))) + + +(defvar vip-minibuffer-overlay-priority 300) +(defvar vip-replace-overlay-priority 400) +(defvar vip-search-overlay-priority 500) + + +;;; Viper minor modes + +;; This is not local in Emacs, so we make it local. +;; This must be local because although the stack of minor modes can be the same +;; for all buffers, the associated *keymaps* can be different. In Viper, +;; vip-vi-local-user-map, vip-insert-local-user-map, and others can have +;; different keymaps for different buffers. +;; Also, the keymaps associated with vip-vi/insert-state-modifier-minor-mode +;; can be different. +(make-variable-buffer-local 'minor-mode-map-alist) + +;; Mode for vital things like \e, C-z. +(vip-deflocalvar vip-vi-intercept-minor-mode nil) + +(vip-deflocalvar vip-vi-basic-minor-mode nil + "Viper's minor mode for Vi bindings.") + +(vip-deflocalvar vip-vi-local-user-minor-mode nil + "Auxiliary minor mode for user-defined local bindings in Vi state.") + +(vip-deflocalvar vip-vi-global-user-minor-mode nil + "Auxiliary minor mode for user-defined global bindings in Vi state.") + +(vip-deflocalvar vip-vi-state-modifier-minor-mode nil + "Minor mode used to make major-mode-specific modification to Vi state.") + +(vip-deflocalvar vip-vi-diehard-minor-mode nil + "This minor mode is in effect when the user wants Viper to be Vi.") + +(vip-deflocalvar vip-vi-kbd-minor-mode nil + "Minor mode for Ex command macros in Vi state. +The corresponding keymap stores key bindings of Vi macros defined with +the Ex command :map.") + +;; Mode for vital things like \e, C-z. +(vip-deflocalvar vip-insert-intercept-minor-mode nil) + +(vip-deflocalvar vip-insert-basic-minor-mode nil + "Viper's minor mode for bindings in Insert mode.") + +(vip-deflocalvar vip-insert-local-user-minor-mode nil + "Auxiliary minor mode for buffer-local user-defined bindings in Insert state. +This is a way to overshadow normal Insert mode bindings locally to certain +designated buffers.") + +(vip-deflocalvar vip-insert-global-user-minor-mode nil + "Auxiliary minor mode for global user-defined bindings in Insert state.") + +(vip-deflocalvar vip-insert-state-modifier-minor-mode nil + "Minor mode used to make major-mode-specific modification to Insert state.") + +(vip-deflocalvar vip-insert-diehard-minor-mode nil + "Minor mode that simulates Vi very closely. +Not recommened, except for the novice user.") + +(vip-deflocalvar vip-insert-kbd-minor-mode nil +"Minor mode for Ex command macros Insert state. +The corresponding keymap stores key bindings of Vi macros defined with +the Ex command :map!.") + +(vip-deflocalvar vip-replace-minor-mode nil + "Minor mode in effect in replace state (cw, C, and the like commands).") + +;; Mode for vital things like \C-z and \C-x) +;; This is t, by default. So, any new buffer will have C-z defined as +;; switch to Vi, unless we switched states in this buffer +(vip-deflocalvar vip-emacs-intercept-minor-mode t) + +(vip-deflocalvar vip-emacs-local-user-minor-mode t + "Minor mode for local user bindings effective in Emacs state. +Users can use it to override Emacs bindings when Viper is in its Emacs +state.") + +(vip-deflocalvar vip-emacs-global-user-minor-mode t + "Minor mode for global user bindings in effect in Emacs state. +Users can use it to override Emacs bindings when Viper is in its Emacs +state.") + +(vip-deflocalvar vip-emacs-kbd-minor-mode t + "Minor mode for Vi style macros in Emacs state. +The corresponding keymap stores key bindings of Vi macros defined with +`vip-record-kbd-macro' command. There is no Ex-level command to do this +interactively.") + +(vip-deflocalvar vip-emacs-state-modifier-minor-mode t + "Minor mode used to make major-mode-specific modification to Emacs state. +For instance, a Vi purist may want to bind `dd' in Dired mode to a function +that deletes a file.") + +(vip-deflocalvar vip-vi-minibuffer-minor-mode nil + "Minor mode that forces Vi-style when the Minibuffer is in Vi state.") + +(vip-deflocalvar vip-insert-minibuffer-minor-mode nil + "Minor mode that forces Vi-style when the Minibuffer is in Insert state.") + + + +;; Some common error messages + +(defconst vip-SpuriousText "Spurious text after command" "") +(defconst vip-BadExCommand "Not an editor command" "") +(defconst vip-InvalidCommandArgument "Invalid command argument" "") +(defconst vip-NoPrevSearch "No previous search string" "") +(defconst vip-EmptyRegister "`%c': Nothing in this register" "") +(defconst vip-InvalidRegister "`%c': Invalid register" "") +(defconst vip-EmptyTextmarker "`%c': Text marker doesn't point anywhere" "") +(defconst vip-InvalidTextmarker "`%c': Invalid text marker" "") +(defconst vip-InvalidViCommand "Invalid command" "") +(defconst vip-BadAddress "Ill-formed address" "") +(defconst vip-FirstAddrExceedsSecond "First address exceeds second" "") +(defconst vip-NoFileSpecified "No file specified" "") + +;; Is t until viper-mode executes for the very first time. +;; Prevents recursive descend into startup messages. +(defvar vip-first-time t) + +(defvar vip-expert-level 0 + "User's expert level. +The minor mode vip-vi-diehard-minor-mode is in effect when +vip-expert-level is 1 or 2 or when vip-want-emacs-keys-in-vi is t. +The minor mode vip-insert-diehard-minor-mode is in effect when +vip-expert-level is 1 or 2 or if vip-want-emacs-keys-in-insert is t. +Use `M-x vip-set-expert-level' to change this.") + +;; Max expert level supported by Viper. This is NOT a user option. +;; It is here to make it hard for the user from resetting it. +(defconst vip-max-expert-level 5) + +;; Contains user settings for vars affected by vip-set-expert-level function. +;; Not a user option. +(defvar vip-saved-user-settings nil) + + +;;; ISO characters + +(vip-deflocalvar vip-automatic-iso-accents nil + "*If non-nil, ISO accents will be turned on in insert/replace emacs states and turned off in vi-state. +For some users, this behavior may be too primitive. In this case, use +insert/emacs/vi state hooks.") + + +;; VI-style Undo + +;; Used to 'undo' complex commands, such as replace and insert commands. +(vip-deflocalvar vip-undo-needs-adjustment nil) +(put 'vip-undo-needs-adjustment 'permanent-local t) + +;; A mark that Viper puts on buffer-undo-list. Marks the beginning of a +;; complex command that must be undone atomically. If inserted, it is +;; erased by vip-change-state-to-vi and vip-repeat. +(defconst vip-buffer-undo-list-mark 'viper) + +(defvar vip-keep-point-on-undo nil + "*Non-nil means not to move point while undoing commands. +This style is different from Emacs and Vi. Try it to see if +it better fits your working style.") + +;; Replace mode and changing text + +;; Viper's own after/before change functions, which get vip-add-hook'ed to +;; Emacs's +(vip-deflocalvar vip-after-change-functions nil "") +(vip-deflocalvar vip-before-change-functions nil "") +(vip-deflocalvar vip-post-command-hooks nil "") +(vip-deflocalvar vip-pre-command-hooks nil "") + +;; Can be used to pass global states around for short period of time +(vip-deflocalvar vip-intermediate-command nil "") + +;; Indicates that the current destructive command has started in replace mode. +(vip-deflocalvar vip-began-as-replace nil "") + +(defvar vip-allow-multiline-replace-regions t + "If non-nil, Viper will allow multi-line replace regions. +This is an extension to standard Vi. +If nil, commands that attempt to replace text spanning multiple lines first +delete the text being replaced, as in standard Vi.") + +(defvar vip-replace-overlay-cursor-color "Red" + "*Cursor color to use in Replace state") +(defvar vip-insert-state-cursor-color nil + "Cursor color for Viper insert state.") +(put 'vip-insert-state-cursor-color 'permanent-local t) +;; place to save cursor colow when switching to insert mode +(vip-deflocalvar vip-saved-cursor-color nil "") + +(vip-deflocalvar vip-replace-overlay nil "") +(put 'vip-replace-overlay 'permanent-local t) + +(defvar vip-replace-overlay-pixmap "gray3" + "Pixmap to use for search face on non-color displays.") +(defvar vip-search-face-pixmap "gray3" + "Pixmap to use for search face on non-color displays.") + + +(defvar vip-replace-region-end-delimiter "$" + "A string marking the end of replacement regions. +It is used only with TTYs or if `vip-use-replace-region-delimiters' +is non-nil.") +(defvar vip-replace-region-start-delimiter "" + "A string marking the beginning of replacement regions. +It is used only with TTYs or if `vip-use-replace-region-delimiters' +is non-nil.") +(defvar vip-use-replace-region-delimiters (not (vip-has-face-support-p)) + "*If non-nil, Viper will always use `vip-replace-region-end-delimiter' and +`vip-replace-region-start-delimiter' to delimit replacement regions, even on +color displays. By default, the delimiters are used only on TTYs.") + +;; XEmacs requires glyphs +(if vip-xemacs-p + (progn + (or (glyphp vip-replace-region-end-delimiter) + (setq vip-replace-region-end-delimiter + (make-glyph vip-replace-region-end-delimiter))) + (or (glyphp vip-replace-region-start-delimiter) + (setq vip-replace-region-start-delimiter + (make-glyph vip-replace-region-start-delimiter))) + )) + + +;; These are local marker that must be initialized to nil and moved with +;; `vip-move-marker-locally' +;; +;; Remember the last position inside the replace region. +(vip-deflocalvar vip-last-posn-in-replace-region nil) +;; Remember the last position while inserting +(vip-deflocalvar vip-last-posn-while-in-insert-state nil) +(put 'vip-last-posn-in-replace-region 'permanent-local t) +(put 'vip-last-posn-while-in-insert-state 'permanent-local t) + +(vip-deflocalvar vip-sitting-in-replace nil "") +(put 'vip-sitting-in-replace 'permanent-local t) + +;; Remember the number of characters that have to be deleted in replace +;; mode to compensate for the inserted characters. +(vip-deflocalvar vip-replace-chars-to-delete 0 "") +(vip-deflocalvar vip-replace-chars-deleted 0 "") + +;; Insertion ring and command ring +(defvar vip-insertion-ring-size 14 + "The size of the insertion ring.") +;; The insertion ring. +(defvar vip-insertion-ring nil) +;; This is temp insertion ring. Used to do rotation for display purposes. +;; When rotation just started, it is initialized to vip-insertion-ring. +(defvar vip-temp-insertion-ring nil) +(defvar vip-last-inserted-string-from-insertion-ring "") + +(defvar vip-command-ring-size 14 + "The size of the command ring.") +;; The command ring. +(defvar vip-command-ring nil) +;; This is temp command ring. Used to do rotation for display purposes. +;; When rotation just started, it is initialized to vip-command-ring. +(defvar vip-temp-command-ring nil) + +;; Modes and related variables + +;; Current mode. One of: `emacs-state', `vi-state', `insert-state' +(vip-deflocalvar vip-current-state 'emacs-state) + + +;; Autoindent in insert + +;; Variable that keeps track of whether C-t has been pressed. +(vip-deflocalvar vip-cted nil "") + +;; Preserve the indent value, used by C-d in insert mode. +(vip-deflocalvar vip-current-indent 0) + +;; Whether to preserve the indent, used by C-d in insert mode. +(vip-deflocalvar vip-preserve-indent nil) + +(vip-deflocalvar vip-auto-indent nil + "*Autoindent if t.") +(vip-deflocalvar vip-electric-mode t + "*If t, enable electric behavior. +Currently only enables auto-indentation `according to mode'.") + +(defconst vip-shift-width 8 + "*The shiftwidth variable.") + +;; Variables for repeating destructive commands + +(defconst vip-keep-point-on-repeat t + "*If t, don't move point when repeating previous command. +This is useful for doing repeated changes with the '.' key. +The user can change this to nil, if she likes when the cursor moves +to a new place after repeating previous Vi command.") + +;; Remember insert point as a marker. This is a local marker that must be +;; initialized to nil and moved with `vip-move-marker-locally'. +(vip-deflocalvar vip-insert-point nil) +(put 'vip-insert-point 'permanent-local t) + +;; This remembers the point before dabbrev-expand was called. +;; If vip-insert-point turns out to be bigger than that, it is reset +;; back to vip-pre-command-point. +;; The reason this is needed is because dabbrev-expand (and possibly +;; others) may jump to before the insertion point, delete something and +;; then reinsert a bigger piece. For instance: bla^blo +;; If dabbrev-expand is called after `blo' and ^ undicates vip-insert-point, +;; then point jumps to the beginning of `blo'. If expansion is found, `blablo' +;; is deleted, and we have |^, where | denotes point. Next, dabbrev-expand +;; will insert the expansion, and we get: blablo^ +;; Whatever we insert next goes before the ^, i.e., before the +;; vip-insert-point marker. So, Viper will think that nothing was +;; inserted. Remembering the orig position of the marker circumvents the +;; problem. +;; We don't know of any command, except dabbrev-expand, that has the same +;; problem. However, the same trick can be used if such a command is +;; discovered later. +;; +(vip-deflocalvar vip-pre-command-point nil) +(put 'vip-pre-command-point 'permanent-local t) ; this is probably an overkill + +;; This is used for saving inserted text. +(defvar vip-last-insertion nil) + +;; Remembers the last replaced region. +(defvar vip-last-replace-region "") + +;; Remember com point as a marker. +;; This is a local marker. Should be moved with `vip-move-marker-locally' +(vip-deflocalvar vip-com-point nil) + +;; If non-nil, the value is a list (M-COM VAL COM REG inserted-text cmd-keys) +;; It is used to re-execute last destructive command. +;; M-COM is a Lisp symbol representing the function to be executed. +;; VAL is the prefix argument that was used with that command. +;; COM is an internal descriptor, such as ?r, ?c, ?C, which contains +;; additional information on how the function in M-COM is to be handled. +;; REG is the register used by command +;; INSERTED-TEXT is text inserted by that command (in case of o, c, C, i, r +;; commands). +;; COMMAND-KEYS are the keys that were typed to invoke the command. +(defvar vip-d-com nil) + +;; The character remembered by the Vi `r' command. +(defvar vip-d-char nil) + +;; Name of register to store deleted or yanked strings +(defvar vip-use-register nil) + + + +;; Variables for Moves and Searches + +;; For use by `;' command. +(defvar vip-f-char nil) + +;; For use by `.' command. +(defvar vip-F-char nil) + +;; For use by `;' command. +(defvar vip-f-forward nil) + +;; For use by `;' command. +(defvar vip-f-offset nil) + +;; Last search string +(defvar vip-s-string "") + +(defvar vip-quote-string "> " + "String inserted at the beginning of quoted region.") + +;; If t, search is forward. +(defvar vip-s-forward nil) + +(defconst vip-case-fold-search nil + "*If not nil, search ignores cases.") + +(defconst vip-re-search t + "*If not nil, search is reg-exp search, otherwise vanilla search.") + +(defvar vip-search-scroll-threshold 2 + "*If search lands within this threshnold from the window top/bottom, +the window will be scrolled up or down appropriately, to reveal context. +If you want Viper search to behave as usual in Vi, set this variable to a +negative number.") + +(defconst vip-re-query-replace t + "*If t then do regexp replace, if nil then do string replace.") + +(defconst vip-re-replace t + "*If t, do regexp replace. nil means do string replace.") + +(vip-deflocalvar vip-ex-style-motion t + "*Ex-style: the commands l,h do not cross lines, etc.") + +(vip-deflocalvar vip-ex-style-editing-in-insert t + "*The keys ^H, ^? don't jump lines in insert, ESC moves cursor back, etc. +Note: this doesn't preclude ^H and ^? from deleting characters by moving +past the insertion point. This is a feature, not a bug. ") + +(vip-deflocalvar vip-delete-backwards-in-replace nil + "*If t, DEL key will delete characters while moving the cursor backwards. +If nil, the cursor will move backwards without deleting anything.") + +(defconst vip-buffer-search-char nil + "*Key bound for buffer-searching.") + +(defconst vip-search-wrap-around-t t + "*If t, search wraps around.") + +(vip-deflocalvar vip-related-files-and-buffers-ring nil + "*Ring of file and buffer names that are considered to be related to the +current buffer. +These buffers can be cycled through via :R and :P commands.") +(put 'vip-related-files-and-buffers-ring 'permanent-local t) + +;; Used to find out if we are done with searching the current buffer. +(vip-deflocalvar vip-local-search-start-marker nil) +;; As above, but global +(defvar vip-search-start-marker (make-marker)) + +;; the search overlay +(vip-deflocalvar vip-search-overlay nil) + + +(defvar vip-heading-start + (concat "^\\s-*(\\s-*defun\\s-\\|" ; lisp + "^{\\s-*$\\|^[_a-zA-Z][^()]*[()].*{\\s-*$\\|" ; C/C++ + "^\\s-*class.*{\\|^\\s-*struct.*{\\|^\\s-*enum.*{\\|" + "^\\\\[sb][a-z]*{.*}\\s-*$\\|" ; latex + "^@node\\|@table\\|^@m?enu\\|^@itemize\\|^@if\\|" ; texinfo + "^.+:-") ; prolog + "*Regexps for Headings. Used by \[\[ and \]\].") + +(defvar vip-heading-end + (concat "^}\\|" ; C/C++ + "^\\\\end{\\|" ; latex + "^@end \\|" ; texinfo + ")\n\n[ \t\n]*\\|" ; lisp + "\\.\\s-*$") ; prolog + "*Regexps to end Headings/Sections. Used by \[\].") + + +;; These two vars control the interaction of jumps performed by ' and `. +;; In this new version, '' doesn't erase the marks set by ``, so one can +;; use both kinds of jumps interchangeably and without loosing positions +;; inside the lines. + +;; Remembers position of the last jump done using ``'. +(vip-deflocalvar vip-last-jump nil) +;; Remembers position of the last jump done using `''. +(vip-deflocalvar vip-last-jump-ignore 0) + +;; History variables + +;; History of search strings. +(defvar vip-search-history (list "")) +;; History of query-replace strings used as a source. +(defvar vip-replace1-history nil) +;; History of query-replace strings used as replacement. +(defvar vip-replace2-history nil) +;; History of region quoting strings. +(defvar vip-quote-region-history (list vip-quote-string)) +;; History of Ex-style commands. +(defvar vip-ex-history nil) +;; History of shell commands. +(defvar vip-shell-history nil) + + +;; Last shell command. There are two of these, one for Ex (in viper-ex) +;; and one for Vi. + +;; Last shell command executed with ! command. +(defvar vip-last-shell-com nil) + + + +;;; Miscellaneous + +;; don't bark when mark is inactive +(setq mark-even-if-inactive t) + +(defvar vip-inhibit-startup-message nil + "Whether Viper startup message should be inhibited.") + +(defvar vip-always t + "t means, arrange that vi-state will be a default.") + +(defvar vip-custom-file-name (vip-convert-standard-file-name "~/.vip") + "Viper customisation file. +This variable must be set _before_ loading Viper.") + + +(defvar vip-spell-function 'ispell-region + "Spell function used by #s command to spell.") + +(defvar vip-tags-file-name "TAGS" + "The tags file used by Viper.") + +;; Indicates if we are in the middle of executing a command that takes another +;; command as an argument, e.g., cw, dw, etc. +(defvar vip-inside-command-argument-action nil) + +;; Minibuffer + +(defvar vip-vi-style-in-minibuffer t + "If t, use vi-style editing in minibuffer. +Should be set in `~/.vip' file.") + +;; overlay used in the minibuffer to indicate which state it is in +(vip-deflocalvar vip-minibuffer-overlay nil) + +;; Hook, specific to Viper, which is run just *before* exiting the minibuffer. +;; Beginning with Emacs 19.26, the standard `minibuffer-exit-hook' is run +;; *after* exiting the minibuffer +(defvar vip-minibuffer-exit-hook nil) + +;; setup emacs-supported vi-style feel +(setq next-line-add-newlines nil + require-final-newline t) + +(make-variable-buffer-local 'require-final-newline) + + +;; Mode line +(defconst vip-vi-state-id " " + "Mode line tag identifying the Vi mode of Viper.") +(defconst vip-emacs-state-id " " + "Mode line tag identifying the Emacs mode of Viper.") +(defconst vip-insert-state-id " " + "Mode line tag identifying the Insert mode of Viper.") +(defconst vip-replace-state-id " " + "Mode line tag identifying the Replace mode of Viper.") + +;; Viper changes the default mode-line-buffer-identification +(setq-default mode-line-buffer-identification '(" %b")) + +;; Variable displaying the current Viper state in the mode line. +(vip-deflocalvar vip-mode-string vip-emacs-state-id) +(or (memq 'vip-mode-string global-mode-string) + (setq global-mode-string + (append '("" vip-mode-string) (cdr global-mode-string)))) + + +(defvar vip-vi-state-hook nil + "*Hooks run just before the switch to Vi mode is completed.") +(defvar vip-insert-state-hook nil + "*Hooks run just before the switch to Insert mode is completed.") +(defvar vip-replace-state-hook nil + "*Hooks run just before the switch to Replace mode is completed.") +(defvar vip-emacs-state-hook nil + "*Hooks run just before the switch to Emacs mode is completed.") + +(defvar vip-load-hook nil + "Hooks run just after loading Viper.") + +;;; viper-ex.el ends here diff -r ebca3d831cea -r 6a378aca36af lisp/viper/viper-keym.el --- a/lisp/viper/viper-keym.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/viper/viper-keym.el Mon Aug 13 09:07:36 2007 +0200 @@ -1,6 +1,6 @@ ;;; viper-keym.el --- Viper keymaps -;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. @@ -32,7 +32,7 @@ (defvar vip-ex-style-motion) (eval-when-compile - (let ((load-path (cons "." load-path))) + (let ((load-path (cons (expand-file-name ".") load-path))) (or (featurep 'viper-util) (load "viper-util.el" nil nil 'nosuffix)) )) @@ -40,6 +40,7 @@ (require 'viper-util) + ;;; Variables (defvar vip-toggle-key "\C-z" @@ -239,8 +240,8 @@ ;; Replace keymap (define-key vip-replace-map "\C-t" 'vip-forward-indent) -(define-key vip-replace-map "\C-j" 'vip-replace-state-exit-cmd) -(define-key vip-replace-map "\C-m" 'vip-replace-state-exit-cmd) +(define-key vip-replace-map "\C-j" 'vip-replace-state-carriage-return) +(define-key vip-replace-map "\C-m" 'vip-replace-state-carriage-return) (define-key vip-replace-map "\C-?" 'vip-del-backward-char-in-replace) diff -r ebca3d831cea -r 6a378aca36af lisp/viper/viper-macs.el --- a/lisp/viper/viper-macs.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/viper/viper-macs.el Mon Aug 13 09:07:36 2007 +0200 @@ -1,6 +1,6 @@ ;;; viper-macs.el --- functions implementing keyboard macros for Viper -;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. @@ -29,13 +29,15 @@ (defvar vip-current-state) (eval-when-compile - (let ((load-path (cons "." load-path))) + (let ((load-path (cons (expand-file-name ".") load-path))) (or (featurep 'viper-util) (load "viper-util.el" nil nil 'nosuffix)) (or (featurep 'viper-keym) (load "viper-keym.el" nil nil 'nosuffix)) (or (featurep 'viper-mous) (load "viper-mous.el" nil nil 'nosuffix)) + (or (featurep 'viper) + (load "viper.el" nil nil 'nosuffix)) )) ;; end pacifier diff -r ebca3d831cea -r 6a378aca36af lisp/viper/viper-mous.el --- a/lisp/viper/viper-mous.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/viper/viper-mous.el Mon Aug 13 09:07:36 2007 +0200 @@ -1,6 +1,6 @@ ;;; viper-mous.el --- mouse support for Viper -;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. @@ -33,14 +33,17 @@ (defvar vip-re-search) (eval-when-compile - (let ((load-path (cons "." load-path))) + (let ((load-path (cons (expand-file-name ".") load-path))) (or (featurep 'viper-util) (load "viper-util.el" nil nil 'nosuffix)) + (or (featurep 'viper) + (load "viper.el" nil nil 'nosuffix)) )) ;; end pacifier (require 'viper-util) + ;;; Variables diff -r ebca3d831cea -r 6a378aca36af lisp/viper/viper-util.el --- a/lisp/viper/viper-util.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/viper/viper-util.el Mon Aug 13 09:07:36 2007 +0200 @@ -1,6 +1,6 @@ ;;; viper-util.el --- Utilities used by viper.el -;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. @@ -22,254 +22,32 @@ ;; Code -(require 'ring) - ;; Compiler pacifier (defvar vip-overriding-map) (defvar pm-color-alist) (defvar zmacs-region-stays) -(defvar vip-search-face) (defvar vip-minibuffer-current-face) (defvar vip-minibuffer-insert-face) (defvar vip-minibuffer-vi-face) (defvar vip-minibuffer-emacs-face) (defvar vip-replace-overlay-face) -(defvar vip-minibuffer-overlay) -(defvar vip-replace-overlay) -(defvar vip-search-overlay) -(defvar vip-replace-overlay-cursor-color) -(defvar vip-intermediate-command) -(defvar vip-use-replace-region-delimiters) (defvar vip-fast-keyseq-timeout) -(defvar vip-related-files-and-buffers-ring) -(defvar vip-saved-cursor-color) (defvar ex-unix-type-shell) (defvar ex-unix-type-shell-options) (defvar vip-ex-tmp-buf-name) + +(require 'cl) +(require 'ring) + +(and noninteractive + (eval-when-compile + (let ((load-path (cons (expand-file-name ".") load-path))) + (or (featurep 'viper-init) + (load "viper-init.el" nil nil 'nosuffix)) + ))) ;; end pacifier -;; Is it XEmacs? -(defconst vip-xemacs-p (string-match "\\(Lucid\\|XEmacs\\)" emacs-version)) -;; Is it Emacs? -(defconst vip-emacs-p (not vip-xemacs-p)) -;; Tell whether we are running as a window application or on a TTY -(defsubst vip-device-type () - (if vip-emacs-p - window-system - (device-type (selected-device)))) -;; in XEmacs: device-type is tty on tty and stream in batch. -(defun vip-window-display-p () - (and (vip-device-type) (not (memq (vip-device-type) '(tty stream pc))))) - -(defvar vip-ms-style-os-p (memq system-type '(ms-dos windows-nt windows-95)) - "Tells if Emacs is running under an MS-style OS: ms-dos, windows-nt, W95.") -(defvar vip-vms-os-p (memq system-type '(vax-vms axp-vms)) - "Tells if Emacs is running under VMS.") - -(defvar vip-force-faces nil - "If t, Viper will think that it is running on a display that supports faces. -This is provided as a temporary relief for users of face-capable displays -that Viper doesn't know about.") - -(defun vip-has-face-support-p () - (cond ((vip-window-display-p)) - (vip-force-faces) - (vip-emacs-p (memq (vip-device-type) '(pc))) - (vip-xemacs-p (memq (vip-device-type) '(tty pc))))) - - -;;; Macros - -(defmacro vip-deflocalvar (var default-value &optional documentation) - (` (progn - (defvar (, var) (, default-value) - (, (format "%s\n\(buffer local\)" documentation))) - (make-variable-buffer-local '(, var)) - ))) - -(defmacro vip-loop (count body) - "(vip-loop COUNT BODY) Execute BODY COUNT times." - (list 'let (list (list 'count count)) - (list 'while '(> count 0) - body - '(setq count (1- count)) - ))) - -(defmacro vip-buffer-live-p (buf) - (` (and (, buf) (get-buffer (, buf)) (buffer-name (get-buffer (, buf)))))) - -;; return buffer-specific macro definition, given a full macro definition -(defmacro vip-kbd-buf-alist (macro-elt) - (` (nth 1 (, macro-elt)))) -;; get a pair: (curr-buffer . macro-definition) -(defmacro vip-kbd-buf-pair (macro-elt) - (` (assoc (buffer-name) (vip-kbd-buf-alist (, macro-elt))))) -;; get macro definition for current buffer -(defmacro vip-kbd-buf-definition (macro-elt) - (` (cdr (vip-kbd-buf-pair (, macro-elt))))) - -;; return mode-specific macro definitions, given a full macro definition -(defmacro vip-kbd-mode-alist (macro-elt) - (` (nth 2 (, macro-elt)))) -;; get a pair: (major-mode . macro-definition) -(defmacro vip-kbd-mode-pair (macro-elt) - (` (assoc major-mode (vip-kbd-mode-alist (, macro-elt))))) -;; get macro definition for the current major mode -(defmacro vip-kbd-mode-definition (macro-elt) - (` (cdr (vip-kbd-mode-pair (, macro-elt))))) - -;; return global macro definition, given a full macro definition -(defmacro vip-kbd-global-pair (macro-elt) - (` (nth 3 (, macro-elt)))) -;; get global macro definition from an elt of macro-alist -(defmacro vip-kbd-global-definition (macro-elt) - (` (cdr (vip-kbd-global-pair (, macro-elt))))) - -;; last elt of a sequence -(defsubst vip-seq-last-elt (seq) - (elt seq (1- (length seq)))) - -;; Check if arg is a valid character for register -;; TYPE is a list that can contain `letter', `Letter', and `digit'. -;; Letter means lowercase letters, Letter means uppercase letters, and -;; digit means digits from 1 to 9. -;; If TYPE is nil, then down/uppercase letters and digits are allowed. -(defun vip-valid-register (reg &optional type) - (or type (setq type '(letter Letter digit))) - (or (if (memq 'letter type) - (and (<= ?a reg) (<= reg ?z))) - (if (memq 'digit type) - (and (<= ?1 reg) (<= reg ?9))) - (if (memq 'Letter type) - (and (<= ?A reg) (<= reg ?Z))) - )) - -;; checks if object is a marker, has a buffer, and points to within that buffer -(defun vip-valid-marker (marker) - (if (and (markerp marker) (marker-buffer marker)) - (let ((buf (marker-buffer marker)) - (pos (marker-position marker))) - (save-excursion - (set-buffer buf) - (and (<= pos (point-max)) (<= (point-min) pos)))))) - - -(defvar vip-minibuffer-overlay-priority 300) -(defvar vip-replace-overlay-priority 400) -(defvar vip-search-overlay-priority 500) - - -;;; Viper minor modes - -;; This is not local in Emacs, so we make it local. -;; This must be local because although the stack of minor modes can be the same -;; for all buffers, the associated *keymaps* can be different. In Viper, -;; vip-vi-local-user-map, vip-insert-local-user-map, and others can have -;; different keymaps for different buffers. -;; Also, the keymaps associated with vip-vi/insert-state-modifier-minor-mode -;; can be different. -(make-variable-buffer-local 'minor-mode-map-alist) - -;; Mode for vital things like \e, C-z. -(vip-deflocalvar vip-vi-intercept-minor-mode nil) - -(vip-deflocalvar vip-vi-basic-minor-mode nil - "Viper's minor mode for Vi bindings.") - -(vip-deflocalvar vip-vi-local-user-minor-mode nil - "Auxiliary minor mode for user-defined local bindings in Vi state.") - -(vip-deflocalvar vip-vi-global-user-minor-mode nil - "Auxiliary minor mode for user-defined global bindings in Vi state.") - -(vip-deflocalvar vip-vi-state-modifier-minor-mode nil - "Minor mode used to make major-mode-specific modification to Vi state.") - -(vip-deflocalvar vip-vi-diehard-minor-mode nil - "This minor mode is in effect when the user wants Viper to be Vi.") - -(vip-deflocalvar vip-vi-kbd-minor-mode nil - "Minor mode for Ex command macros in Vi state. -The corresponding keymap stores key bindings of Vi macros defined with -the Ex command :map.") - -;; Mode for vital things like \e, C-z. -(vip-deflocalvar vip-insert-intercept-minor-mode nil) - -(vip-deflocalvar vip-insert-basic-minor-mode nil - "Viper's minor mode for bindings in Insert mode.") - -(vip-deflocalvar vip-insert-local-user-minor-mode nil - "Auxiliary minor mode for buffer-local user-defined bindings in Insert state. -This is a way to overshadow normal Insert mode bindings locally to certain -designated buffers.") - -(vip-deflocalvar vip-insert-global-user-minor-mode nil - "Auxiliary minor mode for global user-defined bindings in Insert state.") - -(vip-deflocalvar vip-insert-state-modifier-minor-mode nil - "Minor mode used to make major-mode-specific modification to Insert state.") - -(vip-deflocalvar vip-insert-diehard-minor-mode nil - "Minor mode that simulates Vi very closely. -Not recommened, except for the novice user.") - -(vip-deflocalvar vip-insert-kbd-minor-mode nil -"Minor mode for Ex command macros Insert state. -The corresponding keymap stores key bindings of Vi macros defined with -the Ex command :map!.") - -(vip-deflocalvar vip-replace-minor-mode nil - "Minor mode in effect in replace state (cw, C, and the like commands).") - -;; Mode for vital things like \C-z and \C-x) -;; This is t, by default. So, any new buffer will have C-z defined as -;; switch to Vi, unless we switched states in this buffer -(vip-deflocalvar vip-emacs-intercept-minor-mode t) - -(vip-deflocalvar vip-emacs-local-user-minor-mode t - "Minor mode for local user bindings effective in Emacs state. -Users can use it to override Emacs bindings when Viper is in its Emacs -state.") - -(vip-deflocalvar vip-emacs-global-user-minor-mode t - "Minor mode for global user bindings in effect in Emacs state. -Users can use it to override Emacs bindings when Viper is in its Emacs -state.") - -(vip-deflocalvar vip-emacs-kbd-minor-mode t - "Minor mode for Vi style macros in Emacs state. -The corresponding keymap stores key bindings of Vi macros defined with -`vip-record-kbd-macro' command. There is no Ex-level command to do this -interactively.") - -(vip-deflocalvar vip-emacs-state-modifier-minor-mode t - "Minor mode used to make major-mode-specific modification to Emacs state. -For instance, a Vi purist may want to bind `dd' in Dired mode to a function -that deletes a file.") - -(vip-deflocalvar vip-vi-minibuffer-minor-mode nil - "Minor mode that forces Vi-style when the Minibuffer is in Vi state.") - -(vip-deflocalvar vip-insert-minibuffer-minor-mode nil - "Minor mode that forces Vi-style when the Minibuffer is in Insert state.") - - - -;; Some common error messages - -(defconst vip-SpuriousText "Spurious text after command" "") -(defconst vip-BadExCommand "Not an editor command" "") -(defconst vip-InvalidCommandArgument "Invalid command argument" "") -(defconst vip-NoPrevSearch "No previous search string" "") -(defconst vip-EmptyRegister "`%c': Nothing in this register" "") -(defconst vip-InvalidRegister "`%c': Invalid register" "") -(defconst vip-EmptyTextmarker "`%c': Text marker doesn't point anywhere" "") -(defconst vip-InvalidTextmarker "`%c': Invalid text marker" "") -(defconst vip-InvalidViCommand "Invalid command" "") -(defconst vip-BadAddress "Ill-formed address" "") -(defconst vip-FirstAddrExceedsSecond "First address exceeds second" "") -(defconst vip-NoFileSpecified "No file specified" "") +(require 'viper-init) @@ -360,7 +138,7 @@ (modify-frame-parameters (selected-frame) (list (cons 'cursor-color new-color))))) -(defsubst vip-save-cursor-color () +(defun vip-save-cursor-color () (if (and (vip-window-display-p) (vip-color-display-p)) (let ((color (vip-get-cursor-color))) (if (and (stringp color) (vip-color-defined-p color) @@ -375,6 +153,115 @@ (vip-change-cursor-color vip-saved-cursor-color)) +;; Face-saving tricks + +(defvar vip-search-face + (if (vip-has-face-support-p) + (progn + (make-face 'vip-search-face) + (vip-hide-face 'vip-search-face) + (or (face-differs-from-default-p 'vip-search-face) + ;; face wasn't set in .vip or .Xdefaults + (if (vip-can-use-colors "Black" "khaki") + (progn + (set-face-background 'vip-search-face "khaki") + (set-face-foreground 'vip-search-face "Black")) + (set-face-underline-p 'vip-search-face t) + (vip-set-face-pixmap 'vip-search-face vip-search-face-pixmap))) + 'vip-search-face)) + "*Face used to flash out the search pattern.") + +(defvar vip-replace-overlay-face + (if (vip-has-face-support-p) + (progn + (make-face 'vip-replace-overlay-face) + (vip-hide-face 'vip-replace-overlay-face) + (or (face-differs-from-default-p 'vip-replace-overlay-face) + (progn + (if (vip-can-use-colors "darkseagreen2" "Black") + (progn + (set-face-background + 'vip-replace-overlay-face "darkseagreen2") + (set-face-foreground 'vip-replace-overlay-face "Black"))) + (set-face-underline-p 'vip-replace-overlay-face t) + (vip-set-face-pixmap + 'vip-replace-overlay-face vip-replace-overlay-pixmap))) + 'vip-replace-overlay-face)) + "*Face for highlighting replace regions on a window display.") + +(defvar vip-minibuffer-emacs-face + (if (vip-has-face-support-p) + (progn + (make-face 'vip-minibuffer-emacs-face) + (vip-hide-face 'vip-minibuffer-emacs-face) + (or (face-differs-from-default-p 'vip-minibuffer-emacs-face) + ;; face wasn't set in .vip or .Xdefaults + (if vip-vi-style-in-minibuffer + ;; emacs state is an exception in the minibuffer + (if (vip-can-use-colors "darkseagreen2" "Black") + (progn + (set-face-background + 'vip-minibuffer-emacs-face "darkseagreen2") + (set-face-foreground + 'vip-minibuffer-emacs-face "Black")) + (copy-face 'modeline 'vip-minibuffer-emacs-face)) + ;; emacs state is the main state in the minibuffer + (if (vip-can-use-colors "Black" "pink") + (progn + (set-face-background 'vip-minibuffer-emacs-face "pink") + (set-face-foreground + 'vip-minibuffer-emacs-face "Black")) + (copy-face 'italic 'vip-minibuffer-emacs-face)) + )) + 'vip-minibuffer-emacs-face)) + "Face used in the Minibuffer when it is in Emacs state.") + +(defvar vip-minibuffer-insert-face + (if (vip-has-face-support-p) + (progn + (make-face 'vip-minibuffer-insert-face) + (vip-hide-face 'vip-minibuffer-insert-face) + (or (face-differs-from-default-p 'vip-minibuffer-insert-face) + (if vip-vi-style-in-minibuffer + (if (vip-can-use-colors "Black" "pink") + (progn + (set-face-background 'vip-minibuffer-insert-face "pink") + (set-face-foreground + 'vip-minibuffer-insert-face "Black")) + (copy-face 'italic 'vip-minibuffer-insert-face)) + ;; If Insert state is an exception + (if (vip-can-use-colors "darkseagreen2" "Black") + (progn + (set-face-background + 'vip-minibuffer-insert-face "darkseagreen2") + (set-face-foreground + 'vip-minibuffer-insert-face "Black")) + (copy-face 'modeline 'vip-minibuffer-insert-face)) + (vip-italicize-face 'vip-minibuffer-insert-face))) + 'vip-minibuffer-insert-face)) + "Face used in the Minibuffer when it is in Insert state.") + +(defvar vip-minibuffer-vi-face + (if (vip-has-face-support-p) + (progn + (make-face 'vip-minibuffer-vi-face) + (vip-hide-face 'vip-minibuffer-vi-face) + (or (face-differs-from-default-p 'vip-minibuffer-vi-face) + (if vip-vi-style-in-minibuffer + (if (vip-can-use-colors "Black" "grey") + (progn + (set-face-background 'vip-minibuffer-vi-face "grey") + (set-face-foreground 'vip-minibuffer-vi-face "Black")) + (copy-face 'bold 'vip-minibuffer-vi-face)) + (copy-face 'bold 'vip-minibuffer-vi-face) + (invert-face 'vip-minibuffer-vi-face))) + 'vip-minibuffer-vi-face)) + "Face used in the Minibuffer when it is in Vi state.") + +;; the current face to be used in the minibuffer +(vip-deflocalvar vip-minibuffer-current-face vip-minibuffer-emacs-face "") + + ;; Check the current version against the major and minor version numbers ;; using op: cur-vers op major.minor If emacs-major-version or ;; emacs-minor-version are not defined, we assume that the current version @@ -403,8 +290,8 @@ ((memq op '(< <=)) t)))) ;;;; warn if it is a wrong version of emacs -;;(if (or (vip-check-version '< 19 29 'emacs) -;; (vip-check-version '< 19 12 'xemacs)) +;;(if (or (vip-check-version '< 19 35 'emacs) +;; (vip-check-version '< 19 15 'xemacs)) ;; (progn ;; (with-output-to-temp-buffer " *vip-info*" ;; (switch-to-buffer " *vip-info*") @@ -413,9 +300,9 @@ ;; ;;This version of Viper requires ;; -;;\t Emacs 19.29 and higher +;;\t Emacs 19.35 and higher ;;\t OR -;;\t XEmacs 19.12 and higher +;;\t XEmacs 19.15 and higher ;; ;;It is unlikely to work under Emacs version %s ;;that you are using... " emacs-version)) @@ -674,13 +561,6 @@ (setq tmp (cdr tmp))) (reverse (apply 'append tmp2)))) -(defun vip-convert-standard-file-name (fname) - (if vip-emacs-p - (convert-standard-filename fname) - ;; hopefully, XEmacs adds this functionality - fname)) - - ;;; Insertion ring @@ -892,7 +772,15 @@ (vip-overlay-put vip-replace-overlay (if vip-emacs-p 'evaporate 'detachable) nil) (vip-overlay-put - vip-replace-overlay 'priority vip-replace-overlay-priority)) + vip-replace-overlay 'priority vip-replace-overlay-priority) + ;; If Emacs will start supporting overlay maps, as it currently supports + ;; text-property maps, we could do away with vip-replace-minor-mode and + ;; just have keymap attached to replace overlay. + ;;(vip-overlay-put + ;; vip-replace-overlay + ;; (if vip-xemacs-p 'keymap 'local-map) + ;; vip-replace-map) + ) (if (vip-has-face-support-p) (vip-overlay-put vip-replace-overlay 'face vip-replace-overlay-face)) (vip-save-cursor-color) @@ -900,7 +788,7 @@ ) -(defsubst vip-set-replace-overlay-glyphs (before-glyph after-glyph) +(defun vip-set-replace-overlay-glyphs (before-glyph after-glyph) (if (or (not (vip-has-face-support-p)) vip-use-replace-region-delimiters) (let ((before-name (if vip-xemacs-p 'begin-glyph 'before-string)) @@ -908,7 +796,7 @@ (vip-overlay-put vip-replace-overlay before-name before-glyph) (vip-overlay-put vip-replace-overlay after-name after-glyph)))) -(defsubst vip-hide-replace-overlay () +(defun vip-hide-replace-overlay () (vip-set-replace-overlay-glyphs nil nil) (vip-restore-cursor-color-after-replace) (vip-restore-cursor-color-after-insert) @@ -979,7 +867,15 @@ (let ((ESC-keys '(?\e (control \[) escape)) (key (vip-event-key event))) (member key ESC-keys))) - + +;; checks if object is a marker, has a buffer, and points to within that buffer +(defun vip-valid-marker (marker) + (if (and (markerp marker) (marker-buffer marker)) + (let ((buf (marker-buffer marker)) + (pos (marker-position marker))) + (save-excursion + (set-buffer buf) + (and (<= pos (point-max)) (<= (point-min) pos)))))) (defsubst vip-mark-marker () (if vip-xemacs-p @@ -1004,6 +900,21 @@ (if vip-xemacs-p (setq zmacs-region-stays t))) +;; Check if arg is a valid character for register +;; TYPE is a list that can contain `letter', `Letter', and `digit'. +;; Letter means lowercase letters, Letter means uppercase letters, and +;; digit means digits from 1 to 9. +;; If TYPE is nil, then down/uppercase letters and digits are allowed. +(defun vip-valid-register (reg &optional type) + (or type (setq type '(letter Letter digit))) + (or (if (memq 'letter type) + (and (<= ?a reg) (<= reg ?z))) + (if (memq 'digit type) + (and (<= ?1 reg) (<= reg ?9))) + (if (memq 'Letter type) + (and (<= ?A reg) (<= reg ?Z))) + )) + (defsubst vip-events-to-keys (events) (cond (vip-xemacs-p (events-to-keys events)) @@ -1103,40 +1014,44 @@ (defun vip-event-key (event) (or (and event (eventp event)) (error "vip-event-key: Wrong type argument, eventp, %S" event)) - (let ((mod (event-modifiers event)) - basis) - (setq basis - (cond - (vip-xemacs-p - (cond ((key-press-event-p event) - (event-key event)) - ((button-event-p event) - (concat "mouse-" (prin1-to-string (event-button event)))) - (t - (error "vip-event-key: Unknown event, %S" event)))) - (t - ;; Emacs doesn't handle capital letters correctly, since - ;; \S-a isn't considered the same as A (it behaves as - ;; plain `a' instead). So we take care of this here - (cond ((and (vip-characterp event) (<= ?A event) (<= event ?Z)) - (setq mod nil - event event)) - ;; Emacs has the oddity whereby characters 128+char - ;; represent M-char *if* this appears inside a string. - ;; So, we convert them manually to (meta char). - ((and (vip-characterp event) (< ?\C-? event) (<= event 255)) - (setq mod '(meta) - event (- event ?\C-? 1))) - (t (event-basic-type event))) - ))) - (if (vip-characterp basis) - (setq basis - (if (= basis ?\C-?) - (list 'control '\?) ; taking care of an emacs bug - (intern (char-to-string basis))))) - (if mod - (append mod (list basis)) - basis))) + (when (cond (vip-xemacs-p (or (key-press-event-p event) + (mouse-event-p event))) + (t t)) + (let ((mod (event-modifiers event)) + basis) + (setq basis + (cond + (vip-xemacs-p + (cond ((key-press-event-p event) + (event-key event)) + ((button-event-p event) + (concat "mouse-" (prin1-to-string (event-button event)))) + (t + (error "vip-event-key: Unknown event, %S" event)))) + (t + ;; Emacs doesn't handle capital letters correctly, since + ;; \S-a isn't considered the same as A (it behaves as + ;; plain `a' instead). So we take care of this here + (cond ((and (vip-characterp event) (<= ?A event) (<= event ?Z)) + (setq mod nil + event event)) + ;; Emacs has the oddity whereby characters 128+char + ;; represent M-char *if* this appears inside a string. + ;; So, we convert them manually to (meta char). + ((and (vip-characterp event) + (< ?\C-? event) (<= event 255)) + (setq mod '(meta) + event (- event ?\C-? 1))) + (t (event-basic-type event))) + ))) + (if (vip-characterp basis) + (setq basis + (if (= basis ?\C-?) + (list 'control '\?) ; taking care of an emacs bug + (intern (char-to-string basis))))) + (if mod + (append mod (list basis)) + basis)))) (defun vip-key-to-emacs-key (key) (let (key-name char-p modifiers mod-char-list base-key base-key-name) @@ -1303,7 +1218,7 @@ (append (vconcat vip-ALPHA-char-class) nil))))) )) -(defsubst vip-looking-at-separator () +(defun vip-looking-at-separator () (let ((char (char-after (point)))) (if char (or (eq char ?\n) ; RET is always a separator in Vi @@ -1313,7 +1228,7 @@ (defsubst vip-looking-at-alphasep (&optional addl-chars) (or (vip-looking-at-separator) (vip-looking-at-alpha addl-chars))) -(defsubst vip-skip-alpha-forward (&optional addl-chars) +(defun vip-skip-alpha-forward (&optional addl-chars) (or (stringp addl-chars) (setq addl-chars "")) (vip-skip-syntax 'forward @@ -1324,7 +1239,7 @@ (concat vip-strict-ALPHA-chars addl-chars)) (t addl-chars)))) -(defsubst vip-skip-alpha-backward (&optional addl-chars) +(defun vip-skip-alpha-backward (&optional addl-chars) (or (stringp addl-chars) (setq addl-chars "")) (vip-skip-syntax 'backward @@ -1351,14 +1266,14 @@ (funcall func (concat "^" vip-SEP-char-class) (vip-line-pos (if (eq direction 'forward) 'end 'start))))) -(defsubst vip-skip-nonalphasep-forward () +(defun vip-skip-nonalphasep-forward () (if (eq vip-syntax-preference 'strict-vi) (skip-chars-forward (concat "^" vip-strict-SEP-chars vip-strict-ALPHA-chars)) (skip-syntax-forward (concat "^" vip-ALPHA-char-class vip-SEP-char-class) (vip-line-pos 'end)))) -(defsubst vip-skip-nonalphasep-backward () +(defun vip-skip-nonalphasep-backward () (if (eq vip-syntax-preference 'strict-vi) (skip-chars-backward (concat "^" vip-strict-SEP-chars vip-strict-ALPHA-chars)) diff -r ebca3d831cea -r 6a378aca36af lisp/viper/viper.el --- a/lisp/viper/viper.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/viper/viper.el Mon Aug 13 09:07:36 2007 +0200 @@ -6,9 +6,9 @@ ;; Keywords: emulations ;; Author: Michael Kifer -;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. - -(defconst viper-version "2.92 of January 3, 1997" +;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. + +(defconst viper-version "2.92 of January 10, 1997" "The current version of Viper") ;; This file is part of GNU Emacs. @@ -312,7 +312,7 @@ (defvar mark-even-if-inactive) (eval-when-compile - (let ((load-path (cons "." load-path))) + (let ((load-path (cons (expand-file-name ".") load-path))) (or (featurep 'viper-util) (load "viper-util.el" nil nil 'nosuffix)) (or (featurep 'viper-keym) @@ -326,6 +326,7 @@ )) ;; end pacifier + (require 'viper-util) (require 'viper-keym) (require 'viper-mous) @@ -334,462 +335,6 @@ -;;; Variables - -;; Is t until viper-mode executes for the very first time. -;; Prevents recursive descend into startup messages. -(defvar vip-first-time t) - -(defvar vip-expert-level 0 - "User's expert level. -The minor mode vip-vi-diehard-minor-mode is in effect when -vip-expert-level is 1 or 2 or when vip-want-emacs-keys-in-vi is t. -The minor mode vip-insert-diehard-minor-mode is in effect when -vip-expert-level is 1 or 2 or if vip-want-emacs-keys-in-insert is t. -Use `M-x vip-set-expert-level' to change this.") - -;; Max expert level supported by Viper. This is NOT a user option. -;; It is here to make it hard for the user from resetting it. -(defconst vip-max-expert-level 5) - -;; Contains user settings for vars affected by vip-set-expert-level function. -;; Not a user option. -(defvar vip-saved-user-settings nil) - - -;;; ISO characters - -(vip-deflocalvar vip-automatic-iso-accents nil - "*If non-nil, ISO accents will be turned on in insert/replace emacs states and turned off in vi-state. -For some users, this behavior may be too primitive. In this case, use -insert/emacs/vi state hooks.") - - -;; VI-style Undo - -;; Used to 'undo' complex commands, such as replace and insert commands. -(vip-deflocalvar vip-undo-needs-adjustment nil) -(put 'vip-undo-needs-adjustment 'permanent-local t) - -;; A mark that Viper puts on buffer-undo-list. Marks the beginning of a -;; complex command that must be undone atomically. If inserted, it is -;; erased by vip-change-state-to-vi and vip-repeat. -(defconst vip-buffer-undo-list-mark 'viper) - -(defvar vip-keep-point-on-undo nil - "*Non-nil means not to move point while undoing commands. -This style is different from Emacs and Vi. Try it to see if -it better fits your working style.") - -;; Replace mode and changing text - -;; Viper's own after/before change functions, which get vip-add-hook'ed to -;; Emacs's -(vip-deflocalvar vip-after-change-functions nil "") -(vip-deflocalvar vip-before-change-functions nil "") -(vip-deflocalvar vip-post-command-hooks nil "") -(vip-deflocalvar vip-pre-command-hooks nil "") - -;; Can be used to pass global states around for short period of time -(vip-deflocalvar vip-intermediate-command nil "") - -;; Indicates that the current destructive command has started in replace mode. -(vip-deflocalvar vip-began-as-replace nil "") - -(defvar vip-replace-overlay-cursor-color "Red" - "*Cursor color to use in Replace state") -(defvar vip-insert-state-cursor-color nil - "Cursor color for Viper insert state.") -(put 'vip-insert-state-cursor-color 'permanent-local t) -;; place to save cursor colow when switching to insert mode -(vip-deflocalvar vip-saved-cursor-color nil "") - -(vip-deflocalvar vip-replace-overlay nil "") -(put 'vip-replace-overlay 'permanent-local t) - -(defvar vip-replace-overlay-pixmap "gray3" - "Pixmap to use for search face on non-color displays.") -(defvar vip-search-face-pixmap "gray3" - "Pixmap to use for search face on non-color displays.") - - -(defun vip-set-replace-overlay-face () - (if (vip-has-face-support-p) - (defvar vip-replace-overlay-face - (progn - (make-face 'vip-replace-overlay-face) - (vip-hide-face 'vip-replace-overlay-face) - (or (face-differs-from-default-p 'vip-replace-overlay-face) - (progn - (if (vip-can-use-colors "darkseagreen2" "Black") - (progn - (set-face-background - 'vip-replace-overlay-face "darkseagreen2") - (set-face-foreground 'vip-replace-overlay-face "Black"))) - (set-face-underline-p 'vip-replace-overlay-face t) - (vip-set-face-pixmap - 'vip-replace-overlay-face vip-replace-overlay-pixmap))) - 'vip-replace-overlay-face) - "*Face for highlighting replace regions on a window display.") - )) - -(defvar vip-replace-region-end-delimiter "$" - "A string marking the end of replacement regions. -It is used only with TTYs or if `vip-use-replace-region-delimiters' -is non-nil.") -(defvar vip-replace-region-start-delimiter "" - "A string marking the beginning of replacement regions. -It is used only with TTYs or if `vip-use-replace-region-delimiters' -is non-nil.") -(defvar vip-use-replace-region-delimiters (not (vip-has-face-support-p)) - "*If non-nil, Viper will always use `vip-replace-region-end-delimiter' and -`vip-replace-region-start-delimiter' to delimit replacement regions, even on -color displays. By default, the delimiters are used only on TTYs.") - -;; XEmacs requires glyphs -(if vip-xemacs-p - (progn - (or (glyphp vip-replace-region-end-delimiter) - (setq vip-replace-region-end-delimiter - (make-glyph vip-replace-region-end-delimiter))) - (or (glyphp vip-replace-region-start-delimiter) - (setq vip-replace-region-start-delimiter - (make-glyph vip-replace-region-start-delimiter))) - )) - - -;; These are local marker that must be initialized to nil and moved with -;; `vip-move-marker-locally' -;; -;; Remember the last position inside the replace region. -(vip-deflocalvar vip-last-posn-in-replace-region nil) -;; Remember the last position while inserting -(vip-deflocalvar vip-last-posn-while-in-insert-state nil) -(put 'vip-last-posn-in-replace-region 'permanent-local t) -(put 'vip-last-posn-while-in-insert-state 'permanent-local t) - -(vip-deflocalvar vip-sitting-in-replace nil "") -(put 'vip-sitting-in-replace 'permanent-local t) - -;; Remember the number of characters that have to be deleted in replace -;; mode to compensate for the inserted characters. -(vip-deflocalvar vip-replace-chars-to-delete 0 "") -(vip-deflocalvar vip-replace-chars-deleted 0 "") - -;; Insertion ring and command ring -(defvar vip-insertion-ring-size 14 - "The size of the insertion ring.") -;; The insertion ring. -(defvar vip-insertion-ring nil) -;; This is temp insertion ring. Used to do rotation for display purposes. -;; When rotation just started, it is initialized to vip-insertion-ring. -(defvar vip-temp-insertion-ring nil) -(defvar vip-last-inserted-string-from-insertion-ring "") - -(defvar vip-command-ring-size 14 - "The size of the command ring.") -;; The command ring. -(defvar vip-command-ring nil) -;; This is temp command ring. Used to do rotation for display purposes. -;; When rotation just started, it is initialized to vip-command-ring. -(defvar vip-temp-command-ring nil) - -;; Modes and related variables - -;; Current mode. One of: `emacs-state', `vi-state', `insert-state' -(vip-deflocalvar vip-current-state 'emacs-state) - - -;; Autoindent in insert - -;; Variable that keeps track of whether C-t has been pressed. -(vip-deflocalvar vip-cted nil "") - -;; Preserve the indent value, used by C-d in insert mode. -(vip-deflocalvar vip-current-indent 0) - -;; Whether to preserve the indent, used by C-d in insert mode. -(vip-deflocalvar vip-preserve-indent nil) - -(vip-deflocalvar vip-auto-indent nil - "*Autoindent if t.") -(vip-deflocalvar vip-electric-mode t - "*If t, enable electric behavior. -Currently only enables auto-indentation `according to mode'.") - -(defconst vip-shift-width 8 - "*The shiftwidth variable.") - -;; Variables for repeating destructive commands - -(defconst vip-keep-point-on-repeat t - "*If t, don't move point when repeating previous command. -This is useful for doing repeated changes with the '.' key. -The user can change this to nil, if she likes when the cursor moves -to a new place after repeating previous Vi command.") - -;; Remember insert point as a marker. This is a local marker that must be -;; initialized to nil and moved with `vip-move-marker-locally'. -(vip-deflocalvar vip-insert-point nil) -(put 'vip-insert-point 'permanent-local t) - -;; This remembers the point before dabbrev-expand was called. -;; If vip-insert-point turns out to be bigger than that, it is reset -;; back to vip-pre-command-point. -;; The reason this is needed is because dabbrev-expand (and possibly -;; others) may jump to before the insertion point, delete something and -;; then reinsert a bigger piece. For instance: bla^blo -;; If dabbrev-expand is called after `blo' and ^ undicates vip-insert-point, -;; then point jumps to the beginning of `blo'. If expansion is found, `blablo' -;; is deleted, and we have |^, where | denotes point. Next, dabbrev-expand -;; will insert the expansion, and we get: blablo^ -;; Whatever we insert next goes before the ^, i.e., before the -;; vip-insert-point marker. So, Viper will think that nothing was -;; inserted. Remembering the orig position of the marker circumvents the -;; problem. -;; We don't know of any command, except dabbrev-expand, that has the same -;; problem. However, the same trick can be used if such a command is -;; discovered later. -;; -(vip-deflocalvar vip-pre-command-point nil) -(put 'vip-pre-command-point 'permanent-local t) ; this is probably an overkill - -;; This is used for saving inserted text. -(defvar vip-last-insertion nil) - -;; Remembers the last replaced region. -(defvar vip-last-replace-region "") - -;; Remember com point as a marker. -;; This is a local marker. Should be moved with `vip-move-marker-locally' -(vip-deflocalvar vip-com-point nil) - -;; If non-nil, the value is a list (M-COM VAL COM REG inserted-text cmd-keys) -;; It is used to re-execute last destructive command. -;; M-COM is a Lisp symbol representing the function to be executed. -;; VAL is the prefix argument that was used with that command. -;; COM is an internal descriptor, such as ?r, ?c, ?C, which contains -;; additional information on how the function in M-COM is to be handled. -;; REG is the register used by command -;; INSERTED-TEXT is text inserted by that command (in case of o, c, C, i, r -;; commands). -;; COMMAND-KEYS are the keys that were typed to invoke the command. -(defvar vip-d-com nil) - -;; The character remembered by the Vi `r' command. -(defvar vip-d-char nil) - -;; Name of register to store deleted or yanked strings -(defvar vip-use-register nil) - - - -;; Variables for Moves and Searches - -;; For use by `;' command. -(defvar vip-f-char nil) - -;; For use by `.' command. -(defvar vip-F-char nil) - -;; For use by `;' command. -(defvar vip-f-forward nil) - -;; For use by `;' command. -(defvar vip-f-offset nil) - -;; Last search string -(defvar vip-s-string "") - -(defvar vip-quote-string "> " - "String inserted at the beginning of quoted region.") - -;; If t, search is forward. -(defvar vip-s-forward nil) - -(defconst vip-case-fold-search nil - "*If not nil, search ignores cases.") - -(defconst vip-re-search t - "*If not nil, search is reg-exp search, otherwise vanilla search.") - -(defvar vip-search-scroll-threshold 2 - "*If search lands within this threshnold from the window top/bottom, -the window will be scrolled up or down appropriately, to reveal context. -If you want Viper search to behave as usual in Vi, set this variable to a -negative number.") - -(defconst vip-re-query-replace t - "*If t then do regexp replace, if nil then do string replace.") - -(defconst vip-re-replace t - "*If t, do regexp replace. nil means do string replace.") - -(vip-deflocalvar vip-ex-style-motion t - "*Ex-style: the commands l,h do not cross lines, etc.") - -(vip-deflocalvar vip-ex-style-editing-in-insert t - "*The keys ^H, ^? don't jump lines in insert, ESC moves cursor back, etc. -Note: this doesn't preclude ^H and ^? from deleting characters by moving -past the insertion point. This is a feature, not a bug. ") - -(vip-deflocalvar vip-delete-backwards-in-replace nil - "*If t, DEL key will delete characters while moving the cursor backwards. -If nil, the cursor will move backwards without deleting anything.") - -(defconst vip-buffer-search-char nil - "*Key bound for buffer-searching.") - -(defconst vip-search-wrap-around-t t - "*If t, search wraps around.") - -(vip-deflocalvar vip-related-files-and-buffers-ring nil - "*Ring of file and buffer names that are considered to be related to the -current buffer. -These buffers can be cycled through via :R and :P commands.") -(put 'vip-related-files-and-buffers-ring 'permanent-local t) - -;; Used to find out if we are done with searching the current buffer. -(vip-deflocalvar vip-local-search-start-marker nil) -;; As above, but global -(defvar vip-search-start-marker (make-marker)) - -;; the search overlay -(vip-deflocalvar vip-search-overlay nil) - - -(defvar vip-heading-start - (concat "^\\s-*(\\s-*defun\\s-\\|" ; lisp - "^{\\s-*$\\|^[_a-zA-Z][^()]*[()].*{\\s-*$\\|" ; C/C++ - "^\\s-*class.*{\\|^\\s-*struct.*{\\|^\\s-*enum.*{\\|" - "^\\\\[sb][a-z]*{.*}\\s-*$\\|" ; latex - "^@node\\|@table\\|^@m?enu\\|^@itemize\\|^@if\\|" ; texinfo - "^.+:-") ; prolog - "*Regexps for Headings. Used by \[\[ and \]\].") - -(defvar vip-heading-end - (concat "^}\\|" ; C/C++ - "^\\\\end{\\|" ; latex - "^@end \\|" ; texinfo - ")\n\n[ \t\n]*\\|" ; lisp - "\\.\\s-*$") ; prolog - "*Regexps to end Headings/Sections. Used by \[\].") - - -;; These two vars control the interaction of jumps performed by ' and `. -;; In this new version, '' doesn't erase the marks set by ``, so one can -;; use both kinds of jumps interchangeably and without loosing positions -;; inside the lines. - -;; Remembers position of the last jump done using ``'. -(vip-deflocalvar vip-last-jump nil) -;; Remembers position of the last jump done using `''. -(vip-deflocalvar vip-last-jump-ignore 0) - -;; History variables - -;; History of search strings. -(defvar vip-search-history (list "")) -;; History of query-replace strings used as a source. -(defvar vip-replace1-history nil) -;; History of query-replace strings used as replacement. -(defvar vip-replace2-history nil) -;; History of region quoting strings. -(defvar vip-quote-region-history (list vip-quote-string)) -;; History of Ex-style commands. -(defvar vip-ex-history nil) -;; History of shell commands. -(defvar vip-shell-history nil) - - -;; Last shell command. There are two of these, one for Ex (in viper-ex) -;; and one for Vi. - -;; Last shell command executed with ! command. -(defvar vip-last-shell-com nil) - - - -;;; Miscellaneous - -;; don't bark when mark is inactive -(setq mark-even-if-inactive t) - -(defvar vip-inhibit-startup-message nil - "Whether Viper startup message should be inhibited.") - -(defvar vip-always t - "t means, arrange that vi-state will be a default.") - -(defvar vip-custom-file-name (vip-convert-standard-file-name "~/.vip") - "Viper customisation file. -This variable must be set _before_ loading Viper.") - - -(defvar vip-spell-function 'ispell-region - "Spell function used by #s command to spell.") - -(defvar vip-tags-file-name "TAGS" - "The tags file used by Viper.") - -;; Indicates if we are in the middle of executing a command that takes another -;; command as an argument, e.g., cw, dw, etc. -(defvar vip-inside-command-argument-action nil) - -;; Minibuffer - -(defvar vip-vi-style-in-minibuffer t - "If t, use vi-style editing in minibuffer. -Should be set in `~/.vip' file.") - -;; overlay used in the minibuffer to indicate which state it is in -(vip-deflocalvar vip-minibuffer-overlay nil) - -;; Hook, specific to Viper, which is run just *before* exiting the minibuffer. -;; Beginning with Emacs 19.26, the standard `minibuffer-exit-hook' is run -;; *after* exiting the minibuffer -(defvar vip-minibuffer-exit-hook nil) - -;; setup emacs-supported vi-style feel -(setq next-line-add-newlines nil - require-final-newline t) - -(make-variable-buffer-local 'require-final-newline) - - -;; Mode line -(defconst vip-vi-state-id " " - "Mode line tag identifying the Vi mode of Viper.") -(defconst vip-emacs-state-id " " - "Mode line tag identifying the Emacs mode of Viper.") -(defconst vip-insert-state-id " " - "Mode line tag identifying the Insert mode of Viper.") -(defconst vip-replace-state-id " " - "Mode line tag identifying the Replace mode of Viper.") - -;; Viper changes the default mode-line-buffer-identification -(setq-default mode-line-buffer-identification '(" %b")) - -;; Variable displaying the current Viper state in the mode line. -(vip-deflocalvar vip-mode-string vip-emacs-state-id) -(or (memq 'vip-mode-string global-mode-string) - (setq global-mode-string - (append '("" vip-mode-string) (cdr global-mode-string)))) - - -(defvar vip-vi-state-hook nil - "*Hooks run just before the switch to Vi mode is completed.") -(defvar vip-insert-state-hook nil - "*Hooks run just before the switch to Insert mode is completed.") -(defvar vip-replace-state-hook nil - "*Hooks run just before the switch to Replace mode is completed.") -(defvar vip-emacs-state-hook nil - "*Hooks run just before the switch to Emacs mode is completed.") - -(defvar vip-load-hook nil - "Hooks run just after loading Viper.") - - ;; Generic predicates ;; These test functions are shamelessly lifted from vip 4.4.2 by Aamod Sane @@ -828,6 +373,11 @@ ;; define vip-movement-command-p (vip-test-com-defun vip-movement-command) +(defconst vip-digit-commands '(?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9) + "Digit commands") +;; define vip-digit-command-p +(vip-test-com-defun vip-digit-command) + ;; Commands that can be repeated by . (dotted) (defconst vip-dotable-commands '(?c ?d ?C ?s ?S ?D ?> ?<)) ;; define vip-dotable-command-p @@ -844,6 +394,7 @@ (vip-test-com-defun vip-regsuffix-command) (defconst vip-vi-commands (append vip-movement-commands + vip-digit-commands vip-dotable-commands vip-charpair-commands vip-hash-commands @@ -1490,7 +1041,12 @@ (let ((buff (current-buffer)) result) (vip-set-mode-vars-for 'vi-state) - (setq result (eval form)) + + (condition-case nil + (setq result (eval form)) + (error + (signal 'quit nil))) + (if (not (equal buff (current-buffer))) ; cmd switched buffer (save-excursion (set-buffer buff) @@ -1708,6 +1264,7 @@ (t 'vip-change-state-to-vi) ))) (call-interactively cmd))) + @@ -1838,6 +1395,9 @@ (setq char (read-char))) ;; `char' is a movement command or a digit arg command---so we execute ;; it at the very end + (or (vip-movement-command-p char) + (vip-digit-command-p char) + (error "")) (setq mv-or-digit-cmd (vip-exec-form-in-vi (` (key-binding (char-to-string (, char))))))) @@ -1870,7 +1430,10 @@ (setq last-command-event (vip-copy-event (if vip-xemacs-p (character-to-event char) char))) - (funcall mv-or-digit-cmd cmd-info))) + (condition-case nil + (funcall mv-or-digit-cmd cmd-info) + (error + (error ""))))) )) (defun vip-describe-arg (arg) @@ -2538,100 +2101,6 @@ (command-execute command) (exit-minibuffer)))) - -(defun vip-set-search-face () - (if (vip-has-face-support-p) - (defvar vip-search-face - (progn - (make-face 'vip-search-face) - (vip-hide-face 'vip-search-face) - (or (face-differs-from-default-p 'vip-search-face) - ;; face wasn't set in .vip or .Xdefaults - (if (vip-can-use-colors "Black" "khaki") - (progn - (set-face-background 'vip-search-face "khaki") - (set-face-foreground 'vip-search-face "Black")) - (set-face-underline-p 'vip-search-face t) - (vip-set-face-pixmap 'vip-search-face vip-search-face-pixmap))) - 'vip-search-face) - "*Face used to flash out the search pattern.") - )) - - -(defun vip-set-minibuffer-faces () - (if (not (vip-has-face-support-p)) - () - (defvar vip-minibuffer-emacs-face - (progn - (make-face 'vip-minibuffer-emacs-face) - (vip-hide-face 'vip-minibuffer-emacs-face) - (or (face-differs-from-default-p 'vip-minibuffer-emacs-face) - ;; face wasn't set in .vip or .Xdefaults - (if vip-vi-style-in-minibuffer - ;; emacs state is an exception in the minibuffer - (if (vip-can-use-colors "darkseagreen2" "Black") - (progn - (set-face-background - 'vip-minibuffer-emacs-face "darkseagreen2") - (set-face-foreground - 'vip-minibuffer-emacs-face "Black")) - (copy-face 'modeline 'vip-minibuffer-emacs-face)) - ;; emacs state is the main state in the minibuffer - (if (vip-can-use-colors "Black" "pink") - (progn - (set-face-background 'vip-minibuffer-emacs-face "pink") - (set-face-foreground - 'vip-minibuffer-emacs-face "Black")) - (copy-face 'italic 'vip-minibuffer-emacs-face)) - )) - 'vip-minibuffer-emacs-face) - "Face used in the Minibuffer when it is in Emacs state.") - - (defvar vip-minibuffer-insert-face - (progn - (make-face 'vip-minibuffer-insert-face) - (vip-hide-face 'vip-minibuffer-insert-face) - (or (face-differs-from-default-p 'vip-minibuffer-insert-face) - (if vip-vi-style-in-minibuffer - (if (vip-can-use-colors "Black" "pink") - (progn - (set-face-background 'vip-minibuffer-insert-face "pink") - (set-face-foreground - 'vip-minibuffer-insert-face "Black")) - (copy-face 'italic 'vip-minibuffer-insert-face)) - ;; If Insert state is an exception - (if (vip-can-use-colors "darkseagreen2" "Black") - (progn - (set-face-background - 'vip-minibuffer-insert-face "darkseagreen2") - (set-face-foreground - 'vip-minibuffer-insert-face "Black")) - (copy-face 'modeline 'vip-minibuffer-insert-face)) - (vip-italicize-face 'vip-minibuffer-insert-face))) - 'vip-minibuffer-insert-face) - "Face used in the Minibuffer when it is in Insert state.") - - (defvar vip-minibuffer-vi-face - (progn - (make-face 'vip-minibuffer-vi-face) - (vip-hide-face 'vip-minibuffer-vi-face) - (or (face-differs-from-default-p 'vip-minibuffer-vi-face) - (if vip-vi-style-in-minibuffer - (if (vip-can-use-colors "Black" "grey") - (progn - (set-face-background 'vip-minibuffer-vi-face "grey") - (set-face-foreground 'vip-minibuffer-vi-face "Black")) - (copy-face 'bold 'vip-minibuffer-vi-face)) - (copy-face 'bold 'vip-minibuffer-vi-face) - (invert-face 'vip-minibuffer-vi-face))) - 'vip-minibuffer-vi-face) - "Face used in the Minibuffer when it is in Vi state.") - - ;; the current face used in the minibuffer - (vip-deflocalvar vip-minibuffer-current-face vip-minibuffer-emacs-face "") - )) - - ;;; Reading string with history @@ -2873,6 +2342,10 @@ 'vip-post-command-hooks 'vip-replace-state-post-command-sentinel t) (vip-add-hook 'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel t) + ;; guard against a smartie who switched from R-replace to normal replace + (vip-remove-hook + 'vip-post-command-hooks 'vip-R-state-post-command-sentinel) + (if overwrite-mode (overwrite-mode nil)) ) @@ -2948,9 +2421,11 @@ )) (setq vip-replace-chars-to-delete - (max 0 (min vip-replace-chars-to-delete - (- (vip-replace-end) - vip-last-posn-in-replace-region)))) + (max 0 + (min vip-replace-chars-to-delete + (- (vip-replace-end) vip-last-posn-in-replace-region) + (- (vip-line-pos 'end) vip-last-posn-in-replace-region) + ))) ))) @@ -3002,6 +2477,9 @@ 'vip-post-command-hooks 'vip-R-state-post-command-sentinel t) (vip-add-hook 'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel t) + ;; guard against a smartie who switched from R-replace to normal replace + (vip-remove-hook + 'vip-post-command-hooks 'vip-replace-state-post-command-sentinel) ) @@ -3026,6 +2504,29 @@ ) (vip-hide-replace-overlay)) +(defun vip-replace-state-carriage-return () + "Implements carriage return in Viper replace state." + (interactive) + ;; If Emacs start supporting overlay maps, as it currently supports + ;; text-property maps, we could do away with vip-replace-minor-mode and + ;; just have keymap attached to replace overlay. Then the "if part" of this + ;; statement can be deleted. + (if (or (< (point) (vip-replace-start)) + (> (point) (vip-replace-end))) + (let (vip-replace-minor-mode com) + (vip-set-unread-command-events last-input-char) + (setq com (key-binding (read-key-sequence nil))) + (condition-case conds + (command-execute com) + (error + (vip-message-conditions conds)))) + (if (not vip-allow-multiline-replace-regions) + (vip-replace-state-exit-cmd) + (if (vip-same-line (point) (vip-replace-end)) + (vip-replace-state-exit-cmd) + (vip-kill-line nil) + (vip-next-line-at-bol nil))))) + ;; This is the function bound to 'R'---unlimited replace. ;; Similar to Emacs's own overwrite-mode. @@ -4633,8 +4134,9 @@ ;; protect against error while inserting "@" and other disasters ;; (e.g., read-only buff) (condition-case conds - (if (vip-same-line (vip-replace-start) - (vip-replace-end)) + (if (or vip-allow-multiline-replace-regions + (vip-same-line (vip-replace-start) + (vip-replace-end))) (progn ;; tabs cause problems in replace, so untabify (goto-char (vip-replace-end)) @@ -5733,9 +5235,6 @@ (vip-set-minibuffer-style) -(vip-set-minibuffer-faces) -(vip-set-search-face) -(vip-set-replace-overlay-face) (if vip-buffer-search-char (vip-buffer-search-enable)) (vip-update-alphanumeric-class) diff -r ebca3d831cea -r 6a378aca36af lisp/w3/ChangeLog --- a/lisp/w3/ChangeLog Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/w3/ChangeLog Mon Aug 13 09:07:36 2007 +0200 @@ -1,5 +1,317 @@ +Wed Jan 22 08:28:13 1997 William M. Perry + +* Emacs-W3 3.0.50 released + +* base64.el (base64-encode-region): Pulled in code from VM for quicker + encoding/decoding + +* mm.el (mm-content-transfer-encodings): Better base64 decoding + +Wed Jan 22 07:31:03 1997 Alf-Ivar Holm + +* w3-emulate.el (w3-lynx-emulation-minor-mode-map): Lynx [up] and [down] + bound to non-existing functions. + +* w3.el (w3-do-setup): Fixed installation of lynx emulation modes keymap. + +Tue Jan 21 07:56:51 1997 William M. Perry + +* url-misc.el (url-data): Make sure to url-decode the data before + inserting it into the buffer. + +* w3-menu.el (w3-toggle-minibuffer): better version + +* w3-forms.el (w3-form-create-integer): New form entry type + (w3-form-create-float): new form entry type + (w3-form-encode-helper): deal with the new integer/float types + +* w3-display.el (w3-display-node): Reimplemented