Mercurial > hg > xemacs-beta
changeset 185:3d6bfa290dbd r20-3b19
Import from CVS: tag r20-3b19
line wrap: on
line diff
--- a/CHANGES-beta Mon Aug 13 09:54:24 2007 +0200 +++ b/CHANGES-beta Mon Aug 13 09:55:28 2007 +0200 @@ -1,4 +1,19 @@ -*- indented-text -*- +to 20.3 beta19 "Kiev" +-- Mega Martin Buccholz patch +-- Major Viper update, Viper is now Mule aware +-- ediff updates courtesy of Michael Kifer +-- tpu-edt.el/tpu-extras.el synched with Emacs 19.34/XEmacs 19.16 courtesy of + Kevin Oberman +-- strokes.el-2.4beta +-- crisp.el-1.20 courtesy of Gary D. Foster +-- New regex syntax changes courtesy of Michael Cook +-- improved color terminal detection +-- tetris.el-1.4 Courtesy of Glynn Clements +-- Custom-1.9956 +-- Miscellaneous bug fixes +-- W3-3.0.103 + to 20.3 beta18 "Bratislava" -- enhancements to help.el courtesy of Jens Petersen -- Mega Martin Buchholz patch
--- a/ChangeLog Mon Aug 13 09:54:24 2007 +0200 +++ b/ChangeLog Mon Aug 13 09:55:28 2007 +0200 @@ -1,3 +1,32 @@ +1997-09-02 SL Baur <steve@altair.xemacs.org> + + * XEmacs 20.3-beta19 is released. + + * Makefile.in (finder): New target. + +1997-08-29 SL Baur <steve@altair.xemacs.org> + + * XEmacs 19.16-beta91 is released. + +1997-08-25 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * lisp/apel/emu-x20.el (mime-charset-coding-system-alist): + iso-2022-jp-2 is defined as coding-system. + + * lisp/mule/mule-coding.el: Rename `iso-2022-ss2-{7|8}' -> + `iso-2022-{7|8}bit-ss2' to sync with Emacs 20.0.96. + + (iso-2022-jp-2): New coding system. + +1997-08-23 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * lisp/prim/about.el (about-maintainer-glyph): Fix problem with + jka-compr.el. + +1997-08-20 SL Baur <steve@altair.xemacs.org> + + * XEmacs 19.16-beta90 is released. + 1997-08-16 SL Baur <steve@altair.xemacs.org> * XEmacs 20.3-beta18 is released.
--- a/INSTALL Mon Aug 13 09:54:24 2007 +0200 +++ b/INSTALL Mon Aug 13 09:55:28 2007 +0200 @@ -624,7 +624,7 @@ The `configure' script is built from `configure.in' by the `autoconf' program. However, since XEmacs has configuration requirements that -autoconf can't meet, `configure.in' uses an marriage of custom-baked +autoconf can't meet, `configure.in' uses a marriage of custom-baked configuration code and autoconf macros. New versions of autoconf could very well break this arrangement, so it may be wise to avoid rebuilding `configure' from `configure.in' when possible.
--- a/Makefile.in Mon Aug 13 09:54:24 2007 +0200 +++ b/Makefile.in Mon Aug 13 09:55:28 2007 +0200 @@ -226,7 +226,7 @@ .SUFFIXES: .NO_PARALLEL: ${GENERATED_HEADERS} ${MAKE_SUBDIR} dump-elcs -.PHONY: ${SUBDIR} all beta all-elc all-elcs dump-elc dump-elcs autoloads +.PHONY: ${SUBDIR} all beta all-elc all-elcs dump-elc dump-elcs autoloads finder ## Convenience target for XEmacs beta testers beta: clean all-elc @@ -248,6 +248,11 @@ autoloads: src MAKE='$(MAKE)' sh ${srcdir}/lib-src/update-autoloads.sh +finder: src + @(cd lisp/utils; \ + ../../src/xemacs -batch -q -no-site-file \ + -l finder -f finder-compile-keywords ) + ## We force the rebuilding of src/paths.h because the user might give ## different values for the various directories. Since we use ## move-if-change, src/paths.h only actually changes if the user did @@ -424,12 +429,12 @@ @echo "If you would like to save approximately 15M of disk space, do" @echo "make gzip-el" @echo "or you may run " - @echo lib-src/gzip-el.sh lispdir " from the command line." + @echo ${srcdir}/lib-src/gzip-el.sh lispdir " from the command line." @echo "Where lispdir is where the lisp files were installed, i.e.," @echo "${lispdir}" gzip-el: - lib-src/gzip-el.sh ${lispdir} + ${srcdir}/lib-src/gzip-el.sh ${lispdir} MAKEPATH=./lib-src/make-path ## Build all the directories to install XEmacs in.
--- a/configure Mon Aug 13 09:54:24 2007 +0200 +++ b/configure Mon Aug 13 09:55:28 2007 +0200 @@ -61,6 +61,7 @@ x_includes=NONE x_libraries=NONE CDPATH=.; export CDPATH +package_path=NONE if test -n "$ZSH_VERSION"; then setopt NO_BAD_PATTERN NO_BANG_HIST NO_BG_NICE NO_EQUALS NO_FUNCTION_ARGZERO @@ -373,6 +374,9 @@ --mail-locking=TYPE (*) Specify the locking to be used by movemail to prevent concurrent updates of mail spool files. Valid types are \`lockf', \`flock', and \`file'. +--package-path=PATH A list of blank separated directories for finding + packages to dump with xemacs. + Defaults to \`$prefix/lib/xemacs/packages ~/.xemacs' Internationalization options: @@ -844,7 +848,7 @@ esac echo $ac_n "checking whether ln -s works""... $ac_c" 1>&6 -echo "configure:848: checking whether ln -s works" >&5 +echo "configure:852: checking whether ln -s works" >&5 rm -f conftestdata if ln -s X conftestdata 2>/dev/null @@ -1021,7 +1025,7 @@ echo "checking "the configuration name"" 1>&6 -echo "configure:1025: checking "the configuration name"" >&5 +echo "configure:1029: checking "the configuration name"" >&5 internal_configuration=`echo $configuration | sed 's/-\(energize\|workshop\)//'` if canonical=`$srcdir/config.sub "$internal_configuration"` ; then : ; else exit $? @@ -1475,7 +1479,7 @@ # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1479: checking for $ac_word" >&5 +echo "configure:1483: checking for $ac_word" >&5 if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1501,7 +1505,7 @@ # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1505: checking for $ac_word" >&5 +echo "configure:1509: checking for $ac_word" >&5 if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1546,7 +1550,7 @@ fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 -echo "configure:1550: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 +echo "configure:1554: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 ac_ext=c xe_cppflags='$CPPFLAGS $c_switch_site $c_switch_machine $c_switch_system $c_switch_x_site $X_CFLAGS' @@ -1558,11 +1562,11 @@ cross_compiling=no cat > conftest.$ac_ext <<EOF -#line 1562 "configure" +#line 1566 "configure" #include "confdefs.h" main(){return(0);} EOF -if { (eval echo configure:1566: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:1570: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then ac_cv_prog_cc_works=yes # If we can't run a trivial program, we are probably using a cross compiler. if (./conftest; exit) 2>/dev/null; then @@ -1582,19 +1586,19 @@ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 -echo "configure:1586: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 +echo "configure:1590: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:1591: checking whether we are using GNU C" >&5 +echo "configure:1595: checking whether we are using GNU C" >&5 cat > conftest.c <<EOF #ifdef __GNUC__ yes; #endif EOF -if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1598: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then +if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1602: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no @@ -1608,7 +1612,7 @@ ac_save_CFLAGS="$CFLAGS" CFLAGS= echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 -echo "configure:1612: checking whether ${CC-cc} accepts -g" >&5 +echo "configure:1616: checking whether ${CC-cc} accepts -g" >&5 echo 'void f(){}' > conftest.c if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then @@ -1637,7 +1641,7 @@ # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1641: checking for $ac_word" >&5 +echo "configure:1645: checking for $ac_word" >&5 if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1663,7 +1667,7 @@ # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1667: checking for $ac_word" >&5 +echo "configure:1671: checking for $ac_word" >&5 if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1708,7 +1712,7 @@ fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 -echo "configure:1712: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 +echo "configure:1716: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 ac_ext=c xe_cppflags='$CPPFLAGS $c_switch_site $c_switch_machine $c_switch_system $c_switch_x_site $X_CFLAGS' @@ -1720,11 +1724,11 @@ cross_compiling=no cat > conftest.$ac_ext <<EOF -#line 1724 "configure" +#line 1728 "configure" #include "confdefs.h" main(){return(0);} EOF -if { (eval echo configure:1728: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:1732: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then ac_cv_prog_cc_works=yes # If we can't run a trivial program, we are probably using a cross compiler. if (./conftest; exit) 2>/dev/null; then @@ -1744,19 +1748,19 @@ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 -echo "configure:1748: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 +echo "configure:1752: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:1753: checking whether we are using GNU C" >&5 +echo "configure:1757: checking whether we are using GNU C" >&5 cat > conftest.c <<EOF #ifdef __GNUC__ yes; #endif EOF -if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1760: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then +if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1764: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no @@ -1770,7 +1774,7 @@ ac_save_CFLAGS="$CFLAGS" CFLAGS= echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 -echo "configure:1774: checking whether ${CC-cc} accepts -g" >&5 +echo "configure:1778: checking whether ${CC-cc} accepts -g" >&5 echo 'void f(){}' > conftest.c if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then @@ -1799,7 +1803,7 @@ # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1803: checking for $ac_word" >&5 +echo "configure:1807: checking for $ac_word" >&5 if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1825,7 +1829,7 @@ # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1829: checking for $ac_word" >&5 +echo "configure:1833: checking for $ac_word" >&5 if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1870,7 +1874,7 @@ fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 -echo "configure:1874: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 +echo "configure:1878: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 ac_ext=c xe_cppflags='$CPPFLAGS $c_switch_site $c_switch_machine $c_switch_system $c_switch_x_site $X_CFLAGS' @@ -1882,11 +1886,11 @@ cross_compiling=no cat > conftest.$ac_ext <<EOF -#line 1886 "configure" +#line 1890 "configure" #include "confdefs.h" main(){return(0);} EOF -if { (eval echo configure:1890: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:1894: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then ac_cv_prog_cc_works=yes # If we can't run a trivial program, we are probably using a cross compiler. if (./conftest; exit) 2>/dev/null; then @@ -1906,19 +1910,19 @@ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 -echo "configure:1910: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 +echo "configure:1914: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:1915: checking whether we are using GNU C" >&5 +echo "configure:1919: checking whether we are using GNU C" >&5 cat > conftest.c <<EOF #ifdef __GNUC__ yes; #endif EOF -if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1922: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then +if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1926: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no @@ -1932,7 +1936,7 @@ ac_save_CFLAGS="$CFLAGS" CFLAGS= echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 -echo "configure:1936: checking whether ${CC-cc} accepts -g" >&5 +echo "configure:1940: checking whether ${CC-cc} accepts -g" >&5 echo 'void f(){}' > conftest.c if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then @@ -1965,7 +1969,7 @@ test -n "$NON_GNU_CPP" -a "$GCC" != "yes" -a -z "$CPP" && CPP="$NON_GNU_CPP" echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 -echo "configure:1969: checking how to run the C preprocessor" >&5 +echo "configure:1973: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= @@ -1978,13 +1982,13 @@ # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext <<EOF -#line 1982 "configure" +#line 1986 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1988: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:1992: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then : @@ -1995,13 +1999,13 @@ rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext <<EOF -#line 1999 "configure" +#line 2003 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2005: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2009: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then : @@ -2024,9 +2028,9 @@ echo $ac_n "checking for AIX""... $ac_c" 1>&6 -echo "configure:2028: checking for AIX" >&5 -cat > conftest.$ac_ext <<EOF -#line 2030 "configure" +echo "configure:2032: checking for AIX" >&5 +cat > conftest.$ac_ext <<EOF +#line 2034 "configure" #include "confdefs.h" #ifdef _AIX yes @@ -2053,9 +2057,9 @@ echo $ac_n "checking whether we are using SunPro C""... $ac_c" 1>&6 -echo "configure:2057: checking whether we are using SunPro C" >&5 -cat > conftest.$ac_ext <<EOF -#line 2059 "configure" +echo "configure:2061: checking whether we are using SunPro C" >&5 +cat > conftest.$ac_ext <<EOF +#line 2063 "configure" #include "confdefs.h" int main() { @@ -2066,7 +2070,7 @@ ; return 0; } EOF -if { (eval echo configure:2070: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2074: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* __sunpro_c=yes else @@ -2353,7 +2357,7 @@ fi echo $ac_n "checking for dynodump""... $ac_c" 1>&6 -echo "configure:2357: checking for dynodump" >&5 +echo "configure:2361: checking for dynodump" >&5 if test "$unexec" != "unexsol2.o"; then echo "$ac_t""no" 1>&6 else @@ -2424,19 +2428,19 @@ if test "$add_runtime_path" = "yes"; then echo $ac_n "checking "for runtime libraries flag"""... $ac_c" 1>&6 -echo "configure:2428: checking "for runtime libraries flag"" >&5 +echo "configure:2432: checking "for runtime libraries flag"" >&5 dash_r="" for try_dash_r in "-R" "-R " "-rpath "; do xe_check_libs="${try_dash_r}/no/such/file-or-directory" cat > conftest.$ac_ext <<EOF -#line 2433 "configure" +#line 2437 "configure" #include "confdefs.h" int main() { ; return 0; } EOF -if { (eval echo configure:2440: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:2444: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* dash_r="$try_dash_r" else @@ -2534,7 +2538,7 @@ # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2538: checking for $ac_word" >&5 +echo "configure:2542: checking for $ac_word" >&5 if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. @@ -2587,7 +2591,7 @@ # SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" # ./install, which can be erroneously created by make from ./install.sh. echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6 -echo "configure:2591: checking for a BSD compatible install" >&5 +echo "configure:2595: checking for a BSD compatible install" >&5 if test -z "$INSTALL"; then IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS="${IFS}:" @@ -2638,7 +2642,7 @@ # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2642: checking for $ac_word" >&5 +echo "configure:2646: checking for $ac_word" >&5 if test -n "$YACC"; then ac_cv_prog_YACC="$YACC" # Let the user override the test. @@ -2669,15 +2673,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:2673: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <<EOF -#line 2676 "configure" +echo "configure:2677: checking for $ac_hdr" >&5 + +cat > conftest.$ac_ext <<EOF +#line 2680 "configure" #include "confdefs.h" #include <$ac_hdr> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2681: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2685: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -2710,15 +2714,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:2714: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <<EOF -#line 2717 "configure" +echo "configure:2718: checking for $ac_hdr" >&5 + +cat > conftest.$ac_ext <<EOF +#line 2721 "configure" #include "confdefs.h" #include <$ac_hdr> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2722: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2726: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -2751,15 +2755,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:2755: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <<EOF -#line 2758 "configure" +echo "configure:2759: checking for $ac_hdr" >&5 + +cat > conftest.$ac_ext <<EOF +#line 2762 "configure" #include "confdefs.h" #include <$ac_hdr> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2763: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2767: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -2789,10 +2793,10 @@ done echo $ac_n "checking for sys/wait.h that is POSIX.1 compatible""... $ac_c" 1>&6 -echo "configure:2793: checking for sys/wait.h that is POSIX.1 compatible" >&5 - -cat > conftest.$ac_ext <<EOF -#line 2796 "configure" +echo "configure:2797: checking for sys/wait.h that is POSIX.1 compatible" >&5 + +cat > conftest.$ac_ext <<EOF +#line 2800 "configure" #include "confdefs.h" #include <sys/types.h> #include <sys/wait.h> @@ -2808,7 +2812,7 @@ s = WIFEXITED (s) ? WEXITSTATUS (s) : 1; ; return 0; } EOF -if { (eval echo configure:2812: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2816: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_header_sys_wait_h=yes else @@ -2832,10 +2836,10 @@ fi echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 -echo "configure:2836: checking for ANSI C header files" >&5 - -cat > conftest.$ac_ext <<EOF -#line 2839 "configure" +echo "configure:2840: checking for ANSI C header files" >&5 + +cat > conftest.$ac_ext <<EOF +#line 2843 "configure" #include "confdefs.h" #include <stdlib.h> #include <stdarg.h> @@ -2843,7 +2847,7 @@ #include <float.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2847: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2851: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -2860,7 +2864,7 @@ if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext <<EOF -#line 2864 "configure" +#line 2868 "configure" #include "confdefs.h" #include <string.h> EOF @@ -2878,7 +2882,7 @@ if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext <<EOF -#line 2882 "configure" +#line 2886 "configure" #include "confdefs.h" #include <stdlib.h> EOF @@ -2896,7 +2900,7 @@ if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. cat > conftest.$ac_ext <<EOF -#line 2900 "configure" +#line 2904 "configure" #include "confdefs.h" #include <ctype.h> #define ISLOWER(c) ('a' <= (c) && (c) <= 'z') @@ -2907,7 +2911,7 @@ exit (0); } EOF -if { (eval echo configure:2911: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:2915: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then : else @@ -2932,10 +2936,10 @@ fi echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6 -echo "configure:2936: checking whether time.h and sys/time.h may both be included" >&5 - -cat > conftest.$ac_ext <<EOF -#line 2939 "configure" +echo "configure:2940: checking whether time.h and sys/time.h may both be included" >&5 + +cat > conftest.$ac_ext <<EOF +#line 2943 "configure" #include "confdefs.h" #include <sys/types.h> #include <sys/time.h> @@ -2944,7 +2948,7 @@ struct tm *tp; ; return 0; } EOF -if { (eval echo configure:2948: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2952: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_header_time=yes else @@ -2968,10 +2972,10 @@ fi echo $ac_n "checking for sys_siglist declaration in signal.h or unistd.h""... $ac_c" 1>&6 -echo "configure:2972: checking for sys_siglist declaration in signal.h or unistd.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 2975 "configure" +echo "configure:2976: checking for sys_siglist declaration in signal.h or unistd.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 2979 "configure" #include "confdefs.h" #include <sys/types.h> #include <signal.h> @@ -2983,7 +2987,7 @@ char *msg = *(sys_siglist + 1); ; return 0; } EOF -if { (eval echo configure:2987: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2991: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_decl_sys_siglist=yes else @@ -3008,9 +3012,9 @@ echo $ac_n "checking for struct utimbuf""... $ac_c" 1>&6 -echo "configure:3012: checking for struct utimbuf" >&5 -cat > conftest.$ac_ext <<EOF -#line 3014 "configure" +echo "configure:3016: checking for struct utimbuf" >&5 +cat > conftest.$ac_ext <<EOF +#line 3018 "configure" #include "confdefs.h" #ifdef TIME_WITH_SYS_TIME #include <sys/time.h> @@ -3029,7 +3033,7 @@ static struct utimbuf x; x.actime = x.modtime; ; return 0; } EOF -if { (eval echo configure:3033: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3037: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* echo "$ac_t""yes" 1>&6 { test "$extra_verbose" = "yes" && cat << \EOF @@ -3049,10 +3053,10 @@ rm -f conftest* echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6 -echo "configure:3053: checking return type of signal handlers" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3056 "configure" +echo "configure:3057: checking return type of signal handlers" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3060 "configure" #include "confdefs.h" #include <sys/types.h> #include <signal.h> @@ -3069,7 +3073,7 @@ int i; ; return 0; } EOF -if { (eval echo configure:3073: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3077: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_type_signal=void else @@ -3091,10 +3095,10 @@ echo $ac_n "checking for size_t""... $ac_c" 1>&6 -echo "configure:3095: checking for size_t" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3098 "configure" +echo "configure:3099: checking for size_t" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3102 "configure" #include "confdefs.h" #include <sys/types.h> #if STDC_HEADERS @@ -3125,10 +3129,10 @@ fi echo $ac_n "checking for pid_t""... $ac_c" 1>&6 -echo "configure:3129: checking for pid_t" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3132 "configure" +echo "configure:3133: checking for pid_t" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3136 "configure" #include "confdefs.h" #include <sys/types.h> #if STDC_HEADERS @@ -3159,10 +3163,10 @@ fi echo $ac_n "checking for uid_t in sys/types.h""... $ac_c" 1>&6 -echo "configure:3163: checking for uid_t in sys/types.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3166 "configure" +echo "configure:3167: checking for uid_t in sys/types.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3170 "configure" #include "confdefs.h" #include <sys/types.h> EOF @@ -3198,10 +3202,10 @@ fi echo $ac_n "checking for mode_t""... $ac_c" 1>&6 -echo "configure:3202: checking for mode_t" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3205 "configure" +echo "configure:3206: checking for mode_t" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3209 "configure" #include "confdefs.h" #include <sys/types.h> #if STDC_HEADERS @@ -3232,10 +3236,10 @@ fi echo $ac_n "checking for off_t""... $ac_c" 1>&6 -echo "configure:3236: checking for off_t" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3239 "configure" +echo "configure:3240: checking for off_t" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3243 "configure" #include "confdefs.h" #include <sys/types.h> #if STDC_HEADERS @@ -3267,9 +3271,9 @@ echo $ac_n "checking for struct timeval""... $ac_c" 1>&6 -echo "configure:3271: checking for struct timeval" >&5 -cat > conftest.$ac_ext <<EOF -#line 3273 "configure" +echo "configure:3275: checking for struct timeval" >&5 +cat > conftest.$ac_ext <<EOF +#line 3277 "configure" #include "confdefs.h" #ifdef TIME_WITH_SYS_TIME #include <sys/time.h> @@ -3285,7 +3289,7 @@ static struct timeval x; x.tv_sec = x.tv_usec; ; return 0; } EOF -if { (eval echo configure:3289: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3293: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* echo "$ac_t""yes" 1>&6 HAVE_TIMEVAL=yes @@ -3307,10 +3311,10 @@ rm -f conftest* echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6 -echo "configure:3311: checking whether struct tm is in sys/time.h or time.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3314 "configure" +echo "configure:3315: checking whether struct tm is in sys/time.h or time.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3318 "configure" #include "confdefs.h" #include <sys/types.h> #include <time.h> @@ -3318,7 +3322,7 @@ struct tm *tp; tp->tm_sec; ; return 0; } EOF -if { (eval echo configure:3322: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3326: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_tm=time.h else @@ -3342,10 +3346,10 @@ fi echo $ac_n "checking for tm_zone in struct tm""... $ac_c" 1>&6 -echo "configure:3346: checking for tm_zone in struct tm" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3349 "configure" +echo "configure:3350: checking for tm_zone in struct tm" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3353 "configure" #include "confdefs.h" #include <sys/types.h> #include <$ac_cv_struct_tm> @@ -3353,7 +3357,7 @@ struct tm tm; tm.tm_zone; ; return 0; } EOF -if { (eval echo configure:3357: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3361: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_tm_zone=yes else @@ -3376,10 +3380,10 @@ else echo $ac_n "checking for tzname""... $ac_c" 1>&6 -echo "configure:3380: checking for tzname" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3383 "configure" +echo "configure:3384: checking for tzname" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3387 "configure" #include "confdefs.h" #include <time.h> #ifndef tzname /* For SGI. */ @@ -3389,7 +3393,7 @@ atoi(*tzname); ; return 0; } EOF -if { (eval echo configure:3393: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3397: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* ac_cv_var_tzname=yes else @@ -3415,10 +3419,10 @@ echo $ac_n "checking for working const""... $ac_c" 1>&6 -echo "configure:3419: checking for working const" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3422 "configure" +echo "configure:3423: checking for working const" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3426 "configure" #include "confdefs.h" int main() { @@ -3467,7 +3471,7 @@ ; return 0; } EOF -if { (eval echo configure:3471: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3475: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_const=yes else @@ -3492,7 +3496,7 @@ echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 -echo "configure:3496: checking whether ${MAKE-make} sets \${MAKE}" >&5 +echo "configure:3500: checking whether ${MAKE-make} sets \${MAKE}" >&5 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` cat > conftestmake <<\EOF @@ -3517,12 +3521,12 @@ echo $ac_n "checking whether byte ordering is bigendian""... $ac_c" 1>&6 -echo "configure:3521: checking whether byte ordering is bigendian" >&5 +echo "configure:3525: checking whether byte ordering is bigendian" >&5 ac_cv_c_bigendian=unknown # See if sys/param.h defines the BYTE_ORDER macro. cat > conftest.$ac_ext <<EOF -#line 3526 "configure" +#line 3530 "configure" #include "confdefs.h" #include <sys/types.h> #include <sys/param.h> @@ -3533,11 +3537,11 @@ #endif ; return 0; } EOF -if { (eval echo configure:3537: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3541: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* # It does; now see whether it defined to BIG_ENDIAN or not. cat > conftest.$ac_ext <<EOF -#line 3541 "configure" +#line 3545 "configure" #include "confdefs.h" #include <sys/types.h> #include <sys/param.h> @@ -3548,7 +3552,7 @@ #endif ; return 0; } EOF -if { (eval echo configure:3552: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3556: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_bigendian=yes else @@ -3565,7 +3569,7 @@ rm -f conftest* if test $ac_cv_c_bigendian = unknown; then cat > conftest.$ac_ext <<EOF -#line 3569 "configure" +#line 3573 "configure" #include "confdefs.h" main () { /* Are we little or big endian? From Harbison&Steele. */ @@ -3578,7 +3582,7 @@ exit (u.c[sizeof (long) - 1] == 1); } EOF -if { (eval echo configure:3582: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3586: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_c_bigendian=no else @@ -3604,10 +3608,10 @@ echo $ac_n "checking size of short""... $ac_c" 1>&6 -echo "configure:3608: checking size of short" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3611 "configure" +echo "configure:3612: checking size of short" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3615 "configure" #include "confdefs.h" #include <stdio.h> main() @@ -3618,7 +3622,7 @@ exit(0); } EOF -if { (eval echo configure:3622: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3626: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_sizeof_short=`cat conftestval` else @@ -3645,10 +3649,10 @@ exit 1 fi echo $ac_n "checking size of int""... $ac_c" 1>&6 -echo "configure:3649: checking size of int" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3652 "configure" +echo "configure:3653: checking size of int" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3656 "configure" #include "confdefs.h" #include <stdio.h> main() @@ -3659,7 +3663,7 @@ exit(0); } EOF -if { (eval echo configure:3663: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3667: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_sizeof_int=`cat conftestval` else @@ -3680,10 +3684,10 @@ echo $ac_n "checking size of long""... $ac_c" 1>&6 -echo "configure:3684: checking size of long" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3687 "configure" +echo "configure:3688: checking size of long" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3691 "configure" #include "confdefs.h" #include <stdio.h> main() @@ -3694,7 +3698,7 @@ exit(0); } EOF -if { (eval echo configure:3698: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3702: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_sizeof_long=`cat conftestval` else @@ -3715,10 +3719,10 @@ echo $ac_n "checking size of long long""... $ac_c" 1>&6 -echo "configure:3719: checking size of long long" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3722 "configure" +echo "configure:3723: checking size of long long" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3726 "configure" #include "confdefs.h" #include <stdio.h> main() @@ -3729,7 +3733,7 @@ exit(0); } EOF -if { (eval echo configure:3733: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3737: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_sizeof_long_long=`cat conftestval` else @@ -3750,10 +3754,10 @@ echo $ac_n "checking size of void *""... $ac_c" 1>&6 -echo "configure:3754: checking size of void *" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3757 "configure" +echo "configure:3758: checking size of void *" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3761 "configure" #include "confdefs.h" #include <stdio.h> main() @@ -3764,7 +3768,7 @@ exit(0); } EOF -if { (eval echo configure:3768: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3772: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_sizeof_void_p=`cat conftestval` else @@ -3786,7 +3790,7 @@ echo $ac_n "checking for long file names""... $ac_c" 1>&6 -echo "configure:3790: checking for long file names" >&5 +echo "configure:3794: checking for long file names" >&5 ac_cv_sys_long_file_names=yes # Test for long file names in all the places we know might matter: @@ -3833,12 +3837,12 @@ echo $ac_n "checking for sqrt in -lm""... $ac_c" 1>&6 -echo "configure:3837: checking for sqrt in -lm" >&5 +echo "configure:3841: checking for sqrt in -lm" >&5 ac_lib_var=`echo m'_'sqrt | sed 'y%./+-%__p_%'` xe_check_libs=" -lm " cat > conftest.$ac_ext <<EOF -#line 3842 "configure" +#line 3846 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -3849,7 +3853,7 @@ sqrt() ; return 0; } EOF -if { (eval echo configure:3853: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3857: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -3891,7 +3895,7 @@ echo "checking type of mail spool file locking" 1>&6 -echo "configure:3895: checking type of mail spool file locking" >&5 +echo "configure:3899: checking type of mail spool file locking" >&5 test -z "$mail_locking" -a "$mail_use_flock" = "yes" && mail_locking=flock test -z "$mail_locking" -a "$mail_use_lockf" = "yes" && mail_locking=lockf if test "$mail_locking" = "lockf"; then { test "$extra_verbose" = "yes" && cat << \EOF @@ -3915,12 +3919,12 @@ echo $ac_n "checking for kstat_open in -lkstat""... $ac_c" 1>&6 -echo "configure:3919: checking for kstat_open in -lkstat" >&5 +echo "configure:3923: checking for kstat_open in -lkstat" >&5 ac_lib_var=`echo kstat'_'kstat_open | sed 'y%./+-%__p_%'` xe_check_libs=" -lkstat " cat > conftest.$ac_ext <<EOF -#line 3924 "configure" +#line 3928 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -3931,7 +3935,7 @@ kstat_open() ; return 0; } EOF -if { (eval echo configure:3935: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3939: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -3965,12 +3969,12 @@ echo $ac_n "checking for kvm_read in -lkvm""... $ac_c" 1>&6 -echo "configure:3969: checking for kvm_read in -lkvm" >&5 +echo "configure:3973: checking for kvm_read in -lkvm" >&5 ac_lib_var=`echo kvm'_'kvm_read | sed 'y%./+-%__p_%'` xe_check_libs=" -lkvm " cat > conftest.$ac_ext <<EOF -#line 3974 "configure" +#line 3978 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -3981,7 +3985,7 @@ kvm_read() ; return 0; } EOF -if { (eval echo configure:3985: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3989: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4015,12 +4019,12 @@ echo $ac_n "checking for cma_open in -lpthreads""... $ac_c" 1>&6 -echo "configure:4019: checking for cma_open in -lpthreads" >&5 +echo "configure:4023: checking for cma_open in -lpthreads" >&5 ac_lib_var=`echo pthreads'_'cma_open | sed 'y%./+-%__p_%'` xe_check_libs=" -lpthreads " cat > conftest.$ac_ext <<EOF -#line 4024 "configure" +#line 4028 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -4031,7 +4035,7 @@ cma_open() ; return 0; } EOF -if { (eval echo configure:4035: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4039: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4067,7 +4071,7 @@ fi echo $ac_n "checking whether the -xildoff compiler flag is required""... $ac_c" 1>&6 -echo "configure:4071: checking whether the -xildoff compiler flag is required" >&5 +echo "configure:4075: checking whether the -xildoff compiler flag is required" >&5 if ${CC-cc} '-###' -xildon no_such_file.c 2>&1 | grep '^[^ ]*/ild ' > /dev/null ; then if ${CC-cc} '-###' -xildoff no_such_file.c 2>&1 | grep '^[^ ]*/ild ' > /dev/null ; then echo "$ac_t""no" 1>&6; @@ -4078,7 +4082,7 @@ if test "$opsys" = "sol2" && test "$OS_RELEASE" -ge 56; then echo $ac_n "checking for \"-z ignore\" linker flag""... $ac_c" 1>&6 -echo "configure:4082: checking for \"-z ignore\" linker flag" >&5 +echo "configure:4086: checking for \"-z ignore\" linker flag" >&5 case "`ld -h 2>&1`" in *-z\ ignore\|record* ) echo "$ac_t""yes" 1>&6 ld_switch_site="-z ignore $ld_switch_site" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-z ignore\" to \$ld_switch_site"; fi ;; @@ -4088,7 +4092,7 @@ echo "checking "for specified window system"" 1>&6 -echo "configure:4092: checking "for specified window system"" >&5 +echo "configure:4096: checking "for specified window system"" >&5 if test "$x_includes $x_libraries" = "NONE NONE"; then if test -n "$OPENWINHOME" \ @@ -4109,7 +4113,7 @@ # Uses ac_ vars as temps to allow command line to override cache and checks. # --without-x overrides everything else, but does not touch the cache. echo $ac_n "checking for X""... $ac_c" 1>&6 -echo "configure:4113: checking for X" >&5 +echo "configure:4117: checking for X" >&5 # Check whether --with-x or --without-x was given. if test "${with_x+set}" = set; then @@ -4169,12 +4173,12 @@ # First, try using that file with no special directory specified. cat > conftest.$ac_ext <<EOF -#line 4173 "configure" +#line 4177 "configure" #include "confdefs.h" #include <$x_direct_test_include> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:4178: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:4182: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -4243,14 +4247,14 @@ ac_save_LIBS="$LIBS" LIBS="-l$x_direct_test_library $LIBS" cat > conftest.$ac_ext <<EOF -#line 4247 "configure" +#line 4251 "configure" #include "confdefs.h" int main() { ${x_direct_test_function}() ; return 0; } EOF -if { (eval echo configure:4254: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4258: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* LIBS="$ac_save_LIBS" # We can link X programs with no special library path. @@ -4359,17 +4363,17 @@ case "`(uname -sr) 2>/dev/null`" in "SunOS 5"*) echo $ac_n "checking whether -R must be followed by a space""... $ac_c" 1>&6 -echo "configure:4363: checking whether -R must be followed by a space" >&5 +echo "configure:4367: checking whether -R must be followed by a space" >&5 ac_xsave_LIBS="$LIBS"; LIBS="$LIBS -R$x_libraries" cat > conftest.$ac_ext <<EOF -#line 4366 "configure" +#line 4370 "configure" #include "confdefs.h" int main() { ; return 0; } EOF -if { (eval echo configure:4373: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4377: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* ac_R_nospace=yes else @@ -4385,14 +4389,14 @@ else LIBS="$ac_xsave_LIBS -R $x_libraries" cat > conftest.$ac_ext <<EOF -#line 4389 "configure" +#line 4393 "configure" #include "confdefs.h" int main() { ; return 0; } EOF -if { (eval echo configure:4396: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4400: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* ac_R_space=yes else @@ -4428,12 +4432,12 @@ else echo $ac_n "checking for dnet_ntoa in -ldnet""... $ac_c" 1>&6 -echo "configure:4432: checking for dnet_ntoa in -ldnet" >&5 +echo "configure:4436: checking for dnet_ntoa in -ldnet" >&5 ac_lib_var=`echo dnet'_'dnet_ntoa | sed 'y%./+-%__p_%'` xe_check_libs=" -ldnet " cat > conftest.$ac_ext <<EOF -#line 4437 "configure" +#line 4441 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -4444,7 +4448,7 @@ dnet_ntoa() ; return 0; } EOF -if { (eval echo configure:4448: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4452: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4468,12 +4472,12 @@ if test $ac_cv_lib_dnet_dnet_ntoa = no; then echo $ac_n "checking for dnet_ntoa in -ldnet_stub""... $ac_c" 1>&6 -echo "configure:4472: checking for dnet_ntoa in -ldnet_stub" >&5 +echo "configure:4476: checking for dnet_ntoa in -ldnet_stub" >&5 ac_lib_var=`echo dnet_stub'_'dnet_ntoa | sed 'y%./+-%__p_%'` xe_check_libs=" -ldnet_stub " cat > conftest.$ac_ext <<EOF -#line 4477 "configure" +#line 4481 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -4484,7 +4488,7 @@ dnet_ntoa() ; return 0; } EOF -if { (eval echo configure:4488: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4492: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4513,10 +4517,10 @@ # The nsl library prevents programs from opening the X display # on Irix 5.2, according to dickey@clark.net. echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6 -echo "configure:4517: checking for gethostbyname" >&5 - -cat > conftest.$ac_ext <<EOF -#line 4520 "configure" +echo "configure:4521: checking for gethostbyname" >&5 + +cat > conftest.$ac_ext <<EOF +#line 4524 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char gethostbyname(); below. */ @@ -4539,7 +4543,7 @@ ; return 0; } EOF -if { (eval echo configure:4543: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4547: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_gethostbyname=yes" else @@ -4560,12 +4564,12 @@ if test $ac_cv_func_gethostbyname = no; then echo $ac_n "checking for gethostbyname in -lnsl""... $ac_c" 1>&6 -echo "configure:4564: checking for gethostbyname in -lnsl" >&5 +echo "configure:4568: checking for gethostbyname in -lnsl" >&5 ac_lib_var=`echo nsl'_'gethostbyname | sed 'y%./+-%__p_%'` xe_check_libs=" -lnsl " cat > conftest.$ac_ext <<EOF -#line 4569 "configure" +#line 4573 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -4576,7 +4580,7 @@ gethostbyname() ; return 0; } EOF -if { (eval echo configure:4580: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4584: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4606,10 +4610,10 @@ # -lsocket must be given before -lnsl if both are needed. # We assume that if connect needs -lnsl, so does gethostbyname. echo $ac_n "checking for connect""... $ac_c" 1>&6 -echo "configure:4610: checking for connect" >&5 - -cat > conftest.$ac_ext <<EOF -#line 4613 "configure" +echo "configure:4614: checking for connect" >&5 + +cat > conftest.$ac_ext <<EOF +#line 4617 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char connect(); below. */ @@ -4632,7 +4636,7 @@ ; return 0; } EOF -if { (eval echo configure:4636: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4640: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_connect=yes" else @@ -4655,12 +4659,12 @@ xe_msg_checking="for connect in -lsocket" test -n "$X_EXTRA_LIBS" && xe_msg_checking="$xe_msg_checking using extra libs $X_EXTRA_LIBS" echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 -echo "configure:4659: checking "$xe_msg_checking"" >&5 +echo "configure:4663: checking "$xe_msg_checking"" >&5 ac_lib_var=`echo socket'_'connect | sed 'y%./+-%__p_%'` xe_check_libs=" -lsocket $X_EXTRA_LIBS" cat > conftest.$ac_ext <<EOF -#line 4664 "configure" +#line 4668 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -4671,7 +4675,7 @@ connect() ; return 0; } EOF -if { (eval echo configure:4675: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4679: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4695,10 +4699,10 @@ # gomez@mi.uni-erlangen.de says -lposix is necessary on A/UX. echo $ac_n "checking for remove""... $ac_c" 1>&6 -echo "configure:4699: checking for remove" >&5 - -cat > conftest.$ac_ext <<EOF -#line 4702 "configure" +echo "configure:4703: checking for remove" >&5 + +cat > conftest.$ac_ext <<EOF +#line 4706 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char remove(); below. */ @@ -4721,7 +4725,7 @@ ; return 0; } EOF -if { (eval echo configure:4725: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4729: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_remove=yes" else @@ -4742,12 +4746,12 @@ if test $ac_cv_func_remove = no; then echo $ac_n "checking for remove in -lposix""... $ac_c" 1>&6 -echo "configure:4746: checking for remove in -lposix" >&5 +echo "configure:4750: checking for remove in -lposix" >&5 ac_lib_var=`echo posix'_'remove | sed 'y%./+-%__p_%'` xe_check_libs=" -lposix " cat > conftest.$ac_ext <<EOF -#line 4751 "configure" +#line 4755 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -4758,7 +4762,7 @@ remove() ; return 0; } EOF -if { (eval echo configure:4762: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4766: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4782,10 +4786,10 @@ # BSDI BSD/OS 2.1 needs -lipc for XOpenDisplay. echo $ac_n "checking for shmat""... $ac_c" 1>&6 -echo "configure:4786: checking for shmat" >&5 - -cat > conftest.$ac_ext <<EOF -#line 4789 "configure" +echo "configure:4790: checking for shmat" >&5 + +cat > conftest.$ac_ext <<EOF +#line 4793 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char shmat(); below. */ @@ -4808,7 +4812,7 @@ ; return 0; } EOF -if { (eval echo configure:4812: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4816: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_shmat=yes" else @@ -4829,12 +4833,12 @@ if test $ac_cv_func_shmat = no; then echo $ac_n "checking for shmat in -lipc""... $ac_c" 1>&6 -echo "configure:4833: checking for shmat in -lipc" >&5 +echo "configure:4837: checking for shmat in -lipc" >&5 ac_lib_var=`echo ipc'_'shmat | sed 'y%./+-%__p_%'` xe_check_libs=" -lipc " cat > conftest.$ac_ext <<EOF -#line 4838 "configure" +#line 4842 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -4845,7 +4849,7 @@ shmat() ; return 0; } EOF -if { (eval echo configure:4849: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4853: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4879,12 +4883,12 @@ # --interran@uluru.Stanford.EDU, kb@cs.umb.edu. echo $ac_n "checking for IceConnectionNumber in -lICE""... $ac_c" 1>&6 -echo "configure:4883: checking for IceConnectionNumber in -lICE" >&5 +echo "configure:4887: checking for IceConnectionNumber in -lICE" >&5 ac_lib_var=`echo ICE'_'IceConnectionNumber | sed 'y%./+-%__p_%'` xe_check_libs=" -lICE " cat > conftest.$ac_ext <<EOF -#line 4888 "configure" +#line 4892 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -4895,7 +4899,7 @@ IceConnectionNumber() ; return 0; } EOF -if { (eval echo configure:4899: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4903: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5028,7 +5032,7 @@ fi echo "checking for X defines extracted by xmkmf" 1>&6 -echo "configure:5032: checking for X defines extracted by xmkmf" >&5 +echo "configure:5036: checking for X defines extracted by xmkmf" >&5 rm -fr conftestdir if mkdir conftestdir; then cd conftestdir @@ -5060,15 +5064,15 @@ ac_safe=`echo "X11/Intrinsic.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for X11/Intrinsic.h""... $ac_c" 1>&6 -echo "configure:5064: checking for X11/Intrinsic.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 5067 "configure" +echo "configure:5068: checking for X11/Intrinsic.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 5071 "configure" #include "confdefs.h" #include <X11/Intrinsic.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5072: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5076: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5092,12 +5096,12 @@ echo $ac_n "checking for XOpenDisplay in -lX11""... $ac_c" 1>&6 -echo "configure:5096: checking for XOpenDisplay in -lX11" >&5 +echo "configure:5100: checking for XOpenDisplay in -lX11" >&5 ac_lib_var=`echo X11'_'XOpenDisplay | sed 'y%./+-%__p_%'` xe_check_libs=" -lX11 " cat > conftest.$ac_ext <<EOF -#line 5101 "configure" +#line 5105 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -5108,7 +5112,7 @@ XOpenDisplay() ; return 0; } EOF -if { (eval echo configure:5112: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5116: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5133,12 +5137,12 @@ xe_msg_checking="for XGetFontProperty in -lX11" test -n "-b i486-linuxaout" && xe_msg_checking="$xe_msg_checking using extra libs -b i486-linuxaout" echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 -echo "configure:5137: checking "$xe_msg_checking"" >&5 +echo "configure:5141: checking "$xe_msg_checking"" >&5 ac_lib_var=`echo X11'_'XGetFontProperty | sed 'y%./+-%__p_%'` xe_check_libs=" -lX11 -b i486-linuxaout" cat > conftest.$ac_ext <<EOF -#line 5142 "configure" +#line 5146 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -5149,7 +5153,7 @@ XGetFontProperty() ; return 0; } EOF -if { (eval echo configure:5153: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5157: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5176,12 +5180,12 @@ echo $ac_n "checking for XShapeSelectInput in -lXext""... $ac_c" 1>&6 -echo "configure:5180: checking for XShapeSelectInput in -lXext" >&5 +echo "configure:5184: checking for XShapeSelectInput in -lXext" >&5 ac_lib_var=`echo Xext'_'XShapeSelectInput | sed 'y%./+-%__p_%'` xe_check_libs=" -lXext " cat > conftest.$ac_ext <<EOF -#line 5185 "configure" +#line 5189 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -5192,7 +5196,7 @@ XShapeSelectInput() ; return 0; } EOF -if { (eval echo configure:5196: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5200: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5215,12 +5219,12 @@ echo $ac_n "checking for XtOpenDisplay in -lXt""... $ac_c" 1>&6 -echo "configure:5219: checking for XtOpenDisplay in -lXt" >&5 +echo "configure:5223: checking for XtOpenDisplay in -lXt" >&5 ac_lib_var=`echo Xt'_'XtOpenDisplay | sed 'y%./+-%__p_%'` xe_check_libs=" -lXt " cat > conftest.$ac_ext <<EOF -#line 5224 "configure" +#line 5228 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -5231,7 +5235,7 @@ XtOpenDisplay() ; return 0; } EOF -if { (eval echo configure:5235: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5239: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5254,14 +5258,14 @@ echo $ac_n "checking the version of X11 being used""... $ac_c" 1>&6 -echo "configure:5258: checking the version of X11 being used" >&5 +echo "configure:5262: checking the version of X11 being used" >&5 cat > conftest.$ac_ext <<EOF -#line 5260 "configure" +#line 5264 "configure" #include "confdefs.h" #include <X11/Intrinsic.h> main(int c, char* v[]) { return c>1 ? XlibSpecificationRelease : 0; } EOF -if { (eval echo configure:5265: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:5269: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ./conftest foobar; x11_release=$? else @@ -5285,15 +5289,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:5289: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <<EOF -#line 5292 "configure" +echo "configure:5293: checking for $ac_hdr" >&5 + +cat > conftest.$ac_ext <<EOF +#line 5296 "configure" #include "confdefs.h" #include <$ac_hdr> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5297: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5301: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5324,7 +5328,7 @@ echo $ac_n "checking for XFree86""... $ac_c" 1>&6 -echo "configure:5328: checking for XFree86" >&5 +echo "configure:5332: checking for XFree86" >&5 if test -d "/usr/X386/include" -o \ -f "/etc/XF86Config" -o \ -f "/etc/X11/XF86Config" -o \ @@ -5344,12 +5348,12 @@ test -z "$with_xmu" && { echo $ac_n "checking for XmuReadBitmapDataFromFile in -lXmu""... $ac_c" 1>&6 -echo "configure:5348: checking for XmuReadBitmapDataFromFile in -lXmu" >&5 +echo "configure:5352: checking for XmuReadBitmapDataFromFile in -lXmu" >&5 ac_lib_var=`echo Xmu'_'XmuReadBitmapDataFromFile | sed 'y%./+-%__p_%'` xe_check_libs=" -lXmu " cat > conftest.$ac_ext <<EOF -#line 5353 "configure" +#line 5357 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -5360,7 +5364,7 @@ XmuReadBitmapDataFromFile() ; return 0; } EOF -if { (eval echo configure:5364: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5368: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5381,28 +5385,37 @@ fi } - if test "$with_xmu" = "no" - then extra_objs="$extra_objs xmu.o" && if test "$extra_verbose" = "yes"; then + if test "$with_xmu" = "no"; then + extra_objs="$extra_objs xmu.o" && if test "$extra_verbose" = "yes"; then echo " xemacs will be linked with \"xmu.o\"" fi - else libs_x="-lXmu $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lXmu\" to \$libs_x"; fi + else + libs_x="-lXmu $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lXmu\" to \$libs_x"; fi + { test "$extra_verbose" = "yes" && cat << \EOF + Defining HAVE_XMU +EOF +cat >> confdefs.h <<\EOF +#define HAVE_XMU 1 +EOF +} + fi echo $ac_n "checking for main in -lXbsd""... $ac_c" 1>&6 -echo "configure:5394: checking for main in -lXbsd" >&5 +echo "configure:5407: checking for main in -lXbsd" >&5 ac_lib_var=`echo Xbsd'_'main | sed 'y%./+-%__p_%'` xe_check_libs=" -lXbsd " cat > conftest.$ac_ext <<EOF -#line 5399 "configure" +#line 5412 "configure" #include "confdefs.h" int main() { main() ; return 0; } EOF -if { (eval echo configure:5406: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5419: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5425,12 +5438,12 @@ echo $ac_n "checking for XawScrollbarSetThumb in -lXaw""... $ac_c" 1>&6 -echo "configure:5429: checking for XawScrollbarSetThumb in -lXaw" >&5 +echo "configure:5442: checking for XawScrollbarSetThumb in -lXaw" >&5 ac_lib_var=`echo Xaw'_'XawScrollbarSetThumb | sed 'y%./+-%__p_%'` xe_check_libs=" -lXaw " cat > conftest.$ac_ext <<EOF -#line 5434 "configure" +#line 5447 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -5441,7 +5454,7 @@ XawScrollbarSetThumb() ; return 0; } EOF -if { (eval echo configure:5445: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5458: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5465,15 +5478,15 @@ if test "$have_xaw" = "yes"; then ac_safe=`echo "X11/Xaw/Reports.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for X11/Xaw/Reports.h""... $ac_c" 1>&6 -echo "configure:5469: checking for X11/Xaw/Reports.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 5472 "configure" +echo "configure:5482: checking for X11/Xaw/Reports.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 5485 "configure" #include "confdefs.h" #include <X11/Xaw/Reports.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5477: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5490: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5530,7 +5543,7 @@ esac echo "checking for session-management option" 1>&6 -echo "configure:5534: checking for session-management option" >&5; +echo "configure:5547: checking for session-management option" >&5; if test "$with_session" != "no"; then { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_SESSION @@ -5545,15 +5558,15 @@ test -z "$with_xauth" && test "$window_system" = "none" && with_xauth=no test -z "$with_xauth" && { ac_safe=`echo "X11/Xauth.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for X11/Xauth.h""... $ac_c" 1>&6 -echo "configure:5549: checking for X11/Xauth.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 5552 "configure" +echo "configure:5562: checking for X11/Xauth.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 5565 "configure" #include "confdefs.h" #include <X11/Xauth.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5557: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5570: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5576,12 +5589,12 @@ } test -z "$with_xauth" && { echo $ac_n "checking for XauGetAuthByAddr in -lXau""... $ac_c" 1>&6 -echo "configure:5580: checking for XauGetAuthByAddr in -lXau" >&5 +echo "configure:5593: checking for XauGetAuthByAddr in -lXau" >&5 ac_lib_var=`echo Xau'_'XauGetAuthByAddr | sed 'y%./+-%__p_%'` xe_check_libs=" -lXau " cat > conftest.$ac_ext <<EOF -#line 5585 "configure" +#line 5598 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -5592,7 +5605,7 @@ XauGetAuthByAddr() ; return 0; } EOF -if { (eval echo configure:5596: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5609: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5633,15 +5646,15 @@ test -z "$with_offix" && { ac_safe=`echo "OffiX/DragAndDrop.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for OffiX/DragAndDrop.h""... $ac_c" 1>&6 -echo "configure:5637: checking for OffiX/DragAndDrop.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 5640 "configure" +echo "configure:5650: checking for OffiX/DragAndDrop.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 5653 "configure" #include "confdefs.h" #include <OffiX/DragAndDrop.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5645: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5658: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5664,12 +5677,12 @@ } test -z "$with_offix" && { echo $ac_n "checking for DndInitialize in -lDnd""... $ac_c" 1>&6 -echo "configure:5668: checking for DndInitialize in -lDnd" >&5 +echo "configure:5681: checking for DndInitialize in -lDnd" >&5 ac_lib_var=`echo Dnd'_'DndInitialize | sed 'y%./+-%__p_%'` xe_check_libs=" -lDnd " cat > conftest.$ac_ext <<EOF -#line 5673 "configure" +#line 5686 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -5680,7 +5693,7 @@ DndInitialize() ; return 0; } EOF -if { (eval echo configure:5684: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5697: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5719,15 +5732,15 @@ for dir in "" "Tt/" "desktop/" ; do ac_safe=`echo "${dir}tt_c.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ${dir}tt_c.h""... $ac_c" 1>&6 -echo "configure:5723: checking for ${dir}tt_c.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 5726 "configure" +echo "configure:5736: checking for ${dir}tt_c.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 5739 "configure" #include "confdefs.h" #include <${dir}tt_c.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5731: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5744: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5756,12 +5769,12 @@ xe_msg_checking="for tt_message_create in -ltt" test -n "$extra_libs" && xe_msg_checking="$xe_msg_checking using extra libs $extra_libs" echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 -echo "configure:5760: checking "$xe_msg_checking"" >&5 +echo "configure:5773: checking "$xe_msg_checking"" >&5 ac_lib_var=`echo tt'_'tt_message_create | sed 'y%./+-%__p_%'` xe_check_libs=" -ltt $extra_libs" cat > conftest.$ac_ext <<EOF -#line 5765 "configure" +#line 5778 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -5772,7 +5785,7 @@ tt_message_create() ; return 0; } EOF -if { (eval echo configure:5776: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5789: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5821,15 +5834,15 @@ test -z "$with_cde" && { ac_safe=`echo "Dt/Dt.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for Dt/Dt.h""... $ac_c" 1>&6 -echo "configure:5825: checking for Dt/Dt.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 5828 "configure" +echo "configure:5838: checking for Dt/Dt.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 5841 "configure" #include "confdefs.h" #include <Dt/Dt.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5833: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5846: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5852,12 +5865,12 @@ } test -z "$with_cde" && { echo $ac_n "checking for DtDndDragStart in -lDtSvc""... $ac_c" 1>&6 -echo "configure:5856: checking for DtDndDragStart in -lDtSvc" >&5 +echo "configure:5869: checking for DtDndDragStart in -lDtSvc" >&5 ac_lib_var=`echo DtSvc'_'DtDndDragStart | sed 'y%./+-%__p_%'` xe_check_libs=" -lDtSvc " cat > conftest.$ac_ext <<EOF -#line 5861 "configure" +#line 5874 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -5868,7 +5881,7 @@ DtDndDragStart() ; return 0; } EOF -if { (eval echo configure:5872: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5885: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5915,19 +5928,19 @@ echo $ac_n "checking for main in -lenergize""... $ac_c" 1>&6 -echo "configure:5919: checking for main in -lenergize" >&5 +echo "configure:5932: checking for main in -lenergize" >&5 ac_lib_var=`echo energize'_'main | sed 'y%./+-%__p_%'` xe_check_libs=" -lenergize " cat > conftest.$ac_ext <<EOF -#line 5924 "configure" +#line 5937 "configure" #include "confdefs.h" int main() { main() ; return 0; } EOF -if { (eval echo configure:5931: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5944: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5959,19 +5972,19 @@ if test -z "$energize_version"; then echo $ac_n "checking for main in -lconn""... $ac_c" 1>&6 -echo "configure:5963: checking for main in -lconn" >&5 +echo "configure:5976: checking for main in -lconn" >&5 ac_lib_var=`echo conn'_'main | sed 'y%./+-%__p_%'` xe_check_libs=" -lconn " cat > conftest.$ac_ext <<EOF -#line 5968 "configure" +#line 5981 "configure" #include "confdefs.h" int main() { main() ; return 0; } EOF -if { (eval echo configure:5975: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5988: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6004,15 +6017,15 @@ fi ac_safe=`echo "editorconn.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for editorconn.h""... $ac_c" 1>&6 -echo "configure:6008: checking for editorconn.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 6011 "configure" +echo "configure:6021: checking for editorconn.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 6024 "configure" #include "confdefs.h" #include <editorconn.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6016: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6029: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6054,7 +6067,7 @@ echo "checking for graphics libraries" 1>&6 -echo "configure:6058: checking for graphics libraries" >&5 +echo "configure:6071: checking for graphics libraries" >&5 test -z "$with_gif" && with_gif=yes; if test "$with_gif" = "yes"; then { test "$extra_verbose" = "yes" && cat << \EOF @@ -6071,10 +6084,10 @@ fi echo $ac_n "checking for Xpm - no older than 3.4f""... $ac_c" 1>&6 -echo "configure:6075: checking for Xpm - no older than 3.4f" >&5 +echo "configure:6088: checking for Xpm - no older than 3.4f" >&5 xe_check_libs=-lXpm test -z "$with_xpm" && { cat > conftest.$ac_ext <<EOF -#line 6078 "configure" +#line 6091 "configure" #include "confdefs.h" #include <X11/xpm.h> int main(int c, char **v) { @@ -6084,7 +6097,7 @@ 0 ; } EOF -if { (eval echo configure:6088: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:6101: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ./conftest foobar; xpm_status=$?; if test "$xpm_status" = "0"; then with_xpm=yes; else with_xpm=no; fi; @@ -6122,15 +6135,15 @@ test -z "$with_xface" && { ac_safe=`echo "compface.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for compface.h""... $ac_c" 1>&6 -echo "configure:6126: checking for compface.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 6129 "configure" +echo "configure:6139: checking for compface.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 6142 "configure" #include "confdefs.h" #include <compface.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6134: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6147: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6153,12 +6166,12 @@ } test -z "$with_xface" && { echo $ac_n "checking for UnGenFace in -lcompface""... $ac_c" 1>&6 -echo "configure:6157: checking for UnGenFace in -lcompface" >&5 +echo "configure:6170: checking for UnGenFace in -lcompface" >&5 ac_lib_var=`echo compface'_'UnGenFace | sed 'y%./+-%__p_%'` xe_check_libs=" -lcompface " cat > conftest.$ac_ext <<EOF -#line 6162 "configure" +#line 6175 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -6169,7 +6182,7 @@ UnGenFace() ; return 0; } EOF -if { (eval echo configure:6173: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6186: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6205,15 +6218,15 @@ test -z "$with_jpeg" && { ac_safe=`echo "jpeglib.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for jpeglib.h""... $ac_c" 1>&6 -echo "configure:6209: checking for jpeglib.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 6212 "configure" +echo "configure:6222: checking for jpeglib.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 6225 "configure" #include "confdefs.h" #include <jpeglib.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6217: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6230: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6236,12 +6249,12 @@ } test -z "$with_jpeg" && { echo $ac_n "checking for jpeg_destroy_decompress in -ljpeg""... $ac_c" 1>&6 -echo "configure:6240: checking for jpeg_destroy_decompress in -ljpeg" >&5 +echo "configure:6253: checking for jpeg_destroy_decompress in -ljpeg" >&5 ac_lib_var=`echo jpeg'_'jpeg_destroy_decompress | sed 'y%./+-%__p_%'` xe_check_libs=" -ljpeg " cat > conftest.$ac_ext <<EOF -#line 6245 "configure" +#line 6258 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -6252,7 +6265,7 @@ jpeg_destroy_decompress() ; return 0; } EOF -if { (eval echo configure:6256: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6269: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6288,15 +6301,15 @@ test -z "$with_png" && { ac_safe=`echo "png.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for png.h""... $ac_c" 1>&6 -echo "configure:6292: checking for png.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 6295 "configure" +echo "configure:6305: checking for png.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 6308 "configure" #include "confdefs.h" #include <png.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6300: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6313: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6318,10 +6331,10 @@ fi } test -z "$with_png" && { echo $ac_n "checking for pow""... $ac_c" 1>&6 -echo "configure:6322: checking for pow" >&5 - -cat > conftest.$ac_ext <<EOF -#line 6325 "configure" +echo "configure:6335: checking for pow" >&5 + +cat > conftest.$ac_ext <<EOF +#line 6338 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char pow(); below. */ @@ -6344,7 +6357,7 @@ ; return 0; } EOF -if { (eval echo configure:6348: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6361: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_pow=yes" else @@ -6369,12 +6382,12 @@ xe_msg_checking="for png_read_image in -lpng" test -n "$extra_libs" && xe_msg_checking="$xe_msg_checking using extra libs $extra_libs" echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 -echo "configure:6373: checking "$xe_msg_checking"" >&5 +echo "configure:6386: checking "$xe_msg_checking"" >&5 ac_lib_var=`echo png'_'png_read_image | sed 'y%./+-%__p_%'` xe_check_libs=" -lpng $extra_libs" cat > conftest.$ac_ext <<EOF -#line 6378 "configure" +#line 6391 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -6385,7 +6398,7 @@ png_read_image() ; return 0; } EOF -if { (eval echo configure:6389: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6402: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6435,15 +6448,15 @@ ac_safe=`echo "Xm/Xm.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for Xm/Xm.h""... $ac_c" 1>&6 -echo "configure:6439: checking for Xm/Xm.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 6442 "configure" +echo "configure:6452: checking for Xm/Xm.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 6455 "configure" #include "confdefs.h" #include <Xm/Xm.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6447: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6460: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6460,12 +6473,12 @@ echo "$ac_t""yes" 1>&6 echo $ac_n "checking for XmStringFree in -lXm""... $ac_c" 1>&6 -echo "configure:6464: checking for XmStringFree in -lXm" >&5 +echo "configure:6477: checking for XmStringFree in -lXm" >&5 ac_lib_var=`echo Xm'_'XmStringFree | sed 'y%./+-%__p_%'` xe_check_libs=" -lXm " cat > conftest.$ac_ext <<EOF -#line 6469 "configure" +#line 6482 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -6476,7 +6489,7 @@ XmStringFree() ; return 0; } EOF -if { (eval echo configure:6480: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6493: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6724,7 +6737,7 @@ if test "$with_mule" = "yes" ; then echo "checking for Mule-related features" 1>&6 -echo "configure:6728: checking for Mule-related features" >&5 +echo "configure:6741: checking for Mule-related features" >&5 { test "$extra_verbose" = "yes" && cat << \EOF Defining MULE EOF @@ -6741,15 +6754,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:6745: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <<EOF -#line 6748 "configure" +echo "configure:6758: checking for $ac_hdr" >&5 + +cat > conftest.$ac_ext <<EOF +#line 6761 "configure" #include "confdefs.h" #include <$ac_hdr> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6753: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6766: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6780,12 +6793,12 @@ echo $ac_n "checking for strerror in -lintl""... $ac_c" 1>&6 -echo "configure:6784: checking for strerror in -lintl" >&5 +echo "configure:6797: checking for strerror in -lintl" >&5 ac_lib_var=`echo intl'_'strerror | sed 'y%./+-%__p_%'` xe_check_libs=" -lintl " cat > conftest.$ac_ext <<EOF -#line 6789 "configure" +#line 6802 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -6796,7 +6809,7 @@ strerror() ; return 0; } EOF -if { (eval echo configure:6800: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6813: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6829,19 +6842,19 @@ echo "checking for Mule input methods" 1>&6 -echo "configure:6833: checking for Mule input methods" >&5 +echo "configure:6846: checking for Mule input methods" >&5 test -z "$with_xim" -a "$opsys" != "sol2" && with_xim=no case "$with_xim" in "" | "yes" ) echo "checking for XIM" 1>&6 -echo "configure:6837: checking for XIM" >&5 +echo "configure:6850: checking for XIM" >&5 echo $ac_n "checking for XmImMbLookupString in -lXm""... $ac_c" 1>&6 -echo "configure:6840: checking for XmImMbLookupString in -lXm" >&5 +echo "configure:6853: checking for XmImMbLookupString in -lXm" >&5 ac_lib_var=`echo Xm'_'XmImMbLookupString | sed 'y%./+-%__p_%'` xe_check_libs=" -lXm " cat > conftest.$ac_ext <<EOF -#line 6845 "configure" +#line 6858 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -6852,7 +6865,7 @@ XmImMbLookupString() ; return 0; } EOF -if { (eval echo configure:6856: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6869: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6915,15 +6928,15 @@ fi else case "$with_xfs" in "yes" ) echo "checking for XFontSet" 1>&6 -echo "configure:6919: checking for XFontSet" >&5 +echo "configure:6932: checking for XFontSet" >&5 echo $ac_n "checking for XmbDrawString in -lX11""... $ac_c" 1>&6 -echo "configure:6922: checking for XmbDrawString in -lX11" >&5 +echo "configure:6935: checking for XmbDrawString in -lX11" >&5 ac_lib_var=`echo X11'_'XmbDrawString | sed 'y%./+-%__p_%'` xe_check_libs=" -lX11 " cat > conftest.$ac_ext <<EOF -#line 6927 "configure" +#line 6940 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -6934,7 +6947,7 @@ XmbDrawString() ; return 0; } EOF -if { (eval echo configure:6938: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6951: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6973,15 +6986,15 @@ test "$with_wnn6" = "yes" && with_wnn=yes # wnn6 implies wnn support test -z "$with_wnn" && { ac_safe=`echo "wnn/jllib.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for wnn/jllib.h""... $ac_c" 1>&6 -echo "configure:6977: checking for wnn/jllib.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 6980 "configure" +echo "configure:6990: checking for wnn/jllib.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 6993 "configure" #include "confdefs.h" #include <wnn/jllib.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6985: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6998: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -7006,10 +7019,10 @@ for ac_func in crypt do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:7010: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <<EOF -#line 7013 "configure" +echo "configure:7023: checking for $ac_func" >&5 + +cat > conftest.$ac_ext <<EOF +#line 7026 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func(); below. */ @@ -7032,7 +7045,7 @@ ; return 0; } EOF -if { (eval echo configure:7036: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7049: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -7061,12 +7074,12 @@ test "$ac_cv_func_crypt" != "yes" && { echo $ac_n "checking for crypt in -lcrypt""... $ac_c" 1>&6 -echo "configure:7065: checking for crypt in -lcrypt" >&5 +echo "configure:7078: checking for crypt in -lcrypt" >&5 ac_lib_var=`echo crypt'_'crypt | sed 'y%./+-%__p_%'` xe_check_libs=" -lcrypt " cat > conftest.$ac_ext <<EOF -#line 7070 "configure" +#line 7083 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -7077,7 +7090,7 @@ crypt() ; return 0; } EOF -if { (eval echo configure:7081: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7094: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -7111,12 +7124,12 @@ fi test -z "$with_wnn" && { echo $ac_n "checking for jl_dic_list_e in -lwnn""... $ac_c" 1>&6 -echo "configure:7115: checking for jl_dic_list_e in -lwnn" >&5 +echo "configure:7128: checking for jl_dic_list_e in -lwnn" >&5 ac_lib_var=`echo wnn'_'jl_dic_list_e | sed 'y%./+-%__p_%'` xe_check_libs=" -lwnn " cat > conftest.$ac_ext <<EOF -#line 7120 "configure" +#line 7133 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -7127,7 +7140,7 @@ jl_dic_list_e() ; return 0; } EOF -if { (eval echo configure:7131: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7144: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -7164,12 +7177,12 @@ fi echo $ac_n "checking for jl_fi_dic_list in -lwnn""... $ac_c" 1>&6 -echo "configure:7168: checking for jl_fi_dic_list in -lwnn" >&5 +echo "configure:7181: checking for jl_fi_dic_list in -lwnn" >&5 ac_lib_var=`echo wnn'_'jl_fi_dic_list | sed 'y%./+-%__p_%'` xe_check_libs=" -lwnn " cat > conftest.$ac_ext <<EOF -#line 7173 "configure" +#line 7186 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -7180,7 +7193,7 @@ jl_fi_dic_list() ; return 0; } EOF -if { (eval echo configure:7184: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7197: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -7212,15 +7225,15 @@ test -z "$with_canna" && { ac_safe=`echo "canna/RK.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for canna/RK.h""... $ac_c" 1>&6 -echo "configure:7216: checking for canna/RK.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 7219 "configure" +echo "configure:7229: checking for canna/RK.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 7232 "configure" #include "confdefs.h" #include <canna/RK.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:7224: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:7237: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -7243,12 +7256,12 @@ } test -z "$with_canna" && { echo $ac_n "checking for RkBgnBun in -lRKC""... $ac_c" 1>&6 -echo "configure:7247: checking for RkBgnBun in -lRKC" >&5 +echo "configure:7260: checking for RkBgnBun in -lRKC" >&5 ac_lib_var=`echo RKC'_'RkBgnBun | sed 'y%./+-%__p_%'` xe_check_libs=" -lRKC " cat > conftest.$ac_ext <<EOF -#line 7252 "configure" +#line 7265 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -7259,7 +7272,7 @@ RkBgnBun() ; return 0; } EOF -if { (eval echo configure:7263: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7276: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -7282,12 +7295,12 @@ } test -z "$with_canna" && { echo $ac_n "checking for jrKanjiControl in -lcanna""... $ac_c" 1>&6 -echo "configure:7286: checking for jrKanjiControl in -lcanna" >&5 +echo "configure:7299: checking for jrKanjiControl in -lcanna" >&5 ac_lib_var=`echo canna'_'jrKanjiControl | sed 'y%./+-%__p_%'` xe_check_libs=" -lcanna " cat > conftest.$ac_ext <<EOF -#line 7291 "configure" +#line 7304 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -7298,7 +7311,7 @@ jrKanjiControl() ; return 0; } EOF -if { (eval echo configure:7302: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7315: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -7398,10 +7411,10 @@ for ac_func in acosh asinh atanh cbrt closedir dup2 eaccess fmod fpathconf frexp ftime gethostname getpagesize gettimeofday getcwd getwd logb lrand48 matherr mkdir mktime perror poll random rename res_init rint rmdir select setitimer setpgid setlocale setsid sigblock sighold sigprocmask strcasecmp strerror tzset ulimit usleep utimes waitpid do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:7402: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <<EOF -#line 7405 "configure" +echo "configure:7415: checking for $ac_func" >&5 + +cat > conftest.$ac_ext <<EOF +#line 7418 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func(); below. */ @@ -7424,7 +7437,7 @@ ; return 0; } EOF -if { (eval echo configure:7428: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7441: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -7461,10 +7474,10 @@ for ac_func in realpath do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:7465: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <<EOF -#line 7468 "configure" +echo "configure:7478: checking for $ac_func" >&5 + +cat > conftest.$ac_ext <<EOF +#line 7481 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func(); below. */ @@ -7487,7 +7500,7 @@ ; return 0; } EOF -if { (eval echo configure:7491: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7504: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -7520,16 +7533,16 @@ esac echo $ac_n "checking whether netdb declares h_errno""... $ac_c" 1>&6 -echo "configure:7524: checking whether netdb declares h_errno" >&5 -cat > conftest.$ac_ext <<EOF -#line 7526 "configure" +echo "configure:7537: checking whether netdb declares h_errno" >&5 +cat > conftest.$ac_ext <<EOF +#line 7539 "configure" #include "confdefs.h" #include <netdb.h> int main() { return h_errno; ; return 0; } EOF -if { (eval echo configure:7533: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7546: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* echo "$ac_t""yes" 1>&6 { test "$extra_verbose" = "yes" && cat << \EOF @@ -7549,16 +7562,16 @@ rm -f conftest* echo $ac_n "checking for sigsetjmp""... $ac_c" 1>&6 -echo "configure:7553: checking for sigsetjmp" >&5 -cat > conftest.$ac_ext <<EOF -#line 7555 "configure" +echo "configure:7566: checking for sigsetjmp" >&5 +cat > conftest.$ac_ext <<EOF +#line 7568 "configure" #include "confdefs.h" #include <setjmp.h> int main() { sigjmp_buf bar; sigsetjmp (bar, 0); ; return 0; } EOF -if { (eval echo configure:7562: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:7575: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* echo "$ac_t""yes" 1>&6 { test "$extra_verbose" = "yes" && cat << \EOF @@ -7578,11 +7591,11 @@ rm -f conftest* echo $ac_n "checking whether localtime caches TZ""... $ac_c" 1>&6 -echo "configure:7582: checking whether localtime caches TZ" >&5 +echo "configure:7595: checking whether localtime caches TZ" >&5 if test "$ac_cv_func_tzset" = "yes"; then cat > conftest.$ac_ext <<EOF -#line 7586 "configure" +#line 7599 "configure" #include "confdefs.h" #include <time.h> #if STDC_HEADERS @@ -7617,7 +7630,7 @@ exit (0); } EOF -if { (eval echo configure:7621: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:7634: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then emacs_cv_localtime_cache=no else @@ -7646,9 +7659,9 @@ if test "$HAVE_TIMEVAL" = "yes"; then echo $ac_n "checking whether gettimeofday cannot accept two arguments""... $ac_c" 1>&6 -echo "configure:7650: checking whether gettimeofday cannot accept two arguments" >&5 -cat > conftest.$ac_ext <<EOF -#line 7652 "configure" +echo "configure:7663: checking whether gettimeofday cannot accept two arguments" >&5 +cat > conftest.$ac_ext <<EOF +#line 7665 "configure" #include "confdefs.h" #ifdef TIME_WITH_SYS_TIME @@ -7670,7 +7683,7 @@ ; return 0; } EOF -if { (eval echo configure:7674: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7687: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* echo "$ac_t""no" 1>&6 else @@ -7692,19 +7705,19 @@ echo $ac_n "checking for inline""... $ac_c" 1>&6 -echo "configure:7696: checking for inline" >&5 +echo "configure:7709: checking for inline" >&5 ac_cv_c_inline=no for ac_kw in inline __inline__ __inline; do cat > conftest.$ac_ext <<EOF -#line 7701 "configure" +#line 7714 "configure" #include "confdefs.h" int main() { } $ac_kw foo() { ; return 0; } EOF -if { (eval echo configure:7708: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:7721: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_inline=$ac_kw; break else @@ -7754,17 +7767,17 @@ # The Ultrix 4.2 mips builtin alloca declared by alloca.h only works # for constant arguments. Useless! echo $ac_n "checking for working alloca.h""... $ac_c" 1>&6 -echo "configure:7758: checking for working alloca.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 7761 "configure" +echo "configure:7771: checking for working alloca.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 7774 "configure" #include "confdefs.h" #include <alloca.h> int main() { char *p = alloca(2 * sizeof(int)); ; return 0; } EOF -if { (eval echo configure:7768: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7781: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* ac_cv_header_alloca_h=yes else @@ -7788,10 +7801,10 @@ fi echo $ac_n "checking for alloca""... $ac_c" 1>&6 -echo "configure:7792: checking for alloca" >&5 - -cat > conftest.$ac_ext <<EOF -#line 7795 "configure" +echo "configure:7805: checking for alloca" >&5 + +cat > conftest.$ac_ext <<EOF +#line 7808 "configure" #include "confdefs.h" #ifdef __GNUC__ @@ -7814,7 +7827,7 @@ char *p = (char *) alloca(1); ; return 0; } EOF -if { (eval echo configure:7818: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7831: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* ac_cv_func_alloca_works=yes else @@ -7853,10 +7866,10 @@ echo $ac_n "checking whether alloca needs Cray hooks""... $ac_c" 1>&6 -echo "configure:7857: checking whether alloca needs Cray hooks" >&5 - -cat > conftest.$ac_ext <<EOF -#line 7860 "configure" +echo "configure:7870: checking whether alloca needs Cray hooks" >&5 + +cat > conftest.$ac_ext <<EOF +#line 7873 "configure" #include "confdefs.h" #if defined(CRAY) && ! defined(CRAY2) webecray @@ -7880,10 +7893,10 @@ if test $ac_cv_os_cray = yes; then for ac_func in _getb67 GETB67 getb67; do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:7884: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <<EOF -#line 7887 "configure" +echo "configure:7897: checking for $ac_func" >&5 + +cat > conftest.$ac_ext <<EOF +#line 7900 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func(); below. */ @@ -7906,7 +7919,7 @@ ; return 0; } EOF -if { (eval echo configure:7910: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7923: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -7936,10 +7949,10 @@ fi echo $ac_n "checking stack direction for C alloca""... $ac_c" 1>&6 -echo "configure:7940: checking stack direction for C alloca" >&5 - -cat > conftest.$ac_ext <<EOF -#line 7943 "configure" +echo "configure:7953: checking stack direction for C alloca" >&5 + +cat > conftest.$ac_ext <<EOF +#line 7956 "configure" #include "confdefs.h" find_stack_direction () { @@ -7958,7 +7971,7 @@ exit (find_stack_direction() < 0); } EOF -if { (eval echo configure:7962: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:7975: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_c_stack_direction=1 else @@ -7986,15 +7999,15 @@ ac_safe=`echo "vfork.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for vfork.h""... $ac_c" 1>&6 -echo "configure:7990: checking for vfork.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 7993 "configure" +echo "configure:8003: checking for vfork.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8006 "configure" #include "confdefs.h" #include <vfork.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:7998: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8011: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8022,10 +8035,10 @@ fi echo $ac_n "checking for working vfork""... $ac_c" 1>&6 -echo "configure:8026: checking for working vfork" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8029 "configure" +echo "configure:8039: checking for working vfork" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8042 "configure" #include "confdefs.h" /* Thanks to Paul Eggert for this test. */ #include <stdio.h> @@ -8120,7 +8133,7 @@ } } EOF -if { (eval echo configure:8124: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:8137: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_func_vfork_works=yes else @@ -8145,10 +8158,10 @@ echo $ac_n "checking for working strcoll""... $ac_c" 1>&6 -echo "configure:8149: checking for working strcoll" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8152 "configure" +echo "configure:8162: checking for working strcoll" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8165 "configure" #include "confdefs.h" #include <string.h> main () @@ -8158,7 +8171,7 @@ strcoll ("123", "456") >= 0); } EOF -if { (eval echo configure:8162: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:8175: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_func_strcoll_works=yes else @@ -8185,10 +8198,10 @@ for ac_func in getpgrp do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:8189: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8192 "configure" +echo "configure:8202: checking for $ac_func" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8205 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func(); below. */ @@ -8211,7 +8224,7 @@ ; return 0; } EOF -if { (eval echo configure:8215: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:8228: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -8239,10 +8252,10 @@ done echo $ac_n "checking whether getpgrp takes no argument""... $ac_c" 1>&6 -echo "configure:8243: checking whether getpgrp takes no argument" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8246 "configure" +echo "configure:8256: checking whether getpgrp takes no argument" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8259 "configure" #include "confdefs.h" /* @@ -8297,7 +8310,7 @@ } EOF -if { (eval echo configure:8301: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:8314: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_func_getpgrp_void=yes else @@ -8323,10 +8336,10 @@ echo $ac_n "checking for working mmap""... $ac_c" 1>&6 -echo "configure:8327: checking for working mmap" >&5 +echo "configure:8340: checking for working mmap" >&5 case "$opsys" in ultrix* ) have_mmap=no ;; *) cat > conftest.$ac_ext <<EOF -#line 8330 "configure" +#line 8343 "configure" #include "confdefs.h" #include <stdio.h> #include <unistd.h> @@ -8359,7 +8372,7 @@ return 1; } EOF -if { (eval echo configure:8363: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:8376: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then have_mmap=yes else @@ -8393,15 +8406,15 @@ ac_safe=`echo "termios.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for termios.h""... $ac_c" 1>&6 -echo "configure:8397: checking for termios.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8400 "configure" +echo "configure:8410: checking for termios.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8413 "configure" #include "confdefs.h" #include <termios.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8405: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8418: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8444,15 +8457,15 @@ echo "$ac_t""no" 1>&6 ac_safe=`echo "termio.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for termio.h""... $ac_c" 1>&6 -echo "configure:8448: checking for termio.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8451 "configure" +echo "configure:8461: checking for termio.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8464 "configure" #include "confdefs.h" #include <termio.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8456: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8469: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8484,10 +8497,10 @@ echo $ac_n "checking for socket""... $ac_c" 1>&6 -echo "configure:8488: checking for socket" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8491 "configure" +echo "configure:8501: checking for socket" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8504 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char socket(); below. */ @@ -8510,7 +8523,7 @@ ; return 0; } EOF -if { (eval echo configure:8514: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:8527: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_socket=yes" else @@ -8525,15 +8538,15 @@ echo "$ac_t""yes" 1>&6 ac_safe=`echo "netinet/in.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for netinet/in.h""... $ac_c" 1>&6 -echo "configure:8529: checking for netinet/in.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8532 "configure" +echo "configure:8542: checking for netinet/in.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8545 "configure" #include "confdefs.h" #include <netinet/in.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8537: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8550: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8550,15 +8563,15 @@ echo "$ac_t""yes" 1>&6 ac_safe=`echo "arpa/inet.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for arpa/inet.h""... $ac_c" 1>&6 -echo "configure:8554: checking for arpa/inet.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8557 "configure" +echo "configure:8567: checking for arpa/inet.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8570 "configure" #include "confdefs.h" #include <arpa/inet.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8562: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8575: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8583,9 +8596,9 @@ } echo $ac_n "checking "for sun_len member in struct sockaddr_un"""... $ac_c" 1>&6 -echo "configure:8587: checking "for sun_len member in struct sockaddr_un"" >&5 +echo "configure:8600: checking "for sun_len member in struct sockaddr_un"" >&5 cat > conftest.$ac_ext <<EOF -#line 8589 "configure" +#line 8602 "configure" #include "confdefs.h" #include <sys/types.h> @@ -8596,7 +8609,7 @@ static struct sockaddr_un x; x.sun_len = 1; ; return 0; } EOF -if { (eval echo configure:8600: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:8613: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* echo "$ac_t""yes" 1>&6; { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_SOCKADDR_SUN_LEN @@ -8627,10 +8640,10 @@ echo $ac_n "checking for msgget""... $ac_c" 1>&6 -echo "configure:8631: checking for msgget" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8634 "configure" +echo "configure:8644: checking for msgget" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8647 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char msgget(); below. */ @@ -8653,7 +8666,7 @@ ; return 0; } EOF -if { (eval echo configure:8657: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:8670: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_msgget=yes" else @@ -8668,15 +8681,15 @@ echo "$ac_t""yes" 1>&6 ac_safe=`echo "sys/ipc.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/ipc.h""... $ac_c" 1>&6 -echo "configure:8672: checking for sys/ipc.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8675 "configure" +echo "configure:8685: checking for sys/ipc.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8688 "configure" #include "confdefs.h" #include <sys/ipc.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8680: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8693: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8693,15 +8706,15 @@ echo "$ac_t""yes" 1>&6 ac_safe=`echo "sys/msg.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/msg.h""... $ac_c" 1>&6 -echo "configure:8697: checking for sys/msg.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8700 "configure" +echo "configure:8710: checking for sys/msg.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8713 "configure" #include "confdefs.h" #include <sys/msg.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8705: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8718: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8739,15 +8752,15 @@ ac_safe=`echo "dirent.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for dirent.h""... $ac_c" 1>&6 -echo "configure:8743: checking for dirent.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8746 "configure" +echo "configure:8756: checking for dirent.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8759 "configure" #include "confdefs.h" #include <dirent.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8751: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8764: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8774,15 +8787,15 @@ echo "$ac_t""no" 1>&6 ac_safe=`echo "sys/dir.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/dir.h""... $ac_c" 1>&6 -echo "configure:8778: checking for sys/dir.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8781 "configure" +echo "configure:8791: checking for sys/dir.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8794 "configure" #include "confdefs.h" #include <sys/dir.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8786: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8799: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8815,15 +8828,15 @@ ac_safe=`echo "nlist.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for nlist.h""... $ac_c" 1>&6 -echo "configure:8819: checking for nlist.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8822 "configure" +echo "configure:8832: checking for nlist.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8835 "configure" #include "confdefs.h" #include <nlist.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8827: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8840: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8864,7 +8877,7 @@ echo "checking "for sound support"" 1>&6 -echo "configure:8868: checking "for sound support"" >&5 +echo "configure:8881: checking "for sound support"" >&5 case "$with_sound" in native | both ) with_native_sound=yes;; nas | no ) with_native_sound=no;; @@ -8875,15 +8888,15 @@ if test -n "$native_sound_lib"; then ac_safe=`echo "multimedia/audio_device.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for multimedia/audio_device.h""... $ac_c" 1>&6 -echo "configure:8879: checking for multimedia/audio_device.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8882 "configure" +echo "configure:8892: checking for multimedia/audio_device.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8895 "configure" #include "confdefs.h" #include <multimedia/audio_device.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8887: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8900: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8931,12 +8944,12 @@ if test -z "$native_sound_lib"; then echo $ac_n "checking for ALopenport in -laudio""... $ac_c" 1>&6 -echo "configure:8935: checking for ALopenport in -laudio" >&5 +echo "configure:8948: checking for ALopenport in -laudio" >&5 ac_lib_var=`echo audio'_'ALopenport | sed 'y%./+-%__p_%'` xe_check_libs=" -laudio " cat > conftest.$ac_ext <<EOF -#line 8940 "configure" +#line 8953 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -8947,7 +8960,7 @@ ALopenport() ; return 0; } EOF -if { (eval echo configure:8951: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:8964: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -8978,12 +8991,12 @@ if test -z "$native_sound_lib"; then echo $ac_n "checking for AOpenAudio in -lAlib""... $ac_c" 1>&6 -echo "configure:8982: checking for AOpenAudio in -lAlib" >&5 +echo "configure:8995: checking for AOpenAudio in -lAlib" >&5 ac_lib_var=`echo Alib'_'AOpenAudio | sed 'y%./+-%__p_%'` xe_check_libs=" -lAlib " cat > conftest.$ac_ext <<EOF -#line 8987 "configure" +#line 9000 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -8994,7 +9007,7 @@ AOpenAudio() ; return 0; } EOF -if { (eval echo configure:8998: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9011: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9032,15 +9045,15 @@ for dir in "machine" "sys" "linux"; do ac_safe=`echo "${dir}/soundcard.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ${dir}/soundcard.h""... $ac_c" 1>&6 -echo "configure:9036: checking for ${dir}/soundcard.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 9039 "configure" +echo "configure:9049: checking for ${dir}/soundcard.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 9052 "configure" #include "confdefs.h" #include <${dir}/soundcard.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:9044: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:9057: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -9110,7 +9123,7 @@ fi LIBS="-laudio $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-laudio\" to \$LIBS"; fi cat > conftest.$ac_ext <<EOF -#line 9114 "configure" +#line 9127 "configure" #include "confdefs.h" #include <audio/Xtutil.h> EOF @@ -9137,7 +9150,7 @@ if test "$with_tty" = "yes" ; then echo "checking for TTY-related features" 1>&6 -echo "configure:9141: checking for TTY-related features" >&5 +echo "configure:9154: checking for TTY-related features" >&5 { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_TTY EOF @@ -9153,12 +9166,12 @@ if test -z "$with_ncurses"; then echo $ac_n "checking for tgetent in -lncurses""... $ac_c" 1>&6 -echo "configure:9157: checking for tgetent in -lncurses" >&5 +echo "configure:9170: checking for tgetent in -lncurses" >&5 ac_lib_var=`echo ncurses'_'tgetent | sed 'y%./+-%__p_%'` xe_check_libs=" -lncurses " cat > conftest.$ac_ext <<EOF -#line 9162 "configure" +#line 9175 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -9169,7 +9182,7 @@ tgetent() ; return 0; } EOF -if { (eval echo configure:9173: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9186: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9202,15 +9215,15 @@ ac_safe=`echo "ncurses/curses.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ncurses/curses.h""... $ac_c" 1>&6 -echo "configure:9206: checking for ncurses/curses.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 9209 "configure" +echo "configure:9219: checking for ncurses/curses.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 9222 "configure" #include "confdefs.h" #include <ncurses/curses.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:9214: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:9227: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -9232,15 +9245,15 @@ ac_safe=`echo "ncurses/term.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ncurses/term.h""... $ac_c" 1>&6 -echo "configure:9236: checking for ncurses/term.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 9239 "configure" +echo "configure:9249: checking for ncurses/term.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 9252 "configure" #include "confdefs.h" #include <ncurses/term.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:9244: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:9257: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -9270,15 +9283,15 @@ c_switch_site="$c_switch_site -I/usr/include/ncurses" ac_safe=`echo "ncurses/curses.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ncurses/curses.h""... $ac_c" 1>&6 -echo "configure:9274: checking for ncurses/curses.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 9277 "configure" +echo "configure:9287: checking for ncurses/curses.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 9290 "configure" #include "confdefs.h" #include <ncurses/curses.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:9282: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:9295: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -9313,12 +9326,12 @@ for lib in curses termlib termcap; do echo $ac_n "checking for tgetent in -l$lib""... $ac_c" 1>&6 -echo "configure:9317: checking for tgetent in -l$lib" >&5 +echo "configure:9330: checking for tgetent in -l$lib" >&5 ac_lib_var=`echo $lib'_'tgetent | sed 'y%./+-%__p_%'` xe_check_libs=" -l$lib " cat > conftest.$ac_ext <<EOF -#line 9322 "configure" +#line 9335 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -9329,7 +9342,7 @@ tgetent() ; return 0; } EOF -if { (eval echo configure:9333: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9346: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9360,12 +9373,12 @@ else echo $ac_n "checking for tgetent in -lcurses""... $ac_c" 1>&6 -echo "configure:9364: checking for tgetent in -lcurses" >&5 +echo "configure:9377: checking for tgetent in -lcurses" >&5 ac_lib_var=`echo curses'_'tgetent | sed 'y%./+-%__p_%'` xe_check_libs=" -lcurses " cat > conftest.$ac_ext <<EOF -#line 9369 "configure" +#line 9382 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -9376,7 +9389,7 @@ tgetent() ; return 0; } EOF -if { (eval echo configure:9380: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9393: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9394,12 +9407,12 @@ else echo "$ac_t""no" 1>&6 echo $ac_n "checking for tgetent in -ltermcap""... $ac_c" 1>&6 -echo "configure:9398: checking for tgetent in -ltermcap" >&5 +echo "configure:9411: checking for tgetent in -ltermcap" >&5 ac_lib_var=`echo termcap'_'tgetent | sed 'y%./+-%__p_%'` xe_check_libs=" -ltermcap " cat > conftest.$ac_ext <<EOF -#line 9403 "configure" +#line 9416 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -9410,7 +9423,7 @@ tgetent() ; return 0; } EOF -if { (eval echo configure:9414: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9427: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9458,15 +9471,15 @@ test -z "$with_gpm" && { ac_safe=`echo "gpm.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for gpm.h""... $ac_c" 1>&6 -echo "configure:9462: checking for gpm.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 9465 "configure" +echo "configure:9475: checking for gpm.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 9478 "configure" #include "confdefs.h" #include <gpm.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:9470: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:9483: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -9489,12 +9502,12 @@ } test -z "$with_gpm" && { echo $ac_n "checking for Gpm_Open in -lgpm""... $ac_c" 1>&6 -echo "configure:9493: checking for Gpm_Open in -lgpm" >&5 +echo "configure:9506: checking for Gpm_Open in -lgpm" >&5 ac_lib_var=`echo gpm'_'Gpm_Open | sed 'y%./+-%__p_%'` xe_check_libs=" -lgpm " cat > conftest.$ac_ext <<EOF -#line 9498 "configure" +#line 9511 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -9505,7 +9518,7 @@ Gpm_Open() ; return 0; } EOF -if { (eval echo configure:9509: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9522: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9554,17 +9567,17 @@ echo "checking for database support" 1>&6 -echo "configure:9558: checking for database support" >&5 +echo "configure:9571: checking for database support" >&5 if test "$with_database_gnudbm" != "no"; then echo $ac_n "checking for dbm_open in -lgdbm""... $ac_c" 1>&6 -echo "configure:9563: checking for dbm_open in -lgdbm" >&5 +echo "configure:9576: checking for dbm_open in -lgdbm" >&5 ac_lib_var=`echo gdbm'_'dbm_open | sed 'y%./+-%__p_%'` xe_check_libs=" -lgdbm " cat > conftest.$ac_ext <<EOF -#line 9568 "configure" +#line 9581 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -9575,7 +9588,7 @@ dbm_open() ; return 0; } EOF -if { (eval echo configure:9579: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9592: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9597,10 +9610,10 @@ if test "$with_database_gnudbm" != "yes"; then echo $ac_n "checking for dbm_open""... $ac_c" 1>&6 -echo "configure:9601: checking for dbm_open" >&5 - -cat > conftest.$ac_ext <<EOF -#line 9604 "configure" +echo "configure:9614: checking for dbm_open" >&5 + +cat > conftest.$ac_ext <<EOF +#line 9617 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char dbm_open(); below. */ @@ -9623,7 +9636,7 @@ ; return 0; } EOF -if { (eval echo configure:9627: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9640: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_dbm_open=yes" else @@ -9659,10 +9672,10 @@ if test "$with_database_dbm" != "no"; then echo $ac_n "checking for dbm_open""... $ac_c" 1>&6 -echo "configure:9663: checking for dbm_open" >&5 - -cat > conftest.$ac_ext <<EOF -#line 9666 "configure" +echo "configure:9676: checking for dbm_open" >&5 + +cat > conftest.$ac_ext <<EOF +#line 9679 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char dbm_open(); below. */ @@ -9685,7 +9698,7 @@ ; return 0; } EOF -if { (eval echo configure:9689: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9702: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_dbm_open=yes" else @@ -9706,12 +9719,12 @@ if test "$need_libdbm" != "no"; then echo $ac_n "checking for dbm_open in -ldbm""... $ac_c" 1>&6 -echo "configure:9710: checking for dbm_open in -ldbm" >&5 +echo "configure:9723: checking for dbm_open in -ldbm" >&5 ac_lib_var=`echo dbm'_'dbm_open | sed 'y%./+-%__p_%'` xe_check_libs=" -ldbm " cat > conftest.$ac_ext <<EOF -#line 9715 "configure" +#line 9728 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -9722,7 +9735,7 @@ dbm_open() ; return 0; } EOF -if { (eval echo configure:9726: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9739: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9759,10 +9772,10 @@ if test "$with_database_berkdb" != "no"; then echo $ac_n "checking for dbopen""... $ac_c" 1>&6 -echo "configure:9763: checking for dbopen" >&5 - -cat > conftest.$ac_ext <<EOF -#line 9766 "configure" +echo "configure:9776: checking for dbopen" >&5 + +cat > conftest.$ac_ext <<EOF +#line 9779 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char dbopen(); below. */ @@ -9785,7 +9798,7 @@ ; return 0; } EOF -if { (eval echo configure:9789: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9802: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_dbopen=yes" else @@ -9806,12 +9819,12 @@ if test "$need_libdb" != "no"; then echo $ac_n "checking for dbopen in -ldb""... $ac_c" 1>&6 -echo "configure:9810: checking for dbopen in -ldb" >&5 +echo "configure:9823: checking for dbopen in -ldb" >&5 ac_lib_var=`echo db'_'dbopen | sed 'y%./+-%__p_%'` xe_check_libs=" -ldb " cat > conftest.$ac_ext <<EOF -#line 9815 "configure" +#line 9828 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -9822,7 +9835,7 @@ dbopen() ; return 0; } EOF -if { (eval echo configure:9826: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9839: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9846,7 +9859,7 @@ if test "$with_database_berkdb" = "yes"; then for path in "db/db.h" "db.h"; do cat > conftest.$ac_ext <<EOF -#line 9850 "configure" +#line 9863 "configure" #include "confdefs.h" #ifdef HAVE_INTTYPES_H #define __BIT_TYPES_DEFINED__ @@ -9869,7 +9882,7 @@ ; return 0; } EOF -if { (eval echo configure:9873: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:9886: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* db_h_path="$path"; break else @@ -9921,12 +9934,12 @@ if test "$with_socks" = "yes"; then echo $ac_n "checking for SOCKSinit in -lsocks""... $ac_c" 1>&6 -echo "configure:9925: checking for SOCKSinit in -lsocks" >&5 +echo "configure:9938: checking for SOCKSinit in -lsocks" >&5 ac_lib_var=`echo socks'_'SOCKSinit | sed 'y%./+-%__p_%'` xe_check_libs=" -lsocks " cat > conftest.$ac_ext <<EOF -#line 9930 "configure" +#line 9943 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -9937,7 +9950,7 @@ SOCKSinit() ; return 0; } EOF -if { (eval echo configure:9941: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9954: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -10153,9 +10166,11 @@ -if test -n "$package_path"; then - package_path=`echo $package_path | sed 'y/ /:/'` - { test "$extra_verbose" = "yes" && cat << EOF +if test "x${package_path}" = "xNONE" ; then + package_path="${prefix}/lib/xemacs/packages:~/.xemacs" +fi +package_path=`echo $package_path | sed 'y/ /:/'` +{ test "$extra_verbose" = "yes" && cat << EOF Defining PACKAGE_PATH = "$package_path" EOF cat >> confdefs.h <<EOF @@ -10163,7 +10178,6 @@ EOF } -fi { test "$extra_verbose" = "yes" && cat << EOF Defining EMACS_CONFIGURATION = "$canonical"
--- a/configure.in Mon Aug 13 09:54:24 2007 +0200 +++ b/configure.in Mon Aug 13 09:55:28 2007 +0200 @@ -257,6 +257,8 @@ x_includes=NONE x_libraries=NONE CDPATH=.; export CDPATH +dnl this will serve for testing if a default value sould be given +package_path=NONE dnl Allow this script to work with zsh, by setting sh emulation options if test -n "$ZSH_VERSION"; then @@ -279,8 +281,6 @@ sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' libdir='${{exec_prefix}}/lib' -dnl The following gives NONE/lib/xemacs/packages as the first package -dnl package_path=${prefix}/lib/xemacs/packages:~/.xemacs includedir='${prefix}/include' oldincludedir='/usr/include' infodir='${prefix}/info' @@ -489,6 +489,9 @@ --mail-locking=TYPE (*) Specify the locking to be used by movemail to prevent concurrent updates of mail spool files. Valid types are \`lockf', \`flock', and \`file'. +--package-path=PATH A list of blank separated directories for finding + packages to dump with xemacs. + Defaults to \`$prefix/lib/xemacs/packages ~/.xemacs' Internationalization options: @@ -2361,9 +2364,11 @@ dnl autodetect -lXmu test -z "$with_xmu" && { AC_CHECK_LIB(Xmu, XmuReadBitmapDataFromFile, with_xmu=yes, with_xmu=no) } - if test "$with_xmu" = "no" - then XE_ADD_OBJS(xmu.o) - else XE_PREPEND(-lXmu, libs_x) + if test "$with_xmu" = "no"; then + XE_ADD_OBJS(xmu.o) + else + XE_PREPEND(-lXmu, libs_x) + AC_DEFINE(HAVE_XMU) fi dnl Autodetect -lXbsd @@ -3368,11 +3373,13 @@ AC_SUBST(dynodump_arch) +dnl if --package-path wasn't passed to configure, give the default value +if test "x${package_path}" = "xNONE" ; then + package_path="${prefix}/lib/xemacs/packages:~/.xemacs" +fi dnl change blanks to colons in package path, and make available to config.h -if test -n "$package_path"; then - package_path=`echo $package_path | sed 'y/ /:/'` - AC_DEFINE_UNQUOTED(PACKAGE_PATH, "$package_path") -fi +package_path=`echo $package_path | sed 'y/ /:/'` +AC_DEFINE_UNQUOTED(PACKAGE_PATH, "$package_path") AC_DEFINE_UNQUOTED(EMACS_CONFIGURATION, "$canonical") AC_DEFINE_UNQUOTED(EMACS_CONFIG_OPTIONS, "${ac_configure_args}")
--- a/dynodump/dynodump.c Mon Aug 13 09:54:24 2007 +0200 +++ b/dynodump/dynodump.c Mon Aug 13 09:55:28 2007 +0200 @@ -73,7 +73,7 @@ * N.B. The above commentary is not quite correct in the flags have been hardwired * to RTLD_SAVREL. */ -#pragma ident "@(#) $Id: dynodump.c,v 1.4 1997/07/13 22:40:53 steve Exp $ - SMI" +#pragma ident "@(#) $Id: dynodump.c,v 1.5 1997/09/03 03:39:06 steve Exp $ - SMI" #define __EXTENSIONS__ 1 @@ -215,7 +215,7 @@ return (elferr("elf_getscn")); if ((data = elf_getdata(scn, NULL)) == NULL) return (elferr("elf_getdata")); - istrs = data->d_buf; + istrs = (char *) data->d_buf; /* * Construct a cache to maintain the input files section information. @@ -450,7 +450,7 @@ return (elferr("elf_getscn")); if ((data = elf_getdata(scn, NULL)) == NULL) return (elferr("elf_getdata")); - ostrs = _ostrs = data->d_buf; + ostrs = _ostrs = (char *) data->d_buf; *_ostrs++ = '\0'; /*
--- a/etc/w3/stylesheet Mon Aug 13 09:54:24 2007 +0200 +++ b/etc/w3/stylesheet Mon Aug 13 09:55:28 2007 +0200 @@ -126,8 +126,8 @@ dl { display: block; } dir { display: block; } menu { display: block; } - dt { font-weight: bold; display: list-item } - dd { display: list-item; margin-left: 5em; } + dt { font-weight: bold; display: line } + dd { display: line; margin-left: 5em; } li { display: list-item; margin-left: 5em; } ol { list-style: decimal; } ul { list-style: circle; }
--- a/lisp/ChangeLog Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/ChangeLog Mon Aug 13 09:55:28 2007 +0200 @@ -1,3 +1,70 @@ +1997-08-30 Karl M. Hegbloom <karlheg@inetarena.com> + + * packages/info.el (Info-mouse-track-double-click-hook): Added, + and placed an `add-hook' into (Info-mode) + +1997-08-29 Jens-Ulrik Holger Petersen <petersen@kurims.kyoto-u.ac.jp> + + * packages/hyper-apropos.el (hyper-apropos-help-map): add + keybinding to `hyper-apropos-find-function'. + (hyper-apropos-map): removed unnecessary double binding to + `hyper-apropos-set-variable'. + (hyper-apropos-find-function): new function. + (hyper-apropos-popup-menu): if in the help mode, look for symbol + at top of the buffer if necessary. Added menu entry for + `hyper-apropos-find-function'. + +1997-08-29 Jens-Ulrik Holger Petersen <petersen@kurims.kyoto-u.ac.jp> + + * prim/files.el (switch-to-buffer-other-frame): make it select-frame + +1997-09-01 SL Baur <steve@altair.xemacs.org> + + * x11/x-menubar.el (default-menubar): Put tetris in the game menu, + and move it and the mine game to the top of the menu. + +1997-08-29 SL Baur <steve@altair.xemacs.org> + + * packages/lpr.el: Clone message-flatten-list. + +1997-08-25 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * apel/emu-x20.el (mime-charset-coding-system-alist): + iso-2022-jp-2 is defined as coding-system. + + * mule/mule-coding.el: Rename `iso-2022-ss2-{7|8}' -> + `iso-2022-{7|8}bit-ss2' to sync with Emacs 20.0.96. + + (iso-2022-jp-2): New coding system. + +1997-08-23 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * prim/about.el (about-maintainer-glyph): Fix problem with + jka-compr.el. + +1997-08-25 SL Baur <steve@altair.xemacs.org> + + * prim/help.el (find-function): ff-read-function was renamed. + (find-function-other-window): Ditto. + (find-function-other-frame): Ditto. + +1997-08-21 SL Baur <steve@altair.xemacs.org> + + * prim/packages.el (packages-find-packages-1): Append trailing + slash to directories added to the load-path. + +1997-08-17 SL Baur <steve@altair.xemacs.org> + + * utils/autoload.el (fixup-autoload-buffer): Replace lost guard + statement. + + * prim/make-docfile.el: Remove BOGUS redefinition of + find-file-hooks. + * prim/update-elc.el: Ditto. + + * prim/packages.el (locate-library): Put guard on usage of + `find-file-hooks' (it doesn't exist when temacs is being run). + Fri Aug 15 17:26:05 1997 Barry A. Warsaw <cc-mode-help@python.org> * cc-mode/Release 5.16
--- a/lisp/apel/ChangeLog.emu Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/apel/ChangeLog.emu Mon Aug 13 09:55:28 2007 +0200 @@ -1,3 +1,9 @@ +1997-08-25 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * emu-x20.el (mime-charset-coding-system-alist): iso-2022-jp-2 is + defined as coding-system. + + 1997-07-14 MORIOKA Tomohiko <morioka@jaist.ac.jp> * emu: Version 7.44 was released.
--- a/lisp/apel/emu-x20.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/apel/emu-x20.el Mon Aug 13 09:55:28 2007 +0200 @@ -3,7 +3,7 @@ ;; Copyright (C) 1994,1995,1996,1997 MORIOKA Tomohiko ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> -;; Version: $Id: emu-x20.el,v 1.2 1997/06/11 19:25:42 steve Exp $ +;; Version: $Id: emu-x20.el,v 1.3 1997/09/03 02:55:28 steve Exp $ ;; Keywords: emulation, compatibility, Mule, XEmacs ;; This file is part of XEmacs. @@ -110,9 +110,9 @@ (defvar default-mime-charset 'x-ctext) (defvar mime-charset-coding-system-alist - '((x-ctext . ctext) - (iso-2022-jp-2 . iso-2022-ss2-7) - )) + '((x-ctext . ctext)) + "Alist MIME CHARSET vs CODING-SYSTEM. +MIME CHARSET and CODING-SYSTEM must be symbol.") (defun mime-charset-to-coding-system (charset) "Return coding-system by MIME charset."
--- a/lisp/cl/cl-macs.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/cl/cl-macs.el Mon Aug 13 09:55:28 2007 +0200 @@ -2404,8 +2404,7 @@ (defmacro ignore-errors (&rest body) "Execute FORMS; if an error occurs, return nil. Otherwise, return result of last FORM." - (let ((err (gensym))) - (list 'condition-case err (cons 'progn body) '(error nil)))) + (list 'condition-case nil (cons 'progn body) '(error nil))) ;;; Some predicates for analyzing Lisp forms. These are used by various
--- a/lisp/custom/ChangeLog Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/custom/ChangeLog Mon Aug 13 09:55:28 2007 +0200 @@ -1,5 +1,47 @@ +Wed Aug 13 13:04:36 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * Version 1.9956 released. + +Wed Aug 13 00:28:59 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * cus-face.el (make-empty-face): Make it work on Emacsen compiled + without X support. + + * Version 1.9955 released. + +Wed Aug 13 00:28:15 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * wid-edit.el (widget-before-change): Don't complain if + `inhibit-read-only' is non-nil. + +Mon Aug 11 17:55:02 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * cus-face.el (custom-face-attributes): Don't initialize fg/bg + fields. + +Wed Jul 30 14:04:28 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * cus-edit.el: Synched with FSF. + +Tue Jul 29 07:17:54 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * widget.texi (Programming Example): Also delete overlays. + +Mon Jul 28 20:31:22 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * Version 1.9954 released. + Mon Jul 28 19:23:37 1997 Per Abrahamsen <abraham@dina.kvl.dk> + * cus-edit.el (hook): Support hooks whose value is just a symbol. + + * cus-edit.el (custom-magic-value-create): Support `mismatch' + form. + (custom-variable-value-create): Ditto. + (custom-variable-set): Ditto. + (custom-variable-save): Ditto. + (custom-variable-menu): Ditto. + * Version 1.9953 released. Mon Jul 28 18:04:46 1997 Per Abrahamsen <abraham@dina.kvl.dk>
--- a/lisp/custom/cus-edit.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/custom/cus-edit.el Mon Aug 13 09:55:28 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.9954 +;; Version: 1.9956 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; This file is part of GNU Emacs.
--- a/lisp/custom/cus-face.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/custom/cus-face.el Mon Aug 13 09:55:28 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.9954 +;; Version: 1.9956 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -86,10 +86,12 @@ (unless (fboundp 'make-empty-face) ;; This should be moved to `faces.el'. - (if (string-match "XEmacs" emacs-version) - ;; Give up for old XEmacs pre 19.15/20.1. - (defalias 'make-empty-face 'make-face) - ;; Define for Emacs pre 19.35. + (cond + ((string-match "XEmacs" emacs-version) + ;; Give up for old XEmacs pre 19.15/20.1. + (defalias 'make-empty-face 'make-face)) + ((fboundp 'internal-find-face) + ;; We can do faces... (defun make-empty-face (name) "Define a new FACE on all frames, ignoring X resources." (interactive "SMake face: ") @@ -112,7 +114,9 @@ (if (fboundp 'facemenu-add-new-face) (facemenu-add-new-face name)) face)) - name))) + name)) + (t + (fset 'make-empty-face 'ignore)))) (defcustom initialize-face-resources t "If non nil, allow X resources to initialize face properties. @@ -270,12 +274,12 @@ set-face-underline-p face-underline-p) (:foreground (color :tag "Foreground" - :value "black" + :value "" :help-echo "Set foreground color.") set-face-foreground custom-face-foreground) (:background (color :tag "Background" - :value "white" + :value "" :help-echo "Set background color.") set-face-background custom-face-background)
--- a/lisp/custom/custom-load.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/custom/custom-load.el Mon Aug 13 09:55:28 2007 +0200 @@ -1,53 +1,53 @@ -(custom-put 'emacs 'custom-loads '("cus-edit")) -(custom-put 'editing 'custom-loads '("cus-edit")) -(custom-put 'abbrev 'custom-loads '("cus-edit")) -(custom-put 'matching 'custom-loads '()) -(custom-put 'mouse 'custom-loads '()) -(custom-put 'external 'custom-loads '("cus-edit")) -(custom-put 'processes 'custom-loads '("cus-edit")) -(custom-put 'programming 'custom-loads '("cus-edit")) -(custom-put 'languages 'custom-loads '("cus-edit")) -(custom-put 'lisp 'custom-loads '()) -(custom-put 'applications 'custom-loads '("cus-edit")) -(custom-put 'calendar 'custom-loads '()) -(custom-put 'development 'custom-loads '("cus-edit")) -(custom-put 'extensions 'custom-loads '("wid-edit")) -(custom-put 'internal 'custom-loads '("cus-edit")) -(custom-put 'maint 'custom-loads '()) -(custom-put 'environment 'custom-loads '("cus-edit")) -(custom-put 'i18n 'custom-loads '("cus-edit")) -(custom-put 'x 'custom-loads '()) -(custom-put 'frames 'custom-loads '()) -(custom-put 'data 'custom-loads '()) -(custom-put 'files 'custom-loads '("cus-edit")) -(custom-put 'wp 'custom-loads '("cus-edit")) -(custom-put 'faces 'custom-loads '("cus-edit" "wid-edit")) -(custom-put 'hypermedia 'custom-loads '("wid-edit")) -(custom-put 'help 'custom-loads '("cus-edit")) +(custom-put 'widget-button 'custom-loads '("wid-edit")) +(custom-put 'widget-faces 'custom-loads '("wid-edit")) +(custom-put 'widget-documentation 'custom-loads '("wid-edit")) +(custom-put 'widgets 'custom-loads '("wid-browse" "wid-edit")) +(custom-put 'widget-browse 'custom-loads '("wid-browse")) +(custom-put 'custom-magic-faces 'custom-loads '("cus-edit")) +(custom-put 'windows 'custom-loads '()) +(custom-put 'processes-basics 'custom-loads '()) +(custom-put 'auto-save 'custom-loads '()) +(custom-put 'keyboard 'custom-loads '()) +(custom-put 'minibuffer 'custom-loads '()) +(custom-put 'debug 'custom-loads '()) +(custom-put 'limits 'custom-loads '()) +(custom-put 'dired 'custom-loads '()) +(custom-put 'execute 'custom-loads '()) +(custom-put 'display 'custom-loads '()) +(custom-put 'editing-basics 'custom-loads '()) +(custom-put 'fill 'custom-loads '()) +(custom-put 'modeline 'custom-loads '()) +(custom-put 'undo 'custom-loads '()) +(custom-put 'alloc 'custom-loads '()) +(custom-put 'custom-menu 'custom-loads '("cus-edit")) +(custom-put 'custom-buffer 'custom-loads '("cus-edit")) +(custom-put 'custom-browse 'custom-loads '("cus-edit")) +(custom-put 'custom-faces 'custom-loads '("cus-edit")) +(custom-put 'customize 'custom-loads '("cus-edit" "wid-edit" "cus-face")) (custom-put 'local 'custom-loads '()) -(custom-put 'customize 'custom-loads '("cus-edit" "wid-edit" "cus-face")) -(custom-put 'custom-faces 'custom-loads '("cus-edit")) -(custom-put 'custom-browse 'custom-loads '("cus-edit")) -(custom-put 'custom-buffer 'custom-loads '("cus-edit")) -(custom-put 'custom-menu 'custom-loads '("cus-edit")) -(custom-put 'alloc 'custom-loads '()) -(custom-put 'undo 'custom-loads '()) -(custom-put 'modeline 'custom-loads '()) -(custom-put 'fill 'custom-loads '()) -(custom-put 'editing-basics 'custom-loads '()) -(custom-put 'display 'custom-loads '()) -(custom-put 'execute 'custom-loads '()) -(custom-put 'dired 'custom-loads '()) -(custom-put 'limits 'custom-loads '()) -(custom-put 'debug 'custom-loads '()) -(custom-put 'minibuffer 'custom-loads '()) -(custom-put 'keyboard 'custom-loads '()) -(custom-put 'auto-save 'custom-loads '()) -(custom-put 'processes-basics 'custom-loads '()) -(custom-put 'windows 'custom-loads '()) -(custom-put 'custom-magic-faces 'custom-loads '("cus-edit")) -(custom-put 'widget-browse 'custom-loads '("wid-browse")) -(custom-put 'widgets 'custom-loads '("wid-browse" "wid-edit")) -(custom-put 'widget-documentation 'custom-loads '("wid-edit")) -(custom-put 'widget-faces 'custom-loads '("wid-edit")) -(custom-put 'widget-button 'custom-loads '("wid-edit")) +(custom-put 'help 'custom-loads '("cus-edit")) +(custom-put 'hypermedia 'custom-loads '("wid-edit")) +(custom-put 'faces 'custom-loads '("cus-edit" "wid-edit")) +(custom-put 'wp 'custom-loads '("cus-edit")) +(custom-put 'files 'custom-loads '("cus-edit")) +(custom-put 'data 'custom-loads '()) +(custom-put 'frames 'custom-loads '()) +(custom-put 'x 'custom-loads '()) +(custom-put 'i18n 'custom-loads '("cus-edit")) +(custom-put 'environment 'custom-loads '("cus-edit")) +(custom-put 'maint 'custom-loads '()) +(custom-put 'internal 'custom-loads '("cus-edit")) +(custom-put 'extensions 'custom-loads '("wid-edit")) +(custom-put 'development 'custom-loads '("cus-edit")) +(custom-put 'calendar 'custom-loads '()) +(custom-put 'applications 'custom-loads '("cus-edit")) +(custom-put 'lisp 'custom-loads '()) +(custom-put 'languages 'custom-loads '("cus-edit")) +(custom-put 'programming 'custom-loads '("cus-edit")) +(custom-put 'processes 'custom-loads '("cus-edit")) +(custom-put 'external 'custom-loads '("cus-edit")) +(custom-put 'mouse 'custom-loads '()) +(custom-put 'matching 'custom-loads '()) +(custom-put 'abbrev 'custom-loads '("cus-edit")) +(custom-put 'editing 'custom-loads '("cus-edit")) +(custom-put 'emacs 'custom-loads '("cus-edit"))
--- a/lisp/custom/custom.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/custom/custom.el Mon Aug 13 09:55:28 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.9954 +;; Version: 1.9956 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; This file is part of GNU Emacs.
--- a/lisp/custom/wid-browse.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/custom/wid-browse.el Mon Aug 13 09:55:28 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: extensions -;; Version: 1.9954 +;; Version: 1.9956 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; This file is part of GNU Emacs.
--- a/lisp/custom/wid-edit.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/custom/wid-edit.el Mon Aug 13 09:55:28 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: extensions -;; Version: 1.9954 +;; Version: 1.9956 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; This file is part of GNU Emacs. @@ -1275,18 +1275,19 @@ (defun widget-before-change (from to) ;; This is how, for example, a variable changes its state to `modified'. ;; when it is being edited. - (let ((from-field (widget-field-find from)) - (to-field (widget-field-find to))) - (cond ((not (eq from-field to-field)) - (add-hook 'post-command-hook 'widget-add-change nil t) - (error "Change should be restricted to a single field")) - ((null from-field) - (add-hook 'post-command-hook 'widget-add-change nil t) - (error "Attempt to change text outside editable field")) - (widget-field-use-before-change - (condition-case nil - (widget-apply from-field :notify from-field) - (error (debug "Before Change"))))))) + (unless inhibit-read-only + (let ((from-field (widget-field-find from)) + (to-field (widget-field-find to))) + (cond ((not (eq from-field to-field)) + (add-hook 'post-command-hook 'widget-add-change nil t) + (error "Change should be restricted to a single field")) + ((null from-field) + (add-hook 'post-command-hook 'widget-add-change nil t) + (error "Attempt to change text outside editable field")) + (widget-field-use-before-change + (condition-case nil + (widget-apply from-field :notify from-field) + (error (debug "Before Change")))))))) (defun widget-add-change () (make-local-hook 'post-command-hook)
--- a/lisp/custom/widget-example.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/custom/widget-example.el Mon Aug 13 09:55:28 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.9954 +;; Version: 1.9956 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ (require 'widget)
--- a/lisp/custom/widget.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/custom/widget.el Mon Aug 13 09:55:28 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.9954 +;; Version: 1.9956 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; This file is part of GNU Emacs.
--- a/lisp/ediff/custom-load.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/ediff/custom-load.el Mon Aug 13 09:55:28 2007 +0200 @@ -2,5 +2,4 @@ (custom-put 'ediff-merge 'custom-loads '("ediff-merg")) (custom-put 'ediff-mult 'custom-loads '("ediff-mult")) (custom-put 'ediff-ptch 'custom-loads '("ediff-ptch")) -(custom-put 'ediff-window 'custom-loads '()) (custom-put 'ediff 'custom-loads '("ediff-diff" "ediff-merg" "ediff-mult" "ediff-ptch" "ediff-wind" "ediff" "ediff-init"))
--- a/lisp/ediff/ediff-mult.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/ediff/ediff-mult.el Mon Aug 13 09:55:28 2007 +0200 @@ -155,10 +155,15 @@ ;; history var to use for filtering groups (defvar ediff-filtering-regexp-history nil "") -;; This has the form ((ctl-buf file1 file2) (stl-buf file1 file2) ...) -;; If ctl-buf is nil, the file-pair wasn't processed yet. If it is +;; This has the form ((meta-buf regexp dir1 dir2 dir3 merge-auto-store-dir) +;; (ctl-buf session-status (file1 . eq-status) (file2 . eq-status) (file3 +;; . eq-status)) (ctl-buf session-status (file1 . eq-status) (file2 +;; . eq-status)) ...) +;; If ctl-buf is nil, the file-pair hasn't processed yet. If it is ;; killed-buffer object, the file pair has been processed. If it is a live -;; buffer, this means ediff is still working on the pair +;; buffer, this means ediff is still working on the pair. +;; Eq-status of a file is t if the file equals some other file in the same +;; group. (ediff-defvar-local ediff-meta-list nil "") @@ -204,40 +209,40 @@ ;;; API for ediff-meta-list ;; group buffer/regexp -(defun ediff-get-group-buffer (meta-list) +(defsubst ediff-get-group-buffer (meta-list) (nth 0 (car meta-list))) -(defun ediff-get-group-regexp (meta-list) +(defsubst ediff-get-group-regexp (meta-list) (nth 1 (car meta-list))) ;; group objects -(defun ediff-get-group-objA (meta-list) +(defsubst ediff-get-group-objA (meta-list) (nth 2 (car meta-list))) -(defun ediff-get-group-objB (meta-list) +(defsubst ediff-get-group-objB (meta-list) (nth 3 (car meta-list))) -(defun ediff-get-group-objC (meta-list) +(defsubst ediff-get-group-objC (meta-list) (nth 4 (car meta-list))) -(defun ediff-get-group-merge-autostore-dir (meta-list) +(defsubst ediff-get-group-merge-autostore-dir (meta-list) (nth 5 (car meta-list))) ;; session buffer -(defun ediff-get-session-buffer (elt) +(defsubst ediff-get-session-buffer (elt) (nth 0 elt)) -(defun ediff-get-session-status (elt) +(defsubst ediff-get-session-status (elt) (nth 1 elt)) -(defun ediff-set-session-status (session-info new-status) +(defsubst ediff-set-session-status (session-info new-status) (setcar (cdr session-info) new-status)) ;; session objects -(defun ediff-get-session-objA (elt) +(defsubst ediff-get-session-objA (elt) (nth 2 elt)) -(defun ediff-get-session-objB (elt) +(defsubst ediff-get-session-objB (elt) (nth 3 elt)) -(defun ediff-get-session-objC (elt) +(defsubst ediff-get-session-objC (elt) (nth 4 elt)) -(defun ediff-get-session-objA-name (elt) +(defsubst ediff-get-session-objA-name (elt) (car (nth 2 elt))) -(defun ediff-get-session-objB-name (elt) +(defsubst ediff-get-session-objB-name (elt) (car (nth 3 elt))) -(defun ediff-get-session-objC-name (elt) +(defsubst ediff-get-session-objC-name (elt) (car (nth 4 elt))) ;; equality indicators (defsubst ediff-get-file-eqstatus (elt) @@ -245,6 +250,15 @@ (defsubst ediff-set-file-eqstatus (elt value) (setcar (cdr elt) value)) +;; checks if the session is a meta session +(defun ediff-meta-session-p (session-info) + (and (stringp (ediff-get-session-objA-name session-info)) + (file-directory-p (ediff-get-session-objA-name session-info)) + (stringp (ediff-get-session-objB-name session-info)) + (file-directory-p (ediff-get-session-objB-name session-info)) + (if (stringp (ediff-get-session-objC-name session-info)) + (file-directory-p (ediff-get-session-objC-name session-info)) t))) + ;; set up the keymap in the meta buffer (defun ediff-setup-meta-map() (setq ediff-meta-buffer-map (make-sparse-keymap)) @@ -1122,22 +1136,33 @@ (marksym ?*) (numMarked 0) (sessionNum 0) - elt) + (diff-buffer ediff-meta-diff-buffer) + session-buf elt) (while meta-list (setq elt (car meta-list) meta-list (cdr meta-list) sessionNum (1+ sessionNum)) - (if (eq (ediff-get-session-status elt) marksym) - (save-excursion - (setq numMarked (1+ numMarked)) - (funcall operation elt sessionNum)))) + (cond ((eq (ediff-get-session-status elt) marksym) + (save-excursion + (setq numMarked (1+ numMarked)) + (funcall operation elt sessionNum))) + ((and (ediff-meta-session-p elt) + (ediff-buffer-live-p + (setq session-buf (ediff-get-session-buffer elt)))) + (setq numMarked + (+ numMarked + (ediff-with-current-buffer session-buf + ;; pass meta-diff along + (setq ediff-meta-diff-buffer diff-buffer) + ;; collect diffs in child group + (ediff-operate-on-marked-sessions operation))))))) (ediff-update-meta-buffer grp-buf) ; just in case numMarked )) (defun ediff-append-custom-diff (session sessionNum) (or (ediff-collect-diffs-metajob) - (error "Sorry, I don't do this for everyone...")) + (error "Hmm, I'd hate to do it to you ...")) (let ((session-buf (ediff-get-session-buffer session)) (meta-diff-buff ediff-meta-diff-buffer) (metajob ediff-metajob-name) @@ -1256,9 +1281,7 @@ ;; First handle sessions involving directories (which are themselves ;; session groups) ;; After that handle individual sessions - (cond ((and (file-directory-p file1) - (stringp file2) (file-directory-p file2) - (if (stringp file3) (file-directory-p file1) t)) + (cond ((ediff-meta-session-p info) ;; do ediff/ediff-merge on subdirectories (if (ediff-buffer-live-p session-buf) (ediff-show-meta-buffer session-buf)
--- a/lisp/ediff/ediff-util.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/ediff/ediff-util.el Mon Aug 13 09:55:28 2007 +0200 @@ -145,10 +145,11 @@ (define-key ediff-mode-map "p" 'ediff-previous-difference) (define-key ediff-mode-map "\C-?" 'ediff-previous-difference) - (define-key ediff-mode-map [backspace] 'ediff-previous-difference) (define-key ediff-mode-map [delete] 'ediff-previous-difference) (define-key ediff-mode-map "\C-h" (if ediff-no-emacs-help-in-control-buffer 'ediff-previous-difference nil)) + ;; must come after C-h, or else C-h wipes out backspace's binding in XEmacs + (define-key ediff-mode-map [backspace] 'ediff-previous-difference) (define-key ediff-mode-map "n" 'ediff-next-difference) (define-key ediff-mode-map " " 'ediff-next-difference) (define-key ediff-mode-map "j" 'ediff-jump-to-difference)
--- a/lisp/ediff/ediff.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/ediff/ediff.el Mon Aug 13 09:55:28 2007 +0200 @@ -136,6 +136,7 @@ (defgroup ediff nil "A comprehensive visual interface to diff & patch" + :tag "Ediff" :group 'tools)
--- a/lisp/efs/dired-shell.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/efs/dired-shell.el Mon Aug 13 09:55:28 2007 +0200 @@ -185,7 +185,7 @@ (defun dired-shell-quote (filename) ;; Quote a file name for inferior shell (see variable shell-file-name). ;; Quote everything except POSIX filename characters. - ;; This should be safe enough even for really wierd shells. + ;; This should be safe enough even for really weird shells. (let ((result "") (start 0) end) (while (string-match "[^---0-9a-zA-Z_./]" filename start) (setq end (match-beginning 0)
--- a/lisp/egg/egg.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/egg/egg.el Mon Aug 13 09:55:28 2007 +0200 @@ -2847,7 +2847,7 @@ (setq egg:*input-mode* t egg:*mode-on* t its:*current-map* (its:get-mode-map "roma-kana")) - (mode-line-egg-mode-update (its:get-mode-indicator its:*current-map*)))) + (mode-line-egg-mode-update (its:get-mode-indicator "roma-kana")))) (read-from-minibuffer prompt initial-input egg:*minibuffer-local-hiragana-map*))
--- a/lisp/emulators/crisp.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/emulators/crisp.el Mon Aug 13 09:55:28 2007 +0200 @@ -1,8 +1,16 @@ ;; @(#) crisp.el -- CRiSP/Brief Emacs emulator ;; Author: Gary D. Foster <Gary.Foster@corp.sun.com> -;; 1.19 +;; Created: 01 Mar 1996 +;; Version: 1.20 ;; Keywords: emulations brief crisp +;; X-Modified-by: +;; crisp.el,v +;; Revision 1.20 1997/08/22 18:49:11 gfoster +;; Added next-buffer/previous-buffer keybindings (bound to M-n/M-p) +;; Added crisp-unbury-buffer function +;; Standardized headers for Steve +;; ;; This file is part of XEmacs. @@ -55,6 +63,10 @@ ;; All these overrides should go *before* the (require 'crisp) statement. +;; Code: + +(require 'cl) + ;; local variables (defgroup emulations-crisp nil @@ -99,7 +111,7 @@ (defvar crisp-load-hook nil "Hooks to run after loading the CRiSP emulator package.") -(defconst crisp-version "crisp.el release 1.1/1.19" +(defconst crisp-version "crisp.el release 1.1/1.20" "The release number and RCS version for the CRiSP emulator.") (if (string-match "XEmacs\\Lucid" emacs-version) @@ -154,6 +166,8 @@ (define-key crisp-mode-map [(meta h)] 'help) (define-key crisp-mode-map [(meta i)] 'overwrite-mode) (define-key crisp-mode-map [(meta j)] 'bookmark-jump) +(define-key crisp-mode-map [(meta n)] 'bury-buffer) +(define-key crisp-mode-map [(meta p)] 'crisp-unbury-buffer) (define-key crisp-mode-map [(meta u)] 'advertised-undo) (define-key crisp-mode-map [(f14)] 'advertised-undo) (define-key crisp-mode-map [(meta w)] 'save-buffer) @@ -210,6 +224,11 @@ (end-of-line))) (setq last-last-command last-command)) +(defun crisp-unbury-buffer () + "Go back one buffer" + (interactive) + (switch-to-buffer (car (last (buffer-list))))) + (defun crisp-meta-x-wrapper () "Wrapper function to conditionally override the normal M-x bindings. When `crisp-override-meta-x' is non-nil, M-x will exit Emacs (the
--- a/lisp/emulators/tpu-edt.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/emulators/tpu-edt.el Mon Aug 13 09:55:28 2007 +0200 @@ -7,9 +7,8 @@ ;; Version: 4.2 ;; Keywords: emulations -;; Modified for XEmacs by R. Kevin Oberman <oberman@es.net> - ;; This file is part of XEmacs. +;; Modified for XEmacs by Kevin Oberman <oberman@es.net> ;; XEmacs is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by @@ -18,15 +17,15 @@ ;; 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. +;; 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 XEmacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. -;;; Synched up with: FSF 19.34 +;;; Synced up with FSF 19.34 and XEmacs 19.16 ;; TPU-edt is based on tpu.el by Jeff Kowalski and Bob Covey. @@ -65,7 +64,7 @@ ;; Please note that TPU-edt does NOT emulate TPU. It emulates TPU's EDT ;; emulation. Very few TPU line-mode commands are supported. -;; TPU-edt, like it's VMS cousin, works on VT-series terminals with DEC +;; TPU-edt, like its VMS cousin, works on VT-series terminals with DEC ;; style keyboards. VT terminal emulators, including xterm with the ;; appropriate key translations, work just fine too. @@ -130,7 +129,7 @@ ;; a small help file showing the default keypad layout, control key ;; functions, and Gold key functions. Pressing any key inside of help ;; splits the screen and prints a description of the function of the -;; pressed key. Gold-PF2 invokes the native emacs help, with it's +;; pressed key. Gold-PF2 invokes the native emacs help, with its ;; zillions of options. ;; Thanks to emacs, TPU-edt has some extensions that may make your life @@ -268,16 +267,13 @@ ;; than the emulated TPU commands. Also, it works only in the forward ;; direction, regardless of the current TPU-edt direction. -;; NOTE: There was a very old tpu-edt in XEmacs 19.14 so I deleted it and -;; replaced it with the one in Emacs 19.34. -sb - ;;; Code: ;;; ;;; Version Information ;;; -(defconst tpu-version "4.2" "TPU-edt version number.") +(defconst tpu-version "4.2X" "TPU-edt version number.") ;;; @@ -430,8 +426,9 @@ (setq minor-mode-alist tpu-original-mm-alist)) (t (setq-default mode-line-format - (list (purecopy "") + (list (purecopy "-") 'mode-line-modified + 'mode-line-frame-identification 'mode-line-buffer-identification (purecopy " ") 'global-mode-string @@ -679,8 +676,8 @@ "Sets the screen size." (interactive "nnew screen height: \nnnew screen width: ") (setq zmacs-region-stays t) - (set-screen-height height) - (set-screen-width width)) + (set-frame-height height) + (set-frame-width width)) (defun tpu-toggle-newline-and-indent nil "Toggle between 'newline and indent' and 'simple newline'." @@ -822,6 +819,8 @@ (fset 'replace 'tpu-lm-replace) (fset 'REPLACE 'tpu-lm-replace) +;; Apparently TPU users really expect to do M-x help RET to get help. +;; So it is really necessary to redefine this. (fset 'help 'tpu-help) (fset 'HELP 'tpu-help) @@ -973,10 +972,12 @@ (if split (setq key (read-key-sequence - "Press the key you want help on (RET=exit, ENTER=redisplay, N=next, P=prev): ")) + "Press the key you want help on (RET=exit, ENTER=redisplay, N=next, +P=prev): ")) (setq key (read-key-sequence - "Press the key you want help on (RET to exit, N next screen, P prev screen): "))) + "Press the key you want help on (RET to exit, N next screen, P prev +screen): "))) ;; Process the read key ;; @@ -1090,7 +1091,8 @@ (switch-to-buffer (car (reverse list))))) (defun tpu-make-file-buffer-list (buffer-list) - "Returns names from BUFFER-LIST excluding those beginning with a space or star." + "Returns names from BUFFER-LIST excluding those beginning with a space or +star." (delq nil (mapcar '(lambda (b) (if (or (= (aref (buffer-name b) 0) ? ) (= (aref (buffer-name b) 0) ?*)) nil b)) @@ -1674,7 +1676,7 @@ or each line of the entire buffer if no region is selected." (interactive (list (tpu-string-prompt "String to add: " 'tpu-add-at-eol-hist))) - (set zmacs-region-stays t) + (setq zmacs-region-stays t) (if (string= "" text) (error "No string specified.")) (cond ((tpu-mark) (save-excursion @@ -1817,7 +1819,7 @@ Prefix argument serves as a repeat count." (interactive "p") (setq zmacs-region-stays t) - (next-line-internal num) + (line-move num) (setq this-command 'next-line)) (defun tpu-previous-line (num) @@ -1825,7 +1827,7 @@ Prefix argument serves as a repeat count." (interactive "p") (setq zmacs-region-stays t) - (next-line-internal (- num)) + (line-move (- num)) (setq this-command 'previous-line)) (defun tpu-next-beginning-of-line (num) @@ -1959,10 +1961,12 @@ A repeat count means scroll that many sections." (interactive "p") (setq zmacs-region-stays t) - (let* ((beg (tpu-current-line)) + (let* ( + (beg (tpu-current-line)) (height (1- (window-height))) (lines (* num (/ (* height tpu-percent-scroll) 100)))) - (next-line-internal (- lines)) + (setq zmacs-region-stays t) + (line-move (- lines)) (if (> lines beg) (recenter 0)))) (defun tpu-scroll-window-up (num) @@ -1970,10 +1974,12 @@ A repeat count means scroll that many sections." (interactive "p") (setq zmacs-region-stays t) - (let* ((beg (tpu-current-line)) + (let* ( + (beg (tpu-current-line)) (height (1- (window-height))) (lines (* num (/ (* height tpu-percent-scroll) 100)))) - (next-line-internal lines) + (setq zmacs-region-stays t) + (line-move lines) (if (>= (+ lines beg) height) (recenter -1)))) (defun tpu-pan-right (num) @@ -2337,7 +2343,8 @@ (define-key minibuffer-local-map "\eOM" 'exit-minibuffer) (define-key minibuffer-local-ns-map "\eOM" 'exit-minibuffer) (define-key minibuffer-local-completion-map "\eOM" 'exit-minibuffer) -(define-key minibuffer-local-must-match-map "\eOM" 'minibuffer-complete-and-exit) +(define-key minibuffer-local-must-match-map "\eOM" +'minibuffer-complete-and-exit) (and (boundp 'repeat-complex-command-map) (define-key repeat-complex-command-map "\eOM" 'exit-minibuffer)) @@ -2431,8 +2438,10 @@ (define-key read-expression-map cur 'tpu-previous-history-element) (define-key minibuffer-local-map cur 'tpu-previous-history-element) (define-key minibuffer-local-ns-map cur 'tpu-previous-history-element) - (define-key minibuffer-local-completion-map cur 'tpu-previous-history-element) - (define-key minibuffer-local-must-match-map cur 'tpu-previous-history-element) + (define-key minibuffer-local-completion-map cur +'tpu-previous-history-element) + (define-key minibuffer-local-must-match-map cur +'tpu-previous-history-element) (setq loc (cdr loc))) (setq loc (where-is-internal 'tpu-next-line)) @@ -2440,8 +2449,10 @@ (define-key read-expression-map cur 'tpu-next-history-element) (define-key minibuffer-local-map cur 'tpu-next-history-element) (define-key minibuffer-local-ns-map cur 'tpu-next-history-element) - (define-key minibuffer-local-completion-map cur 'tpu-next-history-element) - (define-key minibuffer-local-must-match-map cur 'tpu-next-history-element) + (define-key minibuffer-local-completion-map cur +'tpu-next-history-element) + (define-key minibuffer-local-must-match-map cur +'tpu-next-history-element) (setq loc (cdr loc))))) @@ -2481,7 +2492,7 @@ Ack!! You're running TPU-edt under X-windows without loading an X key definition file. To create a TPU-edt X key definition file, run the tpu-mapper.el program. It came with TPU-edt. It - even includes directions on how to use it! Perhaps it's laying + even includes directions on how to use it! Perhaps it's lying around here someplace. ") (let ((file "tpu-mapper.el") (found nil) @@ -2550,8 +2561,10 @@ (tpu-arrow-history)) (t ;; define ispell functions - (autoload 'ispell-word "ispell" "Check spelling of word at or before point" t) - (autoload 'ispell-complete-word "ispell" "Complete word at or before point" t) + (autoload 'ispell-word "ispell" "Check spelling of word at or before +point" t) + (autoload 'ispell-complete-word "ispell" "Complete word at or before +point" t) (autoload 'ispell-buffer "ispell" "Check spelling of entire buffer" t) (autoload 'ispell-region "ispell" "Check spelling of region" t))) (tpu-set-mode-line t)
--- a/lisp/emulators/tpu-extras.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/emulators/tpu-extras.el Mon Aug 13 09:55:28 2007 +0200 @@ -7,6 +7,7 @@ ;; Keywords: emulations ;; This file is part of XEmacs. +;; XEmacs modifications by Kevin Oberman <oberman@es.net> ;; XEmacs is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by @@ -15,15 +16,15 @@ ;; 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. +;; 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 XEmacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. -;;; Synched up with: FSF 19.34 +;;; Synced up with FSF 19.34 and XEmacs 19.16 ;;; Commentary: @@ -102,9 +103,6 @@ ;; important aspects of the real TPU/edt. Those who miss free cursor mode ;; and/or scroll margins will appreciate these implementations. -;; NOTE: There was a very old tpu-edt in XEmacs 19.14 so I deleted it and -;; replaced it with the one in Emacs 19.34. -sb - ;;; Code: @@ -171,11 +169,13 @@ (defun tpu-forward-char (num) "Move right ARG characters (left if ARG is negative)." (interactive "p") + (setq zmacs-region-stays t) (if tpu-cursor-free (picture-forward-column num) (forward-char num))) (defun tpu-backward-char (num) "Move left ARG characters (right if ARG is negative)." (interactive "p") + (setq zmacs-region-stays t) (cond ((not tpu-cursor-free) (backward-char num)) (tpu-backward-char-like-tpu @@ -194,6 +194,7 @@ "Move to next line. Prefix argument serves as a repeat count." (interactive "p") + (setq zmacs-region-stays t) (let ((beg (tpu-current-line))) (if tpu-cursor-free (or (eobp) (picture-move-down num)) (next-line-internal num)) @@ -204,6 +205,7 @@ "Move to previous line. Prefix argument serves as a repeat count." (interactive "p") + (setq zmacs-region-stays t) (let ((beg (tpu-current-line))) (if tpu-cursor-free (picture-move-up num) (next-line-internal (- num))) (tpu-top-check beg num) @@ -213,6 +215,7 @@ "Move to beginning of line; if at beginning, move to beginning of next line. Accepts a prefix argument for the number of lines to move." (interactive "p") + (setq zmacs-region-stays t) (let ((beg (tpu-current-line))) (backward-char 1) (forward-line (- 1 num)) @@ -222,6 +225,7 @@ "Move to end of line; if at end, move to end of next line. Accepts a prefix argument for the number of lines to move." (interactive "p") + (setq zmacs-region-stays t) (let ((beg (tpu-current-line))) (cond (tpu-cursor-free (let ((beg (point))) @@ -237,6 +241,7 @@ "Move EOL upward. Accepts a prefix argument for the number of lines to move." (interactive "p") + (setq zmacs-region-stays t) (let ((beg (tpu-current-line))) (cond (tpu-cursor-free (picture-end-of-line (- 1 num))) @@ -247,6 +252,7 @@ (defun tpu-current-end-of-line nil "Move point to end of current line." (interactive) + (setq zmacs-region-stays t) (let ((beg (point))) (if tpu-cursor-free (picture-end-of-line) (end-of-line)) (if (= beg (point)) (message "You are already at the end of a line.")))) @@ -264,6 +270,7 @@ "Move to beginning of previous line. Prefix argument serves as repeat count." (interactive "p") + (setq zmacs-region-stays t) (let ((beg (tpu-current-line))) (or (bolp) (>= 0 num) (setq num (- num 1))) (next-line-internal (- num)) @@ -277,6 +284,7 @@ "Move to the next paragraph in the current direction. A repeat count means move that many paragraphs." (interactive "p") + (setq zmacs-region-stays t) (let* ((left nil) (beg (tpu-current-line)) (height (window-height)) @@ -310,6 +318,7 @@ "Move to the next page in the current direction. A repeat count means move that many pages." (interactive "p") + (setq zmacs-region-stays t) (let* ((left nil) (beg (tpu-current-line)) (height (window-height)) @@ -343,6 +352,7 @@ "Scroll the display down to the next section. A repeat count means scroll that many sections." (interactive "p") + (setq zmacs-region-stays t) (let* ((beg (tpu-current-line)) (height (1- (window-height))) (lines (* num (/ (* height tpu-percent-scroll) 100)))) @@ -353,6 +363,7 @@ "Scroll the display up to the next section. A repeat count means scroll that many sections." (interactive "p") + (setq zmacs-region-stays t) (let* ((beg (tpu-current-line)) (height (1- (window-height))) (lines (* num (/ (* height tpu-percent-scroll) 100)))) @@ -404,6 +415,7 @@ In Auto Fill mode, can break the preceding line if no numeric arg. This is the TPU-edt version that respects the bottom scroll margin." (interactive "p") + (setq zmacs-region-stays t) (let ((beg (tpu-current-line))) (or num (setq num 1)) (tpu-old-newline num) @@ -417,6 +429,7 @@ to the specified left-margin column. This is the TPU-edt version that respects the bottom scroll margin." (interactive) + (setq zmacs-region-stays t) (let ((beg (tpu-current-line))) (tpu-old-newline-and-indent) (tpu-bottom-check beg 1))) @@ -436,6 +449,7 @@ (interactive "sEnter top scroll margin (N lines or N%% or RETURN for current value): \ \nsEnter bottom scroll margin (N lines or N%% or RETURN for current value): ") + (setq zmacs-region-stays t) ;; set top scroll margin (or (string= top "") (if (string= "%" (substring top -1)) @@ -462,6 +476,7 @@ (defun tpu-set-cursor-free nil "Allow the cursor to move freely about the screen." (interactive) + (setq zmacs-region-stays t) (setq tpu-cursor-free t) (substitute-key-definition 'tpu-set-cursor-free 'tpu-set-cursor-bound @@ -472,6 +487,7 @@ (defun tpu-set-cursor-bound nil "Constrain the cursor to the flow of the text." (interactive) + (setq zmacs-region-stays t) (picture-clean) (setq tpu-cursor-free nil) (substitute-key-definition 'tpu-set-cursor-bound
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/games/tetris.el Mon Aug 13 09:55:28 2007 +0200 @@ -0,0 +1,823 @@ +;;; tetris.el -- Implementation of Tetris for Emacs. + +;; Copyright (C) 1997 Glynn Clements <glynn@sensei.co.uk> + +;; Author: Glynn Clements <glynn@sensei.co.uk> +;; Version: 1.7 +;; Created: 1997-08-13 +;; Keywords: games + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not synched. + +;;; Commentary: + +;; Modified: 1997-08-17, added tetris-move-bottom +;; Modified: 1997-08-22, changed setting of display table for compatibility +;; with XEmacs 19.15 +;; Modified: 1997-08-23, changed setting of display table for TTY compatibility +;; Modified: 1997-08-24, various changes for FSF Emacs compatibility +;; Modified: 1997-08-25 +;; modified existing docstrings, added new docstrings +;; L now rotates the same way as T and mirror-L +;; now adds tetris-end-game to buffer-local value of kill-buffer-hook +;; Modified: 1997-08-26, miscellaneous bugfixes +;; Modified: 1997-08-27 +;; added color support for non-glyph mode +;; added tetris-mode-hook +;; added tetris-update-speed-function +;; URL: ftp://sensei.co.uk/misc/tetris.el.gz +;; Tested with XEmacs 20.3-beta and Emacs 19.34 +;; Reported to work with XEmacs 19.15 and 20.2 + +(eval-when-compile + (require 'cl)) + +;; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar tetris-use-glyphs t + "Non-nil means use glyphs when available") + +(defvar tetris-use-color t + "Non-nil means use color when available") + +(defvar tetris-draw-border-with-glyphs t + "Non-nil means draw a border even when using glyphs") + +(defvar tetris-font "-*-courier-medium-r-*-*-*-140-100-75-*-*-iso8859-*" + "Name of the font used for tetris in X mode") + +(defvar tetris-default-tick-period 0.3 + "The default time taken for a shape to drop one row") + +(defvar tetris-update-speed-function + 'tetris-default-update-speed-function + "Function run whenever the Tetris score changes +Called with two arguments: (SHAPES ROWS) +SHAPES is the number of shapes which have been dropped +ROWS is the number of rows which have been completed + +If the return value is a number, it is used as the timer period") + +(defvar tetris-mode-hook nil + "Hook run upon starting Tetris") + +;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst tetris-buffer-name "*Tetris*" + "Name used for Tetris buffer") + +(defconst tetris-space-char [?\040] + "Character vector used for a space") + +(defconst tetris-block-char [?\040] + "Character vector for a full square in text mode") + +(defconst tetris-emacs-block-char [?O] + "Character vector for a full square in text mode under Emacs") + +(defconst tetris-border-char [?\+] + "Character vector for a border square in text mode") + +(defconst tetris-buffer-width 25 + "Width of used portion of buffer") + +(defconst tetris-buffer-height 25 + "Height of used portion of buffer") + +(defconst tetris-width 10 + "Width of playing area") + +(defconst tetris-height 20 + "Height of playing area") + +(defconst tetris-top-left-x 3 + "X position of top left of playing area") + +(defconst tetris-top-left-y 1 + "Y position of top left of playing area") + +(defconst tetris-next-x (+ (* 2 tetris-top-left-x) tetris-width) + "X position of next shape") + +(defconst tetris-next-y tetris-top-left-y + "Y position of next shape") + +(defconst tetris-score-x tetris-top-left-x + "X position of score") + +(defconst tetris-score-y (+ tetris-top-left-y tetris-height 2) + "Y position of score") + +(defconst tetris-blank 0) + +(defconst tetris-space ?\.) + +(defconst tetris-border ?\*) + +(defconst tetris-shapes + [[[[1 1 0 0] [1 1 0 0] [1 1 0 0] [1 1 0 0]] + [[1 1 0 0] [1 1 0 0] [1 1 0 0] [1 1 0 0]] + [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]] + [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] + + [[[2 2 2 0] [0 2 0 0] [2 0 0 0] [2 2 0 0]] + [[0 0 2 0] [0 2 0 0] [2 2 2 0] [2 0 0 0]] + [[0 0 0 0] [2 2 0 0] [0 0 0 0] [2 0 0 0]] + [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] + + [[[3 3 3 0] [3 3 0 0] [0 0 3 0] [3 0 0 0]] + [[3 0 0 0] [0 3 0 0] [3 3 3 0] [3 0 0 0]] + [[0 0 0 0] [0 3 0 0] [0 0 0 0] [3 3 0 0]] + [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] + + [[[4 4 0 0] [0 4 0 0] [4 4 0 0] [0 4 0 0]] + [[0 4 4 0] [4 4 0 0] [0 4 4 0] [4 4 0 0]] + [[0 0 0 0] [4 0 0 0] [0 0 0 0] [4 0 0 0]] + [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] + + [[[0 5 5 0] [5 0 0 0] [0 5 5 0] [5 0 0 0]] + [[5 5 0 0] [5 5 0 0] [5 5 0 0] [5 5 0 0]] + [[0 0 0 0] [0 5 0 0] [0 0 0 0] [0 5 0 0]] + [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] + + [[[0 6 0 0] [6 0 0 0] [6 6 6 0] [0 6 0 0]] + [[6 6 6 0] [6 6 0 0] [0 6 0 0] [6 6 0 0]] + [[0 0 0 0] [6 0 0 0] [0 0 0 0] [0 6 0 0]] + [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] + + [[[7 7 7 7] [7 0 0 0] [7 7 7 7] [7 0 0 0]] + [[0 0 0 0] [7 0 0 0] [0 0 0 0] [7 0 0 0]] + [[0 0 0 0] [7 0 0 0] [0 0 0 0] [7 0 0 0]] + [[0 0 0 0] [7 0 0 0] [0 0 0 0] [7 0 0 0]]]]) + +(defconst tetris-shape-dimensions + [[2 2] [3 2] [3 2] [3 2] [3 2] [3 2] [4 1]]) + +(defconst tetris-text-colors + ["black" "blue" "white" "yellow" + "magenta" "cyan" "green" "red"] + "Vector of colors of the various shapes in text mode +Element 0 is the background color") + +(defconst tetris-colors + [[0 0 0] [0 0 1] [0.7 0 1] [1 1 0] + [1 0 1] [0 1 1] [0 1 0] [1 0 0] + [0.5 0.5 0.5]] + "Vector of colors of the various shapes +Element 0 is the background color +Element 8 is the border color") + +(defconst tetris-xpm "\ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +\"16 16 3 1\", +/* colors */ +\"+ s col1\", +\". s col2\", +\"- s col3\", +/* pixels */ +\"---------------+\", +\"--------------++\", +\"--............++\", +\"--............++\", +\"--............++\", +\"--............++\", +\"--............++\", +\"--............++\", +\"--............++\", +\"--............++\", +\"--............++\", +\"--............++\", +\"--............++\", +\"--............++\", +\"-+++++++++++++++\", +\"++++++++++++++++\" +}; +" + "XPM format image used for each square") + +(defun tetris-default-update-speed-function (shapes rows) + (/ 20.0 (+ 50.0 rows))) + +;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar tetris-faces (make-vector 256 nil)) + +(defvar tetris-buffer-start 1) + +(defvar tetris-display-mode nil) + +(defvar tetris-shape 0) +(defvar tetris-rot 0) +(defvar tetris-next-shape 0) +(defvar tetris-n-shapes 0) +(defvar tetris-n-rows 0) +(defvar tetris-pos-x 0) +(defvar tetris-pos-y 0) + +(defvar tetris-timer nil) + +(defvar tetris-display-table nil) + +;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar tetris-mode-map + (make-sparse-keymap 'tetris-mode-map)) + +(define-key tetris-mode-map "n" 'tetris-start-game) +(define-key tetris-mode-map "q" 'tetris-end-game) + +(define-key tetris-mode-map " " 'tetris-move-bottom) +(define-key tetris-mode-map [left] 'tetris-move-left) +(define-key tetris-mode-map [right] 'tetris-move-right) +(define-key tetris-mode-map [up] 'tetris-rotate-prev) +(define-key tetris-mode-map [down] 'tetris-rotate-next) + +(defvar tetris-null-map + (make-sparse-keymap 'tetris-null-map)) + +(define-key tetris-null-map "n" 'tetris-start-game) + +;; ;;;;;;;;;;;;;;;; timer functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun tetris-start-timer (period) + (setq tetris-timer + (if (featurep 'itimer) + (start-itimer + "Tetris" + 'tetris-update-game period period + nil t (current-buffer)) + (run-with-timer + period period + 'tetris-update-game (current-buffer))))) + +(defun tetris-set-timer (delay) + (if tetris-timer + (if (featurep 'itimer) + (set-itimer-restart tetris-timer delay) + (timer-set-time tetris-timer + (list (aref tetris-timer 1) + (aref tetris-timer 2) + (aref tetris-timer 3)) + delay)))) + +(defun tetris-kill-timer () + (if tetris-timer + (if (featurep 'itimer) + (delete-itimer tetris-timer) + (timer-set-time tetris-timer '(0 0 0) nil))) + (setq tetris-timer nil)) + +;; ;;;;;;;;;;;;; display functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun tetris-color (col shade) + (let* ((vec (aref tetris-colors col)) + (v (floor (* shade 255))) + (r (* v (aref vec 0))) + (g (* v (aref vec 1))) + (b (* v (aref vec 2)))) + (format "#%02x%02x%02x" r g b))) + +(defun tetris-set-font (face) + (if tetris-font + (condition-case nil + (set-face-font face tetris-font) + ('error nil)))) + +(defun tetris-setup-face (face color) + (set-face-foreground face color) + (set-face-background face color) + (tetris-set-font face) + (condition-case nil + (set-face-background-pixmap face [nothing]) ;; XEmacs + ('error nil)) + (condition-case nil + (set-face-background-pixmap face nil) ;; Emacs + ('error nil))) + +(defun tetris-make-mono-tty-face () + (let ((face (make-face 'tetris-mono-tty-face))) + (condition-case nil + (set-face-property face 'reverse t) + ('error nil)) + face)) + +(defun tetris-make-color-tty-face (c) + (let* ((name (intern (format "tetris-color-tty-face-%d" c))) + (face (make-face name))) + (tetris-setup-face face (aref tetris-text-colors c)) + face)) + +(defun tetris-make-x-border-face () + (let ((face (make-face 'tetris-x-border-face))) + (tetris-set-font face) + face)) + +(defun tetris-make-mono-x-face () + (let ((face (make-face 'tetris-mono-x-face)) + (color (face-foreground 'default))) + (if (null color) + (setq color + (cdr-safe (assq 'foreground-color (frame-parameters))))) + (tetris-setup-face face color) + face)) + +(defun tetris-make-color-x-face (c) + (let* ((name (intern (format "tetris-color-x-face-%d" c))) + (face (make-face name))) + (tetris-setup-face face (tetris-color c 1.0)) + face)) + +(defun tetris-make-mono-tty-faces () + (let ((face (tetris-make-mono-tty-face))) + (loop for c from 0 to 255 do + (aset tetris-faces c + (cond + ((or (= c 0) (> c 7)) + 'default) + (t + face)))))) + +(defun tetris-make-color-tty-faces () + (loop for c from 0 to 255 do + (aset tetris-faces c + (cond + ((> c 7) + 'default) + (t + (tetris-make-color-tty-face c)))))) + +(defun tetris-make-mono-x-faces () + (let ((face (tetris-make-mono-x-face)) + (face2 (tetris-make-x-border-face))) + (loop for c from 0 to 255 do + (aset tetris-faces c + (cond + ((or (= c 0) (= c tetris-border)) + face2) + ((> c 7) + 'default) + (t + face)))))) + +(defun tetris-make-color-x-faces () + (loop for c from 0 to 255 do + (aset tetris-faces c + (cond + ((= c tetris-border) + (tetris-make-x-border-face)) + ((> c 7) + 'default) + (t + (tetris-make-color-x-face c)))))) + +(defun tetris-make-glyph (index) + (make-glyph + (vector + 'xpm + :data tetris-xpm + :color-symbols (list + (cons "col1" (tetris-color index 0.6)) + (cons "col2" (tetris-color index 0.8)) + (cons "col3" (tetris-color index 1.0)))))) + +(defun tetris-make-display-table () + (setq tetris-display-table (make-display-table)) + (aset tetris-display-table tetris-space tetris-space-char) + (case tetris-display-mode + ('glyph + (aset tetris-display-table tetris-border (tetris-make-glyph 8)) + (aset tetris-display-table tetris-blank (tetris-make-glyph 0))) + (otherwise + (aset tetris-display-table tetris-border tetris-border-char) + (aset tetris-display-table tetris-blank tetris-space-char))) + (loop for i from 1 to 7 do + (aset tetris-display-table + (+ tetris-blank i) + (case tetris-display-mode + ('glyph + (tetris-make-glyph i)) + ('emacs-tty + tetris-emacs-block-char) + (otherwise + tetris-block-char))))) + +(defun tetris-color-display-p () + (if (fboundp 'device-class) + (eq (device-class (selected-device)) 'color) + (eq (cdr-safe (assq 'display-type (frame-parameters))) 'color))) + +(defun tetris-display-type () + (cond ((and tetris-use-glyphs (eq window-system 'x) (featurep 'xpm)) + 'glyph) + ((and tetris-use-color (eq window-system 'x) (tetris-color-display-p)) + 'color-x) + ((eq window-system 'x) + 'mono-x) + ((and tetris-use-color (tetris-color-display-p)) + 'color-tty) + (t + (if (fboundp 'set-face-property) + 'mono-tty + 'emacs-tty)))) + +(defun tetris-initialize-display () + (setq tetris-display-mode (tetris-display-type)) + (tetris-make-display-table) + (case tetris-display-mode + ('mono-tty + (tetris-make-mono-tty-faces)) + ('color-tty + (tetris-make-color-tty-faces)) + ('mono-x + (tetris-make-mono-x-faces)) + ('color-x + (tetris-make-color-x-faces)))) + +(defun tetris-set-display-table () + (if (fboundp 'specifierp) + (add-spec-to-specifier current-display-table + tetris-display-table + (current-buffer) + nil 'remove-locale) + (setq buffer-display-table tetris-display-table))) + +(defun tetris-hide-cursor () + (if (fboundp 'specifierp) + (set-specifier text-cursor-visible-p nil (current-buffer)))) + +(defun tetris-draw-border-p () + (or (not (eq tetris-display-mode 'glyph)) + tetris-draw-border-with-glyphs)) + +(defun tetris-set-color (c) + (unless (eq tetris-display-mode 'glyph) + (put-text-property + (1- (point)) (point) 'face (aref tetris-faces c)))) + +;; ;;;;;;;;;;;;;;;; game functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun tetris-get-tick-period () + (if (boundp 'tetris-update-speed-function) + (let ((period (apply tetris-update-speed-function + tetris-n-shapes + tetris-n-rows nil))) + (and (numberp period) period)))) + +(defun tetris-cell-offset (x y) + (+ tetris-buffer-start + (* (1+ tetris-buffer-width) y) + x)) + +(defun tetris-get-cell (x y) + (char-after (tetris-cell-offset x y))) + +(defun tetris-set-cell (x y c) + (save-excursion + (let ((buffer-read-only nil)) + (goto-char (tetris-cell-offset x y)) + (delete-char 1) + (insert-char c 1) + (tetris-set-color c)))) + +(defun tetris-get-shape-cell (x y) + (aref + (aref + (aref + (aref tetris-shapes tetris-shape) + y) + tetris-rot) + x)) + +(defun tetris-shape-width () + (aref (aref tetris-shape-dimensions tetris-shape) + (% tetris-rot 2))) + +(defun tetris-shape-height () + (aref (aref tetris-shape-dimensions tetris-shape) + (- 1 (% tetris-rot 2)))) + +(defun tetris-draw-score () + (let ((strings (vector + (format "Shapes: %05d" tetris-n-shapes) + (format "Rows: %05d" tetris-n-rows)))) + (loop for y from 0 to 1 do + (let* ((string (aref strings y)) + (len (length string))) + (loop for x from 0 to (1- len) do + (tetris-set-cell + (+ tetris-score-x x) + (+ tetris-score-y y) + (aref string x))))))) + +(defun tetris-update-score () + (tetris-draw-score) + (let ((period (tetris-get-tick-period))) + (if period (tetris-set-timer period)))) + +(defun tetris-new-shape () + (setq tetris-shape tetris-next-shape) + (setq tetris-rot 0) + (setq tetris-next-shape (random 7)) + (setq tetris-pos-x (random (- tetris-width (tetris-shape-width)))) + (setq tetris-pos-y 0) + (setq tetris-n-shapes (1+ tetris-n-shapes)) + (tetris-draw-next-shape) + (tetris-update-score)) + +(defun tetris-draw-next-shape () + (loop for y from 0 to 3 do + (loop for x from 0 to 3 do + (tetris-set-cell + (+ tetris-next-x x) + (+ tetris-next-y y) + (let ((tetris-shape tetris-next-shape) + (tetris-rot 0)) + (tetris-get-shape-cell x y)))))) + +(defun tetris-draw-shape () + (loop for y from 0 to (1- (tetris-shape-height)) do + (loop for x from 0 to (1- (tetris-shape-width)) do + (let ((c (tetris-get-shape-cell x y))) + (if (/= c tetris-blank) + (tetris-set-cell + (+ tetris-top-left-x tetris-pos-x x) + (+ tetris-top-left-y tetris-pos-y y) + c)))))) + +(defun tetris-erase-shape () + (loop for y from 0 to (1- (tetris-shape-height)) do + (loop for x from 0 to (1- (tetris-shape-width)) do + (let ((c (tetris-get-shape-cell x y))) + (if (/= c tetris-blank) + (tetris-set-cell + (+ tetris-top-left-x tetris-pos-x x) + (+ tetris-top-left-y tetris-pos-y y) + tetris-blank)))))) + +(defun tetris-test-shape () + (let ((hit nil)) + (loop for y from 0 to (1- (tetris-shape-height)) do + (loop for x from 0 to (1- (tetris-shape-width)) do + (unless hit + (setq hit + (let ((c (tetris-get-shape-cell x y)) + (xx (+ tetris-pos-x x)) + (yy (+ tetris-pos-y y))) + (and (/= c tetris-blank) + (or (>= xx tetris-width) + (>= yy tetris-height) + (/= (tetris-get-cell + (+ tetris-top-left-x xx) + (+ tetris-top-left-y yy)) + tetris-blank)))))))) + hit)) + +(defun tetris-full-row (y) + (let ((full t)) + (loop for x from 0 to (1- tetris-width) do + (if (= (tetris-get-cell + (+ tetris-top-left-x x) + (+ tetris-top-left-y y)) + tetris-blank) + (setq full nil))) + full)) + +(defun tetris-shift-row (y) + (loop for x from 0 to (1- tetris-width) do + (let ((c (tetris-get-cell + (+ tetris-top-left-x x) + (+ tetris-top-left-y y -1)))) + (tetris-set-cell + (+ tetris-top-left-x x) + (+ tetris-top-left-y y) + c)))) + +(defun tetris-shift-down () + (loop for y0 from (1- tetris-height) downto 0 do + (if (tetris-full-row y0) + (progn + (setq tetris-n-rows (1+ tetris-n-rows)) + (tetris-update-score) + (loop for y from y0 downto 1 do + (tetris-shift-row y)))))) + +(defun tetris-init-buffer () + (let ((line (concat + (make-string tetris-buffer-width tetris-space) + "\n")) + (buffer-read-only nil)) + (erase-buffer) + (setq tetris-buffer-start (point)) + (dotimes (i tetris-buffer-height) + (insert-string line)) + (if (tetris-draw-border-p) + (loop for y from -1 to tetris-height do + (loop for x from -1 to tetris-width do + (tetris-set-cell + (+ tetris-top-left-x x) + (+ tetris-top-left-y y) + tetris-border)))) + (loop for y from 0 to (1- tetris-height) do + (loop for x from 0 to (1- tetris-width) do + (tetris-set-cell + (+ tetris-top-left-x x) + (+ tetris-top-left-y y) + tetris-blank))) + (if (tetris-draw-border-p) + (loop for y from -1 to 4 do + (loop for x from -1 to 4 do + (tetris-set-cell + (+ tetris-next-x x) + (+ tetris-next-y y) + tetris-border)))))) + +(defun tetris-reset-game () + (tetris-kill-timer) + (tetris-init-buffer) + (setq tetris-next-shape (random 7)) + (setq tetris-shape 0 + tetris-rot 0 + tetris-n-shapes 0 + tetris-n-rows 0 + tetris-pos-x 0 + tetris-pos-y 0) + (tetris-new-shape) + (tetris-draw-shape)) + +(defun tetris-shape-done () + (tetris-shift-down) + (tetris-new-shape) + (if (tetris-test-shape) + (progn + (tetris-end-game)) + (tetris-draw-shape))) + +(defun tetris-update-game (tetris-buffer) + "Called on each clock tick. +Drops the shape one square, testing for collision." + (if (eq (current-buffer) tetris-buffer) + (let (hit) + (tetris-erase-shape) + (setq tetris-pos-y (1+ tetris-pos-y)) + (setq hit (tetris-test-shape)) + (if hit + (setq tetris-pos-y (1- tetris-pos-y))) + (tetris-draw-shape) + (if hit + (tetris-shape-done))))) + +(defun tetris-move-bottom () + "Drops the shape to the bottom of the playing area" + (interactive) + (let ((hit nil)) + (tetris-erase-shape) + (while (not hit) + (setq tetris-pos-y (1+ tetris-pos-y)) + (setq hit (tetris-test-shape))) + (setq tetris-pos-y (1- tetris-pos-y)) + (tetris-draw-shape) + (tetris-shape-done))) + +(defun tetris-move-left () + "Moves the shape one square to the left" + (interactive) + (unless (= tetris-pos-x 0) + (tetris-erase-shape) + (setq tetris-pos-x (1- tetris-pos-x)) + (if (tetris-test-shape) + (setq tetris-pos-x (1+ tetris-pos-x))) + (tetris-draw-shape))) + +(defun tetris-move-right () + "Moves the shape one square to the right" + (interactive) + (unless (= (+ tetris-pos-x (tetris-shape-width)) + tetris-width) + (tetris-erase-shape) + (setq tetris-pos-x (1+ tetris-pos-x)) + (if (tetris-test-shape) + (setq tetris-pos-x (1- tetris-pos-x))) + (tetris-draw-shape))) + +(defun tetris-rotate-prev () + "Rotates the shape clockwise" + (interactive) + (tetris-erase-shape) + (setq tetris-rot (% (+ 1 tetris-rot) 4)) + (if (tetris-test-shape) + (setq tetris-rot (% (+ 3 tetris-rot) 4))) + (tetris-draw-shape)) + +(defun tetris-rotate-next () + "Rotates the shape anticlockwise" + (interactive) + (tetris-erase-shape) + (setq tetris-rot (% (+ 3 tetris-rot) 4)) + (if (tetris-test-shape) + (setq tetris-rot (% (+ 1 tetris-rot) 4))) + (tetris-draw-shape)) + +(defun tetris-end-game () + "Terminates the current game" + (interactive) + (tetris-kill-timer) + (use-local-map tetris-null-map)) + +(defun tetris-start-game () + "Starts a new game of Tetris" + (interactive) + (tetris-reset-game) + (use-local-map tetris-mode-map) + (let ((period (or (tetris-get-tick-period) + tetris-default-tick-period))) + (tetris-start-timer period))) + +(put 'tetris-mode 'mode-class 'special) + +(defun tetris-mode () + "A mode for playing Tetris. + +tetris-mode keybindings: + \\{tetris-mode-map} +" + (kill-all-local-variables) + + (make-local-hook 'kill-buffer-hook) + (add-hook 'kill-buffer-hook 'tetris-end-game nil t) + + (make-local-variable 'tetris-display-mode) + (make-local-variable 'tetris-display-table) + (make-local-variable 'tetris-faces) + (make-local-variable 'tetris-timer) + (make-local-variable 'tetris-buffer-start) + (make-local-variable 'tetris-shape) + (make-local-variable 'tetris-rot) + (make-local-variable 'tetris-next-shape) + (make-local-variable 'tetris-n-shapes) + (make-local-variable 'tetris-n-rows) + (make-local-variable 'tetris-pos-x) + (make-local-variable 'tetris-pos-y) + + (use-local-map tetris-null-map) + + (setq buffer-read-only t) + (setq truncate-lines 't) + (setq major-mode 'tetris-mode) + (setq mode-name "Tetris") + + (buffer-disable-undo (current-buffer)) + + (tetris-initialize-display) + (tetris-set-display-table) + (tetris-hide-cursor) + + (run-hooks 'tetris-mode-hook)) + +(defun tetris () + "Tetris + +Shapes drop from the top of the screen, and the user has to move and +rotate the shape to fit in with those at the bottom of the screen so +as to form complete rows. + +tetris-mode keybindings: + \\<tetris-mode-map> +\\[tetris-start-game] Starts a new game of Tetris +\\[tetris-end-game] Terminates the current game +\\[tetris-move-left] Moves the shape one square to the left +\\[tetris-move-right] Moves the shape one square to the right +\\[tetris-rotate-prev] Rotates the shape clockwise +\\[tetris-rotate-next] Rotates the shape anticlockwise +\\[tetris-move-bottom] Drops the shape to the bottom of the playing area + +" + (interactive) + + (switch-to-buffer tetris-buffer-name) + (tetris-kill-timer) + (tetris-mode) + (tetris-start-game)) + +(provide 'tetris) + +;;; tetris.el ends here +
--- a/lisp/modes/auto-autoloads.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/modes/auto-autoloads.el Mon Aug 13 09:55:28 2007 +0200 @@ -569,7 +569,7 @@ ;;;### (autoloads (ksh-mode) "ksh-mode" "modes/ksh-mode.el") (autoload 'ksh-mode "ksh-mode" "\ -ksh-mode $Revision: 1.8 $ - Major mode for editing (Bourne, Korn or Bourne again) +ksh-mode $Revision: 1.9 $ - Major mode for editing (Bourne, Korn or Bourne again) shell scripts. Special key bindings and commands: \\{ksh-mode-map} @@ -1558,7 +1558,7 @@ ;;;*** -;;;### (autoloads (strokes-mode strokes-list-strokes strokes-edit-strokes strokes-load-user-strokes strokes-help strokes-describe-stroke strokes-do-complex-stroke strokes-do-stroke strokes-read-complex-stroke strokes-read-stroke strokes-global-set-stroke) "strokes" "modes/strokes.el") +;;;### (autoloads (strokes-compose-complex-stroke strokes-decode-buffer strokes-mode strokes-list-strokes strokes-load-user-strokes strokes-help strokes-describe-stroke strokes-do-complex-stroke strokes-do-stroke strokes-read-stroke strokes-global-set-stroke) "strokes" "modes/strokes.el") (defvar strokes-mode nil "\ Non-nil when `strokes' is globally enabled") @@ -1578,18 +1578,10 @@ This function will display the stroke interactively as it is being entered in the strokes buffer if the variable `strokes-use-strokes-buffer' is non-nil. -Optional EVENT is currently not used, but hopefully will be soon." nil nil) - -(autoload 'strokes-read-complex-stroke "strokes" "\ -Read a complex stroke (interactively) and return the stroke. -Optional PROMPT in minibuffer displays before and during stroke reading. -Note that a complex stroke allows the user to pen-up and pen-down. This -is implemented by allowing the user to paint with button1 or button2 and -then complete the stroke with button3. -Optional EVENT is currently not used, but hopefully will be soon." nil nil) +Optional EVENT is acceptable as the starting event of the stroke" nil nil) (autoload 'strokes-do-stroke "strokes" "\ -Read a simple stroke from the user and then exectute its comand. +Read a simple stroke from the user and then exectute its command. This must be bound to a mouse event." t nil) (autoload 'strokes-do-complex-stroke "strokes" "\ @@ -1609,16 +1601,6 @@ (defalias 'load-user-strokes 'strokes-load-user-strokes) -(autoload 'strokes-edit-strokes "strokes" "\ -Edit strokes in a pop-up buffer containing strokes and their definitions. -If STROKES-MAP is not given, `strokes-global-map' will be used instead. - -Editing commands: - -\\{edit-faces-mode-map}" t nil) - -(defalias 'edit-strokes 'strokes-edit-strokes) - (autoload 'strokes-list-strokes "strokes" "\ Pop up a buffer containing an alphabetical listing of strokes in STROKES-MAP. With CHRONOLOGICAL prefix arg (\\[universal-argument]) list strokes @@ -1635,7 +1617,22 @@ By default, strokes are invoked with mouse button-2. You can define new strokes with -> M-x global-set-stroke" t nil) +> M-x global-set-stroke + +To use strokes for pictographic editing, such as Chinese/Japanese, use +Sh-button-2, which draws strokes and inserts them. Encode/decode your +strokes with + +> M-x strokes-encode-buffer +> M-x strokes-decode-buffer" t nil) + +(autoload 'strokes-decode-buffer "strokes" "\ +Decode stroke strings in BUFFER and display their corresponding glyphs. +Optional BUFFER defaults to the current buffer. +Optional FORCE non-nil will ignore the buffer's read-only status." t nil) + +(autoload 'strokes-compose-complex-stroke "strokes" "\ +Read a complex stroke and insert its glyph into the current buffer." t nil) ;;;*** @@ -1938,7 +1935,7 @@ (autoload 'vhdl-mode "vhdl-mode" "\ Major mode for editing VHDL code. -vhdl-mode $Revision: 1.8 $ +vhdl-mode $Revision: 1.9 $ To submit a problem report, enter `\\[vhdl-submit-bug-report]' from a vhdl-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the
--- a/lisp/modes/custom-load.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/modes/custom-load.el Mon Aug 13 09:55:28 2007 +0200 @@ -1,31 +1,31 @@ -(custom-put 'asm 'custom-loads '("asm-mode")) -(custom-put 'auto-show 'custom-loads '("auto-show")) -(custom-put 'lisp-indent 'custom-loads '("cl-indent")) -(custom-put 'c-macro 'custom-loads '("cmacexp")) -(custom-put 'enriched 'custom-loads '("enriched")) -(custom-put 'executable 'custom-loads '("executable")) -(custom-put 'f90 'custom-loads '("f90")) -(custom-put 'f90-indent 'custom-loads '("f90")) -(custom-put 'fortran 'custom-loads '("f90" "fortran")) -(custom-put 'fortran-indent 'custom-loads '("fortran")) -(custom-put 'fortran-comment 'custom-loads '("fortran")) -(custom-put 'icon 'custom-loads '("icon")) -(custom-put 'mail-abbrevs 'custom-loads '("mail-abbrevs")) -(custom-put 'makefile-mode 'custom-loads '("make-mode")) -(custom-put 'outl-mouse 'custom-loads '("outl-mouse")) +(custom-put 'xrdb 'custom-loads '("xrdb-mode")) +(custom-put 'winmgr 'custom-loads '("winmgr-mode")) +(custom-put 'whitespace 'custom-loads '("whitespace-mode")) +(custom-put 'vrml 'custom-loads '("vrml-mode")) +(custom-put 'verilog 'custom-loads '("verilog-mode")) +(custom-put 'texinfo 'custom-loads '("texinfo")) +(custom-put 'tcl 'custom-loads '("tcl")) +(custom-put 'strokes 'custom-loads '("strokes")) +(custom-put 'sh-script 'custom-loads '("sh-script")) +(custom-put 'sh 'custom-loads '("sh-script")) +(custom-put 'resize-minibuffer 'custom-loads '("rsz-minibuf")) +(custom-put 'rexx 'custom-loads '("rexx-mode")) +(custom-put 'reftex-label-support 'custom-loads '("reftex")) +(custom-put 'reftex 'custom-loads '("reftex")) +(custom-put 'prolog 'custom-loads '("prolog")) (custom-put 'pascal 'custom-loads '("pascal")) -(custom-put 'prolog 'custom-loads '("prolog")) -(custom-put 'reftex 'custom-loads '("reftex")) -(custom-put 'reftex-label-support 'custom-loads '("reftex")) -(custom-put 'rexx 'custom-loads '("rexx-mode")) -(custom-put 'resize-minibuffer 'custom-loads '("rsz-minibuf")) -(custom-put 'sh 'custom-loads '("sh-script")) -(custom-put 'sh-script 'custom-loads '("sh-script")) -(custom-put 'strokes 'custom-loads '("strokes")) -(custom-put 'tcl 'custom-loads '("tcl")) -(custom-put 'texinfo 'custom-loads '("texinfo")) -(custom-put 'verilog 'custom-loads '("verilog-mode")) -(custom-put 'vrml 'custom-loads '("vrml-mode")) -(custom-put 'whitespace 'custom-loads '("whitespace-mode")) -(custom-put 'winmgr 'custom-loads '("winmgr-mode")) -(custom-put 'xrdb 'custom-loads '("xrdb-mode")) +(custom-put 'outl-mouse 'custom-loads '("outl-mouse")) +(custom-put 'makefile-mode 'custom-loads '("make-mode")) +(custom-put 'mail-abbrevs 'custom-loads '("mail-abbrevs")) +(custom-put 'icon 'custom-loads '("icon")) +(custom-put 'fortran-comment 'custom-loads '("fortran")) +(custom-put 'fortran-indent 'custom-loads '("fortran")) +(custom-put 'fortran 'custom-loads '("f90" "fortran")) +(custom-put 'f90-indent 'custom-loads '("f90")) +(custom-put 'f90 'custom-loads '("f90")) +(custom-put 'executable 'custom-loads '("executable")) +(custom-put 'enriched 'custom-loads '("enriched")) +(custom-put 'c-macro 'custom-loads '("cmacexp")) +(custom-put 'lisp-indent 'custom-loads '("cl-indent")) +(custom-put 'auto-show 'custom-loads '("auto-show")) +(custom-put 'asm 'custom-loads '("asm-mode"))
--- a/lisp/modes/strokes.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/modes/strokes.el Mon Aug 13 09:55:28 2007 +0200 @@ -1,11 +1,11 @@ ;;; strokes.el -- Control XEmacs through mouse strokes -- -;; Mon Jun 2 12:40:41 EDT 1997 +;; Mon Jul 25 12:40:41 EDT 1997 ;; Copyright (C) 1997 Free Software Foundation, Inc. ;; Author: David Bakhash <cadet@mit.edu> ;; Maintainer: David Bakhash <cadet@mit.edu> -;; Version: 2.3 +;; Version: 2.4-beta ;; Created: 12 April 1997 ;; Keywords: lisp, mouse, extensions @@ -30,21 +30,21 @@ ;;; Commentary: -;; This package is written for for XEmacs v19.14 and up. -;; This is the strokes package. It is intended to allow the user to -;; control XEmacs by means of mouse strokes. Once strokes is loaded, you -;; can always get help be invoking `strokes-help': +;; This package is written for for XEmacs v19.15 and up. This is the +;; strokes package. It is intended to allow the user to control +;; XEmacs by means of mouse strokes. Once strokes is loaded, you can +;; always get help be invoking `strokes-help': ;; > M-x strokes-help ;; and you can learn how to use the package. A mouse stroke, for now, ;; can be defined as holding the middle button, for instance, and then ;; moving the mouse in whatever pattern you wish, which you have set -;; XEmacs to understand as mapping to a given command. For example, you -;; may wish the have a mouse stroke that looks like a capital `C' which -;; means `copy-region-as-kill'. Treat strokes just like you do key -;; bindings. For example, XEmacs sets key bindings globally with the -;; `global-set-key' command. Likewise, you can do +;; XEmacs to understand as mapping to a given command. For example, +;; you may wish the have a mouse stroke that looks like a capital `C' +;; which means `copy-region-as-kill'. Treat strokes just like you do +;; key bindings. For example, XEmacs sets key bindings globally with +;; the `global-set-key' command. Likewise, you can do ;; > M-x global-set-stroke @@ -66,10 +66,11 @@ ;; > M-x describe-stroke -;; analogous to `describe-key'. It's also wise to have a stroke, -;; like an `h', for help, or a `?', mapped to `describe-stroke'. +;; analogous to `describe-key'. It's also wise to have a +;; stroke, like an `h', for help, or a `?', mapped to +;; `describe-stroke'. -;; 2) stroke bindings are set internally through the lisp function +;; 2) stroke bindings are set internally through the Lisp function ;; `define-stroke', similar to the `define-key' function. some ;; examples for a 3x3 stroke grid would be @@ -80,11 +81,12 @@ ;; '((0 . 0) (0 . 1) (0 . 2) (1 . 2) (2 . 2)) ;; 'list-buffers) -;; however, if you would probably just have the user enter in the -;; stroke interactively and then set the stroke to whatever he/she -;; entered. The lisp function to interactively read a stroke is -;; `strokes-read-stroke'. This is especially helpful when you're -;; on a fast computer that can handle a 9x9 stroke grid. +;; however, if you would probably just have the user enter in +;; the stroke interactively and then set the stroke to whatever +;; he/she entered. The Lisp function to interactively read a +;; stroke is `strokes-read-stroke'. This is especially helpful +;; when you're on a fast computer that can handle a 9x9 stroke +;; grid. ;; NOTE: only global stroke bindings are currently implemented, ;; however mode- and buffer-local stroke bindings may eventually @@ -98,15 +100,16 @@ ;; and customizing the group named `strokes'. You can also read ;; documentation on the variables there. -;; `strokes-minimum-match-score' (determines the threshold of error that -;; makes a stroke acceptable or unacceptable. If your strokes arn't -;; matching, then you should raise this variable. +;; `strokes-minimum-match-score' (determines the threshold of error +;; that makes a stroke acceptable or unacceptable. If your strokes +;; aren't matching, then you should raise this variable. -;; `strokes-grid-resolution' (determines the grid dimensions that you use -;; when defining/reading strokes. The finer the grid your computer can -;; handle, the more you can do, but even a 3x3 grid is pretty cool.) -;; The default value (7) should be fine for most decent computers. -;; NOTE: This variable should not be set to a number less than 3. +;; `strokes-grid-resolution' (determines the grid dimensions that you +;; use when defining/reading strokes. The finer the grid your +;; computer can handle, the more you can do, but even a 3x3 grid is +;; pretty cool.) The default value (7) should be fine for most decent +;; computers. NOTE: This variable should not be set to a number less +;; than 3. ;; `strokes-display-strokes-buffer' will allow you to hide the strokes ;; buffer when doing simple strokes. This is a speedup for slow @@ -124,141 +127,205 @@ ;; > M-x save-strokes -;; and it will save your strokes in ~/.strokes, or you may wish to change -;; this by setting the variable `strokes-file'. +;; and it will save your strokes in ~/.strokes, or you may wish to +;; change this by setting the variable `strokes-file'. ;; Note that internally, all of the routines that are part of this -;; package are able to deal with complex strokes, as they are a superset -;; of simple strokes. However, the default of this package will map -;; mouse button2 to the command `strokes-do-stroke', and NOT -;; `strokes-do-complex-stroke'. If you wish to use complex strokes, you -;; will have to override this key mapping. Complex strokes are terminated -;; with mouse button3. The strokes package will not interfere with -;; `mouse-yank', but you may want to examine how this is done (see the -;; variable `strokes-click-command') +;; package are able to deal with complex strokes, as they are a +;; superset of simple strokes. However, the default of this package +;; will map mouse button2 to the command `strokes-do-stroke', and NOT +;; `strokes-do-complex-stroke'. If you wish to use complex strokes, +;; you will have to override this key mapping. Complex strokes are +;; terminated with mouse button3. The strokes package will not +;; interfere with `mouse-yank', but you may want to examine how this +;; is done (see the variable `strokes-click-command') ;; To get strokes to work as part of your your setup, then you'll have -;; put the strokes package in your load-path (preferably byte-compiled) -;; and then add the following to your .xemacs-options file (or wherever -;; you put XEmacs-specific startup preferences): +;; put the strokes package in your load-path (preferably +;; byte-compiled) and then add the following to your .emacs file (or +;; wherever you put XEmacs-specific startup preferences): -;;(and (fboundp 'device-on-window-system-p) -;; (device-on-window-system-p) -;; (require 'strokes)) +;; (if window-system (require 'strokes)) ;; Once loaded, you can start stroking. You can also toggle between ;; strokes mode by simple typing ;; > M-x strokes-mode -;; I am now in the process of porting this package to emacs. I also hope -;; that, with the help of others, this package will be useful in entering -;; in pictographic-like language text using the mouse (i.e. Korean). -;; Japanese and Chinese are a bit trickier, but I'm sure that with help -;; it can be done. The next version will allow the user to enter strokes -;; which "remove the pencil from the paper" so to speak, so one character -;; can have multiple strokes. +;; I am now in the process of porting this package to Emacs. I also +;; hope that, with the help of others, this package will be useful in +;; entering in pictographic-like language text using the mouse +;; (i.e. Korean). Japanese and Chinese are a bit trickier, but I'm +;; sure that with help it can be done. The next version will allow +;; the user to enter strokes which "remove the pencil from the paper" +;; so to speak, so one character can have multiple strokes. ;; You can read more about strokes at: -;; http://www.mit.edu/people/cadet/strokes-help.html +;; http://www.mit.edu/people/cadet/strokes-help.html -;; If you're interested in using strokes for writing English into XEmacs -;; using strokes, then you'll want to read about it on the web page above -;; or just download from http://www.mit.edu/people/cadet/strokes-abc.el, -;; which is nothing but a file with some helper commands for inserting -;; alphanumerics and punctuation. +;; If you're interested in using strokes for writing English into +;; XEmacs using strokes, then you'll want to read about it on the web +;; page above or just download from +;; http://www.mit.edu/people/cadet/strokes-abc.el, which is nothing +;; but a file with some helper commands for inserting alphanumerics +;; and punctuation. -;; Great thanks to Rob Ristroph for his generosity in letting me use his -;; PC to develop this, Jason Johnson for his help in algorithms, Euna -;; Kim for her help in Korean, and massive thanks to the helpful guys -;; on the help instance on athena (zeno, jered, amu, gsstark, ghudson, etc) -;; Special thanks to Steve Baur and Hrvoje Niksic for all their help. -;; And even more thanks to Dave Gillespie for all the elisp help--he -;; is responsible for helping me use the cl macros at (near) max speed. +;; Great thanks to Rob Ristroph for his generosity in letting me use +;; his PC to develop this, Jason Johnson for his help in algorithms, +;; Euna Kim for her help in Korean, and massive thanks to the helpful +;; guys on the help instance on athena (zeno, jered, amu, gsstark, +;; ghudson, etc) Special thanks to Steve Baur, Kyle Jones, and Hrvoje +;; Niksic for all their help. And special thanks to Dave Gillespie +;; for all the elisp help--he is responsible for helping me use the cl +;; macros at (near) max speed. ;; Tasks: (what I'm getting ready for future version)... ;; 2) use 'strokes-read-complex-stroke for korean, etc. ;; 4) buffer-local 'strokes-local-map, and mode-stroke-maps would be nice -;; 5) 'list-strokes (kinda important). What do people want? -;; How about an optional docstring for each stroke so that a person -;; can examine the strokes-file and actually make sense of it? -;; (e.g. "This stroke is a pentagram") ;; 6) add some hooks, like `strokes-read-stroke-hook' ;; 7) See what people think of the factory settings. Should I change ;; them? They're all pretty arbitrary in a way. I guess they ;; should be minimal, but computers are getting lots faster, and ;; if I choose the defaults too conservatively, then strokes will -;; surely dissapoint some people on decent machines (until they +;; surely disappoint some people on decent machines (until they ;; figure out M-x customize). I need feedback. ;; Other: I always have the most beta version of strokes, so if you ;; want it just let me know. ;;; Change Log: -;; 1.3: provided user variable `strokes-use-strokes-buffer' to let users -;; hide the strokes and strokes buffer when entering simple strokes. +;; 1.3: provided user variable `strokes-use-strokes-buffer' to let +;; users hide the strokes and strokes buffer when entering simple +;; strokes. ;; 1.3: cleaned up most leaks. ;; 1.3: with Jari Aalto's help, cleaned up overall program. ;; 1.3: added `strokes-help' for help on strokes ;; 1.3: fixed 'strokes-load-hook bug ;; 1.3: email address change: now <cadet@mit.edu> -;; 1.3: added `strokes-report-bug' based on efs/dired's `dired-report-bug' +;; 1.3: added `strokes-report-bug' based on efs/dired's +;; `dired-report-bug' ;; 1.3: added more dialog-box queries for mouse-event stuff. ;; 1.4: allowed strokes to invoke kbd macros as well (thanks gsstark!) ;; 2.0: fixed up ordering of certain functions. -;; 2.0: fixed bug applying to strokes in dedicated and minibuffer windows. +;; 2.0: fixed bug applying to strokes in dedicated and minibuffer +;; windows. ;; 2.0: punted the C-h way of invoking strokes help routines. ;; 2.0: fixed `strokes-define-stroke' so it would error check against -;; defining strokes that were too short (really clicks) -;; 2.0: added `strokes-toggle-strokes-buffer' interactive function -;; 2.0: added `customize' support, thanks to patch from Hrvoje (thanks) -;; 2.1: strokes no longer forces `mouse-yank-at-point' to t on mouse-yank -;; (i.e. `mouse-yank-at-point' is up to you again) +;; defining strokes that were too short (really clicks) 2.0: +;; added `strokes-toggle-strokes-buffer' interactive function +;; 2.0: added `customize' support, thanks to patch from Hrvoje +;; (thanks) +;; 2.1: strokes no longer forces `mouse-yank-at-point' to t on +;; mouse-yank (i.e. `mouse-yank-at-point' is up to you again) ;; 2.1: toggling strokes-mode off and then back on no longer deletes ;; the strokes that you programmed in but didn't save before ;; toggling off strokes-mode. -;; 2.1: advised may functions for modes like VM and w3 so that they too -;; can use strokes, while still mantaining old button2 functionality. -;; 2.1: with steve's help, got the autoload for `strokes-mode' and +;; 2.1: advised may functions for modes like VM and w3 so that they +;; too can use strokes, while still maintaining old button2 +;; functionality. +;; 2.1: with Steve's help, got the autoload for `strokes-mode' and ;; fixed up the package so loading it does not enable strokes ;; until user calls `strokes-mode'. ;; 2.2: made sure that abbrev-mode was off in the ` *strokes*' buffer ;; 2.2: added more dired advice for mouse permissions commands -;; 2.2: added some checks to see if saving strokes is really necessary so -;; the user doesn't get promped aimlessly. -;; 2.2: change the `strokes-lift' symbol to a keyword of value `:strokes-lift' -;; for legibility. IF YOUR OLD STROKES DON'T WORK, THIS IS PROBABLY WHY. -;; 2.2: I might have to change this back to `'strokes-lift' because the keyword -;; fails in emacs, though I don't know why. +;; 2.2: added some checks to see if saving strokes is really necessary +;; so the user doesn't get prompted aimlessly. +;; 2.2: change the `strokes-lift' symbol to a keyword of value +;; `:strokes-lift' for legibility. IF YOUR OLD STROKES DON'T +;; WORK, THIS IS PROBABLY WHY. +;; 2.2: I might have to change this back to `'strokes-lift' because +;; the keyword fails in emacs, though I don't know why. ;; 2.2: `strokes-describe-stroke' is nicer during recursive edits ;; 2.2: provided `strokes-fill-stroke' to fill in empty spaces of strokes ;; as an important step towards platform (speed) independence. -;; Because of this, I moved the global setting of `strokes-last-stroke' -;; from `strokes-eliminate-consecutive-redundancies' to -;; `strokes-fill-stroke' since the latter comes later in processing -;; a user stroke. +;; Because of this, I moved the global setting of +;; `strokes-last-stroke' from +;; `strokes-eliminate-consecutive-redundancies' to +;; `strokes-fill-stroke' since the latter comes later in +;; processing a user stroke. ;; 2.2: Finally changed the defaults, so now `strokes-grid-resolution' is 9 -;; and `strokes-minimum-match-score' is 1000 by default. This will surely -;; mess some people up, but if so, just set it back w/ M-x customize. -;; 2.2: Fixed up the mechanism for updating the `strokes-window-configuration'. -;; Now it only uses one function (`strokes-update-window-configuration') -;; which does it all, and much more efficiently (thanks RMS!). -;; 2.2 Fixed up the appearance of the *strokes* buffer so that there are no -;; ugly line truncations, and I got rid of the bug which would draw the stroke -;; on the wrong line. I still wish that `event-closest-point' was smarter. -;; In fact, `event-closest-point' does *not* do what its name suggests. -;; 2.3 Added more to `strokes-update-window-configuration' so it goes to hell less often -;; 2.3 `strokes-mode' no longer will undefine keys unless it's sure that the user had -;; had them mapped to a strokes command. -;; 2.3 added more magic autoload statements so strokes work more smoothly. -;; similarly, I made strokes-mode turn itself on when the user defines a stroke -;; (thanks Hrvoje). -;; 2.3 Added "Strokes" to the modeline when strokes is on, and allow toggling strokes -;; with mouse button2. -;; 2.3 Added `list-strokes', which is a really nice function which graphically lists -;; all the strokes that the user has defined and their corresponding commands. -;; `list-strokes' will appropriately colorize the pixmaps to display some time info. +;; and `strokes-minimum-match-score' is 1000 by default. This +;; will surely mess some people up, but if so, just set it back +;; w/ M-x customize. +;; 2.2: Fixed up the mechanism for updating the +;; `strokes-window-configuration'. Now it only uses one function +;; (`strokes-update-window-configuration') which does it all, and +;; much more efficiently (thanks RMS!). +;; 2.2 Fixed up the appearance of the *strokes* buffer so that there +;; are no ugly line truncations, and I got rid of the bug which +;; would draw the stroke on the wrong line. I still wish that +;; `event-closest-point' was smarter. In fact, +;; `event-closest-point' does *not* do what its name suggests. +;; 2.3 Added more to `strokes-update-window-configuration' so it goes +;; to hell less often +;; 2.3 `strokes-mode' no longer will undefined keys unless it's sure +;; that the user had had them mapped to a strokes command. +;; 2.3 Added more magic autoload statements so strokes work more +;; smoothly. similarly, I made strokes-mode turn itself on when +;; the user defines a stroke (thanks Hrvoje). +;; 2.3 Added "Strokes" to the modeline when strokes is on, and allow +;; toggling strokes with mouse button2. +;; 2.3 Added `list-strokes', which is a really nice function which +;; graphically lists all the strokes that the user has defined +;; and their corresponding commands. `list-strokes' will +;; appropriately colorize the pixmaps to display some time info. +;; 2.4 Added all new functionality to strokes by allowing the user to +;; enter strokes in graphically into XEmacs, allowing true graphic +;; editing, Chinese/Japanese, etc. User simply uses C-button2 to +;; draw strokes (function: `strokes-compose-complex-stroke'). Then +;; after the glyph gets inserted into the current buffer at (point), +;; the use can treat that glyph as any other character, and +;; copy/paste/delete/undo, etc. Also, when the user would like to +;; save/send the glyphs (to other XEmacs users, of course), he/she +;; can use the helper functions: +;; +;; i. M-x strokes-encode-buffer -- Ascii-encodes and compresses +;; strokes to base-64. +;; ii. M-x strokes-decode-buffer -- Decodes ascii-encoded strokes +;; back into glyphs. +;; 2.4 With help from Kyle fixed the itimer (timeout event) bug, where I +;; forgot to check for timeouts. +;; 2.4 Around this time, made a successful port of strokes.el for emacs. +;; 2.4 Made added `strokes-xpm-header' as a variable. +;; 2.4 Changed the default value of `strokes-character' from `o' to +;; `@' since it looks nicer when drawn. +;; 2.4 Changed `strokes-click-p' so that it considers only a stroke +;; of length <= 1 a click, as opposed to a length 2 being a +;; click. +;; 2.4 Totally made the the function `strokes-read-stroke' (and a bit +;; on `strokes-read-complex-stroke') more efficient and robust, +;; making the former use the optional event passed to it, and +;; thus not losing the first mouse event position when reading a +;; stroke on the fly. +;; 2.4 Finally fixed the mouse-yank / mouse-yank-at-point bug (after +;; months of struggling with it). I simply inserted a (sit-for 0) +;; before the (command-execute strokes-click-command) and that +;; patched it up. I'd thought that it was a kludge, but I later +;; found out that it wasn't, as redisplay has several states, and +;; command-execute often must decide which of two states must be +;; considered when executing a command. The (sit-for 0) merely +;; allowed redisplay to be sure to wait for the ` *strokes*' +;; buffer to vanish before executing the command (thanks for the +;; explanation of why my frobbing worked Kyle). Fixing this bug +;; also (magically) fixed the bug which prevented strokes from +;; executing a stroke in a mode which had it's own binding for +;; button-2, such as w3 when the variable +;; `strokes-use-strokes-buffer' is non-nil. It used to be that +;; if you chose to view your strokes, then you couldn't use +;; strokes properly in modes like VM or w3. Now you can! +;; 2.4 Replaced `kill-emacs-hook' with `kill-emacs-query-functions' +;; for prompting the user to save his/her strokes, since +;; `kill-emacs-hook' was not the right hook to use. +;; 2.4 Having `strokes-update-window-configuration' bound to +;; `select-frame-hook' was a heavy function for such a commonly +;; run hook -- especially since event-Xt.c (?) will add the +;; eval-event to the event queue. So the effect was that if XEmacs +;; was doing an interpreter-intensive task while the user (re)selected +;; the frame n times, then the intensive window config updating +;; took place n times. So to deal, I put in some extra checks to +;; see if the frame parameters really changed, making an update +;; worthwhile. See `strokes-update-window-configuration-plist'. ;;; Code: @@ -267,11 +334,11 @@ (autoload 'reporter-submit-bug-report "reporter") (autoload 'mail-position-on-field "sendmail") (eval-when-compile - (mapc 'require '(xpm-mode pp annotations reporter advice))) + (mapc 'require '(xpm-mode pp annotations reporter advice view-less))) ;;; Constants... -(defconst strokes-version "2.3") +(defconst strokes-version "2.4-beta") (defconst strokes-bug-address "cadet@mit.edu") @@ -285,8 +352,8 @@ /* width height ncolors cpp [x_hot y_hot] */ \"33 33 9 1 26 23\", /* colors */ -\" c #D9D9D9D9D9D9\", -\"* s iconColor1 m black c black\", +\" c none s none\", +\"* c #000000 s foreground\", \"R c #FFFF00000000\", \"O c #FFFF80000000\", \"Y c #FFFFFFFF0000\", @@ -300,7 +367,7 @@ ;;; user variables... (defgroup strokes nil - "Control Emacs through mouse strokes" + "Control Emacs through mouse strokes." :group 'mouse) (defcustom strokes-modeline-string " Strokes" @@ -308,9 +375,9 @@ :type 'string :group 'strokes) -(defcustom strokes-character ?o +(defcustom strokes-character ?@ "*Character used when drawing strokes in the strokes buffer. -\(The default is lower-case `o', which works okay\)." +\(The default is lower-case `@', which works okay\)." :type 'character :group 'strokes) @@ -338,7 +405,8 @@ left to ((STROKES-GRID-RESOLUTION - 1) . (STROKES-GRID-RESOLUTION - 1)) on the bottom right. The greater the resolution, the more intricate your strokes can be. -NOTE: This variable should be odd and MUST NOT be less than 3. +NOTE: This variable should be odd and MUST NOT be less than 3 and need + not be greater than 33, which is the resolution of the pixmaps. WARNING: Changing the value of this variable will gravely affect the strokes you have already programmed in. You should try to figure out what it should be based on your needs and on how @@ -381,6 +449,15 @@ "The special window configuration used when entering strokes. This is set properly in the function `strokes-update-window-configuration'.") +(defvar strokes-window-configuration-plist + (list 'frame nil 'frame-height nil 'frame-width nil) + "Plist describing the state of the current strokes-window-configuration. +The plist consists of the following keys: + +'frame Frame to draw strokes in. +'frame-height Height of the frame. +'frame-width Width of the frame.") + (defvar strokes-last-stroke nil "Last stroke entered by the user. Its value gets set every time the function @@ -397,22 +474,28 @@ (defvar strokes-load-hook nil "Function or functions to be called when `strokes' is loaded.") -(defvar edit-strokes-menu - '("Edit-Strokes" - ["Add stroke..." strokes-global-set-stroke t] - ["Delete stroke..." strokes-edit-delete-stroke t] - ["Change stroke" strokes-smaller t] - ["Change definition" strokes-larger t] - ["[Re]List Strokes chronologically" strokes-list-strokes t] - ["[Re]List Strokes alphabetically" strokes-list-strokes t] - ["Quit" strokes-edit-quit t] - )) +;;; ### NOT IMPLEMENTED YET ### +;;(defvar edit-strokes-menu +;; '("Edit-Strokes" +;; ["Add stroke..." strokes-global-set-stroke t] +;; ["Delete stroke..." strokes-edit-delete-stroke t] +;; ["Change stroke" strokes-smaller t] +;; ["Change definition" strokes-larger t] +;; ["[Re]List Strokes chronologically" strokes-list-strokes t] +;; ["[Re]List Strokes alphabetically" strokes-list-strokes t] +;; ["Quit" strokes-edit-quit t] +;; )) ;;; Macros... +(defmacro strokes-while-inhibiting-garbage-collector (&rest forms) + "Execute FORMS without interference from the garbage collector." + `(let ((gc-cons-threshold 134217727)) + ,@forms)) + (defsubst strokes-click-p (stroke) "Non-nil if STROKE is really click." - (< (length stroke) 3)) + (< (length stroke) 2)) ;;; old, but worked pretty good (just in case)... ;;(defmacro strokes-define-stroke (stroke-map stroke def) @@ -424,7 +507,7 @@ ;; (list 'remassoc stroke stroke-map))))) (defmacro strokes-define-stroke (stroke-map stroke def) - "Add STROKE to STROKE-MAP alist with given command DEF" + "Add STROKE to STROKE-MAP alist with given command DEF." `(if (strokes-click-p ,stroke) (error "That's a click, not a stroke; see `strokes-click-command'") (setq ,stroke-map (cons (cons ,stroke ,def) @@ -438,7 +521,7 @@ (defsubst strokes-distance-squared (p1 p2) "Gets the distance (squared) between to points P1 and P2. -Each point is a cons cells (X . Y)" +P1 and P2 are cons cells in the form (X . Y)." (let ((x1 (car p1)) (y1 (cdr p1)) (x2 (car p2)) @@ -449,26 +532,27 @@ ;;; Advice for various functions... ;; I'd originally wanted to write a macro that would just take in the -;; generic functions which use mouse button2 in various modes. Most of -;; them are identical in form: they take an event as the single argument -;; and then do their thing. I tried writing a macro that looked -;; something like this, but failed. Advice just ain't that easy. The -;; one that bugged me the most was `Manual-follow-xref', because that had -;; &rest arguments, and I didn't know how to work around it in defadvice. -;; However, I was able to fix up most of the important modes (i.e. the -;; ones I use all the time). One `bug' in the program that I just can't -;; seem to figure out is why I can only advise other button2 functions -;; successfully when the variable `strokes-use-strokes-buffer' is nil. I -;; did all the save-excursion/save-window-excursion stuff SPECIFICALLY so -;; that using the strokes buffer or not would absolutely not affect any -;; other part of the program. If someone can figure out how to make the -;; following advices work w/ regardless of that variable -;; `strokes-use-strokes-buffer', then that would be a great victory. If -;; someone out there would be kind enough to make the commented code -;; below work, I'd be grateful. By the way, I put the `protect' keywords -;; there to insure that if a stroke went bad, then -;; `strokes-click-command' would be set back. If this isn't necessary, -;; then feel free to let me know. +;; generic functions which use mouse button2 in various modes. Most +;; of them are identical in form: they take an event as the single +;; argument and then do their thing. I tried writing a macro that +;; looked something like this, but failed. Advice just ain't that +;; easy. The one that bugged me the most was `Manual-follow-xref', +;; because that had &rest arguments, and I didn't know how to work +;; around it in defadvice. However, I was able to fix up most of the +;; important modes (i.e. the ones I use all the time). One `bug' in +;; the program that I just can't seem to figure out is why I can only +;; advise other button2 functions successfully when the variable +;; `strokes-use-strokes-buffer' is nil. I did all the +;; save-excursion/save-window-excursion stuff SPECIFICALLY so that +;; using the strokes buffer or not would absolutely not affect any +;; other part of the program. If someone can figure out how to make +;; the following advices work w/ regardless of that variable +;; `strokes-use-strokes-buffer', then that would be a great victory. +;; If someone out there would be kind enough to make the commented +;; code below work, I'd be grateful. By the way, I put the `protect' +;; keywords there to insure that if a stroke went bad, then +;; `strokes-click-command' would be set back. If this isn't +;; necessary, then feel free to let me know. ;; For what follows, I really wanted something that would work like this: @@ -493,13 +577,9 @@ `(progn (defadvice ,command (around strokes-fix-button2 compile preactivate) ,(format "Fix %s to work with strokes." command) - (if strokes-use-strokes-buffer - ;; then strokes is no good and we'll have to use the original - ad-do-it - ;; otherwise, we can make strokes work too... - (let ((strokes-click-command + (let ((strokes-click-command ',(intern (format "ad-Orig-%s" command)))) - (strokes-do-stroke (ad-get-arg 0)))))))) + (strokes-do-stroke (ad-get-arg 0))))))) (strokes-fix-button2-command 'vm-mouse-button-2) (strokes-fix-button2-command 'rmail-summary-mouse-goto-msg) @@ -546,7 +626,7 @@ ;;; Functions... (defun strokes-lift-p (object) - "Return non-nil if object is a stroke-lift" + "Return non-nil if object is a stroke-lift." (eq object strokes-lift)) (defun strokes-unset-last-stroke () @@ -573,7 +653,7 @@ (and (or strokes-mode (strokes-mode t)) (strokes-read-complex-stroke "Define a new stroke. Draw with button1 (or 2). End with button3...")) - (read-command "command to map stroke to: "))) + (read-command-or-command-sexp "command to map stroke to: "))) (strokes-define-stroke strokes-global-map stroke command)) ;;;###autoload @@ -590,7 +670,7 @@ (defun strokes-get-grid-position (stroke-extent position &optional grid-resolution) "Map POSITION to a new grid position based on its STROKE-EXTENT and GRID-RESOLUTION. -STROKE-EXTENT as a list \(\(xmin . ymin\) \(xmax . ymax\)\). +STROKE-EXTENT as a list \(\(XMIN . YMIN\) \(XMAX . YMAX\)\). If POSITION is a `strokes-lift', then it is itself returned. Optional GRID-RESOLUTION may be used in place of STROKES-GRID-RESOLUTION. The grid is a square whose dimesion is [0,GRID-RESOLUTION)." @@ -613,32 +693,9 @@ ((strokes-lift-p position) ; stroke lift strokes-lift))) -;;(defun strokes-get-grid-position (stroke-extent pix-pos) -;; "Return the stroke-grid position for PIX-POS given the total STROKE-EXTENT. -;;STROKE-EXTENT as a list \(\(xmin . ymin\) \(xmax . ymax\)\) and a particular -;;pixel position or `strokes-lift', find the corresponding grid position -;;\(based on `strokes-grid-resolution'\) for the PIX-POS." -;; (cond ((consp pix-pos) ; actual pixel location -;; (let ((x (car pix-pos)) -;; (y (cdr pix-pos)) -;; (xmin (caar stroke-extent)) -;; (ymin (cdar stroke-extent)) -;; ;; the `1+' is there to insure that the -;; ;; formula evaluates correctly at the boundaries -;; (xmax (1+ (caadr stroke-extent))) -;; (ymax (1+ (cdadr stroke-extent)))) -;; (cons (floor (* strokes-grid-resolution -;; (/ (float (- x xmin)) -;; (- xmax xmin)))) -;; (floor (* strokes-grid-resolution -;; (/ (float (- y ymin)) -;; (- ymax ymin))))))) -;; ((strokes-lift-p pix-pos) ; stroke lift -;; strokes-lift))) - (defun strokes-get-stroke-extent (pixel-positions) "From a list of absolute PIXEL-POSITIONS, returns absolute spatial extent. -The return value is a list ((xmin . ymin) (xmax . ymax))." +The return value is a list ((XMIN . YMIN) (XMAX . YMAX))." (if pixel-positions (let ((xmin (caar pixel-positions)) (xmax (caar pixel-positions)) @@ -714,16 +771,6 @@ (strokes-get-grid-position stroke-extent pos grid-resolution))) positions))) -;;(defun strokes-normalize-pixels-to-grid (pixel-positions) -;; "Map PIXEL-POSITIONS to the stroke grid. -;;PIXEL-POSITIONS is a list of pixel-positions and stroke-lifts. The -;;normalized stroke grid is defined by the variable STROKES-GRID-RESOLUTION" -;; (let ((stroke-extent (strokes-get-stroke-extent pixel-positions))) -;; (mapcar (function -;; (lambda (pix-pos) -;; (strokes-get-grid-position stroke-extent pix-pos))) -;; pixel-positions))) - (defun strokes-fill-stroke (unfilled-stroke &optional force) "Fill in missing grid locations in the list of UNFILLED-STROKE. If FORCE is non-nil, then fill the stroke even if it's `stroke-click'. @@ -875,104 +922,179 @@ This function will display the stroke interactively as it is being entered in the strokes buffer if the variable `strokes-use-strokes-buffer' is non-nil. -Optional EVENT is currently not used, but hopefully will be soon." +Optional EVENT is acceptable as the starting event of the stroke" (save-excursion (let ((pix-locs nil) (grid-locs nil) - (event (or event (make-event)))) - (if strokes-use-strokes-buffer - ;; switch to the strokes buffer and - ;; display the stroke as it's being read - (save-window-excursion - (set-window-configuration strokes-window-configuration) - (if prompt - (progn - (setq event (next-event event prompt)) - (while (not (button-press-event-p event)) - (dispatch-event event) - (setq event (next-event event))))) - (unwind-protect - (progn - (setq event (next-event event)) - (while (not (button-release-event-p event)) - (if (mouse-event-p event) - (let ((point (event-closest-point event))) - (when point - (goto-char point) - (subst-char-in-region point (1+ point) ?\ strokes-character)) - (push (cons (event-x-pixel event) - (event-y-pixel event)) - pix-locs))) - (setq event (next-event event)))) - ;; protected - ;; clean up strokes buffer and then bury it. - (when (equal (buffer-name) strokes-buffer-name) - (subst-char-in-region (point-min) (point-max) strokes-character ?\ ) - (goto-char (point-min)) - (bury-buffer)))) - ;; Otherwise, don't use strokes buffer and read stroke silently - (if prompt - (progn - (setq event (next-event event prompt)) - (while (not (button-press-event-p event)) - (dispatch-event event) - (setq event (next-event event))))) - (setq event (next-event)) - (while (not (button-release-event-p event)) - (if (mouse-event-p event) - (push (cons (event-x-pixel event) - (event-y-pixel event)) - pix-locs)) - (setq event (next-event event)))) + (safe-to-draw-p nil)) + (strokes-while-inhibiting-garbage-collector + (if strokes-use-strokes-buffer + ;; switch to the strokes buffer and + ;; display the stroke as it's being read + (save-window-excursion + (set-window-configuration strokes-window-configuration) + (when prompt + (setq event (next-command-event event prompt)) + (or (button-press-event-p event) + (error "You must draw with the mouse"))) + (or event (setq event (next-event nil prompt) + safe-to-draw-p t)) + (unwind-protect + (progn + (while (not (button-release-event-p event)) + (if (mouse-event-p event) + (let ((point (event-closest-point event))) + (if (and point safe-to-draw-p) + ;; we can draw that point + (progn + (goto-char point) + (subst-char-in-region point (1+ point) ?\ strokes-character)) + ;; otherwise, we can start drawing the next time... + (setq safe-to-draw-p t)) + (push (cons (event-x-pixel event) + (event-y-pixel event)) + pix-locs)) + ;; otherwise, if it's not a mouse-event... + (dispatch-event event)) + (setq event (next-event event)))) + ;; protected + ;; clean up strokes buffer and then bury it. + (when (equal (buffer-name) strokes-buffer-name) + (subst-char-in-region (point-min) (point-max) strokes-character ?\ ) + (goto-char (point-min)) + (bury-buffer)))) + ;; Otherwise, don't use strokes buffer and read stroke silently + (when prompt + (setq event (next-command-event event prompt)) + (or (button-press-event-p event) + (error "You must draw with the mouse"))) + (or event (setq event (next-event nil prompt))) + (while (not (button-release-event-p event)) + (if (mouse-event-p event) + (push (cons (event-x-pixel event) + (event-y-pixel event)) + pix-locs) + (dispatch-event event)) + (setq event (next-event event))))) (setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs))) (strokes-fill-stroke (strokes-eliminate-consecutive-redundancies grid-locs))))) -;;;###autoload +;;; This version of `strokes-read-stroke' is not broken, but pathetic. +;;(defun strokes-read-stroke (&optional prompt event) +;; "Read a simple stroke (interactively) and return the stroke. +;;Optional PROMPT in minibuffer displays before and during stroke reading. +;;This function will display the stroke interactively as it is being +;;entered in the strokes buffer if the variable +;;`strokes-use-strokes-buffer' is non-nil. +;;Optional EVENT is currently not used, but hopefully will be soon." +;; (save-excursion +;; (strokes-while-inhibiting-garbage-collector +;; (let ((pix-locs nil) +;; (grid-locs nil) +;; (event (or event (make-event)))) +;; (if strokes-use-strokes-buffer +;; ;; switch to the strokes buffer and +;; ;; display the stroke as it's being read +;; (save-window-excursion +;; (set-window-configuration strokes-window-configuration) +;; (if prompt +;; (progn +;; (setq event (next-event event prompt)) +;; (while (not (button-press-event-p event)) +;; (dispatch-event event) +;; (setq event (next-event event))))) +;; (unwind-protect +;; (progn +;; (setq event (next-event event)) +;; (while (not (button-release-event-p event)) +;; (if (mouse-event-p event) +;; (let ((point (event-closest-point event))) +;; (when point +;; (goto-char point) +;; (subst-char-in-region point (1+ point) ?\ strokes-character)) +;; (push (cons (event-x-pixel event) +;; (event-y-pixel event)) +;; pix-locs))) +;; (setq event (next-event event)))) +;; ;; protected +;; ;; clean up strokes buffer and then bury it. +;; (when (equal (buffer-name) strokes-buffer-name) +;; (subst-char-in-region (point-min) (point-max) strokes-character ?\ ) +;; (goto-char (point-min)) +;; (bury-buffer)))) +;; ;; Otherwise, don't use strokes buffer and read stroke silently +;; (if prompt +;; (progn +;; (setq event (next-event event prompt)) +;; (while (not (button-press-event-p event)) +;; (dispatch-event event) +;; (setq event (next-event event))))) +;; (setq event (next-event)) +;; (while (not (button-release-event-p event)) +;; (if (mouse-event-p event) +;; (push (cons (event-x-pixel event) +;; (event-y-pixel event)) +;; pix-locs)) +;; (setq event (next-event event)))) +;; (setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs))) +;; (strokes-fill-stroke (strokes-eliminate-consecutive-redundancies grid-locs)))))) + (defun strokes-read-complex-stroke (&optional prompt event) "Read a complex stroke (interactively) and return the stroke. Optional PROMPT in minibuffer displays before and during stroke reading. Note that a complex stroke allows the user to pen-up and pen-down. This is implemented by allowing the user to paint with button1 or button2 and then complete the stroke with button3. -Optional EVENT is currently not used, but hopefully will be soon." +Optional EVENT is acceptable as the starting event of the stroke" (save-excursion (save-window-excursion - (set-window-configuration strokes-window-configuration) - (let ((pix-locs nil) - (grid-locs nil) - (event (or event (next-event nil prompt)))) - (if prompt - (while (not (button-press-event-p event)) - (dispatch-event event) - (setq event (next-event event)))) - (unwind-protect - (progn - (setq event (next-event event prompt)) - (while (not (and (button-press-event-p event) - (eq (event-button event) 3))) - (while (not (button-release-event-p event)) - (if (mouse-event-p event) - (let ((point (event-closest-point event))) - (when point - (goto-char point) - (subst-char-in-region point (1+ point) ?\ strokes-character)) - (push (cons (event-x-pixel event) - (event-y-pixel event)) - pix-locs))) - (setq event (next-event event prompt))) - (push strokes-lift pix-locs) - (while (not (button-press-event-p event)) - (dispatch-event event) - (setq event (next-event event prompt)))) - (setq pix-locs (nreverse (cdr pix-locs)) - grid-locs (strokes-renormalize-to-grid pix-locs)) - (strokes-fill-stroke - (strokes-eliminate-consecutive-redundancies grid-locs))) - ;; protected - (when (equal (buffer-name) strokes-buffer-name) - (subst-char-in-region (point-min) (point-max) strokes-character ?\ ) - (goto-char (point-min)) - (bury-buffer))))))) + (strokes-while-inhibiting-garbage-collector + (set-window-configuration strokes-window-configuration) + (let ((pix-locs nil) + (grid-locs nil) + (safe-to-draw-p nil)) + (when prompt + (setq event (next-command-event event prompt)) + (or (button-press-event-p event) + (error "You must draw with the mouse"))) + (or event (setq event (next-event nil prompt) + safe-to-draw-p t)) + (unwind-protect + (progn + (while (not (and (button-press-event-p event) + (eq (event-button event) 3))) + (while (not (button-release-event-p event)) + (if (mouse-event-p event) + (let ((point (event-closest-point event))) + (if (and point safe-to-draw-p) + ;; we can draw that point + (progn + (goto-char point) + (subst-char-in-region point (1+ point) ?\ strokes-character)) + ;; otherwise, we can start drawing the next time... + (setq safe-to-draw-p t)) + (push (cons (event-x-pixel event) + (event-y-pixel event)) + pix-locs)) + (dispatch-event event)) + (setq event (next-event event prompt))) + (push strokes-lift pix-locs) + (while (not (button-press-event-p event)) + (dispatch-event event) + (setq event (next-event event prompt)))) + (setq pix-locs (nreverse (cdr pix-locs))) + ;; minor bug fix here for when user enters ` *strokes*' + ;; buffer with a click instead of a drag... + (when (strokes-lift-p (car pix-locs)) + (setq pix-locs (cdr pix-locs))) + (setq grid-locs (strokes-renormalize-to-grid pix-locs)) + (strokes-fill-stroke + (strokes-eliminate-consecutive-redundancies grid-locs))) + ;; protected + (when (equal (buffer-name) strokes-buffer-name) + (subst-char-in-region (point-min) (point-max) strokes-character ?\ ) + (goto-char (point-min)) + (bury-buffer)))))))) (defun strokes-execute-stroke (stroke) "Given STROKE, execute the command which corresponds to it. @@ -983,7 +1105,16 @@ (command (car match)) (score (cdr match))) (cond ((strokes-click-p stroke) - ;; This is the case of a `click' type event + ;; This is the case of a `click' type event. + ;; The `sit-for' is a minor frob that has to do with timing + ;; problems. Without the `sit-for', mouse-yank will not + ;; yank at the proper location if the user opted for + ;; mouse-yank-at-point to be nil (i.e. mouse-yank takes + ;; place at pointer position). The sit-for tells redisplay + ;; to be sure to wait for the `*strokes*' buffer to vanish + ;; from consideration when deciding on a point to be used + ;; for mouse-yank. + (sit-for 0) (command-execute strokes-click-command)) ((and match (<= score strokes-minimum-match-score)) (message "%s" command) @@ -1002,7 +1133,7 @@ ;;;###autoload (defun strokes-do-stroke (event) - "Read a simple stroke from the user and then exectute its comand. + "Read a simple stroke from the user and then exectute its command. This must be bound to a mouse event." (interactive "e") (or strokes-mode (strokes-mode t)) @@ -1050,8 +1181,8 @@ (let ((helpdoc "This is help for the strokes package. -If you find something wrong with it, or feel that it can be improved -in some way, then please feel free to email me: +If you find something wrong with strokes, or feel that it can be +improved in some way, then please feel free to email me: David Bakhash <cadet@mit.edu> @@ -1061,18 +1192,27 @@ ------------------------------------------------------------ +** Strokes... + The strokes package allows you to define strokes (that you make with the mouse or other pointer device) that XEmacs can interpret as corresponding to commands, and then executes the commands. It does character recognition, so you don't have to worry about getting it right every time. +Strokes also allows you to compose documents graphically. You can +fully edit documents in Chinese, Japanese, etc. based on XEmacs +strokes. Once you've done so, you can ascii compress-and-encode them +and then safely save them for later use, send letters to friends +(using XEmacs, of course). Strokes will later decode these documents, +extracting the strokes for editing use once again, so the editing +cycle can continue. + Strokes are easy to program and fun to use. To start strokes going, you'll want to put the following line in your .emacs file: -(and (fboundp 'device-on-window-system-p) - (device-on-window-system-p) - (require 'strokes)) +(if window-system + (require 'strokes)) This will load strokes when and only when you start XEmacs on a window system (i.e. that has a pointer (mouse) device, etc.). @@ -1081,6 +1221,8 @@ > M-x strokes-mode +** Strokes for controlling the behavior of XEmacs... + When you're ready to start defining strokes, just use the command > M-x global-set-stroke @@ -1148,14 +1290,28 @@ > M-x load-user-strokes -A few more important things: +** Strokes for pictographic editing... -o The command `strokes-do-stroke' is also invoked with C-button2, so that you - can still enter a stroke in modes which use button2 for other things, - such as cross-referencing. +If you'd like to create graphical files with strokes, you'll have to +be running XEmacs on a window system, with XPM support. You use the +binding C-button2 to start drawing your strokes. These are just +complex strokes, and thus you continue drawing with buttons 1 or 2 and +end with button-3. Then the stroke glyph gets inserted into the +buffer. You treat it like any other character, which you can copy, +paste, delete, move, etc. The command which is bound to C-button2 is +called `strokes-compose-complex-stroke'. When all is done, you may +want to send the file, or save it. This is done with -o Complex strokes (i.e. `strokes-do-complex-stroke'), by default, use - Sh-button2. +> M-x strokes-encode-buffer + +Likewise, to decode the strokes from a strokes-encoded buffer you do + +> M-x strokes-decode-buffer + +** A few more important things... + +o The command `strokes-do-complex-stroke' is invoked with M-button2, so that you + can execute complex strokes (i.e. with more than one lift) if preferred. o Strokes are a bit computer-dependent in that they depend somewhat on the speed of the computer you're working on. This means that you @@ -1167,13 +1323,7 @@ silently--without displaying the strokes. All variables can be set by customizing the group named `strokes' via the customization package: - > M-x customize - -o A problem with strokes happens when you resize windows. If you - enlarge your XEmacs window a lot and realize that your strokes - buffer is not big enough, you may need to fix it with - - > M-x strokes-update-window-configuration.")) + > M-x customize")) (princ helpdoc standard-output))))))) (defun strokes-report-bug () @@ -1208,15 +1358,40 @@ (insert " " strokes-version " bug:"))))))))) (defsubst strokes-fill-current-buffer-with-whitespace () - "Erase the contents of the current buffer and fill it with whitespace" + "Erase the contents of the current buffer and fill it with whitespace." (erase-buffer) (loop repeat (frame-height) do (insert-char ?\ (1- (frame-width))) (newline)) (goto-char (point-min))) +(defun strokes-window-configuration-changed-p () + "Non-nil if the `strokes-window-configuration' frame properties changed. +This is based on the last time the `strokes-window-configuration was updated." + (not (and (eq (selected-frame) + (plist-get strokes-window-configuration-plist + 'frame)) + (eq (frame-height) + (plist-get strokes-window-configuration-plist + 'frame-height)) + (eq (frame-width) + (plist-get strokes-window-configuration-plist + 'frame-width))))) + +(defun strokes-update-window-configuration-plist () + "Update the `strokes-window-configuration-plist' based on the current state." + (plist-put strokes-window-configuration-plist + 'frame + (selected-frame)) + (plist-put strokes-window-configuration-plist + 'frame-height + (frame-height)) + (plist-put strokes-window-configuration-plist + 'frame-width + (frame-width))) + (defun strokes-update-window-configuration () - "Insure that `strokes-window-configuration' is up-to-date." + "Update the `strokes-window-configuration'." (interactive) (let ((current-window (selected-window))) (cond ((or (window-minibuffer-p current-window) @@ -1242,15 +1417,18 @@ (setq truncate-lines nil) (strokes-fill-current-buffer-with-whitespace) (setq strokes-window-configuration (current-window-configuration)) + (strokes-update-window-configuration-plist) (bury-buffer)))) - (t ; `strokes buffer' still exists... - ;; update the strokes-window-configuration for this specific frame... + ((strokes-window-configuration-changed-p) ; simple update + ;; update the strokes-window-configuration for this + ;; specific frame... (save-excursion (save-window-excursion (set-window-buffer current-window strokes-buffer-name) (delete-other-windows) (strokes-fill-current-buffer-with-whitespace) (setq strokes-window-configuration (current-window-configuration)) + (strokes-update-window-configuration-plist) (bury-buffer))))))) ;;;###autoload @@ -1380,109 +1558,109 @@ (xpm-show-image) (goto-char (point-min)))))) -;;; Strokes Edit stuff... +;;; Strokes Edit stuff... ### NOT IMLEMENTED YET ### -(defun strokes-edit-quit () - (interactive) - (or (one-window-p t 0) - (delete-window)) - (kill-buffer "*Strokes List*")) +;;(defun strokes-edit-quit () +;; (interactive) +;; (or (one-window-p t 0) +;; (delete-window)) +;; (kill-buffer "*Strokes List*")) -(define-derived-mode edit-strokes-mode list-mode - "Edit-Strokes" - "Major mode for `edit-strokes' and `list-strokes' buffers. +;;(define-derived-mode edit-strokes-mode list-mode +;; "Edit-Strokes" +;; "Major mode for `edit-strokes' and `list-strokes' buffers. -Editing commands: +;;Editing commands: -\\{edit-strokes-mode-map}" - (setq truncate-lines nil - auto-show-mode nil ; don't want problems here either - mode-popup-menu edit-strokes-menu) ; what about extent-specific stuff? - (and (featurep 'menubar) - current-menubar - (set (make-local-variable 'current-menubar) - (copy-sequence current-menubar)) - (add-submenu nil edit-strokes-menu))) +;;\\{edit-strokes-mode-map}" +;; (setq truncate-lines nil +;; auto-show-mode nil ; don't want problems here either +;; mode-popup-menu edit-strokes-menu) ; what about extent-specific stuff? +;; (and (featurep 'menubar) +;; current-menubar +;; (set (make-local-variable 'current-menubar) +;; (copy-sequence current-menubar)) +;; (add-submenu nil edit-strokes-menu))) -(let ((map edit-strokes-mode-map)) - (define-key map "<" 'beginning-of-buffer) - (define-key map ">" 'end-of-buffer) - ;; (define-key map "c" 'strokes-copy-other-face) - ;; (define-key map "C" 'strokes-copy-this-face) - ;; (define-key map "s" 'strokes-smaller) - ;; (define-key map "l" 'strokes-larger) - ;; (define-key map "b" 'strokes-bold) - ;; (define-key map "i" 'strokes-italic) - (define-key map "e" 'strokes-list-edit) - ;; (define-key map "f" 'strokes-font) - ;; (define-key map "u" 'strokes-underline) - ;; (define-key map "t" 'strokes-truefont) - ;; (define-key map "F" 'strokes-foreground) - ;; (define-key map "B" 'strokes-background) - ;; (define-key map "D" 'strokes-doc-string) - (define-key map "a" 'strokes-global-set-stroke) - (define-key map "d" 'strokes-list-delete-stroke) - ;; (define-key map "n" 'strokes-list-next) - ;; (define-key map "p" 'strokes-list-prev) - ;; (define-key map " " 'strokes-list-next) - ;; (define-key map "\C-?" 'strokes-list-prev) - (define-key map "g" 'strokes-list-strokes) ; refresh display - (define-key map "q" 'strokes-edit-quit) - (define-key map [(control c) (control c)] 'bury-buffer)) +;;(let ((map edit-strokes-mode-map)) +;; (define-key map "<" 'beginning-of-buffer) +;; (define-key map ">" 'end-of-buffer) +;; ;; (define-key map "c" 'strokes-copy-other-face) +;; ;; (define-key map "C" 'strokes-copy-this-face) +;; ;; (define-key map "s" 'strokes-smaller) +;; ;; (define-key map "l" 'strokes-larger) +;; ;; (define-key map "b" 'strokes-bold) +;; ;; (define-key map "i" 'strokes-italic) +;; (define-key map "e" 'strokes-list-edit) +;; ;; (define-key map "f" 'strokes-font) +;; ;; (define-key map "u" 'strokes-underline) +;; ;; (define-key map "t" 'strokes-truefont) +;; ;; (define-key map "F" 'strokes-foreground) +;; ;; (define-key map "B" 'strokes-background) +;; ;; (define-key map "D" 'strokes-doc-string) +;; (define-key map "a" 'strokes-global-set-stroke) +;; (define-key map "d" 'strokes-list-delete-stroke) +;; ;; (define-key map "n" 'strokes-list-next) +;; ;; (define-key map "p" 'strokes-list-prev) +;; ;; (define-key map " " 'strokes-list-next) +;; ;; (define-key map "\C-?" 'strokes-list-prev) +;; (define-key map "g" 'strokes-list-strokes) ; refresh display +;; (define-key map "q" 'strokes-edit-quit) +;; (define-key map [(control c) (control c)] 'bury-buffer)) -;;;###autoload -(defun strokes-edit-strokes (&optional chronological strokes-map) - ;; ### DEAL WITH THE 2nd ARGUMENT ISSUE! ### - "Edit strokes in a pop-up buffer containing strokes and their definitions. -If STROKES-MAP is not given, `strokes-global-map' will be used instead. +;;;;;###autoload +;;(defun strokes-edit-strokes (&optional chronological strokes-map) +;; ;; ### DEAL WITH THE 2nd ARGUMENT ISSUE! ### +;; "Edit strokes in a pop-up buffer containing strokes and their definitions. +;;If STROKES-MAP is not given, `strokes-global-map' will be used instead. -Editing commands: +;;Editing commands: -\\{edit-faces-mode-map}" - (interactive "P") - (pop-to-buffer (get-buffer-create "*Strokes List*")) - (reset-buffer (current-buffer)) ; handy function from minibuf.el - (setq strokes-map (or strokes-map - strokes-global-map - (progn - (strokes-load-user-strokes) - strokes-global-map))) - (or chronological - (setq strokes-map (sort (copy-sequence strokes-map) - 'strokes-alphabetic-lessp))) - ;; (push-window-configuration) - (insert - "Command Stroke\n" - "------- ------") - (loop for def in strokes-map - for i from 0 to (1- (length strokes-map)) do - (let ((stroke (car def)) - (command-name (symbol-name (cdr def)))) - (strokes-xpm-for-stroke stroke " *strokes-xpm*") - (newline 2) - (insert-char ?\ 45) - (beginning-of-line) - (insert command-name) - (beginning-of-line) - (forward-char 45) - (set (intern (format "strokes-list-annotation-%d" i)) - (make-annotation (make-glyph - (list - (vector 'xpm - :data (buffer-substring - (point-min " *strokes-xpm*") - (point-max " *strokes-xpm*") - " *strokes-xpm*")) - [string :data "[Stroke]"])) - (point) 'text)) - (set-annotation-data (symbol-value (intern (format "strokes-list-annotation-%d" i))) - def)) - finally do (kill-region (1+ (point)) (point-max))) - (edit-strokes-mode) - (goto-char (point-min))) +;;\\{edit-faces-mode-map}" +;; (interactive "P") +;; (pop-to-buffer (get-buffer-create "*Strokes List*")) +;; (reset-buffer (current-buffer)) ; handy function from minibuf.el +;; (setq strokes-map (or strokes-map +;; strokes-global-map +;; (progn +;; (strokes-load-user-strokes) +;; strokes-global-map))) +;; (or chronological +;; (setq strokes-map (sort (copy-sequence strokes-map) +;; 'strokes-alphabetic-lessp))) +;; ;; (push-window-configuration) +;; (insert +;; "Command Stroke\n" +;; "------- ------") +;; (loop for def in strokes-map +;; for i from 0 to (1- (length strokes-map)) do +;; (let ((stroke (car def)) +;; (command-name (symbol-name (cdr def)))) +;; (strokes-xpm-for-stroke stroke " *strokes-xpm*") +;; (newline 2) +;; (insert-char ?\ 45) +;; (beginning-of-line) +;; (insert command-name) +;; (beginning-of-line) +;; (forward-char 45) +;; (set (intern (format "strokes-list-annotation-%d" i)) +;; (make-annotation (make-glyph +;; (list +;; (vector 'xpm +;; :data (buffer-substring +;; (point-min " *strokes-xpm*") +;; (point-max " *strokes-xpm*") +;; " *strokes-xpm*")) +;; [string :data "[Stroke]"])) +;; (point) 'text)) +;; (set-annotation-data (symbol-value (intern (format "strokes-list-annotation-%d" i))) +;; def)) +;; finally do (kill-region (1+ (point)) (point-max))) +;; (edit-strokes-mode) +;; (goto-char (point-min))) -;;;###autoload -(defalias 'edit-strokes 'strokes-edit-strokes) +;;;;;###autoload +;;(defalias 'edit-strokes 'strokes-edit-strokes) ;;;###autoload (defun strokes-list-strokes (&optional chronological strokes-map) @@ -1512,7 +1690,7 @@ (command-name (symbol-name (cdr def)))) (strokes-xpm-for-stroke stroke " *strokes-xpm*") (newline 2) - (insert-char ?\ 45) + (insert-char ?\ 45) (beginning-of-line) (insert command-name) (beginning-of-line) @@ -1554,7 +1732,14 @@ By default, strokes are invoked with mouse button-2. You can define new strokes with -> M-x global-set-stroke" +> M-x global-set-stroke + +To use strokes for pictographic editing, such as Chinese/Japanese, use +Sh-button-2, which draws strokes and inserts them. Encode/decode your +strokes with + +> M-x strokes-encode-buffer +> M-x strokes-decode-buffer" (interactive "P") (let ((on-p (if arg (> (prefix-numeric-value arg) 0) @@ -1565,15 +1750,16 @@ (and (file-exists-p strokes-file) (null strokes-global-map) (strokes-load-user-strokes)) - (add-hook 'kill-emacs-hook + (add-hook 'kill-emacs-query-functions 'strokes-prompt-user-save-strokes) (add-hook 'select-frame-hook 'strokes-update-window-configuration) (strokes-update-window-configuration) (define-key global-map [(button2)] 'strokes-do-stroke) - (define-key global-map [(control button2)] 'strokes-do-stroke) - (define-key global-map [(shift button2)] - 'strokes-do-complex-stroke) + (define-key global-map [(meta button2)] 'strokes-do-complex-stroke) + ;; (define-key global-map [(control button2)] 'strokes-do-complex-stroke) + (define-key global-map [(control button2)] + 'strokes-compose-complex-stroke) (ad-activate-regexp "^strokes-") ; advise button2 commands (setq strokes-mode t)) (t ; turn off strokes @@ -1583,25 +1769,41 @@ 'strokes-update-window-configuration) (if (string-match "^strokes-" (symbol-name (key-binding [(button2)]))) (define-key global-map [(button2)] strokes-click-command)) + (if (string-match "^strokes-" (symbol-name (key-binding [(meta button2)]))) + (global-unset-key [(meta button2)])) (if (string-match "^strokes-" (symbol-name (key-binding [(control button2)]))) (global-unset-key [(control button2)])) - (if (string-match "^strokes-" (symbol-name (key-binding [(shift button2)]))) - (global-unset-key [(shift button2)])) + ;; (if (string-match "^strokes-" (symbol-name (key-binding [(shift button2)]))) + ;; (global-unset-key [(shift button2)])) (ad-deactivate-regexp "^strokes-") ; unadvise strokes-button2 commands (setq strokes-mode nil)))) (redraw-modeline)) (add-minor-mode 'strokes-mode strokes-modeline-string nil nil 'strokes-mode) -(unless (find-face 'strokes-char-face) - (copy-face 'default 'strokes-char-face) - (set-face-background 'strokes-char-face "lightgray")) +;;;; strokes-xpm stuff (later may be separate)... + +;; This is the stuff that will eventuall be used for composing letters in +;; any language, compression, decompression, graphics, editing, etc. + +(require 'atomic-extents) ; might as well say + ; (require 'not-so-atomic-extents) + ; but what can you do? + +;;(unless (find-face 'strokes-char-face) +(copy-face 'default 'strokes-char-face) +(set-face-background 'strokes-char-face "lightgray") ; I should really + ; make this a + ; user-option, + ; but I'm too + ; lazy right now. + ; In a few days. (defconst strokes-char-value-hashtable (make-hashtable 62) ; ; (make-char-table ; 'syntax) ; in 20.* - ;; ### This will become a char-table for XEmacs-20 !!! ### + ;; ### This will/should become a char-table for XEmacs-20 !!! ### "The table which stores values for the character keys.") (puthash ?0 0 strokes-char-value-hashtable) ; (put-char-table ?0 0 ; strokes-value-chartable) @@ -1796,50 +1998,57 @@ (strokes-xpm-encode-length-as-string count))) "/")))) -(defun strokes-strokify-buffer (&optional buffer) +;;;###autoload +(defun strokes-decode-buffer (&optional buffer force) "Decode stroke strings in BUFFER and display their corresponding glyphs. -BUFFER defaults to the current buffer." +Optional BUFFER defaults to the current buffer. +Optional FORCE non-nil will ignore the buffer's read-only status." (interactive) ;; (interactive "*bStrokify buffer: ") (save-excursion - (set-buffer (or buffer (setq buffer (current-buffer)))) - (if (interactive-p) - (message "Strokifying %s..." buffer)) - (goto-char (point-min)) - (let (ext string) - ;; The comment below is what i'd have to do if I wanted to deal with - ;; random newlines in the midst of the compressed strings. - ;; If I do this, I'll also have to change `strokes-xpm-to-compress-string' - ;; to deal with the newline, and possibly other whitespace stuff. YUCK! - ;; (while (re-search-forward "\\+/\\(\\w\\| - ;;\\)+/" nil t nil (get-buffer buffer)) - (while (re-search-forward "\\+/\\w+/" nil t nil (get-buffer buffer)) - (setq string (buffer-substring (+ 2 (match-beginning 0)) - (1- (match-end 0)))) - (strokes-xpm-for-compressed-string string " *strokes-xpm*") - (replace-match " ") - (setq ext (make-extent (1- (point)) (point))) - (set-extent-property ext 'type 'stroke-glyph) - (set-extent-property ext 'start-open t) - (set-extent-property ext 'end-open t) - (set-extent-property ext 'detachable t) - (set-extent-property ext 'duplicable t) - (set-extent-property ext 'data string) - (set-extent-face ext 'strokes-char-face) - (set-extent-end-glyph ext (make-glyph - (list - (vector 'xpm - :data (buffer-substring - (point-min " *strokes-xpm*") - (point-max " *strokes-xpm*") - " *strokes-xpm*")) - [string :data "[Stroke]"]))))) - (if (interactive-p) - (message "Strokifying %s...done" buffer)))) + (set-buffer (setq buffer (get-buffer (or buffer (current-buffer))))) + (when (or (not buffer-read-only) + force + inhibit-read-only + (y-or-n-p-maybe-dialog-box + (format "Buffer %s is read-only. Strokify anyway? " buffer))) + (let ((inhibit-read-only t)) + (message "Strokifying %s..." buffer) + (goto-char (point-min)) + (let (ext string) + ;; The comment below is what i'd have to do if I wanted to + ;; deal with random newlines in the midst of the compressed + ;; strings. If I do this, I'll also have to change + ;; `strokes-xpm-to-compress-string' to deal with the newline, + ;; and possibly other whitespace stuff. YUCK! + ;; (while (re-search-forward "\\+/\\(\\w\\|\\)+/" nil t nil (get-buffer buffer)) + (while (re-search-forward "\\+/\\w+/" nil t nil buffer) + (setq string (buffer-substring (+ 2 (match-beginning 0)) + (1- (match-end 0)))) + (strokes-xpm-for-compressed-string string " *strokes-xpm*") + (replace-match " ") + (setq ext (make-extent (1- (point)) (point))) + (set-extent-property ext 'type 'stroke-glyph) + (set-extent-property ext 'start-open t) + (set-extent-property ext 'end-open t) + (set-extent-property ext 'detachable t) + (set-extent-property ext 'duplicable t) + (set-extent-property ext 'data string) + (set-extent-face ext 'default) + (set-extent-end-glyph ext (make-glyph + (list + (vector 'xpm + :data (buffer-substring + (point-min " *strokes-xpm*") + (point-max " *strokes-xpm*") + " *strokes-xpm*")) + [string :data "[Stroke]"]))))) + (message "Strokifying %s...done" buffer))))) -(defun strokes-unstrokify-buffer (&optional buffer) +(defun strokes-encode-buffer (&optional buffer force) "Convert the glyphs in BUFFER to thier base-64 ASCII representations. -BUFFER defaults to the current buffer" +Optional BUFFER defaults to the current buffer. +Optional FORCE non-nil will ignore the buffer's read-only status." ;; ### NOTE !!! ### (for me) ;; For later on, you can/should make the inserted strings atomic ;; extents, so that the users have a clue that they shouldn't be @@ -1853,30 +2062,39 @@ (interactive) (save-excursion (set-buffer (setq buffer (or buffer (current-buffer)))) - ;; (map-extents - ;; (lambda (ext buf) - ;; (when (eq (extent-property ext 'type) 'stroke-glyph) - ;; (goto-char (extent-start-position ext)) - ;; (delete-char 1) ; ### What the hell do I do here? ### - ;; (insert "+/" (extent-property ext 'data) "/") - ;; (delete-extent ext)))))) - (let (start) - (map-extents - (lambda (ext buf) - (when (eq (extent-property ext 'type) 'stroke-glyph) - (setq start (goto-char (extent-start-position ext))) -;; (insert "+/" (extent-property ext 'data) "/") - (insert-string "+/") - (insert-string (extent-property ext 'data)) - (insert-string "/") - (delete-char 1) - (set-extent-endpoints ext start (point)) - (set-extent-property ext 'type 'stroke-string) - (set-extent-property ext 'atomic t) -;; (set-extent-property ext 'read-only t) - (set-extent-face ext 'strokes-char-face) - (set-extent-property ext 'stroke-glyph (extent-end-glyph ext)) - (set-extent-end-glyph ext nil))))))) + (when (or (not buffer-read-only) + force + inhibit-read-only + (y-or-n-p-maybe-dialog-box + (format "Buffer %s is read-only. Encode anyway? " buffer))) + (message "Encoding strokes in %s..." buffer) + ;; (map-extents + ;; (lambda (ext buf) + ;; (when (eq (extent-property ext 'type) 'stroke-glyph) + ;; (goto-char (extent-start-position ext)) + ;; (delete-char 1) ; ### What the hell do I do here? ### + ;; (insert "+/" (extent-property ext 'data) "/") + ;; (delete-extent ext)))))) + (let ((inhibit-read-only t) + (start nil)) + (loop repeat 2 do ; ### KLUDGE!!! This it pure crap! ### + (map-extents + (lambda (ext buf) + (when (eq (extent-property ext 'type) 'stroke-glyph) + (setq start (goto-char (extent-start-position ext))) + ;; (insert "+/" (extent-property ext 'data) "/") + (insert-string "+/") + (insert-string (extent-property ext 'data)) + (insert-string "/") + (delete-char 1) + (set-extent-endpoints ext start (point)) + (set-extent-property ext 'type 'stroke-string) + (set-extent-property ext 'atomic t) + ;; (set-extent-property ext 'read-only t) + (set-extent-face ext 'strokes-char-face) + (set-extent-property ext 'stroke-glyph (extent-end-glyph ext)) + (set-extent-end-glyph ext nil)))))) + (message "Encoding strokes in %s...done" buffer)))) (defun strokes-xpm-for-compressed-string (compressed-string &optional bufname) "Convert the stroke represented by COMPRESSED-STRING into an xpm. @@ -1903,13 +2121,19 @@ (goto-char (point-min)) (insert strokes-xpm-header)))) +;;;###autoload (defun strokes-compose-complex-stroke () + ;; ### NOTE !!! ### + ;; Even though we have lexical scoping, it's somewhat ugly how I + ;; pass around variables in the global name space. I can/should + ;; change this. + "Read a complex stroke and insert its glyph into the current buffer." (interactive "*") (let ((strokes-grid-resolution 33)) (strokes-read-complex-stroke) - (strokes-xpm-for-stroke nil nil t) - (insert (strokes-xpm-to-compressed-string)) - (strokes-strokify-buffer))) + (strokes-xpm-for-stroke nil " *strokes-xpm*" t) + (insert (strokes-xpm-to-compressed-string " *strokes-xpm*")) + (strokes-decode-buffer))) (provide 'strokes) (run-hooks 'strokes-load-hook)
--- a/lisp/mule/mule-coding.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/mule/mule-coding.el Mon Aug 13 09:55:28 2007 +0200 @@ -187,7 +187,7 @@ (copy-coding-system 'ctext 'iso-8859-1) (make-coding-system - 'iso-2022-ss2-8 'iso2022 + 'iso-2022-8bit-ss2 'iso2022 "ISO-2022 coding system using SS2 for 96-charset in 8-bit code." '(charset-g0 ascii charset-g1 latin-iso8859-1 @@ -197,7 +197,7 @@ )) (make-coding-system - 'iso-2022-ss2-7 'iso2022 + 'iso-2022-7bit-ss2 'iso2022 "ISO-2022 coding system using SS2 for 96-charset in 7-bit code." '(charset-g0 ascii charset-g2 t ;; unspecified but can be used later. @@ -206,6 +206,8 @@ mnemonic "ISO7/SS" )) +(copy-coding-system 'iso-2022-7bit-ss2 'iso-2022-jp-2) + (make-coding-system 'iso-2022-7 'iso2022 "ISO-2022 seven-bit coding system. No single-shift or locking-shift."
--- a/lisp/packages/custom-load.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/packages/custom-load.el Mon Aug 13 09:55:28 2007 +0200 @@ -1,46 +1,46 @@ -(custom-put 'copyright 'custom-loads '("upd-copyr")) -(custom-put 'time-stamp 'custom-loads '("time-stamp")) -(custom-put 'texinfo-tex 'custom-loads '("texnfo-tex")) -(custom-put 'supercite-hooks 'custom-loads '("supercite")) -(custom-put 'supercite-cite 'custom-loads '("supercite")) -(custom-put 'supercite-attr 'custom-loads '("supercite")) -(custom-put 'supercite-frames 'custom-loads '("supercite")) -(custom-put 'supercite 'custom-loads '("supercite")) -(custom-put 'save-place 'custom-loads '("saveplace")) -(custom-put 'recent-files-menu 'custom-loads '("recent-files")) -(custom-put 'recent-files 'custom-loads '("recent-files")) -(custom-put 'remote-compile 'custom-loads '("rcompile")) -(custom-put 'ps-print-face 'custom-loads '("ps-print")) -(custom-put 'ps-print-color 'custom-loads '("ps-print")) -(custom-put 'ps-print-font 'custom-loads '("ps-print")) -(custom-put 'ps-print-header 'custom-loads '("ps-print")) -(custom-put 'ps-print-vertical 'custom-loads '("ps-print")) -(custom-put 'ps-print-horizontal 'custom-loads '("ps-print")) -(custom-put 'ps-print 'custom-loads '("ps-print")) -(custom-put 'pages 'custom-loads '("page-ext")) -(custom-put 'metamail 'custom-loads '("metamail")) -(custom-put 'man 'custom-loads '("man")) +(custom-put 'igrep 'custom-loads '("igrep")) +(custom-put 'change-log 'custom-loads '("add-log")) +(custom-put 'auto-save 'custom-loads '("auto-save")) +(custom-put 'avoid 'custom-loads '("avoid")) +(custom-put 'balloon-help 'custom-loads '("balloon-help")) +(custom-put 'compilation 'custom-loads '("compile")) +(custom-put 'completion 'custom-loads '("completion")) +(custom-put 'dabbrev 'custom-loads '("dabbrev")) +(custom-put 'desktop 'custom-loads '("desktop")) +(custom-put 'diff 'custom-loads '("diff")) +(custom-put 'etags 'custom-loads '("etags")) +(custom-put 'fast-lock 'custom-loads '("fast-lock")) +(custom-put 'feedmail 'custom-loads '("feedmail")) +(custom-put 'filladapt 'custom-loads '("filladapt")) +(custom-put 'fume 'custom-loads '("func-menu")) +(custom-put 'generic-sc 'custom-loads '("generic-sc")) +(custom-put 'gnuserv 'custom-loads '("gnuserv")) +(custom-put 'gopher 'custom-loads '("gopher")) +(custom-put 'hyper-apropos 'custom-loads '("hyper-apropos")) +(custom-put 'hyper-apropos-faces 'custom-loads '("hyper-apropos")) +(custom-put 'info 'custom-loads '("info")) +(custom-put 'ispell 'custom-loads '("ispell")) +(custom-put 'lpr 'custom-loads '("lpr")) (custom-put 'makeinfo 'custom-loads '("makeinfo")) -(custom-put 'lpr 'custom-loads '("lpr")) -(custom-put 'ispell 'custom-loads '("ispell")) -(custom-put 'info 'custom-loads '("info")) -(custom-put 'hyper-apropos-faces 'custom-loads '("hyper-apropos")) -(custom-put 'hyper-apropos 'custom-loads '("hyper-apropos")) -(custom-put 'gopher 'custom-loads '("gopher")) -(custom-put 'gnuserv 'custom-loads '("gnuserv")) -(custom-put 'generic-sc 'custom-loads '("generic-sc")) -(custom-put 'fume 'custom-loads '("func-menu")) -(custom-put 'filladapt 'custom-loads '("filladapt")) -(custom-put 'feedmail 'custom-loads '("feedmail")) -(custom-put 'fast-lock 'custom-loads '("fast-lock")) -(custom-put 'etags 'custom-loads '("etags")) -(custom-put 'diff 'custom-loads '("diff")) -(custom-put 'desktop 'custom-loads '("desktop")) -(custom-put 'dabbrev 'custom-loads '("dabbrev")) -(custom-put 'completion 'custom-loads '("completion")) -(custom-put 'compilation 'custom-loads '("compile")) -(custom-put 'balloon-help 'custom-loads '("balloon-help")) -(custom-put 'avoid 'custom-loads '("avoid")) -(custom-put 'auto-save 'custom-loads '("auto-save")) -(custom-put 'change-log 'custom-loads '("add-log")) -(custom-put 'igrep 'custom-loads '("igrep")) +(custom-put 'man 'custom-loads '("man")) +(custom-put 'metamail 'custom-loads '("metamail")) +(custom-put 'pages 'custom-loads '("page-ext")) +(custom-put 'ps-print 'custom-loads '("ps-print")) +(custom-put 'ps-print-horizontal 'custom-loads '("ps-print")) +(custom-put 'ps-print-vertical 'custom-loads '("ps-print")) +(custom-put 'ps-print-header 'custom-loads '("ps-print")) +(custom-put 'ps-print-font 'custom-loads '("ps-print")) +(custom-put 'ps-print-color 'custom-loads '("ps-print")) +(custom-put 'ps-print-face 'custom-loads '("ps-print")) +(custom-put 'remote-compile 'custom-loads '("rcompile")) +(custom-put 'recent-files 'custom-loads '("recent-files")) +(custom-put 'recent-files-menu 'custom-loads '("recent-files")) +(custom-put 'save-place 'custom-loads '("saveplace")) +(custom-put 'supercite 'custom-loads '("supercite")) +(custom-put 'supercite-frames 'custom-loads '("supercite")) +(custom-put 'supercite-attr 'custom-loads '("supercite")) +(custom-put 'supercite-cite 'custom-loads '("supercite")) +(custom-put 'supercite-hooks 'custom-loads '("supercite")) +(custom-put 'texinfo-tex 'custom-loads '("texnfo-tex")) +(custom-put 'time-stamp 'custom-loads '("time-stamp")) +(custom-put 'copyright 'custom-loads '("upd-copyr"))
--- a/lisp/packages/hyper-apropos.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/packages/hyper-apropos.el Mon Aug 13 09:55:28 2007 +0200 @@ -167,6 +167,7 @@ (define-key map "t" 'hyper-apropos-find-tag) (define-key map "l" 'hyper-apropos-last-help) (define-key map "c" 'hyper-apropos-customize-variable) + (define-key map "f" 'hyper-apropos-find-function) (define-key map [button2] 'hyper-apropos-mouse-get-doc) (define-key map [button3] 'hyper-apropos-popup-menu) ;; for the totally hardcore... @@ -192,7 +193,8 @@ ;; act on the current line... (define-key map "w" 'hyper-apropos-where-is) (define-key map "i" 'hyper-apropos-invoke-fn) - (define-key map "s" 'hyper-apropos-set-variable) +;; this is already defined in the parent-keymap above, isn't it? +;; (define-key map "s" 'hyper-apropos-set-variable) ;; more administrativa... (define-key map "P" 'hyper-apropos-toggle-programming-flag) (define-key map "k" 'hyper-apropos-add-keyword) @@ -1203,6 +1205,24 @@ ;; ---------------------------------------------------------------------- ;; +(defun hyper-apropos-find-function (fn) + "Find the function for the symbol on the current line in other +window. (See also `find-function'.)" + (interactive + (let ((fn (hyper-apropos-this-symbol))) + (or (fboundp fn) + (and (setq fn (and (eq major-mode 'hyper-apropos-help-mode) + (save-excursion + (goto-char (point-min)) + (hyper-apropos-this-symbol)))) + (fboundp fn)) + (setq fn nil)) + (list fn))) + (if fn + (find-function-other-window fn))) + +;; ---------------------------------------------------------------------- ;; + (defun hyper-apropos-disassemble (sym) "Disassemble FUN if it is byte-coded. If it's a lambda, prettyprint it." (interactive (list (hyper-apropos-this-symbol))) @@ -1251,7 +1271,11 @@ (defun hyper-apropos-popup-menu (event) (interactive "e") (mouse-set-point event) - (let* ((sym (hyper-apropos-this-symbol)) + (let* ((sym (or (hyper-apropos-this-symbol) + (and (eq major-mode 'hyper-apropos-help-mode) + (save-excursion + (goto-char (point-min)) + (hyper-apropos-this-symbol))))) (notjunk (not (null sym))) (command-p (if (commandp sym) t)) (variable-p (and sym (boundp sym))) @@ -1268,11 +1292,12 @@ nil (list (concat "Hyper-Help: " name) (vector "Display documentation" 'hyper-apropos-get-doc notjunk) - (vector "Set variable" 'hyper-apropos-set-variable variable-p) + (vector "Set variable" 'hyper-apropos-set-variable variable-p) (vector "Customize variable" 'hyper-apropos-customize-variable customizable-p) (vector "Show keys for" 'hyper-apropos-where-is command-p) - (vector "Invoke command" 'hyper-apropos-invoke-fn command-p) + (vector "Invoke command" 'hyper-apropos-invoke-fn command-p) + (vector "Find function" 'hyper-apropos-find-function function-p) (vector "Find tag" 'hyper-apropos-find-tag notjunk) (and apropos-p ["Add keyword..." hyper-apropos-add-keyword t])
--- a/lisp/packages/info.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/packages/info.el Mon Aug 13 09:55:28 2007 +0200 @@ -832,7 +832,7 @@ (goto-char (+ pt len)) (save-excursion (goto-char pt) - (if (search-forward "* menu:" (+ pt len) t) + (if (search-forward "* Menu:" (+ pt len) t) (progn (forward-line 1) (delete-region pt (point))))))) @@ -855,7 +855,7 @@ (setq others (cdr others)))) ;; Add to the main menu a menu item for each other node. - (re-search-forward "^\\* Menu:") + (re-search-forward "^\\* Menu:" nil t) (forward-line 1) (let ((menu-items '("top")) (nodes nodes) @@ -2239,6 +2239,40 @@ (and name (nth 1 data)))) (error nil))) +(defun Info-mouse-track-double-click-hook (event click-count) + "Handle double-clicks by turning pages, like the `gv' ghostscript viewer" + (if (/= click-count 2) + ;; Return nil so any other hooks are performed. + nil + (let* ((x (event-x-pixel event)) + (y (event-y-pixel event)) + (w (window-pixel-width (event-window event))) + (h (window-pixel-height (event-window event))) + (w/3 (/ w 3)) + (w/2 (/ w 2)) + (h/4 (/ h 4))) + (cond + ;; In the top 1/4 and inside the middle 1/3 + ((and (<= y h/4) + (and (>= x w/3) (<= x (+ w/3 w/3)))) + (Info-up) + t) + ;; In the lower 3/4 and the right 1/2 + ;; OR in the upper 1/4 and the right 1/3 + ((or (and (>= y h/4) (>= x w/2)) + (and (< y h/4) (>= x (+ w/3 w/3)))) + (Info-next) + t) + ;; In the lower 3/4 and the left 1/2 + ;; OR in the upper 1/4 and the left 1/3 + ((or (and (>= y h/4) (< x w/2)) + (and (< y h/4) (<= x w/3))) + (Info-prev) + t) + ;; This shouldn't happen. + (t + (error "event out of bounds: %s %s" x y)))))) + (defvar Info-mode-map nil "Keymap containing Info commands.") (if Info-mode-map @@ -2385,6 +2419,7 @@ (copy-face 'bold 'info-xref)))) (make-local-variable 'mouse-track-click-hook) (add-hook 'mouse-track-click-hook 'Info-maybe-follow-clicked-node) + (add-hook 'mouse-track-click-hook 'Info-mouse-track-double-click-hook) ;; #### The console-on-window-system-p check is to allow this to ;; work on tty's. The real problem here is that featurep really ;; needs to have some device/console domain knowledge added to it.
--- a/lisp/packages/lpr.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/packages/lpr.el Mon Aug 13 09:55:28 2007 +0200 @@ -115,8 +115,27 @@ (print-region-1 start end lpr-switches t)) ;; XEmacs change -(require 'message) ; Until We can get some sensible autoloads, or +;; (require 'message) ; Until We can get some sensible autoloads, or ; message-flatten-list gets put somewhere decent. +;; Sigh ... +;; `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 lpr-flatten-list (&rest list) + (lpr-flatten-list-1 list)) + +(defun lpr-flatten-list-1 (list) + (cond + ((null list) (list)) + ((consp list) + (append (lpr-flatten-list-1 (car list)) + (lpr-flatten-list-1 (cdr list)))) + (t (list list)))) + (defun print-region-1 (start end switches page-headers) ;; On some MIPS system, having a space in the job name ;; crashes the printer demon. But using dashes looks ugly @@ -139,7 +158,7 @@ (list lpr-headers-switches) lpr-headers-switches) switches)))) - (setq nswitches (message-flatten-list ; XEmacs + (setq nswitches (lpr-flatten-list ; XEmacs (mapcar '(lambda (arg) ; Dynamic evaluation (cond ((stringp arg) arg) ((functionp arg) (apply arg nil))
--- a/lisp/packages/time.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/packages/time.el Mon Aug 13 09:55:28 2007 +0200 @@ -932,6 +932,8 @@ (push (display-time-convert-num 12-hours t) tmp)) ((eq elem 'minutes) (push (display-time-convert-num minutes) tmp)) + ((eq elem 'seconds) + (push (display-time-convert-num seconds) tmp)) ((eq elem 'minutes-text) (push (display-time-convert-num minutes t) tmp)) ((eq elem 'am-pm)
--- a/lisp/pcl-cvs/ChangeLog Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/pcl-cvs/ChangeLog Mon Aug 13 09:55:28 2007 +0200 @@ -1,3 +1,8 @@ +1997-08-28 SL Baur <steve@altair.xemacs.org> + + * pcl-cvs.el (cvs-changelog-ours-p): correct for drift in + `user-full-name' semantics. + Fri May 2 20:04:35 1997 Steven L Baur <steve@altair.xemacs.org> * pcl-cvs.el (cvs-update): Inhibit dialog box usage in call to
--- a/lisp/pcl-cvs/pcl-cvs.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/pcl-cvs/pcl-cvs.el Mon Aug 13 09:55:28 2007 +0200 @@ -1,10 +1,10 @@ ;;; ;;;#ident "@(#)OrigId: pcl-cvs.el,v 1.93 1993/05/31 22:44:00 ceder Exp " ;;; -;;;#ident "@(#)cvs/contrib/pcl-cvs:$Name: r20-2b5 $:$Id: pcl-cvs.el,v 1.4 1997/05/09 03:28:08 steve Exp $" +;;;#ident "@(#)cvs/contrib/pcl-cvs:$Name: r20-3b19 $:$Id: pcl-cvs.el,v 1.5 1997/09/03 02:55:39 steve Exp $" ;;; ;;; pcl-cvs.el -- A Front-end to CVS 1.3 or later. -;;; Release 1.05-CVS-$Name: r20-2b5 $. +;;; Release 1.05-CVS-$Name: r20-3b19 $. ;;; Copyright (C) 1991, 1992, 1993 Per Cederqvist ;;; This program is free software; you can redistribute it and/or modify @@ -126,7 +126,7 @@ ;;; END OF THINGS TO CHECK WHEN INSTALLING ;;; -------------------------------------------------------- -(defconst pcl-cvs-version "1.05-CVS-$Name: r20-2b5 $" +(defconst pcl-cvs-version "1.05-CVS-$Name: r20-3b19 $" "A string denoting the current release version of pcl-cvs.") ;; You are NOT allowed to disable this message by default. However, you @@ -139,8 +139,8 @@ (defconst cvs-startup-message (if cvs-inhibit-copyright-message - "PCL-CVS release 1.05-CVS-$Name: r20-2b5 $" - "PCL-CVS release 1.05 from CVS release $Name: r20-2b5 $. + "PCL-CVS release 1.05-CVS-$Name: r20-3b19 $" + "PCL-CVS release 1.05 from CVS release $Name: r20-3b19 $. Copyright (C) 1992, 1993 Per Cederqvist Pcl-cvs comes with absolutely no warranty; for details consult the manual. This is free software, and you are welcome to redistribute it under certain @@ -727,7 +727,7 @@ \\[cvs-mode-undo-local-changes] Revert the last checked in version - discard your changes to the file. Entry to this mode runs cvs-mode-hook. -This description is updated for release 1.05-CVS-$Name: r20-2b5 $ of pcl-cvs. +This description is updated for release 1.05-CVS-$Name: r20-3b19 $ of pcl-cvs. All bindings: \\{cvs-mode-map}" @@ -1016,7 +1016,7 @@ (insert "Pcl-cvs Version: " "@(#)OrigId: pcl-cvs.el,v 1.93 1993/05/31 22:44:00 ceder Exp\n") (insert "CVS Version: " - "@(#)lisp/pcl-cvs:$Name: r20-2b5 $:$Id: pcl-cvs.el,v 1.4 1997/05/09 03:28:08 steve Exp $\n\n") + "@(#)lisp/pcl-cvs:$Name: r20-3b19 $:$Id: pcl-cvs.el,v 1.5 1997/09/03 02:55:39 steve Exp $\n\n") (insert (format "--- Contents of stdout buffer (%d chars) ---\n" (length stdout))) (insert stdout) @@ -3313,7 +3313,9 @@ (regexp-quote (if (and (boundp 'add-log-full-name) add-log-full-name) add-log-full-name - user-full-name)) + (or (and (boundp 'user-full-name) + user-full-name) + (user-full-name)))) " <" (regexp-quote (if (and (boundp 'add-log-mailing-address) add-log-mailing-address)
--- a/lisp/prim/about.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/prim/about.el Mon Aug 13 09:55:28 2007 +0200 @@ -512,7 +512,7 @@ (erase-buffer) (let ((coding-system-for-read 'binary) (coding-system-for-write 'binary)) - (insert-file-contents file) + (insert-file-contents-literally file) (call-process-region (point-min) (point-max) "zcat" t t nil) (setq data
--- a/lisp/prim/cus-load.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/prim/cus-load.el Mon Aug 13 09:55:28 2007 +0200 @@ -35,7 +35,7 @@ (let ((dir load-path)) (while dir (condition-case nil - (load (concat (car dir) "/custom-load") nil t) + (load (concat (car dir) "custom-load") nil nil) (file-error nil)) (pop dir)))
--- a/lisp/prim/files.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/prim/files.el Mon Aug 13 09:55:28 2007 +0200 @@ -635,6 +635,7 @@ (frame (make-frame (if name (list (cons 'name (symbol-name name))))))) (pop-to-buffer buffer t frame) + (select-frame frame) (make-frame-visible frame) buffer)) @@ -946,7 +947,7 @@ If a buffer exists visiting FILENAME, return that one, but verify that the file has not changed since visited or saved. The buffer is not selected, just returned to the caller. -If NOWARN is non-nil warning messages about several potential +If NOWARN is non-nil, warning messages about several potential problems will be suppressed." (setq filename (abbreviate-file-name (expand-file-name filename))) (if (file-directory-p filename) @@ -976,15 +977,15 @@ ; (if (or find-file-existing-other-name find-file-visit-truename) ; (setq buf (or same-truename same-number))) - (if (and buf - (or find-file-compare-truenames find-file-use-truenames) - (not nowarn)) - (save-excursion - (set-buffer buf) - (if (not (string-equal buffer-file-name filename)) - (message "%s and %s are the same file (%s)" - filename buffer-file-name - buffer-file-truename)))) + (when (and buf + (or find-file-compare-truenames find-file-use-truenames) + (not nowarn)) + (save-excursion + (set-buffer buf) + (if (not (string-equal buffer-file-name filename)) + (message "%s and %s are the same file (%s)" + filename buffer-file-name + buffer-file-truename)))) (if buf (or nowarn @@ -1008,6 +1009,7 @@ (save-excursion (set-buffer buf) (revert-buffer t t))))) + ;; Else: we must create a new buffer for filename (save-excursion ;;; The truename stuff makes this obsolete. ;;; (let* ((link-name (car (file-attributes filename))) @@ -1066,7 +1068,8 @@ (setq backup-inhibited t))) (if rawfile nil - (after-find-file error (not nowarn))))) + (after-find-file error (not nowarn)) + (setq buf (current-buffer))))) buf))) (defvar after-find-file-from-revert-buffer nil) @@ -1935,6 +1938,7 @@ "Given the name of a numeric backup file, return the backup number. Uses the free variable `bv-length', whose value should be the index in the name where the version number begins." + (declare (special bv-length)) (if (and (string-match "[0-9]+~\\'" fn bv-length) (= (match-beginning 0) bv-length)) (string-to-int (substring fn bv-length -1))
--- a/lisp/prim/help.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/prim/help.el Mon Aug 13 09:55:28 2007 +0200 @@ -411,22 +411,23 @@ (lambda () (princ (key-description key)) (princ " runs ") - (princ (format "`%s'" defn)) + (if (symbolp defn) (princ (format "`%S'" defn)) + (prin1 defn)) (princ "\n\n") (cond ((or (stringp defn) (vectorp defn)) (let ((cmd (key-binding defn))) (if (not cmd) (princ "a keyboard macro") (progn - (princ (format "a keyboard macro which runs the command %s:\n\n" - cmd)) - (princ cmd) - (princ "\n") + (princ "a keyboard macro which runs the command ") + (prin1 cmd) + (princ ":\n\n") (if (documentation cmd) (princ (documentation cmd))))))) ((and (consp defn) (not (eq 'lambda (car-safe defn)))) - (princ "\n") (let ((describe-function-show-arglist nil)) (describe-function-1 (car defn) standard-output))) + ((symbolp defn) + (describe-function-1 defn standard-output)) ((documentation defn) (princ (documentation defn))) (t @@ -557,6 +558,9 @@ (insert "Global Bindings:\n" heading) (describe-bindings-internal (current-global-map) nil shadow prefix mouse-only-p) + (when (and prefix function-key-map (not mouse-only-p)) + (insert "\nFunction key map translations:\n" heading) + (describe-bindings-internal function-key-map nil nil prefix mouse-only-p)) (set-buffer buffer))) (defun describe-prefix-bindings () @@ -860,19 +864,21 @@ (princ (format "`%S' is " function) stream) (let* ((def function) file-name - (doc (or (documentation function) - (gettext "not documented"))) + (doc (condition-case nil + (or (documentation function) + (gettext "not documented")) + (void-function ""))) aliases home kbd-macro-p fndef macrop) - (while (symbolp def) - (or (eq def function) - (if aliases - ;; I18N3 Need gettext due to concat - (setq aliases (concat aliases - (format - "\n which is an alias for `%s', " - (symbol-name def)))) - (setq aliases (format "an alias for `%s', " - (symbol-name def))))) + (while (and (symbolp def) (fboundp def)) + (when (not (eq def function)) + (setq aliases + (if aliases + ;; I18N3 Need gettext due to concat + (concat aliases + (format + "\n which is an alias for `%s', " + (symbol-name def))) + (format "an alias for `%s', " (symbol-name def))))) (setq def (symbol-function def))) (if (compiled-function-p def) (setq home (compiled-function-annotation def))) @@ -910,6 +916,8 @@ ((eq (car-safe def) 'autoload) (setq file-name (elt def 1)) (funcall int "autoloaded Lisp" t (elt def 4))) + ((and (symbolp def) (not (fboundp def))) + (princ "a symbol with a void (unbound) function definition." stream)) (t nil))) (princ "\n") @@ -961,22 +969,19 @@ ;; encouragement to use the new function. (let ((obsolete (function-obsoleteness-doc function)) (compatible (function-compatibility-doc function))) - (if obsolete - (progn - (princ obsolete stream) - (terpri stream) - (terpri stream))) - (if compatible - (progn - (princ compatible stream) - (terpri stream) - (terpri stream))) - (if (not (and obsolete aliases)) - (progn - (princ doc stream) - (or (equal doc "") - (eq ?\n (aref doc (1- (length doc)))) - (terpri stream))))))))) + (when obsolete + (princ obsolete stream) + (terpri stream) + (terpri stream)) + (when compatible + (princ compatible stream) + (terpri stream) + (terpri stream)) + (unless (and obsolete aliases) + (princ doc stream) + (unless (or (equal doc "") + (eq ?\n (aref doc (1- (length doc))))) + (terpri stream)))))))) (defun describe-function-arglist (function) @@ -999,20 +1004,19 @@ (defun variable-at-point () - (condition-case () - (let ((stab (syntax-table))) - (unwind-protect - (save-excursion - (set-syntax-table emacs-lisp-mode-syntax-table) - (or (not (zerop (skip-syntax-backward "_w"))) - (eq (char-syntax (char-after (point))) ?w) - (eq (char-syntax (char-after (point))) ?_) - (forward-sexp -1)) - (skip-chars-forward "'") - (let ((obj (read (current-buffer)))) - (and (symbolp obj) (boundp obj) obj))) - (set-syntax-table stab))) - (error nil))) + (ignore-errors + (let ((stab (syntax-table))) + (unwind-protect + (save-excursion + (set-syntax-table emacs-lisp-mode-syntax-table) + (or (not (zerop (skip-syntax-backward "_w"))) + (eq (char-syntax (char-after (point))) ?w) + (eq (char-syntax (char-after (point))) ?_) + (forward-sexp -1)) + (skip-chars-forward "'") + (let ((obj (read (current-buffer)))) + (and (symbolp obj) (boundp obj) obj))) + (set-syntax-table stab))))) (defun variable-obsolete-p (variable) "Return non-nil if VARIABLE is obsolete." @@ -1433,7 +1437,7 @@ If the optional argument PATH is given, the library where FUNCTION is defined is searched in PATH instead of `load-path'" - (interactive (ff-read-function)) + (interactive (find-function-read-function)) (let ((buffer-point (find-function-noselect function path))) (if buffer-point (progn @@ -1450,7 +1454,7 @@ If the optional argument PATH is given, the library where FUNCTION is defined is searched in PATH instead of `load-path'" - (interactive (ff-read-function)) + (interactive (find-function-read-function)) (let ((buffer-point (find-function-noselect function path))) (if buffer-point (progn @@ -1467,7 +1471,7 @@ If the optional argument PATH is given, the library where FUNCTION is defined is searched in PATH instead of `load-path'" - (interactive (ff-read-function)) + (interactive (find-function-read-function)) (let ((buffer-point (find-function-noselect function path))) (if buffer-point (progn
--- a/lisp/prim/keymap.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/prim/keymap.el Mon Aug 13 09:55:28 2007 +0200 @@ -359,55 +359,40 @@ ;FSFmacs #### ;;; Support keyboard commands to turn on various modifiers. -; + ;;; These functions -- which are not commands -- each add one modifier ;;; to the following event. -; -;(defun event-apply-alt-modifier (ignore-prompt) -; (vector (event-apply-modifier (read-event) 'alt 22 "A-"))) -;(defun event-apply-super-modifier (ignore-prompt) -; (vector (event-apply-modifier (read-event) 'super 23 "s-"))) -;(defun event-apply-hyper-modifier (ignore-prompt) -; (vector (event-apply-modifier (read-event) 'hyper 24 "H-"))) -;(defun event-apply-shift-modifier (ignore-prompt) -; (vector (event-apply-modifier (read-event) 'shift 25 "S-"))) -;(defun event-apply-control-modifier (ignore-prompt) -; (vector (event-apply-modifier (read-event) 'control 26 "C-"))) -;(defun event-apply-meta-modifier (ignore-prompt) -; (vector (event-apply-modifier (read-event) 'meta 27 "M-"))) -; -;(defun event-apply-modifier (event symbol lshiftby prefix) -; "Apply a modifier flag to event EVENT. -;SYMBOL is the name of this modifier, as a symbol. -;LSHIFTBY is the numeric value of this modifier, in keyboard events. -;PREFIX is the string that represents this modifier in an event type symbol." -; (if (numberp event) -; (cond ((eq symbol 'control) -; (if (and (<= (downcase event) ?z) -; (>= (downcase event) ?a)) -; (- (downcase event) ?a -1) -; (if (and (<= (downcase event) ?Z) -; (>= (downcase event) ?A)) -; (- (downcase event) ?A -1) -; (logior (lsh 1 lshiftby) event)))) -; ((eq symbol 'shift) -; (if (and (<= (downcase event) ?z) -; (>= (downcase event) ?a)) -; (upcase event) -; (logior (lsh 1 lshiftby) event))) -; (t -; (logior (lsh 1 lshiftby) event))) -; (if (memq symbol (event-modifiers event)) -; event -; (let ((event-type (if (symbolp event) event (car event)))) -; (setq event-type (intern (concat prefix (symbol-name event-type)))) -; (if (symbolp event) -; event-type -; (cons event-type (cdr event))))))) -; -;(define-key function-key-map [?\C-x ?@ ?h] 'event-apply-hyper-modifier) -;(define-key function-key-map [?\C-x ?@ ?s] 'event-apply-super-modifier) -;(define-key function-key-map [?\C-x ?@ ?m] 'event-apply-meta-modifier) -;(define-key function-key-map [?\C-x ?@ ?a] 'event-apply-alt-modifier) -;(define-key function-key-map [?\C-x ?@ ?S] 'event-apply-shift-modifier) -;(define-key function-key-map [?\C-x ?@ ?c] 'event-apply-control-modifier) + +(defun event-apply-alt-modifier (ignore-prompt) + (event-apply-modifier 'alt)) +(defun event-apply-super-modifier (ignore-prompt) + (event-apply-modifier 'super)) +(defun event-apply-hyper-modifier (ignore-prompt) + (event-apply-modifier 'hyper)) +(defun event-apply-shift-modifier (ignore-prompt) + (event-apply-modifier 'shift)) +(defun event-apply-control-modifier (ignore-prompt) + (event-apply-modifier 'control)) +(defun event-apply-meta-modifier (ignore-prompt) + (event-apply-modifier 'meta)) + +(defun event-apply-modifier (symbol) + "Return the next key event, with a modifier flag applied. +SYMBOL is the name of this modifier, as a symbol." + (let (event) + (while (not (key-press-event-p (setq event (next-command-event)))) + (dispatch-event event)) + (vector (append (list symbol) + (delq symbol (event-modifiers event)) + (list (event-key event)))))) + +(add-hook + 'create-console-hook + (lambda (console) + (letf (((selected-console) console)) + (define-key function-key-map [?\C-x ?@ ?h] 'event-apply-hyper-modifier) + (define-key function-key-map [?\C-x ?@ ?s] 'event-apply-super-modifier) + (define-key function-key-map [?\C-x ?@ ?m] 'event-apply-meta-modifier) + (define-key function-key-map [?\C-x ?@ ?S] 'event-apply-shift-modifier) + (define-key function-key-map [?\C-x ?@ ?c] 'event-apply-control-modifier) + (define-key function-key-map [?\C-x ?@ ?a] 'event-apply-alt-modifier))))
--- a/lisp/prim/make-docfile.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/prim/make-docfile.el Mon Aug 13 09:55:28 2007 +0200 @@ -40,9 +40,6 @@ (defvar site-file-list nil) (defvar docfile-out-of-date nil) -;; BOGUS -(defvar find-file-hooks nil) - ;; Gobble up the stuff we don't wish to pass on. (setq command-line-args (cdr (cdr (cdr (cdr command-line-args)))))
--- a/lisp/prim/mouse.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/prim/mouse.el Mon Aug 13 09:55:28 2007 +0200 @@ -32,7 +32,11 @@ (global-set-key '(control shift button1) 'mouse-track-delete-and-insert) (global-set-key '(meta button1) 'mouse-track-do-rectangle) -(global-set-key 'button2 'mouse-yank) +;; enable drag regions (ograf@fga.de) +(if (or (featurep 'offix) ;; do we have DnD support? + (featurep 'cde)) + (global-set-key 'button2 'mouse-drag-or-yank) + (global-set-key 'button2 'mouse-yank)) (defcustom mouse-track-rectangle-p nil "*If true, then dragging out a region with the mouse selects rectangles @@ -141,16 +145,30 @@ (or (point-inside-extent-p primary-selection-extent) (point-inside-extent-p zmacs-region-extent))) -;;; #### - finish this... -;;; (defun mouse-drag-or-yank (event) -;;; "Either drag or paste the current selection. If the variable -;;; `mouse-yank-at-point' is non-nil, then moves the cursor to the location of -;;; the click before pasting." -;;; (interactive "e") -;;; (if (click-inside-selection-p event) -;;; ;; okay, this is a drag -;;; ) -;;; ) +(defun mouse-drag-or-yank (event) + "Either drag or paste the current selection. If the variable + `mouse-yank-at-point' is non-nil, then moves the cursor to the location of + the click before pasting. + This functions has to be improved. Until now it is just a (working) test." + ;; by ograf@fga.de + (interactive "e") + (if (click-inside-extent-p event zmacs-region-extent) + ;; okay, this is a drag + (cond ((featurep 'offix) + (offix-start-drag-region event + (extent-start-position zmacs-region-extent) + (extent-end-position zmacs-region-extent))) + ((featurep 'cde) + ;; should also work with CDE + (cde-start-drag + (extent-start-position zmacs-region-extent) + (extent-end-position zmacs-region-extent))) + (t ding)) + ;; no drag, call region-funct + (and (not mouse-yank-at-point) + (mouse-set-point event)) + (funcall mouse-yank-function)) + ) (defun mouse-eval-sexp (click force-window) "Evaluate the sexp under the mouse. Usually, this is the last sexp before
--- a/lisp/prim/packages.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/prim/packages.el Mon Aug 13 09:55:28 2007 +0200 @@ -113,14 +113,15 @@ ;; consider all combinations of library suffixes ;; and compression suffixes. (if (or (rassq 'jka-compr-handler file-name-handler-alist) - (member 'crypt-find-file-hook find-file-hooks)) - (apply 'nconc - (mapcar (lambda (compelt) - (mapcar (lambda (baselt) - (concat baselt compelt)) - basic)) - compressed)) - basic))))) + (and (boundp 'find-file-hooks) + (member 'crypt-find-file-hook find-file-hooks))) + (apply 'nconc + (mapcar (lambda (compelt) + (mapcar (lambda (baselt) + (concat baselt compelt)) + basic)) + compressed)) + basic))))) (or path load-path))) (and interactive-call (if result @@ -183,13 +184,13 @@ ;; Lisp files (if (file-directory-p (concat package "/lisp")) (progn - (setq load-path (cons (concat package "/lisp") load-path)) + (setq load-path (cons (concat package "/lisp/") load-path)) (let ((dirs (directory-files (concat package "/lisp/") t "^[^-.]" nil 'dirs-only)) dir) (while dirs (setq dir (car dirs)) - (setq load-path (cons dir load-path)) + (setq load-path (cons (concat dir "/") load-path)) (packages-find-packages-1 dir path-only) (setq dirs (cdr dirs)))))))
--- a/lisp/prim/update-elc.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/prim/update-elc.el Mon Aug 13 09:55:28 2007 +0200 @@ -47,9 +47,6 @@ (defvar processed nil) (defvar update-elc-files-to-compile nil) -;; BOGUS -(defvar find-file-hooks nil) - ;(setq update-elc-files-to-compile ; (delq nil ; (mapcar (function @@ -138,7 +135,7 @@ (load "loadup-el.el")) (condition-case nil (delete-file "./NOBYTECOMPILE") - (t nil))) + (file-error nil))) (kill-emacs)
--- a/lisp/psgml/custom-load.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/psgml/custom-load.el Mon Aug 13 09:55:28 2007 +0200 @@ -1,7 +1,7 @@ -(custom-put 'tempo 'custom-loads '("tempo")) -(custom-put 'psgml-dtd 'custom-loads '("psgml")) -(custom-put 'psgml-insert 'custom-loads '("psgml")) +(custom-put 'html 'custom-loads '("psgml-html")) +(custom-put 'psgml-html 'custom-loads '("psgml-html")) +(custom-put 'sgml 'custom-loads '("psgml-html" "psgml")) (custom-put 'psgml 'custom-loads '("psgml-html" "psgml")) -(custom-put 'sgml 'custom-loads '("psgml-html" "psgml")) -(custom-put 'psgml-html 'custom-loads '("psgml-html")) -(custom-put 'html 'custom-loads '("psgml-html")) +(custom-put 'psgml-insert 'custom-loads '("psgml")) +(custom-put 'psgml-dtd 'custom-loads '("psgml")) +(custom-put 'tempo 'custom-loads '("tempo"))
--- a/lisp/psgml/psgml.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/psgml/psgml.el Mon Aug 13 09:55:28 2007 +0200 @@ -1,5 +1,5 @@ ;;; psgml.el --- SGML-editing mode with parsing support -;; $Id: psgml.el,v 1.7 1997/04/10 05:55:50 steve Exp $ +;; $Id: psgml.el,v 1.8 1997/09/03 02:55:43 steve Exp $ ;; Copyright (C) 1993, 1994, 1995, 1996 Lennart Staflin ;; Copyright (C) 1992 Free Software Foundation, Inc. @@ -384,7 +384,7 @@ ;; Wing change (concat "%S:" (directory-file-name sgml-data-directory) - "%o/%c/%d"))) + "/%o/%c/%d"))) "*Mapping from public identifiers to file names. This is a list of possible file names. To find the file for a public
--- a/lisp/sunpro/sunpro-init.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/sunpro/sunpro-init.el Mon Aug 13 09:55:28 2007 +0200 @@ -127,24 +127,24 @@ (setq internal-doc-file-name mule-doc-file-name)))) ;; Connect to tooltalk, but only on an X server. - (and (featurep 'tooltalk) - (fboundp 'command-line-do-tooltalk) - (eq 'x (device-type)) - (command-line-do-tooltalk nil)) + (when (and (featurep 'tooltalk) + (fboundp 'command-line-do-tooltalk) + (eq 'x (device-type))) + (command-line-do-tooltalk nil)) ;; Sun's pending-del default is like textedit's (require 'pending-del) - (pending-delete-on nil) + (turn-on-pending-delete) ;; Bar cursor 2 pixels wide (setq bar-cursor 2) ;; Nice CDE compliant icon -- now the default... - ;(if (featurep 'xpm) - ; (set-glyph-image - ; frame-icon-glyph - ; (format "%s%s" data-directory "xemacs-icon3.xpm") - ; 'global 'x)) + ;;(if (featurep 'xpm) + ;; (set-glyph-image + ;; frame-icon-glyph + ;; (format "%s%s" data-directory "xemacs-icon3.xpm") + ;; 'global 'x)) (cond ;; Use Sun WorkShop if available
--- a/lisp/tm/tm-image.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/tm/tm-image.el Mon Aug 13 09:55:28 2007 +0200 @@ -7,7 +7,7 @@ ;; Dan Rich <drich@morpheus.corp.sgi.com> ;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; Created: 1995/12/15 -;; Version: $Id: tm-image.el,v 1.8 1997/07/13 22:41:52 steve Exp $ +;; Version: $Id: tm-image.el,v 1.9 1997/09/03 02:55:43 steve Exp $ ;; Keywords: image, picture, X-Face, MIME, multimedia, mail, news
--- a/lisp/utils/autoload.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/utils/autoload.el Mon Aug 13 09:55:28 2007 +0200 @@ -607,6 +607,8 @@ (not (looking-at ";;; DO NOT MODIFY THIS FILE"))) (progn (insert ";;; DO NOT MODIFY THIS FILE\n") + (insert "(if (featurep '" sym "-autoloads)") + (insert " (error \"Already loaded\"))") (goto-char (point-max)) (insert "\n(provide '" sym ")\n")))))
--- a/lisp/utils/custom-load.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/utils/custom-load.el Mon Aug 13 09:55:28 2007 +0200 @@ -1,14 +1,13 @@ -(custom-put 'highlight-headers-faces 'custom-loads '("highlight-headers")) -(custom-put 'crontab 'custom-loads '("crontab")) -(custom-put 'browse-url 'custom-loads '("browse-url")) -(custom-put 'detached-minibuf 'custom-loads '("detached-minibuf")) -(custom-put 'edmacro 'custom-loads '("edmacro")) -(custom-put 'eldoc 'custom-loads '("eldoc")) +(custom-put 'uniquify 'custom-loads '("uniquify")) +(custom-put 'smtpmail 'custom-loads '("smtpmail")) +(custom-put 'savehist 'custom-loads '("savehist")) +(custom-put 'ph 'custom-loads '("ph")) +(custom-put 'passwd 'custom-loads '("passwd")) +(custom-put 'highlight-headers 'custom-loads '("highlight-headers")) (custom-put 'elp 'custom-loads '("elp")) -(custom-put 'highlight-headers 'custom-loads '("highlight-headers")) -(custom-put 'message-headers 'custom-loads '()) -(custom-put 'passwd 'custom-loads '("passwd")) -(custom-put 'ph 'custom-loads '("ph")) -(custom-put 'savehist 'custom-loads '("savehist")) -(custom-put 'smtpmail 'custom-loads '("smtpmail")) -(custom-put 'uniquify 'custom-loads '("uniquify")) +(custom-put 'eldoc 'custom-loads '("eldoc")) +(custom-put 'edmacro 'custom-loads '("edmacro")) +(custom-put 'detached-minibuf 'custom-loads '("detached-minibuf")) +(custom-put 'browse-url 'custom-loads '("browse-url")) +(custom-put 'crontab 'custom-loads '("crontab")) +(custom-put 'highlight-headers-faces 'custom-loads '("highlight-headers"))
--- a/lisp/utils/edit-toolbar.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/utils/edit-toolbar.el Mon Aug 13 09:55:28 2007 +0200 @@ -57,10 +57,12 @@ ;; - Added context sensitivity to `edit-toolbar-menu'. ;; - Added support for `nil' toolbar item (left/right divider). ;; - Enabled editing of empty toolbars. +;; Modified by Jeff Miller <jmiller@smart.net> 17 Aug 1997 +;; - Modfied how added toolbar buttons are created and saved. ;;; Code: -(defvar edit-toolbar-version "1.02" +(defvar edit-toolbar-version "1.03" "Version of Edit Toolbar.") (defvar edit-toolbar-temp-toolbar-name nil @@ -79,6 +81,16 @@ ".toolbar") "File name to save toolbars to. Defaults to \"~/.xemacs/.toolbar\"") +(defvar edit-toolbar-button-prefix "edit-toolbar-button" + "Prefix to use when naming new buttons created by edit-toolbar. +The new buttons will be stored in the file named by edit-toolbar-file-name") + +(defvar edit-toolbar-added-buttons-alist nil + "Buttons added by edit-toolbar. +A list of cons cells. The car is the variable which stores the glyph data. +The cdr is a list of filenames to be passed as arguments to +toolbar-make-button-list when the toolbar file is read at startup.") + (defvar edit-toolbar-menu '("Edit Toolbar" ["Move This Item Up" edit-toolbar-up (>= (edit-toolbar-current-index) 0)] @@ -303,7 +315,17 @@ "Remove the current toolbar button." (interactive) (let* ((toolbar (specifier-instance edit-toolbar-temp-toolbar)) - (index (- (count-lines (point-min) (point)) 2))) + (index (- (count-lines (point-min) (point)) 2)) + (etk-scratch-list) + (button (elt (nth index toolbar) 0 ))) + + (mapcar + (lambda (cons) + (if (not (memq button cons)) + (setq etk-scratch-list (append etk-scratch-list cons))) + ) + edit-toolbar-added-buttons-alist) + (setq edit-toolbar-added-buttons-alist etk-scratch-list) (if (eq index 0) (setq toolbar (cdr toolbar)) (setcdr (nthcdr (1- index) toolbar) @@ -432,22 +454,28 @@ "UP CAPTIONED glyph (RET for no glyph): " "DOWN CAPTIONED glyph (RET for no glyph): " "DISABLED CAPTIONED glyph (RET for no glyph): ")) - (glyphs nil) + (glyphs-list nil) (count 0)) (let ((glyph-file (read-file-name (car prompts) nil ""))) (if (string-equal glyph-file "") (error "You must specify at least the UP glyph.") - (setq glyphs (list (make-glyph glyph-file))) + (setq glyphs-list (list glyph-file)) (setq prompts (cdr prompts)))) (while prompts (let ((glyph-file (read-file-name (car prompts) nil ""))) (if (not (string-equal glyph-file "")) - (setq glyphs - (append glyphs (list (make-glyph glyph-file)))))) + (setq glyphs-list + (append glyphs-list (list glyph-file))))) (setq prompts (cdr prompts))) + (setq added-button (gentemp edit-toolbar-button-prefix )) + (setf (symbol-value added-button) + (toolbar-make-button-list glyphs-list)) + (setq edit-toolbar-added-buttons-alist + (append edit-toolbar-added-buttons-alist + (list (cons added-button glyphs-list)))) (let ((func (read-string "Function to call: ")) (help (read-string "Help String: "))) - (setq new-button (vector glyphs (intern func) t help)))) + (setq new-button (vector added-button (intern func) t help)))) (let ((match (assoc button edit-toolbar-button-alist))) (if match (setq new-button (cdr match)) @@ -492,6 +520,14 @@ (standard-output buf)) (set-buffer buf) (erase-buffer) + (insert "(setq edit-toolbar-added-buttons-alist '") + (prin1 edit-toolbar-added-buttons-alist) + (insert ")\n") + (insert "(mapcar + (lambda (cons) + (setf (symbol-value (car cons)) (toolbar-make-button-list (cdr cons))) + ) + edit-toolbar-added-buttons-alist)\n") (insert (concat "(set-specifier " edit-toolbar-temp-toolbar-name) " '") (prin1 (specifier-instance edit-toolbar-temp-toolbar)) (insert ")")
--- a/lisp/utils/finder-inf.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/utils/finder-inf.el Mon Aug 13 09:55:28 2007 +0200 @@ -6,6 +6,322 @@ ;;; Code: (setq finder-package-info '( + ("dgnushack.el" + "a hack to set the load path for byte-compiling" + (news path) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("earcon.el" + "Sound effects for messages" + (news fun sound) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-art.el" + "article mode commands for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-async.el" + "asynchronous support for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-audio.el" + "Sound effects for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-bcklg.el" + "backlog functions for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-cache.el" + "cache interface for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-cite.el" + "parse citations in articles for Gnus" + (news mail) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-cus.el" + "customization commands for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-demon.el" + "daemonic Gnus behaviour" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-dup.el" + "suppression of duplicate articles in Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-eform.el" + "a mode for editing forms for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-ems.el" + "functions for making Gnus work under different Emacsen" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-gl.el" + "an interface to GroupLens for Gnus" + (news score) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-group.el" + "group mode commands for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-int.el" + "backend interface functions for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-kill.el" + "kill commands for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-load.el" + "automatically extracted custom dependencies" + nil + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-logic.el" + "advanced scoring code for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-mh.el" + "mh-e interface for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-move.el" + "commands for moving Gnus from one server to another" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-msg.el" + "mail and post interface for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-nocem.el" + "NoCeM pseudo-cancellation treatment" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-picon.el" + "displaying pretty icons in Gnus" + (news xpm annotation glyph faces) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-range.el" + "range and sequence functions for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-salt.el" + "alternate summary mode interfaces for Gnus" + nil + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-setup.el" + "Initialization & Setup for Gnus 5" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-soup.el" + "SOUP packet writing support for Gnus" + (news mail) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-spec.el" + "format spec functions for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-srvr.el" + "virtual server support for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-start.el" + "startup functions for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-sum.el" + "summary mode commands for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-topic.el" + "a folding minor mode for Gnus group buffers" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-undo.el" + "minor mode for undoing in Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-util.el" + "utility functions for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-uu.el" + "extract (uu)encoded files in Gnus" + nil + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-vm.el" + "vm interface for Gnus" + (news mail) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-win.el" + "window configuration functions for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus-xmas.el" + "Gnus functions for XEmacs" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("gnus.el" + "a newsreader for GNU Emacs" + (news mail) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("mailheader.el" + "Mail header parsing, merging, formatting" + (tools mail news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("message.el" + "composing mail and news messages" + (mail news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("messagexmas.el" + "XEmacs extensions to message" + (mail news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("messcompat.el" + "making message mode compatible with mail mode" + (mail news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("nnbabyl.el" + "rmail mbox access for Gnus" + (news mail) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("nndb.el" + "nndb access for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("nndir.el" + "single directory newsgroup access for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("nndoc.el" + "single file access for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("nndraft.el" + "draft article access for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("nneething.el" + "random file access for Gnus" + (news mail) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("nnfolder.el" + "mail folder access for Gnus" + (mail) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("nngateway.el" + "posting news via mail gateways" + (news mail) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("nnheader.el" + "header access macros for Gnus and its backends" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("nnheaderxm.el" + "making Gnus backends work under XEmacs" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("nnkiboze.el" + "select virtual news access for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("nnmail.el" + "mail support functions for the Gnus mail backends" + (news mail) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("nnmbox.el" + "mail mbox access for Gnus" + (news mail) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("nnmh.el" + "mhspool access for Gnus" + (news mail) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("nnml.el" + "mail spool access for Gnus" + (news mail) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("nnoo.el" + "OO Gnus Backends" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("nnsoup.el" + "SOUP access for Gnus" + (news mail) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("nnspool.el" + "spool access for GNU Emacs" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("nntp.el" + "nntp access for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("nnvirtual.el" + "virtual newsgroups access for Gnus" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("nnweb.el" + "retrieving articles via web search engines" + (news) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("parse-time.el" + "Parsing time strings" + (util) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("pop3.el" + "Post Office Protocol (RFC 1460) interface" + (mail pop3) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("score-mode.el" + "mode for editing Gnus score files" + (news mail) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("smiley.el" + "displaying smiley faces" + (fun) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("widget.el" + "a library of user interface components." + (help extensions faces hypermedia) + "/usr/local/lib/xemacs/packages/lisp/gnus/") + ("footnote-cyrillic.el" + "Cyrillic lettering for footnote mode" + (mule news mail) + "/usr/local/lib/xemacs/packages/lisp/footnote/") + ("footnote-greek.el" + "Greek lettering for footnote mode" + (mule news mail) + "/usr/local/lib/xemacs/packages/lisp/footnote/") + ("footnote-hebrew.el" + "Hebrew lettering for footnote mode" + (mule news mail) + "/usr/local/lib/xemacs/packages/lisp/footnote/") + ("footnote-japanese.el" + "Japanese footnote support" + (mail news mule) + "/usr/local/lib/xemacs/packages/lisp/footnote/") + ("footnote.el" + "Footnote support for message mode" + (mail news) + "/usr/local/lib/xemacs/packages/lisp/footnote/") + ("font-latex.el" + "LaTeX fontification for Font Lock mode." + (latex faces) + "/usr/local/lib/xemacs/packages/lisp/auctex/") + ("latex.el" + "Support for LaTeX documents." + (wp) + "/usr/local/lib/xemacs/packages/lisp/auctex/") + ("multi-prompt.el" + "completing read of multiple strings." + (extensions) + "/usr/local/lib/xemacs/packages/lisp/auctex/") + ("tex.el" + "Support for TeX documents." + (wp) + "/usr/local/lib/xemacs/packages/lisp/auctex/") ("paths.el" "define pathnames for use by various Emacs commands." (internal) @@ -14,22 +330,58 @@ "Template file for site-wide XEmacs customization" (internal) "lisp/") - ("font-latex.el" - "LaTeX fontification for Font Lock mode." - (latex faces) - "lisp/auctex/") - ("latex.el" - "Support for LaTeX documents." - (wp) - "lisp/auctex/") - ("multi-prompt.el" - "completing read of multiple strings." - (extensions) - "lisp/auctex/") - ("tex.el" - "Support for TeX documents." - (wp) - "lisp/auctex/") + ("alist.el" + "utility functions about assoc-list" + (alist) + "lisp/apel/") + ("atype.el" + "atype functions" + (atype) + "lisp/apel/") + ("emu-e19.el" + "emu module for Emacs 19 and XEmacs 19" + (emulation compatibility mule latin-1) + "lisp/apel/") + ("emu-x20.el" + "emu API implementation for XEmacs 20 with mule" + (emulation compatibility mule xemacs) + "lisp/apel/") + ("emu-xemacs.el" + "emu API implementation for XEmacs" + (emulation compatibility xemacs) + "lisp/apel/") + ("emu.el" + "Emulation module for each Emacs variants" + (emulation compatibility nemacs mule emacs/mule xemacs) + "lisp/apel/") + ("file-detect.el" + "Emacs Lisp file detection utility" + (install module) + "lisp/apel/") + ("filename.el" + "file name filter" + (file name string) + "lisp/apel/") + ("install.el" + "Emacs Lisp package install utility" + (install) + "lisp/apel/") + ("mule-caesar.el" + "ROT 13-47 Caesar rotation utility" + (rot 13-47 caesar mail news text/x-rot13-47) + "lisp/apel/") + ("richtext.el" + "read and save files in text/richtext format" + (wp faces mime multimedia) + "lisp/apel/") + ("std11-parse.el" + "STD 11 parser for GNU Emacs" + (mail news rfc 822 std 11) + "lisp/apel/") + ("std11.el" + "STD 11 functions for GNU Emacs" + (mail news rfc 822 std 11) + "lisp/apel/") ("byte-optimize.el" "the optimization passes of the emacs-lisp byte compiler." (internal) @@ -94,6 +446,46 @@ "calendar functions for solar events." (calendar) "lisp/calendar/") + ("cc-align.el" + "custom indentation functions for CC Mode" + (c languages oop) + "lisp/cc-mode/") + ("cc-cmds.el" + "user level commands for CC Mode " + (c languages oop) + "lisp/cc-mode/") + ("cc-compat.el" + "cc-mode compatibility with c-mode.el confusion" + (c languages oop) + "lisp/cc-mode/") + ("cc-defs.el" + "definitions for CC Mode" + (c languages oop) + "lisp/cc-mode/") + ("cc-engine.el" + "core syntax guessing engine for CC mode" + (c languages oop) + "lisp/cc-mode/") + ("cc-langs.el" + "specific language support for CC Mode" + (c languages oop) + "lisp/cc-mode/") + ("cc-menus.el" + "imenu support for CC Mode" + (c languages oop) + "lisp/cc-mode/") + ("cc-mode.el" + "major mode for editing C, C++, Objective-C, and Java code" + (c languages oop) + "lisp/cc-mode/") + ("cc-styles.el" + "support for styles in CC Mode" + (c languages oop) + "lisp/cc-mode/") + ("cc-vars.el" + "user customization variables for CC Mode" + (c languages oop) + "lisp/cc-mode/") ("cl-autoload.el" "Generate the autoload file cl-defs.el." (extensions lisp) @@ -134,6 +526,10 @@ "run dbx under Emacs" (c unix tools debugging) "lisp/comint/") + ("gdb-highlight.el" + "make gdb buffers be mouse-sensitive." + (extensions c unix tools debugging) + "lisp/comint/") ("gdb.el" "run gdb under Emacs" (c unix tools debugging) @@ -166,12 +562,16 @@ "specialized comint.el for running the shell." (processes) "lisp/comint/") + ("ssh.el" + "remote login interface" + (unix comm) + "lisp/comint/") ("telnet.el" "run a telnet session from within an Emacs buffer" (comm unix) "lisp/comint/") ("cus-edit.el" - "Tools for customization Emacs." + "Tools for customizating Emacs and Lisp packages." (help faces) "lisp/custom/") ("cus-face.el" @@ -194,10 +594,6 @@ "example of using the widget library" (help extensions faces hypermedia) "lisp/custom/") - ("widget.el" - "a library of user interface components." - (help extensions faces hypermedia) - "lisp/custom/") ("advise-eval-region.el" "Wrap advice around eval-region" (extensions lisp) @@ -314,14 +710,6 @@ "Enhanced EDT Keypad Mode Emulation for GNU Emacs 19" (emulations) "lisp/emulators/") - ("mlconvert.el" - "convert buffer of Mocklisp code to real lisp." - (emulations) - "lisp/emulators/") - ("mlsupport.el" - "run-time support for mocklisp code." - (extensions) - "lisp/emulators/") ("scroll-lock.el" "scroll-locking minor mode" (scroll crisp brief lock) @@ -354,10 +742,6 @@ "Intereactively loads the XEmacs/SPARCworks interface" (sparcworks eos era on sparcworks load) "lisp/eos/") - ("loaddefs-eos.el" - "define standard autoloads of other files" - (internal) - "lisp/eos/") ("sun-eos-browser.el" "Implements the XEmacs/SPARCworks SourceBrowser interface" (sparcworks eos era on sparcworks sbrowser source browser) @@ -462,6 +846,10 @@ "StudlyCaps (tm)(r)(c)(xxx)" (games) "lisp/games/") + ("tetris.el" + "Implementation of Tetris for Emacs." + (games) + "lisp/games/") ("xmine.el" "Mine game for XEmacs" (games) @@ -470,282 +858,6 @@ "quote random zippyisms" (games) "lisp/games/") - ("dgnushack.el" - "a hack to set the load path for byte-compiling" - (news path) - "lisp/gnus/") - ("earcon.el" - "Sound effects for messages" - (news fun sound) - "lisp/gnus/") - ("gnus-art.el" - "article mode commands for Gnus" - (news) - "lisp/gnus/") - ("gnus-async.el" - "asynchronous support for Gnus" - (news) - "lisp/gnus/") - ("gnus-audio.el" - "Sound effects for Gnus" - (news) - "lisp/gnus/") - ("gnus-bcklg.el" - "backlog functions for Gnus" - (news) - "lisp/gnus/") - ("gnus-cache.el" - "cache interface for Gnus" - (news) - "lisp/gnus/") - ("gnus-cite.el" - "parse citations in articles for Gnus" - (news mail) - "lisp/gnus/") - ("gnus-cus.el" - "customization commands for Gnus" - (news) - "lisp/gnus/") - ("gnus-demon.el" - "daemonic Gnus behaviour" - (news) - "lisp/gnus/") - ("gnus-dup.el" - "suppression of duplicate articles in Gnus" - (news) - "lisp/gnus/") - ("gnus-eform.el" - "a mode for editing forms for Gnus" - (news) - "lisp/gnus/") - ("gnus-ems.el" - "functions for making Gnus work under different Emacsen" - (news) - "lisp/gnus/") - ("gnus-gl.el" - "an interface to GroupLens for Gnus" - (news score) - "lisp/gnus/") - ("gnus-group.el" - "group mode commands for Gnus" - (news) - "lisp/gnus/") - ("gnus-int.el" - "backend interface functions for Gnus" - (news) - "lisp/gnus/") - ("gnus-kill.el" - "kill commands for Gnus" - (news) - "lisp/gnus/") - ("gnus-load.el" - "automatically extracted custom dependencies" - nil - "lisp/gnus/") - ("gnus-logic.el" - "advanced scoring code for Gnus" - (news) - "lisp/gnus/") - ("gnus-mh.el" - "mh-e interface for Gnus" - (news) - "lisp/gnus/") - ("gnus-move.el" - "commands for moving Gnus from one server to another" - (news) - "lisp/gnus/") - ("gnus-msg.el" - "mail and post interface for Gnus" - (news) - "lisp/gnus/") - ("gnus-nocem.el" - "NoCeM pseudo-cancellation treatment" - (news) - "lisp/gnus/") - ("gnus-picon.el" - "displaying pretty icons in Gnus" - (news xpm annotation glyph faces) - "lisp/gnus/") - ("gnus-range.el" - "range and sequence functions for Gnus" - (news) - "lisp/gnus/") - ("gnus-salt.el" - "alternate summary mode interfaces for Gnus" - nil - "lisp/gnus/") - ("gnus-setup.el" - "Initialization & Setup for Gnus 5" - (news) - "lisp/gnus/") - ("gnus-soup.el" - "SOUP packet writing support for Gnus" - (news mail) - "lisp/gnus/") - ("gnus-spec.el" - "format spec functions for Gnus" - (news) - "lisp/gnus/") - ("gnus-srvr.el" - "virtual server support for Gnus" - (news) - "lisp/gnus/") - ("gnus-start.el" - "startup functions for Gnus" - (news) - "lisp/gnus/") - ("gnus-sum.el" - "summary mode commands for Gnus" - (news) - "lisp/gnus/") - ("gnus-topic.el" - "a folding minor mode for Gnus group buffers" - (news) - "lisp/gnus/") - ("gnus-undo.el" - "minor mode for undoing in Gnus" - (news) - "lisp/gnus/") - ("gnus-util.el" - "utility functions for Gnus" - (news) - "lisp/gnus/") - ("gnus-uu.el" - "extract (uu)encoded files in Gnus" - nil - "lisp/gnus/") - ("gnus-vm.el" - "vm interface for Gnus" - (news mail) - "lisp/gnus/") - ("gnus-win.el" - "window configuration functions for Gnus" - (news) - "lisp/gnus/") - ("gnus-xmas.el" - "Gnus functions for XEmacs" - (news) - "lisp/gnus/") - ("gnus.el" - "a newsreader for GNU Emacs" - (news mail) - "lisp/gnus/") - ("mailheader.el" - "Mail header parsing, merging, formatting" - (tools mail news) - "lisp/gnus/") - ("message.el" - "composing mail and news messages" - (mail news) - "lisp/gnus/") - ("messagexmas.el" - "XEmacs extensions to message" - (mail news) - "lisp/gnus/") - ("messcompat.el" - "making message mode compatible with mail mode" - (mail news) - "lisp/gnus/") - ("nnbabyl.el" - "rmail mbox access for Gnus" - (news mail) - "lisp/gnus/") - ("nndb.el" - "nndb access for Gnus" - (news) - "lisp/gnus/") - ("nndir.el" - "single directory newsgroup access for Gnus" - (news) - "lisp/gnus/") - ("nndoc.el" - "single file access for Gnus" - (news) - "lisp/gnus/") - ("nndraft.el" - "draft article access for Gnus" - (news) - "lisp/gnus/") - ("nneething.el" - "random file access for Gnus" - (news mail) - "lisp/gnus/") - ("nnfolder.el" - "mail folder access for Gnus" - (mail) - "lisp/gnus/") - ("nngateway.el" - "posting news via mail gateways" - (news mail) - "lisp/gnus/") - ("nnheader.el" - "header access macros for Gnus and its backends" - (news) - "lisp/gnus/") - ("nnheaderxm.el" - "making Gnus backends work under XEmacs" - (news) - "lisp/gnus/") - ("nnkiboze.el" - "select virtual news access for Gnus" - (news) - "lisp/gnus/") - ("nnmail.el" - "mail support functions for the Gnus mail backends" - (news mail) - "lisp/gnus/") - ("nnmbox.el" - "mail mbox access for Gnus" - (news mail) - "lisp/gnus/") - ("nnmh.el" - "mhspool access for Gnus" - (news mail) - "lisp/gnus/") - ("nnml.el" - "mail spool access for Gnus" - (news mail) - "lisp/gnus/") - ("nnoo.el" - "OO Gnus Backends" - (news) - "lisp/gnus/") - ("nnsoup.el" - "SOUP access for Gnus" - (news mail) - "lisp/gnus/") - ("nnspool.el" - "spool access for GNU Emacs" - (news) - "lisp/gnus/") - ("nntp.el" - "nntp access for Gnus" - (news) - "lisp/gnus/") - ("nnvirtual.el" - "virtual newsgroups access for Gnus" - (news) - "lisp/gnus/") - ("nnweb.el" - "retrieving articles via web search engines" - (news) - "lisp/gnus/") - ("parse-time.el" - "Parsing time strings" - (util) - "lisp/gnus/") - ("pop3.el" - "Post Office Protocol (RFC 1460) interface" - (mail pop3) - "lisp/gnus/") - ("score-mode.el" - "mode for editing Gnus score files" - (news mail) - "lisp/gnus/") - ("smiley.el" - "displaying smiley faces" - (fun) - "lisp/gnus/") ("hm--html-menu.el" "A menu for the hm--html-mode." nil @@ -758,6 +870,10 @@ "routines for communicating with a NCSA Mosaic process" (comm unix wp help) "lisp/hm--html-menus/") + ("internal-drag-and-drop.el" + "Internal drag and drop interface" + (mouse) + "lisp/hm--html-menus/") ("tmpl-minor-mode.el" "Template Minor Mode" (data tools) @@ -790,6 +906,106 @@ "miscellaneous functions for dealing with Swedish." (i18n) "lisp/iso/") + ("arabic-util.el" + "minor mode for editing Arabic." + (multilingual arabic) + "lisp/language/") + ("arabic.el" + "pre-loaded support for Arabic." + nil + "lisp/language/") + ("china-util.el" + "utilities for Chinese" + (mule multilingual chinese) + "lisp/language/") + ("chinese.el" + "Support for Chinese" + (multilingual chinese) + "lisp/language/") + ("cyrillic.el" + "Support for languages which use Cyrillic characters" + (multilingual cyrillic) + "lisp/language/") + ("devanagari.el" + "Support for Devanagari Languages" + (multilingual indian devanagari) + "lisp/language/") + ("english.el" + "English support" + (multibyte character character set syntax category) + "lisp/language/") + ("ethio-util.el" + "utilities for Ethiopic" + (mule multilingual ethiopic) + "lisp/language/") + ("ethiopic.el" + "Support for Ethiopic" + (multilingual ethiopic) + "lisp/language/") + ("european.el" + "Support for European languages" + (multilingual european) + "lisp/language/") + ("greek.el" + "Support for Greek" + (multilingual greek) + "lisp/language/") + ("hebrew.el" + "Support for Hebrew" + (multilingual hebrew) + "lisp/language/") + ("indian.el" + "Support for Indian Languages" + (multilingual indian) + "lisp/language/") + ("japan-util.el" + "utilities for Japanese" + (mule multilingual japanese) + "lisp/language/") + ("japanese.el" + "Japanese support" + (multilingual japanese) + "lisp/language/") + ("korean.el" + "Support for Korean" + (multilingual korean) + "lisp/language/") + ("lao-util.el" + "utilities for Lao" + (multilingual lao) + "lisp/language/") + ("lao.el" + "Support for Lao" + (multilingual lao) + "lisp/language/") + ("misc-lang.el" + "support for miscellaneous languages (characters)" + (multilingual character set coding system) + "lisp/language/") + ("thai-util.el" + "utilities for Thai" + (mule multilingual thai) + "lisp/language/") + ("thai.el" + "Support for Thai" + (multilingual thai) + "lisp/language/") + ("tibetan.el" + "Support for Tibetan language" + (multilingual tibetan) + "lisp/language/") + ("vietnamese.el" + "Support for Vietnamese" + (multilingual vietnamese) + "lisp/language/") + ("visual-mode.el" + "cursor motion, insertion, deletion, etc. in visual order" + nil + "lisp/language/") + ("quail.el" + "Provides simple input method for multilingual text" + (mule multilingual input method) + "lisp/leim/") ("mc-remail.el" "Remailer support for Mailcrypt" nil @@ -840,7 +1056,11 @@ "lisp/modes/") ("auto-show.el" "perform automatic horizontal scrolling as point moves" - (scroll display minor-mode) + (extensions internal) + "lisp/modes/") + ("autoconf-mode.el" + "autoconf code editing commands for Emacs" + (languages faces m4 configure) "lisp/modes/") ("awk-mode.el" "AWK code editing commands for Emacs" @@ -862,22 +1082,6 @@ "sets c-style control variables." nil "lisp/modes/") - ("cc-compat.el" - "cc-mode compatibility with c-mode.el confusion" - (c languages oop) - "lisp/modes/") - ("cc-guess.el" - "guess indentation values by scanning existing code" - (c languages oop) - "lisp/modes/") - ("cc-lobotomy.el" - "excise portions of cc-mode's brain... for speed" - (c languages oop) - "lisp/modes/") - ("cc-mode.el" - "major mode for editing C, C++, Objective-C, and Java code" - (c languages oop) - "lisp/modes/") ("cl-indent.el" "enhanced lisp-indent mode" (lisp tools) @@ -898,10 +1102,6 @@ "Fortran-90 mode (free format)" (fortran f90 languages) "lisp/modes/") - ("follow.el" - "Minor mode, Synchronize windows showing the same buffer." - (display window minor-mode) - "lisp/modes/") ("fortran-misc.el" "Routines than can be used with fortran mode." (languages) @@ -922,14 +1122,18 @@ "mode for editing Icon code" (languages) "lisp/modes/") - ("imenu.el" - "Framework for mode-specific buffer indexes." - (tools) + ("image-mode.el" + "Major mode for navigate images" + (image graphics) "lisp/modes/") ("ksh-mode.el" "sh (ksh, bash) script editing mode for GNU Emacs." (shell korn bourne sh ksh bash) "lisp/modes/") + ("linuxdoc-sgml.el" + "sgml-mode enhancements for linuxdoc" + (docs languages) + "lisp/modes/") ("lisp-mnt.el" "minor mode for Emacs Lisp maintainers" (docs) @@ -954,14 +1158,6 @@ "GNU Emacs major mode for editing nroff source" (wp) "lisp/modes/") - ("old-c++-mode.el" - "major mode for editing C++ (and C) code" - (c) - "lisp/modes/") - ("old-c-mode.el" - "C code editing commands for Emacs" - (c) - "lisp/modes/") ("outl-mouse.el" "outline mode mouse commands for Emacs" (outlines mouse) @@ -970,6 +1166,10 @@ "outline mode commands for Emacs" (outlines) "lisp/modes/") + ("pascal.el" + "major mode for editing pascal source in Emacs" + (languages) + "lisp/modes/") ("perl-mode.el" "Perl code editing commands for GNU Emacs" (languages) @@ -990,6 +1190,10 @@ "Major mode for editing Python programs" (python languages oop) "lisp/modes/") + ("reftex.el" + "Minor mode for doing \\label, \\ref and \\cite in LaTeX" + (tex) + "lisp/modes/") ("rexx-mode.el" "major mode for editing REXX program files" (languages) @@ -1010,6 +1214,10 @@ "mail sending commands for Emacs." (mail) "lisp/modes/") + ("sgml-mode.el" + "SGML- and HTML-editing modes" + (wp hypermedia comm languages) + "lisp/modes/") ("sh-script.el" "shell-script editing commands for Emacs" (languages unix) @@ -1018,6 +1226,10 @@ "SIMULA 87 code editing commands for Emacs" (languages) "lisp/modes/") + ("strokes.el" + "Control XEmacs through mouse strokes --" + (lisp mouse extensions) + "lisp/modes/") ("tcl.el" "Tcl code editing commands for Emacs" (languages tcl modes) @@ -1034,10 +1246,6 @@ "text mode, and its idiosyncratic commands." nil "lisp/modes/") - ("two-column.el" - "minor mode for editing of two-column text" - nil - "lisp/modes/") ("verilog-mode.el" "major mode for editing verilog source in Emacs" (languages) @@ -1050,6 +1258,18 @@ "Minor mode for browsing files with keybindings like `less'" (wp unix) "lisp/modes/") + ("view-process-mode.el" + "Display current running processes" + (processes) + "lisp/modes/") + ("view-process-system-specific.el" + "System specific stuff for view-process" + (processes) + "lisp/modes/") + ("view-process-xemacs.el" + "XEmacs specific code for view-process" + (processes) + "lisp/modes/") ("view.el" "peruse file or buffer without editing." (wp unix) @@ -1086,74 +1306,22 @@ "yet another citation tool for GNU Emacs" (mail news citation) "lisp/mu/") - ("std11-parse.el" - "STD 11 parser for GNU Emacs" - (mail news rfc 822 std 11) - "lisp/mu/") - ("std11.el" - "STD 11 functions for GNU Emacs" - (mail news rfc 822 std 11) - "lisp/mu/") - ("arabic-hooks.el" - "pre-loaded support for Arabic." - nil - "lisp/mule/") - ("arabic.el" - "minor mode for editing Arabic." - nil - "lisp/mule/") ("canna.el" "Interface to the Canna input method." (canna japanese input method mule multilingual) "lisp/mule/") - ("chinese-hooks.el" - "pre-loaded support for Chinese." - nil - "lisp/mule/") - ("chinese.el" - "Chinese specific setup for XEmacs/Mule (not pre-loaded)." - nil - "lisp/mule/") - ("cyrillic-hooks.el" - "pre-loaded support for Cyrillic." - nil - "lisp/mule/") - ("ethiopic-hooks.el" - "pre-loaded support for Ethiopic." - nil - "lisp/mule/") - ("european-hooks.el" - "pre-loaded support for European languages." - nil - "lisp/mule/") - ("greek-hooks.el" - "pre-loaded support for Greek." - nil - "lisp/mule/") ("hebrew-hooks.el" "pre-loaded support for Hebrew." nil "lisp/mule/") - ("ipa-hooks.el" - "pre-loaded support for other languages." - nil - "lisp/mule/") ("isearch-mule.el" "incremental search with front-end inputting method" (search) "lisp/mule/") - ("japanese-hooks.el" - "pre-loaded support for Japanese." - nil - "lisp/mule/") ("kinsoku.el" "Kinsoku (line wrap) processing for XEmacs/Mule" nil "lisp/mule/") - ("korean-hooks.el" - "pre-loaded support for Korean." - nil - "lisp/mule/") ("mule-category.el" "category functions for XEmacs/Mule." nil @@ -1166,6 +1334,10 @@ "Charset functions for Mule." nil "lisp/mule/") + ("mule-cmds.el" + "Commands for mulitilingual environment" + (mule multilingual) + "lisp/mule/") ("mule-cne.el" "interface between input methods Canna and EGG." nil @@ -1186,26 +1358,18 @@ "Direct input of multilingual chars from keyboard." nil "lisp/mule/") - ("mule-load.el" - "Load up all pre-loaded Mule Lisp files." - nil - "lisp/mule/") ("mule-misc.el" "Miscellaneous Mule functions." nil "lisp/mule/") - ("mule-process.el" - "Process functions for XEmacs/Mule." - nil + ("mule-util.el" + "Utility functions for mulitilingual environment (mule)" + (mule multilingual) "lisp/mule/") ("mule-x-init.el" "initialization code for X Windows under MULE" (mule x11) "lisp/mule/") - ("thai-hooks.el" - "pre-loaded support for Thai." - nil - "lisp/mule/") ("vietnamese-hooks-1.el" "pre-loaded support for Vietnamese, part 1." nil @@ -1214,10 +1378,6 @@ "pre-loaded support for Vietnamese, part 2." nil "lisp/mule/") - ("visual-mode.el" - "cursor motion, insertion, deletion, etc. in visual order" - nil - "lisp/mule/") ("add-log.el" "change log maintenance commands for Emacs" (maint) @@ -1342,6 +1502,10 @@ "generic interface to source control systems" (tools unix) "lisp/packages/") + ("gnuserv.el" + "Lisp interface code between Emacs and gnuserv" + (environment processes terminals) + "lisp/packages/") ("gopher.el" "an emacs gopher client" (gopher comm) @@ -1354,10 +1518,6 @@ "Hypertext emacs lisp documentation interface." (lisp tools help docs matching) "lisp/packages/") - ("icomplete.el" - "minibuffer completion with incremental feedback" - (help abbrev) - "lisp/packages/") ("igrep.el" "An improved interface to `grep`." nil @@ -1414,14 +1574,6 @@ "highlight matching parenthesises." (languages faces) "lisp/packages/") - ("mime-compose.el" - "mime-compose.el ---" - nil - "lisp/packages/") - ("netunam.el" - "HP-UX RFA Commands" - (comm) - "lisp/packages/") ("page-ext.el" "extended page handling commands" nil @@ -1458,14 +1610,6 @@ "automatically save place in files." (bookmarks placeholders) "lisp/packages/") - ("sccs.el" - "easy-to-use SCCS control from within Emacs" - nil - "lisp/packages/") - ("server.el" - "Lisp code for GNU Emacs running as server process." - (processes) - "lisp/packages/") ("spell.el" "spelling correction interface for Emacs." (wp unix) @@ -1520,7 +1664,7 @@ "lisp/packages/") ("webjump.el" "programmable Web hotlist" - (webjump web www browse-url) + (comm www) "lisp/packages/") ("webster-www.el" "Look up a word in WWW Merriam-Webster dictionary" @@ -1536,7 +1680,7 @@ "lisp/pcl-cvs/") ("about.el" "the About The Authors page (shameless self promotion)." - nil + (extensions) "lisp/prim/") ("advocacy.el" "blatant XEmacs self promotion" @@ -1566,6 +1710,10 @@ "miscellaneous console functions not written in C" (internal) "lisp/prim/") + ("cus-load.el" + "Batch load all available cus-load files" + (internal help faces) + "lisp/prim/") ("cus-start.el" "define customization properties of builtins." (internal) @@ -1588,7 +1736,7 @@ "lisp/prim/") ("events.el" "event functions." - (internal) + (internal event) "lisp/prim/") ("extents.el" "miscellaneous extent functions not written in C" @@ -1628,11 +1776,11 @@ "lisp/prim/") ("glyphs.el" "Lisp interface to C glyphs" - (glyphs internal) + (extensions internal) "lisp/prim/") ("gui.el" "Basic GUI functions for XEmacs." - nil + (internal) "lisp/prim/") ("help.el" "help commands for XEmacs." @@ -1666,6 +1814,14 @@ "non-primitive commands for keyboard macros." (abbrev) "lisp/prim/") + ("make-docfile.el" + "Cache docstrings in external file" + (internal) + "lisp/prim/") + ("minibuf.el" + "Minibuffer functions for XEmacs" + (internal) + "lisp/prim/") ("misc.el" "miscellaneous functions for XEmacs" nil @@ -1698,6 +1854,10 @@ "overlay support." (internal) "lisp/prim/") + ("packages.el" + "Low level support for XEmacs packages" + (internal lisp) + "lisp/prim/") ("page.el" "page motion commands for emacs." nil @@ -1708,11 +1868,11 @@ "lisp/prim/") ("process.el" "commands for subprocesses; split out of simple.el" - nil + (internal processes) "lisp/prim/") ("profile.el" "basic profiling commands for XEmacs" - nil + (internal) "lisp/prim/") ("rect.el" "rectangle functions for XEmacs." @@ -1762,14 +1922,26 @@ "tab conversion commands for XEmacs" nil "lisp/prim/") + ("toolbar.el" + "Toolbar support for XEmacs" + (extensions internal) + "lisp/prim/") ("undo-stack.el" "An \"undoable stack\" object." (extensions) "lisp/prim/") + ("update-elc.el" + "Bytecompile out-of-date dumped files" + (internal) + "lisp/prim/") ("userlock.el" "handle file access contention between multiple users" (internal) "lisp/prim/") + ("window-xemacs.el" + "XEmacs window commands aside from those written in C." + (extensions) + "lisp/prim/") ("window.el" "XEmacs window commands aside from those written in C." (extensions) @@ -1822,18 +1994,6 @@ "Flexible template insertion" (extensions languages tools) "lisp/psgml/") - ("quail-hanja-ksc.el" - "Quail-package for hanja (KSC5601) inputting" - nil - "lisp/quail/") - ("quail-ltn.el" - "European language input methods for quick typists" - nil - "lisp/quail/") - ("quail.el" - "Simple inputting method" - nil - "lisp/quail/") ("rmail-kill.el" "Mail filtering for rmail" (mail) @@ -1878,6 +2038,10 @@ "convert Rmail files to mailbox files." (mail) "lisp/rmail/") + ("sccs.el" + "easy-to-use SCCS control from within Emacs" + nil + "lisp/sunpro/") ("sunpro-keys.el" "SunPro-specific key bindings" nil @@ -1972,48 +2136,24 @@ "lisp/term/") ("char-table.el" "display table of charset" - (character emacs/mule) + (character mule) "lisp/tl/") ("char-util.el" "character utility" (character emacs/mule) "lisp/tl/") + ("chartblxmas.el" + "display table of charset by pop-up menu" + (character xemacs/mule) + "lisp/tl/") ("cless.el" "Common lisp and Emacs Lisp source sharing" (common lisp) "lisp/tl/") - ("emu-e19.el" - "emu module for Emacs 19 and XEmacs 19" - (emulation compatibility mule latin-1) - "lisp/tl/") - ("emu-x20.el" - "emu API implementation for XEmacs 20 with mule" - (emulation compatibility mule xemacs) - "lisp/tl/") - ("emu-xemacs.el" - "emu API implementation for XEmacs" - (emulation compatibility xemacs) - "lisp/tl/") - ("emu.el" - "Emulation module for each Emacs variants" - (emulation compatibility nemacs mule emacs/mule xemacs) - "lisp/tl/") - ("file-detect.el" - "Emacs Lisp file detection utility" - (install module) - "lisp/tl/") - ("filename.el" - "file name filter" - (string file name) - "lisp/tl/") ("range.el" "range functions" (range) "lisp/tl/") - ("richtext.el" - "read and save files in text/richtext format" - (wp faces mime multimedia) - "lisp/tl/") ("texi-util.el" "Texinfo utility" (texinfo) @@ -2054,10 +2194,6 @@ "MIME charset extension for Gnus" (news mime multimedia multilingual encoded-word) "lisp/tm/") - ("gnus-mime-old.el" - "MIME extensions for Gnus 5.[01] and 5.[23]" - (news mime multimedia multilingual encoded-word) - "lisp/tm/") ("gnus-mime.el" "MIME extensions for Gnus" (news mime multimedia multilingual encoded-word) @@ -2194,9 +2330,9 @@ "ask a WWW browser to load a URL" (hypertext) "lisp/utils/") - ("delbackspace.el" - "rebind backspace and delete to be correct" - (terminals) + ("config.el" + "access configuration parameters" + (configure) "lisp/utils/") ("delbs.el" "a small lisp package to allow you to swap around DEL/BS keys" @@ -2214,6 +2350,10 @@ "Simple cross references for Elisp documentation strings" (docs help lisp) "lisp/utils/") + ("edit-toolbar.el" + "Interactive toolbar editing mode for XEmacs" + (tools) + "lisp/utils/") ("edmacro.el" "keyboard macro editor" (abbrev) @@ -2266,10 +2406,18 @@ "Forms mode: edit a file as a form to fill in" (extensions) "lisp/utils/") + ("hide-copyleft.el" + "hide obnoxious copyright prologs" + nil + "lisp/utils/") ("highlight-headers.el" "highlighting message headers." (mail news) "lisp/utils/") + ("hippie-exp.el" + "expand text trying various ways to find its expansion." + (abbrev) + "lisp/utils/") ("lib-complete.el" "Completion on the lisp search path" (lisp extensions) @@ -2290,22 +2438,18 @@ "utility functions used both by rmail and rnews" (mail news) "lisp/utils/") - ("mailpost.el" - "RMAIL coupler to /usr/uci/post mailer" - (mail) - "lisp/utils/") ("map-ynp.el" - "General-purpose boolean question-asker" + "General-purpose boolean question-asker." (lisp extensions) "lisp/utils/") - ("meese.el" - "protect the impressionable young minds of America" - (games) - "lisp/utils/") ("passwd.el" "Prompting for passwords semi-securely" (comm extensions) "lisp/utils/") + ("ph.el" + "Client for the CCSO directory system (aka PH/QI)" + (help) + "lisp/utils/") ("pp.el" "pretty printer for Emacs Lisp" (lisp tools language extensions) @@ -2330,6 +2474,10 @@ "handle rings of items" (extensions) "lisp/utils/") + ("savehist.el" + "Save minibuffer history" + (minibuffer) + "lisp/utils/") ("shadowfile.el" "automatic file copying for Emacs 19" (comm) @@ -2342,6 +2490,14 @@ "implement Soundex algorithm" (matching) "lisp/utils/") + ("speedbar.el" + "quick access to files and tags -*-byte-compile-warnings:nil;-*-" + (file tags tools) + "lisp/utils/") + ("speedbspec.el" + "Buffer specialized configurations for speedbar" + (file tags tools) + "lisp/utils/") ("symbol-syntax.el" "find chars with symbol syntax" (matching) @@ -2362,6 +2518,10 @@ "time zone package for GNU Emacs" (news) "lisp/utils/") + ("toolbar-utils.el" + "Toolbar utility functions for XEmacs" + (extensions) + "lisp/utils/") ("tq.el" "utility to maintain a transaction queue" (extensions) @@ -2374,6 +2534,14 @@ "unique buffer names dependent on file name" nil "lisp/utils/") + ("xpm-button.el" + "create XPM buttons" + (frames internal) + "lisp/utils/") + ("viper-cmd.el" + "Vi command support for Viper" + nil + "lisp/viper/") ("viper-ex.el" "functions implementing the Ex commands for Viper" nil @@ -2399,7 +2567,7 @@ nil "lisp/viper/") ("viper.el" - "A full-featured Vi emulator for GNU Emacs 19 and XEmacs 19," + "A full-featured Vi emulator for GNU Emacs and XEmacs," (emulations) "lisp/viper/") ("vm-easymenu.el" @@ -2534,6 +2702,10 @@ "Emacs 19.xx specific functions for emacs-w3" (faces help mouse hypermedia) "lisp/w3/") + ("w3-e20.el" + "Emacs 20.xx specific functions for emacs-w3" + (faces help mouse hypermedia) + "lisp/w3/") ("w3-elisp.el" "Scripting support for emacs-lisp" (hypermedia scripting) @@ -2622,6 +2794,10 @@ "Main functions for emacs-w3 on all platforms/versions" (faces help comm news mail processes mouse hypermedia) "lisp/w3/") + ("x-compose.el" + "Compose-key processing in XEmacs" + (i18n) + "lisp/x11/") ("x-faces.el" "X-specific face frobnication, aka black magic." nil
--- a/lisp/viper/auto-autoloads.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/viper/auto-autoloads.el Mon Aug 13 09:55:28 2007 +0200 @@ -1,6 +1,8 @@ ;;; DO NOT MODIFY THIS FILE (if (featurep 'viper-autoloads) (error "Already loaded")) + +(provide 'viper-autoloads) ;;;### (autoloads (viper-mode toggle-viper-mode) "viper" "viper/viper.el") @@ -10,5 +12,3 @@ Turn on Viper emulation of Vi." t nil) ;;;*** - -(provide 'viper-autoloads)
--- a/lisp/viper/custom-load.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/viper/custom-load.el Mon Aug 13 09:55:28 2007 +0200 @@ -1,3 +1,3 @@ -(custom-put 'viper-ex 'custom-loads '("viper-ex")) +(custom-put 'viper 'custom-loads '("viper-cmd" "viper-ex" "viper-init" "viper-keym" "viper-macs" "viper-mous" "viper-util" "viper")) (custom-put 'viper-mouse 'custom-loads '("viper-mous")) -(custom-put 'viper 'custom-loads '("viper-cmd" "viper-ex" "viper-init" "viper-keym" "viper-macs" "viper-mous" "viper-util" "viper")) +(custom-put 'viper-ex 'custom-loads '("viper-ex"))
--- a/lisp/viper/viper-cmd.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/viper/viper-cmd.el Mon Aug 13 09:55:28 2007 +0200 @@ -16,6 +16,8 @@ (defvar viper-mode-string) (defvar viper-custom-file-name) (defvar iso-accents-mode) +(defvar quail-mode) +(defvar quail-current-str) (defvar zmacs-region-stays) (defvar mark-even-if-inactive) @@ -161,8 +163,10 @@ )) (if (and (eq this-command 'dabbrev-expand) (integerp viper-pre-command-point) + (markerp viper-insert-point) + (marker-position viper-insert-point) (> viper-insert-point viper-pre-command-point)) - (move-marker viper-insert-point viper-pre-command-point)) + (viper-move-marker-locally viper-insert-point viper-pre-command-point)) ) (defsubst viper-insert-state-pre-command-sentinel () @@ -217,25 +221,23 @@ (let ((replace-boundary (viper-replace-end))) (save-excursion (goto-char viper-last-posn-in-replace-region) + (viper-trim-replace-chars-to-delete-if-necessary) (delete-char viper-replace-chars-to-delete) - (setq viper-replace-chars-to-delete 0 - viper-replace-chars-deleted 0) + (setq viper-replace-chars-to-delete 0) ;; terminate replace mode if reached replace limit - (if (= viper-last-posn-in-replace-region - (viper-replace-end)) - (viper-finish-change viper-last-posn-in-replace-region))) + (if (= viper-last-posn-in-replace-region (viper-replace-end)) + (viper-finish-change))) - (if (and (<= (viper-replace-start) (point)) - (<= (point) replace-boundary)) + (if (viper-pos-within-region + (point) (viper-replace-start) replace-boundary) (progn ;; the state may have changed in viper-finish-change above (if (eq viper-current-state 'replace-state) (viper-change-cursor-color viper-replace-overlay-cursor-color)) (setq viper-last-posn-in-replace-region (point-marker)))) )) - - (t ;; terminate replace mode if changed Viper states. - (viper-finish-change viper-last-posn-in-replace-region)))) + ;; terminate replace mode if changed Viper states. + (t (viper-finish-change)))) ;; changing mode @@ -286,7 +288,7 @@ (viper-push-onto-ring viper-last-insertion 'viper-insertion-ring)) - (if viper-ex-style-editing-in-insert + (if viper-ex-style-editing (or (bolp) (backward-char 1)))) )) @@ -305,7 +307,20 @@ ;; Nothing needs to be done to switch to emacs mode! Just set some ;; variables, which is already done in viper-change-state-to-emacs! + ;; ISO accents + ;; always turn off iso-accents-mode in vi-state, or else we won't be able to + ;; use the keys `,',^ , as they will do accents instead of Vi actions. + (cond ((eq new-state 'vi-state) (viper-set-iso-accents-mode nil));accents off + (viper-automatic-iso-accents (viper-set-iso-accents-mode t));accents on + (t (viper-set-iso-accents-mode nil))) + ;; Always turn off quail mode in vi state + (cond ((eq new-state 'vi-state) (viper-set-input-method nil)) ;intl input off + (viper-special-input-method (viper-set-input-method t)) ;intl input on + (t (viper-set-input-method nil))) + (setq viper-current-state new-state) + + (viper-update-syntax-classes) (viper-normalize-minor-mode-map-alist) (viper-adjust-keys-for new-state) (viper-set-mode-vars-for new-state) @@ -333,9 +348,15 @@ (if viper-want-ctl-h-help (progn + (define-key viper-insert-basic-map [backspace] 'help-command) + (define-key viper-replace-map [backspace] 'help-command) (define-key viper-insert-basic-map [(control h)] 'help-command) (define-key viper-replace-map [(control h)] 'help-command)) (define-key viper-insert-basic-map + [backspace] 'viper-del-backward-char-in-insert) + (define-key viper-replace-map + [backspace] 'viper-del-backward-char-in-replace) + (define-key viper-insert-basic-map [(control h)] 'viper-del-backward-char-in-insert) (define-key viper-replace-map [(control h)] 'viper-del-backward-char-in-replace))) @@ -343,7 +364,10 @@ (t ; Vi state (setq viper-vi-diehard-minor-mode (not viper-want-emacs-keys-in-vi)) (if viper-want-ctl-h-help - (define-key viper-vi-basic-map [(control h)] 'help-command) + (progn + (define-key viper-vi-basic-map [backspace] 'help-command) + (define-key viper-vi-basic-map [(control h)] 'help-command)) + (define-key viper-vi-basic-map [backspace] 'viper-backward-char) (define-key viper-vi-basic-map [(control h)] 'viper-backward-char))) )) @@ -537,17 +561,12 @@ (viper-over-whitespace-line)) (indent-to-left-margin)) (viper-add-newline-at-eob-if-necessary) - (if viper-undo-needs-adjustment (viper-adjust-undo)) + (viper-adjust-undo) (viper-change-state 'vi-state) - ;; always turn off iso-accents-mode, or else we won't be able to use the - ;; keys `,',^ in Vi state, as they will do accents instead of Vi actions. - (if (and (boundp 'iso-accents-mode) iso-accents-mode) - (iso-accents-mode -1)) - (viper-restore-cursor-color-after-insert) - ;; Protection against user errors in hooks + ;; Protect against user errors in hooks (condition-case conds (run-hooks 'viper-vi-state-hook) (error @@ -557,8 +576,6 @@ "Change Viper state to Insert." (interactive) (viper-change-state 'insert-state) - (if (and viper-automatic-iso-accents (fboundp 'iso-accents-mode)) - (iso-accents-mode 1)) ; turn iso accents on (or (stringp viper-saved-cursor-color) (string= (viper-get-cursor-color) viper-insert-state-cursor-color) @@ -568,7 +585,8 @@ ;; bug related to local variables? ;;;(if (stringp viper-saved-cursor-color) ;;; (viper-change-cursor-color viper-insert-state-cursor-color)) - ;; Protection against user errors in hooks + + ;; Protect against user errors in hooks (condition-case conds (run-hooks 'viper-insert-state-hook) (error @@ -584,8 +602,6 @@ ;; replace state changes to insert state. (defun viper-change-state-to-replace (&optional non-R-cmd) (viper-change-state 'replace-state) - (if (and viper-automatic-iso-accents (fboundp 'iso-accents-mode)) - (iso-accents-mode 1)) ; turn iso accents on ;; Run insert-state-hook (condition-case conds (run-hooks 'viper-insert-state-hook 'viper-replace-state-hook) @@ -603,10 +619,8 @@ "Change Viper state to Emacs." (interactive) (viper-change-state 'emacs-state) - (if (and viper-automatic-iso-accents (fboundp 'iso-accents-mode)) - (iso-accents-mode 1)) ; turn iso accents on - ;; Protection agains user errors in hooks + ;; Protect agains user errors in hooks (condition-case conds (run-hooks 'viper-emacs-state-hook) (error @@ -1125,6 +1139,11 @@ ;; Saves last inserted text for possible use by viper-repeat command. (defun viper-save-last-insertion (beg end) + (condition-case nil + (setq viper-last-insertion (buffer-substring beg end)) + (error + ;; beg or end marker are somehow screwed up + (setq viper-last-insertion nil))) (setq viper-last-insertion (buffer-substring beg end)) (or (< (length viper-d-com) 5) (setcar (nthcdr 4 viper-d-com) viper-last-insertion)) @@ -1395,12 +1414,12 @@ (funcall m-com (cons val com)) (cond ((and (< save-point (point)) viper-keep-point-on-repeat) (goto-char save-point)) ; go back to before repeat. - ((and (< save-point (point)) viper-ex-style-editing-in-insert) + ((and (< save-point (point)) viper-ex-style-editing) (or (bolp) (backward-char 1)))) (if (and (eolp) (not (bolp))) (backward-char 1)) )) - (if viper-undo-needs-adjustment (viper-adjust-undo)) ; take care of undo + (viper-adjust-undo) ; take care of undo ;; If the prev cmd was rotating the command ring, this means that `.' has ;; just executed a command from that ring. So, push it on the ring again. ;; If we are just executing previous command , then don't push viper-d-com @@ -1495,8 +1514,8 @@ (viper-sit-for-short 300) (goto-char undo-end-posn) (viper-sit-for-short 300) - (if (and (> (abs (- undo-beg-posn before-undo-pt)) 1) - (> (abs (- undo-end-posn before-undo-pt)) 1)) + (if (and (> (viper-chars-in-region undo-beg-posn before-undo-pt) 1) + (> (viper-chars-in-region undo-end-posn before-undo-pt) 1)) (goto-char before-undo-pt) (goto-char undo-beg-posn))) (push-mark before-undo-pt t)) @@ -1518,24 +1537,26 @@ ;; In VI, unlike Emacs, if you open a line, say, and add a bunch of lines, ;; they are undone all at once. (defun viper-adjust-undo () - (let ((inhibit-quit t) - tmp tmp2) - (setq viper-undo-needs-adjustment nil) - (if (listp buffer-undo-list) - (if (setq tmp (memq viper-buffer-undo-list-mark buffer-undo-list)) - (progn - (setq tmp2 (cdr tmp)) ; the part after mark - - ;; cut tail from buffer-undo-list temporarily by direct - ;; manipulation with pointers in buffer-undo-list - (setcdr tmp nil) - - (setq buffer-undo-list (delq nil buffer-undo-list)) - (setq buffer-undo-list - (delq viper-buffer-undo-list-mark buffer-undo-list)) - ;; restore tail of buffer-undo-list - (setq buffer-undo-list (nconc buffer-undo-list tmp2))) - (setq buffer-undo-list (delq nil buffer-undo-list)))))) + (if viper-undo-needs-adjustment + (let ((inhibit-quit t) + tmp tmp2) + (setq viper-undo-needs-adjustment nil) + (if (listp buffer-undo-list) + (if (setq tmp (memq viper-buffer-undo-list-mark buffer-undo-list)) + (progn + (setq tmp2 (cdr tmp)) ; the part after mark + + ;; cut tail from buffer-undo-list temporarily by direct + ;; manipulation with pointers in buffer-undo-list + (setcdr tmp nil) + + (setq buffer-undo-list (delq nil buffer-undo-list)) + (setq buffer-undo-list + (delq viper-buffer-undo-list-mark buffer-undo-list)) + ;; restore tail of buffer-undo-list + (setq buffer-undo-list (nconc buffer-undo-list tmp2))) + (setq buffer-undo-list (delq nil buffer-undo-list))))) + )) (defun viper-set-complex-command-for-undo () @@ -1560,7 +1581,11 @@ (concat "`" (viper-array-to-string keys) "'") (viper-abbreviate-string (if viper-xemacs-p - (replace-in-string text "\n" "^J") + (replace-in-string + (cond ((characterp text) (char-to-string text)) + ((stringp text) text) + (t "")) + "\n" "^J") text) max-text-len " inserting `" "'" " .......")) @@ -1747,15 +1772,86 @@ (funcall hook) )) -;; Interpret last event in the local map +;; Interpret last event in the local map first; if fails, use exit-minibuffer. +;; Run viper-minibuffer-exit-hook before exiting. (defun viper-exit-minibuffer () + "Exit minibuffer Viper way." (interactive) (let (command) (setq command (local-key-binding (char-to-string last-command-char))) + (run-hooks 'viper-minibuffer-exit-hook) (if command (command-execute command) (exit-minibuffer)))) + +(defcustom viper-smart-suffix-list + '("" "tex" "c" "cc" "C" "el" "java" "html" "htm" "pl" "P" "p") + "*List of suffixes that Viper automatically tries to append to filenames ending with a `.'. +This is useful when you the current directory contains files with the same +prefix and many different suffixes. Usually, only one of the suffixes +represents an editable file. However, file completion will stop at the `.' +The smart suffix feature lets you hit RET in such a case, and Viper will +select the appropriate suffix. + +Suffixes are tried in the order given and the first suffix for which a +corresponding file exists is selected. If no file exists for any of the +suffixes, the user is asked to confirm. + +To turn this feature off, set this variable to nil." + :type '(set string) + :group 'viper) + + +;; Try to add a suitable suffix to files whose name ends with a `.' +;; Useful when the user hits RET on a non-completed file name. +;; Used as a minibuffer exit hook in read-file-name +(defun viper-file-add-suffix () + (let ((count 0) + (len (length viper-smart-suffix-list)) + (file (buffer-string)) + found key cmd suff) + (goto-char (point-max)) + (if (and viper-smart-suffix-list (string-match "\\.$" file)) + (progn + (while (and (not found) (< count len)) + (setq suff (nth count viper-smart-suffix-list) + count (1+ count)) + (if (file-exists-p + (format "%s%s" (substitute-in-file-name file) suff)) + (progn + (setq found t) + (insert suff)))) + + (if found + () + (viper-tmp-insert-at-eob " [Please complete file name]") + (unwind-protect + (while (not (memq cmd + '(exit-minibuffer viper-exit-minibuffer))) + (setq cmd + (key-binding (setq key (read-key-sequence nil)))) + (cond ((eq cmd 'self-insert-command) + (if viper-xemacs-p + (insert (events-to-keys key)) + (insert key))) + ((memq cmd '(exit-minibuffer viper-exit-minibuffer)) + nil) + (t (command-execute cmd))) + ))) + )))) + + +(defun viper-minibuffer-trim-tail () + "Delete junk at the end of the first line of the minibuffer input. +Remove this function from `viper-minibuffer-exit-hook', if this causes +problems." + (if (viper-is-in-minibuffer) + (progn + (goto-char (point-min)) + (end-of-line) + (delete-region (point) (point-max))))) + ;;; Reading string with history @@ -1892,7 +1988,6 @@ (let ((col (current-indentation))) (if (equal com ?r) (viper-loop val - (progn (end-of-line) (newline 1) (if viper-auto-indent @@ -1902,7 +1997,7 @@ (indent-according-to-mode) (indent-to col)) )) - (viper-yank-last-insertion))) + (viper-yank-last-insertion)) (end-of-line) (newline 1) (if viper-auto-indent @@ -1923,7 +2018,6 @@ (let ((col (current-indentation))) (if (equal com ?r) (viper-loop val - (progn (beginning-of-line) (open-line 1) (if viper-auto-indent @@ -1933,7 +2027,7 @@ (indent-according-to-mode) (indent-to col)) )) - (viper-yank-last-insertion))) + (viper-yank-last-insertion)) (beginning-of-line) (open-line 1) (if viper-auto-indent @@ -1955,9 +2049,8 @@ (list 'viper-open-line-at-point val ?r nil nil nil)) (if (equal com ?r) (viper-loop val - (progn (open-line 1) - (viper-yank-last-insertion))) + (viper-yank-last-insertion)) (open-line 1) (viper-change-state-to-insert)))) @@ -1985,8 +2078,7 @@ (defun viper-start-replace () (setq viper-began-as-replace t viper-sitting-in-replace t - viper-replace-chars-to-delete 0 - viper-replace-chars-deleted 0) + viper-replace-chars-to-delete 0) (viper-add-hook 'viper-after-change-functions 'viper-replace-mode-spy-after t) (viper-add-hook @@ -2007,90 +2099,86 @@ ) -;; checks how many chars were deleted by the last change (defun viper-replace-mode-spy-before (beg end) - (setq viper-replace-chars-deleted - (- end beg - (max 0 (- end (viper-replace-end))) - (max 0 (- (viper-replace-start) beg)) - ))) - -;; Invoked as an after-change-function to set up parameters of the last change + (setq viper-replace-region-chars-deleted (viper-chars-in-region beg end)) + ) + +;; Invoked as an after-change-function to calculate how many chars have to be +;; deleted. This function may be called several times within a single command, +;; if this command performs several separate buffer changes. Therefore, if adds +;; up the number of chars inserted and subtracts the number of chars deleted. (defun viper-replace-mode-spy-after (beg end length) - (if (memq viper-intermediate-command '(repeating-insertion-from-ring)) + (if (memq viper-intermediate-command + '(dabbrev-expand repeating-insertion-from-ring)) + ;; Take special care of text insertion from insertion ring inside + ;; replacement overlays. (progn (setq viper-replace-chars-to-delete 0) (viper-move-marker-locally 'viper-last-posn-in-replace-region (point))) - (let (beg-col end-col real-end chars-to-delete) - (setq real-end (min end (viper-replace-end))) - (save-excursion - (goto-char beg) - (setq beg-col (current-column)) - (goto-char real-end) - (setq end-col (current-column))) - - ;; If beg of change is outside the replacement region, then don't - ;; delete anything in the repl region (set chars-to-delete to 0). - ;; - ;; This works fine except that we have to take special care of - ;; dabbrev-expand. The problem stems from new-dabbrev.el, which - ;; sometimes simply shifts the repl region rightwards, without - ;; deleting an equal amount of characters. - ;; - ;; The reason why new-dabbrev.el causes this are this: - ;; if one dinamically completes a partial word that starts before the - ;; replacement region (but ends inside) then new-dabbrev.el first - ;; moves cursor backwards, to the beginning of the word to be - ;; completed (say, pt A). Then it inserts the - ;; completed word and then deletes the old, incomplete part. - ;; Since the complete word is inserted at position before the repl - ;; region, the next If-statement would have set chars-to-delete to 0 - ;; unless we check for the current command, which must be - ;; dabbrev-expand. - ;; - ;; In fact, it might be also useful to have overlays for insert - ;; regions as well, since this will let us capture the situation when - ;; dabbrev-expand goes back past the insertion point to find the - ;; beginning of the word to be expanded. - (if (or (and (<= (viper-replace-start) beg) - (<= beg (viper-replace-end))) - (and (= length 0) (eq this-command 'dabbrev-expand))) - (setq chars-to-delete - (max (- end-col beg-col) (- real-end beg) 0)) - (setq chars-to-delete 0)) - - ;; if beg = last change position, it means that we are within the - ;; same command that does multiple changes. Moreover, it means - ;; that we have two subsequent changes (insert/delete) that - ;; complement each other. - (if (= beg (marker-position viper-last-posn-in-replace-region)) - (setq viper-replace-chars-to-delete - (- (+ chars-to-delete viper-replace-chars-to-delete) - viper-replace-chars-deleted)) - (setq viper-replace-chars-to-delete chars-to-delete)) - + (let* ((real-end (min end (viper-replace-end))) + (column-shift (- (save-excursion (goto-char real-end) + (current-column)) + (save-excursion (goto-char beg) + (current-column)))) + (chars-deleted 0)) + + (if (> length 0) + (setq chars-deleted viper-replace-region-chars-deleted)) + (setq viper-replace-region-chars-deleted 0) + (setq viper-replace-chars-to-delete + (+ viper-replace-chars-to-delete + (- + ;; if column shift is bigger, due to a TAB insertion, take + ;; column-shift instead of the number of inserted chars + (max (viper-chars-in-region beg real-end) + ;; This test accounts for Chinese/Japanese/... chars, + ;; which occupy 2 columns instead of one. If we use + ;; column-shift here, we may delete two chars instead of + ;; one when the user types one Chinese character. Deleting + ;; two would be OK, if they were European chars, but it is + ;; not OK if they are Chinese chars. Since it is hard to + ;; figure out which characters are being deleted in any + ;; given region, we decided to treat Eastern and European + ;; characters equally, even though Eastern chars may + ;; occupy more columns. + (if (memq this-command '(self-insert-command + quoted-insert viper-insert-tab)) + column-shift + 0)) + ;; the number of deleted chars + chars-deleted))) + (viper-move-marker-locally 'viper-last-posn-in-replace-region - (max (if (> end (viper-replace-end)) (viper-replace-start) end) + (max (if (> end (viper-replace-end)) (viper-replace-end) end) (or (marker-position viper-last-posn-in-replace-region) (viper-replace-start)) )) - (setq viper-replace-chars-to-delete - (max 0 - (min viper-replace-chars-to-delete - (- (viper-replace-end) viper-last-posn-in-replace-region) - (- (viper-line-pos 'end) - viper-last-posn-in-replace-region) - ))) ))) - -;; Delete stuff between posn and the end of viper-replace-overlay-marker, if -;; posn is within the overlay. -(defun viper-finish-change (posn) +;; Make sure we don't delete more than needed. +;; This is executed at viper-last-posn-in-replace-region +(defsubst viper-trim-replace-chars-to-delete-if-necessary () + (setq viper-replace-chars-to-delete + (max 0 + (min viper-replace-chars-to-delete + ;; Don't delete more than to the end of repl overlay + (viper-chars-in-region + (viper-replace-end) viper-last-posn-in-replace-region) + ;; point is viper-last-posn-in-replace-region now + ;; So, this limits deletion to the end of line + (viper-chars-in-region (point) (viper-line-pos 'end)) + )))) + + +;; Delete stuff between viper-last-posn-in-replace-region and the end of +;; viper-replace-overlay-marker, if viper-last-posn-in-replace-region is within +;; the overlay and current point is before the end of the overlay. +;; Don't delete anything if current point is past the end of the overlay. +(defun viper-finish-change () (viper-remove-hook 'viper-after-change-functions 'viper-replace-mode-spy-after) (viper-remove-hook @@ -2102,12 +2190,13 @@ (viper-restore-cursor-color-after-replace) (setq viper-sitting-in-replace nil) ; just in case we'll need to know it (save-excursion - (if (and - viper-replace-overlay - (>= posn (viper-replace-start)) - (< posn (viper-replace-end))) - (delete-region posn (viper-replace-end))) - ) + (if (and viper-replace-overlay + (viper-pos-within-region viper-last-posn-in-replace-region + (viper-replace-start) + (viper-replace-end)) + (< (point) (viper-replace-end))) + (delete-region + viper-last-posn-in-replace-region (viper-replace-end)))) (if (eq viper-current-state 'replace-state) (viper-downgrade-to-insert)) @@ -2150,9 +2239,9 @@ "Binding for keys that cause Replace state to switch to Vi or to Insert. These keys are ESC, RET, and LineFeed" (interactive) - (if overwrite-mode ;; If you are in replace mode invoked via 'R' + (if overwrite-mode ; if in replace mode invoked via 'R' (viper-finish-R-mode) - (viper-finish-change viper-last-posn-in-replace-region)) + (viper-finish-change)) (let (com) (if (eq this-command 'viper-intercept-ESC-key) (setq com 'viper-exit-insert-state) @@ -2269,29 +2358,66 @@ (com (viper-getcom arg))) (viper-replace-char-subr com val) (if (and (eolp) (not (bolp))) (forward-char 1)) + (setq viper-this-command-keys + (format "%sr" (if (integerp arg) arg ""))) (viper-set-destructive-command (list 'viper-replace-char val ?r nil viper-d-char nil)) )) (defun viper-replace-char-subr (com arg) - (let ((take-care-of-iso-accents - (and (boundp 'iso-accents-mode) viper-automatic-iso-accents)) - char) + (let (char) (setq char (if (equal com ?r) viper-d-char (read-char))) - (if (and take-care-of-iso-accents (memq char '(?' ?\" ?^ ?~))) - ;; get European characters - (progn - (iso-accents-mode 1) - (viper-set-unread-command-events char) - (setq char (aref (read-key-sequence nil) 0)) - (iso-accents-mode -1))) - (delete-char arg t) - (setq viper-d-char char) - (viper-loop (if (> arg 0) arg (- arg)) - (if (eq char ?\C-m) (insert "\n") (insert char))) - (backward-char arg))) + (let (inhibit-quit) ; preserve consistency of undo-list and iso-accents + (if (and viper-automatic-iso-accents (memq char '(?' ?\" ?^ ?~))) + ;; get European characters + (progn + (viper-set-iso-accents-mode t) + (viper-set-unread-command-events char) + (setq char (aref (read-key-sequence nil) 0)) + (viper-set-iso-accents-mode nil))) + (viper-set-complex-command-for-undo) + (if (eq char ?\C-m) (setq char ?\n)) + (if (and viper-special-input-method (fboundp 'quail-start-translation)) + ;; get Intl. characters + (progn + (viper-set-input-method t) + (setq last-command-event + (viper-copy-event + (if viper-xemacs-p (character-to-event char) char))) + (delete-char 1 t) + (condition-case nil + (if com + (insert char) + (if viper-emacs-p + (quail-start-translation 1) + (quail-start-translation))) + (error)) + ;; quail translation failed + (if (and (not (stringp quail-current-str)) + (not (viper-characterp quail-current-str))) + (progn + (viper-adjust-undo) + (undo-start) + (undo-more 1) + (viper-set-input-method nil) + (error "Composing character failed, changes undone"))) + ;; quail translation seems ok + (or com + ;;(setq char quail-current-str)) + (setq char (viper-char-at-pos 'backward))) + (setq viper-d-char char) + (viper-loop (1- (if (> arg 0) arg (- arg))) + (delete-char 1 t) + (insert char)) + (viper-set-input-method nil)) + (delete-char arg t) + (setq viper-d-char char) + (viper-loop (if (> arg 0) arg (- arg)) + (insert char))) + (viper-adjust-undo) + (backward-char arg)))) ;; basic cursor movement. j, k, l, h commands. @@ -2334,18 +2460,30 @@ (if com (viper-execute-com 'viper-backward-char val com))))) ;; Like forward-char, but doesn't move at end of buffer. +;; Returns distance traveled +;; (positive or 0, if arg positive; negative if arg negative). (defun viper-forward-char-carefully (&optional arg) (setq arg (or arg 1)) - (if (>= (point-max) (+ (point) arg)) - (forward-char arg) - (goto-char (point-max)))) + (let ((pt (point))) + (condition-case nil + (forward-char arg) + (error)) + (if (< (point) pt) ; arg was negative + (- (viper-chars-in-region pt (point))) + (viper-chars-in-region pt (point))))) -;; Like backward-char, but doesn't move at end of buffer. +;; Like backward-char, but doesn't move at beg of buffer. +;; Returns distance traveled +;; (negative or 0, if arg positive; positive if arg negative). (defun viper-backward-char-carefully (&optional arg) (setq arg (or arg 1)) - (if (<= (point-min) (- (point) arg)) - (backward-char arg) - (goto-char (point-min)))) + (let ((pt (point))) + (condition-case nil + (backward-char arg) + (error)) + (if (> (point) pt) ; arg was negative + (viper-chars-in-region pt (point)) + (- (viper-chars-in-region pt (point)))))) (defun viper-next-line-carefully (arg) (condition-case nil @@ -2372,7 +2510,7 @@ (forward-char) (viper-skip-all-separators-forward 'within-line)))) (viper-skip-all-separators-backward 'within-line) - (backward-char) + (viper-backward-char-carefully) (if (looking-at "\n") (viper-skip-all-separators-backward 'within-line) (forward-char)))) @@ -2389,16 +2527,43 @@ (viper-skip-separators t))) (setq val (1- val)))) -;; first search backward for pat. Then skip chars backwards using aux-pat -(defun viper-fwd-skip (pat aux-pat lim) - (if (and (save-excursion - (re-search-backward pat lim t)) - (= (point) (match-end 0))) - (goto-char (match-beginning 0))) - (skip-chars-backward aux-pat lim) - (if (= (point) lim) - (viper-forward-char-carefully)) - ) +;; first skip non-newline separators backward, then skip \n. Then, if TWICE is +;; non-nil, skip non-\n back again, but don't overshoot the limit LIM. +(defun viper-separator-skipback-special (twice lim) + (let ((prev-char (viper-char-at-pos 'backward)) + (saved-point (point))) + ;; skip non-newline separators backward + (while (and (not (memq prev-char '(nil \n))) + (< lim (point)) + ;; must be non-newline separator + (if (eq viper-syntax-preference 'strict-vi) + (memq prev-char '(?\ ?\t)) + (memq (char-syntax prev-char) '(?\ ?-)))) + (viper-backward-char-carefully) + (setq prev-char (viper-char-at-pos 'backward))) + + (if (and (< lim (point)) (eq prev-char ?\n)) + (backward-char) + ;; If we skipped to the next word and the prefix of this line doesn't + ;; consist of separators preceded by a newline, then don't skip backwards + ;; at all. + (goto-char saved-point)) + (setq prev-char (viper-char-at-pos 'backward)) + + ;; skip again, but make sure we don't overshoot the limit + (if twice + (while (and (not (memq prev-char '(nil \n))) + (< lim (point)) + ;; must be non-newline separator + (if (eq viper-syntax-preference 'strict-vi) + (memq prev-char '(?\ ?\t)) + (memq (char-syntax prev-char) '(?\ ?-)))) + (viper-backward-char-carefully) + (setq prev-char (viper-char-at-pos 'backward)))) + + (if (= (point) lim) + (viper-forward-char-carefully)) + )) (defun viper-forward-word (arg) @@ -2411,12 +2576,12 @@ (viper-forward-word-kernel val) (if com (progn (cond ((memq com (list ?c (- ?c))) - (viper-fwd-skip "\n[ \t]*" " \t" viper-com-point)) + (viper-separator-skipback-special 'twice viper-com-point)) ;; Yank words including the whitespace, but not newline ((memq com (list ?y (- ?y))) - (viper-fwd-skip "\n[ \t]*" "" viper-com-point)) + (viper-separator-skipback-special nil viper-com-point)) ((viper-dotable-command-p com) - (viper-fwd-skip "\n[ \t]*" "" viper-com-point))) + (viper-separator-skipback-special nil viper-com-point))) (viper-execute-com 'viper-forward-word val com))))) @@ -2428,17 +2593,16 @@ (com (viper-getcom arg))) (if com (viper-move-marker-locally 'viper-com-point (point))) (viper-loop val - (progn (viper-skip-nonseparators 'forward) - (viper-skip-separators t))) + (viper-skip-separators t)) (if com (progn (cond ((memq com (list ?c (- ?c))) - (viper-fwd-skip "\n[ \t]*" " \t" viper-com-point)) + (viper-separator-skipback-special 'twice viper-com-point)) ;; Yank words including the whitespace, but not newline ((memq com (list ?y (- ?y))) - (viper-fwd-skip "\n[ \t]*" "" viper-com-point)) + (viper-separator-skipback-special nil viper-com-point)) ((viper-dotable-command-p com) - (viper-fwd-skip "\n[ \t]*" "" viper-com-point))) + (viper-separator-skipback-special nil viper-com-point))) (viper-execute-com 'viper-forward-Word val com))))) @@ -2485,10 +2649,9 @@ (com (viper-getcom arg))) (if com (viper-move-marker-locally 'viper-com-point (point))) (viper-loop val - (progn (viper-end-of-word-kernel) (viper-skip-nonseparators 'forward) - (backward-char))) + (backward-char)) (if com (progn (forward-char) @@ -2496,17 +2659,18 @@ (defun viper-backward-word-kernel (val) (while (> val 0) - (backward-char) + (viper-backward-char-carefully) (cond ((viper-looking-at-alpha) (viper-skip-alpha-backward "_")) ((viper-looking-at-separator) (forward-char) (viper-skip-separators nil) - (backward-char) + (viper-backward-char-carefully) (cond ((viper-looking-at-alpha) (viper-skip-alpha-backward "_")) ((not (viper-looking-at-alphasep)) (viper-skip-nonalphasep-backward)) + ((bobp)) ; could still be at separator, but at beg of buffer (t (forward-char)))) ((not (viper-looking-at-alphasep)) (viper-skip-nonalphasep-backward))) @@ -2540,9 +2704,8 @@ (viper-move-marker-locally 'viper-com-point (point)) (if i (forward-char)))) (viper-loop val - (progn - (viper-skip-separators nil) - (viper-skip-nonseparators 'backward))) + (viper-skip-separators nil) ; nil means backward here + (viper-skip-nonseparators 'backward)) (if com (viper-execute-com 'viper-backward-Word val com)))) @@ -2593,7 +2756,9 @@ (let ((val (viper-p-val arg)) (com (viper-getcom arg)) line-len) - (setq line-len (- (viper-line-pos 'end) (viper-line-pos 'start))) + (setq line-len + (viper-chars-in-region + (viper-line-pos 'start) (viper-line-pos 'end))) (if com (viper-move-marker-locally 'viper-com-point (point))) (beginning-of-line) (forward-char (1- (min line-len val))) @@ -2733,7 +2898,10 @@ (search-forward (char-to-string char) nil 0 arg)) (setq point (point)) (error "Command `%s': `%c' not found" cmd char)))) - (goto-char (+ point (if (> arg 0) (if offset -2 -1) (if offset 1 0)))))) + (goto-char point) + (if (> arg 0) + (backward-char (if offset 2 1)) + (forward-char (if offset 1 0))))) (defun viper-find-char-forward (arg) "Find char on the line. @@ -3546,62 +3714,6 @@ (kill-buffer buffer) (error "Buffer not killed")))) - -(defcustom viper-smart-suffix-list - '("" "tex" "c" "cc" "C" "el" "java" "html" "htm" "pl" "P" "p") - "*List of suffixes that Viper automatically tries to append to filenames ending with a `.'. -This is useful when you the current directory contains files with the same -prefix and many different suffixes. Usually, only one of the suffixes -represents an editable file. However, file completion will stop at the `.' -The smart suffix feature lets you hit RET in such a case, and Viper will -select the appropriate suffix. - -Suffixes are tried in the order given and the first suffix for which a -corresponding file exists is selected. If no file exists for any of the -suffixes, the user is asked to confirm. - -To turn this feature off, set this variable to nil." - :type '(set string) - :group 'viper) - -;; Try to add suffix to files ending with a `.' -;; Useful when the user hits RET on a non-completed file name. -(defun viper-file-add-suffix () - (let ((count 0) - (len (length viper-smart-suffix-list)) - (file (buffer-string)) - found key cmd suff) - (goto-char (point-max)) - (if (and viper-smart-suffix-list (string-match "\\.$" file)) - (progn - (while (and (not found) (< count len)) - (setq suff (nth count viper-smart-suffix-list) - count (1+ count)) - (if (file-exists-p - (format "%s%s" (substitute-in-file-name file) suff)) - (progn - (setq found t) - (insert suff)))) - - (if found - () - (viper-tmp-insert-at-eob " [Please complete file name]") - (unwind-protect - (while (not (memq cmd - '(exit-minibuffer viper-exit-minibuffer))) - (setq cmd - (key-binding (setq key (read-key-sequence nil)))) - (cond ((eq cmd 'self-insert-command) - (if viper-xemacs-p - (insert (events-to-keys key)) - (insert key))) - ((memq cmd '(exit-minibuffer viper-exit-minibuffer)) - nil) - (t (command-execute cmd))) - ))) - )))) - - ;; yank and pop @@ -3696,67 +3808,68 @@ (defun viper-delete-char (arg) - "Delete character." + "Delete next character." (interactive "P") - (let ((val (viper-p-val arg))) + (let ((val (viper-p-val arg)) + end-del-pos) (viper-set-destructive-command (list 'viper-delete-char val nil nil nil nil)) - (if (> val 1) - (save-excursion - (let ((here (point))) - (end-of-line) - (if (> val (- (point) here)) - (setq val (- (point) here)))))) - (if (and (eq val 0) (not viper-ex-style-motion)) (setq val 1)) + (if (and viper-ex-style-editing + (> val (viper-chars-in-region (point) (viper-line-pos 'end)))) + (setq val (viper-chars-in-region (point) (viper-line-pos 'end)))) (if (and viper-ex-style-motion (eolp)) (if (bolp) (error "") (setq val 0))) ; not bol---simply back 1 ch + (save-excursion + (viper-forward-char-carefully val) + (setq end-del-pos (point))) (if viper-use-register (progn (cond ((viper-valid-register viper-use-register '((Letter))) (viper-append-to-register - (downcase viper-use-register) (point) (- (point) val))) + (downcase viper-use-register) (point) end-del-pos)) ((viper-valid-register viper-use-register) (copy-to-register - viper-use-register (point) (- (point) val) nil)) + viper-use-register (point) end-del-pos nil)) (t (error viper-InvalidRegister viper-use-register))) (setq viper-use-register nil))) + + (delete-char val t) (if viper-ex-style-motion - (progn - (delete-char val t) - (if (and (eolp) (not (bolp))) (backward-char 1))) - (if (eolp) - (delete-backward-char val t) - (delete-char val t))))) + (if (and (eolp) (not (bolp))) (backward-char 1))) + )) (defun viper-delete-backward-char (arg) "Delete previous character. On reaching beginning of line, stop and beep." (interactive "P") - (let ((val (viper-p-val arg))) + (let ((val (viper-p-val arg)) + end-del-pos) (viper-set-destructive-command (list 'viper-delete-backward-char val nil nil nil nil)) - (if (> val 1) - (save-excursion - (let ((here (point))) - (beginning-of-line) - (if (> val (- here (point))) - (setq val (- here (point))))))) + (if (and + viper-ex-style-editing + (> val (viper-chars-in-region (viper-line-pos 'start) (point)))) + (setq val (viper-chars-in-region (viper-line-pos 'start) (point)))) + (save-excursion + (viper-backward-char-carefully val) + (setq end-del-pos (point))) (if viper-use-register (progn (cond ((viper-valid-register viper-use-register '(Letter)) (viper-append-to-register - (downcase viper-use-register) (point) (+ (point) val))) + (downcase viper-use-register) end-del-pos (point))) ((viper-valid-register viper-use-register) (copy-to-register - viper-use-register (point) (+ (point) val) nil)) + viper-use-register end-del-pos (point) nil)) (t (error viper-InvalidRegister viper-use-register))) (setq viper-use-register nil))) - (if (bolp) (ding) - (delete-backward-char val t)))) + (if (and (bolp) viper-ex-style-editing) + (ding)) + (delete-backward-char val t))) (defun viper-del-backward-char-in-insert () "Delete 1 char backwards while in insert mode." (interactive) - (if (and viper-ex-style-editing-in-insert (bolp)) + (if (and viper-ex-style-editing (bolp)) (beep 1) (delete-backward-char 1 t))) @@ -3764,19 +3877,19 @@ "Delete one character in replace mode. If `viper-delete-backwards-in-replace' is t, then DEL key actually deletes charecters. If it is nil, then the cursor just moves backwards, similarly -to Vi. The variable `viper-ex-style-editing-in-insert', if t, doesn't let the +to Vi. The variable `viper-ex-style-editing', if t, doesn't let the cursor move past the beginning of line." (interactive) (cond (viper-delete-backwards-in-replace (cond ((not (bolp)) (delete-backward-char 1 t)) - (viper-ex-style-editing-in-insert + (viper-ex-style-editing (beep 1)) ((bobp) (beep 1)) (t (delete-backward-char 1 t)))) - (viper-ex-style-editing-in-insert + (viper-ex-style-editing (if (bolp) (beep 1) (backward-char 1))) @@ -3794,7 +3907,6 @@ (viper-set-destructive-command (list 'viper-join-lines val nil nil nil nil)) (viper-loop (if (null val) 1 (1- val)) - (progn (end-of-line) (if (not (eobp)) (progn @@ -3806,7 +3918,7 @@ (or (looking-at " ") (insert " ") (backward-char 1)) - )))))) + ))))) ;; Replace state @@ -4262,7 +4374,7 @@ (setq viper-always t viper-ex-style-motion t - viper-ex-style-editing-in-insert t + viper-ex-style-editing t viper-want-ctl-h-help nil) (cond ((eq viper-expert-level 1) ; novice or beginner @@ -4289,14 +4401,14 @@ ; and viper-no-multiple-ESC (progn (setq-default - viper-ex-style-editing-in-insert - (viper-standard-value 'viper-ex-style-editing-in-insert) + viper-ex-style-editing + (viper-standard-value 'viper-ex-style-editing) viper-ex-style-motion (viper-standard-value 'viper-ex-style-motion)) (setq viper-ex-style-motion (viper-standard-value 'viper-ex-style-motion) - viper-ex-style-editing-in-insert - (viper-standard-value 'viper-ex-style-editing-in-insert) + viper-ex-style-editing + (viper-standard-value 'viper-ex-style-editing) viper-re-search (viper-standard-value 'viper-re-search) viper-no-multiple-ESC @@ -4305,8 +4417,8 @@ ;; A wizard!! ;; Ideally, if 5 is selected, a buffer should pop up to let the ;; user toggle the values of variables. - (t (setq-default viper-ex-style-editing-in-insert - (viper-standard-value 'viper-ex-style-editing-in-insert) + (t (setq-default viper-ex-style-editing + (viper-standard-value 'viper-ex-style-editing) viper-ex-style-motion (viper-standard-value 'viper-ex-style-motion)) (setq viper-want-ctl-h-help @@ -4317,8 +4429,8 @@ (viper-standard-value 'viper-no-multiple-ESC) viper-ex-style-motion (viper-standard-value 'viper-ex-style-motion) - viper-ex-style-editing-in-insert - (viper-standard-value 'viper-ex-style-editing-in-insert) + viper-ex-style-editing + (viper-standard-value 'viper-ex-style-editing) viper-re-search (viper-standard-value 'viper-re-search) viper-electric-mode @@ -4366,7 +4478,7 @@ 3 -- GRAND MASTER: Like 3, but most Emacs commands are available also in Viper's insert state. 4 -- GURU: Like 3, but user settings are respected for viper-no-multiple-ESC, - viper-ex-style-motion, viper-ex-style-editing-in-insert, and + viper-ex-style-motion, viper-ex-style-editing, and viper-re-search variables. Adjust these settings to your taste. 5 -- WIZARD: Like 4, but user settings are also respected for viper-always, viper-electric-mode, viper-want-ctl-h-help, viper-want-emacs-keys-in-vi, @@ -4487,6 +4599,7 @@ 'viper-emacs-global-user-minor-mode 'viper-emacs-state-modifier-minor-mode 'viper-automatic-iso-accents + 'viper-special-input-method 'viper-want-emacs-keys-in-insert 'viper-want-emacs-keys-in-vi 'viper-keep-point-on-undo @@ -4494,7 +4607,7 @@ 'viper-electric-mode 'viper-ESC-key 'viper-want-ctl-h-help - 'viper-ex-style-editing-in-insert + 'viper-ex-style-editing 'viper-delete-backwards-in-replace 'viper-vi-style-in-minibuffer 'viper-vi-state-hook
--- a/lisp/viper/viper-ex.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/viper/viper-ex.el Mon Aug 13 09:55:28 2007 +0200 @@ -326,98 +326,100 @@ (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name)) (set-buffer viper-ex-work-buf) (skip-chars-forward " \t|") - (cond ((looking-at "#") - (setq ex-token-type 'command) - (setq ex-token (char-to-string (following-char))) - (forward-char 1)) - ((looking-at "[a-z]") (viper-get-ex-com-subr)) - ((looking-at "\\.") - (forward-char 1) - (setq ex-token-type 'dot)) - ((looking-at "[0-9]") - (set-mark (point)) - (re-search-forward "[0-9]*") - (setq ex-token-type - (cond ((eq ex-token-type 'plus) 'add-number) - ((eq ex-token-type 'minus) 'sub-number) - (t 'abs-number))) - (setq ex-token (string-to-int (buffer-substring (point) (mark t))))) - ((looking-at "\\$") - (forward-char 1) - (setq ex-token-type 'end)) - ((looking-at "%") - (forward-char 1) - (setq ex-token-type 'whole)) - ((looking-at "+") - (cond ((or (looking-at "+[-+]") (looking-at "+[\n|]")) - (forward-char 1) - (insert "1") - (backward-char 1) - (setq ex-token-type 'plus)) - ((looking-at "+[0-9]") - (forward-char 1) + (let ((case-fold-search t)) + (cond ((looking-at "#") + (setq ex-token-type 'command) + (setq ex-token (char-to-string (following-char))) + (forward-char 1)) + ((looking-at "[a-z]") (viper-get-ex-com-subr)) + ((looking-at "\\.") + (forward-char 1) + (setq ex-token-type 'dot)) + ((looking-at "[0-9]") + (set-mark (point)) + (re-search-forward "[0-9]*") + (setq ex-token-type + (cond ((eq ex-token-type 'plus) 'add-number) + ((eq ex-token-type 'minus) 'sub-number) + (t 'abs-number))) + (setq ex-token + (string-to-int (buffer-substring (point) (mark t))))) + ((looking-at "\\$") + (forward-char 1) + (setq ex-token-type 'end)) + ((looking-at "%") + (forward-char 1) + (setq ex-token-type 'whole)) + ((looking-at "+") + (cond ((or (looking-at "+[-+]") (looking-at "+[\n|]")) + (forward-char 1) + (insert "1") + (backward-char 1) (setq ex-token-type 'plus)) - (t - (error viper-BadAddress)))) - ((looking-at "-") - (cond ((or (looking-at "-[-+]") (looking-at "-[\n|]")) - (forward-char 1) - (insert "1") - (backward-char 1) - (setq ex-token-type 'minus)) - ((looking-at "-[0-9]") - (forward-char 1) - (setq ex-token-type 'minus)) - (t - (error viper-BadAddress)))) - ((looking-at "/") - (forward-char 1) - (set-mark (point)) - (let ((cont t)) - (while (and (not (eolp)) cont) - ;;(re-search-forward "[^/]*/") - (re-search-forward "[^/]*\\(/\\|\n\\)") - (if (not (viper-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/")) - (setq cont nil)))) - (backward-char 1) - (setq ex-token (buffer-substring (point) (mark t))) - (if (looking-at "/") (forward-char 1)) - (setq ex-token-type 'search-forward)) - ((looking-at "\\?") - (forward-char 1) - (set-mark (point)) - (let ((cont t)) - (while (and (not (eolp)) cont) - ;;(re-search-forward "[^\\?]*\\?") - (re-search-forward "[^\\?]*\\(\\?\\|\n\\)") - (if (not (viper-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?")) - (setq cont nil)) - (backward-char 1) - (if (not (looking-at "\n")) (forward-char 1)))) - (setq ex-token-type 'search-backward) - (setq ex-token (buffer-substring (1- (point)) (mark t)))) - ((looking-at ",") - (forward-char 1) - (setq ex-token-type 'comma)) - ((looking-at ";") - (forward-char 1) - (setq ex-token-type 'semi-colon)) - ((looking-at "[!=><&~]") - (setq ex-token-type 'command) - (setq ex-token (char-to-string (following-char))) - (forward-char 1)) - ((looking-at "'") - (setq ex-token-type 'goto-mark) - (forward-char 1) - (cond ((looking-at "'") (setq ex-token nil)) - ((looking-at "[a-z]") (setq ex-token (following-char))) - (t (error "Marks are ' and a-z"))) - (forward-char 1)) - ((looking-at "\n") - (setq ex-token-type 'end-mark) - (setq ex-token "goto")) - (t - (error viper-BadExCommand))))) + ((looking-at "+[0-9]") + (forward-char 1) + (setq ex-token-type 'plus)) + (t + (error viper-BadAddress)))) + ((looking-at "-") + (cond ((or (looking-at "-[-+]") (looking-at "-[\n|]")) + (forward-char 1) + (insert "1") + (backward-char 1) + (setq ex-token-type 'minus)) + ((looking-at "-[0-9]") + (forward-char 1) + (setq ex-token-type 'minus)) + (t + (error viper-BadAddress)))) + ((looking-at "/") + (forward-char 1) + (set-mark (point)) + (let ((cont t)) + (while (and (not (eolp)) cont) + ;;(re-search-forward "[^/]*/") + (re-search-forward "[^/]*\\(/\\|\n\\)") + (if (not (viper-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/")) + (setq cont nil)))) + (backward-char 1) + (setq ex-token (buffer-substring (point) (mark t))) + (if (looking-at "/") (forward-char 1)) + (setq ex-token-type 'search-forward)) + ((looking-at "\\?") + (forward-char 1) + (set-mark (point)) + (let ((cont t)) + (while (and (not (eolp)) cont) + ;;(re-search-forward "[^\\?]*\\?") + (re-search-forward "[^\\?]*\\(\\?\\|\n\\)") + (if (not (viper-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?")) + (setq cont nil)) + (backward-char 1) + (if (not (looking-at "\n")) (forward-char 1)))) + (setq ex-token-type 'search-backward) + (setq ex-token (buffer-substring (1- (point)) (mark t)))) + ((looking-at ",") + (forward-char 1) + (setq ex-token-type 'comma)) + ((looking-at ";") + (forward-char 1) + (setq ex-token-type 'semi-colon)) + ((looking-at "[!=><&~]") + (setq ex-token-type 'command) + (setq ex-token (char-to-string (following-char))) + (forward-char 1)) + ((looking-at "'") + (setq ex-token-type 'goto-mark) + (forward-char 1) + (cond ((looking-at "'") (setq ex-token nil)) + ((looking-at "[a-z]") (setq ex-token (following-char))) + (t (error "Marks are ' and a-z"))) + (forward-char 1)) + ((looking-at "\n") + (setq ex-token-type 'end-mark) + (setq ex-token "goto")) + (t + (error viper-BadExCommand)))))) ;; Reads Ex command. Tries to determine if it has to exit because command ;; is complete or invalid. If not, keeps reading command.
--- a/lisp/viper/viper-init.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/viper/viper-init.el Mon Aug 13 09:55:28 2007 +0200 @@ -25,6 +25,9 @@ ;; compiler pacifier (defvar mark-even-if-inactive) +(defvar quail-mode) +(defvar iso-accents-mode) +(defvar viper-current-state) (defvar viper-version) (defvar viper-expert-level) ;; end pacifier @@ -83,13 +86,15 @@ (make-variable-buffer-local '(, var)) ))) -(defmacro viper-loop (count body) - "(viper-loop COUNT BODY) Execute BODY COUNT times." - (list 'let (list (list 'count count)) - (list 'while '(> count 0) - body - '(setq count (1- count)) - ))) +;; (viper-loop COUNT BODY) Execute BODY COUNT times. +(defmacro viper-loop (count &rest body) + (` (let ((count (, count))) + (while (> count 0) + (progn + (,@ body) + (setq count (1- count)) + )) + ))) (defmacro viper-buffer-live-p (buf) (` (and (, buf) (get-buffer (, buf)) (buffer-name (get-buffer (, buf)))))) @@ -124,6 +129,19 @@ ;; last elt of a sequence (defsubst viper-seq-last-elt (seq) (elt seq (1- (length seq)))) + +(defsubst viper-string-to-list (string) + (append (vconcat string) nil)) + +(defsubst viper-charlist-to-string (list) + (mapconcat 'char-to-string list "")) + +;; like char-after/before, but saves typing +(defun viper-char-at-pos (direction &optional offset) + (or (integerp offset) (setq offset 0)) + (if (eq direction 'forward) + (char-after (+ (point) offset)) + (char-before (- (point) offset)))) (defvar viper-minibuffer-overlay-priority 300) @@ -251,16 +269,81 @@ (defconst viper-max-expert-level 5) -;;; ISO characters - +;;; ISO characters and MULE + +;; 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. (viper-deflocalvar viper-automatic-iso-accents nil "") -(defcustom viper-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." - :type 'boolean - :group 'viper) +;; Set iso-accents-mode to ARG. Check if it is bound first +(defsubst viper-set-iso-accents-mode (arg) + (if (boundp 'iso-accents-mode) + (setq iso-accents-mode arg))) + +;; Internal flag used to control when viper mule hooks are run. +;; Don't change this! +(defvar viper-mule-hook-flag t) +;; If non-nil, the default intl. input method is turned on. +(viper-deflocalvar viper-special-input-method nil "") +;; viper hook to run on input-method activation +(defun viper-activate-input-method-action () + (if (null viper-mule-hook-flag) + () + (setq viper-special-input-method t) + ;; turn off special input methods in vi-state + (if (eq viper-current-state 'vi-state) + (viper-set-input-method nil)) + (if (memq viper-current-state '(vi-state insert-state replace-state)) + (message "Viper special input method%s: on" + (if (or current-input-method default-input-method) + (format " %S" + (or current-input-method default-input-method)) + ""))) + )) +;; viper hook to run on input-method deactivation +(defun viper-inactivate-input-method-action () + (if (null viper-mule-hook-flag) + () + (setq viper-special-input-method nil) + (if (memq viper-current-state '(vi-state insert-state replace-state)) + (message "Viper special input method%s: off" + (if (or current-input-method default-input-method) + (format " %S" + (or current-input-method default-input-method)) + ""))))) + +(defun viper-inactivate-input-method () + (cond ((and viper-emacs-p (fboundp 'inactivate-input-method)) + (inactivate-input-method)) + ((and viper-xemacs-p (boundp 'current-input-method)) + ;; XEmacs had broken quil-mode for some time, so we are working around + ;; it here + (setq quail-mode nil) + (if (featurep 'quail) + (quail-delete-overlays)) + (setq describe-current-input-method-function nil) + (setq current-input-method nil) + (run-hooks 'input-method-inactivate-hook) + (force-mode-line-update)) + )) +(defun viper-activate-input-method () + (cond ((and viper-emacs-p (fboundp 'activate-input-method)) + (activate-input-method default-input-method)) + ((and viper-xemacs-p (fboundp 'quail-mode)) + (quail-mode 1)))) + +;; Set quail-mode to ARG +(defun viper-set-input-method (arg) + (setq viper-mule-hook-flag t) ; just a precaution + (let (viper-mule-hook-flag) ; temporarily inactivate viper mule hooks + (cond ((and arg (> (prefix-numeric-value arg) 0) default-input-method) + ;; activate input method + (viper-activate-input-method)) + (t ; deactivate input method + (viper-inactivate-input-method))) + )) + ;; VI-style Undo @@ -337,7 +420,9 @@ is non-nil." :type 'string :group 'viper) -(defcustom viper-use-replace-region-delimiters (not (viper-has-face-support-p)) +(defcustom viper-use-replace-region-delimiters + (or (not (viper-has-face-support-p)) + (and viper-xemacs-p (eq (viper-device-type) 'tty))) "*If non-nil, Viper will always use `viper-replace-region-end-delimiter' and `viper-replace-region-start-delimiter' to delimit replacement regions, even on color displays. By default, the delimiters are used only on TTYs." @@ -372,7 +457,12 @@ ;; Remember the number of characters that have to be deleted in replace ;; mode to compensate for the inserted characters. (viper-deflocalvar viper-replace-chars-to-delete 0 "") -(viper-deflocalvar viper-replace-chars-deleted 0 "") +;; This variable is used internally by the before/after changed functions to +;; determine how many chars were deleted by the change. This can't be +;; determined inside after-change-functions because those get the length of the +;; deleted region, not the number of chars deleted (which are two different +;; things under MULE). +(viper-deflocalvar viper-replace-region-chars-deleted 0 "") ;; Insertion ring and command ring (defcustom viper-insertion-ring-size 14 @@ -520,8 +610,7 @@ (defvar viper-use-register nil) - -;; Variables for Moves and Searches +;;; Variables for Moves and Searches ;; For use by `;' command. (defvar viper-f-char nil) @@ -589,18 +678,22 @@ :type 'boolean :group 'viper) -(viper-deflocalvar viper-ex-style-editing-in-insert t "") -(defcustom viper-ex-style-editing-in-insert t - "*If t, `Backspace' and `Delete' don't cross line boundaries in insert, etc. +(viper-deflocalvar viper-ex-style-editing t "") +(defcustom viper-ex-style-editing t + "*If t, Ex-style behavior while editing in Vi command and insert states. +`Backspace' and `Delete' don't cross line boundaries in insert. +`X' and `x' can't delete characters across line boundary in Vi, etc. Note: this doesn't preclude `Backspace' and `Delete' from deleting characters -by moving past the insertion point. This is a feature, not a bug." +by moving past the insertion point. This is a feature, not a bug. + +If nil, the above commands can work across lines." :type 'boolean :group 'viper) -(viper-deflocalvar viper-ESC-moves-cursor-back viper-ex-style-editing-in-insert "") +(viper-deflocalvar viper-ESC-moves-cursor-back viper-ex-style-editing "") (defcustom viper-ESC-moves-cursor-back nil "*If t, ESC moves cursor back when changing from insert to vi state. -If nil, the cursor stays where it was." +If nil, the cursor stays where it was when ESC was hit." :type 'boolean :group 'viper) @@ -888,7 +981,7 @@ ;; 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 viper-minibuffer-exit-hook nil) +(defvar viper-minibuffer-exit-hook '(viper-minibuffer-trim-tail)) ;; Mode line
--- a/lisp/viper/viper-keym.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/viper/viper-keym.el Mon Aug 13 09:55:28 2007 +0200 @@ -28,7 +28,7 @@ (defvar viper-current-state) (defvar viper-mode-string) (defvar viper-expert-level) -(defvar viper-ex-style-editing-in-insert) +(defvar viper-ex-style-editing) (defvar viper-ex-style-motion) ;; loading happens only in non-interactive compilation @@ -597,8 +597,8 @@ (princ (format "viper-always %S\n" viper-always)) (princ (format "viper-ex-style-motion %S\n" viper-ex-style-motion)) - (princ (format "viper-ex-style-editing-in-insert %S\n" - viper-ex-style-editing-in-insert)) + (princ (format "viper-ex-style-editing %S\n" + viper-ex-style-editing)) (princ (format "viper-want-emacs-keys-in-vi %S\n" viper-want-emacs-keys-in-vi)) (princ (format "viper-want-emacs-keys-in-insert %S\n"
--- a/lisp/viper/viper-mous.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/viper/viper-mous.el Mon Aug 13 09:55:28 2007 +0200 @@ -256,42 +256,47 @@ (interactive "e\nP") (if viper-frame-of-focus ;; to handle clicks in another frame (select-frame viper-frame-of-focus)) - - ;; turn arg into a number - (cond ((integerp arg) nil) - ;; prefix arg is a list when one hits C-u then command - ((and (listp arg) (integerp (car arg))) - (setq arg (car arg))) - (t (setq arg 1))) - - (if (not (eq (key-binding viper-mouse-down-insert-key-parsed) - 'viper-mouse-catch-frame-switch)) - () ; do nothing - (let (click-count interrupting-event) - (if (and - (viper-multiclick-p) - ;; This trick checks if there is a pending mouse event if so, we use - ;; this latter event and discard the current mouse click If the next - ;; pending event is not a mouse event, we execute the current mouse - ;; event - (progn - (setq interrupting-event (viper-read-event)) - (viper-mouse-event-p last-input-event))) - (progn ; interrupted wait - (setq viper-global-prefix-argument arg) - ;; count this click for XEmacs - (viper-event-click-count click)) - ;; uninterrupted wait or the interrupting event wasn't a mouse event - (setq click-count (viper-event-click-count click)) - (if (> click-count 1) - (setq arg viper-global-prefix-argument - viper-global-prefix-argument nil)) - (insert (viper-mouse-click-get-word click arg click-count)) - (if (and interrupting-event - (eventp interrupting-event) - (not (viper-mouse-event-p interrupting-event))) - (viper-set-unread-command-events interrupting-event)) - )))) + (if (or (not (eq (key-binding viper-mouse-down-insert-key-parsed) + 'viper-mouse-catch-frame-switch)) + (not (eq (key-binding viper-mouse-up-insert-key-parsed) + 'viper-mouse-click-insert-word)) + (and viper-xemacs-p (not (event-over-text-area-p click)))) + () ; do nothing, if binding isn't right or not over text + ;; turn arg into a number + (cond ((integerp arg) nil) + ;; prefix arg is a list when one hits C-u then command + ((and (listp arg) (integerp (car arg))) + (setq arg (car arg))) + (t (setq arg 1))) + + (if (not (eq (key-binding viper-mouse-down-insert-key-parsed) + 'viper-mouse-catch-frame-switch)) + () ; do nothing + (let (click-count interrupting-event) + (if (and + (viper-multiclick-p) + ;; This trick checks if there is a pending mouse event if so, we + ;; use this latter event and discard the current mouse click If + ;; the next pending event is not a mouse event, we execute the + ;; current mouse event + (progn + (setq interrupting-event (viper-read-event)) + (viper-mouse-event-p last-input-event))) + (progn ; interrupted wait + (setq viper-global-prefix-argument arg) + ;; count this click for XEmacs + (viper-event-click-count click)) + ;; uninterrupted wait or the interrupting event wasn't a mouse event + (setq click-count (viper-event-click-count click)) + (if (> click-count 1) + (setq arg viper-global-prefix-argument + viper-global-prefix-argument nil)) + (insert (viper-mouse-click-get-word click arg click-count)) + (if (and interrupting-event + (eventp interrupting-event) + (not (viper-mouse-event-p interrupting-event))) + (viper-set-unread-command-events interrupting-event)) + ))))) ;; arg is an event. accepts symbols and numbers, too (defun viper-mouse-event-p (event) @@ -324,9 +329,12 @@ (interactive "e\nP") (if viper-frame-of-focus ;; to handle clicks in another frame (select-frame viper-frame-of-focus)) - (if (not (eq (key-binding viper-mouse-down-search-key-parsed) - 'viper-mouse-catch-frame-switch)) - () ; do nothing + (if (or (not (eq (key-binding viper-mouse-down-search-key-parsed) + 'viper-mouse-catch-frame-switch)) + (not (eq (key-binding viper-mouse-up-search-key-parsed) + 'viper-mouse-click-search-word)) + (and viper-xemacs-p (not (event-over-text-area-p click)))) + () ; do nothing, if binding isn't right or not over text (let ((previous-search-string viper-s-string) click-word click-count)
--- a/lisp/viper/viper-util.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/viper/viper-util.el Mon Aug 13 09:55:28 2007 +0200 @@ -35,6 +35,7 @@ (defvar ex-unix-type-shell) (defvar ex-unix-type-shell-options) (defvar viper-ex-tmp-buf-name) +(defvar viper-syntax-preference) (require 'cl) (require 'ring) @@ -216,6 +217,21 @@ (goto-char cur-pos) result)) +;; Emacs counts each multibyte character as several positions in the buffer, so +;; we use Emacs' chars-in-region. XEmacs is counting each char as just one pos, +;; so we can simply subtract. +(defun viper-chars-in-region (beg end &optional preserve-sign) + (let ((count (abs (if (fboundp 'chars-in-region) + (chars-in-region beg end) + (- end beg))))) + (if (and (< end beg) preserve-sign) + (- count) + count))) + +;; Test if POS is between BEG and END +(defsubst viper-pos-within-region (pos beg end) + (and (>= pos (min beg end)) (>= (max beg end) pos))) + ;; Like move-marker but creates a virgin marker if arg isn't already a marker. ;; The first argument must eval to a variable name. @@ -1058,45 +1074,104 @@ ;;; Movement utilities -(defcustom viper-syntax-preference 'strict-vi - "*Syntax type characterizing Viper's alphanumeric symbols. -`emacs' means only word constituents are considered to be alphanumeric. -Word constituents are symbols specified as word constituents by the current -syntax table. -`extended' means word and symbol constituents. -`reformed-vi' means Vi-ish behavior: word constituents and the symbol `_'. -However, word constituents are determined according to Emacs syntax tables, -which may be different from Vi in some major modes. -`strict-vi' means Viper words are exactly as in Vi." - :type '(radio (const strict-vi) (const reformed-vi) - (const extended) (const emacs)) - :group 'viper) +;; Characters that should not be considered as part of the word, in reformed-vi +;; syntax mode. +(defconst viper-non-word-characters-reformed-vi + "!@#$%^&*()-+=|\\~`{}[];:'\",<.>/?") +;; These are characters that are not to be considered as parts of a word in +;; Viper. +;; Set each time state changes and at loading time +(viper-deflocalvar viper-non-word-characters nil) +;; must be buffer-local (viper-deflocalvar viper-ALPHA-char-class "w" "String of syntax classes characterizing Viper's alphanumeric symbols. In addition, the symbol `_' may be considered alphanumeric if -`viper-syntax-preference'is `reformed-vi'.") +`viper-syntax-preference' is `strict-vi' or `reformed-vi'.") -(viper-deflocalvar viper-strict-ALPHA-chars "a-zA-Z0-9_" +(defconst viper-strict-ALPHA-chars "a-zA-Z0-9_" "Regexp matching the set of alphanumeric characters acceptable to strict Vi.") -(viper-deflocalvar viper-strict-SEP-chars " \t\n" +(defconst viper-strict-SEP-chars " \t\n" + "Regexp matching the set of alphanumeric characters acceptable to strict +Vi.") +(defconst viper-strict-SEP-chars-sans-newline " \t" "Regexp matching the set of alphanumeric characters acceptable to strict Vi.") -(viper-deflocalvar viper-SEP-char-class " -" +(defconst viper-SEP-char-class " -" "String of syntax classes for Vi separators. Usually contains ` ', linefeed, TAB or formfeed.") -(defun viper-update-alphanumeric-class () - "Set the syntax class of Viper alphanumerals according to `viper-syntax-preference'. -Must be called in order for changes to `viper-syntax-preference' to take effect." + +;; Set Viper syntax classes and related variables according to +;; `viper-syntax-preference'. +(defun viper-update-syntax-classes (&optional set-default) + (let ((preference (cond ((eq viper-syntax-preference 'emacs) + "w") ; Viper words have only Emacs word chars + ((eq viper-syntax-preference 'extended) + "w_") ; Viper words have Emacs word & symbol chars + (t "w"))) ; Viper words are Emacs words plus `_' + (non-word-chars (cond ((eq viper-syntax-preference 'reformed-vi) + (viper-string-to-list + viper-non-word-characters-reformed-vi)) + (t nil)))) + (if set-default + (setq-default viper-ALPHA-char-class preference + viper-non-word-characters non-word-chars) + (setq viper-ALPHA-char-class preference + viper-non-word-characters non-word-chars)) + )) + +;; SYMBOL is used because customize requires it, but it is ignored, unless it +;; is `nil'. If nil, use setq. +(defun viper-set-syntax-preference (&optional symbol value) + "Set Viper syntax preference. +If called interactively or if SYMBOL is nil, sets syntax preference in current +buffer. If called non-interactively, preferably via the customization widget, +sets the default value." (interactive) - (setq-default - viper-ALPHA-char-class - (cond ((eq viper-syntax-preference 'emacs) "w") ; only word constituents - ((eq viper-syntax-preference 'extended) "w_") ; word & symbol chars - (t "w")))) ; vi syntax: word constituents and the symbol `_' + (or value + (setq value + (completing-read + "Viper syntax preference: " + '(("strict-vi") ("reformed-vi") ("extended") ("emacs")) + nil 'require-match))) + (if (stringp value) (setq value (intern value))) + (or (memq value '(strict-vi reformed-vi extended emacs)) + (error "Invalid Viper syntax preference, %S" value)) + (if symbol + (setq-default viper-syntax-preference value) + (setq viper-syntax-preference value)) + (viper-update-syntax-classes)) + +(defcustom viper-syntax-preference 'reformed-vi + "*Syntax type characterizing Viper's alphanumeric symbols. +Affects movement and change commands that deal with Vi-style words. +Works best when set in the hooks to various major modes. + +`strict-vi' means Viper words are (hopefully) exactly as in Vi. + +`reformed-vi' means Viper words are like Emacs words \(as determined using +Emacs syntax tables, which are different for different major modes\) with two +exceptions: the symbol `_' is always part of a word and typical Vi non-word +symbols, such as `,',:,\",),{, etc., are excluded. +This behaves very close to `strict-vi', but also works well with non-ASCII +characters from various alphabets. + +`extended' means Viper word constituents are symbols that are marked as being +parts of words OR symbols in Emacs syntax tables. +This is most appropriate for major modes intended for editing programs. + +`emacs' means Viper words are the same as Emacs words as specified by Emacs +syntax tables. +This option is appropriate if you like Emacs-style words." + :type '(radio (const strict-vi) (const reformed-vi) + (const extended) (const emacs)) + :set 'viper-set-syntax-preference + :group 'viper) +(make-variable-buffer-local 'viper-syntax-preference) + ;; addl-chars are characters to be temporarily considered as alphanumerical (defun viper-looking-at-alpha (&optional addl-chars) @@ -1107,19 +1182,26 @@ (if char (if (eq viper-syntax-preference 'strict-vi) (looking-at (concat "[" viper-strict-ALPHA-chars addl-chars "]")) - (or (memq char - ;; convert string to list - (append (vconcat addl-chars) nil)) - (memq (char-syntax char) - (append (vconcat viper-ALPHA-char-class) nil))))) + (or + ;; or one of the additional chars being asked to include + (memq char (viper-string-to-list addl-chars)) + (and + ;; not one of the excluded word chars + (not (memq char viper-non-word-characters)) + ;; char of the Viper-word syntax class + (memq (char-syntax char) + (viper-string-to-list viper-ALPHA-char-class)))))) )) (defun viper-looking-at-separator () (let ((char (char-after (point)))) (if char - (or (eq char ?\n) ; RET is always a separator in Vi - (memq (char-syntax char) - (append (vconcat viper-SEP-char-class) nil)))))) + (if (eq viper-syntax-preference 'strict-vi) + (memq char (viper-string-to-list viper-strict-SEP-chars)) + (or (eq char ?\n) ; RET is always a separator in Vi + (memq (char-syntax char) + (viper-string-to-list viper-SEP-char-class))))) + )) (defsubst viper-looking-at-alphasep (&optional addl-chars) (or (viper-looking-at-separator) (viper-looking-at-alpha addl-chars))) @@ -1148,51 +1230,102 @@ ;; weird syntax tables may confuse strict-vi style (defsubst viper-skip-all-separators-forward (&optional within-line) - (viper-skip-syntax 'forward - viper-SEP-char-class - (or within-line "\n") - (if within-line (viper-line-pos 'end)))) + (if (eq viper-syntax-preference 'strict-vi) + (if within-line + (skip-chars-forward viper-strict-SEP-chars-sans-newline) + (skip-chars-forward viper-strict-SEP-chars)) + (viper-skip-syntax 'forward + viper-SEP-char-class + (or within-line "\n") + (if within-line (viper-line-pos 'end))))) (defsubst viper-skip-all-separators-backward (&optional within-line) - (viper-skip-syntax 'backward - viper-SEP-char-class - (or within-line "\n") - (if within-line (viper-line-pos 'start)))) + (if (eq viper-syntax-preference 'strict-vi) + (if within-line + (skip-chars-backward viper-strict-SEP-chars-sans-newline) + (skip-chars-backward viper-strict-SEP-chars)) + (viper-skip-syntax 'backward + viper-SEP-char-class + (or within-line "\n") + (if within-line (viper-line-pos 'start))))) (defun viper-skip-nonseparators (direction) - (let ((func (intern (format "skip-syntax-%S" direction)))) - (funcall func (concat "^" viper-SEP-char-class) - (viper-line-pos (if (eq direction 'forward) 'end 'start))))) + (viper-skip-syntax + direction + (concat "^" viper-SEP-char-class) + nil + (viper-line-pos (if (eq direction 'forward) 'end 'start)))) + +;; skip over non-word constituents and non-separators (defun viper-skip-nonalphasep-forward () (if (eq viper-syntax-preference 'strict-vi) (skip-chars-forward (concat "^" viper-strict-SEP-chars viper-strict-ALPHA-chars)) - (skip-syntax-forward - (concat - "^" viper-ALPHA-char-class viper-SEP-char-class) (viper-line-pos 'end)))) + (viper-skip-syntax + 'forward + (concat "^" viper-ALPHA-char-class viper-SEP-char-class) + ;; Emacs may consider some of these as words, but we don't want them + viper-non-word-characters + (viper-line-pos 'end)))) (defun viper-skip-nonalphasep-backward () (if (eq viper-syntax-preference 'strict-vi) (skip-chars-backward (concat "^" viper-strict-SEP-chars viper-strict-ALPHA-chars)) - (skip-syntax-backward - (concat - "^" - viper-ALPHA-char-class viper-SEP-char-class) + (viper-skip-syntax + 'backward + (concat "^" viper-ALPHA-char-class viper-SEP-char-class) + ;; Emacs may consider some of these as words, but we don't want them + viper-non-word-characters (viper-line-pos 'start)))) ;; Skip SYNTAX like skip-syntax-* and ADDL-CHARS like skip-chars-* ;; Return the number of chars traveled. -;; Either SYNTAX or ADDL-CHARS can be nil, in which case they are interpreted -;; as an empty string. +;; Both SYNTAX or ADDL-CHARS can be strings or lists of characters. +;; When SYNTAX is "w", then viper-non-word-characters are not considered to be +;; words, even if Emacs syntax table says they are. (defun viper-skip-syntax (direction syntax addl-chars &optional limit) (let ((total 0) (local 1) - (skip-chars-func (intern (format "skip-chars-%S" direction))) - (skip-syntax-func (intern (format "skip-syntax-%S" direction)))) - (or (stringp addl-chars) (setq addl-chars "")) - (or (stringp syntax) (setq syntax "")) + (skip-chars-func + (if (eq direction 'forward) + 'skip-chars-forward 'skip-chars-backward)) + (skip-syntax-func + (if (eq direction 'forward) + 'viper-forward-char-carefully 'viper-backward-char-carefully)) + char-looked-at syntax-of-char-looked-at negated-syntax) + (setq addl-chars + (cond ((listp addl-chars) (viper-charlist-to-string addl-chars)) + ((stringp addl-chars) addl-chars) + (t ""))) + (setq syntax + (cond ((listp syntax) syntax) + ((stringp syntax) (viper-string-to-list syntax)) + (t nil))) + (if (memq ?^ syntax) (setq negated-syntax t)) + (while (and (not (= local 0)) (not (eobp))) + (setq char-looked-at (viper-char-at-pos direction) + ;; if outside the range, set to nil + syntax-of-char-looked-at (if char-looked-at + (char-syntax char-looked-at))) (setq local - (+ (funcall skip-syntax-func syntax limit) + (+ (if (and + (cond ((and limit (eq direction 'forward)) + (< (point) limit)) + (limit ; backward & limit + (> (point) limit)) + (t t)) ; no limit + ;; char under/before cursor has appropriate syntax + (if negated-syntax + (not (memq syntax-of-char-looked-at syntax)) + (memq syntax-of-char-looked-at syntax)) + ;; if char-syntax class is "word", make sure it is not one + ;; of the excluded characters + (if (and (eq syntax-of-char-looked-at ?w) + (not negated-syntax)) + (not (memq char-looked-at viper-non-word-characters)) + t)) + (funcall skip-syntax-func 1) + 0) (funcall skip-chars-func addl-chars limit))) (setq total (+ total local))) total
--- a/lisp/viper/viper.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/viper/viper.el Mon Aug 13 09:55:28 2007 +0200 @@ -8,7 +8,7 @@ ;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. -(defconst viper-version "2.96 of August 7, 1997" +(defconst viper-version "3.00 (Polyglot) of August 18, 1997" "The current version of Viper") ;; This file is part of GNU Emacs. @@ -302,6 +302,7 @@ ;; compiler pacifier (defvar mark-even-if-inactive) +(defvar quail-mode) (defvar viper-expert-level) (defvar viper-expert-level) @@ -469,7 +470,7 @@ ;; This hook designed to enable Vi-style editing in comint-based modes." (defun viper-comint-mode-hook () (setq require-final-newline nil - viper-ex-style-editing-in-insert nil + viper-ex-style-editing nil viper-ex-style-motion nil) (viper-change-state-to-insert)) @@ -828,6 +829,62 @@ (defadvice rmail-cease-edit (after viper-rmail-advice activate) "Switch to emacs state when done editing message." (viper-change-state-to-emacs)) + + ;; ISO accents + ;; Need to do it after loading iso-acc, or else this loading will wipe out + ;; the advice. + (eval-after-load + "iso-acc" + (defadvice iso-accents-mode (around viper-iso-accents-advice activate) + "Set viper-automatic-iso-accents to iso-accents-mode." + (let ((arg (ad-get-arg 0))) + ad-do-it + (setq viper-automatic-iso-accents + (if (eq viper-current-state 'vi-state) + (if arg + ;; if iso-accents-mode was called with positive arg, turn + ;; accents on + (> (prefix-numeric-value arg) 0) + ;; else: toggle viper-automatic-iso-accents + (not viper-automatic-iso-accents)) + ;; other states: accept what iso-accents-mode has done + iso-accents-mode)) + ;; turn off ISO accents in vi-state + (if (eq viper-current-state 'vi-state) + (viper-set-iso-accents-mode nil)) + (if (memq viper-current-state '(vi-state insert-state replace-state)) + (message "Viper ISO accents mode: %s" + (if viper-automatic-iso-accents "on" "off"))) + ))) + + ;; International input methods + (if viper-emacs-p + (eval-after-load "mule-cmds" + (progn + (defadvice inactivate-input-method (after viper-mule-advice activate) + "Set viper-special-input-method to disable intl. input methods." + (viper-inactivate-input-method-action)) + (defadvice activate-input-method (after viper-mule-advice activate) + "Set viper-special-input-method to enable intl. input methods." + (viper-activate-input-method-action)) + )) + ;; XEmacs Although these hooks exist in Emacs, they don't seem to be always + ;; called on input-method activation/deactivation, so we the above advise + ;; functions instead. + (eval-after-load "mule-cmds" + (progn + (add-hook 'input-method-activate-hook + 'viper-activate-input-method-action t) + (add-hook 'input-method-inactivate-hook + 'viper-inactivate-input-method-action t))) + ) + (eval-after-load "mule-cmds" + (defadvice toggle-input-method (around viper-mule-advice activate) + "Adjust input-method toggling in vi-state." + (if (and viper-special-input-method (eq viper-current-state 'vi-state)) + (viper-inactivate-input-method) + ad-do-it))) + ) ; viper-set-hooks @@ -895,10 +952,11 @@ (read-key-sequence "Describe key briefly: "))))) - ;; Advice for use in find-file and read-file-name commands. - (defadvice exit-minibuffer (before viper-exit-minibuffer-advice activate) - "Run `viper-minibuffer-exit-hook' just before exiting the minibuffer." - (run-hooks 'viper-minibuffer-exit-hook)) + ;; This is now done in viper-minibuffer-exit-hook + ;;;; Advice for use in find-file and read-file-name commands. + ;;(defadvice exit-minibuffer (before viper-exit-minibuffer-advice activate) + ;; "Run `viper-minibuffer-exit-hook' just before exiting the minibuffer." + ;; (run-hooks 'viper-minibuffer-exit-hook)) (defadvice find-file (before viper-add-suffix-advice activate) "Use `read-file-name' for reading arguments." @@ -954,7 +1012,8 @@ (defadvice read-file-name (around viper-suffix-advice activate) "Tell `exit-minibuffer' to run `viper-file-add-suffix' as a hook." - (let ((viper-minibuffer-exit-hook 'viper-file-add-suffix)) + (let ((viper-minibuffer-exit-hook + (append viper-minibuffer-exit-hook '(viper-file-add-suffix)))) ad-do-it)) (defadvice start-kbd-macro (after viper-kbd-advice activate) @@ -1089,8 +1148,8 @@ (cons 'viper-always (list viper-always)) (cons 'viper-no-multiple-ESC (list viper-no-multiple-ESC)) (cons 'viper-ex-style-motion (list viper-ex-style-motion)) - (cons 'viper-ex-style-editing-in-insert - (list viper-ex-style-editing-in-insert)) + (cons 'viper-ex-style-editing + (list viper-ex-style-editing)) (cons 'viper-want-emacs-keys-in-vi (list viper-want-emacs-keys-in-vi)) (cons 'viper-electric-mode (list viper-electric-mode)) @@ -1104,7 +1163,7 @@ (viper-set-minibuffer-style) (if viper-buffer-search-char (viper-buffer-search-enable)) - (viper-update-alphanumeric-class) + (viper-update-syntax-classes 'set-default) ))
--- a/lisp/w3/custom-load.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/w3/custom-load.el Mon Aug 13 09:55:28 2007 +0200 @@ -1,19 +1,19 @@ -(custom-put 'url-news 'custom-loads '("url-news")) -(custom-put 'w3-scripting 'custom-loads '("w3-script")) -(custom-put 'w3-hooks 'custom-loads '("w3-cus")) -(custom-put 'w3-display 'custom-loads '("w3-cus")) -(custom-put 'w3-parsing 'custom-loads '("w3-cus")) -(custom-put 'w3-menus 'custom-loads '("w3-cus" "w3-menu")) -(custom-put 'w3-printing 'custom-loads '("w3-cus")) -(custom-put 'w3-images 'custom-loads '("w3-cus")) -(custom-put 'w3-files 'custom-loads '("w3-cus")) +(custom-put 'ssl 'custom-loads '("ssl")) +(custom-put 'url-gateway 'custom-loads '("url-gw")) +(custom-put 'url 'custom-loads '("url-gw" "url-irc" "url-vars" "url" "url-news")) +(custom-put 'url-file 'custom-loads '("url-cache" "url-vars")) +(custom-put 'url-cache 'custom-loads '("url-cache" "url-vars")) +(custom-put 'url-history 'custom-loads '("url-vars")) +(custom-put 'url-cookie 'custom-loads '("url-cookie" "url-vars")) +(custom-put 'url-mime 'custom-loads '("url-vars")) +(custom-put 'url-hairy 'custom-loads '("url-vars")) (custom-put 'w3 'custom-loads '("w3-cus" "w3-script")) -(custom-put 'url-hairy 'custom-loads '("url-vars")) -(custom-put 'url-mime 'custom-loads '("url-vars")) -(custom-put 'url-cookie 'custom-loads '("url-cookie" "url-vars")) -(custom-put 'url-history 'custom-loads '("url-vars")) -(custom-put 'url-cache 'custom-loads '("url-cache" "url-vars")) -(custom-put 'url-file 'custom-loads '("url-cache" "url-vars")) -(custom-put 'url 'custom-loads '("url-gw" "url-irc" "url-vars" "url" "url-news")) -(custom-put 'url-gateway 'custom-loads '("url-gw")) -(custom-put 'ssl 'custom-loads '("ssl")) +(custom-put 'w3-files 'custom-loads '("w3-cus")) +(custom-put 'w3-images 'custom-loads '("w3-cus")) +(custom-put 'w3-printing 'custom-loads '("w3-cus")) +(custom-put 'w3-menus 'custom-loads '("w3-cus" "w3-menu")) +(custom-put 'w3-parsing 'custom-loads '("w3-cus")) +(custom-put 'w3-display 'custom-loads '("w3-cus")) +(custom-put 'w3-hooks 'custom-loads '("w3-cus")) +(custom-put 'w3-scripting 'custom-loads '("w3-script")) +(custom-put 'url-news 'custom-loads '("url-news"))
--- a/lisp/w3/md5.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/w3/md5.el Mon Aug 13 09:55:28 2007 +0200 @@ -401,6 +401,6 @@ ;; viewing, make sure we leave it behind. (buffer-substring (point-min) (+ (point-min) 32))) (kill-buffer buffer))) - (and buffer (kill-buffer buffer) nil)))) + (and buffer (buffer-name buffer) (kill-buffer buffer) nil)))) (provide 'md5)
--- a/lisp/w3/socks.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/w3/socks.el Mon Aug 13 09:55:28 2007 +0200 @@ -1,7 +1,7 @@ ;;; socks.el --- A Socks v5 Client for Emacs ;; Author: wmperry -;; Created: 1997/06/25 16:25:12 -;; Version: 1.4 +;; Created: 1997/08/08 21:08:34 +;; Version: 1.5 ;; Keywords: comm, firewalls ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -249,9 +249,13 @@ (let ((route (cons socks-host socks-port)) (noproxy socks-noproxy)) (while noproxy - (if (string-match (car noproxy) host) - (setq route nil - noproxy nil)) + (if (eq ?! (aref (car noproxy) 0)) + (if (string-match (substring (car noproxy) 1) host) + (setq route nil + noproxy nil)) + (if (string-match (car noproxy) host) + (setq route nil + noproxy nil))) (setq noproxy (cdr noproxy))) route))
--- a/lisp/w3/url-misc.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/w3/url-misc.el Mon Aug 13 09:55:28 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-misc.el --- Misc Uniform Resource Locator retrieval code ;; Author: wmperry -;; Created: 1997/04/21 23:59:58 -;; Version: 1.17 +;; Created: 1997/08/12 22:58:50 +;; Version: 1.20 ;; Keywords: comm, data, processes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -133,10 +133,9 @@ (defun url-proxy (url) ;; Retrieve URL from a proxy. ;; Expects `url-using-proxy' to be bound to the specific proxy to use." - (let ( - (urlobj (url-generic-parse-url url)) - (proxyobj (url-generic-parse-url url-using-proxy))) - (url-http url-using-proxy url))) + (let ((urlobj (url-generic-parse-url url))) + (url-set-target urlobj nil) + (url-http url-using-proxy (url-recreate-url urlobj)))) (defvar url-webmail-gateway "w3mail@gmd.de" "*Where to send webmail requests")
--- a/lisp/w3/url-ns.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/w3/url-ns.el Mon Aug 13 09:55:28 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-ns.el --- Various netscape-ish functions for proxy definitions ;; Author: wmperry -;; Created: 1997/06/29 22:51:33 -;; Version: 1.3 +;; Created: 1997/07/14 05:11:46 +;; Version: 1.4 ;; Keywords: comm, data, processes, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -31,7 +31,6 @@ (not (string-match "\\." host))) (defun dnsDomainIs (host dom) - (setq host (url-gateway-nslookup-host host)) (string-match (concat (regexp-quote dom) "$") host)) (defun dnsResolve (host)
--- a/lisp/w3/url-vars.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/w3/url-vars.el Mon Aug 13 09:55:28 2007 +0200 @@ -38,7 +38,7 @@ (defmacro defcustom (var value doc &rest args) (` (defvar (, var) (, value) (, doc)))))) -(defconst url-version (let ((x "p3.0.94")) +(defconst url-version (let ((x "p3.0.103")) (if (string-match "State: \\([^ \t\n]+\\)" x) (substring x (match-beginning 1) (match-end 1)) x))
--- a/lisp/w3/url.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/w3/url.el Mon Aug 13 09:55:28 2007 +0200 @@ -1,13 +1,13 @@ ;;; url.el --- Uniform Resource Locator retrieval tool ;; Author: wmperry -;; Created: 1997/06/10 05:26:37 -;; Version: 1.79 +;; Created: 1997/07/14 05:15:29 +;; Version: 1.80 ;; Keywords: comm, data, processes, hypermedia ;;; LCD Archive Entry: ;;; url|William M. Perry|wmperry@cs.indiana.edu| ;;; Functions for retrieving/manipulating URLs| -;;; 1997/06/10 05:26:37|1.79|Location Undetermined +;;; 1997/07/14 05:15:29|1.80|Location Undetermined ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1902,7 +1902,9 @@ ;; Not sure how I should handle gracefully degrading from one proxy to ;; another, so for now just deal with the first one ;; (while proxies - (setq proxy (pop proxies)) + (if (listp proxies) + (setq proxy (pop proxies)) + (setq proxy proxies)) (cond ((string-match "^direct" proxy) nil) ((string-match "^proxy +" proxy)
--- a/lisp/w3/w3-cus.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/w3/w3-cus.el Mon Aug 13 09:55:28 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-cus.el --- Customization support for Emacs-W3 ;; Author: wmperry -;; Created: 1997/07/06 22:30:54 -;; Version: 1.10 +;; Created: 1997/07/14 16:56:45 +;; Version: 1.11 ;; Keywords: comm, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -465,4 +465,41 @@ :group 'w3-hooks :type 'hook) +(defcustom w3-display-errors-hook nil + "*Hooks to be run after displaying HTML errors for a page." + :group 'w3-hooks + :type 'hook) + +(defcustom w3-html-errors-font-lock-keywords + '(("\\(HTML errors for\\) \\(.*\\)" + (1 font-lock-function-name-face) (2 font-lock-reference-face)) + ("Empty \\([A-Z0-9]+\\) element." (1 font-lock-type-face)) + ("Bad attribute name syntax: \\(.*\\)" (1 font-lock-type-face)) + ("Bad attribute value syntax: \\(.*\\)" (1 font-lock-type-face)) + ("Evil attribute value syntax: \\(.*\\)" (1 font-lock-type-face)) + ("Attribute value missing end quote: \\(.*\\)" (1 font-lock-type-face)) + ("Bad start-tag \\([A-Z0-9]+\\)" (1 font-lock-type-face)) + ("\\([A-Z0-9]+\\) element has no \\([A-Z0-9]+\\) attribute" + (1 font-lock-type-face) (2 font-lock-type-face)) + (", inferring \\(</?[A-Z0-9]+>\\)" (1 font-lock-type-face)) + ("Bad unclosed \\([A-Z0-9]+\\) tag" (1 font-lock-type-face)) + ("Bad comment (unterminated or unbalanced \"\\(--\\)\" pairs)" (1 font-lock-type-face t)) + ("Obsolete element \\(.*\\)" (1 font-lock-type-face)) + ("Deprecated element \\(.*\\)" (1 font-lock-type-face)) + ("\\[deprecated inside \\([A-Z0-9]+\\)\\]" (1 font-lock-type-face)) + ("\\(</[A-Z0-9]+>\\) end-tag not omissible (required due to \\(</?[A-Z0-9]+>\\) end-tag)" + (1 font-lock-type-face) (2 font-lock-type-face)) + ("Bad data characters [\\([^][]\\)], " (1 font-lock-comment-face)) + ("Bad \\(<!\\) syntax." (1 font-lock-type-face)) + ("Unterminated IGNORE marked section.") + ("Invalid SGML character: \\(.\\)" (1 font-lock-type-face)) + ("Unmatched end-tag \\(</[A-Z0-9]+>\\)" (1 font-lock-type-face)) + ;;("</?[A-Z0-9]+>" . font-lock-type-face) + ("^ [A-Z][a-zA-Z0-9 ]*: .*" . font-lock-comment-face) + ("^ [A-Z][a-zA-Z0-9 ]*: " . font-lock-comment-face) + ("\\*ERROR\\*" 0 font-lock-keyword-face t)) + "*Font locking keywords used for HTML error display" + :group 'w3 + :type 'list) + (provide 'w3-cus)
--- a/lisp/w3/w3-display.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/w3/w3-display.el Mon Aug 13 09:55:28 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-display.el --- display engine v99999 ;; Author: wmperry -;; Created: 1997/07/08 13:58:52 -;; Version: 1.195 +;; Created: 1997/08/12 22:51:19 +;; Version: 1.200 ;; Keywords: faces, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -249,8 +249,7 @@ (defun w3-make-face-emacs19 (name &optional doc-string temporary) "Defines and returns a new FACE described by DOC-STRING. -If the face already exists, it is unmodified. -If TEMPORARY is non-nil, this face will cease to exist if not in use." +If the face already exists, it is unmodified." (make-face name)) (cond @@ -366,7 +365,9 @@ (defsubst w3-munge-line-breaks-p () (eq (car w3-display-whitespace-stack) 'pre)) -(defvar w3-display-nil-face (w3-make-face nil "Stub face... don't ask." t)) +(defvar w3-display-nil-face (if w3-running-xemacs + (w3-make-face nil "Stub face... don't ask." t) + nil)) (defvar w3-scratch-start-point nil) @@ -424,8 +425,8 @@ (defun w3-widget-echo (widget &rest ignore) (let* ((url (widget-get widget :href)) (name (widget-get widget :name)) - (text (buffer-substring (widget-get widget :from) - (widget-get widget :to))) + (text (buffer-substring-no-properties (widget-get widget :from) + (widget-get widget :to))) (title (widget-get widget :title)) (check w3-echo-link) (msg nil)) @@ -856,11 +857,24 @@ (goto-char (point-max)))))) ;; The table handling - -(if (and w3-running-xemacs (featurep 'mule) - (not (find-charset 'w3-dingbats))) +(eval-and-compile + (cond + ((and w3-running-xemacs (featurep 'mule) (not (find-charset 'w3-dingbats))) (make-charset 'w3-dingbats "Dingbats character set for Emacs/W3" '(registry "" dimension 1 chars 96 final ?:))) + ((and (featurep 'mule) (not (charsetp 'w3-dingbats))) + (define-charset nil 'w3-dingbats + (vector + 1 ; dimension + 96 ; chars + 1 ; width + 0 ; direction + ?: ; iso-final-char + 1 ; iso-graphic-plane (whats this?) + "dingbats" "emacs/w3-dingbats" + "Dingbats character set for Emacs/W3"))) + (t + nil))) (defun w3-make-char (oct) (if (and w3-running-xemacs (featurep 'mule)) @@ -868,7 +882,7 @@ oct)) (defvar w3-table-ascii-border-chars - [nil nil nil ?' nil ?- ?` ?- nil ?\\ ?| ?| ?/ ?- ?| ?+] + [nil nil nil ?+ nil ?- ?+ ?- nil ?+ ?| ?| ?+ ?- ?| ?+] "*Vector of ascii characters to use to draw table borders. This vector is used when terminal characters are unavailable") @@ -1905,9 +1919,17 @@ (w3-handle-empty-tag)) (frameset (if w3-display-frames - (progn + (let ((frames (nth 2 node)) + (frameset-cardinal 0) + (cols (cdr-safe (assq 'cols args)))) + (while (and frames (memq (car (car frames)) '(frame frameset))) + (setq frameset-cardinal (1+ frameset-cardinal) + frames (cdr frames))) (push (list 'frameset - (or (assq 'cols args) (assq 'rows args))) + frameset-cardinal + (if (and cols (not (string-equal cols "*"))) + (assq 'cols args) + (assq 'rows args))) w3-frameset-structure) (w3-handle-content node)) (w3-handle-content node))) @@ -2421,41 +2443,7 @@ ;; set up frames (while structure (if (eq (car (car structure)) 'frameset) - (let* ((current-dims (cdr (car structure))) - (cols (cdr-safe (assq 'cols current-dims))) - (rows (cdr-safe (assq 'rows current-dims)))) - (pop structure) - ;; columns ? - (if cols - (setq cols (w3-decode-frameset-dimensions cols (window-width) window-min-width)) - ;; rows ? - (if rows - (setq rows (w3-decode-frameset-dimensions rows (window-height) window-min-height)) - ;; default: columns of equal width - (let ((nb-windows 0) - (frames structure)) - (while (and frames (eq (car (car frames)) 'frame)) - (setq nb-windows (1+ nb-windows))) - (let ((fwidth (/ (window-width) nb-windows))) - (while (> nb-windows 0) - (push fwidth cols) - (setq nb-windows (1- nb-windows))))))) - (while (eq (car (car structure)) 'frame) - (cond ((cdr cols) - (split-window-horizontally (car cols)) - (pop cols)) - ((cdr rows) - (split-window-vertically (car rows)) - (pop rows))) - (let ((href (nth 2 (car structure))) - (name (nth 1 (car structure))) - (url-working-buffer url-default-working-buffer) ; in case url-multiple-p is t - (w3-notify 'semibully)) - (w3-fetch href) - (setq w3-frame-name name - w3-target-window-distances nil)) - (other-window 1) - (pop structure))) + (setq structure (w3-display-frameset structure)) (pop structure))) ;; compute target window distances (let ((origin-buffer (current-buffer)) @@ -2469,6 +2457,54 @@ (setq stop t)))) (setq-default url-be-asynchronous old-asynch))) +(defun w3-display-frameset (frameset-structure) + (let* ((structure frameset-structure) + (frameset-cardinal (nth 1 (car structure))) + (current-dims (cdr (cdr (car structure)))) + (cols (cdr-safe (assq 'cols current-dims))) + (rows (cdr-safe (assq 'rows current-dims))) + (char-width (if (> (frame-char-width) 1) + (frame-char-width) + w3-tty-char-width)) + (char-height (if (> (frame-char-height) 1) + (frame-char-height) + w3-tty-char-height))) + (pop structure) + ;; columns ? + (if (and cols (not (string-equal cols "*"))) + (setq cols (w3-decode-frameset-dimensions + cols (window-width) window-min-width char-width)) + ;; rows ? + (if (and rows (not (string-equal rows "*"))) + (setq rows (w3-decode-frameset-dimensions + rows (window-height) window-min-height char-height)) + ;; default: columns of equal width + (let ((fwidth (/ (window-width) frameset-cardinal))) + (while (> frameset-cardinal 0) + (push fwidth cols) + (setq frameset-cardinal (1- frameset-cardinal)))))) + (while (> frameset-cardinal 0) + (cond ((cdr cols) + (split-window-horizontally (car cols)) + (pop cols)) + ((cdr rows) + (split-window-vertically (car rows)) + (pop rows))) + (cond ((eq (car (car structure)) 'frame) + (let ((href (nth 2 (car structure))) + (name (nth 1 (car structure))) + (url-working-buffer url-default-working-buffer) ; in case url-multiple-p is t + (w3-notify 'semibully)) + (pop structure) + (w3-fetch href) + (setq w3-frame-name name + w3-target-window-distances nil) + (other-window 1))) + ((eq (car (car structure)) 'frameset) + (setq structure (w3-display-frameset structure)))) + (setq frameset-cardinal (1- frameset-cardinal))) + structure)) + (defun w3-compute-target-window-distances () "Compute an alist of target names and window distances" (let ((origin-buffer (current-buffer)) @@ -2499,7 +2535,7 @@ For a terminal screen, the value is always 1." (font-width (face-font 'default frame)))) -(defun w3-decode-frameset-dimensions (dims available-dimension min-dim) +(defun w3-decode-frameset-dimensions (dims available-dimension min-dim pixel-dim) "Returns numbers of lines or columns in Emacs, computed from specified frameset dimensions" (let ((dimensions nil)) (if dims @@ -2522,7 +2558,7 @@ (t ;; absolute number: pixel height (push (max (1+ (/ (car (read-from-string match)) - (frame-char-height))) + pixel-dim)) min-dim) dimensions))) (setq remaining-available-dimension
--- a/lisp/w3/w3-e19.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/w3/w3-e19.el Mon Aug 13 09:55:28 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-e19.el --- Emacs 19.xx specific functions for emacs-w3 ;; Author: wmperry -;; Created: 1997/07/08 14:00:33 -;; Version: 1.28 +;; Created: 1997/08/12 18:18:03 +;; Version: 1.29 ;; Keywords: faces, help, mouse, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -108,20 +108,10 @@ (ns (ns-store-pasteboard-internal str)) (otherwise nil))))) -(defun w3-e19-no-read-only (st nd) - ;; Make sure we don't yank any read-only data out of this buffer - (let ((inhibit-read-only t) - (after-change-functions nil) - (after-change-function nil)) - (put-text-property st nd 'w3-munged-ro t) - (put-text-property st nd 'read-only nil))) - (defun w3-mode-version-specifics () ;; Emacs 19 specific stuff for w3-mode (declare (special w3-face-index w3-display-background-properties)) (make-local-variable 'track-mouse) - (set (make-local-variable 'buffer-access-fontify-functions) 'w3-e19-no-read-only) - (set (make-local-variable 'buffer-access-fontified-property) 'w3-munged-ro) (setq w3-e19-window-width (window-width)) (if w3-track-mouse (setq track-mouse t)) (if w3-display-background-properties @@ -149,7 +139,7 @@ (if (not (and good pt (number-or-marker-p pt))) nil (widget-echo-help pt) - ;; Need to handle onmouseover, on mouseout + ;; FIXME!!! Need to handle onmouseover, on mouseout (setq mouse-events (w3-script-find-event-handlers pt 'mouse)) (if (assq 'onmouseover mouse-events) (w3-script-evaluate-form (cdr (assq 'onmouseover mouse-events)))))))
--- a/lisp/w3/w3-e20.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/w3/w3-e20.el Mon Aug 13 09:55:28 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-e19.el --- Emacs 20.xx specific functions for emacs-w3 ;; Author: wmperry -;; Created: 1997/06/27 15:28:39 -;; Version: 1.1 +;; Created: 1997/08/08 14:44:42 +;; Version: 1.2 ;; Keywords: faces, help, mouse, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -26,3 +26,4 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (require 'w3-e19) +(provide 'w3-e20)
--- a/lisp/w3/w3-vars.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/w3/w3-vars.el Mon Aug 13 09:55:28 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-vars.el,v --- All variable definitions for emacs-w3 ;; Author: wmperry -;; Created: 1997/07/12 04:58:34 -;; Version: 1.149 +;; Created: 1997/08/12 14:44:46 +;; Version: 1.150 ;; Keywords: comm, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -34,7 +34,7 @@ (require 'wid-edit) ; For `widget-keymap' (defconst w3-version-number - (let ((x "p3.0.94")) + (let ((x "p3.0.103")) (if (string-match "State:[ \t\n]+.\\([^ \t\n]+\\)" x) (setq x (substring x (match-beginning 1) (match-end 1))) (setq x (substring x 1))) @@ -42,7 +42,7 @@ (function (lambda (x) (if (= x ?-) "." (char-to-string x)))) x "")) "Version # of w3-mode.") -(defconst w3-version-date (let ((x "1997/07/12 04:58:34")) +(defconst w3-version-date (let ((x "1997/08/12 14:44:46")) (if (string-match "Date: \\([^ \t\n]+\\)" x) (substring x (match-beginning 1) (match-end 1)) x)) @@ -373,6 +373,12 @@ (defvar w3-target-window-distances nil "Target window distances") +(defvar w3-tty-char-width 8 + "*Char width to use when in a tty") + +(defvar w3-tty-char-height 15 + "*Char height to use when in a tty") + (defvar w3-form-radio-elements nil "Internal variable - do not touch!") (defvar w3-form-elements nil "Internal variable - do not touch!")
--- a/lisp/w3/w3.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/w3/w3.el Mon Aug 13 09:55:28 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3.el --- Main functions for emacs-w3 on all platforms/versions ;; Author: wmperry -;; Created: 1997/07/10 23:41:29 -;; Version: 1.139 +;; Created: 1997/07/14 16:57:04 +;; Version: 1.140 ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -2279,7 +2279,17 @@ (while todo (goto-char (point-min)) (insert "\n" (car todo)) - (setq todo (cdr todo)))) + (setq todo (cdr todo))) + (if url + (progn + (goto-char (point-min)) + (insert (format "HTML Errors for: <URL:%s>\n" url)))) + (set (make-local-variable 'font-lock-keywords) w3-html-errors-font-lock-keywords) + (set (make-local-variable 'font-lock-keywords-only) nil) + (set (make-local-variable 'font-lock-keywords-case-fold-search) nil) + (set (make-local-variable 'font-lock-syntax-table) nil) + (set (make-local-variable 'font-lock-beginning-of-syntax-function) 'beginning-of-line) + (run-hooks 'w3-display-errors-hook)) (w3-notify-when-ready buffer))) (defun w3-mode ()
--- a/lisp/x11/x-compose.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/x11/x-compose.el Mon Aug 13 09:55:28 2007 +0200 @@ -21,7 +21,7 @@ ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the +;; along with XEmacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. @@ -36,7 +36,7 @@ ;;; XFree86 deadkeys ;; This file implements DEC-, OpenWindows-, and HP-compatible "Compose" -;; processing for XEmacs. +;; processing for XEmacs. ;; If you are running a version of X which already does compose processing, ;; then you don't need this file. But the MIT R4 and R5 distributions don't @@ -110,45 +110,69 @@ (defvar compose-tilde-map (make-sparse-keymap)) (defvar compose-ring-map (make-sparse-keymap)) -;;; The command `compose-key' exists so that this file may be autoloaded. -;;;this doesn't work yet###autoload -;; (define-function 'compose-key compose-map) +;; Required to tell XEmacs the keymaps were actually autoloaded. +;; #### Make this unnecessary! +(fset 'compose-map compose-map) +(fset 'compose-acute-map compose-acute-map) +(fset 'compose-grave-map compose-grave-map) +(fset 'compose-cedilla-map compose-cedilla-map) +(fset 'compose-diaeresis-map compose-diaeresis-map) +(fset 'compose-circumflex-map compose-circumflex-map) +(fset 'compose-tilde-map compose-tilde-map) +(fset 'compose-ring-map compose-ring-map) + +(define-key compose-map 'acute compose-acute-map) +(define-key compose-map 'grave compose-grave-map) +(define-key compose-map 'cedilla compose-cedilla-map) +(define-key compose-map 'diaeresis compose-diaeresis-map) +(define-key compose-map 'circumflex compose-circumflex-map) +(define-key compose-map 'tilde compose-tilde-map) +(define-key compose-map 'degree compose-ring-map) -;; The "Compose" key: -;; (keysym is lower case because we downcase everything in the Symbol font...) -;; -;;;this doesn't work yet###autoload -;; Ditched JV, (define-key function-key-map [multi-key] 'compose-key) -(define-key function-key-map [multi-key] compose-map) +;;(eval-when-compile +;; (defsubst define-dead-key-map (key map) +;; (define-key function-key-map key map) +;; (define-key compose-map key map))) + +;;;###utoload (autoload 'compose-map "x-compose" nil t 'keymap) +;;;###utoload (autoload 'compose-acute-map "x-compose" nil t 'keymap) +;;;###utoload (autoload 'compose-grave-map "x-compose" nil t 'keymap) +;;;###utoload (autoload 'compose-cedilla-map "x-compose" nil t 'keymap) +;;;###utoload (autoload 'compose-diaeresis-map "x-compose" nil t 'keymap) +;;;###utoload (autoload 'compose-degree-map "x-compose" nil t 'keymap) +;;;###utoload (define-key function-key-map [acute] 'compose-acute-map) +;;;###utoload (define-key function-key-map [grave] 'compose-grave-map) +;;;###utoload (define-key function-key-map [cedilla] 'compose-cedilla-map) +;;;###utoload (define-key function-key-map [diaeresis] 'compose-diaeresis-map) +;;;###utoload (define-key function-key-map [degree] 'compose-degree-map) +;;;###utoload (define-key function-key-map [multi-key] 'compose-map) +;;;###utoload (define-key global-map [multi-key] 'compose-map) + +;;(define-key function-key-map [multi-key] compose-map) + ;; The following is necessary, because one can't rebind [degree] ;; and use it to insert the degree sign! -(defun compose-insert-degree () - "Inserts a degree sign." - (interactive) - (insert ?\260)) +;;(defun compose-insert-degree () +;; "Inserts a degree sign." +;; (interactive) +;; (insert ?\260)) ;; The "Dead" keys: ;; -(define-key function-key-map [acute] compose-acute-map) -(define-key function-key-map [cedilla] compose-cedilla-map) -(define-key function-key-map [diaeresis] compose-diaeresis-map) -(define-key function-key-map [degree] compose-ring-map) +;;(define-dead-key-map [acute] compose-acute-map) +;;(define-dead-key-map [cedilla] compose-cedilla-map) +;;(define-dead-key-map [diaeresis] compose-diaeresis-map) +;;(define-dead-key-map [degree] compose-ring-map) -;; The dead keys as seen by the "Compose" map: -;; -(define-key compose-map [acute] compose-acute-map) -(define-key compose-map [cedilla] compose-cedilla-map) -(define-key compose-map [diaeresis] compose-diaeresis-map) -(define-key compose-map [degree] compose-ring-map) - -(define-key compose-map "'" compose-acute-map) -(define-key compose-map "`" compose-grave-map) -(define-key compose-map "," compose-cedilla-map) -(define-key compose-map "\"" compose-diaeresis-map) -(define-key compose-map "^" compose-circumflex-map) -(define-key compose-map "~" compose-tilde-map) -(define-key compose-map "*" compose-ring-map) +(define-key compose-map [?'] compose-acute-map) +(define-key compose-map [?`] compose-grave-map) +(define-key compose-map [?,] compose-cedilla-map) +(define-key compose-map [?\"] compose-diaeresis-map) +(define-key compose-map [?:] compose-diaeresis-map) +(define-key compose-map [?^] compose-circumflex-map) +(define-key compose-map [~] compose-tilde-map) +(define-key compose-map [?*] compose-ring-map) ;;; The dead keys might really be called just about anything, depending @@ -168,177 +192,96 @@ ;; Sun according to MIT: ;; -(cond ((x-valid-keysym-name-p "SunFA_Acute") - (define-key function-key-map [SunFA_Acute] - compose-acute-map) - (define-key compose-map [SunFA_Acute] compose-acute-map) - (define-key function-key-map [SunFA_Grave] - compose-grave-map) - (define-key compose-map [SunFA_Grave] compose-grave-map) - (define-key function-key-map [SunFA_Cedilla] - compose-cedilla-map) - (define-key compose-map [SunFA_Cedilla] compose-cedilla-map) - (define-key function-key-map [SunFA_Diaeresis] compose-diaeresis-map) - (define-key compose-map [SunFA_Diaeresis] compose-diaeresis-map) - (define-key function-key-map [SunFA_Circum] - compose-circumflex-map) - (define-key compose-map [SunFA_Circum] compose-circumflex-map) - (define-key function-key-map [SunFA_Tilde] - compose-tilde-map) - (define-key compose-map [SunFA_Tilde] compose-tilde-map) - )) -;; Sun according to OpenWindows 2: +;;(when (x-valid-keysym-name-p "SunFA_Acute") +;; (define-dead-key-map [SunFA_Acute] compose-acute-map) +;; (define-dead-key-map [SunFA_Grave] compose-grave-map) +;; (define-dead-key-map [SunFA_Cedilla] compose-cedilla-map) +;; (define-dead-key-map [SunFA_Diaeresis] compose-diaeresis-map) +;; (define-dead-key-map [SunFA_Circum] compose-circumflex-map) +;; (define-dead-key-map [SunFA_Tilde] compose-tilde-map) +;; ) ;; -(cond ((x-valid-keysym-name-p "Dead_Grave") - (define-key function-key-map [Dead_Grave] - compose-grave-map) - (define-key compose-map [Dead_Grave] compose-grave-map) - (define-key function-key-map [Dead_Circum] - compose-circumflex-map) - (define-key compose-map [Dead_Circum] compose-circumflex-map) - (define-key function-key-map [Dead_Tilde] - compose-tilde-map) - (define-key compose-map [Dead_Tilde] compose-tilde-map) - )) - -;; Sun according to OpenWindows 3: +;;;; Sun according to OpenWindows 2: +;;;; +;;(when (x-valid-keysym-name-p "Dead_Grave") +;; (define-dead-key-map [Dead_Grave] compose-grave-map) +;; (define-dead-key-map [Dead_Circum] compose-circumflex-map) +;; (define-dead-key-map [Dead_Tilde] compose-tilde-map) +;; ) ;; -(cond ((x-valid-keysym-name-p "SunXK_FA_Acute") - (define-key function-key-map [SunXK_FA_Acute] - compose-acute-map) - (define-key compose-map [SunXK_FA_Acute] compose-acute-map) - (define-key function-key-map [SunXK_FA_Grave] - compose-grave-map) - (define-key compose-map [SunXK_FA_Grave] compose-grave-map) - (define-key function-key-map [SunXK_FA_Cedilla] compose-cedilla-map) - (define-key compose-map [SunXK_FA_Cedilla] compose-cedilla-map) - (define-key function-key-map [SunXK_FA_Diaeresis] - compose-diaeresis-map) - (define-key compose-map [SunXK_FA_Diaeresis] compose-diaeresis-map) - (define-key function-key-map [SunXK_FA_Circum] compose-circumflex-map) - (define-key compose-map [SunXK_FA_Circum] compose-circumflex-map) - (define-key function-key-map [SunXK_FA_Tilde] - compose-tilde-map) - (define-key compose-map [SunXK_FA_Tilde] compose-tilde-map) - )) - -;; DEC according to MIT: +;;;; Sun according to OpenWindows 3: +;;;; +;;(when (x-valid-keysym-name-p "SunXK_FA_Acute") +;; (define-dead-key-map [SunXK_FA_Acute] compose-acute-map) +;; (define-dead-key-map [SunXK_FA_Grave] compose-grave-map) +;; (define-dead-key-map [SunXK_FA_Cedilla] compose-cedilla-map) +;; (define-dead-key-map [SunXK_FA_Diaeresis] compose-diaeresis-map) +;; (define-dead-key-map [SunXK_FA_Circum] compose-circumflex-map) +;; (define-dead-key-map [SunXK_FA_Tilde] compose-tilde-map) +;; ) ;; -(cond ((x-valid-keysym-name-p "Dacute_accent") - (define-key function-key-map [Dacute_accent] - compose-acute-map) - (define-key compose-map [Dacute_accent] compose-acute-map) - (define-key function-key-map [Dgrave_accent] - compose-grave-map) - (define-key compose-map [Dgrave_accent] compose-grave-map) - (define-key function-key-map [Dcedilla_accent] compose-cedilla-map) - (define-key compose-map [Dcedilla_accent] compose-cedilla-map) - (define-key function-key-map [Dcircumflex_accent] - compose-circumflex-map) - (define-key compose-map [Dcircumflex_accent] compose-circumflex-map) - (define-key function-key-map [Dtilde] - compose-tilde-map) - (define-key compose-map [Dtilde] compose-tilde-map) - (define-key function-key-map [Dring_accent] - compose-ring-map) - (define-key compose-map [Dring_accent] compose-ring-map) - )) - -;; DEC according to OpenWindows 3: +;;;; DEC according to MIT: +;;;; +;;(when (x-valid-keysym-name-p "Dacute_accent") +;; (define-dead-key-map [Dacute_accent] compose-acute-map) +;; (define-dead-key-map [Dgrave_accent] compose-grave-map) +;; (define-dead-key-map [Dcedilla_accent] compose-cedilla-map) +;; (define-dead-key-map [Dcircumflex_accent] compose-circumflex-map) +;; (define-dead-key-map [Dtilde] compose-tilde-map) +;; (define-dead-key-map [Dring_accent] compose-ring-map) +;; ) ;; -(cond ((x-valid-keysym-name-p "DXK_acute_accent") - (define-key function-key-map [DXK_acute_accent] compose-acute-map) - (define-key compose-map [DXK_acute_accent] compose-acute-map) - (define-key function-key-map [DXK_grave_accent] compose-grave-map) - (define-key compose-map [DXK_grave_accent] compose-grave-map) - (define-key function-key-map [DXK_cedilla_accent] - compose-cedilla-map) - (define-key compose-map [DXK_cedilla_accent] compose-cedilla-map) - (define-key function-key-map [DXK_circumflex_accent] - compose-circumflex-map) - (define-key compose-map [DXK_circumflex_accent] compose-circumflex-map) - (define-key function-key-map [DXK_tilde] - compose-tilde-map) - (define-key compose-map [DXK_tilde] compose-tilde-map) - (define-key function-key-map [DXK_ring_accent] compose-ring-map) - (define-key compose-map [DXK_ring_accent] compose-ring-map) - )) - -;; HP according to MIT: +;;;; DEC according to OpenWindows 3: +;;;; +;;(when (x-valid-keysym-name-p "DXK_acute_accent") +;; (define-dead-key-map [DXK_acute_accent] compose-acute-map) +;; (define-dead-key-map [DXK_grave_accent] compose-grave-map) +;; (define-dead-key-map [DXK_cedilla_accent] compose-cedilla-map) +;; (define-dead-key-map [DXK_circumflex_accent] compose-circumflex-map) +;; (define-dead-key-map [DXK_tilde] compose-tilde-map) +;; (define-dead-key-map [DXK_ring_accent] compose-ring-map) +;; ) ;; -(cond ((x-valid-keysym-name-p "hpmute_acute") - (define-key function-key-map [hpmute_acute] - compose-acute-map) - (define-key compose-map [hpmute_acute] compose-acute-map) - (define-key function-key-map [hpmute_grave] - compose-grave-map) - (define-key compose-map [hpmute_grave] compose-grave-map) - (define-key function-key-map [hpmute_diaeresis] compose-diaeresis-map) - (define-key compose-map [hpmute_diaeresis] compose-diaeresis-map) - (define-key function-key-map [hpmute_asciicircum] - compose-circumflex-map) - (define-key compose-map [hpmute_asciicircum] compose-circumflex-map) - (define-key function-key-map [hpmute_asciitilde] - compose-tilde-map) - (define-key compose-map [hpmute_asciitilde] compose-tilde-map) - )) - -;; HP according to OpenWindows 3: +;;;; HP according to MIT: +;;;; +;;(when (x-valid-keysym-name-p "hpmute_acute") +;; (define-dead-key-map [hpmute_acute] compose-acute-map) +;; (define-dead-key-map [hpmute_grave] compose-grave-map) +;; (define-dead-key-map [hpmute_diaeresis] compose-diaeresis-map) +;; (define-dead-key-map [hpmute_asciicircum] compose-circumflex-map) +;; (define-dead-key-map [hpmute_asciitilde] compose-tilde-map) +;; ) ;; -(cond ((x-valid-keysym-name-p "hpXK_mute_acute") - (define-key function-key-map [hpXK_mute_acute] compose-acute-map) - (define-key compose-map [hpXK_mute_acute] compose-acute-map) - (define-key function-key-map [hpXK_mute_grave] compose-grave-map) - (define-key compose-map [hpXK_mute_grave] compose-grave-map) - (define-key function-key-map [hpXK_mute_diaeresis] - compose-diaeresis-map) - (define-key compose-map [hpXK_mute_diaeresis] compose-diaeresis-map) - (define-key function-key-map [hpXK_mute_asciicircum] - compose-circumflex-map) - (define-key compose-map [hpXK_mute_asciicircum] compose-circumflex-map) - (define-key function-key-map [hpXK_mute_asciitilde] - compose-tilde-map) - (define-key compose-map [hpXK_mute_asciitilde] compose-tilde-map) - )) - -;; HP according to HP-UX 8.0: +;;;; HP according to OpenWindows 3: +;;;; +;;(when (x-valid-keysym-name-p "hpXK_mute_acute") +;; (define-dead-key-map [hpXK_mute_acute] compose-acute-map) +;; (define-dead-key-map [hpXK_mute_grave] compose-grave-map) +;; (define-dead-key-map [hpXK_mute_diaeresis] compose-diaeresis-map) +;; (define-dead-key-map [hpXK_mute_asciicircum] compose-circumflex-map) +;; (define-dead-key-map [hpXK_mute_asciitilde] compose-tilde-map) +;; ) ;; -(cond ((x-valid-keysym-name-p "XK_mute_acute") - (define-key function-key-map [XK_mute_acute] - compose-acute-map) - (define-key compose-map [XK_mute_acute] compose-acute-map) - (define-key function-key-map [XK_mute_grave] - compose-grave-map) - (define-key compose-map [XK_mute_grave] compose-grave-map) - (define-key function-key-map [XK_mute_diaeresis] - compose-diaeresis-map) - (define-key compose-map [XK_mute_diaeresis] compose-diaeresis-map) - (define-key function-key-map [XK_mute_asciicircum] - compose-circumflex-map) - (define-key compose-map [XK_mute_asciicircum] compose-circumflex-map) - (define-key function-key-map - [XK_mute_asciitilde] compose-tilde-map) - (define-key compose-map [XK_mute_asciitilde] compose-tilde-map) - )) -;; Xfree seems to use lower case and a hyphen -(cond ((x-valid-keysym-name-p "dead-tilde") - (define-key function-key-map [dead-acute] - compose-acute-map) - (define-key compose-map [dead-acute] compose-acute-map) - (define-key function-key-map [dead-grave] - compose-grave-map) - (define-key compose-map [dead-grave] compose-grave-map) - (define-key function-key-map [dead-cedilla] compose-cedilla-map) - (define-key compose-map [dead-cedilla] compose-cedilla-map) - (define-key function-key-map [dead_diaeresis] compose-diaeresis-map) - (define-key compose-map [dead-diaeresis] compose-diaeresis-map) - (define-key function-key-map [dead-circum] compose-circumflex-map) - (define-key compose-map [dead-circum] compose-circumflex-map) - (define-key function-key-map [dead-tilde] - compose-tilde-map) - (define-key compose-map [dead-tilde] compose-tilde-map) - )) +;;;; HP according to HP-UX 8.0: +;;;; +;;(when (x-valid-keysym-name-p "XK_mute_acute") +;; (define-dead-key-map [XK_mute_acute] compose-acute-map) +;; (define-dead-key-map [XK_mute_grave] compose-grave-map) +;; (define-dead-key-map [XK_mute_diaeresis] compose-diaeresis-map) +;; (define-dead-key-map [XK_mute_asciicircum] compose-circumflex-map) +;; (define-dead-key-map [XK_mute_asciitilde] compose-tilde-map) +;; ) +;; +;;;; Xfree seems to use lower case and a hyphen +;;(when (x-valid-keysym-name-p "dead-tilde") +;; (define-dead-key-map [dead-acute] compose-acute-map) +;; (define-dead-key-map [dead-grave] compose-grave-map) +;; (define-dead-key-map [dead-cedilla] compose-cedilla-map) +;; (define-dead-key-map [dead-diaeresis] compose-diaeresis-map) +;; (define-dead-key-map [dead-circum] compose-circumflex-map) +;; (define-dead-key-map [dead-tilde] compose-tilde-map) +;; ) @@ -346,112 +289,104 @@ ;;; compose-map. (set-keymap-name compose-acute-map 'compose-acute-map) -(set-keymap-default-binding compose-acute-map 'self-insert-command) -(define-key compose-acute-map " " "'") -(define-key compose-acute-map "'" [acute]) -(define-key compose-acute-map "A" [Aacute]) -(define-key compose-acute-map "E" [Eacute]) -(define-key compose-acute-map "I" [Iacute]) -(define-key compose-acute-map "O" [Oacute]) -(define-key compose-acute-map "U" [Uacute]) -(define-key compose-acute-map "Y" [Yacute]) -(define-key compose-acute-map "a" [aacute]) -(define-key compose-acute-map "e" [eacute]) -(define-key compose-acute-map "i" [iacute]) -(define-key compose-acute-map "o" [oacute]) -(define-key compose-acute-map "u" [uacute]) -(define-key compose-acute-map "y" [yacute]) +(define-key compose-acute-map [space] "'") +(define-key compose-acute-map [?'] [acute]) +(define-key compose-acute-map [?A] [Aacute]) +(define-key compose-acute-map [E] [Eacute]) +(define-key compose-acute-map [I] [Iacute]) +(define-key compose-acute-map [O] [Oacute]) +(define-key compose-acute-map [U] [Uacute]) +(define-key compose-acute-map [Y] [Yacute]) +(define-key compose-acute-map [a] [aacute]) +(define-key compose-acute-map [e] [eacute]) +(define-key compose-acute-map [i] [iacute]) +(define-key compose-acute-map [o] [oacute]) +(define-key compose-acute-map [u] [uacute]) +(define-key compose-acute-map [y] [yacute]) (set-keymap-name compose-grave-map 'compose-grave-map) -(set-keymap-default-binding compose-grave-map 'self-insert-command) -(define-key compose-grave-map " " "`") -(define-key compose-grave-map "`" [grave]) -(define-key compose-grave-map "A" [Agrave]) -(define-key compose-grave-map "E" [Egrave]) -(define-key compose-grave-map "I" [Igrave]) -(define-key compose-grave-map "O" [Ograve]) -(define-key compose-grave-map "U" [Ugrave]) -(define-key compose-grave-map "a" [agrave]) -(define-key compose-grave-map "e" [egrave]) -(define-key compose-grave-map "i" [igrave]) -(define-key compose-grave-map "o" [ograve]) -(define-key compose-grave-map "u" [ugrave]) +(define-key compose-grave-map [space] "`") +(define-key compose-grave-map [?`] [grave]) +(define-key compose-grave-map [A] [Agrave]) +(define-key compose-grave-map [E] [Egrave]) +(define-key compose-grave-map [I] [Igrave]) +(define-key compose-grave-map [O] [Ograve]) +(define-key compose-grave-map [U] [Ugrave]) +(define-key compose-grave-map [a] [agrave]) +(define-key compose-grave-map [e] [egrave]) +(define-key compose-grave-map [i] [igrave]) +(define-key compose-grave-map [o] [ograve]) +(define-key compose-grave-map [u] [ugrave]) (set-keymap-name compose-cedilla-map 'compose-cedilla-map) -(set-keymap-default-binding compose-cedilla-map 'self-insert-command) -(define-key compose-cedilla-map " " ",") -(define-key compose-cedilla-map "," [cedilla]) -(define-key compose-cedilla-map "C" [Ccedilla]) -(define-key compose-cedilla-map "c" [ccedilla]) +(define-key compose-cedilla-map [space] ",") +(define-key compose-cedilla-map [?,] [cedilla]) +(define-key compose-cedilla-map [C] [Ccedilla]) +(define-key compose-cedilla-map [c] [ccedilla]) (set-keymap-name compose-diaeresis-map 'compose-diaeresis-map) -(set-keymap-default-binding compose-diaeresis-map 'self-insert-command) -(define-key compose-diaeresis-map " " [diaeresis]) -(define-key compose-diaeresis-map "\"" [diaeresis]) -(define-key compose-diaeresis-map "A" [Adiaeresis]) -(define-key compose-diaeresis-map "E" [Ediaeresis]) -(define-key compose-diaeresis-map "I" [Idiaeresis]) -(define-key compose-diaeresis-map "O" [Odiaeresis]) -(define-key compose-diaeresis-map "U" [Udiaeresis]) -(define-key compose-diaeresis-map "a" [adiaeresis]) -(define-key compose-diaeresis-map "e" [ediaeresis]) -(define-key compose-diaeresis-map "i" [idiaeresis]) -(define-key compose-diaeresis-map "o" [odiaeresis]) -(define-key compose-diaeresis-map "u" [udiaeresis]) -(define-key compose-diaeresis-map "y" [ydiaeresis]) +(define-key compose-diaeresis-map [space] [diaeresis]) +(define-key compose-diaeresis-map [?\"] [diaeresis]) +(define-key compose-diaeresis-map [A] [Adiaeresis]) +(define-key compose-diaeresis-map [E] [Ediaeresis]) +(define-key compose-diaeresis-map [I] [Idiaeresis]) +(define-key compose-diaeresis-map [O] [Odiaeresis]) +(define-key compose-diaeresis-map [U] [Udiaeresis]) +(define-key compose-diaeresis-map [a] [adiaeresis]) +(define-key compose-diaeresis-map [e] [ediaeresis]) +(define-key compose-diaeresis-map [i] [idiaeresis]) +(define-key compose-diaeresis-map [o] [odiaeresis]) +(define-key compose-diaeresis-map [u] [udiaeresis]) +(define-key compose-diaeresis-map [y] [ydiaeresis]) (set-keymap-name compose-circumflex-map 'compose-circumflex-map) -(set-keymap-default-binding compose-circumflex-map 'self-insert-command) -(define-key compose-circumflex-map " " "^") -(define-key compose-circumflex-map "/" "|") -(define-key compose-circumflex-map "!" [brokenbar]) -(define-key compose-circumflex-map "-" [macron]) -(define-key compose-circumflex-map "_" [macron]) -(define-key compose-circumflex-map "0" 'compose-insert-degree) -(define-key compose-circumflex-map "1" [onesuperior]) -(define-key compose-circumflex-map "2" [twosuperior]) -(define-key compose-circumflex-map "3" [threesuperior]) -(define-key compose-circumflex-map "." [periodcentered]) -(define-key compose-circumflex-map "A" [Acircumflex]) -(define-key compose-circumflex-map "E" [Ecircumflex]) -(define-key compose-circumflex-map "I" [Icircumflex]) -(define-key compose-circumflex-map "O" [Ocircumflex]) -(define-key compose-circumflex-map "U" [Ucircumflex]) -(define-key compose-circumflex-map "a" [acircumflex]) -(define-key compose-circumflex-map "e" [ecircumflex]) -(define-key compose-circumflex-map "i" [icircumflex]) -(define-key compose-circumflex-map "o" [ocircumflex]) -(define-key compose-circumflex-map "u" [ucircumflex]) +(define-key compose-circumflex-map [space] "^") +(define-key compose-circumflex-map [?/] "|") +(define-key compose-circumflex-map [?!] [brokenbar]) +(define-key compose-circumflex-map [?-] [macron]) +(define-key compose-circumflex-map [?_] [macron]) +(define-key compose-circumflex-map [?0] [degree]) +(define-key compose-circumflex-map [?1] [onesuperior]) +(define-key compose-circumflex-map [?2] [twosuperior]) +(define-key compose-circumflex-map [?3] [threesuperior]) +(define-key compose-circumflex-map [?.] [periodcentered]) +(define-key compose-circumflex-map [A] [Acircumflex]) +(define-key compose-circumflex-map [E] [Ecircumflex]) +(define-key compose-circumflex-map [I] [Icircumflex]) +(define-key compose-circumflex-map [O] [Ocircumflex]) +(define-key compose-circumflex-map [U] [Ucircumflex]) +(define-key compose-circumflex-map [a] [acircumflex]) +(define-key compose-circumflex-map [e] [ecircumflex]) +(define-key compose-circumflex-map [i] [icircumflex]) +(define-key compose-circumflex-map [o] [ocircumflex]) +(define-key compose-circumflex-map [u] [ucircumflex]) (set-keymap-name compose-tilde-map 'compose-tilde-map) -(set-keymap-default-binding compose-tilde-map 'self-insert-command) -(define-key compose-tilde-map " " "~") -(define-key compose-tilde-map "A" [Atilde]) -(define-key compose-tilde-map "N" [Ntilde]) -(define-key compose-tilde-map "O" [Otilde]) -(define-key compose-tilde-map "a" [atilde]) -(define-key compose-tilde-map "n" [ntilde]) -(define-key compose-tilde-map "o" [otilde]) +(define-key compose-tilde-map [space] "~") +(define-key compose-tilde-map [A] [Atilde]) +(define-key compose-tilde-map [N] [Ntilde]) +(define-key compose-tilde-map [O] [Otilde]) +(define-key compose-tilde-map [a] [atilde]) +(define-key compose-tilde-map [n] [ntilde]) +(define-key compose-tilde-map [o] [otilde]) (set-keymap-name compose-ring-map 'compose-ring-map) -(set-keymap-default-binding compose-ring-map 'self-insert-command) -(define-key compose-ring-map " " 'compose-insert-degree) -(define-key compose-ring-map "A" [Aring]) -(define-key compose-ring-map "a" [aring]) +(define-key compose-ring-map [space] [degree]) +(define-key compose-ring-map [A] [Aring]) +(define-key compose-ring-map [a] [aring]) ;;; The rest of the compose-map. These are the composed characters ;;; that are not accessible via "dead" keys. (set-keymap-name compose-map 'compose-map) -(set-keymap-default-binding compose-map 'self-insert-command) (define-key compose-map " '" "'") (define-key compose-map " ^" "^") (define-key compose-map " `" "`") (define-key compose-map " ~" "~") (define-key compose-map " " [nobreakspace]) (define-key compose-map " \"" [diaeresis]) -(define-key compose-map " *" 'compose-insert-degree) +(define-key compose-map " *" [degree]) (define-key compose-map "!!" [exclamdown]) (define-key compose-map "!^" [brokenbar]) @@ -505,7 +440,7 @@ (define-key compose-map "0c" [copyright]) (define-key compose-map "0R" [registered]) (define-key compose-map "0r" [registered]) -(define-key compose-map "0^" 'compose-insert-degree) +(define-key compose-map "0^" [degree]) (define-key compose-map "1^" [onesuperior]) (define-key compose-map "14" [onequarter]) @@ -705,9 +640,9 @@ (defun electric-diacritic (&optional count) "Modify the previous character with an accent. -For example, if `:' is bound to this command, then typing `a:' +For example, if `:' is bound to this command, then typing `a:' will first insert `a' and then turn it into `\344' (adiaeresis). -The keys to which this command may be bound (and the accents +The keys to which this command may be bound (and the accents which it understands) are: ' (acute) \301\311\315\323\332\335 \341\351\355\363\372\375 @@ -718,7 +653,7 @@ . (ring) \305\345" (interactive "p") (or count (setq count 1)) - + (if (not (eq last-command 'self-insert-command)) ;; Only do the magic if the two chars were typed in succession. (self-insert-command count) @@ -753,7 +688,7 @@ (setq count (1- count)))))) ;; should "::" mean "¨" and ": " mean ":"? -;; should we also do +;; should we also do ;; (?~ ;; (?A "\303") ;; (?C "\307") @@ -780,32 +715,38 @@ ;;; Providing help in the middle of a compose sequence. (Way cool.) -(defun compose-help () - (interactive) - (let* ((keys (apply 'vector - (nreverse - (cdr (nreverse (append (this-command-keys) nil)))))) - (map (or (key-binding keys) - (error "can't find map? %s" (this-command-keys))))) - (with-output-to-temp-buffer "*Help*" - (set-buffer "*Help*") - (erase-buffer) - (message "Working...") - (setq ctl-arrow 'compose) ; non-t-non-nil - (insert "You are typing a compose sequence. So far you have typed: ") - (insert (key-description keys)) - (insert "\nCompletions from here are:\n\n") - (map-keymap 'compose-help-mapper map t) - (message "? ")) +(eval-when-compile + (defsubst next-composable-event () (let (event) (while (progn (setq event (next-command-event)) - (setq map (lookup-key map (vector event))) - (keymapp map)) - ) - (if map - (command-execute map) - (setq unread-command-event event))))) + (not (or (key-press-event-p event) + (button-press-event-p event)))) + (dispatch-event event)) + event))) + +(defun compose-help (ignore-prompt) + (let* ((keys (apply 'vector (nbutlast (append (this-command-keys) nil)))) + (map (or (lookup-key function-key-map keys) + (error "can't find map? %s %s" keys (this-command-keys)))) + binding) + (save-excursion + (with-output-to-temp-buffer "*Help*" + (set-buffer "*Help*") + (erase-buffer) + (message "Working...") + (setq ctl-arrow 'compose) ; non-t-non-nil + (insert "You are typing a compose sequence. So far you have typed: ") + (insert (key-description keys)) + (insert "\nCompletions from here are:\n\n") + (map-keymap 'compose-help-mapper map t) + (message "? "))) + (while (keymapp map) + (setq binding (lookup-key map (vector (next-composable-event)))) + (if (null binding) + (message "No such key in keymap. Try again.") + (setq map binding))) + binding)) (put 'compose-help 'isearch-command t) ; so that it doesn't terminate isearch @@ -837,22 +778,21 @@ (if (stringp binding) (insert binding) (insert (prin1-to-string binding))))) - (if (and (vectorp binding) (= 1 (length binding))) - (progn - (indent-to 32) - (insert (symbol-name (aref binding 0)))))) + (when (and (vectorp binding) (= 1 (length binding))) + (indent-to 32) + (insert (symbol-name (aref binding 0))))) (insert "\n"))) ;; define it at top-level in the compose map... -(define-key compose-map '(control h) 'compose-help) -(define-key compose-map 'help 'compose-help) +;;(define-key compose-map [(control h)] 'compose-help) +;;(define-key compose-map [help] 'compose-help) ;; and then define it in each sub-map of the compose map. (map-keymap - (function (lambda (key binding) - (if (keymapp binding) - (progn - (define-key binding '(control h) 'compose-help) - (define-key binding 'help 'compose-help))))) + (lambda (key binding) + (when (keymapp binding) +;; (define-key binding [(control h)] 'compose-help) +;; (define-key binding [help] 'compose-help) + )) compose-map nil) ;; Make redisplay display the accented letters
--- a/lisp/x11/x-init.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/x11/x-init.el Mon Aug 13 09:55:28 2007 +0200 @@ -19,7 +19,7 @@ ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the +;; along with XEmacs; see the file COPYING. If not, write to the ;; Free Software Foundation, 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. @@ -78,7 +78,7 @@ (zmacs-activate-region))) (defun ow-find-backward () - "Search backward the previous occurrence of the text of the selection." + "Search backward for the previous occurrence of the text of the selection." (interactive) (ow-find t)) @@ -86,6 +86,133 @@ ;;; Specifically, load some code to repair the grievous damage that MIT and ;;; Sun have done to the default keymap for the Sun keyboards. +(eval-when-compile + (defmacro x-define-dead-key (key map) + `(when (x-keysym-on-keyboard-p ,(symbol-name key)) + (define-key function-key-map [,key] ',map)))) + +(defun x-initialize-compose () + "Enable compose processing" + (autoload 'compose-map "x-compose" nil t 'keymap) + (autoload 'compose-acute-map "x-compose" nil t 'keymap) + (autoload 'compose-grave-map "x-compose" nil t 'keymap) + (autoload 'compose-cedilla-map "x-compose" nil t 'keymap) + (autoload 'compose-diaeresis-map "x-compose" nil t 'keymap) + (autoload 'compose-circumflex-map "x-compose" nil t 'keymap) + (autoload 'compose-tilde-map "x-compose" nil t 'keymap) + + (when (x-keysym-on-keyboard-p "Multi_key") + (define-key function-key-map [multi-key] 'compose-map)) + + ;; The dead keys might really be called just about anything, depending + ;; on the vendor. MIT thinks that the prefixes are "SunFA_", "D", and + ;; "hpmute_" for Sun, DEC, and HP respectively. However, OpenWindows 3 + ;; thinks that the prefixes are "SunXK_FA_", "DXK_", and "hpXK_mute_". + ;; And HP (who don't mention Sun and DEC at all) use "XK_mute_". + ;; Go figure. + + ;; Presumably if someone is running OpenWindows, they won't be using + ;; the DEC or HP keysyms, but if they are defined then that is possible, + ;; so in that case we accept them all. + + ;; If things seem not to be working, you might want to check your + ;; /usr/lib/X11/XKeysymDB file to see if your vendor has an equally + ;; mixed up view of what these keys should be called. + + ;; Canonical names: + (x-define-dead-key acute compose-acute-map) + (x-define-dead-key grave compose-grave-map) + (x-define-dead-key cedilla compose-cedilla-map) + (x-define-dead-key diaeresis compose-diaeresis-map) + (x-define-dead-key circumflex compose-circumflex-map) + (x-define-dead-key tilde compose-tilde-map) + (x-define-dead-key degree compose-ring-map) + + ;; Sun according to MIT: + (when (x-valid-keysym-name-p "SunFA_Acute") + (x-define-dead-key SunFA_Acute compose-acute-map) + (x-define-dead-key SunFA_Grave compose-grave-map) + (x-define-dead-key SunFA_Cedilla compose-cedilla-map) + (x-define-dead-key SunFA_Diaeresis compose-diaeresis-map) + (x-define-dead-key SunFA_Circum compose-circumflex-map) + (x-define-dead-key SunFA_Tilde compose-tilde-map)) + + ;; Sun according to OpenWindows 2: + (when (x-valid-keysym-name-p "Dead_Grave") + (x-define-dead-key Dead_Grave compose-grave-map) + (x-define-dead-key Dead_Circum compose-circumflex-map) + (x-define-dead-key Dead_Tilde compose-tilde-map)) + + ;; Sun according to OpenWindows 3: + (when (x-valid-keysym-name-p "SunXK_FA_Acute") + (x-define-dead-key SunXK_FA_Acute compose-acute-map) + (x-define-dead-key SunXK_FA_Grave compose-grave-map) + (x-define-dead-key SunXK_FA_Cedilla compose-cedilla-map) + (x-define-dead-key SunXK_FA_Diaeresis compose-diaeresis-map) + (x-define-dead-key SunXK_FA_Circum compose-circumflex-map) + (x-define-dead-key SunXK_FA_Tilde compose-tilde-map)) + + ;; DEC according to MIT: + (when (x-valid-keysym-name-p "Dacute_accent") + (x-define-dead-key Dacute_accent compose-acute-map) + (x-define-dead-key Dgrave_accent compose-grave-map) + (x-define-dead-key Dcedilla_accent compose-cedilla-map) + (x-define-dead-key Dcircumflex_accent compose-circumflex-map) + (x-define-dead-key Dtilde compose-tilde-map) + (x-define-dead-key Dring_accent compose-ring-map)) + + ;; DEC according to OpenWindows 3: + (when (x-valid-keysym-name-p "DXK_acute_accent") + (x-define-dead-key DXK_acute_accent compose-acute-map) + (x-define-dead-key DXK_grave_accent compose-grave-map) + (x-define-dead-key DXK_cedilla_accent compose-cedilla-map) + (x-define-dead-key DXK_circumflex_accent compose-circumflex-map) + (x-define-dead-key DXK_tilde compose-tilde-map) + (x-define-dead-key DXK_ring_accent compose-ring-map)) + + ;; HP according to MIT: + (when (x-valid-keysym-name-p "hpmute_acute") + (x-define-dead-key hpmute_acute compose-acute-map) + (x-define-dead-key hpmute_grave compose-grave-map) + (x-define-dead-key hpmute_diaeresis compose-diaeresis-map) + (x-define-dead-key hpmute_asciicircum compose-circumflex-map) + (x-define-dead-key hpmute_asciitilde compose-tilde-map)) + + ;; HP according to OpenWindows 3: + (when (x-valid-keysym-name-p "hpXK_mute_acute") + (x-define-dead-key hpXK_mute_acute compose-acute-map) + (x-define-dead-key hpXK_mute_grave compose-grave-map) + (x-define-dead-key hpXK_mute_diaeresis compose-diaeresis-map) + (x-define-dead-key hpXK_mute_asciicircum compose-circumflex-map) + (x-define-dead-key hpXK_mute_asciitilde compose-tilde-map)) + + ;; HP according to HP-UX 8.0: + (when (x-valid-keysym-name-p "XK_mute_acute") + (x-define-dead-key XK_mute_acute compose-acute-map) + (x-define-dead-key XK_mute_grave compose-grave-map) + (x-define-dead-key XK_mute_diaeresis compose-diaeresis-map) + (x-define-dead-key XK_mute_asciicircum compose-circumflex-map) + (x-define-dead-key XK_mute_asciitilde compose-tilde-map)) + + ;; Xfree86 seems to use lower case and a hyphen + (when (x-valid-keysym-name-p "dead-acute") + (x-define-dead-key dead-acute compose-acute-map) + (x-define-dead-key dead-grave compose-grave-map) + (x-define-dead-key dead-cedilla compose-cedilla-map) + (x-define-dead-key dead-diaeresis compose-diaeresis-map) + (x-define-dead-key dead-circum compose-circumflex-map) + (x-define-dead-key dead-tilde compose-tilde-map)) + + ;; and AIX uses underscore, sigh.... + (when (x-valid-keysym-name-p "dead_acute") + (x-define-dead-key dead_acute compose-acute-map) + (x-define-dead-key dead_grave compose-grave-map) + (x-define-dead-key dead_cedilla compose-cedilla-map) + (x-define-dead-key dead_diaeresis compose-diaeresis-map) + (x-define-dead-key dead_circum compose-circumflex-map) + (x-define-dead-key dead_tilde compose-tilde-map)) +) + (defun x-initialize-keyboard () "Perform X-Server-specific initializations. Don't call this." ;; This is some heuristic junk that tries to guess whether this is @@ -139,7 +266,7 @@ (make-x-device nil) (setq command-line-args-left (cdr x-initial-argv-list)) (setq x-win-initted t))) - + (defvar post-x-win-initted nil) (defun init-post-x-win () @@ -153,13 +280,13 @@ (if (featurep 'mule) (init-mule-x-win)) ;; these are only ever called if zmacs-regions is true. - (add-hook 'zmacs-deactivate-region-hook - (lambda () - (if (console-on-window-system-p) + (add-hook 'zmacs-deactivate-region-hook + (lambda () + (if (console-on-window-system-p) (x-disown-selection)))) (add-hook 'zmacs-activate-region-hook - (lambda () - (if (console-on-window-system-p) + (lambda () + (if (console-on-window-system-p) (x-activate-region-as-selection)))) (add-hook 'zmacs-update-region-hook (lambda () @@ -181,15 +308,16 @@ (setq post-x-win-initted t))) - +;;; Keyboard initialization needs to be done differently for each X +;;; console, so use create-console-hook. (when (featurep 'x) (add-hook 'create-console-hook (lambda (console) (letf (((selected-console) console)) (when (eq 'x (console-type console)) - (x-initialize-keyboard)))))) - + (x-initialize-keyboard) + (x-initialize-compose)))))) (defun make-frame-on-display (display &optional props) "Create a frame on the X display named DISPLAY.
--- a/lisp/x11/x-menubar.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/x11/x-menubar.el Mon Aug 13 09:55:28 2007 +0200 @@ -154,6 +154,8 @@ ["Sunrise/Sunset" sunrise-sunset t] ) ("Games" + ["Mine Game" xmine t] + ["Tetris" tetris t] ["Quote from Zippy" yow t] ["Psychoanalyst" doctor t] ["Psychoanalyze Zippy!" psychoanalyze-pinhead t] @@ -162,7 +164,6 @@ ["Towers of Hanoi" hanoi t] ["Game of Life" life t] ["Multiplication Puzzle" mpuz t] - ["Mine Game" xmine t] ) )
--- a/lwlib/config.h.in Mon Aug 13 09:54:24 2007 +0200 +++ b/lwlib/config.h.in Mon Aug 13 09:55:28 2007 +0200 @@ -97,4 +97,4 @@ #define NEED_LUCID #endif -#endif /* _CONFIG_H_ */ +#endif /* _LWLIB_CONFIG_H_ */
--- a/lwlib/lwlib.c Mon Aug 13 09:54:24 2007 +0200 +++ b/lwlib/lwlib.c Mon Aug 13 09:55:28 2007 +0200 @@ -4,13 +4,13 @@ This file is part of the Lucid Widget Library. -The Lucid Widget Library is free software; you can redistribute it and/or +The Lucid Widget Library 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. The Lucid Widget Library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of +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. @@ -114,7 +114,7 @@ } /* this is analogous to free(). It frees only what was allocated - by malloc_widget_value(), and no substructures. + by malloc_widget_value(), and no substructures. */ void free_widget_value (widget_value *wv) @@ -130,9 +130,9 @@ static void free_widget_value_contents (widget_value *wv) { - if (wv->name) free (wv->name); + if (wv->name) free (wv->name); if (wv->value) free (wv->value); - if (wv->key) free (wv->key); + if (wv->key) free (wv->key); /* #### - all of this 0xDEADBEEF stuff should be unnecessary in production code... it should be conditionalized. */ @@ -140,7 +140,7 @@ if (wv->toolkit_data && wv->free_toolkit_data) { - XtFree (wv->toolkit_data); + XtFree ((char *) wv->toolkit_data); wv->toolkit_data = (void *) 0xDEADBEEF; } #ifdef NEED_SCROLLBARS @@ -238,7 +238,7 @@ copy_widget_value_tree (widget_value *val, change_type change) { widget_value *copy; - + if (!val) return NULL; if (val == (widget_value *) 1) @@ -515,7 +515,7 @@ free_widget_value_tree (val1); return NULL; } - + change = NO_CHANGE; if (val1->type != val2->type) @@ -589,7 +589,7 @@ { merged_contents = merge_widget_value (val1->contents, val2->contents, level - 1); - + if (val1->contents && !merged_contents) { EXPLAIN (val1->name, change, INVISIBLE_CHANGE, "(contents gone)", @@ -602,7 +602,7 @@ 0, 0); change = max (change, INVISIBLE_CHANGE); } - + val1->contents = merged_contents; } @@ -627,11 +627,11 @@ val1->next = merged_next; val1->change = change; - + if (change > NO_CHANGE && val1->toolkit_data) { if (val1->free_toolkit_data) - XtFree (val1->toolkit_data); + XtFree ((char *) val1->toolkit_data); val1->toolkit_data = NULL; } @@ -656,7 +656,7 @@ char *real_name = (char *) alloca (length); real_name [0] = '*'; strcpy (real_name + 1, name); - + widget = XtNameToWidget (instance->widget, real_name); } return widget; @@ -666,7 +666,7 @@ set_one_value (widget_instance *instance, widget_value *val, Boolean deep_p) { Widget widget = name_to_widget (instance, val->name); - + if (widget) { #ifdef NEED_LUCID @@ -790,11 +790,11 @@ static Boolean dialog_spec_p (CONST char *name) { - /* return True if name matches [EILPQeilpq][1-9][Bb] or + /* return True if name matches [EILPQeilpq][1-9][Bb] or [EILPQeilpq][1-9][Bb][Rr][1-9] */ if (!name) return False; - + switch (name [0]) { case 'E': case 'I': case 'L': case 'P': case 'Q': @@ -814,7 +814,7 @@ } else return False; - + default: return False; } @@ -855,7 +855,7 @@ #endif } } - + if (!function) { fprintf (stderr, "No creation function for widget type %s\n", @@ -871,7 +871,7 @@ /* XtRealizeWidget (instance->widget);*/ } -void +void lw_register_widget (CONST char *type, CONST char *name, LWLIB_ID id, widget_value *val, lw_callback pre_activate_cb, lw_callback selection_cb, @@ -886,7 +886,7 @@ lw_get_widget (LWLIB_ID id, Widget parent, Boolean pop_up_p) { widget_instance *instance; - + instance = find_instance (id, parent, pop_up_p); return instance ? instance->widget : NULL; } @@ -896,7 +896,7 @@ { widget_instance *instance; widget_info *info; - + instance = find_instance (id, parent, pop_up_p); if (!instance) { @@ -921,7 +921,7 @@ post_activate_cb); return lw_make_widget (id, parent, pop_up_p); } - + /* destroying the widgets */ static void @@ -972,7 +972,7 @@ lw_destroy_widget (Widget w) { widget_instance *instance = get_widget_instance (w, True); - + if (instance) { widget_info *info = instance->info; @@ -1128,7 +1128,7 @@ get_one_value (widget_instance *instance, widget_value *val) { Widget widget = name_to_widget (instance, val->name); - + if (widget) { #ifdef NEED_LUCID @@ -1197,7 +1197,7 @@ /* update other instances value when one thing changed */ -/* This function can be used as a an XtCallback for the widgets that get +/* This function can be used as a an XtCallback for the widgets that get modified to update other instances of the widgets. Closure should be the widget_instance. */ void @@ -1206,7 +1206,7 @@ { /* To forbid recursive calls */ static Boolean updating; - + widget_instance *instance = (widget_instance*)closure; char *name = XtName (widget); widget_info *info; @@ -1272,7 +1272,7 @@ Pixel background = 1; Widget widget_to_invert = XtNameToWidget (w, "*sheet"); Arg al [2]; - + if (!widget_to_invert) widget_to_invert = w;
--- a/lwlib/xlwmenu.c Mon Aug 13 09:54:24 2007 +0200 +++ b/lwlib/xlwmenu.c Mon Aug 13 09:55:28 2007 +0200 @@ -2792,10 +2792,9 @@ older function doesn't. */ while ((fontentry = XmFontListNextEntry (context))) { - char *one_of_them; XmFontType rettype; - one_of_them = XmFontListEntryGetFont (fontentry, &rettype); + XtPointer one_of_them = XmFontListEntryGetFont (fontentry, &rettype); if (rettype == XmFONT_IS_FONTSET) { XFontSet fontset = (XFontSet) one_of_them; @@ -2873,7 +2872,7 @@ #if (XmVersion >= 1002) XmFontListEntry fontentry; XmFontType rettype; - char *one_of_them; + XtPointer one_of_them; #else XmStringCharSet charset; #endif
--- a/lwlib/xlwscrollbarP.h Mon Aug 13 09:54:24 2007 +0200 +++ b/lwlib/xlwscrollbarP.h Mon Aug 13 09:55:28 2007 +0200 @@ -38,6 +38,22 @@ XlwScrollBarClassPart scrollbar_class; } XlwScrollBarClassRec; +enum XlwScrollbarArm +{ + ARM_NONE, + ARM_SLIDER, + ARM_UP, + ARM_DOWN, + ARM_PAGEUP, + ARM_PAGEDOWN +}; + +enum XlwScrollbarForcedScroll +{ + FORCED_SCROLL_NONE, + FORCED_SCROLL_DOWNRIGHT, + FORCED_SCROLL_UPLEFT +}; /* ** Widget instance @@ -98,20 +114,9 @@ int above, ss, below; int lastY; - enum { - ARM_NONE, - ARM_SLIDER, - ARM_UP, - ARM_DOWN, - ARM_PAGEUP, - ARM_PAGEDOWN - } armed; + enum XlwScrollbarArm armed; - enum { - FORCED_SCROLL_NONE, - FORCED_SCROLL_DOWNRIGHT, - FORCED_SCROLL_UPLEFT - } forced_scroll; + enum XlwScrollbarForcedScroll forced_scroll; int savedValue;
--- a/man/cl.texi Mon Aug 13 09:54:24 2007 +0200 +++ b/man/cl.texi Mon Aug 13 09:55:28 2007 +0200 @@ -818,7 +818,7 @@ characters. In Emacs-19 and XEmacs-19, characters are the same thing as integers in the range 0-255. In XEmacs-20, where characters are a first-class data type, this checks for actual characters, and -+@code{(typep 8bit-integer 'character)} will return @code{nil}. +@code{(typep @var{8bit-integer} 'character)} will return @code{nil}. @item The type symbol @code{float} uses the @code{floatp-safe} predicate
--- a/man/ediff.texi Mon Aug 13 09:54:24 2007 +0200 +++ b/man/ediff.texi Mon Aug 13 09:55:28 2007 +0200 @@ -899,7 +899,7 @@ Session records in session group panels are also marked with @kbd{+}, for active sessions, and with @kbd{-}, for finished sessions. -Sometimes, it is convenient to exclude certain session records from a group. +Sometimes, it is convenient to exclude certain sessions from a group. Usually this happens when the user doesn't intend to run Ediff of certain files in the group, and the corresponding session records just add clutter to the session group buffer. To help alleviate this problem, the user can @@ -934,17 +934,26 @@ @cindex Multi-file patches A multi-file patch is a concatenated output of several runs of the Unix @file{diff} command (some versions of @file{diff} let you create a -multi-file patch in just one run). In a session group buffer created in -response to @code{ediff-directories} or @code{ediff-directory-revisions}, -the user can type @kbd{P} to create a multi-file patch of marked sessions -(which must be marked using the @kbd{m} command). Ediff then will display -a buffer containing the patch. In an @code{ediff-directories} session, it -is enough to just mark the requisite sessions. In -@code{ediff-directory-revisions} revisions, the marked sessions must also -be active, or else Ediff will refuse to produce a multi-file patch. This is -because, in the latter-style sessions, there are many ways to create diff -output, and it is easier to handle by running Ediff on the inactive -sessions. +multi-file patch in just one run). Ediff facilitates creation of +multi-file patches as follows. If you are in a session group buffer +created in response to @code{ediff-directories} or +@code{ediff-directory-revisions}, you can mark (by typing @kbd{m}) the +desired Ediff sessions and then type @kbd{P} to create a +multi-file patch of those marked sessions. +Ediff will then display a buffer containing the patch. +The patch is generated by invoking @file{diff} on all marked individual +sessions (represented by files) and session groups (represented by +directories). Ediff will also recursively descend into any @emph{unmarked} +session group and will search for marked sessions there. In this way, you +can create multi-file patches that span file subtrees that grow out of +any given directory. + +In an @code{ediff-directories} session, it is enough to just mark the +requisite sessions. In @code{ediff-directory-revisions} revisions, the +marked sessions must also be active, or else Ediff will refuse to produce a +multi-file patch. This is because, in the latter-style sessions, there are +many ways to create diff output, and it is easier to handle by running +Ediff on the inactive sessions. Last, but not least, by typing @kbd{=}, you can quickly find out which sessions have identical files, so you won't have to run Ediff on those
--- a/man/viper.texi Mon Aug 13 09:54:24 2007 +0200 +++ b/man/viper.texi Mon Aug 13 09:55:28 2007 +0200 @@ -15,7 +15,7 @@ @titlepage @title Viper Is a Package for Emacs Rebels @subtitle a Vi emulator for GNU Emacs 20 and XEmacs 20 -@subtitle August 1997, Viper Version 2.96 +@subtitle August 1997, Viper Version 3.0 (Polyglot) @author Michael Kifer (Viper) @author Aamod Sane (VIP 4.4) @@ -533,14 +533,20 @@ @cindex Meta key Viper uses @key{ESC} as a switch between Insert and Vi states. Emacs uses -@key{ESC} for Meta. We need a Meta key to call the Meta key functions such -as @kbd{M-x function name}. This role is played by the key @kbd{C-\}. -Thus, to get @kbd{M-x}, you should type @kbd{C-\ x} (if the keyboard has no -Meta key). This works both in the Vi state and the Insert state. -Alternatively, you can use @kbd{\ @key{ESC}} in Vi state to simulate the -meta key. It is possible to use @key{ESC} as Meta, but then you cannot -press @key{ESC} multiple times in Vi state. @xref{Customization}, to find -out how to rebind @key{ESC} to be Meta.@refill +@key{ESC} for Meta. The Meta key is very important in Emacs since many +finctions are accessible only via that key as @kbd{M-x function-name}. +Therefore, we need to simulate it somehow. In Viper's Vi, Insert, and +Replace states, the meta key is set to be @kbd{C-\}. Thus, to get +@kbd{M-x}, you should type @kbd{C-\ x} (if the keyboard has no Meta key). +This works both in the Vi command state and in the Insert and Replace +states. In Vi command state, you can also use @kbd{\ @key{ESC}} as the +meta key. + +Note: Emacs binds @kbd{C-\} to a function that offers to change the +keyboard input method in the multilingual environment. Viper overrides this +binding. However, it is still possible to switch the input method by typing +@kbd{\ C-\} in the Vi command state and @kbd{C-z \ C-\} in the Insert state. +Or you can use the MULE menu in the menubar. @end table @noindent Other differences are mostly improvements. The ones you should know @@ -696,6 +702,11 @@ @kbd{C-\ f} and @kbd{C-\ b} (@kbd{C-\} simulates the Meta key in Insert state, as explained above). +The key @kbd{C-z} is sometimes also useful in Insert state: it allows you +to execute a single command in Vi state without leaving the Insert state! +For instance, @kbd{C-z d2w} will delete the next two words without leaving +the Insert state. + When Viper is in Insert state, you will see <I> in the mode line. @node Replace State,, Insert State, States in Viper @@ -1215,12 +1226,17 @@ The word-movement commands @kbd{w}, @kbd{e}, etc., and the associated deletion/yanking commands, @kbd{dw}, @kbd{yw}, etc., can be made to understand Emacs syntax tables. If the variable -@code{viper-syntax-preference} is set to @code{strict-vi} (the default) then +@code{viper-syntax-preference} is set to @code{strict-vi} then the meaning of @emph{word} is the same as in -Vi. However, if the value is @code{reformed-vi} then the alphanumeric -symbols will be those specified by the current Emacs syntax table (which -may be different for different major modes) plus the underscore symbol -@kbd{_}. The user can also specify the value @code{emacs}, which would +Vi. However, if the value is @code{reformed-vi} (the default) then the +alphanumeric symbols will be those specified by the current Emacs syntax +table (which may be different for different major modes) plus the +underscore symbol @kbd{_}, minus some non-word symbols, like '.;,|, etc. +Both @code{strict-vi} and @code{reformed-vi} work close to Vi in +traditional cases, but @code{reformed-vi} does a better job when editing +text in non-Latin alphabets. + +The user can also specify the value @code{emacs}, which would make Viper use exactly the Emacs notion of word. In particular, the underscore may not be part of a word. Finally, if @code{viper-syntax-preference} is set to @code{extended}, Viper words would @@ -1235,9 +1251,14 @@ the value can be @code{reformed-vi} or @code{emacs}. Changes to @code{viper-syntax-preference} should be done in the hooks to -various major modes. Furthermore, for these changes to take effect, you -should execute @code{(viper-update-alphanumeric-class)} right after changing -the value of @code{viper-syntax-preference}. +various major modes by executing @code{viper-set-syntax-preference} as in +the following example: + +@example +(viper-set-syntax-preference nil "emacs") +@end example + +@findex @code{viper-set-syntax-preference} The above discussion of the meaning of Viper's words concerns only Viper's movement commands. In regular expressions, words remain the same as in @@ -1263,17 +1284,13 @@ @item C-x, C-c @kindex @kbd{C-x} @kindex @kbd{C-c} -@kbd{C-x} will exit from Vi state and return to Emacs state -@emph{temporarily}. If you hit one of these keys, Emacs will believe -that you hit that key in Emacs state. For example, if you hit @kbd{C-x} -followed by @kbd{2}, then the current window will be split into 2 and you -will be in Vi state again. Except for novice users, @kbd{C-c} is also set -to temporarily escape to Emacs and execute a command from the current -major mode. -@key{ESC} will do the same, if -you configure @key{ESC} as Meta by setting @code{viper-no-multiple-ESC} to nil -in @file{.viper}. @xref{Customization}. @kbd{C-\} -in Insert or Vi states will make Emacs think @kbd{Meta} has been hit.@refill +These two keys invoke many important Emacs functions. For example, if you +hit @kbd{C-x} followed by @kbd{2}, then the current window will be split +into 2. Except for novice users, @kbd{C-c} is also set to execute an Emacs +command from the current major mode. @key{ESC} will do the same, if you +configure @key{ESC} as Meta by setting @code{viper-no-multiple-ESC} to nil +in @file{.viper}. @xref{Customization}. @kbd{C-\} in Insert, Replace, or Vi +states will make Emacs think @kbd{Meta} has been hit.@refill @item \ @kindex @kbd{\} Escape to Emacs to execute a single Emacs command. For instance, @@ -1701,10 +1718,11 @@ @item viper-ex-style-motion t Set this to @code{nil}, if you want @kbd{l,h} to cross lines, etc. @xref{Movement and Markers}, for more info. -@item viper-ex-style-editing-in-insert t +@item viper-ex-style-editing t Set this to to @code{nil}, if you want @kbd{C-h} and @key{DEL} to not stop -at the beginning of a line in Insert state. +at the beginning of a line in Insert state, @key{X} and @key{x} to delete +characters across lines in Vi command state, etc. @item viper-ESC-moves-cursor-back t It t, cursor moves back 1 character when switching from insert state to vi state. If nil, the cursor stays where it was before the switch. @@ -1745,12 +1763,6 @@ @item ex-cycle-through-non-files nil @kbd{:n} does not normally cycle through buffers. Set this to get buffers also. -@item viper-automatic-iso-accents nil -If @kbd{t}, ISO accents will be turned on in insert/replace Viper states -and turned off in Vi state. This is useful for editing text in European -languages. This variable is buffer-local. If used, it should be set in the -hooks to the appropriate major modes (usually setting it in -@code{text-mode-hook} is enough). @item viper-want-emacs-keys-in-insert This is set to @code{nil} for user levels 1 and 2 and to @code{t} for user levels 3 and 4. Users who specify level 5 are allowed to set this variable @@ -1899,13 +1911,12 @@ @vindex @code{viper-ESC-keyseq-timeout} @vindex @code{viper-fast-keyseq-timeout} @vindex @code{viper-ex-style-motion} -@vindex @code{viper-ex-style-editing-in-insert} +@vindex @code{viper-ex-style-editing} @vindex @code{viper-ESC-moves-cursor-back} @vindex @code{viper-custom-file-name} @vindex @code{viper-spell-function} @vindex @code{ex-cycle-other-window} @vindex @code{ex-cycle-through-non-files} -@vindex @code{viper-automatic-iso-accents} @vindex @code{viper-want-emacs-keys-in-insert} @vindex @code{viper-want-emacs-keys-in-vi} @vindex @code{viper-keep-point-on-repeat} @@ -1959,8 +1970,8 @@ @lisp (cond ((string= (getenv "TERM") "xterm") - (define-key function-key-map "\e[192z" [f11]) ; L1 - (define-key function-key-map "\e[195z" [f14]) ; L4, Undo +(define-key function-key-map "\e[192z" [f11]) ; L1 +(define-key function-key-map "\e[195z" [f14]) ; L4, Undo @end lisp The above illustrates how to do this for Xterm. On VT100, you would have to @@ -2093,7 +2104,7 @@ state. For instance, @lisp (viper-add-local-keys 'vi-state '(("ZZ" . TeX-command-master) - ("ZQ" . viper-save-kill-buffer))) + ("ZQ" . viper-save-kill-buffer))) @end lisp @noindent redefines @kbd{ZZ} to invoke @code{TeX-command-master} in @code{vi-state} @@ -2746,9 +2757,9 @@ only: @example - (viper-record-kbd-macro "gg" 'insert-state - [l up (meta x) n e x t - l i n e return] - "my-buf") +(viper-record-kbd-macro "gg" 'insert-state + [l up (meta x) n e x t - l i n e return] + "my-buf") @end example @noindent @@ -2756,9 +2767,9 @@ @code{cc-mode}, use: @example - (viper-record-kbd-macro "gg" 'vi-state - [l up (meta x) n e x t - l i n e return] - 'cc-mode) +(viper-record-kbd-macro "gg" 'vi-state + [l up (meta x) n e x t - l i n e return] + 'cc-mode) @end example @noindent @@ -2772,7 +2783,7 @@ strings: @example - (viper-record-kbd-macro "aa" 'vi-state "aaa\e" "my-buffer") +(viper-record-kbd-macro "aa" 'vi-state "aaa\e" "my-buffer") @end example @noindent @@ -3096,36 +3107,53 @@ words understand Emacs symbol tables. Therefore, all symbols declared to be alphanumeric in a symbol table can automatically be made part of the Viper word. This is useful when, for instance, editing text containing European, -Cyrillic, etc., letters. - -Second, Viper lets you depart from Vi's idea of a word by changing the -value of @code{viper-syntax-preference}. By default, this variable is set to -@code{strict-vi}, which means that alphanumeric symbols are exactly as -in Vi. -However, if the value is @code{reformed-vi} then alphanumeric -symbols will be those specified by the current Emacs syntax table (which -may be different for different major modes) plus the underscore symbol -@kbd{_}. The user can also specify the value @code{emacs}, which would -make Viper use exactly the Emacs notion of word. In particular, the -underscore may not be part of a word. Finally, if -@code{viper-syntax-preference} is set to @code{extended}, Viper words would -consist of characters that are classified as alphanumeric @emph{or} as -parts of symbols. This is convenient for writing programs and in many other -situations. - -@vindex @code{viper-syntax-preference} -@cindex syntax table +Cyrillic, Japanese, etc., texts. + +Second, Viper lets you depart from Vi's idea of a word by changing the a +syntax preference via the customization widget (the variable +@code{viper-syntax-preference}) or by executing +@code{viper-set-syntax-preference} interactively. + +By default, Viper syntax preference is @code{reformed-vi}, which means that +Viper considers only those symbols to be part of a word that are specified +as word-symbols by the current Emacs syntax table (which may be different +for different major modes) plus the underscore symbol @kbd{_}, minus the +symbols that are not considered words in Vi (e.g., `,',;, etc.), but may be +considered as word-symbols by various Emacs major modes. Reformed-Vi works +very close to Vi, and it also recognizes words in other +alphabets. Therefore, this is the most appropriate mode for editing text +and is likely to fit all your needs. + +You can also set Viper syntax preference to @code{strict-vi}, which would +cause Viper to view all non-English letters as non-word-symbols. + +You can also specify @code{emacs} as your preference, which would +make Viper use exactly the same notion of a word as Emacs does. In +particular, the underscore may not be part of a word in some major modes. + +Finally, if @code{viper-syntax-preference} is set to @code{extended}, Viper +words would consist of characters that are classified as alphanumeric +@emph{or} as parts of symbols. This is convenient for editing programs. @code{viper-syntax-preference} is a local variable, so it can have different values for different major modes. For instance, in programming modes it can have the value @code{extended}. In text modes where words contain special characters, such as European (non-English) letters, Cyrillic letters, etc., the value can be @code{reformed-vi} or @code{emacs}. - -Changes to @code{viper-syntax-preference} should be done in the hooks to -various major modes. Furthermore, for these changes to take effect, you -should execute @code{(viper-update-alphanumeric-class)} right after changing -the value of @code{viper-syntax-preference}. +If you consider using different syntactic preferences for different major +modes, you should execute, for example, + +@example +(viper-set-syntax-preference nil "extended") +@end example + +in the appropriate major mode hooks. + +@vindex @code{viper-syntax-preference} +@findex @code{viper-set-syntax-preference} +@cindex syntax table + + The above discussion concerns only the movement commands. In regular expressions, words remain the same as in Emacs. That is, the expressions @@ -3373,9 +3401,9 @@ @item m , Jump to the Emacs mark. @item :mark <char> - Mark position with text marker named <char>. This is an Ex command. +Mark position with text marker named <char>. This is an Ex command. @item :k <char> - Same as @kbd{:mark}. +Same as @kbd{:mark}. @item `` Exchange point and mark. @item '' @@ -3592,11 +3620,11 @@ @kbd{s/[ab]+/\&\&/} will double the string matched by @kbd{[ab]}. Viper doesn't treat @samp{&} specially, unlike Vi: use @samp{\&} instead. @item :[x,y]copy [z] - Copy text between @kbd{x} and @kbd{y} to the position after @kbd{z}. +Copy text between @kbd{x} and @kbd{y} to the position after @kbd{z}. @item :[x,y]t [z] - Same as @kbd{:copy}. +Same as @kbd{:copy}. @item :[x,y]move [z] - Move text between @kbd{x} and @kbd{y} to the position after @kbd{z}. +Move text between @kbd{x} and @kbd{y} to the position after @kbd{z}. @item & Repeat latest Ex substitute command, e.g. @kbd{:s/wrong/right}. @@ -3687,7 +3715,7 @@ punctuation character other than <space> <tab> and <lf> can be used as delimiter. @item & - Repeat latest Ex substitute command, e.g. @kbd{:s/wrong/right}. +Repeat latest Ex substitute command, e.g. @kbd{:s/wrong/right}. @item :global /<pattern>/<ex-command> @itemx :g /<pattern>/<ex-command> Execute <ex-command> on all lines that match <pattern>. @@ -3991,51 +4019,51 @@ @table @kbd @item :map <string> - Start defining a Vi-style keyboard macro. - For instance, typing - @kbd{:map www} followed by @kbd{:!wc %} and then typing @kbd{C-x )} - will cause @kbd{www} to run wc on - current file (Vi replaces @samp{%} with the current file name). +Start defining a Vi-style keyboard macro. +For instance, typing +@kbd{:map www} followed by @kbd{:!wc %} and then typing @kbd{C-x )} +will cause @kbd{www} to run wc on +current file (Vi replaces @samp{%} with the current file name). @item C-x ) - Finish defining a keyboard macro. - In Viper, this command completes the process of defining all keyboard +Finish defining a keyboard macro. +In Viper, this command completes the process of defining all keyboard macros, whether they are Emacs-style or Vi-style. This is a departure from Vi, needed to allow WYSIWYG mapping of keyboard macros and to permit the use of function keys and arbitrary Emacs functions in the macros. @item :unmap <string> - Deprive <string> of its mappings in Vi state. +Deprive <string> of its mappings in Vi state. @item :map! <string> - Map a macro for Insert state. +Map a macro for Insert state. @item :unmap! <string> - Deprive <string> of its mapping in Insert state (see @kbd{:unmap}). +Deprive <string> of its mapping in Insert state (see @kbd{:unmap}). @item @@<a-z> - In Vi state, - execute the contents of register as a command. +In Vi state, +execute the contents of register as a command. @item @@@@ - In Vi state, - repeat last register command. +In Vi state, +repeat last register command. @item @@# In Vi state, - begin keyboard macro. End with @@<a-z>. This will - put the macro in the proper register. Register will - be automatically downcased. - @xref{Macros and Registers}, for more info. +begin keyboard macro. End with @@<a-z>. This will +put the macro in the proper register. Register will +be automatically downcased. +@xref{Macros and Registers}, for more info. @item @@!<a-z> - In Vi state, - yank anonymous macro to register +In Vi state, +yank anonymous macro to register @item * - In Vi state, - execute anonymous macro (defined by C-x( and C-x )). +In Vi state, +execute anonymous macro (defined by C-x( and C-x )). @item C-x e - Like @kbd{*}, but works in all Viper states. +Like @kbd{*}, but works in all Viper states. @item #g<move> - Execute the last keyboard macro for each line in the region. - @xref{Macros and Registers}, for more info. +Execute the last keyboard macro for each line in the region. +@xref{Macros and Registers}, for more info. @item [<a-z> - Show contents of textmarker. +Show contents of textmarker. @item ]<a-z> - Show contents of register. +Show contents of register. @end table @kindex @kbd{]<a-z>} @kindex @kbd{[<a-z>} @@ -4235,6 +4263,12 @@ @table @kbd @item C-\ Begin Meta command in Vi or Insert states. Most often used as C-\ x (M-x). + +Note: Emacs binds @kbd{C-\} to a function that offers to change the +keyboard input method in the multilingual environment. Viper overrides this +binding. However, it is still possible to switch the input method by typing +@kbd{\ C-\} in the Vi command state and @kbd{C-z \ C-\} in the Insert state. +Or you can use the MULE menu on the menubar. @item C-z In Insert and Replace states, prepare Viper to accept the next command and execute it as if Viper was in Vi state. Then return to Insert state.
--- a/man/w3.texi Mon Aug 13 09:54:24 2007 +0200 +++ b/man/w3.texi Mon Aug 13 09:55:28 2007 +0200 @@ -12,7 +12,7 @@ @c site: http://www.cs.indiana.edu/elisp/w3/docs.html @c @setfilename w3.info -@settitle Emacs/W3 v3.0.94 User's Manual +@settitle Emacs/W3 v3.0.103 User's Manual @iftex @finalout @end iftex @@ -27,7 +27,7 @@ @dircategory World Wide Web @dircategory GNU Emacs Lisp @direntry -* W3: (w3). Emacs/W3 World Wide Web browser. +* Emacs/W3: (w3). Emacs/W3 World Wide Web browser. @end direntry @ifinfo This file documents the Emacs/W3 World Wide Web browser. @@ -53,9 +53,9 @@ @center @titlefont{Emacs/W3} @center @titlefont{User's Manual} @sp 4 -@center Third Edition, Emacs/W3 Version 3.0 +@center Third Edition, Emacs/W3 Version 4.0 @sp 1 -@center March 1997 +@center June 1997 @sp 5 @center William M. Perry @center @i{wmperry@@cs.indiana.edu} @@ -90,7 +90,7 @@ @t{w3-beta@@indiana.edu} mailing list with any suggestions. @xref{Reporting Bugs} -This manual corresponds to Emacs/W3 v3.0.94 +This manual corresponds to Emacs/W3 v3.0.103 @menu * Getting Started:: Getting up and running with Emacs/W3 @@ -228,7 +228,7 @@ hypertext link. The @kbd{tab} and @kbd{Meta-tab} keys maneuver around the various links on the page. -@b{NOTE:} Starting with Emacs/W3 3.0, form entry areas in a page can be +@b{NOTE:} Starting with Emacs/W3 4.0, form entry areas in a page can be typed directly into. This is one of the main differences in navigation from version 2.0. If you are used to using the @kbd{f} and @kbd{b} keys to navigate around a buffer, I suggest training yourself to always use @@ -388,10 +388,7 @@ Pressing return when over a form input field can cause auto-submission of the form. This is for Mosaic and Netscape compatibility. If there is only one item in the form other than submit or reset buttons, then - -minibuffer for the data to insert into the input field. Type checking -is done, and the data is only entered into the form when data of the -correct type is entered (ie: cannot enter 44 for 'date' field, etc). +the form will be submitted. @kindex Middle Mouse Button @findex w3-follow-mouse
--- a/man/widget.texi Mon Aug 13 09:54:24 2007 +0200 +++ b/man/widget.texi Mon Aug 13 09:55:28 2007 +0200 @@ -13,7 +13,7 @@ @comment node-name, next, previous, up @top The Emacs Widget Library -Version: 1.9954 +Version: 1.9956 @menu * Introduction:: @@ -292,6 +292,10 @@ (make-local-variable 'widget-example-repeat) (let ((inhibit-read-only t)) (erase-buffer)) + (let ((all (overlay-lists))) + ;; Delete all the overlays. + (mapcar 'delete-overlay (car all)) + (mapcar 'delete-overlay (cdr all))) (widget-insert "Here is some documentation.\n\nName: ") (widget-create 'editable-field :size 13
--- a/src/EmacsFrame.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/EmacsFrame.c Mon Aug 13 09:55:28 2007 +0200 @@ -53,7 +53,7 @@ XtWidgetGeometry*); extern void -emacs_Xt_mapping_action (Widget w, XMappingEvent* event); +emacs_Xt_mapping_action (Widget w, XEvent* event); #undef XtOffset #define XtOffset(p_type,field) \ @@ -501,7 +501,7 @@ q = XrmStringToQuark (lowerName); toVal->size = sizeof (cvt_string_scrollbar_placement); - toVal->addr = (XtPointer) &cvt_string_scrollbar_placement; + toVal->addr = (XPointer) &cvt_string_scrollbar_placement; if (q == XrmStringToQuark ("top_left")) cvt_string_scrollbar_placement = XtTOP_LEFT;
--- a/src/EmacsFrameP.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/EmacsFrameP.h Mon Aug 13 09:55:28 2007 +0200 @@ -42,7 +42,7 @@ /* The rest of this is crap and should be deleted. */ Boolean minibuffer; /* 0: normal frames with minibuffers. - * 1: frames without minibuffers + * 1: frames without minibuffers * 2: minibuffer only. */ Boolean unsplittable; /* frame can only have one window */
--- a/src/EmacsShell-sub.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/EmacsShell-sub.c Mon Aug 13 09:55:28 2007 +0200 @@ -33,7 +33,7 @@ be a better name than "EmacsShell". What it does is work around a limitation in Xt in correctly dealing with the window-manager size hints with applications that - + (a) dynamically change their window size (b) have a cell size (width-inc and height-inc) other than 1 @@ -55,7 +55,7 @@ current size in cells (you must keep this up-to-date), and "minWidthCells" and "minHeightCells" to specify the minimum size in cells. - + Every time that the program issues a size command, the "baseWidth", "baseHeight", "minWidth", and "minHeight" fields of the WM_NORMAL_HINTS property will be updated to stay in @@ -116,8 +116,8 @@ #endif typedef struct { - XtPointer next_extension; - XrmQuark record_type; + XtPointer next_extension; + XrmQuark record_type; long version; Cardinal record_size; } GenericClassExtRec; @@ -128,7 +128,7 @@ /* snarfed from Shell.c */ #define BIGSIZE ((Dimension)32767) - + static XtResource resources[] = { #define offset(field) XtOffset(EMACS_SHELL_WIDGET, emacs_shell.field) #define coreoffset(field) XtOffset(EMACS_SHELL_WIDGET, core.field) @@ -194,9 +194,9 @@ /* resize */ XtInheritResize, /* expose */ NULL, /* set_values */ NULL, /* XtInheritSetValues, */ - /* set_values_hook */ NULL, - /* set_values_almost */ XtInheritSetValuesAlmost, - /* get_values_hook */ NULL, + /* set_values_hook */ NULL, + /* set_values_almost */ XtInheritSetValuesAlmost, + /* get_values_hook */ NULL, /* accept_focus */ NULL, /* intrinsics version */ XtVersion, /* callback offsets */ NULL, @@ -353,7 +353,7 @@ { Widget child = NULL; int i; - + /* the managed child indicates what our size is */ for (i = 0; i < w->composite.num_children; i++) { if (XtIsManaged(w->composite.children[i])) { @@ -361,7 +361,7 @@ break; } } - + update_size_hints_internal (w, child->core.width, child->core.height); } @@ -369,7 +369,7 @@ (((ShellWidgetClass) SUPERCLASS_WIDGET_CLASS)-> composite_class.change_managed)(wid); } - + /******************* external entry points *********************/
--- a/src/Makefile.in.in Mon Aug 13 09:54:24 2007 +0200 +++ b/src/Makefile.in.in Mon Aug 13 09:55:28 2007 +0200 @@ -285,8 +285,6 @@ touch release #endif /* ! defined (CANNOT_DUMP) */ -FRC.DOC: - xemacs: temacs ${libsrc}DOC $(mo_file) ${other_files} update-elc.stamp @$(RM) $@ && touch SATISFIED -$(DUMPENV) ./temacs -batch -l loadup.el dump @@ -310,10 +308,7 @@ cd ../dynodump && $(RECURSIVE_MAKE) #endif /* DYNODUMP */ -${libsrc}DOC: temacs -#ifdef NO_DOC_FILE - if test -f $@; then touch $@ && exit 0; fi; \ -#endif +${libsrc}DOC: temacs update-elc.stamp $(RM) ${libsrc}DOC; \ ${DUMPENV} ./temacs -batch -l ../prim/make-docfile.el -- \ -o ${libsrc}DOC -d ${srcdir} -i ${libsrc}../site-packages \
--- a/src/alloc.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/alloc.c Mon Aug 13 09:55:28 2007 +0200 @@ -369,18 +369,16 @@ #endif void * -xmalloc (int size) +xmalloc (size_t size) { - void *val; - - val = (void *) malloc (size); + void *val = (void *) malloc (size); if (!val && (size != 0)) memory_full (); return val; } void * -xmalloc_and_zero (int size) +xmalloc_and_zero (size_t size) { void *val = xmalloc (size); memset (val, 0, size); @@ -392,16 +390,11 @@ #endif void * -xrealloc (void *block, int size) +xrealloc (void *block, size_t size) { - void *val; - /* We must call malloc explicitly when BLOCK is 0, since some reallocs don't do this. */ - if (! block) - val = (void *) malloc (size); - else - val = (void *) realloc (block, size); + void *val = (void *) (block ? realloc (block, size) : malloc (size)); if (!val && (size != 0)) memory_full (); return val; @@ -469,13 +462,12 @@ char * xstrdup (CONST char *str) { - char *val; int len = strlen (str) + 1; /* for stupid terminating 0 */ - val = xmalloc (len); + void *val = xmalloc (len); if (val == 0) return 0; memcpy (val, str, len); - return val; + return (char *) val; } #ifdef NEED_STRDUP @@ -534,7 +526,7 @@ else if (implementation->static_size != size) abort (); - lcheader = allocate_lisp_storage (size); + lcheader = (struct lcrecord_header *) allocate_lisp_storage (size); lcheader->lheader.implementation = implementation; lcheader->next = all_lcrecords; #if 1 /* mly prefers to see small ID numbers */ @@ -626,9 +618,9 @@ int gc_record_type_p (Lisp_Object frob, CONST struct lrecord_implementation *type) { - return (XGCTYPE (frob) == Lisp_Record - && (XRECORD_LHEADER (frob)->implementation == type - || XRECORD_LHEADER (frob)->implementation == type + 1)); + return (XGCTYPE (frob) == Lisp_Type_Record + && (XRECORD_LHEADER (frob)->implementation == type || + XRECORD_LHEADER (frob)->implementation == type + 1)); } @@ -831,8 +823,8 @@ if (current_##type##_block_index \ == countof (current_##type##_block->block)) \ { \ - struct type##_block *__new__ \ - = allocate_lisp_storage (sizeof (struct type##_block)); \ + struct type##_block *__new__ = (struct type##_block *) \ + allocate_lisp_storage (sizeof (struct type##_block)); \ __new__->prev = current_##type##_block; \ current_##type##_block = __new__; \ current_##type##_block_index = 0; \ @@ -1155,7 +1147,7 @@ * +1 to account for vector_next */ + (sizei - 1 + 1) * sizeof (Lisp_Object) ); - struct Lisp_Vector *p = allocate_lisp_storage (sizem); + struct Lisp_Vector *p = (struct Lisp_Vector *) allocate_lisp_storage (sizem); #ifdef LRECORD_VECTOR set_lheader_implementation (&(p->lheader), lrecord_vector); #endif @@ -1342,7 +1334,8 @@ EMACS_INT sizem = (sizeof (struct Lisp_Bit_Vector) + /* -1 because struct Lisp_Bit_Vector includes 1 slot */ sizeof (long) * (BIT_VECTOR_LONG_STORAGE (sizei) - 1)); - struct Lisp_Bit_Vector *p = allocate_lisp_storage (sizem); + struct Lisp_Bit_Vector *p = + (struct Lisp_Bit_Vector *) allocate_lisp_storage (sizem); set_lheader_implementation (&(p->lheader), lrecord_bit_vector); INCREMENT_CONS_COUNTER (sizem, "bit-vector"); @@ -1850,8 +1843,7 @@ static void init_string_chars_alloc (void) { - first_string_chars_block = - (struct string_chars_block *) xmalloc (sizeof (struct string_chars_block)); + first_string_chars_block = xnew (struct string_chars_block); first_string_chars_block->prev = 0; first_string_chars_block->next = 0; first_string_chars_block->pos = 0; @@ -1882,9 +1874,7 @@ else { /* Make a new current string chars block */ - struct string_chars_block *new - = (struct string_chars_block *) - xmalloc (sizeof (struct string_chars_block)); + struct string_chars_block *new = xnew (struct string_chars_block); current_string_chars_block->next = new; new->prev = current_string_chars_block; @@ -2084,8 +2074,7 @@ if (oldlen != newlen) resize_string (s, bytoff, newlen - oldlen); - /* Remember, string_data (s) might have changed so we can't - cache it. */ + /* Remember, string_data (s) might have changed so we can't cache it. */ memcpy (string_data (s) + bytoff, newstr, newlen); } @@ -2156,29 +2145,15 @@ Lisp_Object build_string (CONST char *str) { - Bytecount length; - - /* Some strlen crash and burn if passed null. */ - if (!str) - length = 0; - else - length = strlen (str); - - return make_string ((CONST Bufbyte *) str, length); + /* Some strlen's crash and burn if passed null. */ + return make_string ((CONST Bufbyte *) str, (str ? strlen(str) : 0)); } Lisp_Object build_ext_string (CONST char *str, enum external_data_format fmt) { - Bytecount length; - - /* Some strlen crash and burn if passed null. */ - if (!str) - length = 0; - else - length = strlen (str); - - return make_ext_string ((Extbyte *) str, length, fmt); + /* Some strlen's crash and burn if passed null. */ + return make_ext_string ((Extbyte *) str, (str ? strlen(str) : 0), fmt); } Lisp_Object @@ -2265,8 +2240,8 @@ make_lcrecord_list (int size, CONST struct lrecord_implementation *implementation) { - struct lcrecord_list *p = alloc_lcrecord (sizeof (*p), - lrecord_lcrecord_list); + struct lcrecord_list *p = alloc_lcrecord_type (struct lcrecord_list, + lrecord_lcrecord_list); Lisp_Object val = Qnil; p->implementation = implementation; @@ -2310,11 +2285,11 @@ } else { - Lisp_Object foo = Qnil; - - XSETOBJ (foo, Lisp_Record, + Lisp_Object val = Qnil; + + XSETOBJ (val, Lisp_Type_Record, alloc_lcrecord (list->size, list->implementation)); - return foo; + return val; } } @@ -2562,16 +2537,17 @@ switch (XTYPE (obj)) { - case Lisp_Cons: + case Lisp_Type_Cons: return pure_cons (XCAR (obj), XCDR (obj)); - case Lisp_String: + case Lisp_Type_String: return make_pure_string (XSTRING_DATA (obj), XSTRING_LENGTH (obj), XSTRING (obj)->plist, 0); - case Lisp_Vector: +#ifndef LRECORD_VECTOR + case Lisp_Type_Vector: { struct Lisp_Vector *o = XVECTOR (obj); Lisp_Object new = make_pure_vector (vector_length (o), Qnil); @@ -2579,6 +2555,7 @@ XVECTOR_DATA (new)[i] = Fpurecopy (o->contents[i]); return new; } +#endif /* !LRECORD_VECTOR */ default: { @@ -2803,7 +2780,7 @@ return; switch (XGCTYPE (obj)) { - case Lisp_Cons: + case Lisp_Type_Cons: { struct Lisp_Cons *ptr = XCONS (obj); if (CONS_MARKED_P (ptr)) @@ -2822,7 +2799,7 @@ goto tail_recurse; } - case Lisp_Record: + case Lisp_Type_Record: /* case Lisp_Symbol_Value_Magic: */ { struct lrecord_header *lheader = XRECORD_LHEADER (obj); @@ -2846,7 +2823,7 @@ } break; - case Lisp_String: + case Lisp_Type_String: { struct Lisp_String *ptr = XSTRING (obj); @@ -2862,7 +2839,8 @@ } break; - case Lisp_Vector: +#ifndef LRECORD_VECTOR + case Lisp_Type_Vector: { struct Lisp_Vector *ptr = XVECTOR (obj); int len = vector_length (ptr); @@ -2880,9 +2858,10 @@ } } break; +#endif /* !LRECORD_VECTOR */ #ifndef LRECORD_SYMBOL - case Lisp_Symbol: + case Lisp_Type_Symbol: { struct Lisp_Symbol *sym = XSYMBOL (obj); @@ -2972,7 +2951,7 @@ switch (XTYPE (obj)) { - case Lisp_String: + case Lisp_Type_String: { struct Lisp_String *ptr = XSTRING (obj); int size = string_length (ptr); @@ -2993,7 +2972,8 @@ } break; - case Lisp_Vector: +#ifndef LRECORD_VECTOR + case Lisp_Type_Vector: { struct Lisp_Vector *ptr = XVECTOR (obj); int len = vector_length (ptr); @@ -3016,8 +2996,9 @@ #endif /* unused */ } break; - - case Lisp_Record: +#endif /* !LRECORD_SYMBOL */ + + case Lisp_Type_Record: { struct lrecord_header *lheader = XRECORD_LHEADER (obj); CONST struct lrecord_implementation *implementation @@ -3047,7 +3028,7 @@ } break; - case Lisp_Cons: + case Lisp_Type_Cons: { struct Lisp_Cons *ptr = XCONS (obj); total += sizeof (*ptr); @@ -3809,16 +3790,18 @@ if (PURIFIED (XPNTR (obj))) return 1; switch (XGCTYPE (obj)) { - case Lisp_Cons: + case Lisp_Type_Cons: return XMARKBIT (XCAR (obj)); - case Lisp_Record: + case Lisp_Type_Record: return MARKED_RECORD_HEADER_P (XRECORD_LHEADER (obj)); - case Lisp_String: + case Lisp_Type_String: return XMARKBIT (XSTRING (obj)->plist); - case Lisp_Vector: +#ifndef LRECORD_VECTOR + case Lisp_Type_Vector: return XVECTOR_LENGTH (obj) < 0; +#endif /* !LRECORD_VECTOR */ #ifndef LRECORD_SYMBOL - case Lisp_Symbol: + case Lisp_Type_Symbol: return XMARKBIT (XSYMBOL (obj)->plist); #endif default:
--- a/src/alloca.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/alloca.c Mon Aug 13 09:55:28 2007 +0200 @@ -76,7 +76,7 @@ /* XEmacs: With ERROR_CHECK_MALLOC defined, there is no xfree -- it's a macro that does some stuff to try and trap invalid frees, and then calls xfree_1 to actually do the work. */ - + #ifdef emacs # ifdef ERROR_CHECK_MALLOC void xfree_1 (pointer);
--- a/src/blocktype.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/blocktype.c Mon Aug 13 09:55:28 2007 +0200 @@ -79,7 +79,7 @@ void * Blocktype_newf (int elsize) { - Blocktype *b = (Blocktype *) xmalloc (sizeof (*b)); + Blocktype *b = xnew (Blocktype); b->elsize = max (elsize, sizeof (void *)); b->free = 0; return (void *) b;
--- a/src/buffer.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/buffer.c Mon Aug 13 09:55:28 2007 +0200 @@ -561,7 +561,7 @@ static struct buffer * allocate_buffer (void) { - struct buffer *b = alloc_lcrecord (sizeof (struct buffer), lrecord_buffer); + struct buffer *b = alloc_lcrecord_type (struct buffer, lrecord_buffer); copy_lcrecord (b, XBUFFER (Vbuffer_defaults)); @@ -1428,7 +1428,7 @@ DEFUN ("record-buffer", Frecord_buffer, 1, 1, 0, /* Place buffer BUF first in the buffer order. -Call this function when a buffer is selected \"visibly\". +Call this function when a buffer is selected "visibly". This function changes the global buffer order and the per-frame buffer order for the selected frame. The buffer order keeps track of recency @@ -2094,35 +2094,35 @@ /* Declaring this stuff as const produces 'Cannot reinitialize' messages from SunPro C's fix-and-continue feature (a way neato feature that makes debugging unbelievably more bearable) */ -#define DEFVAR_BUFFER_LOCAL(lname, field_name) \ - do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { { lrecord_symbol_value_forward }, \ - (void *) &(buffer_local_flags.field_name), 69 }, \ - SYMVAL_CURRENT_BUFFER_FORWARD }, 0 }; \ +#define DEFVAR_BUFFER_LOCAL(lname, field_name) do { \ +static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ + = { { { { lrecord_symbol_value_forward }, \ + (struct lcrecord_header *) &(buffer_local_flags.field_name), 69 }, \ + SYMVAL_CURRENT_BUFFER_FORWARD }, 0 }; \ defvar_buffer_local ((lname), &I_hate_C); \ } while (0) -#define DEFVAR_BUFFER_LOCAL_MAGIC(lname, field_name, magicfun) \ - do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { { lrecord_symbol_value_forward }, \ - (void *) &(buffer_local_flags.field_name), 69 }, \ - SYMVAL_CURRENT_BUFFER_FORWARD }, magicfun }; \ +#define DEFVAR_BUFFER_LOCAL_MAGIC(lname, field_name, magicfun) do { \ +static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ + = { { { { lrecord_symbol_value_forward }, \ + (struct lcrecord_header *) &(buffer_local_flags.field_name), 69 }, \ + SYMVAL_CURRENT_BUFFER_FORWARD }, magicfun }; \ defvar_buffer_local ((lname), &I_hate_C); \ } while (0) -#define DEFVAR_CONST_BUFFER_LOCAL(lname, field_name) \ - do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { { lrecord_symbol_value_forward }, \ - (void *) &(buffer_local_flags.field_name), 69 }, \ - SYMVAL_CONST_CURRENT_BUFFER_FORWARD }, 0 }; \ +#define DEFVAR_CONST_BUFFER_LOCAL(lname, field_name) do { \ +static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ + = { { { { lrecord_symbol_value_forward }, \ + (struct lcrecord_header *) &(buffer_local_flags.field_name), 69 }, \ + SYMVAL_CONST_CURRENT_BUFFER_FORWARD }, 0 }; \ defvar_buffer_local ((lname), &I_hate_C); \ } while (0) -#define DEFVAR_CONST_BUFFER_LOCAL_MAGIC(lname, field_name, magicfun) \ - do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { { lrecord_symbol_value_forward }, \ - (void *) &(buffer_local_flags.field_name), 69 }, \ - SYMVAL_CONST_CURRENT_BUFFER_FORWARD }, magicfun }; \ +#define DEFVAR_CONST_BUFFER_LOCAL_MAGIC(lname, field_name, magicfun) do{\ +static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ + = { { { { lrecord_symbol_value_forward }, \ + (struct lcrecord_header *) &(buffer_local_flags.field_name), 69 }, \ + SYMVAL_CONST_CURRENT_BUFFER_FORWARD }, magicfun }; \ defvar_buffer_local ((lname), &I_hate_C); \ } while (0) @@ -2141,19 +2141,19 @@ /* DOC is ignored because it is snagged and recorded externally * by make-docfile */ -#define DEFVAR_BUFFER_DEFAULTS(lname, field_name) \ - do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { { lrecord_symbol_value_forward }, \ - (void *) &(buffer_local_flags.field_name), 69 }, \ - SYMVAL_DEFAULT_BUFFER_FORWARD }, 0 }; \ +#define DEFVAR_BUFFER_DEFAULTS(lname, field_name) do { \ +static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ + = { { { { lrecord_symbol_value_forward }, \ + (struct lcrecord_header *) &(buffer_local_flags.field_name), 69 }, \ + SYMVAL_DEFAULT_BUFFER_FORWARD }, 0 }; \ defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C)); \ } while (0) -#define DEFVAR_BUFFER_DEFAULTS_MAGIC(lname, field_name, magicfun) \ - do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { { lrecord_symbol_value_forward }, \ - (void *) &(buffer_local_flags.field_name), 69 }, \ - SYMVAL_DEFAULT_BUFFER_FORWARD }, magicfun }; \ +#define DEFVAR_BUFFER_DEFAULTS_MAGIC(lname, field_name, magicfun) do { \ +static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ + = { { { { lrecord_symbol_value_forward }, \ + (struct lcrecord_header *) &(buffer_local_flags.field_name), 69 }, \ + SYMVAL_DEFAULT_BUFFER_FORWARD }, magicfun }; \ defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C)); \ } while (0) @@ -2171,12 +2171,9 @@ complex_vars_of_buffer (void) { /* Make sure all markable slots in buffer_defaults - are initialized reasonably, so mark_buffer won't choke. - */ - struct buffer *defs = alloc_lcrecord (sizeof (struct buffer), - lrecord_buffer); - struct buffer *syms = alloc_lcrecord (sizeof (struct buffer), - lrecord_buffer); + are initialized reasonably, so mark_buffer won't choke. */ + struct buffer *defs = alloc_lcrecord_type (struct buffer, lrecord_buffer); + struct buffer *syms = alloc_lcrecord_type (struct buffer, lrecord_buffer); staticpro (&Vbuffer_defaults); staticpro (&Vbuffer_local_symbols); @@ -2189,8 +2186,7 @@ syms->text = &syms->own_text; /* Set up the non-nil default values of various buffer slots. - Must do these before making the first buffer. - */ + Must do these before making the first buffer. */ defs->major_mode = Qfundamental_mode; defs->mode_name = QSFundamental; defs->abbrev_table = Qnil; /* real default setup by Lisp code */ @@ -2531,7 +2527,7 @@ `escape-quoted', which is equivalent to `iso-2022-8' but prefixes certain control characters with ESC to make sure they are not interpreted as escape sequences when read in. This latter coding -system results in more \"correct\" output in the presence of control +system results in more "correct" output in the presence of control characters in the buffer, in the sense that when read in again using the same coding system, the result will virtually always match the original contents of the buffer, which is not the case with @@ -2658,7 +2654,7 @@ of the text being deleted; if negative, point was at the end. An entry (t HIGH . LOW) indicates that the buffer previously had -\"unmodified\" status. HIGH and LOW are the high and low 16-bit portions +"unmodified" status. HIGH and LOW are the high and low 16-bit portions of the visited file's modification time, as of that time. If the modification time of the most recent save is different, this entry is obsolete. @@ -2739,7 +2735,7 @@ then characters with property value PROP are invisible, and they have an ellipsis as well if ELLIPSIS is non-nil. Note that the actual characters used for the ellipsis are controllable -using `invisible-text-glyph', and default to \"...\". +using `invisible-text-glyph', and default to "...". */, redisplay_variable_changed); DEFVAR_CONST_BUFFER_LOCAL ("generated-modeline-string",
--- a/src/buffer.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/buffer.h Mon Aug 13 09:55:28 2007 +0200 @@ -76,7 +76,7 @@ struct buffer_text { - Bufbyte *beg; /* Actual address of buffer contents. */ + Bufbyte *beg; /* Actual address of buffer contents. */ Bytind gpt; /* Index of gap in buffer. */ Bytind z; /* Index of end of buffer. */ Bufpos bufz; /* Equivalent as a Bufpos. */ @@ -627,19 +627,19 @@ /* None of these are lvalues. Use the settor macros below to change the positions. */ -/* Beginning of buffer. */ +/* Beginning of buffer. */ #define BI_BUF_BEG(buf) ((Bytind) 1) #define BUF_BEG(buf) ((Bufpos) 1) -/* Beginning of accessible range of buffer. */ +/* Beginning of accessible range of buffer. */ #define BI_BUF_BEGV(buf) ((buf)->begv + 0) #define BUF_BEGV(buf) ((buf)->bufbegv + 0) -/* End of accessible range of buffer. */ +/* End of accessible range of buffer. */ #define BI_BUF_ZV(buf) ((buf)->zv + 0) #define BUF_ZV(buf) ((buf)->bufzv + 0) -/* End of buffer. */ +/* End of buffer. */ #define BI_BUF_Z(buf) ((buf)->text->z + 0) #define BUF_Z(buf) ((buf)->text->bufz + 0) @@ -1017,7 +1017,7 @@ means that the size of the known region can be at most 64K for width-three characters. */ - + extern short three_to_one_table[]; INLINE int real_bufpos_to_bytind (struct buffer *buf, Bufpos x); @@ -1164,11 +1164,11 @@ safety of knowing your string data won't be relocated out from under you. */ - - + + /* Maybe convert charptr's data into ext-format and store the result in alloca()'ed space. - + You may wonder why this is written in this fashion and not as a function call. With a little trickery it could certainly be written this way, but it won't work because of those DAMN GCC WANKERS @@ -1177,7 +1177,7 @@ a function call, the stack space gets allocated right in the middle of the arguments to the function call and you are unbelievably hosed.) */ - + #ifdef MULE #define GET_CHARPTR_EXT_DATA_ALLOCA(ptr, len, fmt, stick_value_here, stick_len_here) \ @@ -1257,7 +1257,7 @@ /* Maybe convert external charptr's data into internal format and store the result in alloca()'ed space. - + You may wonder why this is written in this fashion and not as a function call. With a little trickery it could certainly be written this way, but it won't work because of those DAMN GCC WANKERS @@ -1266,7 +1266,7 @@ a function call, the stack space gets allocated right in the middle of the arguments to the function call and you are unbelievably hosed.) */ - + #ifdef MULE #define GET_CHARPTR_INT_DATA_ALLOCA(ptr, len, fmt, stick_value_here, stick_len_here)\ @@ -1456,7 +1456,7 @@ /* Settor macros for important positions in a buffer */ /*----------------------------------------------------------------------*/ -/* Set beginning of accessible range of buffer. */ +/* Set beginning of accessible range of buffer. */ #define SET_BOTH_BUF_BEGV(buf, val, bival) \ do \ { \ @@ -1464,7 +1464,7 @@ (buf)->bufbegv = (val); \ } while (0) -/* Set end of accessible range of buffer. */ +/* Set end of accessible range of buffer. */ #define SET_BOTH_BUF_ZV(buf, val, bival) \ do \ { \ @@ -1624,21 +1624,21 @@ #ifdef REL_ALLOC -char *r_alloc (char **, unsigned long); -char *r_re_alloc (char **, unsigned long); -void r_alloc_free (void **); +char *r_alloc (unsigned char **, unsigned long); +char *r_re_alloc (unsigned char **, unsigned long); +void r_alloc_free (unsigned char **); -#define BUFFER_ALLOC(data,size) \ - ((Bufbyte *) r_alloc ((char **) &data, (size) * sizeof(Bufbyte))) -#define BUFFER_REALLOC(data,size) \ - ((Bufbyte *) r_re_alloc ((char **) &data, (size) * sizeof(Bufbyte))) -#define BUFFER_FREE(data) r_alloc_free ((void **) &(data)) +#define BUFFER_ALLOC(data, size) \ + ((Bufbyte *) r_alloc ((unsigned char **) &data, (size) * sizeof(Bufbyte))) +#define BUFFER_REALLOC(data, size) \ + ((Bufbyte *) r_re_alloc ((unsigned char **) &data, (size) * sizeof(Bufbyte))) +#define BUFFER_FREE(data) r_alloc_free ((unsigned char **) &(data)) #define R_ALLOC_DECLARE(var,data) r_alloc_declare (&(var), data) #else /* !REL_ALLOC */ #define BUFFER_ALLOC(data,size)\ - (data = (Bufbyte *) xmalloc ((size) * sizeof(Bufbyte))) + ((void) (data = xnew_array (Bufbyte, size))) #define BUFFER_REALLOC(data,size)\ ((Bufbyte *) xrealloc (data, (size) * sizeof(Bufbyte))) /* Avoid excess parentheses, or syntax errors may rear their heads. */ @@ -1667,12 +1667,12 @@ int emchar_string_displayed_columns (CONST Emchar *str, Charcount len); void convert_bufbyte_string_into_emchar_dynarr (CONST Bufbyte *str, Bytecount len, - emchar_dynarr *dyn); + Emchar_dynarr *dyn); int convert_bufbyte_string_into_emchar_string (CONST Bufbyte *str, Bytecount len, Emchar *arr); void convert_emchar_string_into_bufbyte_dynarr (Emchar *arr, int nels, - bufbyte_dynarr *dyn); + Bufbyte_dynarr *dyn); Bufbyte *convert_emchar_string_into_malloced_string (Emchar *arr, int nels, Bytecount *len_out);
--- a/src/bytecode.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/bytecode.c Mon Aug 13 09:55:28 2007 +0200 @@ -294,7 +294,7 @@ vector = wrong_type_argument (Qvectorp, vector); CHECK_NATNUM (maxdepth); - stackp = (Lisp_Object *) alloca (XINT (maxdepth) * sizeof (Lisp_Object)); + stackp = alloca_array (Lisp_Object, XINT (maxdepth)); memset (stackp, 0, XINT (maxdepth) * sizeof (Lisp_Object)); GCPRO3 (bytestr, vector, *stackp); gcpro3.nvars = XINT (maxdepth); @@ -305,9 +305,8 @@ /* Initialize the pc-register and convert the string into a fixed-width format for easier processing. */ - massaged_code = - (Emchar *) alloca (sizeof (Emchar) * - (1 + string_char_length (XSTRING (bytestr)))); + massaged_code = alloca_array (Emchar, + 1 + string_char_length (XSTRING (bytestr))); massaged_code_len = convert_bufbyte_string_into_emchar_string (XSTRING_DATA (bytestr), XSTRING_LENGTH (bytestr), @@ -1055,7 +1054,7 @@ #if 0 /* probably this code is OK, but nth_entry is commented out above --ben */ - if (XTYPE (TOP) == Lisp_Cons) + if (XTYPE (TOP) == Lisp_Type_Cons) { /* Exchange args and then do nth. */ v2 = POP;
--- a/src/bytecode.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/bytecode.h Mon Aug 13 09:55:28 2007 +0200 @@ -42,29 +42,29 @@ #define COMPILED_FUNCTION_ANNOTATION_HACK struct Lisp_Compiled_Function +{ + struct lrecord_header lheader; + unsigned short maxdepth; + struct { - struct lrecord_header lheader; - unsigned short maxdepth; - struct - { - unsigned int documentationp: 1; - unsigned int interactivep: 1; - /* Only used if I18N3, but always defined for simplicity. */ - unsigned int domainp: 1; - /* Non-zero if this bytecode came from a v18 or v19 file. - We need to Ebolify the `assoc', `delq', etc. functions. */ - unsigned int ebolified: 1; - } flags; - Lisp_Object bytecodes; - Lisp_Object constants; - Lisp_Object arglist; - /* This uses the minimal number of conses; see accessors in data.c. */ - Lisp_Object doc_and_interactive; + unsigned int documentationp: 1; + unsigned int interactivep: 1; + /* Only used if I18N3, but always defined for simplicity. */ + unsigned int domainp: 1; + /* Non-zero if this bytecode came from a v18 or v19 file. + We need to Ebolify the `assoc', `delq', etc. functions. */ + unsigned int ebolified: 1; + } flags; + Lisp_Object bytecodes; + Lisp_Object constants; + Lisp_Object arglist; + /* This uses the minimal number of conses; see accessors in data.c. */ + Lisp_Object doc_and_interactive; #ifdef COMPILED_FUNCTION_ANNOTATION_HACK - /* Something indicating where the bytecode came from */ - Lisp_Object annotated; + /* Something indicating where the bytecode came from */ + Lisp_Object annotated; #endif - }; +}; Lisp_Object compiled_function_documentation (struct Lisp_Compiled_Function *b); Lisp_Object compiled_function_interactive (struct Lisp_Compiled_Function *b); @@ -91,15 +91,15 @@ neither args : (* 559 0) = 0 = 3962 combined overhead : (* 1765 1) = 1765 - doc-and-int (doc . int) : (* 775 2) = 1550 + doc-and-int (doc . int) : (* 775 2) = 1550 doc-only doc : (* 389 0) = 0 - int-only int : (* 42 0) = 0 + int-only int : (* 42 0) = 0 neither - : (* 559 0) = 0 = 3315 both overhead : (* 1765 2) = 3530 doc-and-int - : (* 775 0) = 0 doc-only - : (* 389 0) = 0 - int-only - : (* 42 0) = 0 + int-only - : (* 42 0) = 0 neither - : (* 559 0) = 0 = 3530 */
--- a/src/callint.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/callint.c Mon Aug 13 09:55:28 2007 +0200 @@ -83,9 +83,9 @@ DEFUN ("interactive", Finteractive, 0, UNEVALLED, 0, /* Specify a way of parsing arguments for interactive use of a function. For example, write - (defun foo (arg) \"Doc string\" (interactive \"p\") ...use arg...) + (defun foo (arg) "Doc string" (interactive "p") ...use arg...) to make ARG be the prefix argument when `foo' is called as a command. -The \"call\" to `interactive' is actually a declaration rather than a function; +The "call" to `interactive' is actually a declaration rather than a function; it tells `call-interactively' how to read arguments to pass to the function. When actually called, `interactive' just returns nil. @@ -194,7 +194,7 @@ struct gcpro gcpro1; /* Fformat no longer smashes its arg vector, so no need to copy it. */ - + if (!strchr ((char *) XSTRING_DATA (s), '%')) return s; GCPRO1 (s); @@ -372,10 +372,10 @@ if (CONSP (elt)) { Lisp_Object eltcar = Fcar (elt); - if (EQ (eltcar, Qpoint) - || EQ (eltcar, Qmark) - || EQ (eltcar, Qregion_beginning) - || EQ (eltcar, Qregion_end)) + if (EQ (eltcar, Qpoint) || + EQ (eltcar, Qmark) || + EQ (eltcar, Qregion_beginning) || + EQ (eltcar, Qregion_end)) Fsetcar (valtail, Fcar (intail)); } } @@ -420,7 +420,7 @@ { if (STRINGP (specs)) prompt_data = (CONST char *) XSTRING_DATA (specs); - + if (prompt_data[prompt_index] == '+') error ("`+' is not used in `interactive' for ordinary commands"); else if (prompt_data[prompt_index] == '*') @@ -443,7 +443,7 @@ /* Doesn't work; see below */ event = Vcurrent_mouse_event; #endif - if (! NILP (event)) + if (! NILP (event)) { Lisp_Object window = Fevent_window (event); if (!NILP (window)) @@ -533,11 +533,9 @@ + argcount /* visargs */ + argcount /* varies */ ); - Lisp_Object *args - = (((Lisp_Object *) alloca (sizeof (Lisp_Object) * alloca_size)) - + 1); + Lisp_Object *args = alloca_array (Lisp_Object, alloca_size) + 1; /* visargs is an array of either Qnil or user-friendlier versions (often - * strings) of previous arguments, to use in prompts for succesive + * strings) of previous arguments, to use in prompts for successive * arguments. ("Often strings" because emacs didn't used to have * format %S and prin1-to-string.) */ Lisp_Object *visargs = args + argcount; @@ -564,7 +562,7 @@ CONST char *prompt_start = prompt_data + prompt_index + 1; CONST char *prompt_limit = (CONST char *) strchr (prompt_start, '\n'); int prompt_length; - prompt_length = ((prompt_limit) + prompt_length = ((prompt_limit) ? (prompt_limit - prompt_start) : strlen (prompt_start)); if (prompt_limit && prompt_limit[1] == 0) @@ -815,7 +813,7 @@ args[argnum] = tem; if (string_length (XSYMBOL (tem)->name) > 0) /* Don't accept the empty-named symbol. If the loser - really wants this s/he can call completing-read + really wants this s/he can call completing-read directly */ break; } @@ -852,7 +850,7 @@ { args[argnum] = Qnil; } - else + else { args[argnum] = call1 (Qread_non_nil_coding_system, PROMPT ()); @@ -902,7 +900,7 @@ { RETURN_UNGCPRO (Flist (argcount, args)); } - + if (arg_from_tty || !NILP (record_flag)) { /* Reuse visargs as a temporary for constructing the command history */ @@ -935,26 +933,21 @@ DEFUN ("prefix-numeric-value", Fprefix_numeric_value, 1, 1, 0, /* Return numeric meaning of raw prefix argument ARG. -A raw prefix argument is what you get from `(interactive \"P\")'. -Its numeric meaning is what you would get from `(interactive \"p\")'. +A raw prefix argument is what you get from `(interactive "P")'. +Its numeric meaning is what you would get from `(interactive "p")'. */ (raw)) { - int val; + if (NILP (raw)) + return make_int (1); + if (EQ (raw, Qminus)) + return make_int (-1); + if (INTP (raw)) + return raw; + if (CONSP (raw) && INTP (XCAR (raw))) + return XCAR (raw); - if (NILP (raw)) - val = 1; - else if (EQ (raw, Qminus)) - val = -1; - else if (INTP (raw)) - val = XINT (raw); - else if (CONSP (raw) && INTP (XCAR (raw))) - val = XINT (XCAR (raw)); - else - val = 1; - - return make_int (val); - + return make_int (1); } void @@ -1003,7 +996,7 @@ It may be a number, or the symbol `-' for just a minus sign as arg, or a list whose car is a number for just one or more C-U's or nil if no argument has been specified. -This is what `(interactive \"P\")' returns. +This is what `(interactive "P")' returns. */ ); Vcurrent_prefix_arg = Qnil; @@ -1021,7 +1014,7 @@ Vcommand_debug_status = Qnil; #if 0 /* FSFmacs */ - xxDEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive /* + xxDEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive /* *Non-nil means you can use the mark even when inactive. This option makes a difference in Transient Mark mode. When the option is non-nil, deactivation of the mark
--- a/src/callproc.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/callproc.c Mon Aug 13 09:55:28 2007 +0200 @@ -99,7 +99,7 @@ if (!NILP (pid)) EMACS_KILLPG (XINT (pid), SIGKILL); - + synch_process_alive = 0; return Qnil; } @@ -187,8 +187,8 @@ int bufsize = 16384; int speccount = specpdl_depth (); struct gcpro gcpro1; - char **new_argv = (char **) alloca ((max (2, nargs - 2)) * sizeof (char *)); - + char **new_argv = alloca_array (char *, max (2, nargs - 2)); + /* File to use for stderr in the child. t means use same as standard output. */ Lisp_Object error_file; @@ -196,7 +196,7 @@ char *outf, *tempfile; int outfilefd; #endif /* MSDOS */ - + CHECK_STRING (args[0]); error_file = Qt; @@ -217,7 +217,7 @@ chdir, since it's in a vfork. */ { struct gcpro ngcpro1, ngcpro2; - /* Do this test before building new_argv because GC in Lisp code + /* Do this test before building new_argv because GC in Lisp code * called by various filename-hacking routines might relocate strings */ /* Make sure that the child will be able to chdir to the current buffer's current directory. We can't just have the child check @@ -285,7 +285,7 @@ CHECK_BUFFER (buffer); } } - else + else buffer = Qnil; UNGCPRO; @@ -306,7 +306,7 @@ if (NILP (path)) report_file_error ("Searching for program", Fcons (args[0], Qnil)); new_argv[0] = (char *) XSTRING_DATA (path); - + filefd = open ((char *) XSTRING_DATA (infile), O_RDONLY, 0); if (filefd < 0) report_file_error ("Opening process input file", Fcons (infile, Qnil)); @@ -326,7 +326,7 @@ *tempfile = '\0'; } dostounix_filename (tempfile); - if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/') + if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/') strcat (tempfile, "/"); strcat (tempfile, "detmp.XXX"); mktemp (tempfile); @@ -360,12 +360,12 @@ if (INTP (buffer)) outf = NULL_DEVICE; - else + else { - /* DOS can't create pipe for interprocess communication, + /* DOS can't create pipe for interprocess communication, so redirect child process's standard output to temporary file and later read the file. */ - + if ((outf = egetenv ("TMP")) || (outf = egetenv ("TEMP"))) { strcpy (tempfile, outf); @@ -453,7 +453,7 @@ fork_error = Qnil; #ifdef WINDOWSNT - pid = child_setup (filefd, fd1, fd_error, new_argv, + pid = child_setup (filefd, fd1, fd_error, new_argv, (char *) XSTRING_DATA (current_dir)); #else /* not WINDOWSNT */ pid = fork (); @@ -576,7 +576,7 @@ break; total_read += nread; - + if (!NILP (buffer)) buffer_insert_raw_string (XBUFFER (buffer), (Bufbyte *) bufptr, nread); @@ -681,7 +681,7 @@ REGISTER int i; i = strlen (current_dir); - pwd = (char *) alloca (i + 6); + pwd = alloca_array (char, i + 6); memcpy (pwd, "PWD=", 4); memcpy (pwd + 4, current_dir, i); i += 4; @@ -723,7 +723,7 @@ new_length++; /* new_length + 2 to include PWD and terminating 0. */ - env = new_env = (char **) alloca ((new_length + 2) * sizeof (char *)); + env = new_env = alloca_array (char *, new_length + 2); /* If we have a PWD envvar and we know the real current directory, pass one down, but with corrected value. */ @@ -797,7 +797,7 @@ dup2 (in, 0); dup2 (out, 1); dup2 (err, 2); - + close (in); close (out); close (err); @@ -875,7 +875,7 @@ for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan)) { Lisp_Object entry = XCAR (scan); - + if (STRINGP (entry) && XSTRING_LENGTH (entry) > varlen && XSTRING_BYTE (entry, varlen) == '=' @@ -973,7 +973,7 @@ char *data_dir = egetenv ("EMACSDATA"); char *site_dir = egetenv ("EMACSSITE"); char *doc_dir = egetenv ("EMACSDOC"); - + #ifdef PATH_DATA if (!data_dir) data_dir = (char *) PATH_DATA; @@ -986,7 +986,7 @@ if (!site_dir) site_dir = (char *) PATH_SITE; #endif - + if (data_dir) Vdata_directory = Ffile_name_as_directory (build_string (data_dir)); @@ -1059,7 +1059,7 @@ #endif } } - + if (!NILP (Vsite_directory)) { tempdir = Fdirectory_file_name (Vsite_directory); @@ -1077,7 +1077,7 @@ #endif } } - + #ifdef PATH_PREFIX Vprefix_directory = build_string ((char *) PATH_PREFIX); #else @@ -1095,7 +1095,7 @@ char *tem; /* ** If COMSPEC has been set, then convert the - ** DOS formatted name into a UNIX format. Then + ** DOS formatted name into a UNIX format. Then ** create a LISP object. */ if (sh) @@ -1116,7 +1116,7 @@ #else /* not VMS or WINDOWSNT */ sh = (char *) egetenv ("SHELL"); Vshell_file_name = build_string (sh ? sh : "/bin/sh"); -#endif +#endif } #if 0
--- a/src/casefiddle.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/casefiddle.c Mon Aug 13 09:55:28 2007 +0200 @@ -172,7 +172,7 @@ end_multiple_change (buf, mccount); } -INLINE Lisp_Object +static Lisp_Object casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e, Lisp_Object buffer) {
--- a/src/casetab.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/casetab.c Mon Aug 13 09:55:28 2007 +0200 @@ -84,7 +84,7 @@ while (tem = Fcase_table_p (obj), NILP (tem)) obj = wrong_type_argument (Qcase_table_p, obj); return (obj); -} +} DEFUN ("current-case-table", Fcurrent_case_table, 0, 1, 0, /* Return the case table of BUFFER, which defaults to the current buffer. @@ -93,7 +93,7 @@ { Lisp_Object down, up, canon, eqv; struct buffer *buf = decode_buffer (buffer, 0); - + down = buf->downcase_table; up = buf->upcase_table; canon = buf->case_canon_table; @@ -327,7 +327,7 @@ SET_TRT_TABLE_CHAR_1 (tem, i, lowered); } - + #ifdef MULE tem = make_mirror_trt_table (tem); Vmirror_ascii_downcase_table = tem; @@ -337,7 +337,7 @@ tem = MAKE_TRT_TABLE (); Vascii_upcase_table = tem; Vascii_eqv_table = tem; - + for (i = 0; i < 256; i++) { unsigned char flipped = (isupper (i) ? tolower (i)
--- a/src/chartab.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/chartab.c Mon Aug 13 09:55:28 2007 +0200 @@ -590,8 +590,7 @@ Lisp_Object obj = Qnil; enum char_table_type ty = symbol_to_char_table_type (type); - ct = (struct Lisp_Char_Table *) - alloc_lcrecord (sizeof (struct Lisp_Char_Table), lrecord_char_table); + ct = alloc_lcrecord_type (struct Lisp_Char_Table, lrecord_char_table); ct->type = ty; if (ty == CHAR_TABLE_TYPE_SYNTAX) { @@ -619,9 +618,8 @@ Lisp_Object obj = Qnil; int i; - cte = (struct Lisp_Char_Table_Entry *) - alloc_lcrecord (sizeof (struct Lisp_Char_Table_Entry), - lrecord_char_table_entry); + cte = alloc_lcrecord_type (struct Lisp_Char_Table_Entry, + lrecord_char_table_entry); for (i = 0; i < 96; i++) cte->level2[i] = initval; XSETCHAR_TABLE_ENTRY (obj, cte); @@ -632,13 +630,12 @@ copy_char_table_entry (Lisp_Object entry) { struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry); - struct Lisp_Char_Table_Entry *ctenew; Lisp_Object obj = Qnil; int i; + struct Lisp_Char_Table_Entry *ctenew = + alloc_lcrecord_type (struct Lisp_Char_Table_Entry, + lrecord_char_table_entry); - ctenew = (struct Lisp_Char_Table_Entry *) - alloc_lcrecord (sizeof (struct Lisp_Char_Table_Entry), - lrecord_char_table_entry); for (i = 0; i < 96; i++) { Lisp_Object new = cte->level2[i]; @@ -667,8 +664,7 @@ CHECK_CHAR_TABLE (old_table); ct = XCHAR_TABLE (old_table); - ctnew = (struct Lisp_Char_Table *) - alloc_lcrecord (sizeof (struct Lisp_Char_Table), lrecord_char_table); + ctnew = alloc_lcrecord_type (struct Lisp_Char_Table, lrecord_char_table); ctnew->type = ct->type; for (i = 0; i < NUM_ASCII_CHARS; i++) @@ -1561,8 +1557,8 @@ There are 95 different categories available, one for each printable character (including space) in the ASCII charset. Each category -is designated by one such character, called a \"category designator\". -They are specified in a regexp using the syntax \"\\cX\", where X is +is designated by one such character, called a "category designator". +They are specified in a regexp using the syntax "\\cX", where X is a category designator. A category table specifies, for each character, the categories that
--- a/src/chartab.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/chartab.h Mon Aug 13 09:55:28 2007 +0200 @@ -136,9 +136,8 @@ int leading_byte, Emchar c); -INLINE Lisp_Object CHAR_TABLE_NON_ASCII_VALUE_UNSAFE (struct - Lisp_Char_Table *ct, - Emchar ch); +INLINE Lisp_Object +CHAR_TABLE_NON_ASCII_VALUE_UNSAFE (struct Lisp_Char_Table *ct, Emchar ch); INLINE Lisp_Object CHAR_TABLE_NON_ASCII_VALUE_UNSAFE (struct Lisp_Char_Table *ct, Emchar ch) {
--- a/src/cm.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/cm.c Mon Aug 13 09:55:28 2007 +0200 @@ -33,8 +33,14 @@ #define EXPENSIVE 2000 +#ifdef __cplusplus +extern "C" { +#endif extern char *tgoto (CONST char *cm, int hpos, int vpos); extern void tputs (CONST char *, int, void (*)(int)); +#ifdef __cplusplus +} +#endif static void cmgoto_for_real (struct console *c, int row, int col); @@ -215,7 +221,7 @@ while (--deltay >= 0) tputs (motion, 1, cmputc); -calculate_x: +calculate_x: deltax = dstx - srcx; if (!deltax) @@ -246,7 +252,7 @@ while (--deltax >= 0) tputs (motion, 1, cmputc); -done: +done: return totalcost; } #endif /* NOT_YET */ @@ -289,7 +295,7 @@ #if 0 if (frame_y >= 0 && frame_x >= 0) { - /* + /* * Pick least-cost motions */ @@ -351,7 +357,7 @@ dcm = TTY_CM (c).abs; } - /* + /* * In the following comparison, the = in <= is because when the costs * are the same, it looks nicer (I think) to move directly there. */ @@ -374,20 +380,20 @@ switch (use) { - case USEHOME: + case USEHOME: tputs (TTY_CM (c).home, 1, cmputc); FRAME_CURSOR_X (f) = 0; FRAME_CURSOR_Y (f) = 0; break; - case USELL: + case USELL: tputs (TTY_CM (c).low_left, 1, cmputc); FRAME_CURSOR_Y (f) = FRAME_HEIGHT (f) - 1; FRAME_CURSOR_X (f) = 0; break; #if 0 - case USECR: + case USECR: tputs (Wcm.cm_cr, 1, cmputc); if (Wcm.cm_autolf) curY++;
--- a/src/cmdloop.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/cmdloop.c Mon Aug 13 09:55:28 2007 +0200 @@ -277,7 +277,7 @@ (!CONSOLEP (Vselected_console) || CONSOLE_STREAM_P (XCONSOLE (Vselected_console)))) Fkill_emacs (make_int (-1)); - + /* End of -batch run causes exit here. */ if (noninteractive) Fkill_emacs (Qt); @@ -417,7 +417,7 @@ XCONSOLE (Vselected_console)->prefix_arg = Qnil; if (NILP (catch_errors)) Fcommand_loop_1 (); - else + else internal_catch (Qtop_level, cold_load_command_loop, Qnil, 0); goto loop; @@ -434,7 +434,7 @@ if (CONSP (datum) && EQ (XCAR (datum), Qquit)) /* Don't bother with the message */ return (Qt); - + message ("Error in command-loop!!"); Fset (intern ("last-error"), datum); /* #### Better/different name? */ Fsit_for (make_int (2), Qnil); @@ -561,7 +561,7 @@ if (!was_locked) any_console_state (); -#if defined (__SUNPRO_C) || (defined (DEC_ALPHA) && defined (OSF1)) +#if defined (__SUNPRO_C) || defined (__SUNPRO_CC) || (defined (DEC_ALPHA) && defined (OSF1)) if (0) return Qnil; /* Shut up compiler */ #endif }
--- a/src/cmds.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/cmds.c Mon Aug 13 09:55:28 2007 +0200 @@ -343,7 +343,7 @@ Lisp_Object overwrite; struct Lisp_Char_Table *syntax_table; struct buffer *buf = current_buffer; - + overwrite = buf->overwrite_mode; syntax_table = XCHAR_TABLE (buf->mirror_syntax_table);
--- a/src/commands.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/commands.h Mon Aug 13 09:55:28 2007 +0200 @@ -109,7 +109,7 @@ extern Lisp_Object recent_keys_ring; extern int recent_keys_ring_index; - + /* #ifndef LISP_COMMAND_LOOP */ extern Lisp_Object Vtop_level; /* #else */
--- a/src/config.h.in Mon Aug 13 09:54:24 2007 +0200 +++ b/src/config.h.in Mon Aug 13 09:55:28 2007 +0200 @@ -463,8 +463,15 @@ configuration names to use for them. See s/template.h for documentation on writing s/...h files. */ + +#if defined (__cplusplus) && !defined (NOT_C_CODE) +extern "C" { +#endif #undef config_opsysfile #include config_opsysfile +#if defined (__cplusplus) && !defined (NOT_C_CODE) +} +#endif /* The configuration script defines machfile to be the name of the m/...h file that describes the machine you are using. The file is @@ -723,4 +730,4 @@ #define MAIL_USE_LOCKF #endif -#endif /* _CONFIG_H_ */ +#endif /* _SRC_CONFIG_H_ */
--- a/src/console-stream.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/console-stream.c Mon Aug 13 09:55:28 2007 +0200 @@ -47,11 +47,7 @@ static void allocate_stream_console_struct (struct console *con) { - con->console_data = - (struct stream_console *) xmalloc (sizeof (struct stream_console)); - - /* zero out all slots. */ - memset (con->console_data, 0, sizeof (struct stream_console)); + con->console_data = xnew_and_zero (struct stream_console); } static void @@ -114,7 +110,7 @@ stream_delete_console (struct console *con) { if (/* CONSOLE_STREAM_DATA (con)->needs_newline */ - stdout_needs_newline) /* #### clean this up */ + stdout_needs_newline) /* #### clean this up */ { fputc ('\n', CONSOLE_STREAM_DATA (con)->outfd); fflush (CONSOLE_STREAM_DATA (con)->outfd);
--- a/src/console-tty.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/console-tty.c Mon Aug 13 09:55:28 2007 +0200 @@ -49,12 +49,8 @@ static void allocate_tty_console_struct (struct console *con) { - con->console_data = - (struct tty_console *) xmalloc (sizeof (struct tty_console)); - - /* zero out all slots. */ - memset (con->console_data, 0, sizeof (struct tty_console)); - /* except the lisp ones ... */ + /* zero out all slots except the lisp ones ... */ + con->console_data = xnew_and_zero (struct tty_console); CONSOLE_TTY_DATA (con)->terminal_type = Qnil; CONSOLE_TTY_DATA (con)->instream = Qnil; CONSOLE_TTY_DATA (con)->outstream = Qnil; @@ -72,7 +68,7 @@ terminal_type = Fplist_get (props, Qterminal_type, Qnil); controlling_process = Fplist_get(props, Qcontrolling_process, Qnil); - + /* Determine the terminal type */ if (!NILP (terminal_type)) @@ -109,7 +105,7 @@ error ("Unable to open tty %s", XSTRING_DATA (tty)); CONSOLE_TTY_DATA (con)->is_stdio = 0; } - + CONSOLE_TTY_DATA (con)->infd = infd; CONSOLE_TTY_DATA (con)->outfd = outfd; CONSOLE_TTY_DATA (con)->instream = make_filedesc_input_stream (infd, 0,
--- a/src/console-tty.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/console-tty.h Mon Aug 13 09:55:28 2007 +0200 @@ -66,135 +66,135 @@ /* flags indicating presence, absence or value of various features */ struct - { - unsigned int must_write_spaces :1;/* terminal inserts nulls, not - spaces to fill whitespace - on screen */ - unsigned int insert_mode_motion :1;/* cursor movement commands - work while in insert mode */ - unsigned int standout_motion :1; /* cursor movement is graceful + { + unsigned int must_write_spaces :1; /* terminal inserts nulls, not + spaces to fill whitespace on + screen */ + unsigned int insert_mode_motion :1; /* cursor movement commands + work while in insert mode */ + unsigned int standout_motion :1; /* cursor movement is graceful in standout or underline mode */ - unsigned int memory_above_frame :1;/* display retained above screen */ - unsigned int memory_below_frame :1;/* display retained below screen */ - unsigned int meta_key :2; /* 0 == mask off top bit; + unsigned int memory_above_frame :1; /* display retained above screen */ + unsigned int memory_below_frame :1; /* display retained below screen */ + unsigned int meta_key :2; /* 0 == mask off top bit; 1 == top bit is meta; 2 == top bit is useful as character info */ - unsigned int flow_control :1; /* Nonzero means use ^S/^Q as + unsigned int flow_control :1; /* Nonzero means use ^S/^Q as cretinous flow control. */ - int standout_width; /* # of spaces printed when - change to standout mode */ - int underline_width; /* # of spaces printed when + int standout_width; /* # of spaces printed when + change to standout mode */ + int underline_width; /* # of spaces printed when change to underline mode */ - } flags; + } flags; /* cursor motion entries - each entry is commented with the terminfo and the termcap entry */ struct - { - /* local cursor movement */ - CONST char *up; /* cuu1, up */ - CONST char *down; /* cud1, do */ - CONST char *left; /* cub1, le */ - CONST char *right; /* cuf1, nd */ - CONST char *home; /* home, ho */ - CONST char *low_left; /* ll, ll */ - CONST char *car_return; /* cr, cr */ - - /* parameterized local cursor movement */ - CONST char *multi_up; /* cuu, UP */ - CONST char *multi_down; /* cud, DO */ - CONST char *multi_left; /* cub, LE */ - CONST char *multi_right; /* cuf, RI */ - - /* absolute cursor motion */ - CONST char *abs; /* cup, cm */ - CONST char *hor_abs; /* hpa, ch */ - CONST char *ver_abs; /* vpa, cv */ - - /* scrolling */ - CONST char *scroll_forw; /* ind, sf */ - CONST char *scroll_back; /* ri, sr */ - CONST char *multi_scroll_forw; /* indn, SF */ - CONST char *multi_scroll_back; /* rin, SR */ - CONST char *set_scroll_region; /* csr, cs */ - } cm; - + { + /* local cursor movement */ + CONST char *up; /* cuu1, up */ + CONST char *down; /* cud1, do */ + CONST char *left; /* cub1, le */ + CONST char *right; /* cuf1, nd */ + CONST char *home; /* home, ho */ + CONST char *low_left; /* ll, ll */ + CONST char *car_return; /* cr, cr */ + + /* parameterized local cursor movement */ + CONST char *multi_up; /* cuu, UP */ + CONST char *multi_down; /* cud, DO */ + CONST char *multi_left; /* cub, LE */ + CONST char *multi_right; /* cuf, RI */ + + /* absolute cursor motion */ + CONST char *abs; /* cup, cm */ + CONST char *hor_abs; /* hpa, ch */ + CONST char *ver_abs; /* vpa, cv */ + + /* scrolling */ + CONST char *scroll_forw; /* ind, sf */ + CONST char *scroll_back; /* ri, sr */ + CONST char *multi_scroll_forw; /* indn, SF */ + CONST char *multi_scroll_back; /* rin, SR */ + CONST char *set_scroll_region; /* csr, cs */ + } cm; + /* screen editing entries - each entry is commented with the terminfo and the termcap entry */ struct - { - /* adding to the screen */ - CONST char *ins_line; /* il1, al */ - CONST char *multi_ins_line; /* il, AL */ - CONST char *repeat; /* rep, rp */ - CONST char *begin_ins_mode; /* smir, im */ - CONST char *end_ins_mode; /* rmir, ei */ - CONST char *ins_char; /* ich1, ic */ - CONST char *multi_ins_char; /* ich, IC */ - CONST char *insert_pad; /* ip, ip */ - - /* deleting from the screen */ - CONST char *clr_frame; /* clear, cl */ - CONST char *clr_from_cursor; /* ed, cd */ - CONST char *clr_to_eol; /* el, ce */ - CONST char *del_line; /* dl1, dl */ - CONST char *multi_del_line; /* dl, DL */ - CONST char *del_char; /* dch1, dc */ - CONST char *multi_del_char; /* dch, DC */ - CONST char *begin_del_mode; /* smdc, dm */ - CONST char *end_del_mode; /* rmdc, ed */ - CONST char *erase_at_cursor; /* ech, ec */ - } se; + { + /* adding to the screen */ + CONST char *ins_line; /* il1, al */ + CONST char *multi_ins_line; /* il, AL */ + CONST char *repeat; /* rep, rp */ + CONST char *begin_ins_mode; /* smir, im */ + CONST char *end_ins_mode; /* rmir, ei */ + CONST char *ins_char; /* ich1, ic */ + CONST char *multi_ins_char; /* ich, IC */ + CONST char *insert_pad; /* ip, ip */ + + /* deleting from the screen */ + CONST char *clr_frame; /* clear, cl */ + CONST char *clr_from_cursor; /* ed, cd */ + CONST char *clr_to_eol; /* el, ce */ + CONST char *del_line; /* dl1, dl */ + CONST char *multi_del_line; /* dl, DL */ + CONST char *del_char; /* dch1, dc */ + CONST char *multi_del_char; /* dch, DC */ + CONST char *begin_del_mode; /* smdc, dm */ + CONST char *end_del_mode; /* rmdc, ed */ + CONST char *erase_at_cursor; /* ech, ec */ + } se; /* screen display entries - each entry is commented with the terminfo and termcap entry */ struct - { - CONST char *begin_standout; /* smso, so */ - CONST char *end_standout; /* rmso, se */ - CONST char *begin_underline; /* smul, us */ - CONST char *end_underline; /* rmul, ue */ - CONST char *begin_alternate; /* smacs, as */ - CONST char *end_alternate; /* rmacs, ae */ - - CONST char *turn_on_reverse; /* rev, mr */ - CONST char *turn_on_blinking; /* blink, mb */ - CONST char *turn_on_bold; /* bold, md */ - CONST char *turn_on_dim; /* dim, mh */ - CONST char *turn_off_attributes; /* sgr0, me */ - - CONST char *visual_bell; /* flash, vb */ - CONST char *audio_bell; /* bel, bl */ - - CONST char *cursor_visible; /* cvvis, vs */ - CONST char *cursor_normal; /* cnorm, ve */ - CONST char *init_motion; /* smcup, ti */ - CONST char *end_motion; /* rmcup, te */ - CONST char *keypad_on; /* smkx, ks */ - CONST char *keypad_off; /* rmkx, ke */ + { + CONST char *begin_standout; /* smso, so */ + CONST char *end_standout; /* rmso, se */ + CONST char *begin_underline; /* smul, us */ + CONST char *end_underline; /* rmul, ue */ + CONST char *begin_alternate; /* smacs, as */ + CONST char *end_alternate; /* rmacs, ae */ + + CONST char *turn_on_reverse; /* rev, mr */ + CONST char *turn_on_blinking; /* blink, mb */ + CONST char *turn_on_bold; /* bold, md */ + CONST char *turn_on_dim; /* dim, mh */ + CONST char *turn_off_attributes; /* sgr0, me */ - CONST char *orig_pair; /* op, op */ - } sd; + CONST char *visual_bell; /* flash, vb */ + CONST char *audio_bell; /* bel, bl */ + + CONST char *cursor_visible; /* cvvis, vs */ + CONST char *cursor_normal; /* cnorm, ve */ + CONST char *init_motion; /* smcup, ti */ + CONST char *end_motion; /* rmcup, te */ + CONST char *keypad_on; /* smkx, ks */ + CONST char *keypad_off; /* rmkx, ke */ + + CONST char *orig_pair; /* op, op */ + } sd; /* costs of various operations */ struct - { - int cm_up; - int cm_down; - int cm_left; - int cm_right; - int cm_home; - int cm_low_left; - int cm_car_return; - int cm_abs; - int cm_hor_abs; - int cm_ver_abs; - } cost; + { + int cm_up; + int cm_down; + int cm_left; + int cm_right; + int cm_home; + int cm_low_left; + int cm_car_return; + int cm_abs; + int cm_hor_abs; + int cm_ver_abs; + } cost; /* The initial tty mode bits */ struct emacs_tty old_tty; - + /* Is this TTY our controlling terminal? */ unsigned int controlling_terminal :1; unsigned int is_stdio :1;
--- a/src/console-x.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/console-x.c Mon Aug 13 09:55:28 2007 +0200 @@ -271,7 +271,7 @@ console_type_create_x (void) { INITIALIZE_CONSOLE_TYPE (x, "x", "console-x-p"); - + CONSOLE_HAS_METHOD (x, semi_canonicalize_console_connection); CONSOLE_HAS_METHOD (x, canonicalize_console_connection); CONSOLE_HAS_METHOD (x, semi_canonicalize_device_connection);
--- a/src/console-x.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/console-x.h Mon Aug 13 09:55:28 2007 +0200 @@ -57,7 +57,7 @@ #include <X11/xpm.h> #endif -/* R5 defines the XPointer type, but R4 doesn't. +/* R5 defines the XPointer type, but R4 doesn't. R4 also doesn't define a version number, but R5 does. */ #if (XlibSpecificationRelease < 5) # define XPointer char * @@ -143,8 +143,8 @@ dispatched to emacs or widgets. */ Time global_mouse_timestamp; - /* This is the last known timestamp received from the server. It is - maintained by x_event_to_emacs_event and used to patch bogus + /* This is the last known timestamp received from the server. It is + maintained by x_event_to_emacs_event and used to patch bogus WM_TAKE_FOCUS messages sent by Mwm. */ Time last_server_timestamp; @@ -163,7 +163,7 @@ /* XComposeStatus x_compose_status; */ #ifdef HAVE_XIM - XIM xim; + XIM xim; XIMStyles *xim_styles; #endif /* HAVE_XIM */ @@ -425,7 +425,7 @@ void x_redraw_exposed_area (struct frame *f, int x, int y, int width, int height); void x_output_string (struct window *w, struct display_line *dl, - emchar_dynarr *buf, int xpos, int xoffset, + Emchar_dynarr *buf, int xpos, int xoffset, int start_pixpos, int width, face_index findex, int cursor, int cursor_start, int cursor_width, int cursor_height);
--- a/src/console.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/console.c Mon Aug 13 09:55:28 2007 +0200 @@ -72,15 +72,15 @@ as well as a default value which is used to initialize newly-created consoles and as a reset-value when local-vars are killed. - If a slot is -2, there is no DEFVAR_CONSOLE_LOCAL for it. + If a slot is -2, there is no DEFVAR_CONSOLE_LOCAL for it. (The slot is always local, but there's no lisp variable for it.) - The default value is only used to initialize newly-creation consoles. - + The default value is only used to initialize newly-creation consoles. + If a slot is -3, then there is no DEFVAR_CONSOLE_LOCAL for it but there is a default which is used to initialize newly-creation consoles and as a reset-value when local-vars are killed. - + */ struct console console_local_flags; @@ -150,8 +150,7 @@ allocate_console (void) { Lisp_Object console = Qnil; - struct console *con = alloc_lcrecord (sizeof (struct console), - lrecord_console); + struct console *con = alloc_lcrecord_type (struct console, lrecord_console); struct gcpro gcpro1; copy_lcrecord (con, XCONSOLE (Vconsole_defaults)); @@ -535,7 +534,7 @@ if (!CONSOLE_STREAM_P (XCONSOLE (con)) && !EQ (con, console) && !NILP (CONSOLE_SELECTED_DEVICE (XCONSOLE (con))) - && !NILP (DEVICE_SELECTED_FRAME + && !NILP (DEVICE_SELECTED_FRAME (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (con)))))) break; } @@ -548,7 +547,7 @@ Lisp_Object con = XCAR (concons); if (!EQ (con, console) && !NILP (CONSOLE_SELECTED_DEVICE (XCONSOLE (con))) - && !NILP (DEVICE_SELECTED_FRAME + && !NILP (DEVICE_SELECTED_FRAME (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (con)))))) break; } @@ -595,7 +594,7 @@ void delete_console_internal (struct console *con, int force, - int called_from_kill_emacs, int from_io_error) + int called_from_kill_emacs, int from_io_error) { /* This function can GC */ Lisp_Object console = Qnil; @@ -695,11 +694,11 @@ } } } - + CONSOLE_SELECTED_DEVICE (con) = Qnil; - + /* try to select another console */ - + if (EQ (console, Fselected_console ())) { Lisp_Object other_dev = find_other_console (console); @@ -715,7 +714,7 @@ if (con->input_enabled) event_stream_unselect_console (con); - + MAYBE_CONMETH (con, delete_console, (con)); Vconsole_list = delq_no_quit (console, Vconsole_list); @@ -870,7 +869,7 @@ /* Call value of suspend-resume-hook if it is bound and value is non-nil. */ run_hook (Qsuspend_resume_hook); - + UNGCPRO; return Qnil; } @@ -930,7 +929,7 @@ #ifdef HAVE_TTY c = decode_console (console); - if (CONSOLE_TTY_P (c)) + if (CONSOLE_TTY_P (c)) { /* * hide all the unhidden frames so the display code won't update @@ -969,7 +968,7 @@ #ifdef HAVE_TTY c = decode_console (console); - if (CONSOLE_TTY_P (c)) + if (CONSOLE_TTY_P (c)) { /* raise the selected frame */ Lisp_Object device = CONSOLE_SELECTED_DEVICE (c); @@ -1065,13 +1064,13 @@ { Lisp_Object val[4]; struct console *con = decode_console (console); - + val[0] = Qnil; val[1] = CONSOLE_TTY_P (con) && TTY_FLAGS (con).flow_control ? Qt : Qnil; val[2] = (!CONSOLE_TTY_P (con) || TTY_FLAGS (con).meta_key == 1) ? Qt : TTY_FLAGS (con).meta_key == 2 ? make_int (0) : Qnil; val[3] = make_char (CONSOLE_QUIT_CHAR (con)); - + return Flist (sizeof (val) / sizeof (val[0]), val); } @@ -1103,7 +1102,7 @@ DEFSUBR (Fconsole_on_window_system_p); DEFSUBR (Fsuspend_console); DEFSUBR (Fresume_console); - + DEFSUBR (Fsuspend_emacs); DEFSUBR (Fset_input_mode); DEFSUBR (Fcurrent_input_mode); @@ -1121,7 +1120,7 @@ void console_type_create (void) { - the_console_type_entry_dynarr = Dynarr_new (struct console_type_entry); + the_console_type_entry_dynarr = Dynarr_new (console_type_entry); Vconsole_type_list = Qnil; staticpro (&Vconsole_type_list); @@ -1163,61 +1162,61 @@ #endif } -/* DOC is ignored because it is snagged and recorded externally +/* DOC is ignored because it is snagged and recorded externally * by make-docfile */ /* Declaring this stuff as const produces 'Cannot reinitialize' messages from SunPro C's fix-and-continue feature (a way neato feature that makes debugging unbelievably more bearable) */ -#define DEFVAR_CONSOLE_LOCAL(lname, field_name) \ - do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { { lrecord_symbol_value_forward }, \ - (void *) &(console_local_flags.field_name), 69 }, \ - SYMVAL_SELECTED_CONSOLE_FORWARD }, 0 }; \ - defvar_console_local ((lname), &I_hate_C); \ - } while (0) +#define DEFVAR_CONSOLE_LOCAL(lname, field_name) do { \ +static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ + = { { { { lrecord_symbol_value_forward }, \ + (struct lcrecord_header *) &(console_local_flags.field_name), 69 }, \ + SYMVAL_SELECTED_CONSOLE_FORWARD }, 0 }; \ + defvar_console_local ((lname), &I_hate_C); \ +} while (0) -#define DEFVAR_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun) \ - do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { { lrecord_symbol_value_forward }, \ - (void *) &(console_local_flags.field_name), 69 }, \ - SYMVAL_SELECTED_CONSOLE_FORWARD }, magicfun }; \ - defvar_console_local ((lname), &I_hate_C); \ - } while (0) +#define DEFVAR_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun) do { \ +static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ + = { { { { lrecord_symbol_value_forward }, \ + (struct lcrecord_header *) &(console_local_flags.field_name), 69 }, \ + SYMVAL_SELECTED_CONSOLE_FORWARD }, magicfun }; \ + defvar_console_local ((lname), &I_hate_C); \ +} while (0) -#define DEFVAR_CONST_CONSOLE_LOCAL(lname, field_name) \ - do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { { lrecord_symbol_value_forward }, \ - (void *) &(console_local_flags.field_name), 69 }, \ - SYMVAL_CONST_SELECTED_CONSOLE_FORWARD }, 0 }; \ - defvar_console_local ((lname), &I_hate_C); \ - } while (0) +#define DEFVAR_CONST_CONSOLE_LOCAL(lname, field_name) do { \ +static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ + = { { { { lrecord_symbol_value_forward }, \ + (struct lcrecord_header *) &(console_local_flags.field_name), 69 }, \ + SYMVAL_CONST_SELECTED_CONSOLE_FORWARD }, 0 }; \ + defvar_console_local ((lname), &I_hate_C); \ +} while (0) -#define DEFVAR_CONST_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun) \ - do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { { lrecord_symbol_value_forward }, \ - (void *) &(console_local_flags.field_name), 69 }, \ - SYMVAL_CONST_SELECTED_CONSOLE_FORWARD }, magicfun }; \ - defvar_console_local ((lname), &I_hate_C); \ - } while (0) +#define DEFVAR_CONST_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun) do { \ +static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ + = { { { { lrecord_symbol_value_forward }, \ + (struct lcrecord_header *) &(console_local_flags.field_name), 69 }, \ + SYMVAL_CONST_SELECTED_CONSOLE_FORWARD }, magicfun }; \ + defvar_console_local ((lname), &I_hate_C); \ +} while (0) -#define DEFVAR_CONSOLE_DEFAULTS(lname, field_name) \ - do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { { lrecord_symbol_value_forward }, \ - (void *) &(console_local_flags.field_name), 69 }, \ - SYMVAL_DEFAULT_CONSOLE_FORWARD }, 0 }; \ - defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C)); \ - } while (0) +#define DEFVAR_CONSOLE_DEFAULTS(lname, field_name) do { \ +static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ + = { { { { lrecord_symbol_value_forward }, \ + (struct lcrecord_header *) &(console_local_flags.field_name), 69 }, \ + SYMVAL_DEFAULT_CONSOLE_FORWARD }, 0 }; \ + defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C)); \ +} while (0) -#define DEFVAR_CONSOLE_DEFAULTS_MAGIC(lname, field_name, magicfun) \ - do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { { lrecord_symbol_value_forward }, \ - (void *) &(console_local_flags.field_name), 69 }, \ - SYMVAL_DEFAULT_CONSOLE_FORWARD }, magicfun }; \ - defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C)); \ - } while (0) +#define DEFVAR_CONSOLE_DEFAULTS_MAGIC(lname, field_name, magicfun) do { \ +static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ + = { { { { lrecord_symbol_value_forward }, \ + (struct lcrecord_header *) &(console_local_flags.field_name), 69 }, \ + SYMVAL_DEFAULT_CONSOLE_FORWARD }, magicfun }; \ + defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C)); \ +} while (0) static void -defvar_console_local (CONST char *namestring, +defvar_console_local (CONST char *namestring, CONST struct symbol_value_forward *m) { int offset = ((char *)symbol_value_forward_forward (m) @@ -1225,7 +1224,7 @@ defvar_mumble (namestring, m, sizeof (*m)); - *((Lisp_Object *)(offset + (char *)XCONSOLE (Vconsole_local_symbols))) + *((Lisp_Object *)(offset + (char *)XCONSOLE (Vconsole_local_symbols))) = intern (namestring); } @@ -1245,24 +1244,22 @@ /* Make sure all markable slots in console_defaults are initialized reasonably, so mark_console won't choke. */ - struct console *defs = alloc_lcrecord (sizeof (struct console), - lrecord_console); - struct console *syms = alloc_lcrecord (sizeof (struct console), - lrecord_console); + struct console *defs = alloc_lcrecord_type (struct console, lrecord_console); + struct console *syms = alloc_lcrecord_type (struct console, lrecord_console); staticpro (&Vconsole_defaults); staticpro (&Vconsole_local_symbols); XSETCONSOLE (Vconsole_defaults, defs); XSETCONSOLE (Vconsole_local_symbols, syms); - + nuke_all_console_slots (syms, Qnil); nuke_all_console_slots (defs, Qnil); - + /* Set up the non-nil default values of various console slots. Must do these before making the first console. */ /* #### Anything needed here? */ - + { /* 0 means var is always local. Default used only at creation. * -1 means var is always local. Default used only at reset and @@ -1282,13 +1279,13 @@ Lisp_Object always_local_no_default = make_int (0); Lisp_Object resettable = make_int (-3); #endif - + /* Assign the local-flags to the slots that have default values. The local flag is a bit that is used in the console to say that it has its own local value for the slot. The local flag bits are in the local_var_flags slot of the console. */ - + nuke_all_console_slots (&console_local_flags, make_int (-2)); console_local_flags.defining_kbd_macro = always_local_resettable; console_local_flags.last_kbd_macro = always_local_resettable; @@ -1297,9 +1294,9 @@ console_local_flags.overriding_terminal_local_map = always_local_resettable; console_local_flags.tty_erase_char = always_local_resettable; - + console_local_flags.function_key_map = make_int (1); - + /* #### Warning, 0x4000000 (that's six zeroes) is the largest number currently allowable due to the XINT() handling of this value. With some rearrangement you can get 4 more bits. */ @@ -1360,7 +1357,7 @@ You cannot examine this variable to find the argument for this command since it has been set to nil by the time you can look. Instead, you should use the variable `current-prefix-arg', although -normally commands can get this prefix argument with (interactive \"P\"). +normally commands can get this prefix argument with (interactive "P"). */ ); DEFVAR_CONSOLE_LOCAL ("default-minibuffer-frame",
--- a/src/console.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/console.h Mon Aug 13 09:55:28 2007 +0200 @@ -304,31 +304,28 @@ /******** Defining new console types ********/ +typedef struct console_type_entry console_type_entry; struct console_type_entry { Lisp_Object symbol; struct console_methods *meths; }; -#define DECLARE_CONSOLE_TYPE(type) \ +#define DECLARE_CONSOLE_TYPE(type) \ extern struct console_methods * type##_console_methods -#define DEFINE_CONSOLE_TYPE(type) \ +#define DEFINE_CONSOLE_TYPE(type) \ struct console_methods * type##_console_methods -#define INITIALIZE_CONSOLE_TYPE(type, obj_name, pred_sym) \ - do { \ - type##_console_methods = \ - malloc_type_and_zero (struct console_methods); \ - type##_console_methods->name = obj_name; \ - type##_console_methods->symbol = Q##type; \ - defsymbol (&type##_console_methods->predicate_symbol, \ - pred_sym); \ - add_entry_to_console_type_list (Q##type, \ - type##_console_methods); \ - type##_console_methods->image_conversion_list = Qnil; \ - staticpro (&type##_console_methods->image_conversion_list); \ - } while (0) +#define INITIALIZE_CONSOLE_TYPE(type, obj_name, pred_sym) do { \ + type##_console_methods = xnew_and_zero (struct console_methods); \ + type##_console_methods->name = obj_name; \ + type##_console_methods->symbol = Q##type; \ + defsymbol (&type##_console_methods->predicate_symbol, pred_sym); \ + add_entry_to_console_type_list (Q##type, type##_console_methods); \ + type##_console_methods->image_conversion_list = Qnil; \ + staticpro (&type##_console_methods->image_conversion_list); \ +} while (0) /* Declare that console-type TYPE has method M; used in initialization routines */
--- a/src/data.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/data.c Mon Aug 13 09:55:28 2007 +0200 @@ -167,7 +167,7 @@ { Lisp_Object val; /* Don't use XSETINT here -- it's defined in terms of make_int (). */ - XSETOBJ (val, Lisp_Int, num); + XSETOBJ (val, Lisp_Type_Int, num); return val; } #endif /* ! defined (make_int) */ @@ -195,8 +195,7 @@ make_char (Emchar num) { Lisp_Object val; - /* Don't use XSETCHAR here -- it's defined in terms of make_char (). */ - XSETOBJ (val, Lisp_Char, num); + XSETOBJ (val, Lisp_Type_Char, num); return val; } @@ -1757,9 +1756,9 @@ make_weak_list (enum weak_list_type type) { Lisp_Object result = Qnil; + struct weak_list *wl = + alloc_lcrecord_type (struct weak_list, lrecord_weak_list); - struct weak_list *wl = - alloc_lcrecord (sizeof (struct weak_list), lrecord_weak_list); wl->list = Qnil; wl->type = type; XSETWEAK_LIST (result, wl);
--- a/src/database.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/database.c Mon Aug 13 09:55:28 2007 +0200 @@ -21,7 +21,7 @@ /* Synched up with: Not in FSF. */ /* Written by Bill Perry */ -/* Hacked on by Martin Buchholz */ +/* Substantially rewritten by Martin Buchholz */ #include <config.h> #include "lisp.h" @@ -63,24 +63,23 @@ typedef enum { DB_DBM, DB_BERKELEY, DB_UNKNOWN } XEMACS_DB_TYPE; -struct database_struct; -typedef struct database_struct database_struct; +struct database; +typedef struct database database; typedef struct { - CONST char * (*get_subtype) (struct database_struct *); - CONST char * (*get_type) (struct database_struct *); - void * (*open_file) (CONST char *, Lisp_Object, int, int); - Lisp_Object (*get) (struct database_struct *, Lisp_Object); - int (*put) (struct database_struct *, Lisp_Object, Lisp_Object, Lisp_Object); - int (*rem) (struct database_struct *, Lisp_Object); - void (*map) (struct database_struct *, Lisp_Object); - Lisp_Object (*get_lisp_type) (struct database_struct *); - void (*close) (struct database_struct *); - Lisp_Object (*last_error) (struct database_struct *); + CONST char * (*get_subtype) (struct database *); + CONST char * (*get_type) (struct database *); + Lisp_Object (*get) (struct database *, Lisp_Object); + int (*put) (struct database *, Lisp_Object, Lisp_Object, Lisp_Object); + int (*rem) (struct database *, Lisp_Object); + void (*map) (struct database *, Lisp_Object); + Lisp_Object (*get_lisp_type) (struct database *); + void (*close) (struct database *); + Lisp_Object (*last_error) (struct database *); } DB_FUNCS; -struct database_struct +struct database { struct lcrecord_header header; Lisp_Object fname; @@ -88,35 +87,54 @@ int mode; int access_; int dberrno; - void *db_handle; + int live_p; +#ifdef HAVE_DBM + DBM *dbm_handle; +#endif +#ifdef HAVE_BERKELEY_DB + DB *db_handle; +#endif DB_FUNCS *funcs; #ifdef MULE Lisp_Object coding_system; #endif }; -#define XDATABASE(x) XRECORD (x, database, struct database_struct) +#define XDATABASE(x) XRECORD (x, database, struct database) #define XSETDATABASE(x, p) XSETRECORD (x, p, database) #define DATABASEP(x) RECORDP (x, database) #define GC_DATABASEP(x) GC_RECORDP (x, database) #define CHECK_DATABASE(x) CHECK_RECORD (x, database) -#define DATABASE_LIVE_P(x) (x->db_handle) +#define DATABASE_LIVE_P(x) (x->live_p) static Lisp_Object mark_database (Lisp_Object, void (*) (Lisp_Object)); static void print_database (Lisp_Object, Lisp_Object, int); static void finalize_database (void *, int); DEFINE_LRECORD_IMPLEMENTATION ("database", database, mark_database, print_database, finalize_database, 0, 0, - struct database_struct); + struct database); -static struct database_struct * +#define CHECK_LIVE_DATABASE(db) do { \ + CHECK_DATABASE(db); \ + if (!DATABASE_LIVE_P (XDATABASE(db))) \ + signal_simple_error ("Attempting to access closed database", db); \ +} while (0) + + +static struct database * new_database (void) { - struct database_struct *dbase - = alloc_lcrecord (sizeof (struct database_struct), lrecord_database); + struct database *dbase = + alloc_lcrecord_type (struct database, lrecord_database); dbase->fname = Qnil; + dbase->live_p = 0; +#ifdef HAVE_BERKELEY_DB dbase->db_handle = NULL; +#endif +#ifdef HAVE_DBM + dbase->dbm_handle = NULL; +#endif dbase->access_ = 0; dbase->mode = 0; dbase->dberrno = 0; @@ -130,7 +148,7 @@ static Lisp_Object mark_database (Lisp_Object obj, void (*markobj) (Lisp_Object)) { - struct database_struct *dbase = XDATABASE (obj); + struct database *dbase = XDATABASE (obj); ((markobj) (dbase->fname)); return Qnil; @@ -139,7 +157,7 @@ static void print_database (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { - struct database_struct *dbase = XDATABASE (obj); + struct database *dbase = XDATABASE (obj); char buf[200]; if (print_readably) @@ -148,19 +166,13 @@ } else { - CONST char *type; - CONST char *subtype; - CONST char *perms; - - perms = (!dbase->db_handle) ? "closed" : - (dbase->access_ & O_WRONLY) ? "writeonly" : - (dbase->access_ & O_RDWR) ? "readwrite" : "readonly"; - - type = dbase->funcs->get_type (dbase); - subtype = dbase->funcs->get_subtype (dbase); - - sprintf (buf, "#<database %s (%s/%s/%s) 0x%x>", - XSTRING_DATA (dbase->fname), type, subtype, perms, + sprintf (buf, "#<database \"%s\" (%s/%s/%s) 0x%x>", + XSTRING_DATA (dbase->fname), + dbase->funcs->get_type (dbase), + dbase->funcs->get_subtype (dbase), + (!DATABASE_LIVE_P (dbase) ? "closed" : + (dbase->access_ & O_WRONLY) ? "writeonly" : + (dbase->access_ & O_RDWR) ? "readwrite" : "readonly"), dbase->header.uid); write_c_string (buf, printcharfun); } @@ -169,13 +181,13 @@ static void finalize_database (void *header, int for_disksave) { - struct database_struct *db = (struct database_struct *) header; + struct database *db = (struct database *) header; if (for_disksave) { - Lisp_Object obj; - XSETOBJ (obj, Lisp_Record, (void *) db); - + Lisp_Object obj; + XSETOBJ (obj, Lisp_Type_Record, (void *) db); + signal_simple_error ("Can't dump an emacs containing window system objects", obj); } @@ -187,15 +199,9 @@ */ (obj)) { - struct database_struct *db; - CHECK_DATABASE (obj); - db = XDATABASE (obj); - - if (DATABASE_LIVE_P (db)) - db->funcs->close (db); - else - signal_simple_error ("Attempting to access closed database", obj); - + CHECK_LIVE_DATABASE (obj); + XDATABASE (obj)->funcs->close (XDATABASE (obj)); + XDATABASE (obj)->live_p = 0; return Qnil; } @@ -204,11 +210,9 @@ */ (obj)) { - struct database_struct *db; CHECK_DATABASE (obj); - db = XDATABASE (obj); - return db->funcs->get_lisp_type (db); + return XDATABASE (obj)->funcs->get_lisp_type (XDATABASE (obj)); } DEFUN ("database-subtype", Fdatabase_subtype, 1, 1, 0, /* @@ -216,12 +220,9 @@ */ (obj)) { - struct database_struct *db; - CHECK_DATABASE (obj); - db = XDATABASE (obj); - - return intern (db->funcs->get_subtype (db)); + + return intern (XDATABASE (obj)->funcs->get_subtype (XDATABASE (obj))); } DEFUN ("database-live-p", Fdatabase_live_p, 1, 1, 0, /* @@ -229,11 +230,9 @@ */ (obj)) { - struct database_struct *db; CHECK_DATABASE (obj); - db = XDATABASE (obj); - return DATABASE_LIVE_P (db) ? Qt : Qnil; + return DATABASE_LIVE_P (XDATABASE (obj)) ? Qt : Qnil; } DEFUN ("database-file-name", Fdatabase_file_name, 1, 1, 0, /* @@ -241,10 +240,9 @@ */ (obj)) { - struct database_struct *db; CHECK_DATABASE (obj); - db = XDATABASE (obj); - return db->fname; + + return XDATABASE (obj)->fname; } DEFUN ("databasep", Fdatabasep, 1, 1, 0, /* @@ -257,17 +255,16 @@ #ifdef HAVE_DBM static void -dbm_map (struct database_struct *db, Lisp_Object func) +dbm_map (struct database *db, Lisp_Object func) { datum keydatum, valdatum; - DBM *handle = (DBM *)db->db_handle; Lisp_Object key, val; - for (keydatum = dbm_firstkey (handle); + for (keydatum = dbm_firstkey (db->dbm_handle); keydatum.dptr != NULL; - keydatum = dbm_nextkey (handle)) + keydatum = dbm_nextkey (db->dbm_handle)) { - valdatum = dbm_fetch (handle, keydatum); + valdatum = dbm_fetch (db->dbm_handle, keydatum); key = make_string ((unsigned char *) keydatum.dptr, keydatum.dsize); val = make_string ((unsigned char *) valdatum.dptr, valdatum.dsize); call2 (func, key, val); @@ -275,13 +272,13 @@ } static Lisp_Object -dbm_get (struct database_struct *db, Lisp_Object key) +dbm_get (struct database *db, Lisp_Object key) { datum keydatum, valdatum; - DBM *handle = (DBM *)db->db_handle; + keydatum.dptr = (char *) XSTRING_DATA (key); keydatum.dsize = XSTRING_LENGTH (key); - valdatum = dbm_fetch (handle, keydatum); + valdatum = dbm_fetch (db->dbm_handle, keydatum); return (valdatum.dptr ? make_string ((unsigned char *) valdatum.dptr, valdatum.dsize) @@ -289,77 +286,69 @@ } static int -dbm_put (struct database_struct *db, - Lisp_Object key, - Lisp_Object val, - Lisp_Object replace) +dbm_put (struct database *db, + Lisp_Object key, Lisp_Object val, Lisp_Object replace) { - DBM *handle = (DBM *)db->db_handle; datum keydatum, valdatum; - + valdatum.dptr = (char *) XSTRING_DATA (val); valdatum.dsize = XSTRING_LENGTH (val); keydatum.dptr = (char *) XSTRING_DATA (key); keydatum.dsize = XSTRING_LENGTH (key); - return (!dbm_store (handle, keydatum, valdatum, - (NILP (replace)) ? DBM_INSERT : DBM_REPLACE)); + return !dbm_store (db->dbm_handle, keydatum, valdatum, + NILP (replace) ? DBM_INSERT : DBM_REPLACE); } static int -dbm_remove (struct database_struct *db, Lisp_Object key) +dbm_remove (struct database *db, Lisp_Object key) { datum keydatum; + keydatum.dptr = (char *) XSTRING_DATA (key); keydatum.dsize = XSTRING_LENGTH (key); - return dbm_delete (db->db_handle, keydatum); + + return dbm_delete (db->dbm_handle, keydatum); } static Lisp_Object -dbm_lisp_type (struct database_struct *db) +dbm_lisp_type (struct database *db) { return Qdbm; } static CONST char * -dbm_type (struct database_struct *db) +dbm_type (struct database *db) { return "dbm"; } static CONST char * -dbm_subtype (struct database_struct *db) +dbm_subtype (struct database *db) { return "nil"; } -static void * -new_dbm_file (CONST char *file, Lisp_Object subtype, int access_, int mode) -{ - DBM *db = NULL; - db = dbm_open ((char *) file, access_, mode); - return (void *) db; -} - static Lisp_Object -dbm_lasterr (struct database_struct *dbp) +dbm_lasterr (struct database *dbp) { return lisp_strerror (dbp->dberrno); } static void -dbm_closeit (struct database_struct *db) +dbm_closeit (struct database *db) { - if (db->db_handle) - dbm_close ((DBM *)db->db_handle); - db->db_handle = NULL; + if (db->dbm_handle) + { + dbm_close (db->dbm_handle); + db->dbm_handle = NULL; + } } static DB_FUNCS ndbm_func_block = { dbm_subtype, dbm_type, - new_dbm_file, dbm_get, dbm_put, dbm_remove, @@ -368,159 +357,131 @@ dbm_closeit, dbm_lasterr }; -#endif +#endif /* HAVE_DBM */ #ifdef HAVE_BERKELEY_DB static Lisp_Object -berkdb_lisp_type (struct database_struct *db) +berkdb_lisp_type (struct database *db) { return Qberkeley_db; } static CONST char * -berkdb_type (struct database_struct *db) +berkdb_type (struct database *db) { return "berkeley"; } static CONST char * -berkdb_subtype (struct database_struct *db) +berkdb_subtype (struct database *db) { - DB *temp = (DB *)db->db_handle; - - if (!temp) + if (!db->db_handle) return "nil"; - - switch (temp->type) - { - case DB_BTREE: - return "btree"; - case DB_HASH: - return "hash"; - case DB_RECNO: - return "recno"; - } - return "unknown"; -} -static void * -berkdb_open (CONST char *file, Lisp_Object subtype, int access_, int mode) -{ - DB *db; - DBTYPE real_subtype; - - if (EQ (subtype, Qhash) || NILP (subtype)) - real_subtype = DB_HASH; - else if (EQ (subtype, Qbtree)) - real_subtype = DB_BTREE; - else if (EQ (subtype, Qrecno)) - real_subtype = DB_RECNO; - else - signal_simple_error ("Unsupported subtype", subtype); - - db = dbopen (file, access_, mode, real_subtype, NULL); - - return (void *) db; + switch (db->db_handle->type) + { + case DB_BTREE: return "btree"; + case DB_HASH: return "hash"; + case DB_RECNO: return "recno"; + default: return "unknown"; + } } static Lisp_Object -berkdb_lasterr (struct database_struct *dbp) +berkdb_lasterr (struct database *dbp) { return lisp_strerror (dbp->dberrno); } static Lisp_Object -berkdb_get (struct database_struct *db, Lisp_Object key) +berkdb_get (struct database *db, Lisp_Object key) { + /* #### Needs mule-izing */ DBT keydatum, valdatum; - DB *dbp = (DB *) db->db_handle; int status = 0; keydatum.data = XSTRING_DATA (key); keydatum.size = XSTRING_LENGTH (key); - - status = dbp->get (dbp, &keydatum, &valdatum, 0); + + status = db->db_handle->get (db->db_handle, &keydatum, &valdatum, 0); if (!status) - return make_string (valdatum.data, valdatum.size); + return make_string ((Bufbyte *) valdatum.data, valdatum.size); db->dberrno = (status == 1) ? -1 : errno; return Qnil; } static int -berkdb_put (struct database_struct *db, +berkdb_put (struct database *db, Lisp_Object key, Lisp_Object val, Lisp_Object replace) { DBT keydatum, valdatum; - DB *dbp = (DB *) db->db_handle; int status = 0; keydatum.data = XSTRING_DATA (key); keydatum.size = XSTRING_LENGTH (key); valdatum.data = XSTRING_DATA (val); valdatum.size = XSTRING_LENGTH (val); - status = dbp->put (dbp, &keydatum, &valdatum, NILP (replace) - ? R_NOOVERWRITE : 0); + status = db->db_handle->put (db->db_handle, &keydatum, &valdatum, + NILP (replace) ? R_NOOVERWRITE : 0); db->dberrno = (status == 1) ? -1 : errno; return status; } static int -berkdb_remove (struct database_struct *db, Lisp_Object key) +berkdb_remove (struct database *db, Lisp_Object key) { DBT keydatum; - DB *dbp = (DB *) db->db_handle; int status; keydatum.data = XSTRING_DATA (key); keydatum.size = XSTRING_LENGTH (key); - - status = dbp->del (dbp, &keydatum, 0); + + status = db->db_handle->del (db->db_handle, &keydatum, 0); if (!status) return 0; - + db->dberrno = (status == 1) ? -1 : errno; return 1; } static void -berkdb_map (struct database_struct *db, Lisp_Object func) +berkdb_map (struct database *db, Lisp_Object func) { DBT keydatum, valdatum; Lisp_Object key, val; - DB *dbp = (DB *) db->db_handle; + DB *dbp = db->db_handle; int status; for (status = dbp->seq (dbp, &keydatum, &valdatum, R_FIRST); status == 0; status = dbp->seq (dbp, &keydatum, &valdatum, R_NEXT)) { - key = make_string (keydatum.data, keydatum.size); - val = make_string (valdatum.data, valdatum.size); + /* ### Needs mule-izing */ + key = make_string ((Bufbyte *) keydatum.data, keydatum.size); + val = make_string ((Bufbyte *) valdatum.data, valdatum.size); call2 (func, key, val); } } static void -berkdb_close (struct database_struct *db) +berkdb_close (struct database *db) { - DB *dbp = (DB *)db->db_handle; - if (dbp) + if (db->db_handle) { - dbp->sync (dbp, 0); - dbp->close (dbp); + db->db_handle->sync (db->db_handle, 0); + db->db_handle->close (db->db_handle); + db->db_handle = NULL; } - db->db_handle = NULL; } static DB_FUNCS berk_func_block = { berkdb_subtype, berkdb_type, - berkdb_open, berkdb_get, berkdb_put, berkdb_remove, @@ -529,21 +490,19 @@ berkdb_close, berkdb_lasterr }; -#endif +#endif /* HAVE_BERKELEY_DB */ DEFUN ("database-last-error", Fdatabase_error, 0, 1, 0, /* Return the last error associated with database OBJ. */ (obj)) { - struct database_struct *db; - if (NILP (obj)) return lisp_strerror (errno); - + CHECK_DATABASE (obj); - db = XDATABASE (obj); - return db->funcs->last_error (db); + + return XDATABASE (obj)->funcs->last_error (XDATABASE (obj)); } DEFUN ("open-database", Fmake_database, 1, 5, 0, /* @@ -556,12 +515,11 @@ Lisp_Object retval = Qnil; int modemask; int accessmask = 0; - XEMACS_DB_TYPE the_type; - DB_FUNCS *funcblock; - struct database_struct *dbase = NULL; - void *db = NULL; + struct database *dbase = NULL; + char *filename; CHECK_STRING (file); + filename = (char *) XSTRING_DATA (file); if (NILP (access_)) { @@ -572,27 +530,21 @@ char *acc; CHECK_STRING (access_); acc = (char *) XSTRING_DATA (access_); - + if (strchr (acc, '+')) accessmask |= O_CREAT; - + if (strchr (acc, 'r') && strchr (acc, 'w')) - { accessmask |= O_RDWR; - } else if (strchr (acc, 'w')) - { accessmask |= O_WRONLY; - } else - { accessmask |= O_RDONLY; - } } if (NILP (mode)) { - modemask = 493; /* rwxr-xr-x */ + modemask = 0755; /* rwxr-xr-x */ } else { @@ -603,67 +555,73 @@ #ifdef HAVE_DBM if (NILP (type) || EQ (type, Qdbm)) { - the_type = DB_DBM; - funcblock = &ndbm_func_block; + DBM *dbm = dbm_open (filename, accessmask, modemask); + if (!dbm) + return Qnil; + + dbase = new_database (); + dbase->dbm_handle = dbm; + dbase->type = DB_DBM; + dbase->funcs = &ndbm_func_block; goto db_done; } -#endif +#endif /* HAVE_DBM */ #ifdef HAVE_BERKELEY_DB if (NILP (type) || EQ (type, Qberkeley_db)) { + DBTYPE real_subtype; + DB *db; - funcblock = &berk_func_block; - the_type = DB_BERKELEY; + if (EQ (subtype, Qhash) || NILP (subtype)) + real_subtype = DB_HASH; + else if (EQ (subtype, Qbtree)) + real_subtype = DB_BTREE; + else if (EQ (subtype, Qrecno)) + real_subtype = DB_RECNO; + else + signal_simple_error ("Unsupported subtype", subtype); + + db = dbopen (filename, accessmask, modemask, real_subtype, NULL); + if (!db) + return Qnil; + + dbase = new_database (); + dbase->db_handle = db; + dbase->type = DB_BERKELEY; + dbase->funcs = &berk_func_block; goto db_done; } -#endif - +#endif /* HAVE_BERKELEY_DB */ + signal_simple_error ("Unsupported database type", type); return Qnil; db_done: - db = funcblock->open_file ((char *) XSTRING_DATA (file), subtype, - accessmask, modemask); - - if (!db) - { - return Qnil; - } - - dbase = new_database (); + dbase->live_p = 1; dbase->fname = file; - dbase->type = the_type; dbase->mode = modemask; dbase->access_ = accessmask; - dbase->db_handle = db; - dbase->funcs = funcblock; XSETDATABASE (retval, dbase); return retval; } DEFUN ("put-database", Fputdatabase, 3, 4, 0, /* -Store KEY and VAL in DATABASE. If optinal fourth arg REPLACE is +Store KEY and VAL in DATABASE. If optional fourth arg REPLACE is non-nil, replace any existing entry in the database. */ (key, val, dbase, replace)) { - struct database_struct *db; - int status; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - - CHECK_DATABASE (dbase); + CHECK_LIVE_DATABASE (dbase); CHECK_STRING (key); CHECK_STRING (val); - db = XDATABASE (dbase); - if (!DATABASE_LIVE_P (db)) - signal_simple_error ("Attempting to access closed database", dbase); - GCPRO4 (key, val, dbase, replace); - status = db->funcs->put (db, key, val, replace); - UNGCPRO; - return status ? Qt : Qnil; + { + int status = + XDATABASE (dbase)->funcs->put (XDATABASE (dbase), key, val, replace); + return status ? Qt : Qnil; + } } DEFUN ("remove-database", Fremdatabase, 2, 2, 0, /* @@ -671,34 +629,27 @@ */ (key, dbase)) { - struct database_struct *db; - CHECK_DATABASE (dbase); + CHECK_LIVE_DATABASE (dbase); CHECK_STRING (key); - db = XDATABASE (dbase); - if (!DATABASE_LIVE_P (db)) - signal_simple_error ("Attempting to access closed database", dbase); - return db->funcs->rem (db, key) ? Qt : Qnil; + return XDATABASE (dbase)->funcs->rem (XDATABASE (dbase), key) ? Qt : Qnil; } - + DEFUN ("get-database", Fgetdatabase, 2, 3, 0, /* Find value for KEY in DATABASE. If there is no corresponding value, return DEFAULT (defaults to nil). */ (key, dbase, default_)) { - Lisp_Object retval; - struct database_struct *db; - CHECK_DATABASE (dbase); + CHECK_LIVE_DATABASE (dbase); CHECK_STRING (key); - db = XDATABASE (dbase); - if (!DATABASE_LIVE_P (db)) - signal_simple_error ("Attempting to access closed database", dbase); - retval = db->funcs->get (db, key); - - return NILP (retval) ? default_ : retval; + { + Lisp_Object retval = + XDATABASE (dbase)->funcs->get (XDATABASE (dbase), key); + return NILP (retval) ? default_ : retval; + } } DEFUN ("map-database", Fmapdatabase, 2, 2, 0, /* @@ -707,17 +658,10 @@ */ (function, dbase)) { - struct gcpro gcpro1, gcpro2; - struct database_struct *db; - - CHECK_DATABASE (dbase); - GCPRO2 (dbase, function); + CHECK_LIVE_DATABASE (dbase); - db = XDATABASE (dbase); - if (!DATABASE_LIVE_P (db)) - signal_simple_error ("Attempting to access closed database", dbase); - db->funcs->map (db, function); - UNGCPRO; + XDATABASE (dbase)->funcs->map (XDATABASE (dbase), function); + return Qnil; }
--- a/src/database.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/database.h Mon Aug 13 09:55:28 2007 +0200 @@ -1,6 +1,6 @@ #ifndef _XEMACS_DBM_H #define _XEMACS_DBM_H -DECLARE_LRECORD (database, struct database_struct); +DECLARE_LRECORD (database, struct database); #endif
--- a/src/debug.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/debug.c Mon Aug 13 09:55:28 2007 +0200 @@ -89,7 +89,7 @@ FROB (frames); FROB (devices); FROB (byte_code); - + return retval; #undef FROB }
--- a/src/device-tty.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/device-tty.c Mon Aug 13 09:55:28 2007 +0200 @@ -50,11 +50,7 @@ static void allocate_tty_device_struct (struct device *d) { - d->device_data = - (struct tty_device *) xmalloc (sizeof (struct tty_device)); - - /* zero out all slots. */ - memset (d->device_data, 0, sizeof (struct tty_device)); + d->device_data = xnew_and_zero (struct tty_device); } static void @@ -171,7 +167,7 @@ tail = XCDR (tail)) { struct frame *f = XFRAME (XCAR (tail)); - + /* We know the frame is tty because we made sure that the device is tty. */ change_frame_size (f, height, width, 1);
--- a/src/device-x.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/device-x.c Mon Aug 13 09:55:28 2007 +0200 @@ -66,7 +66,7 @@ static XrmOptionDescRec emacs_options[] = { {"-geometry", ".geometry", XrmoptionSepArg, NULL}, - {"-iconic", ".iconic", XrmoptionNoArg, (XtPointer) "yes"}, + {"-iconic", ".iconic", XrmoptionNoArg, "yes"}, {"-internal-border-width", "*EmacsFrame.internalBorderWidth", XrmoptionSepArg, NULL}, @@ -152,10 +152,7 @@ static void allocate_x_device_struct (struct device *d) { - d->device_data = (struct x_device *) xmalloc (sizeof (struct x_device)); - - /* zero out all slots. */ - memset (d->device_data, 0, sizeof (struct x_device)); + d->device_data = xnew_and_zero (struct x_device); } static void @@ -299,21 +296,23 @@ #endif /* HAVE_XIM */ #ifdef HAVE_SESSION - XtVaSetValues(DEVICE_XT_APP_SHELL (d), - XtNmappedWhenManaged, False, - XtNwidth, 1, - XtNheight, 1, - NULL); - XtRealizeWidget(DEVICE_XT_APP_SHELL (d)); { - int argc; - char **argv; + Arg al[3]; + Widget shell = DEVICE_XT_APP_SHELL (d); - make_argc_argv (Vcommand_line_args, &argc, &argv); - XSetCommand (XtDisplay (DEVICE_XT_APP_SHELL (d)), - XtWindow (DEVICE_XT_APP_SHELL (d)), argv, argc); - free_argc_argv (argv); + XtSetArg (al [0], XtNmappedWhenManaged, False); + XtSetArg (al [1],XtNwidth, 1); + XtSetArg (al [2],XtNheight, 1); + XtSetValues (shell, al, 3); + XtRealizeWidget (shell); + { + int new_argc; + char **new_argv; + make_argc_argv (Vcommand_line_args, &new_argc, &new_argv); + XSetCommand (XtDisplay (shell), XtWindow (shell), new_argv, new_argc); + free_argc_argv (new_argv); + } } #endif /* HAVE_SESSION */
--- a/src/device.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/device.c Mon Aug 13 09:55:28 2007 +0200 @@ -141,10 +141,7 @@ */ (device_class)) { - if (valid_device_class_p (device_class)) - return Qt; - else - return Qnil; + return valid_device_class_p (device_class) ? Qt : Qnil; } DEFUN ("device-class-list", Fdevice_class_list, 0, 0, 0, /* @@ -158,8 +155,8 @@ static struct device * allocate_device (Lisp_Object console) { - Lisp_Object device = Qnil; - struct device *d = alloc_lcrecord (sizeof (struct device), lrecord_device); + Lisp_Object device; + struct device *d = alloc_lcrecord_type (struct device, lrecord_device); struct gcpro gcpro1; zero_lcrecord (d); @@ -253,7 +250,7 @@ { struct device *dev = XDEVICE (device); Lisp_Object old_selected_device = Fselected_device (Qnil); - + if (EQ (device, old_selected_device)) return; @@ -299,7 +296,9 @@ */ (device, frame)) { - XSETDEVICE (device, decode_device (device)); + struct device *d = decode_device (device); + + XSETDEVICE (device, d); CHECK_LIVE_FRAME (frame); if (! EQ (device, FRAME_DEVICE (XFRAME (frame)))) @@ -317,9 +316,7 @@ */ (object)) { - if (!DEVICEP (object)) - return Qnil; - return Qt; + return DEVICEP (object) ? Qt : Qnil; } DEFUN ("device-live-p", Fdevice_live_p, 1, 1, 0, /* @@ -327,9 +324,7 @@ */ (object)) { - if (!DEVICEP (object) || !DEVICE_LIVE_P (XDEVICE (object))) - return Qnil; - return Qt; + return DEVICEP (object) && DEVICE_LIVE_P (XDEVICE (object)) ? Qt : Qnil; } DEFUN ("device-name", Fdevice_name, 0, 1, 0, /* @@ -499,7 +494,7 @@ delete_deviceless_console(Lisp_Object console) { if (NILP (XCONSOLE (console)->device_list)) - Fdelete_console(console, Qnil); + Fdelete_console (console, Qnil); return Qnil; } @@ -888,13 +883,9 @@ (device)) { struct device *d = decode_device (device); - int retval; + int retval = DEVMETH_OR_GIVEN (d, device_pixel_width, (d), 0); - retval = DEVMETH_OR_GIVEN (d, device_pixel_width, (d), 0); - if (retval <= 0) - return Qnil; - - return make_int (retval); + return retval <= 0 ? Qnil : make_int (retval); } DEFUN ("device-pixel-height", Fdevice_pixel_height, 0, 1, 0, /* @@ -903,13 +894,9 @@ (device)) { struct device *d = decode_device (device); - int retval; + int retval = DEVMETH_OR_GIVEN (d, device_pixel_height, (d), 0); - retval = DEVMETH_OR_GIVEN (d, device_pixel_height, (d), 0); - if (retval <= 0) - return Qnil; - - return make_int (retval); + return retval <= 0 ? Qnil : make_int (retval); } DEFUN ("device-mm-width", Fdevice_mm_width, 0, 1, 0, /* @@ -918,13 +905,9 @@ (device)) { struct device *d = decode_device (device); - int retval; + int retval = DEVMETH_OR_GIVEN (d, device_mm_width, (d), 0); - retval = DEVMETH_OR_GIVEN (d, device_mm_width, (d), 0); - if (retval <= 0) - return Qnil; - - return make_int (retval); + return retval <= 0 ? Qnil : make_int (retval); } DEFUN ("device-mm-height", Fdevice_mm_height, 0, 1, 0, /* @@ -933,13 +916,9 @@ (device)) { struct device *d = decode_device (device); - int retval; + int retval = DEVMETH_OR_GIVEN (d, device_mm_height, (d), 0); - retval = DEVMETH_OR_GIVEN (d, device_mm_height, (d), 0); - if (retval <= 0) - return Qnil; - - return make_int (retval); + return retval <= 0 ? Qnil : make_int (retval); } DEFUN ("device-bitplanes", Fdevice_bitplanes, 0, 1, 0, /* @@ -948,13 +927,9 @@ (device)) { struct device *d = decode_device (device); - int retval; + int retval = DEVMETH_OR_GIVEN (d, device_bitplanes, (d), 0); - retval = DEVMETH_OR_GIVEN (d, device_bitplanes, (d), 0); - if (retval <= 0) - return Qnil; - - return make_int (retval); + return retval <= 0 ? Qnil : make_int (retval); } DEFUN ("device-color-cells", Fdevice_color_cells, 0, 1, 0, /* @@ -963,13 +938,9 @@ (device)) { struct device *d = decode_device (device); - int retval; + int retval = DEVMETH_OR_GIVEN (d, device_color_cells, (d), 0); - retval = DEVMETH_OR_GIVEN (d, device_color_cells, (d), 0); - if (retval <= 0) - return Qnil; - - return make_int (retval); + return retval <= 0 ? Qnil : make_int (retval); } DEFUN ("set-device-baud-rate", Fset_device_baud_rate, 2, 2, 0, /* @@ -1040,7 +1011,7 @@ call1_with_handler (Qreally_early_error_handler, function, object); else call0_with_handler (Qreally_early_error_handler, function); - + UNLOCK_DEVICE (d); Vinhibit_quit = old_inhibit_quit; gc_currently_forbidden = old_gc_currently_forbidden;
--- a/src/dgif_lib.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/dgif_lib.c Mon Aug 13 09:55:28 2007 +0200 @@ -14,8 +14,8 @@ #ifdef emacs #include <config.h> -void *xmalloc (unsigned int size); -void *xrealloc (void *ptr, unsigned int size); +void *xmalloc (size_t size); +void *xrealloc (void *ptr, size_t size); #ifdef ERROR_CHECK_MALLOC void *xfree_1 (void *); #define xfree xfree_1 @@ -325,7 +325,7 @@ FreeMapObject(GifFile->Image.ColorMap); GifFile->Image.ColorMap = MakeMapObject(1 << BitsPerPixel, NULL); - + /* Get the image local color map: */ for (i = 0; i < GifFile->Image.ColorMap->ColorCount; i++) { if (fread(Buf, 1, 3, Private->File) != 3) { @@ -983,7 +983,7 @@ } #else /* Skip any extension blocks in the file. */ - if (DGifGetExtension (GifFile, &ExtCode, &ExtData) + if (DGifGetExtension (GifFile, &ExtCode, &ExtData) == GIF_ERROR) return GIF_ERROR;
--- a/src/dialog-x.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/dialog-x.c Mon Aug 13 09:55:28 2007 +0200 @@ -223,9 +223,9 @@ Each of these is a vector, the syntax of which is essentially the same as that of popup menu items. They may have any of the following forms: - [ \"name\" callback <active-p> ] - [ \"name\" callback <active-p> \"suffix\" ] - [ \"name\" callback :<keyword> <value> :<keyword> <value> ... ] + [ "name" callback <active-p> ] + [ "name" callback <active-p> "suffix" ] + [ "name" callback :<keyword> <value> :<keyword> <value> ... ] The name is the string to display on the button; it is filtered through the resource database, so it is possible for resources to override what string @@ -238,7 +238,7 @@ One (and only one) of the buttons may be `nil'. This marker means that all following buttons should be flushright instead of flushleft. -Though the keyword/value syntax is supported for dialog boxes just as in +Though the keyword/value syntax is supported for dialog boxes just as in popup menus, the only keyword which is both meaningful and fully implemented for dialog box buttons is `:active'. */ @@ -277,7 +277,7 @@ for the dialog widget) to begin. Eventually, a dialog item is selected, and a misc-user-event blip is pushed onto the end of the input stream, which is then executed by the event loop. - + So there are two command-events, with a bunch of magic-events between them. We don't want the *first* command event to alter the state of the region, so that the region can be available as
--- a/src/dired.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/dired.c Mon Aug 13 09:55:28 2007 +0200 @@ -45,7 +45,7 @@ If MATCH is non-nil, only pathnames containing that regexp are returned. If NOSORT is non-nil, the list is not sorted--its order is unpredictable. NOSORT is useful if you plan to sort the result yourself. -If FILES-ONLY is the symbol t, then only the \"files\" in the directory +If FILES-ONLY is the symbol t, then only the "files" in the directory will be returned; subdirectories will be excluded. If FILES-ONLY is not nil and not t, then only the subdirectories will be returned. Otherwise, if FILES-ONLY is nil (the default) then both files and subdirectories will @@ -207,8 +207,8 @@ return Fsort (Fnreverse (list), Qstring_lessp); } -static Lisp_Object file_name_completion (Lisp_Object file, - Lisp_Object dirname, +static Lisp_Object file_name_completion (Lisp_Object file, + Lisp_Object dirname, int all_flag, int ver_flag); DEFUN ("file-name-completion", Ffile_name_completion, 2, 2, 0, /* @@ -473,7 +473,7 @@ an exact match. This way, we get the case pattern of the actual match. */ if ((matchsize == cclen - && matchsize + !!directoryp + && matchsize + !!directoryp < string_char_length (XSTRING (bestmatch))) || /* If there is no exact match ignoring case, @@ -481,7 +481,7 @@ of the input. */ (((matchsize == cclen) == - (matchsize + !!directoryp + (matchsize + !!directoryp == string_char_length (XSTRING (bestmatch)))) /* If there is more than one exact match aside from case, and one of them is exact including case, @@ -654,7 +654,7 @@ char *tmpnam = (char *) XSTRING_DATA (Ffile_name_nondirectory (filename)); int l = strlen (tmpnam); - if (l >= 5 + if (l >= 5 && S_ISREG (s.st_mode) && (stricmp (&tmpnam[l - 4], ".com") == 0 || stricmp (&tmpnam[l - 4], ".exe") == 0 ||
--- a/src/doc.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/doc.c Mon Aug 13 09:55:28 2007 +0200 @@ -92,7 +92,7 @@ nread = read (fd, p, space_left); if (nread < 0) { - return_me = list1 (build_string + return_me = list1 (build_string ("Read error on documentation file")); goto done; } @@ -121,7 +121,7 @@ else { int c = *(++from); - + from++; switch (c) { @@ -190,7 +190,7 @@ if (!STRINGP (file)) return Qnil; - + /* Put the file name in NAME as a C string. If it is relative, combine it with Vdoc_directory. */ @@ -381,7 +381,7 @@ else doc = Fdgettext (domain, doc); } -#endif +#endif if (NILP (raw) && STRINGP (doc)) doc = Fsubstitute_command_keys (doc); return doc; @@ -430,7 +430,7 @@ strcpy (name, "../lib-src/"); #else /* CANNOT_DUMP */ CHECK_STRING (Vdoc_directory); - name = (char *) alloca (XSTRING_LENGTH (filename) + name = (char *) alloca (XSTRING_LENGTH (filename) + XSTRING_LENGTH (Vdoc_directory) + 1); strcpy (name, (char *) XSTRING_DATA (Vdoc_directory)); @@ -481,7 +481,7 @@ goto weird; } Fput (sym, Qvariable_documentation, - ((end[1] == '*') + ((end[1] == '*') ? make_int (- XINT (offset)) : offset)); } @@ -669,7 +669,7 @@ doc = -1; tem = Fcdr (Fcdr (fun)); if (CONSP (tem) && - INTP (XCAR (tem))) + INTP (XCAR (tem))) doc = XINT (XCAR (tem)); } } @@ -728,7 +728,7 @@ Substitute key descriptions for command names in STRING. Return a new string which is STRING with substrings of the form \\=\\[COMMAND] replaced by either: a keystroke sequence that will invoke COMMAND, -or \"M-x COMMAND\" if COMMAND is not on any keys. +or "M-x COMMAND" if COMMAND is not on any keys. Substrings of the form \\=\\{MAPVAR} are replaced by summaries \(made by describe-bindings) of the value of MAPVAR, taken as a keymap. Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR @@ -794,7 +794,7 @@ for (idx = 0; idx < strlength; ) { Bufbyte *strp = strdata + idx; - + if (strp[0] != '\\') { /* just copy other chars */ @@ -834,9 +834,9 @@ while ((idx < strlength) && *strp != ']') - { - strp++; - idx++; + { + strp++; + idx++; } length = strp - start; idx++; /* skip ] */ @@ -885,9 +885,9 @@ while ((idx < strlength) && *strp != '}' && *strp != '>') - { - strp++; - idx++; + { + strp++; + idx++; } length = strp - start; idx++; /* skip } or > */
--- a/src/doprnt.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/doprnt.c Mon Aug 13 09:55:28 2007 +0200 @@ -39,6 +39,7 @@ static CONST char *double_converters = "feEgG"; static CONST char *string_converters = "sS"; +typedef struct printf_spec printf_spec; struct printf_spec { int argnum; /* which argument does this spec want? This is one-based: @@ -61,6 +62,7 @@ Bytecount text_before_len; /* length of that text */ }; +typedef union printf_arg printf_arg; union printf_arg { int i; @@ -120,7 +122,7 @@ to_add--; } } - + if (maxlen >= 0) len = charcount_to_bytecount (string, min (maxlen, cclen)); Lstream_write (lstr, string, len); @@ -142,7 +144,7 @@ { Bufbyte arg_convert[100]; REGISTER Bufbyte *arg_ptr = arg_convert; - + *returned_num = -1; while (start != end && isdigit (*start)) { @@ -171,7 +173,7 @@ { CONST Bufbyte *fmt = format; CONST Bufbyte *fmt_end = format + format_length; - printf_spec_dynarr *specs = Dynarr_new (struct printf_spec); + printf_spec_dynarr *specs = Dynarr_new (printf_spec); int prev_argnum = 0; while (1) @@ -235,7 +237,7 @@ } NEXT_ASCII_BYTE (ch); } - + /* Parse off the minimum field width */ fmt--; /* back up */ fmt = parse_off_posnum (fmt, fmt_end, &spec.minwidth); @@ -310,7 +312,7 @@ static printf_arg_dynarr * get_doprnt_args (printf_spec_dynarr *specs, va_list vargs) { - printf_arg_dynarr *args = Dynarr_new (union printf_arg); + printf_arg_dynarr *args = Dynarr_new (printf_arg); union printf_arg arg; REGISTER int i; int args_needed = get_args_needed (specs); @@ -379,7 +381,7 @@ static Bytecount emacs_doprnt_1 (Lisp_Object stream, CONST Bufbyte *format_nonreloc, Lisp_Object format_reloc, Bytecount format_length, - int nargs, + int nargs, /* #### Gag me, gag me, gag me */ CONST Lisp_Object *largs, va_list vargs) { @@ -445,6 +447,15 @@ if (!largs) { string = Dynarr_at (args, spec->argnum - 1).bp; + /* error() can be called with null string arguments. + E.g., in fileio.c, the return value of strerror() + is never checked. We'll print (null), like some + printf implementations do. Would it be better (and safe) + to signal an error instead? Or should we just use the + empty string? -dkindred@cs.cmu.edu 8/1997 + */ + if (!string) + string = "(null)"; string_len = strlen ((char *) string); } else @@ -532,7 +543,7 @@ a = (Emchar) arg.l; else a = (Emchar) arg.i; - + if (!valid_char_p (a)) error ("invalid character value %d to %%c spec", a); @@ -690,16 +701,15 @@ Lisp_Object format_reloc, Bytecount format_length, int nargs, ...) { - Lisp_Object *foo; va_list vargs; int i; + Lisp_Object *foo = alloca_array (Lisp_Object, nargs); - foo = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object)); va_start (vargs, nargs); for (i = 0; i < nargs; i++) foo[i] = va_arg (vargs, Lisp_Object); va_end (vargs); - + return emacs_doprnt_2 (stream, format_nonreloc, format_reloc, format_length, nargs, foo); } @@ -782,16 +792,15 @@ Lisp_Object obj; Lisp_Object stream = make_resizing_buffer_output_stream (); struct gcpro gcpro1; - Lisp_Object *foo; va_list vargs; int i; + Lisp_Object *foo = alloca_array (Lisp_Object, nargs); - foo = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object)); va_start (vargs, nargs); for (i = 0; i < nargs; i++) foo[i] = va_arg (vargs, Lisp_Object); va_end (vargs); - + GCPRO1 (stream); emacs_doprnt_2 (stream, format_nonreloc, format_reloc, format_length, nargs, foo);
--- a/src/dynarr.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/dynarr.c Mon Aug 13 09:55:28 2007 +0200 @@ -44,17 +44,19 @@ This is a container object. Declare a dynamic array of a specific type as follows: -struct mytype_dynarr +typdef struct { Dynarr_declare (mytype); -}; +} mytype_dynarr; Use the following functions/macros: void *Dynarr_new(type) [MACRO] Create a new dynamic-array object, with each element of the - specified type. The return value is a void * and must be cast to the - proper dynamic array type. + specified type. The return value is cast to (type##_dynarr). + This requires following the convention that types are declared in + such a way that this type concatenation works. In particular, TYPE + must be a symbol, not an arbitrary C type. Dynarr_add(d, el) [MACRO] Add an element to the end of a dynamic array. EL is a pointer @@ -76,6 +78,10 @@ int Dynarr_length(d) [MACRO] Return the number of elements currently in a dynamic array. + int Dynarr_largest(d) + [MACRO] Return the maximum value that Dynarr_length(d) would + ever have returned. + type Dynarr_at(d, i) [MACRO] Return the element at the specified index (no bounds checking done on the index). The element itself is returned, not a pointer @@ -108,9 +114,7 @@ void * Dynarr_newf (int elsize) { - Dynarr *d = (Dynarr *) xmalloc (sizeof (Dynarr)); - - memset (d, 0, sizeof (*d)); + Dynarr *d = xnew_and_zero (Dynarr); d->elsize = elsize; return d; @@ -229,4 +233,4 @@ return total; } -#endif +#endif /* MEMORY_USAGE_STATS */
--- a/src/dynarr.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/dynarr.h Mon Aug 13 09:55:28 2007 +0200 @@ -43,7 +43,7 @@ void Dynarr_delete_many (void *d, int start, int len); void Dynarr_free (void *d); -#define Dynarr_new(type) Dynarr_newf (sizeof(* (type *) NULL)) +#define Dynarr_new(type) ((type##_dynarr *) Dynarr_newf (sizeof(type))) #define Dynarr_at(d, pos) ((d)->base[pos]) #define Dynarr_atp(d, pos) (&Dynarr_at (d, pos)) #define Dynarr_length(d) ((d)->cur)
--- a/src/editfns.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/editfns.c Mon Aug 13 09:55:28 2007 +0200 @@ -135,12 +135,12 @@ getpwnam ((char *) XSTRING_DATA (Vuser_login_name)); speed_up_interrupts (); } - + p = (Bufbyte *) ((pw) ? USER_FULL_NAME : "unknown"); /* don't gettext here */ q = (Bufbyte *) strchr ((char *) p, ','); Vuser_full_name = make_ext_string (p, (q ? q - p : strlen ((char *) p)), FORMAT_OS); - + #ifdef AMPERSAND_FULL_NAME p = XSTRING_DATA (Vuser_full_name); q = (Bufbyte *) strchr ((char *) p, '&'); @@ -462,7 +462,7 @@ and cleaner never to alter the window/buffer connections. */ /* #### I'm certain some code somewhere depends on this behavior. --jwz */ - if (visible + if (visible && (current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))) switch_to_buffer (Fcurrent_buffer (), Qnil); #endif @@ -489,7 +489,7 @@ int speccount = specpdl_depth (); record_unwind_protect (save_excursion_restore, save_excursion_save ()); - + return unbind_to (speccount, Fprogn (args)); } @@ -688,7 +688,7 @@ get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD))); n--; - + if (n < BUF_BEGV (b)) return Qnil; return make_char (BUF_FETCH_CHAR (b, n)); @@ -782,11 +782,11 @@ struct passwd *pw = NULL; Lisp_Object tem; char *p, *q; - + if (!NILP (user_name)) /* nil when nonexistent UID passed as arg */ { CONST char *user_name_ext; - + /* Fuck me. getpwnam() can call select() and (under IRIX at least) things get wedged if a SIGIO arrives during this time. */ GET_C_STRING_OS_DATA_ALLOCA (user_name, user_name_ext); @@ -955,12 +955,12 @@ %A is replaced by the full name of the day of week. %b is replaced by the abbreviated name of the month. %B is replaced by the full name of the month. -%c is a synonym for \"%x %X\". -%C is a locale-specific synonym, which defaults to \"%A, %B %e, %Y\" in the C locale. +%c is a synonym for "%x %X". +%C is a locale-specific synonym, which defaults to "%A, %B %e, %Y" in the C locale. %d is replaced by the day of month, zero-padded. -%D is a synonym for \"%m/%d/%y\". +%D is a synonym for "%m/%d/%y". %e is replaced by the day of month, blank-padded. -%h is a synonym for \"%b\". +%h is a synonym for "%b". %H is replaced by the hour (00-23). %I is replaced by the hour (00-12). %j is replaced by the day of the year (001-366). @@ -968,18 +968,18 @@ %l is replaced by the hour (1-12), blank padded. %m is replaced by the month (01-12). %M is replaced by the minute (00-59). -%n is a synonym for \"\\n\". +%n is a synonym for "\\n". %p is replaced by AM or PM, as appropriate. -%r is a synonym for \"%I:%M:%S %p\". -%R is a synonym for \"%H:%M\". +%r is a synonym for "%I:%M:%S %p". +%R is a synonym for "%H:%M". %S is replaced by the second (00-60). -%t is a synonym for \"\\t\". -%T is a synonym for \"%H:%M:%S\". +%t is a synonym for "\\t". +%T is a synonym for "%H:%M:%S". %U is replaced by the week of the year (00-53), first day of week is Sunday. %w is replaced by the day of week (0-6), Sunday is day 0. %W is replaced by the week of the year (00-53), first day of week is Monday. -%x is a locale-specific synonym, which defaults to \"%D\" in the C locale. -%X is a locale-specific synonym, which defaults to \"%T\" in the C locale. +%x is a locale-specific synonym, which defaults to "%D" in the C locale. +%X is a locale-specific synonym, which defaults to "%T" in the C locale. %y is replaced by the year without century (00-99). %Y is replaced by the year with century. %Z is replaced by the time zone abbreviation. @@ -1036,7 +1036,7 @@ struct tm save_tm; struct tm *decoded_time; Lisp_Object list_args[9]; - + if (! lisp_to_time (specified_time, &time_spec)) error ("Invalid time specification"); @@ -1104,7 +1104,7 @@ char tzbuf[100]; char *tzstring; char **oldenv = environ, **newenv; - + if (STRINGP (zone)) tzstring = (char *) XSTRING_DATA (zone); else if (INTP (zone)) @@ -1117,7 +1117,7 @@ else error ("Invalid time zone specification"); - /* Set TZ before calling mktime; merely adjusting mktime's returned + /* Set TZ before calling mktime; merely adjusting mktime's returned value doesn't suffice, since that would mishandle leap seconds. */ set_time_zone_rule (tzstring); @@ -1451,7 +1451,7 @@ if (n <= 0) return Qnil; slen = min (n, 768); - string = (Bufbyte *) alloca (slen * sizeof (Bufbyte)); + string = alloca_array (Bufbyte, slen); /* Write as many copies of the character into the temp string as will fit. */ for (i = 0; i + charlen <= slen; i += charlen) for (j = 0; j < charlen; j++) @@ -1836,7 +1836,7 @@ start = BUF_BEG (buf) + newhead; end = BUF_Z (buf) - newtail; - + bi_start = bufpos_to_bytind (buf, start); bi_end = bufpos_to_bytind (buf, end); @@ -1906,7 +1906,7 @@ %f means print as a floating-point number in fixed notation (e.g. 785.200). %e or %E means print as a floating-point number in scientific notation (e.g. 7.85200e+03). -%g or %G means print as a floating-point number in \"pretty format\"; +%g or %G means print as a floating-point number in "pretty format"; depending on the number, either %f or %e/%E format will be used, and trailing zeroes are removed from the fractional part. The argument used for all but %s and %S must be a number. It will be @@ -1999,7 +1999,7 @@ Traverses the entire marker list of the buffer to do so, adding an appropriate amount to some, subtracting from some, and leaving the rest untouched. Most of this is copied from adjust_markers in insdel.c. - + It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */ void @@ -2030,7 +2030,7 @@ /* The difference between the region's lengths */ diff = (end2 - start2) - (end1 - start1); - + /* For shifting each marker in a region by the length of the other * region plus the distance between the regions. */ @@ -2188,7 +2188,7 @@ staticpro (&Vuser_full_name); staticpro (&Vuser_name); staticpro (&Vuser_real_name); -#endif +#endif DEFVAR_BOOL ("zmacs-regions", &zmacs_regions /* *Whether LISPM-style active regions should be used. This means that commands which operate on the region (the area between the @@ -2203,7 +2203,7 @@ - Only a very small set of commands cause the region to become active: Those commands whose semantics are to mark an area, like mark-defun. - The region is deactivated after each command that is executed, except that: - - \"Motion\" commands do not change whether the region is active or not. + - "Motion" commands do not change whether the region is active or not. set-mark-command (C-SPC) pushes a mark and activates the region. Moving the cursor with normal motion commands (C-n, C-p, etc) will cause the region
--- a/src/elhash.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/elhash.c Mon Aug 13 09:55:28 2007 +0200 @@ -31,7 +31,7 @@ #define LISP_OBJECTS_PER_HENTRY (sizeof (hentry) / sizeof (Lisp_Object))/* 2 */ -struct hashtable_struct +struct hashtable { struct lcrecord_header header; unsigned int fullness; @@ -50,12 +50,12 @@ static void print_hashtable (Lisp_Object, Lisp_Object, int); DEFINE_LRECORD_IMPLEMENTATION ("hashtable", hashtable, mark_hashtable, print_hashtable, 0, 0, 0, - struct hashtable_struct); + struct hashtable); static Lisp_Object mark_hashtable (Lisp_Object obj, void (*markobj) (Lisp_Object)) { - struct hashtable_struct *table = XHASHTABLE (obj); + struct hashtable *table = XHASHTABLE (obj); if (table->type != HASHTABLE_NONWEAK) { @@ -69,11 +69,11 @@ ((markobj) (table->zero_entry)); return table->harray; } - + static void print_hashtable (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { - struct hashtable_struct *table = XHASHTABLE (obj); + struct hashtable *table = XHASHTABLE (obj); char buf[200]; if (print_readably) error ("printing unreadable object #<hashtable 0x%x>", @@ -92,12 +92,11 @@ } static void -ht_copy_to_c (struct hashtable_struct *ht, - c_hashtable c_table) +ht_copy_to_c (struct hashtable *ht, c_hashtable c_table) { int len = XVECTOR_LENGTH (ht->harray); - c_table->harray = (void *) XVECTOR_DATA (ht->harray); + c_table->harray = (hentry *) XVECTOR_DATA (ht->harray); c_table->zero_set = (!GC_UNBOUNDP (ht->zero_entry)); c_table->zero_entry = LISP_TO_VOID (ht->zero_entry); if (len < 0) @@ -118,13 +117,12 @@ } static void -ht_copy_from_c (c_hashtable c_table, - struct hashtable_struct *ht) +ht_copy_from_c (c_hashtable c_table, struct hashtable *ht) { struct Lisp_Vector dummy; /* C is truly hateful */ void *vec_addr - = ((char *) c_table->harray + = ((char *) c_table->harray - ((char *) &(dummy.contents[0]) - (char *) &dummy)); XSETVECTOR (ht->harray, vec_addr); @@ -136,11 +134,11 @@ } -static struct hashtable_struct * +static struct hashtable * allocate_hashtable (void) { - struct hashtable_struct *table - = alloc_lcrecord (sizeof (struct hashtable_struct), lrecord_hashtable); + struct hashtable *table = + alloc_lcrecord_type (struct hashtable, lrecord_hashtable); table->harray = Qnil; table->zero_entry = Qunbound; table->fullness = 0; @@ -153,9 +151,8 @@ elisp_hvector_malloc (unsigned int bytes, Lisp_Object table) { Lisp_Object new_vector; - struct hashtable_struct *ht; + struct hashtable *ht = XHASHTABLE (table); - ht = XHASHTABLE (table); assert (bytes > XVECTOR_LENGTH (ht->harray) * sizeof (Lisp_Object)); new_vector = make_vector ((bytes / sizeof (Lisp_Object)), Qzero); return (void *) XVECTOR_DATA (new_vector); @@ -164,7 +161,7 @@ void elisp_hvector_free (void *ptr, Lisp_Object table) { - struct hashtable_struct *ht = XHASHTABLE (table); + struct hashtable *ht = XHASHTABLE (table); #if defined (USE_ASSERTIONS) || defined (DEBUG_XEMACS) Lisp_Object current_vector = ht->harray; #endif @@ -252,7 +249,7 @@ enum hashtable_test_fun test) { Lisp_Object result; - struct hashtable_struct *table = allocate_hashtable (); + struct hashtable *table = allocate_hashtable (); table->harray = make_vector ((compute_harray_size (size) * LISP_OBJECTS_PER_HENTRY), @@ -303,7 +300,7 @@ if (EQ (sym, Qeq)) return HASHTABLE_EQ; if (EQ (sym, Qequal)) return HASHTABLE_EQUAL; if (EQ (sym, Qeql)) return HASHTABLE_EQL; - + signal_simple_error ("Invalid hashtable test fun", sym); return HASHTABLE_EQ; /* not reached */ } @@ -333,8 +330,8 @@ { struct _C_hashtable old_htbl; struct _C_hashtable new_htbl; - struct hashtable_struct *old_ht; - struct hashtable_struct *new_ht; + struct hashtable *old_ht; + struct hashtable *new_ht; Lisp_Object result; CHECK_HASHTABLE (old_table); @@ -385,7 +382,7 @@ CVOID_TO_LISP (val, vval); return val; } - else + else return default_; } @@ -410,7 +407,7 @@ */ (key, val, table)) { - struct hashtable_struct *ht; + struct hashtable *ht; void *vkey = LISP_TO_VOID (key); CHECK_HASHTABLE (table); @@ -471,8 +468,8 @@ else if (CONSP (function)) { Lisp_Object funcar = Fcar (function); - if ((SYMBOLP (funcar)) - && (EQ (funcar, Qlambda) + if ((SYMBOLP (funcar)) + && (EQ (funcar, Qlambda) || EQ (funcar, Qautoload))) return; } @@ -621,7 +618,7 @@ We complete the marking for semi-weak hashtables. */ CVOID_TO_LISP (keytem, key); CVOID_TO_LISP (valuetem, contents); - + switch (fmh->type) { case HASHTABLE_KEY_WEAK: @@ -677,7 +674,7 @@ default: abort (); /* Huh? */ } - + return; } @@ -747,8 +744,7 @@ pruning_mapper (CONST void *key, CONST void *contents, void *closure) { Lisp_Object keytem, valuetem; - struct pruning_closure *fmh = - (struct pruning_closure *) closure; + struct pruning_closure *fmh = (struct pruning_closure *) closure; /* This function is called over each pair in the hashtable. We remove the pairs that aren't completely marked (everything @@ -804,13 +800,13 @@ hash = HASH2 (hash, internal_hash (arr[i], depth + 1)); return hash; } - + /* just pick five elements scattered throughout the array. A slightly better approach would be to offset by some noise factor from the points chosen below. */ for (i = 0; i < 5; i++) hash = HASH2 (hash, internal_hash (arr[i*size/5], depth + 1)); - + return hash; }
--- a/src/elhash.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/elhash.h Mon Aug 13 09:55:28 2007 +0200 @@ -23,9 +23,9 @@ #ifndef _XEMACS_ELHASH_H_ #define _XEMACS_ELHASH_H_ -DECLARE_LRECORD (hashtable, struct hashtable_struct); +DECLARE_LRECORD (hashtable, struct hashtable); -#define XHASHTABLE(x) XRECORD (x, hashtable, struct hashtable_struct) +#define XHASHTABLE(x) XRECORD (x, hashtable, struct hashtable) #define XSETHASHTABLE(x, p) XSETRECORD (x, p, hashtable) #define HASHTABLEP(x) RECORDP (x, hashtable) #define GC_HASHTABLEP(x) GC_RECORDP (x, hashtable)
--- a/src/emacs.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/emacs.c Mon Aug 13 09:55:28 2007 +0200 @@ -1565,14 +1565,14 @@ static void sort_args (int argc, char **argv) { - char **new = (char **) xmalloc (sizeof (char *) * argc); + char **new = xnew_array (char *, argc); /* For each element of argv, the corresponding element of options is: 0 for an option that takes no arguments, 1 for an option that takes one argument, etc. -1 for an ordinary non-option argument. */ - int *options = (int *) xmalloc (sizeof (int) * argc); - int *priority = (int *) xmalloc (sizeof (int) * argc); + int *options = xnew_array (int, argc); + int *priority = xnew_array (int, argc); int to = 1; int from; int i; @@ -1713,7 +1713,7 @@ much as long as your filesystem is local, and you don't end up with a dumped version in case you want to rerun it. This function is most useful when used as part of the `make all-elc' command. --ben] - This will \"restart\" emacs with the specified command-line arguments. + This will "restart" emacs with the specified command-line arguments. */ (int nargs, Lisp_Object *args)) { @@ -1722,8 +1722,8 @@ int namesize; int total_len; Lisp_Object orig_invoc_name = Fcar (Vcommand_line_args); - Extbyte **wampum_all = (Extbyte **) alloca (nargs * sizeof (Extbyte *)); - int *wampum_all_len = (int *) alloca (nargs * sizeof (int)); + Extbyte **wampum_all = alloca_array (Extbyte *, nargs); + int *wampum_all_len = alloca_array (int, nargs); assert (!gc_in_progress);
--- a/src/emacsfns.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/emacsfns.h Mon Aug 13 09:55:28 2007 +0200 @@ -73,17 +73,7 @@ Lisp_Object list6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); -void malloc_warning (CONST char *); DECLARE_DOESNT_RETURN (memory_full (void)); -void *xmalloc (int size); -void *xmalloc_and_zero (int size); -void *xrealloc (void *, int size); -#ifdef ERROR_CHECK_MALLOC -void xfree_1 (void *); -#else -void xfree (void *); -#endif -char *xstrdup (CONST char *); void disksave_object_finalization (void); extern int purify_flag; extern int gc_currently_forbidden; @@ -195,8 +185,8 @@ /* Defined in bytecode.c */ extern Lisp_Object Qbyte_code; -Lisp_Object Fbyte_code (Lisp_Object bytestr, - Lisp_Object constants_vector, +Lisp_Object Fbyte_code (Lisp_Object bytestr, + Lisp_Object constants_vector, Lisp_Object maxdepth); @@ -268,7 +258,7 @@ /* Defined in console.c */ Lisp_Object Fset_input_mode (Lisp_Object interrupt, - Lisp_Object flow, + Lisp_Object flow, Lisp_Object meta, Lisp_Object quit, Lisp_Object console); @@ -480,7 +470,7 @@ Lisp_Object ignored, Lisp_Object buffer); void buffer_insert1 (struct buffer *buf, Lisp_Object arg); Lisp_Object Finsert_before_markers (int nargs, Lisp_Object *args); -Lisp_Object Finsert_buffer_substring (Lisp_Object buffer, +Lisp_Object Finsert_buffer_substring (Lisp_Object buffer, Lisp_Object b, Lisp_Object e); Lisp_Object Fdelete_region (Lisp_Object b, Lisp_Object e, Lisp_Object buffer); @@ -700,7 +690,7 @@ /* Lisp_Object Funwind_protect (Lisp_Object args); */ /* Lisp_Object Fcondition_case (Lisp_Object args); */ Lisp_Object Fthrow (Lisp_Object tag, Lisp_Object val); -Lisp_Object internal_catch (Lisp_Object tag, +Lisp_Object internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object arg), Lisp_Object arg, int *threw); @@ -710,8 +700,8 @@ Lisp_Object (*hfun) (Lisp_Object val, Lisp_Object harg), Lisp_Object harg); -Lisp_Object Fcondition_case_3 (Lisp_Object bodyform, - Lisp_Object var, +Lisp_Object Fcondition_case_3 (Lisp_Object bodyform, + Lisp_Object var, Lisp_Object handlers); Lisp_Object unbind_to (int n, Lisp_Object val); void specbind (Lisp_Object symbol, Lisp_Object value); @@ -744,10 +734,10 @@ int detect_input_pending (void); void enqueue_command_event (Lisp_Object event); Lisp_Object dequeue_command_event (void); -Lisp_Object Fadd_timeout (Lisp_Object secs, - Lisp_Object function, Lisp_Object object, +Lisp_Object Fadd_timeout (Lisp_Object secs, + Lisp_Object function, Lisp_Object object, Lisp_Object resignal); -Lisp_Object Fdisable_timeout (Lisp_Object id); +Lisp_Object Fdisable_timeout (Lisp_Object id); void reset_this_command_keys (Lisp_Object console, int clear_echo_area_p); Lisp_Object Fenqueue_eval_event (Lisp_Object function, Lisp_Object object); @@ -819,14 +809,14 @@ Lisp_Object, Lisp_Object); Lisp_Object Fdelete_extent (Lisp_Object extent); Lisp_Object Fdetach_extent (Lisp_Object); -Lisp_Object Fmap_extents (Lisp_Object function, - Lisp_Object buffer, +Lisp_Object Fmap_extents (Lisp_Object function, + Lisp_Object buffer, Lisp_Object from, Lisp_Object to, Lisp_Object maparg, Lisp_Object flags, Lisp_Object property, Lisp_Object value); -Lisp_Object Fextent_at (Lisp_Object pos, Lisp_Object buffer, +Lisp_Object Fextent_at (Lisp_Object pos, Lisp_Object buffer, Lisp_Object flag, Lisp_Object before, Lisp_Object at_flag); Lisp_Object Fextent_face (Lisp_Object); @@ -966,12 +956,12 @@ /* Defined in fns.c */ -Lisp_Object list_sort (Lisp_Object list, +Lisp_Object list_sort (Lisp_Object list, Lisp_Object lisp_arg, int (*pred_fn) (Lisp_Object first, Lisp_Object second, Lisp_Object lisp_arg)); -Lisp_Object Fsort (Lisp_Object list, +Lisp_Object Fsort (Lisp_Object list, Lisp_Object pred); Lisp_Object merge (Lisp_Object org_l1, Lisp_Object org_l2, Lisp_Object pred); @@ -1110,11 +1100,11 @@ Lisp_Object rows, Lisp_Object pretend); Lisp_Object Fset_frame_width (Lisp_Object frame, Lisp_Object cols, Lisp_Object pretend); -Lisp_Object Fset_frame_size (Lisp_Object frame, - Lisp_Object cols, Lisp_Object rows, +Lisp_Object Fset_frame_size (Lisp_Object frame, + Lisp_Object cols, Lisp_Object rows, Lisp_Object pretend); Lisp_Object Fset_frame_position (Lisp_Object frame, - Lisp_Object xoffset, + Lisp_Object xoffset, Lisp_Object yoffset); Lisp_Object Fdelete_frame (Lisp_Object frame, Lisp_Object force); Lisp_Object Fset_frame_properties (Lisp_Object frame, Lisp_Object plist); @@ -1335,7 +1325,7 @@ Lisp_Object Fvertical_motion (Lisp_Object lines, Lisp_Object window); Lisp_Object Findent_to (Lisp_Object col, Lisp_Object mincol, Lisp_Object buffer); -Lisp_Object Fcurrent_column (Lisp_Object buffer); +Lisp_Object Fcurrent_column (Lisp_Object buffer); int bi_spaces_at_point (struct buffer *b, Bytind pos); int column_at_point (struct buffer *buf, Bufpos pos, int cur_col); int current_column (struct buffer *buf); @@ -1381,7 +1371,7 @@ extern Lisp_Object Vload_file_name_internal; extern Lisp_Object Vload_file_name_internal_the_purecopy; Lisp_Object Fread (Lisp_Object readcharfun); -Lisp_Object Fread_from_string (Lisp_Object string, +Lisp_Object Fread_from_string (Lisp_Object string, Lisp_Object start, Lisp_Object end); Lisp_Object Fload_internal (Lisp_Object filename, Lisp_Object missing_ok, @@ -1391,8 +1381,8 @@ Lisp_Object used_codesys); void ebolify_bytecode_constants (Lisp_Object vector); void close_load_descs (void); -int locate_file (Lisp_Object path, - Lisp_Object str, CONST char *suffix, +int locate_file (Lisp_Object path, + Lisp_Object str, CONST char *suffix, Lisp_Object *storeptr, int mode); Lisp_Object Flocate_file_clear_hashing (Lisp_Object path); int isfloat_string (CONST char *); @@ -1412,7 +1402,7 @@ /* Defined in macros.c */ -Lisp_Object Fexecute_kbd_macro (Lisp_Object macro, +Lisp_Object Fexecute_kbd_macro (Lisp_Object macro, Lisp_Object prefixarg); @@ -1422,7 +1412,7 @@ void set_bi_marker_position (Lisp_Object marker, Bytind pos); void set_marker_position (Lisp_Object marker, Bufpos pos); void unchain_marker (Lisp_Object marker); -Lisp_Object Fset_marker (Lisp_Object marker, +Lisp_Object Fset_marker (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer); Lisp_Object Fmarker_position (Lisp_Object m); Lisp_Object Fmarker_buffer (Lisp_Object m); @@ -1459,7 +1449,7 @@ Charcount scmp_1 (CONST Bufbyte *s1, CONST Bufbyte *s2, Charcount len, int ignore_case); #define scmp(s1, s2, len) scmp_1 (s1, s2, len, completion_ignore_case) -Lisp_Object Fread_from_minibuffer (Lisp_Object prompt, +Lisp_Object Fread_from_minibuffer (Lisp_Object prompt, Lisp_Object init, Lisp_Object keymap, Lisp_Object read_crock, @@ -1474,10 +1464,10 @@ extern Lisp_Object Vminibuffer_zero; extern Lisp_Object Vecho_area_buffer; -Lisp_Object clear_echo_area (struct frame *f, Lisp_Object label, +Lisp_Object clear_echo_area (struct frame *f, Lisp_Object label, int no_restore); -Lisp_Object clear_echo_area_from_print (struct frame *f, - Lisp_Object label, +Lisp_Object clear_echo_area_from_print (struct frame *f, + Lisp_Object label, int no_restore); void echo_area_append (struct frame *f, CONST Bufbyte *nonreloc, Lisp_Object reloc, Bytecount offset, @@ -1542,17 +1532,17 @@ * (eg Qnil means stdout, not Vstandard_output, etc) */ void write_c_string (CONST char *s, Lisp_Object printcharfun); /* Same goes for this function. */ -void write_string_1 (CONST Bufbyte *s, Bytecount size, +void write_string_1 (CONST Bufbyte *s, Bytecount size, Lisp_Object printcharfun); -void print_internal (Lisp_Object obj, - Lisp_Object printcharfun, +void print_internal (Lisp_Object obj, + Lisp_Object printcharfun, int escapeflag); extern Lisp_Object Vprint_level; extern Lisp_Object Vprint_length; extern int print_escape_newlines; extern int print_readably; extern Lisp_Object Qprint_escape_newlines; -Lisp_Object internal_with_output_to_temp_buffer (CONST char *bufname, +Lisp_Object internal_with_output_to_temp_buffer (CONST char *bufname, Lisp_Object (*function) (Lisp_Object args), Lisp_Object args, @@ -1714,7 +1704,7 @@ Lisp_Object intern (CONST char *); Lisp_Object oblookup (Lisp_Object obarray, CONST Bufbyte *, Bytecount len); -void map_obarray (Lisp_Object obarray, +void map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object sym, Lisp_Object arg), Lisp_Object arg); Lisp_Object Fboundp (Lisp_Object sym); @@ -1796,8 +1786,8 @@ /* Defined in unex*.c */ int unexec (char *new_name, char *a_name, - uintptr_t data_start, - uintptr_t bss_start, + uintptr_t data_start, + uintptr_t bss_start, uintptr_t entry_address); #ifdef RUN_TIME_REMAP int run_time_remap (char *); @@ -1815,28 +1805,28 @@ Lisp_Object Fwindow_buffer (Lisp_Object window); Lisp_Object Fwindow_lowest_p (Lisp_Object window); Lisp_Object Fwindow_highest_p (Lisp_Object window); -Lisp_Object Fget_buffer_window (Lisp_Object buffer, +Lisp_Object Fget_buffer_window (Lisp_Object buffer, Lisp_Object frame, Lisp_Object ignored); Lisp_Object Fsave_window_excursion (Lisp_Object body); Lisp_Object Fset_window_configuration (Lisp_Object config); Lisp_Object save_window_excursion_unwind (Lisp_Object window_config); Lisp_Object Fcurrent_window_configuration (Lisp_Object frame); -Lisp_Object display_buffer (Lisp_Object buffer, - Lisp_Object notthiswindow, +Lisp_Object display_buffer (Lisp_Object buffer, + Lisp_Object notthiswindow, Lisp_Object overrideframe); Lisp_Object Freplace_buffer_in_windows (Lisp_Object buffer); Lisp_Object Fwindow_dedicated_p (Lisp_Object window); -Lisp_Object Fnext_window (Lisp_Object window, - Lisp_Object minibuf, +Lisp_Object Fnext_window (Lisp_Object window, + Lisp_Object minibuf, Lisp_Object all_frames, Lisp_Object device); Lisp_Object Fdelete_window (Lisp_Object window, Lisp_Object force); Lisp_Object Fselect_window (Lisp_Object window); -Lisp_Object Fset_window_buffer (Lisp_Object window, +Lisp_Object Fset_window_buffer (Lisp_Object window, Lisp_Object buffer); -Lisp_Object Fsplit_window (Lisp_Object window, - Lisp_Object chsize, +Lisp_Object Fsplit_window (Lisp_Object window, + Lisp_Object chsize, Lisp_Object horflag); Lisp_Object Frecenter (Lisp_Object arg, Lisp_Object window); Lisp_Object Fmove_to_window_line (Lisp_Object arg, Lisp_Object window);
--- a/src/energize.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/energize.c Mon Aug 13 09:55:28 2007 +0200 @@ -167,8 +167,6 @@ /**************************** Macros *****************************/ -#define xnew(type) ((type*)xmalloc (sizeof (type))) - #define BUFFER_NOTIFY_BACKGROUND_BIT_SET_P(buffer) 1 #define get_extent_data(id,binfo) (Energize_Extent_Data*)get_object(id, binfo) @@ -343,8 +341,7 @@ static GDataClass * alloc_GDataclass (EId id, BufferInfo *binfo) { - GDataClass *cl = xnew (GDataClass); - memset (cl, 0, sizeof (GDataClass)); + GDataClass *cl = xnew_and_zero (GDataClass); cl->seal = GDATA_CLASS_SEAL; cl->id = id; put_class (cl->id, binfo, cl); @@ -443,7 +440,7 @@ nw = XtWindowToWidget (get_x_display (Qnil), win); if (nw) nw = XtParent (nw); - + if (nw) sprintf (win_as_string, "w%x", nw); else @@ -491,7 +488,7 @@ binfo->wcmap.valid = 0; binfo->wcmap.modiff_stamp = -1; binfo->wcmap.map = NULL; -#endif +#endif put_buffer_info (id, binfo->emacs_buffer, binfo, editor); Venergize_buffers_list = Fcons (buffer, Venergize_buffers_list); @@ -531,7 +528,7 @@ binfo->wcmap.valid= 0; xfree(binfo->wcmap.map); } -#endif +#endif SET_OBJECT_FREE (binfo); } @@ -560,7 +557,7 @@ an extent object to be in an Energize_Extent_Data structure that is pointed at by the binfo->id_to_object table. Since Energize may still reference this object by its id (in fact, I think it may even "ressurect" a detached - extent) we must prevent the extent from being garbage collected. Aside + extent) we must prevent the extent from being garbage collected. Aside from the obvious lossage (that the extent itself would be trashed) this would also cause us to free the Energize_Extent_Data which the server still believes we have. The buffers all get marked because they're on the @@ -575,7 +572,7 @@ /* FUCK!! It's not standard-conforming to cast pointers to functions to or from void*. Give me a fucking break! */ -struct markobj_kludge_fmh +struct markobj_kludge_fmh { void (*markobj) (Lisp_Object); }; @@ -779,7 +776,7 @@ #ifndef MB_LEN_MAX #define MB_LEN_MAX 10 /* arbitrarily large enough */ -#endif +#endif static char wcsize_buf[MB_LEN_MAX]; #define WCSIZE(wc) (isascii(wc) ? 1 : wctomb(wcsize_buf,wc)) @@ -787,7 +784,7 @@ #define SANITY_CHECK_NOT #ifdef SANITY_CHECK static int sanity=0; -#endif +#endif static void sync_buffer_widechar_map (BufferInfo *binfo) @@ -818,13 +815,13 @@ #ifdef SANITY_CHECK stderr_out ("rebuilding widechar map for %s\n", XSTRING_DATA (current_buffer->name)); #endif - + /* #### this is not gonna compile. move_gap() is now a private function inside of insdel.c and it should stay that way. */ if (BUF_BEGV (current_buffer) < GPT && BUF_ZV (current_buffer) > GPT) move_gap (current_buffer, BUF_BEGV (current_buffer)); binfo->wcmap.modiff_stamp = BUF_MODIFF (current_buffer); - + buf = BUF_BEG_ADDR (current_buffer); maxpos= (BUF_Z (current_buffer) - 1); wctomb (NULL, 0); /* reset shift state of wctomb() */ @@ -880,7 +877,7 @@ char_pos, byte_pos, byte_pos, check_pos); } } -#endif +#endif return byte_pos; } @@ -915,13 +912,13 @@ sanity=1; check_pos= EnergizePosForBufpos(char_pos); sanity=0; - + if (check_pos != ez_pos) { stderr_out ("Bufpos(%d) = %d, EnergizePosForBufpos(%d) = %d\n", ez_pos, char_pos, char_pos, check_pos); } } -#endif +#endif return char_pos; } @@ -930,7 +927,7 @@ static Bufpos BufposForEnergizePos (EnergizePos energizePos, BufferInfo *binfo) { - return ((energizePos >= (1 << VALBITS)) ? BUF_Z (current_buffer) : + return ((energizePos >= (1 << VALBITS)) ? BUF_Z (current_buffer) : (energizePos + 1)); } @@ -981,7 +978,7 @@ && !NILP (energize_connection->proc) && energize_connection->conn && CRequestDelayedP (energize_connection->conn)) - this function no longer exists. + this function no longer exists. (Replaced by mark_what_as_being_ready, with different arguments.) Rewrite this. mark_process_as_being_ready (XPROCESS (energize_connection->proc)); @@ -1403,7 +1400,7 @@ char *first_section_chars = (char *) BUF_BYTE_ADDRESS (buf, bufpos); int comp = strncmp (string, first_section_chars, first_section_end - bufpos); - + if (comp) return comp; } @@ -1571,8 +1568,8 @@ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; /* For some reason calling the GC before parsing the buffer data - makes a better usage of memory and emacs leaks less when - creating/deleting LE browser buffers. + makes a better usage of memory and emacs leaks less when + creating/deleting LE browser buffers. However you don't want to call GC all the tiem so we only do it if the request will create more than a given number of extents. */ if (cbu->nExtent > energize_extent_gc_threshold) @@ -1718,7 +1715,7 @@ else get_chars_from_file = binfo->flags & CBFileYourself; #endif - + /* Even when we get the chars from a file there is an empty text string */ if (get_chars_from_file) { @@ -1730,7 +1727,7 @@ { text = CGetVstring (conn, &text_len); } - + /* updates the visited file modtime */ if (modifying_p && (from != to || text_len) /* but only when we do not read the file ourselves */ @@ -1878,7 +1875,7 @@ else extent_offset = EnergizePosForBufpos (BUF_Z(XBUFFER(binfo->emacs_buffer)), binfo); - + #if 1 if (text_len || !text) hack_window_point (display_window, @@ -2149,7 +2146,7 @@ map_extents (BUF_BEG (current_buffer), BUF_Z (current_buffer), write_energize_extent_data_mapper, &bane, binfo->emacs_buffer, 0, ME_END_CLOSED); - + } /* update nextent in request's header */ @@ -2350,7 +2347,7 @@ } else if (!NILP (selection)) error ("unrecognized energize selection"); - + if (!NILP (no_confirm)) conn->header->data |= CECnoConfirm; CWriteLength (conn); @@ -2478,7 +2475,7 @@ Request the set of menu options from the Energize server that are appropriate to the buffer and the extent. Extent can be (), in which case the options are requested for the whole buffer. Selection-p tells -if the selection is available on the dislpay emacs is using. +if the selection is available on the dislpay emacs is using. Returns the options as a list that can be passed to energize-activate-menu. Items in the list can also be passed to energize-execute-menu-item. @@ -2508,7 +2505,7 @@ execute the code associated to this menu inside the Energize server. Optional fourth argument is a string or a vector to be used as the selection for entry disabled because they need the selection. -Optional fifth argument, if non NIL, tells Energize to not request +Optional fifth argument, if non NIL, tells Energize to not request confirmation before executing the command. */ (buffer, extent_obj, item, selection, no_confirm)) @@ -2540,7 +2537,7 @@ Command is a string naming an energize command. Sends a request to execute this command inside the Energize server. Optional fourth argument is a string or a vector to be used as the selection. -Optional fifth argument, if non NIL, tells Energize to not request +Optional fifth argument, if non NIL, tells Energize to not request confirmation before executing the command. See also 'energize-list-menu'. @@ -4664,7 +4661,7 @@ /* Do not show the debugger panel in this function. The * debugger panel should never be listed in the visible psheets. */ extern int debuggerpanel_sheet; - + if (count == 1 && psheets [0] == debuggerpanel_sheet) return; @@ -4762,8 +4759,8 @@ /* returns 1 if the buffer is only visible in window on frame f */ static int -buffer_only_visible_in_this_window_p (Lisp_Object buffer, - struct frame* f, +buffer_only_visible_in_this_window_p (Lisp_Object buffer, + struct frame* f, struct window* window) { return !find_buffer_in_different_window (XWINDOW (f->root_window), buffer, @@ -5160,11 +5157,11 @@ data->name = "matchWord"; if (! lw_get_some_values (id, data)) abort (); match_word_p = (data->selected ? Qt : Qnil); - + data->name = "directionForward"; if (! lw_get_some_values (id, data)) abort (); direction = data->selected ? Qt : Qnil; - + if (!strcmp (name, "search")) replace = Qnil; else if (!strcmp (name, "replace")) @@ -5176,9 +5173,9 @@ } else abort (); - + free_widget_value (data); - + signal_special_Xt_user_event (device, intern ("energize-search-internal"), (NILP (replace) @@ -5335,7 +5332,7 @@ Venergize_process = Qnil; DEFVAR_LISP ("energize-create-buffer-hook", &Venergize_create_buffer_hook /* -Hook called when buffer is created by energize; takes +Hook called when buffer is created by energize; takes BUFFER as its only argument. */ ); Venergize_create_buffer_hook = Qnil; @@ -5377,7 +5374,7 @@ Number of extents in a ModifyBuffer request above which to do a GC */ ); energize_extent_gc_threshold = 20; - + pure_put (Qbuffer_locked_by_energize, Qerror_conditions, list2 (Qbuffer_locked_by_energize, Qerror)); pure_put (Qbuffer_locked_by_energize, Qerror_message,
--- a/src/eval.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/eval.c Mon Aug 13 09:55:28 2007 +0200 @@ -69,7 +69,7 @@ current position in the GCPRO stack. All of these are restored by Fthrow(). */ - + struct catchtag *catchlist; Lisp_Object Qautoload, Qmacro, Qexit; @@ -181,7 +181,7 @@ #endif /* Nonzero means we are trying to enter the debugger. - This is to prevent recursive attempts. + This is to prevent recursive attempts. Cleared by the debugger calling Fbacktrace */ static int entering_debugger; @@ -258,7 +258,7 @@ ? "#<special-form " : "#<subr "), printcharfun); - + write_c_string (subr_name (subr), printcharfun); write_c_string (((subr->prompt) ? " (interactive)>" : ">"), printcharfun); @@ -303,7 +303,7 @@ && internal_equal (b1->bytecodes, b2->bytecodes, depth + 1) && internal_equal (b1->constants, b2->constants, depth + 1) && internal_equal (b1->arglist, b2->arglist, depth + 1) - && internal_equal (b1->doc_and_interactive, + && internal_equal (b1->doc_and_interactive, b2->doc_and_interactive, depth + 1)); } @@ -399,12 +399,12 @@ debug_on_next_call = 0; speccount = specpdl_depth_counter; - record_unwind_protect (restore_entering_debugger, + record_unwind_protect (restore_entering_debugger, (entering_debugger ? Qt : Qnil)); entering_debugger = 1; val = internal_catch (Qdebugger, call_debugger_259, arg, &threw); - return unbind_to (speccount, ((threw) + return unbind_to (speccount, ((threw) ? Qunbound /* Not returning a value */ : val)); } @@ -573,7 +573,7 @@ specbind (Qstack_trace_on_error, Qnil); specbind (Qdebug_on_signal, Qnil); specbind (Qstack_trace_on_signal, Qnil); - + internal_with_output_to_temp_buffer ("*Backtrace*", backtrace_259, Qnil, @@ -581,7 +581,7 @@ unbind_to (speccount, Qnil); *stack_trace_displayed = 1; } - + if (!entering_debugger && !*debugger_entered && !signal_vars_only && (EQ (sig, Qquit) ? debug_on_quit @@ -593,7 +593,7 @@ specbind (Qstack_trace_on_error, Qnil); specbind (Qdebug_on_signal, Qnil); specbind (Qstack_trace_on_signal, Qnil); - + val = call_debugger (list2 (Qerror, (Fcons (sig, data)))); *debugger_entered = 1; } @@ -605,7 +605,7 @@ specbind (Qstack_trace_on_error, Qnil); specbind (Qdebug_on_signal, Qnil); specbind (Qstack_trace_on_signal, Qnil); - + internal_with_output_to_temp_buffer ("*Backtrace*", backtrace_259, Qnil, @@ -624,7 +624,7 @@ specbind (Qstack_trace_on_error, Qnil); specbind (Qdebug_on_signal, Qnil); specbind (Qstack_trace_on_signal, Qnil); - + val = call_debugger (list2 (Qerror, (Fcons (sig, data)))); *debugger_entered = 1; } @@ -916,7 +916,7 @@ /* Make space to hold the values to give the bound variables */ elt = Flength (varlist); - temps = (Lisp_Object *) alloca (XINT (elt) * sizeof (Lisp_Object)); + temps = alloca_array (Lisp_Object, XINT (elt)); /* Compute the values and store them in `temps' */ @@ -978,8 +978,6 @@ return Qnil; } -Lisp_Object Qsetq; - DEFUN ("setq", Fsetq, 0, UNEVALLED, 0, /* (setq SYM VAL SYM VAL ...): set each SYM to the value of its VAL. The symbols SYM are variables; they are literal (not evaluated). @@ -1018,7 +1016,7 @@ UNGCPRO; return val; } - + DEFUN ("quote", Fquote, 1, UNEVALLED, 0, /* Return the argument, without evaluating it. `(quote x)' yields `x'. */ @@ -1026,7 +1024,7 @@ { return Fcar (args); } - + DEFUN ("function", Ffunction, 1, UNEVALLED, 0, /* Like `quote', but preferred for objects which are functions. In byte compilation, `function' causes its argument to be compiled. @@ -1204,7 +1202,7 @@ (variable)) { Lisp_Object documentation; - + documentation = Fget (variable, Qvariable_documentation, Qnil); if (INTP (documentation) && XINT (documentation) < 0) return Qt; @@ -1218,7 +1216,7 @@ && XINT (XCDR (documentation)) < 0) return Qt; return Qnil; -} +} DEFUN ("macroexpand-internal", Fmacroexpand_internal, 1, 2, 0, /* Return result of expanding macros at top level of FORM. @@ -1326,7 +1324,7 @@ This is how catches are done from within C code. */ Lisp_Object -internal_catch (Lisp_Object tag, +internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object arg), Lisp_Object arg, int *threw) @@ -1397,7 +1395,7 @@ */ /* Save the value somewhere it will be GC'ed. - (Can't overwrite tag slot because an unwind-protect may + (Can't overwrite tag slot because an unwind-protect may want to throw to this same tag, which isn't yet invalid.) */ c->val = val; @@ -1431,7 +1429,7 @@ throw_level = 0; LONGJMP (c->jmp, 1); -} +} static DOESNT_RETURN throw_or_bomb_out (Lisp_Object tag, Lisp_Object val, int bomb_out_p, @@ -1455,9 +1453,9 @@ established at the same time, in initial_command_loop/ top_level_1. - #### Fix this horrifitude! + #### Fix this horrifitude! */ - + while (1) { REGISTER struct catchtag *c; @@ -1703,7 +1701,7 @@ if (!NILP (h.var)) specbind (h.var, c.val); val = Fprogn (Fcdr (h.chosen_clause)); - + /* Note that this just undoes the binding of h.var; whoever longjumped to us unwound the stack to c.pdlcount before throwing. */ @@ -1726,7 +1724,7 @@ condition-case except that it takes three arguments rather than a single list of arguments. */ Lisp_Object -Fcondition_case_3 (Lisp_Object bodyform, +Fcondition_case_3 (Lisp_Object bodyform, Lisp_Object var, Lisp_Object handlers) { /* This function can GC */ @@ -1738,13 +1736,13 @@ { Lisp_Object tem; tem = Fcar (val); - if ((!NILP (tem)) + if ((!NILP (tem)) && (!CONSP (tem) || (!SYMBOLP (XCAR (tem)) && !CONSP (XCAR (tem))))) signal_simple_error ("Invalid condition handler", tem); } - return condition_case_1 (handlers, + return condition_case_1 (handlers, Feval, bodyform, run_condition_case_handlers, var); @@ -1790,7 +1788,7 @@ return Fcondition_case_3 (Fcar (Fcdr (args)), Fcar (args), Fcdr (Fcdr (args))); -} +} DEFUN ("call-with-condition-handler", Fcall_with_condition_handler, 2, MANY, 0, /* Regain control when an error is signalled, without popping the stack. @@ -1963,7 +1961,7 @@ /* It's a condition-case handler */ - /* t is used by handlers for all conditions, set up by C code. + /* t is used by handlers for all conditions, set up by C code. * debugger is not called even if debug_on_error */ else if (EQ (handler_data, Qt)) { @@ -2024,7 +2022,7 @@ there is no 'top-level catch. (That's why the "bomb-out" hack was added.) - #### Fix this horrifitude! + #### Fix this horrifitude! */ signal_call_debugger (conditions, sig, data, Qnil, 0, &stack_trace_displayed, @@ -2156,7 +2154,7 @@ } else no_error = Qnil; - + va_start (vargs, nargs); for (i = 0; i < nargs; i++) args[i] = va_arg (vargs, Lisp_Object); @@ -2165,7 +2163,7 @@ /* If error-checking is not disabled, just call the function. It's important not to override disabled error-checking with enabled error-checking. */ - + if (ERRB_EQ (errb, ERROR_ME)) return primitive_funcall (fun, nargs, args); @@ -2366,7 +2364,7 @@ return maybe_signal_continuable_error (Qerror, list2 (build_translated_string (reason), frob), class, errb); -} +} /****************** Error functions class 4 ******************/ @@ -2506,7 +2504,7 @@ /* This function can GC */ if (EQ (Vquit_flag, Qcritical)) debug_on_quit |= 2; /* set critical bit. */ - Vquit_flag = Qnil; + Vquit_flag = Qnil; /* note that this is continuable. */ Fsignal (Qquit, Qnil); } @@ -2676,7 +2674,7 @@ /* If this isn't a byte-compiled function, then we may now be looking at several frames for special forms. Skip past them. */ - while (btp && + while (btp && btp->nargs == UNEVALLED) btp = btp->next; @@ -2746,7 +2744,7 @@ file = Fsymbol_name (Fintern (file, Qnil)); } - return Ffset (function, + return Ffset (function, Fpurecopy (Fcons (Qautoload, list4 (file, docstring, interactive, @@ -2778,7 +2776,7 @@ } void -do_autoload (Lisp_Object fundef, +do_autoload (Lisp_Object fundef, Lisp_Object funname) { /* This function can GC */ @@ -2840,9 +2838,9 @@ /* eval, funcall, apply */ /**********************************************************************/ -static Lisp_Object funcall_lambda (Lisp_Object fun, +static Lisp_Object funcall_lambda (Lisp_Object fun, int nargs, Lisp_Object args[]); -static Lisp_Object apply_lambda (Lisp_Object fun, +static Lisp_Object apply_lambda (Lisp_Object fun, int nargs, Lisp_Object args); static Lisp_Object funcall_subr (struct Lisp_Subr *sub, Lisp_Object args[]); @@ -2885,7 +2883,7 @@ level = XCAR (XCDR (this_warning)); messij = XCAR (XCDR (XCDR (this_warning))); free_list (this_warning); - + if (NILP (Vpending_warnings)) Vpending_warnings_tail = Qnil; /* perhaps not strictly necessary, but safer */ @@ -2961,7 +2959,7 @@ if (nargs < subr->min_args || (max_args >= 0 && max_args < nargs)) { - return Fsignal (Qwrong_number_of_arguments, + return Fsignal (Qwrong_number_of_arguments, list2 (fun, make_int (nargs))); } @@ -2978,7 +2976,7 @@ REGISTER int argnum; struct gcpro gcpro1, gcpro2, gcpro3; - vals = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object)); + vals = alloca_array (Lisp_Object, nargs); GCPRO3 (args_left, fun, vals[0]); gcpro3.nvars = 0; @@ -3023,9 +3021,9 @@ argvals[i] = Feval (Fcar (args_left)); gcpro3.nvars = ++i; } - + UNGCPRO; - + for (i = nargs; i < max_args; i++) argvals[i] = Qnil; @@ -3137,7 +3135,7 @@ if (nargs < subr->min_args || (max_args >= 0 && max_args < nargs)) { - return Fsignal (Qwrong_number_of_arguments, + return Fsignal (Qwrong_number_of_arguments, list2 (fun, make_int (nargs))); } @@ -3346,7 +3344,7 @@ int funcall_nargs; CHECK_LIST (spread_arg); - + numargs = XINT (Flength (spread_arg)); if (numargs == 0) @@ -3390,8 +3388,7 @@ } { REGISTER int i; - REGISTER Lisp_Object *funcall_args - = (Lisp_Object *) alloca (funcall_nargs * sizeof (Lisp_Object)); + Lisp_Object *funcall_args = alloca_array (Lisp_Object, funcall_nargs); struct gcpro gcpro1; GCPRO1 (*funcall_args); @@ -3401,7 +3398,7 @@ memcpy (funcall_args, args, (nargs - 1) * sizeof (Lisp_Object)); /* Spread the last arg we got. Its first element goes in the slot that it used to occupy, hence this value of I. */ - for (i = nargs - 1; + for (i = nargs - 1; !NILP (spread_arg); /* i < 1 + numargs */ i++, spread_arg = XCDR (spread_arg)) { @@ -3478,8 +3475,7 @@ struct gcpro gcpro1, gcpro2, gcpro3; REGISTER int i; REGISTER Lisp_Object tem; - REGISTER Lisp_Object *arg_vector - = (Lisp_Object *) alloca (numargs * sizeof (Lisp_Object)); + REGISTER Lisp_Object *arg_vector = alloca_array (Lisp_Object, numargs); GCPRO3 (*arg_vector, unevalled_args, fun); gcpro1.nvars = 0; @@ -3550,14 +3546,14 @@ specbind (next, tem); } else if (!optional) - return Fsignal (Qwrong_number_of_arguments, + return Fsignal (Qwrong_number_of_arguments, list2 (fun, make_int (nargs))); else specbind (next, Qnil); } if (i < nargs) - return Fsignal (Qwrong_number_of_arguments, + return Fsignal (Qwrong_number_of_arguments, list2 (fun, make_int (nargs))); if (CONSP (fun)) @@ -3631,7 +3627,7 @@ return Qnil; } - + DEFUN ("run-hook-with-args", Frun_hook_with_args, 1, MANY, 0, /* Run HOOK with the specified arguments ARGS. HOOK should be a symbol, a hook variable. If HOOK has a non-nil @@ -3825,8 +3821,7 @@ struct gcpro gcpro1; int i; va_list vargs; - Lisp_Object *funcall_args = - (Lisp_Object *) alloca ((1 + nargs) * sizeof (Lisp_Object)); + Lisp_Object *funcall_args = alloca_array (Lisp_Object, 1 + nargs); va_start (vargs, nargs); funcall_args[0] = hook_var; @@ -3848,8 +3843,7 @@ struct gcpro gcpro1; int i; va_list vargs; - Lisp_Object *funcall_args = - (Lisp_Object *) alloca ((1 + nargs) * sizeof (Lisp_Object)); + Lisp_Object *funcall_args = alloca_array (Lisp_Object, 1 + nargs); va_start (vargs, nargs); funcall_args[0] = hook_var; @@ -3911,7 +3905,7 @@ { /* This function can GC */ struct gcpro gcpro1; - Lisp_Object args[2]; + Lisp_Object args[2]; args[0] = fn; args[1] = arg0; GCPRO1 (args[0]); @@ -3974,7 +3968,7 @@ /* Call function fn with arguments arg0, arg1, arg2, arg3, arg4 */ Lisp_Object call5 (Lisp_Object fn, - Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2, + Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4) { /* This function can GC */ @@ -3993,7 +3987,7 @@ Lisp_Object call6 (Lisp_Object fn, - Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2, + Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5) { /* This function can GC */ @@ -4013,7 +4007,7 @@ Lisp_Object call7 (Lisp_Object fn, - Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2, + Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6) { @@ -4035,7 +4029,7 @@ Lisp_Object call8 (Lisp_Object fn, - Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2, + Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6, Lisp_Object arg7) { @@ -4237,7 +4231,7 @@ return value. */ -/* #### This stuff needs to catch throws as well. We need to +/* #### This stuff needs to catch throws as well. We need to improve internal_catch() so it can take a "catch anything" argument similar to Qt or Qerror for condition_case_1(). */ @@ -4247,7 +4241,7 @@ if (!NILP (errordata)) { Lisp_Object args[2]; - + if (!NILP (arg)) { char *str = (char *) get_opaque_ptr (arg); @@ -4330,7 +4324,7 @@ if (OPAQUEP (opaque)) free_opaque_ptr (opaque); UNGCPRO; - + /* gc_currently_forbidden = 0; */ return unbind_to (speccount, tem); } @@ -4394,7 +4388,7 @@ if (!allow_quit) specbind (Qinhibit_quit, Qt); - cons = noseeum_cons (hook_symbol, + cons = noseeum_cons (hook_symbol, warning_string ? make_opaque_ptr (warning_string) : Qnil); GCPRO1 (cons); @@ -4499,7 +4493,7 @@ free_opaque_ptr (opaque); free_cons (XCONS (cons)); UNGCPRO; - + /* gc_currently_forbidden = 0; */ return unbind_to (speccount, tem); } @@ -4566,8 +4560,7 @@ specpdl_size *= 2; if (specpdl_size > max_specpdl_size) specpdl_size = max_specpdl_size; - specpdl = ((struct specbinding *) - xrealloc (specpdl, specpdl_size * sizeof (struct specbinding))); + XREALLOC_ARRAY (specpdl, struct specbinding, specpdl_size); specpdl_ptr = specpdl + specpdl_depth_counter; } @@ -4676,7 +4669,7 @@ specpdl_ptr->old_value = Fcurrent_buffer (); specpdl_ptr->func = specbind_unwind_wasnt_local; } - + specpdl_ptr->symbol = symbol; specpdl_ptr++; specpdl_depth_counter++; @@ -4792,7 +4785,7 @@ } } return Fset (symbol, newval); -} +} #endif /* 0 */ @@ -4855,7 +4848,7 @@ and defaults to the value of `standard-output'. Optional second arg DETAILED means show places where currently active variable bindings, catches, condition-cases, and unwind-protects were made as well as -function calls. +function calls. */ (stream, detailed)) { @@ -4897,7 +4890,7 @@ && speccount > catchpdl) /* This is a condition-case catchpoint */ catchpdl = catchpdl + 1; - + backtrace_specials (speccount, catchpdl, stream); speccount = catches->pdlcount; @@ -5270,8 +5263,7 @@ specpdl_size = 50; specpdl_depth_counter = 0; - specpdl = (struct specbinding *) - xmalloc (specpdl_size * sizeof (struct specbinding)); + specpdl = xnew_array (struct specbinding, specpdl_size); /* XEmacs change: increase these values. */ max_specpdl_size = 3000; max_lisp_eval_depth = 500;
--- a/src/event-Xt.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/event-Xt.c Mon Aug 13 09:55:28 2007 +0200 @@ -634,8 +634,8 @@ switch (keysym) { /* These would be handled correctly by the default case, but by - special-casing them here we don't garbage a string or call intern(). - */ + special-casing them here we don't garbage a string or call + intern(). */ case XK_BackSpace: return QKbackspace; case XK_Tab: return QKtab; case XK_Linefeed: return QKlinefeed; @@ -700,15 +700,12 @@ #endif /* XIM_XLIB */ #endif /* HAVE_XIM */ - if ( -#ifndef HAVE_XIM - 1 -#elif defined (XIM_MOTIF) - 0 -#else /* XIM_XLIB */ - !xic -#endif - ) + /* We use XLookupString if we're not using XIM, or are using + XIM_XLIB but input context creation failed. */ +#if ! (defined (HAVE_XIM) && defined (XIM_MOTIF)) +#if defined (HAVE_XIM) && defined (XIM_XLIB) + if (!xic) +#endif /* XIM_XLIB */ { /* Apparently it's necessary to specify a dummy here (rather than passing in 0) to avoid crashes on German IRIX */ @@ -716,6 +713,7 @@ XLookupString (event, dummy, 200, &keysym, 0); return x_keysym_to_emacs_keysym (keysym, simple_p); } +#endif /* ! XIM_MOTIF */ #ifdef HAVE_XIM Lookup_String: /* Come-From XBufferOverflow */ @@ -724,7 +722,7 @@ event, bufptr, bufsiz, &keysym, &status); #else /* XIM_XLIB */ len = XmbLookupString (xic, event, bufptr, bufsiz, &keysym, &status); -#endif /* XIM_XLIB */ +#endif /* HAVE_XIM */ #ifdef DEBUG_XEMACS if (x_debug_events > 0) @@ -769,33 +767,45 @@ /* Generate multiple emacs events */ struct device *d = get_device_from_display (event->display); Emchar ch; - Lisp_Object instream = + Lisp_Object instream, fb_instream; + Lstream *istr; + struct gcpro gcpro1, gcpro2; + + fb_instream = make_fixed_buffer_input_stream ((unsigned char *) bufptr, len); /* ### Use Fget_coding_system (Vcomposed_input_coding_system) */ - instream = - make_decoding_input_stream (XLSTREAM (instream), + instream = + make_decoding_input_stream (XLSTREAM (fb_instream), Fget_coding_system (Qautomatic_conversion)); - while ((ch = Lstream_get_emchar (XLSTREAM (instream))) != EOF) + istr = XLSTREAM (instream); + + GCPRO2 (instream, fb_instream); + while ((ch = Lstream_get_emchar (istr)) != EOF) { Lisp_Object emacs_event = Fmake_event (); - XEVENT (emacs_event)->channel = DEVICE_CONSOLE (d); - XEVENT (emacs_event)->event_type = key_press_event; - XEVENT (emacs_event)->timestamp = event->time; - XEVENT (emacs_event)->event.key.modifiers = 0; - XEVENT (emacs_event)->event.key.keysym = make_char (ch); + struct Lisp_Event *ev = XEVENT (emacs_event); + ev->channel = DEVICE_CONSOLE (d); + ev->event_type = key_press_event; + ev->timestamp = event->time; + ev->event.key.modifiers = 0; + ev->event.key.keysym = make_char (ch); enqueue_Xt_dispatch_event (emacs_event); } - Lstream_close (XLSTREAM (instream)); + Lstream_close (istr); + UNGCPRO; + Lstream_delete (istr); + Lstream_delete (XLSTREAM (fb_instream)); return Qnil; } case XLookupNone: return Qnil; case XBufferOverflow: - bufptr = alloca (len+1); + bufptr = (char *) alloca (len+1); bufsiz = len+1; goto Lookup_String; } + return Qnil; /* not reached */ #endif /* HAVE_XIM */ } @@ -1233,7 +1243,7 @@ inaccurate) state flag. Therefore, ignoring the MapNotify is correct. */ if (!FRAME_VISIBLE_P (f) && NILP (Fframe_iconified_p (frame))) -#endif +#endif /* 0 */ change_frame_visibility (f, 1); } else @@ -1406,25 +1416,6 @@ #ifdef HAVE_XIM XIM_SetGeometry (f); #endif -#if 0 - /* ### If the following code fails to work, simply always call - x_smash_bastardly_shell_position always. In this case we no - longer rely on the data in the events, merely on their - occurrence. */ - /* ### Well, actually we shouldn't have to ever call - x_smash_bastardly_shell_position. We should just call - XtTranslateCoordinates and only access the core.{x,y} fields - using XtGetValue -- mrb */ - { - XConfigureEvent *ev = &event->xconfigure; - if (ev->window == XtWindow (FRAME_X_SHELL_WIDGET (f)) && - ! (ev->x == 0 && ev->y == 0 && !ev->send_event)) - { - FRAME_X_SHELL_WIDGET (f)->core.x = ev->x; - FRAME_X_SHELL_WIDGET (f)->core.y = ev->y; - } - } -#endif break; default: @@ -1558,10 +1549,9 @@ { int i; - filedesc_with_input = (Lisp_Object *) - xmalloc (MAXDESC * sizeof (Lisp_Object)); - filedesc_to_what_closure = (struct what_is_ready_closure **) - xmalloc (MAXDESC * sizeof (struct what_is_ready_closure *)); + filedesc_with_input = xnew_array (Lisp_Object, MAXDESC); + filedesc_to_what_closure = + xnew_array (struct what_is_ready_closure *, MAXDESC); for (i = 0; i < MAXDESC; i++) { @@ -1634,7 +1624,7 @@ detect this and error before here. */ assert (!filedesc_to_what_closure[fd]); - closure = (struct what_is_ready_closure *) xmalloc (sizeof (*closure)); + closure = xnew (struct what_is_ready_closure); closure->fd = fd; closure->what = what; closure->id = @@ -2276,7 +2266,7 @@ XEventsQueued (display, QueuedAfterReading); queued = XCheckIfEvent (display, &event, quit_char_predicate, - (XtPointer)&critical_quit); + (char *) &critical_quit); if (queued) { Vquit_flag = (critical_quit ? Qcritical : Qt); @@ -2636,8 +2626,7 @@ /* this function only makes safe calls */ init_what_input_once (); - Xt_event_stream = - (struct event_stream *) xmalloc (sizeof (struct event_stream)); + Xt_event_stream = xnew (struct event_stream); Xt_event_stream->event_pending_p = emacs_Xt_event_pending_p; Xt_event_stream->next_event_cb = emacs_Xt_next_event; Xt_event_stream->handle_magic_event_cb= emacs_Xt_handle_magic_event;
--- a/src/event-stream.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/event-stream.c Mon Aug 13 09:55:28 2007 +0200 @@ -35,6 +35,30 @@ * */ +/* TODO: + This stuff is way too hard to maintain - needs rework. + + (global-set-key "\C-p" global-map) causes a crash - need recursion check. + + C-x @ h <scrollbar-drag> x causes a crash. + + The command builder should deal only with key and button events. + Other command events should be able to come in the MIDDLE of a key + sequence, without disturbing the key sequence composition, or the + command builder structure representing it. + + Someone should rethink univeral-argument and figure out how an + arbitrary command can influence the next command (universal-argument + or univeral-coding-system-argument) or the next key (hyperify). + + Both C-h and Help in the middle of a key sequence should trigger + prefix-help-command. help-char is stupid. Maybe we need + keymap-of-last-resort? + + After prefix-help is run, one should be able to CONTINUE TYPING, + instead of RETYPING, the key sequence. + */ + #include <config.h> #include "lisp.h" @@ -153,8 +177,7 @@ /* The buffer that was current when the last command was started. */ Lisp_Object last_point_position_buffer; -/* A (16bit . 16bit) representation of the time of the last-command-event. - */ +/* A (16bit . 16bit) representation of the time of the last-command-event. */ Lisp_Object Vlast_input_time; /* Character to recognize as the help char. */ @@ -163,13 +186,13 @@ /* Form to execute when help char is typed. */ Lisp_Object Vhelp_form; +/* Command to run when the help character follows a prefix key. */ +Lisp_Object Vprefix_help_command; + /* Flag to tell QUIT that some interesting occurrence (e.g. a keypress) may have happened. */ volatile int something_happened; -/* Command to run when the help character follows a prefix key. */ -Lisp_Object Vprefix_help_command; - /* Hash table to translate keysyms through */ Lisp_Object Vkeyboard_translate_table; @@ -230,13 +253,29 @@ #ifdef DEBUG_XEMACS int debug_emacs_events; + +static void +external_debugging_print_event (char *event_description, Lisp_Object event) +{ + write_c_string ("(", Qexternal_debugging_output); + write_c_string (event_description, Qexternal_debugging_output); + write_c_string (") ", Qexternal_debugging_output); + print_internal (event, Qexternal_debugging_output, 1); + write_c_string ("\n", Qexternal_debugging_output); +} +#define DEBUG_PRINT_EMACS_EVENT(event_description, event) do { \ + if (debug_emacs_events) \ + external_debugging_print_event (event_description, event); \ +} while (0) +#else +#define DEBUG_PRINT_EMACS_EVENT(string, event) #endif /* The callback routines for the window system or terminal driver */ struct event_stream *event_stream; -/* This structure is what we use to excapsulate the state of a command sequence +/* This structure is what we use to encapsulate the state of a command sequence being composed; key events are executed by adding themselves to the command builder; if the command builder is then complete (does not still represent a prefix key sequence) it executes the corresponding command. @@ -256,30 +295,28 @@ Lisp_Object current_events; /* Last elt of above */ Lisp_Object most_current_event; - /* Last elt before function map code took over. - What this means is: All prefixes up to (but not including) - this event have non-nil bindings, but the prefix including - this event has a nil binding. Any events in the chain after - this one were read solely because we're part of a possible - function key. If we end up with something that's not part - of a possible function key, we have to unread all of those - events. */ + /* Last elt before function map code took over. What this means is: + All prefixes up to (but not including) this event have non-nil + bindings, but the prefix including this event has a nil binding. + Any events in the chain after this one were read solely because + we're part of a possible function key. If we end up with + something that's not part of a possible function key, we have to + unread all of those events. */ Lisp_Object last_non_munged_event; /* One set of values for function-key-map, one for key-translation-map */ struct munging_key_translation - { - /* First event that can begin a possible function key sequence - (to be translated according to function-key-map). Normally - this is the first event in the chain. However, once we've - translated a sequence through function-key-map, this will - point to the first event after the translated sequence: - we don't ever want to translate any events twice through - function-key-map, or things could get really screwed up - (e.g. if the user created a translation loop). If this - is nil, then the next-read event is the first that can - begin a function key sequence. */ - Lisp_Object first_mungeable_event; - } munge_me[2]; + { + /* First event that can begin a possible function key sequence + (to be translated according to function-key-map). Normally + this is the first event in the chain. However, once we've + translated a sequence through function-key-map, this will point + to the first event after the translated sequence: we don't ever + want to translate any events twice through function-key-map, or + things could get really screwed up (e.g. if the user created a + translation loop). If this is nil, then the next-read event is + the first that can begin a function key sequence. */ + Lisp_Object first_mungeable_event; + } munge_me[2]; Bufbyte *echo_buf; Bytecount echo_buf_length; /* size of echo_buf */ @@ -361,12 +398,10 @@ static void finalize_command_builder (void *header, int for_disksave) { - struct command_builder *c = (struct command_builder *) header; - if (!for_disksave) { - xfree (c->echo_buf); - c->echo_buf = 0; + xfree (((struct command_builder *) header)->echo_buf); + ((struct command_builder *) header)->echo_buf = 0; } } @@ -386,14 +421,12 @@ { Lisp_Object builder_obj = Qnil; struct command_builder *builder = - alloc_lcrecord (sizeof (struct command_builder), - lrecord_command_builder); + alloc_lcrecord_type (struct command_builder, lrecord_command_builder); builder->console = console; reset_command_builder_event_chain (builder); builder->echo_buf_length = 300; /* #### Kludge */ - builder->echo_buf = - (Bufbyte *) xmalloc (builder->echo_buf_length); + builder->echo_buf = xnew_array (Bufbyte, builder->echo_buf_length); builder->echo_buf[0] = 0; builder->echo_buf_index = -1; builder->echo_buf_index = -1; @@ -510,15 +543,7 @@ which will unblock us. */ if (maybe_read_quit_event (event)) { -#ifdef DEBUG_XEMACS - if (debug_emacs_events) - { - write_c_string ("(SIGINT) ", - Qexternal_debugging_output); - print_internal (event_obj, Qexternal_debugging_output, 1); - write_c_string ("\n", Qexternal_debugging_output); - } -#endif + DEBUG_PRINT_EMACS_EVENT ("SIGINT", event_obj); return; } @@ -538,18 +563,10 @@ emacs_is_blocking = 0; #ifdef DEBUG_XEMACS - if (debug_emacs_events) - { - write_c_string ("(real) ", - Qexternal_debugging_output); - /* timeout events have more info set later, so - print the event out in next_event_internal(). */ - if (event->event_type != timeout_event) - { - print_internal (event_obj, Qexternal_debugging_output, 1); - write_c_string ("\n", Qexternal_debugging_output); - } - } + /* timeout events have more info set later, so + print the event out in next_event_internal(). */ + if (event->event_type != timeout_event) + DEBUG_PRINT_EMACS_EVENT ("real", event_obj); #endif maybe_kbd_translate (event_obj); } @@ -777,13 +794,8 @@ } #ifdef DEBUG_XEMACS - if (did_translate && debug_emacs_events) - { - write_c_string ("(->keyboard-translate-table) ", - Qexternal_debugging_output); - print_internal (event, Qexternal_debugging_output, 1); - write_c_string ("\n", Qexternal_debugging_output); - } + if (did_translate) + DEBUG_PRINT_EMACS_EVENT ("->keyboard-translate-table", event); #endif } @@ -1155,10 +1167,7 @@ GCPRO1 (op); /* just in case ... because it's removed from the list for awhile. */ - if (async_p) - timeout_list = &pending_async_timeout_list; - else - timeout_list = &pending_timeout_list; + timeout_list = async_p ? &pending_async_timeout_list : &pending_timeout_list; /* Find the timeout on the list of pending ones. */ LIST_LOOP (rest, *timeout_list) @@ -1534,9 +1543,7 @@ void enqueue_magic_eval_event (void (*fun) (Lisp_Object), Lisp_Object object) { - Lisp_Object event; - - event = Fmake_event (); + Lisp_Object event = Fmake_event (); XEVENT (event)->event_type = magic_eval_event; /* channel for magic_eval events is nil */ @@ -1554,9 +1561,7 @@ */ (function, object)) { - Lisp_Object event; - - event = Fmake_event (); + Lisp_Object event = Fmake_event (); XEVENT (event)->event_type = eval_event; /* channel for eval events is nil */ @@ -1571,9 +1576,7 @@ enqueue_misc_user_event (Lisp_Object channel, Lisp_Object function, Lisp_Object object) { - Lisp_Object event; - - event = Fmake_event (); + Lisp_Object event = Fmake_event (); XEVENT (event)->event_type = misc_user_event; XEVENT (event)->channel = channel; @@ -1884,8 +1887,7 @@ return in_single_console; } -/* the number of keyboard characters read. callint.c wants this. - */ +/* the number of keyboard characters read. callint.c wants this. */ Charcount num_input_chars; static void @@ -1905,15 +1907,7 @@ Lisp_Object event = dequeue_command_event (); Fcopy_event (event, target_event); Fdeallocate_event (event); -#ifdef DEBUG_XEMACS - if (debug_emacs_events) - { - write_c_string ("(command event queue) ", - Qexternal_debugging_output); - print_internal (target_event, Qexternal_debugging_output, 1); - write_c_string ("\n", Qexternal_debugging_output); - } -#endif + DEBUG_PRINT_EMACS_EVENT ("command event queue", target_event); } else { @@ -1934,15 +1928,9 @@ e->event.timeout.function = tristan; e->event.timeout.object = isolde; -#ifdef DEBUG_XEMACS /* next_event_internal() doesn't print out timeout events because of the extra info we just set. */ - if (debug_emacs_events) - { - print_internal (target_event, Qexternal_debugging_output, 1); - write_c_string ("\n", Qexternal_debugging_output); - } -#endif + DEBUG_PRINT_EMACS_EVENT ("real, timeout", target_event); } /* If we read a ^G, then set quit-flag but do not discard the ^G. @@ -1985,7 +1973,7 @@ Return the next available event. Pass this object to `dispatch-event' to handle it. In most cases, you will want to use `next-command-event', which returns -the next available \"user\" event (i.e. keypress, button-press, +the next available "user" event (i.e. keypress, button-press, button-release, or menu selection) instead of this function. If EVENT is non-nil, it should be an event object and will be filled in @@ -2014,7 +2002,7 @@ event is dispatched. Eval events are generated by `enqueue-eval-event' or by certain other conditions happening. -- a magic event, indicating that some window-system-specific event - happened (such as an focus-change notification) that must be handled + happened (such as a focus-change notification) that must be handled synchronously with other events. `dispatch-event' knows what to do with these events. */ @@ -2101,20 +2089,11 @@ redisplay (); if (!EQ (e, event)) Fcopy_event (e, event); -#ifdef DEBUG_XEMACS - if (debug_emacs_events) - { - write_c_string ("(unread-command-events) ", - Qexternal_debugging_output); - print_internal (event, Qexternal_debugging_output, 1); - write_c_string ("\n", Qexternal_debugging_output); - } -#endif + DEBUG_PRINT_EMACS_EVENT ("unread-command-events", event); } } - /* Do similar for unread-command-event (obsoleteness support). - */ + /* Do similar for unread-command-event (obsoleteness support). */ else if (!NILP (Vunread_command_event)) { Lisp_Object e = Vunread_command_event; @@ -2128,15 +2107,7 @@ if (!EQ (e, event)) Fcopy_event (e, event); redisplay (); -#ifdef DEBUG_XEMACS - if (debug_emacs_events) - { - write_c_string ("(unread-command-event) ", - Qexternal_debugging_output); - print_internal (event, Qexternal_debugging_output, 1); - write_c_string ("\n", Qexternal_debugging_output); - } -#endif + DEBUG_PRINT_EMACS_EVENT ("unread-command-event", event); } /* If we're executing a keyboard macro, take the next event from that, @@ -2151,15 +2122,7 @@ pop_kbd_macro_event (event); /* This throws past us at end-of-macro. */ store_this_key = 1; -#ifdef DEBUG_XEMACS - if (debug_emacs_events) - { - write_c_string ("(keyboard macro) ", - Qexternal_debugging_output); - print_internal (event, Qexternal_debugging_output, 1); - write_c_string ("\n", Qexternal_debugging_output); - } -#endif + DEBUG_PRINT_EMACS_EVENT ("keyboard macro", event); } /* Otherwise, read a real event, possibly from the command_event_queue, and update this-command-keys and @@ -2245,10 +2208,8 @@ EMACS_GET_TIME (t); if (!CONSP (Vlast_input_time)) Vlast_input_time = Fcons (Qnil, Qnil); - XCAR (Vlast_input_time) - = make_int ((EMACS_SECS (t) >> 16) & 0xffff); - XCDR (Vlast_input_time) - = make_int ((EMACS_SECS (t) >> 0) & 0xffff); + XCAR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 16) & 0xffff); + XCDR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 0) & 0xffff); } /* If this key came from the keyboard or from a keyboard macro, then @@ -2284,7 +2245,7 @@ } DEFUN ("next-command-event", Fnext_command_event, 0, 2, 0, /* -Return the next available \"user\" event. +Return the next available "user" event. Pass this object to `dispatch-event' to handle it. If EVENT is non-nil, it should be an event object and will be filled in @@ -2336,10 +2297,10 @@ } DEFUN ("discard-input", Fdiscard_input, 0, 0, 0, /* -Discard any pending \"user\" events. +Discard any pending "user" events. Also cancel any kbd macro being defined. A user event is a key press, button press, button release, or -\"other-user\" event (menu selection or scrollbar action). +"misc-user" event (menu selection or scrollbar action). */ ()) { @@ -3027,7 +2988,7 @@ { widget_value *current, *prev; widget_value *entries; - + current = lw_get_entries (False); entries = lw_get_entries (True); prev = NULL; @@ -3069,16 +3030,16 @@ { widget_value *current; widget_value *new; - + current = lw_get_entries (False); new = current; - + while (new->next) { new = new->next; if (new->name /*&& new->enabled*/) break; } - + if (new==current||!(new->name/*||new->enabled*/)) { new = lw_get_entries (True); @@ -3093,7 +3054,7 @@ return; } } - + lw_set_item (new); } @@ -3103,7 +3064,7 @@ int level = lw_menu_level (); int l = level; widget_value *current; - + while (level >= 3) { --level; @@ -3121,7 +3082,7 @@ int level = lw_menu_level (); int l = level; widget_value *current; - + while (level >= 3) { --level; @@ -3138,13 +3099,13 @@ { if (val == NULL) val = lw_get_entries (False); - + /* is match a submenu? */ - + if (val->contents) { /* enter the submenu */ - + lw_set_item (val); lw_push_menu (val->contents); } @@ -3161,12 +3122,12 @@ command_builder_operate_menu_accelerator (struct command_builder *builder) { /* this function can GC */ - + struct console *con = XCONSOLE (Vselected_console); Lisp_Object evee = builder->most_current_event; Lisp_Object binding; widget_value *entries; - + extern int lw_menu_accelerate; /* lwlib.c */ #if 0 @@ -3174,7 +3135,7 @@ int i; Lisp_Object t; char buf[50]; - + t = builder->current_events; i = 0; while (!NILP (t)) @@ -3188,14 +3149,14 @@ } } #endif - + /* menu accelerator keys don't go into keyboard macros */ if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro)) con->kbd_macro_ptr = con->kbd_macro_end; - + /* don't echo menu accelerator keys */ /*reset_key_echo (builder, 1);*/ - + if (!lw_menu_accelerate) { /* `convert' mouse display to keyboard display @@ -3208,11 +3169,11 @@ lw_display_menu (CurrentTime); } } - + /* compare event to the current menu accelerators */ - + entries=lw_get_entries (True); - + while (entries) { Lisp_Object accel; @@ -3222,11 +3183,11 @@ if (event_matches_key_specifier_p (XEVENT (evee), accel)) { /* a match! */ - + menu_select_item (entries); - + if (lw_menu_active) lw_display_menu (CurrentTime); - + reset_this_command_keys (Vselected_console, 1); /*reset_command_builder_event_chain (builder);*/ return Vmenu_accelerator_map; @@ -3234,11 +3195,11 @@ } entries = entries->next; } - + /* try to look up event in menu-accelerator-map */ - + binding = event_binding_in (evee, Vmenu_accelerator_map, 1); - + if (NILP (binding)) { /* beep at user for undefined key */ @@ -3295,7 +3256,7 @@ else if (EQ (binding, Qmenu_escape)) { int level = lw_menu_level (); - + if (level > 2) { lw_pop_menu (); @@ -3323,25 +3284,25 @@ return binding; } } - + if (lw_menu_active) lw_display_menu (CurrentTime); - + reset_this_command_keys (Vselected_console, 1); /*reset_command_builder_event_chain (builder);*/ - + return Vmenu_accelerator_map; } static Lisp_Object menu_accelerator_junk_on_error (Lisp_Object errordata, Lisp_Object ignored) { - Vmenu_accelerator_prefix = Qnil; + Vmenu_accelerator_prefix = Qnil; Vmenu_accelerator_modifiers = Qnil; - Vmenu_accelerator_enabled = Qnil; + Vmenu_accelerator_enabled = Qnil; if (!NILP (errordata)) { Lisp_Object args[2]; - + args[0] = build_string ("Error in menu accelerators (setting to nil)"); /* #### This should call (with-output-to-string (display-error errordata)) @@ -3352,7 +3313,7 @@ emacs_doprnt_string_lisp ((CONST Bufbyte *) "%s: %s", Qnil, -1, 2, args)); } - + return Qnil; } @@ -3398,13 +3359,13 @@ struct console *con = XCONSOLE (Vselected_console); struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con)); Widget menubar_widget; - + /* compare entries in event0 against the menu prefix */ - + if ((!CONSOLE_X_P (XCONSOLE (builder->console))) || NILP (event0) || XEVENT (event0)->event_type != key_press_event) return Qnil; - + if (!NILP (Vmenu_accelerator_prefix)) { event0 = condition_case_1 (Qerror, @@ -3413,39 +3374,39 @@ menu_accelerator_junk_on_error, Qnil); } - + if (NILP (event0)) return Qnil; - + menubar_widget = FRAME_X_MENUBAR_WIDGET (f); if (menubar_widget && CONSP (Vmenu_accelerator_modifiers)) { Lisp_Object fake; - Lisp_Object last; + Lisp_Object last = Qnil; struct gcpro gcpro1; Lisp_Object matchp; - + widget_value *val; LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id; - + val = lw_get_all_values (id); if (val) { val = val->contents; - + fake = Fcopy_sequence (Vmenu_accelerator_modifiers); last = fake; - + while (!NILP (Fcdr (last))) last = Fcdr (last); - + Fsetcdr (last, Fcons (Qnil, Qnil)); last = Fcdr (last); } - + fake = Fcons (Qnil, fake); - + GCPRO1 (fake); while (val) @@ -3464,35 +3425,35 @@ if (!NILP (matchp)) { /* we found one! */ - + lw_set_menu (menubar_widget, val); /* yah - yet another hack. pretend emacs timestamp is the same as an X timestamp, which for the moment it is. (read events.h) */ lw_map_menu (XEVENT (event0)->timestamp); - + if (val->contents) lw_push_menu (val->contents); - + lw_display_menu (CurrentTime); - + /* menu accelerator keys don't go into keyboard macros */ if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro)) con->kbd_macro_ptr = con->kbd_macro_end; - + /* don't echo menu accelerator keys */ /*reset_key_echo (builder, 1);*/ reset_this_command_keys (Vselected_console, 1); UNGCPRO; - + return Vmenu_accelerator_map; } } - + val = val->next; } - + UNGCPRO; } return Qnil; @@ -3509,17 +3470,17 @@ struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con)); LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id; widget_value *val = lw_get_all_values (id); - + val = val->contents; lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val); lw_map_menu (CurrentTime); - + lw_display_menu (CurrentTime); - + /* menu accelerator keys don't go into keyboard macros */ if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro)) con->kbd_macro_ptr = con->kbd_macro_end; - + return Qnil; } #endif /* HAVE_X_WINDOWS && HAVE_MENUBARS */ @@ -3539,83 +3500,81 @@ { Lisp_Object result = munging_key_map_event_binding (suffix, munge); - if (!NILP (result)) + if (NILP (result)) + continue; + + if (KEYMAPP (result)) + { + if (NILP (builder->last_non_munged_event) + && !has_normal_binding_p) + builder->last_non_munged_event = builder->most_current_event; + } + else + builder->last_non_munged_event = Qnil; + + if (!KEYMAPP (result) && + !VECTORP (result) && + !STRINGP (result)) { - if (KEYMAPP (result)) + struct gcpro gcpro1; + GCPRO1 (suffix); + result = call1 (result, Qnil); + UNGCPRO; + if (NILP (result)) + return Qnil; + } + + if (KEYMAPP (result)) + return result; + + if (VECTORP (result) || STRINGP (result)) + { + Lisp_Object new_chain = key_sequence_to_event_chain (result); + Lisp_Object tempev; + int n, tckn; + + /* If the first_mungeable_event of the other munger is + within the events we're munging, then it will point to + deallocated events afterwards, which is bad -- so make it + point at the beginning of the munged events. */ + EVENT_CHAIN_LOOP (tempev, suffix) { - if (NILP (builder->last_non_munged_event) - && !has_normal_binding_p) - builder->last_non_munged_event = - builder->most_current_event; - } - else - builder->last_non_munged_event = Qnil; - - if (!KEYMAPP (result) && !VECTORP (result) - && !STRINGP (result)) - { - struct gcpro gcpro1; - GCPRO1 (suffix); - result = call1 (result, Qnil); - UNGCPRO; - } - - if (KEYMAPP (result)) - return result; - - if (VECTORP (result) || STRINGP (result)) - { - Lisp_Object new_chain = - key_sequence_to_event_chain (result); - Lisp_Object tempev; - int n, tckn; - - /* If the first_mungeable_event of the other munger - is within the events we're munging, then it will - point to deallocated events afterwards, which is - bad -- so make it point at the beginning of the - munged events. */ - EVENT_CHAIN_LOOP (tempev, suffix) + Lisp_Object *mungeable_event = + &builder->munge_me[1 - munge].first_mungeable_event; + if (EQ (tempev, *mungeable_event)) { - if (EQ (tempev, builder->munge_me[1 - munge]. - first_mungeable_event)) - { - builder->munge_me[1 - munge].first_mungeable_event = - new_chain; - break; - } + *mungeable_event = new_chain; + break; } - - n = event_chain_count (suffix); - command_builder_replace_suffix (builder, suffix, new_chain); - builder->munge_me[munge].first_mungeable_event = Qnil; - /* Now hork this-command-keys as well. */ - - /* We just assume that the events we just replaced - are sitting in copied form at the end of this-command-keys. - If the user did weird things with `dispatch-event' - this may not be the case, but at least we make - sure we won't crash. */ - new_chain = copy_event_chain (new_chain); - tckn = event_chain_count (Vthis_command_keys); - if (tckn >= n) - { - this_command_keys_replace_suffix - (event_chain_nth (Vthis_command_keys, tckn - n), - new_chain); - } - - result = command_builder_find_leaf_1 (builder); - return result; } - if (munge == MUNGE_ME_FUNCTION_KEY) - signal_simple_error ("Invalid binding in function-key-map", - result); - else - signal_simple_error ("Invalid binding in key-translation-map", - result); + n = event_chain_count (suffix); + command_builder_replace_suffix (builder, suffix, new_chain); + builder->munge_me[munge].first_mungeable_event = Qnil; + /* Now hork this-command-keys as well. */ + + /* We just assume that the events we just replaced are + sitting in copied form at the end of this-command-keys. + If the user did weird things with `dispatch-event' this + may not be the case, but at least we make sure we won't + crash. */ + new_chain = copy_event_chain (new_chain); + tckn = event_chain_count (Vthis_command_keys); + if (tckn >= n) + { + this_command_keys_replace_suffix + (event_chain_nth (Vthis_command_keys, tckn - n), + new_chain); + } + + result = command_builder_find_leaf_1 (builder); + return result; } + + signal_simple_error ((munge == MUNGE_ME_FUNCTION_KEY ? + "Invalid binding in function-key-map" : + "Invalid binding in key-translation-map"), + result); } return Qnil; @@ -3638,29 +3597,24 @@ Lisp_Object result; Lisp_Object evee = builder->current_events; - if (allow_misc_user_events_p - && (NILP (XEVENT_NEXT (evee))) - && (XEVENT_TYPE (evee) == misc_user_event)) + if (XEVENT_TYPE (evee) == misc_user_event) { - Lisp_Object fn = XEVENT (evee)->event.eval.function; - Lisp_Object arg = XEVENT (evee)->event.eval.object; - return list2 (fn, arg); + if (allow_misc_user_events_p && (NILP (XEVENT_NEXT (evee)))) + return list2 (XEVENT (evee)->event.eval.function, + XEVENT (evee)->event.eval.object); + else + return Qnil; } - - if (XEVENT_TYPE (evee) == misc_user_event) - return Qnil; - /* if we're currently in a menu accelerator, check there for further events */ #if defined(HAVE_X_WINDOWS) && defined(HAVE_MENUBARS) if (lw_menu_active) { - result = command_builder_operate_menu_accelerator (builder); - return result; + return command_builder_operate_menu_accelerator (builder); } else { - result=Qnil; + result = Qnil; if (EQ (Vmenu_accelerator_enabled, Qmenu_force)) result = command_builder_find_menu_accelerator (builder); if (NILP (result)) @@ -4168,20 +4122,16 @@ maybe_echo_keys (command_builder, 0); } else if (!NILP (Vquit_flag)) { - Lisp_Object event = Fmake_event(); - struct Lisp_Event *e = XEVENT (event); - struct console *con; - int ch; - + Lisp_Object quit_event = Fmake_event(); + struct Lisp_Event *e = XEVENT (quit_event); /* if quit happened during menu acceleration, pretend we read it */ - con = XCONSOLE (Fselected_console ()); - - ch = CONSOLE_QUIT_CHAR (con); - + struct console *con = XCONSOLE (Fselected_console ()); + int ch = CONSOLE_QUIT_CHAR (con); + character_to_event (ch, e, con, 1); e->channel = make_console (con); - - enqueue_command_event (event); + + enqueue_command_event (quit_event); Vquit_flag = Qnil; } } @@ -4213,16 +4163,21 @@ GCPRO1 (event); /* event may be freshly created */ reset_current_events (command_builder); - if (XEVENT (event)->event_type == key_press_event) - Vcurrent_mouse_event = Qnil; - else if (XEVENT (event)->event_type == button_press_event - || XEVENT (event)->event_type == button_release_event - || XEVENT (event)->event_type == misc_user_event) - Vcurrent_mouse_event = Fcopy_event (event, Qnil); - - /* Store the last-command-event. The semantics of this is that it is - the last event most recently involved in command-lookup. - */ + switch (XEVENT (event)->event_type) + { + case key_press_event: + Vcurrent_mouse_event = Qnil; + break; + case button_press_event: + case button_release_event: + case misc_user_event: + Vcurrent_mouse_event = Fcopy_event (event, Qnil); + break; + default: break; + } + + /* Store the last-command-event. The semantics of this is that it + is the last event most recently involved in command-lookup. */ if (!EVENTP (Vlast_command_event)) Vlast_command_event = Fmake_event (); if (XEVENT (Vlast_command_event)->event_type == dead_event) @@ -4235,20 +4190,16 @@ Fcopy_event (event, Vlast_command_event); /* Note that last-command-char will never have its high-bit set, in - an effort to sidestep the ambiguity between M-x and oslash. - */ + an effort to sidestep the ambiguity between M-x and oslash. */ Vlast_command_char = Fevent_to_character (Vlast_command_event, Qnil, Qnil, Qnil); /* Actually call the command, with all sorts of hair to preserve or clear the echo-area and region as appropriate and call the pre- and post- - command-hooks. - */ + command-hooks. */ { int old_kbd_macro = con->kbd_macro_end; - struct window *w; - - w = XWINDOW (Fselected_window (Qnil)); + struct window *w = XWINDOW (Fselected_window (Qnil)); /* We're executing a new command, so the old value is irrelevant. */ zmacs_region_stays = 0; @@ -4272,29 +4223,28 @@ } else { -#if 0 - call3 (Qcommand_execute, Vthis_command, Qnil, Qnil); -#else Fcommand_execute (Vthis_command, Qnil, Qnil); -#endif } post_command_hook (); - if (!NILP (con->prefix_arg)) +#if 0 /* #### here was an attempted fix that didn't work */ + if (XEVENT (event)->event_type == misc_user_event) + ; + else +#endif + if (!NILP (con->prefix_arg)) { /* Commands that set the prefix arg don't update last-command, don't reset the echoing state, and don't go into keyboard macros unless - followed by another command. - */ + followed by another command. */ maybe_echo_keys (command_builder, 0); /* If we're recording a keyboard macro, and the last command executed set a prefix argument, then decrement the pointer to the "last character really in the macro" to be just before this command. This is so that the ^U in "^U ^X )" doesn't go onto - the end of macro. - */ + the end of macro. */ if (!NILP (con->defining_kbd_macro)) con->kbd_macro_end = old_kbd_macro; } @@ -4449,9 +4399,8 @@ case button_release_event: case key_press_event: { - Lisp_Object leaf; - - leaf = lookup_command_event (command_builder, event, 1); + Lisp_Object leaf = lookup_command_event (command_builder, event, 1); + if (KEYMAPP (leaf)) /* Incomplete key sequence */ break; @@ -4486,8 +4435,7 @@ XEVENT_TYPE (terminal) = button_release_event; /* If the "up" version is bound, don't complain. */ no_bitching - = !NILP (command_builder_find_leaf - (command_builder, 0)); + = !NILP (command_builder_find_leaf (command_builder, 0)); /* Undo the temporary changes we just made. */ XEVENT_TYPE (terminal) = button_press_event; if (no_bitching) @@ -4516,15 +4464,13 @@ } /* Complain that the typed sequence is not defined, if this is the - kind of sequence that warrants a complaint. - */ + kind of sequence that warrants a complaint. */ XCONSOLE (console)->defining_kbd_macro = Qnil; XCONSOLE (console)->prefix_arg = Qnil; /* Don't complain about undefined button-release events */ if (XEVENT_TYPE (terminal) != button_release_event) { - Lisp_Object keys = - current_events_into_vector (command_builder); + Lisp_Object keys = current_events_into_vector (command_builder); struct gcpro gcpro1; /* Run the pre-command-hook before barfing about an undefined @@ -4610,7 +4556,7 @@ /* clear the echo area */ reset_key_echo (command_builder, 1); - + command_builder->self_insert_countdown = 0; if (NILP (XCONSOLE (console)->prefix_arg) && NILP (Vexecuting_macro) @@ -4886,7 +4832,7 @@ defsymbol (&Qmenu_force, "menu-force"); defsymbol (&Qmenu_fallback, "menu-fallback"); - + defsymbol (&Qmenu_quit, "menu-quit"); defsymbol (&Qmenu_up, "menu-up"); defsymbol (&Qmenu_down, "menu-down"); @@ -5056,7 +5002,7 @@ DEFVAR_LISP ("current-mouse-event", &Vcurrent_mouse_event /* The mouse-button event which invoked this command, or nil. -This is usually what `(interactive \"e\")' returns. +This is usually what `(interactive "e")' returns. */ ); Vcurrent_mouse_event = Qnil; @@ -5228,7 +5174,7 @@ See also menu-accelerator-enabled and menu-accelerator-prefix. */ ); Vmenu_accelerator_modifiers = list1 (Qmeta); - + DEFVAR_LISP ("menu-accelerator-enabled", &Vmenu_accelerator_enabled /* Whether menu accelerator keys can cause the menubar to become active. If 'menu-force or 'menu-fallback, then menu accelerator keys can @@ -5238,7 +5184,7 @@ menu-force is used to indicate that the menu accelerator key takes precedence over bindings in the current keymap(s). menu-fallback means that bindings in the current keymap take precedence over menu accelerator keys. -Thus a top level menu with an accelerator of \"T\" would be activated on a +Thus a top level menu with an accelerator of "T" would be activated on a keypress of Meta-t if menu-accelerator-enabled is menu-force. However, if menu-accelerator-enabled is menu-fallback, then Meta-t will not activate the menubar and will instead run the function
--- a/src/event-tty.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/event-tty.c Mon Aug 13 09:55:28 2007 +0200 @@ -144,7 +144,7 @@ if (FD_ISSET (i, &temp_mask) && FD_ISSET (i, &tty_only_mask)) { struct console *c = find_console_from_fd (i); - + assert (c); if (read_event_from_tty_or_stream_desc (emacs_event, c, i)) return; @@ -159,7 +159,7 @@ Lisp_Object process; struct Lisp_Process *p = get_process_from_input_descriptor (i); - + assert (p); XSETPROCESS (process, p); emacs_event->event_type = process_event; @@ -234,8 +234,7 @@ void vars_of_event_tty (void) { - tty_event_stream = - (struct event_stream *) xmalloc (sizeof (struct event_stream)); + tty_event_stream = xnew (struct event_stream); tty_event_stream->event_pending_p = emacs_tty_event_pending_p; tty_event_stream->next_event_cb = emacs_tty_next_event;
--- a/src/event-unixoid.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/event-unixoid.c Mon Aug 13 09:55:28 2007 +0200 @@ -252,18 +252,18 @@ exit (-1); } signal_event_pipe_initialized = 1; - + /* Set it non-blocking so we can drain its output. */ set_descriptor_non_blocking (signal_event_pipe[0]); - + /* Also set the write descriptor non-blocking so we don't hang in case a long time passes between times when we drain the pipe. */ set_descriptor_non_blocking (signal_event_pipe[1]); - + /* WARNING: In order for the signal-event pipe to work correctly and not cause lockups, the following need to be followed: - + 1) event_pending_p() must ignore input on the signal-event pipe. 2) As soon as next_event() notices input on the signal-event pipe, it must drain it. */ @@ -271,6 +271,6 @@ FD_ZERO (&non_fake_input_wait_mask); FD_ZERO (&process_only_mask); FD_ZERO (&tty_only_mask); - + FD_SET (signal_event_pipe[0], &input_wait_mask); }
--- a/src/events.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/events.c Mon Aug 13 09:55:28 2007 +0200 @@ -1113,17 +1113,18 @@ XEVENT (event)->timestamp); } -#define CHECK_EVENT_TYPE(e,t1,sym) \ -{ CHECK_LIVE_EVENT (e); \ +#define CHECK_EVENT_TYPE(e,t1,sym) do { \ + CHECK_LIVE_EVENT (e); \ if (XEVENT(e)->event_type != (t1)) \ - e = wrong_type_argument ((sym),(e)); \ -} + e = wrong_type_argument ((sym),(e)); \ +} while (0) -#define CHECK_EVENT_TYPE2(e,t1,t2,sym) \ -{ CHECK_LIVE_EVENT (e); \ - if (XEVENT(e)->event_type != (t1) && XEVENT(e)->event_type != (t2)) \ - e = wrong_type_argument ((sym),(e)); \ -} +#define CHECK_EVENT_TYPE2(e,t1,t2,sym) do { \ + CHECK_LIVE_EVENT (e); \ + if (XEVENT(e)->event_type != (t1) && \ + XEVENT(e)->event_type != (t2)) \ + e = wrong_type_argument ((sym),(e)); \ +} while (0) DEFUN ("event-key", Fevent_key, 1, 1, 0, /* Return the Keysym of the key-press event EVENT. @@ -1374,7 +1375,7 @@ ret_w = 0; /* #### pixel_to_glyph_translation() sometimes returns garbage... - The word has type Lisp_Record (presumably meaning `extent') but the + The word has type Lisp_Type_Record (presumably meaning `extent') but the pointer points to random memory, often filled with 0, sometimes not. */ /* #### Chuck, do we still need this crap? */
--- a/src/events.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/events.h Mon Aug 13 09:55:28 2007 +0200 @@ -41,8 +41,8 @@ example, then it will be necessary to construct an event_stream structure that can cope with the given types. Currently, the only implemented event_streams are for dumb-ttys, and for X11 plus dumb-ttys. - - To implement this for one window system is relatively simple. + + To implement this for one window system is relatively simple. To implement this for multiple window systems is trickier and may not be possible in all situations, but it's been done for X and TTY. @@ -67,8 +67,8 @@ block. If called with an argument of 1, then this should say whether there are user-generated events pending (that is, keypresses or mouse-clicks). This - is used for redisplay optimization, among other - things. On dumb ttys, these two results are the + is used for redisplay optimization, among other + things. On dumb ttys, these two results are the same, but under a window system, they are not. If this function is not sure whether there are events @@ -94,7 +94,7 @@ granularity, it should round up to the closest value it can deal with. - remove_timeout_cb Called with an int, the id number of a wakeup to + remove_timeout_cb Called with an int, the id number of a wakeup to discard. This id number must have been returned by the add_timeout_cb. If the given wakeup has already expired, this should do nothing. @@ -106,7 +106,7 @@ connection, an event of type "process" should be generated. - select_console_cb These callbacks tell the underlying implementation + select_console_cb These callbacks tell the underlying implementation unselect_console_cb to add or remove a console from the list of consoles which are polled for user-input. @@ -162,14 +162,14 @@ will be a frame. -- for magic events, channel will be a frame (usually) or a device. - + timestamp When this event occurred -- if not known, this is made up. In addition, the following structures are specific to particular event types: - key_press_event + key_press_event key What keysym this is; an integer or a symbol. If this is an integer, it will be in the printing ASCII range: >32 and <127. @@ -239,10 +239,10 @@ the window system. Magic_events are handled somewhat asynchronously, just - like subprocess filters. However, occasionally a + like subprocess filters. However, occasionally a magic_event needs to be handled synchronously; in that case, the asynchronous handling of the magic_event will - push an eval_event back onto the queue, which will be + push an eval_event back onto the queue, which will be handled synchronously later. This is one of the reasons why eval_events exist; I'm not entirely happy with this aspect of this event model.
--- a/src/extents.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/extents.c Mon Aug 13 09:55:28 2007 +0200 @@ -421,8 +421,6 @@ Lisp_Object Qextentp; Lisp_Object Qextent_live_p; -Lisp_Object Qend_closed; -Lisp_Object Qstart_open; Lisp_Object Qall_extents_closed; Lisp_Object Qall_extents_open; Lisp_Object Qall_extents_closed_open; @@ -546,8 +544,8 @@ a geometric progession that saves on realloc space. */ increment += 100 + ga->numels / 8; - ptr = xrealloc (ptr, - (ga->numels + ga->gapsize + increment)*ga->elsize); + ptr = (char *) xrealloc (ptr, + (ga->numels + ga->gapsize + increment)*ga->elsize); if (ptr == 0) memory_full (); ga->array = ptr; @@ -637,7 +635,7 @@ gap_array_marker_freelist = gap_array_marker_freelist->next; } else - m = (Gap_Array_Marker *) xmalloc (sizeof (*m)); + m = xnew (Gap_Array_Marker); m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos); m->next = ga->markers; @@ -689,8 +687,7 @@ static Gap_Array * make_gap_array (int elsize) { - Gap_Array *ga = (Gap_Array *) xmalloc (sizeof(*ga)); - memset (ga, 0, sizeof(*ga)); + Gap_Array *ga = xnew_and_zero (Gap_Array); ga->elsize = elsize; return ga; } @@ -864,7 +861,7 @@ extent_list_marker_freelist = extent_list_marker_freelist->next; } else - m = (Extent_List_Marker *) xmalloc (sizeof (*m)); + m = xnew (Extent_List_Marker); m->m = gap_array_make_marker (endp ? el->end : el->start, pos); m->endp = endp; @@ -899,7 +896,7 @@ static Extent_List * allocate_extent_list (void) { - Extent_List *el = (Extent_List *) xmalloc (sizeof(*el)); + Extent_List *el = xnew (Extent_List); el->start = make_gap_array (sizeof(EXTENT)); el->end = make_gap_array (sizeof(EXTENT)); el->markers = 0; @@ -928,8 +925,7 @@ static Lisp_Object mark_extent_auxiliary (Lisp_Object obj, void (*markobj) (Lisp_Object)) { - struct extent_auxiliary *data = - (struct extent_auxiliary *) XEXTENT_AUXILIARY (obj); + struct extent_auxiliary *data = XEXTENT_AUXILIARY (obj); ((markobj) (data->begin_glyph)); ((markobj) (data->end_glyph)); ((markobj) (data->invisible)); @@ -944,8 +940,7 @@ { Lisp_Object extent_aux = Qnil; struct extent_auxiliary *data = - alloc_lcrecord (sizeof (struct extent_auxiliary), - lrecord_extent_auxiliary); + alloc_lcrecord_type (struct extent_auxiliary, lrecord_extent_auxiliary); copy_lcrecord (data, &extent_auxiliary_defaults); XSETEXTENT_AUXILIARY (extent_aux, data); @@ -1049,8 +1044,7 @@ { Lisp_Object extent_info = Qnil; struct extent_info *data = - alloc_lcrecord (sizeof (struct extent_info), - lrecord_extent_info); + alloc_lcrecord_type (struct extent_info, lrecord_extent_info); XSETEXTENT_INFO (extent_info, data); data->extents = allocate_extent_list (); @@ -1524,8 +1518,7 @@ static struct stack_of_extents * allocate_soe (void) { - struct stack_of_extents *soe = - malloc_type_and_zero (struct stack_of_extents); + struct stack_of_extents *soe = xnew_and_zero (struct stack_of_extents); soe->extents = allocate_extent_list (); soe->pos = -1; return soe; @@ -2364,7 +2357,7 @@ struct adjust_extents_for_deletion_arg { - extent_dynarr *list; + EXTENT_dynarr *list; }; static int @@ -2404,7 +2397,7 @@ #ifdef ERROR_CHECK_EXTENTS sledgehammer_extent_check (object); #endif - closure.list = (extent_dynarr *) Dynarr_new (EXTENT); + closure.list = Dynarr_new (EXTENT); /* We're going to be playing weird games below with extents and the SOE and such, so compute the list now of all the extents that we're going @@ -2600,15 +2593,13 @@ struct extent_fragment * extent_fragment_new (Lisp_Object buffer_or_string, struct frame *frm) { - struct extent_fragment *ef = (struct extent_fragment *) - xmalloc (sizeof (struct extent_fragment)); - - memset (ef, 0, sizeof (*ef)); + struct extent_fragment *ef = xnew_and_zero (struct extent_fragment); + ef->object = buffer_or_string; ef->frm = frm; ef->extents = Dynarr_new (EXTENT); - ef->begin_glyphs = Dynarr_new (struct glyph_block); - ef->end_glyphs = Dynarr_new (struct glyph_block); + ef->begin_glyphs = Dynarr_new (glyph_block); + ef->end_glyphs = Dynarr_new (glyph_block); return ef; } @@ -2633,7 +2624,7 @@ } static void -extent_fragment_sort_by_priority (extent_dynarr *extarr) +extent_fragment_sort_by_priority (EXTENT_dynarr *extarr) { int i; @@ -3037,16 +3028,16 @@ if (!EXTENT_LIVE_P (XEXTENT (obj))) error ("printing unreadable object #<destroyed extent>"); else - error ("printing unreadable object #<extent 0x%lx>", - (long)XEXTENT (obj)); + error ("printing unreadable object #<extent 0x%p>", + XEXTENT (obj)); } if (!EXTENT_LIVE_P (XEXTENT (obj))) write_c_string ("#<destroyed extent", printcharfun); else { - char *buf = alloca (strlen (title) + strlen (name) - + strlen (posttitle)); + char *buf = (char *) + alloca (strlen (title) + strlen (name) + strlen (posttitle) + 1); write_c_string ("#<extent ", printcharfun); print_extent_1 (obj, printcharfun, escapeflag); write_c_string (extent_detached_p (XEXTENT (obj)) @@ -3293,7 +3284,7 @@ Find next extent after EXTENT. If EXTENT is a buffer return the first extent in the buffer; likewise for strings. -Extents in a buffer are ordered in what is called the \"display\" +Extents in a buffer are ordered in what is called the "display" order, which sorts by increasing start positions and then by *decreasing* end positions. If you want to perform an operation on a series of extents, use @@ -3344,7 +3335,7 @@ #ifdef DEBUG_XEMACS DEFUN ("next-e-extent", Fnext_e_extent, 1, 1, 0, /* -Find next extent after EXTENT using the \"e\" order. +Find next extent after EXTENT using the "e" order. If EXTENT is a buffer return the first extent in the buffer; likewise for strings. */ @@ -3365,7 +3356,7 @@ } DEFUN ("previous-e-extent", Fprevious_e_extent, 1, 1, 0, /* -Find last extent before EXTENT using the \"e\" order. +Find last extent before EXTENT using the "e" order. If EXTENT is a buffer return the last extent in the buffer; likewise for strings. This function is analogous to `next-e-extent'. @@ -3428,7 +3419,7 @@ DEFUN ("extent-parent", Fextent_parent, 1, 1, 0, /* Return the parent (if any) of EXTENT. If an extent has a parent, it derives all its properties from that extent -and has no properties of its own. (The only \"properties\" that the +and has no properties of its own. (The only "properties" that the extent keeps are the buffer/string it refers to and the start and end points.) It is possible for an extent's parent to itself have a parent. */ @@ -3641,8 +3632,8 @@ this extent to share the same aux struct as the original one. */ struct extent_auxiliary *data = - alloc_lcrecord (sizeof (struct extent_auxiliary), - lrecord_extent_auxiliary); + alloc_lcrecord_type (struct extent_auxiliary, + lrecord_extent_auxiliary); copy_lcrecord (data, XEXTENT_AUXILIARY (XCAR (original->plist))); XSETEXTENT_AUXILIARY (XCAR (e->plist), data); @@ -4347,10 +4338,10 @@ } DEFUN ("extent-at", Fextent_at, 1, 5, 0, /* -Find \"smallest\" extent at POS in OBJECT having PROPERTY set. -Normally, an extent is \"at\" POS if it overlaps the region (POS, POS+1); +Find "smallest" extent at POS in OBJECT having PROPERTY set. +Normally, an extent is "at" POS if it overlaps the region (POS, POS+1); i.e. if it covers the character after POS. (However, see the definition - of AT-FLAG.) \"Smallest\" means the extent that comes last in the display + of AT-FLAG.) "Smallest" means the extent that comes last in the display order; this normally means the extent whose start position is closest to POS. See `next-extent' for more information. OBJECT specifies a buffer or string and defaults to the current buffer. @@ -5873,7 +5864,7 @@ Returns the value of the PROP property at the given position. Optional arg OBJECT specifies the buffer or string to look in, and defaults to the current buffer. -Optional arg AT-FLAG controls what it means for a property to be \"at\" +Optional arg AT-FLAG controls what it means for a property to be "at" a position, and has the same meaning as in `extent-at'. This examines only those properties added with `put-text-property'. See also `get-char-property'. @@ -5887,7 +5878,7 @@ Returns the value of the PROP property at the given position. Optional arg OBJECT specifies the buffer or string to look in, and defaults to the current buffer. -Optional arg AT-FLAG controls what it means for a property to be \"at\" +Optional arg AT-FLAG controls what it means for a property to be "at" a position, and has the same meaning as in `extent-at'. This examines properties on all extents. See also `get-text-property'.
--- a/src/extents.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/extents.h Mon Aug 13 09:55:28 2007 +0200 @@ -90,8 +90,6 @@ Lisp_Object plist; }; -typedef struct extent *EXTENT; - /* Basic properties of an extent (not affected by the extent's parent) */ #define extent_object(e) ((e)->object) #define extent_start(e) ((e)->start + 0) @@ -114,6 +112,7 @@ most extents won't have this set on them, we usually don't need to have this structure around and thus the size of an extent is smaller. */ +typedef struct extent_auxiliary extent_auxiliary; struct extent_auxiliary { struct lcrecord_header header; @@ -221,7 +220,7 @@ MAC_DECLARE (EXTENT, MTensure_extent, e) \ (MTensure_extent->flags.has_aux ? (void) 0 : \ allocate_extent_auxiliary (MTensure_extent)) \ -MAC_END +MAC_END #define set_extent_no_chase_aux_field(e, field, value) \ MAC_BEGIN \ @@ -293,7 +292,7 @@ (MTplist_extent->flags.has_aux ? \ &XCONS (MTplist_extent->plist)->cdr : \ &MTplist_extent->plist) \ -MAC_END +MAC_END #define extent_no_chase_plist(e) (*extent_no_chase_plist_addr (e)) #define extent_plist_addr(e) extent_no_chase_plist_addr (extent_ancestor (e))
--- a/src/faces.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/faces.c Mon Aug 13 09:55:28 2007 +0200 @@ -383,7 +383,7 @@ allocate_face (void) { struct Lisp_Face *result = - alloc_lcrecord (sizeof (struct Lisp_Face), lrecord_face); + alloc_lcrecord_type (struct Lisp_Face, lrecord_face); reset_face (result); return result; @@ -405,7 +405,8 @@ /* This function can GC */ Lisp_Object key, contents; Lisp_Object *face_list; - struct face_list_closure *fcl = face_list_closure; + struct face_list_closure *fcl = + (struct face_list_closure *) face_list_closure; CVOID_TO_LISP (key, hash_key); VOID_TO_LISP (contents, hash_contents); face_list = fcl->face_list; @@ -511,7 +512,8 @@ void *face_inheritance_closure) { Lisp_Object key, contents; - struct face_inheritance_closure *fcl = face_inheritance_closure; + struct face_inheritance_closure *fcl = + (struct face_inheritance_closure *) face_inheritance_closure; CVOID_TO_LISP (key, hash_key); VOID_TO_LISP (contents, hash_contents);
--- a/src/faces.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/faces.h Mon Aug 13 09:55:28 2007 +0200 @@ -115,6 +115,7 @@ #define NUM_STATIC_CACHEL_FACES 4 +typedef struct face_cachel face_cachel; struct face_cachel { /* There are two kinds of cachels; those created from a single face
--- a/src/fileio.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/fileio.c Mon Aug 13 09:55:28 2007 +0200 @@ -599,7 +599,7 @@ The result can be used as the value of `default-directory' or passed as second argument to `expand-file-name'. For a Unix-syntax file name, just appends a slash. -On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. +On VMS, converts "[X]FOO.DIR" to "[X.FOO]", etc. */ (file)) { @@ -783,8 +783,8 @@ This operation exists because a directory is also a file, but its name as a directory is different from its name as a file. In Unix-syntax, this function just removes the final slash. -On VMS, given a VMS-syntax directory name such as \"[X.Y]\", -it returns a file name such as \"[X]Y.DIR.1\". +On VMS, given a VMS-syntax directory name such as "[X.Y]", +it returns a file name such as "[X]Y.DIR.1". */ (directory)) { @@ -2583,8 +2583,7 @@ bufsize = 100; while (1) { - buf = (char *) xmalloc (bufsize); - memset (buf, 0, bufsize); + buf = xnew_array_and_zero (char, bufsize); valsize = readlink ((char *) XSTRING_DATA (filename), buf, bufsize); if (valsize < bufsize) break; @@ -3627,7 +3626,7 @@ LSTREAM_BLOCKN_BUFFERED, 65536); #ifdef MULE outstream = - make_encoding_output_stream ( XLSTREAM (outstream), codesys); + make_encoding_output_stream (XLSTREAM (outstream), codesys); Lstream_set_buffering (XLSTREAM (outstream), LSTREAM_BLOCKN_BUFFERED, 65536); #endif /* MULE */
--- a/src/filelock.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/filelock.c Mon Aug 13 09:55:28 2007 +0200 @@ -39,7 +39,7 @@ the Lisp variables we use. */ /* The name of the directory in which we keep lock files, with a '/' - appended. */ + appended. */ Lisp_Object Vlock_directory; #if 0 /* FSFmacs */ @@ -85,7 +85,7 @@ REGISTER unsigned char *p, new; CHECK_STRING (Vlock_directory); - + /* 7-bytes cyclic code for burst correction on byte-by-byte basis. the used polynomial is D^7 + D^6 + D^3 +1. pot@cnuce.cnr.it */ @@ -442,7 +442,7 @@ if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer) && !NILP (fn)) lock_file (fn); - return Qnil; + return Qnil; } DEFUN ("unlock-buffer", Funlock_buffer, 0, 0, 0, /* @@ -500,7 +500,7 @@ return (Qnil); else if (owner == getpid ()) return (Qt); - + return (lock_file_owner_name (lfname)); }
--- a/src/floatfns.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/floatfns.c Mon Aug 13 09:55:28 2007 +0200 @@ -119,8 +119,8 @@ Fsignal (Qdomain_error, list3 (build_string ((op)), (a1), (a2))) -/* Convert float to Lisp_Int if it fits, else signal a range error - using the given arguments. */ +/* Convert float to Lisp Integer if it fits, else signal a range + error using the given arguments. */ static Lisp_Object float_to_int (double x, CONST char *name, Lisp_Object num, Lisp_Object num2) { @@ -141,7 +141,7 @@ { switch (errno) { - case 0: + case 0: break; case EDOM: if (in_float == 2) @@ -158,7 +158,7 @@ } } - + static Lisp_Object mark_float (Lisp_Object, void (*) (Lisp_Object)); extern void print_float (Lisp_Object, Lisp_Object, int); @@ -438,7 +438,7 @@ EMACS_INT acc, x, y; x = XINT (arg1); y = XINT (arg2); - + if (y < 0) { if (x == 1) @@ -710,7 +710,7 @@ #else #ifdef HAVE_FREXP { - int exqp; + int exqp; IN_FLOAT (frexp (f, &exqp), "logb", arg); return (make_int (exqp - 1)); } @@ -936,7 +936,7 @@ #endif /* FLOAT_CATCH_SIGILL */ #ifdef HAVE_MATHERR -int +int matherr (struct exception *x) { Lisp_Object args; @@ -971,7 +971,7 @@ #ifdef LISP_FLOAT_TYPE # ifdef FLOAT_CATCH_SIGILL signal (SIGILL, float_error); -# endif +# endif in_float = 0; #endif /* LISP_FLOAT_TYPE */ } @@ -979,9 +979,9 @@ void syms_of_floatfns (void) { - + /* Trig functions. */ - + #ifdef LISP_FLOAT_TYPE DEFSUBR (Facos); DEFSUBR (Fasin); @@ -992,7 +992,7 @@ #endif /* LISP_FLOAT_TYPE */ /* Bessel functions */ - + #if 0 DEFSUBR (Fbessel_y0); DEFSUBR (Fbessel_y1);
--- a/src/fns.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/fns.c Mon Aug 13 09:55:28 2007 +0200 @@ -573,11 +573,7 @@ the result in the returned string's `string-translatable' property. */ #endif if (target_type == c_string) - { - args_mse = ((struct merge_string_extents_struct *) - alloca (nargs * - sizeof (struct merge_string_extents_struct))); - } + args_mse = alloca_array (struct merge_string_extents_struct, nargs); /* In append, the last arg isn't treated like the others */ if (last_special && nargs > 0) @@ -1808,7 +1804,7 @@ Sort LIST, stably, comparing elements using PREDICATE. Returns the sorted list. LIST is modified by side effects. PREDICATE is called with two elements of LIST, and should return T -if the first element is \"less\" than the second. +if the first element is "less" than the second. */ (list, pred)) { @@ -1917,9 +1913,9 @@ lb = XINT (Flength (b)); m = (la > lb ? la : lb); fill = 0; - keys = (Lisp_Object *) alloca (m * sizeof (Lisp_Object)); - vals = (Lisp_Object *) alloca (m * sizeof (Lisp_Object)); - flags = (char *) alloca (m * sizeof (char)); + keys = alloca_array (Lisp_Object, m); + vals = alloca_array (Lisp_Object, m); + flags = alloca_array (char, m); /* First extract the pairs from A. */ for (rest = a; !NILP (rest); rest = XCDR (XCDR (rest))) @@ -3009,7 +3005,7 @@ T if two Lisp objects have similar structure and contents. They must have the same data type. \(Note, however, that an exception is made for characters and integers; -this is known as the \"char-int confoundance disease.\" See `eq' and +this is known as the "char-int confoundance disease." See `eq' and `old-eq'.) This function is provided only for byte-code compatibility with v19. Do not use it. @@ -3218,7 +3214,7 @@ DEFUN ("mapconcat", Fmapconcat, 3, 3, 0, /* Apply FN to each element of SEQ, and concat the results as strings. In between each pair of results, stick in SEP. -Thus, \" \" as SEP results in spaces between the values returned by FN. +Thus, " " as SEP results in spaces between the values returned by FN. */ (fn, seq, sep)) { @@ -3231,7 +3227,7 @@ nargs = len + len - 1; if (nargs < 0) return build_string (""); - args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object)); + args = alloca_array (Lisp_Object, nargs); GCPRO1 (sep); mapcar1 (len, args, fn, seq); @@ -3254,7 +3250,7 @@ (fn, seq)) { int len = XINT (Flength (seq)); - Lisp_Object *args = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); + Lisp_Object *args = alloca_array (Lisp_Object, len); mapcar1 (len, args, fn, seq); @@ -3269,7 +3265,7 @@ (fn, seq)) { int len = XINT (Flength (seq)); - Lisp_Object *args = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); + Lisp_Object *args = alloca_array (Lisp_Object, len); mapcar1 (len, args, fn, seq);
--- a/src/font-lock.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/font-lock.c Mon Aug 13 09:55:28 2007 +0200 @@ -28,14 +28,14 @@ Two caches are used: one caches the last point computed, and the other caches the last point at the beginning of a line. This makes there - be little penalty for moving left-to-right on a line a character at a + be little penalty for moving left-to-right on a line a character at a time; makes starting over on a line be cheap; and makes random-accessing - within a line relatively cheap. + within a line relatively cheap. When we move to a different line farther down in the file (but within the current top-level form) we simply continue computing forward. If we move backward more than a line, or move beyond the end of the current tlf, or - switch buffers, then we call `beginning-of-defun' and start over from + switch buffers, then we call `beginning-of-defun' and start over from there. #### We should really rewrite this to keep extents over the buffer @@ -400,7 +400,7 @@ SYNTAX_STYLES_MATCH_END_P (table, c1, c2, SYNTAX_COMMENT_STYLE_B) ? \ comment_style_b : \ comment_style_none) - + #define SINGLE_SYNTAX_STYLE(table, c) \ (SYNTAX_STYLES_MATCH_1CHAR_P (table, c, SYNTAX_COMMENT_STYLE_A) ? \ comment_style_a : \
--- a/src/frame-x.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/frame-x.c Mon Aug 13 09:55:28 2007 +0200 @@ -227,7 +227,7 @@ x_wm_set_cell_size (Widget wmshell, int cw, int ch) { Arg al [2]; - + if (!XtIsWMShell (wmshell)) abort (); if (cw <= 0 || ch <= 0) @@ -242,7 +242,7 @@ x_wm_set_variable_size (Widget wmshell, int width, int height) { Arg al [2]; - + if (!XtIsWMShell (wmshell)) abort (); #ifdef DEBUG_GEOMETRY_MANAGEMENT @@ -456,7 +456,7 @@ defi(Qheight, XtNheight); defi(Qleft, XtNx); defi(Qtop, XtNy); - + #undef def } @@ -504,7 +504,7 @@ to learn about race conditions and such. We can't trust the X and Y values to have any semblance of correctness, so we smash the right values in place. */ - + /* We might be called before we've actually realized the window (if we're checking for the minibuffer resource). This will bomb in that case so we don't bother calling it. */ @@ -611,7 +611,7 @@ x = y = 0; else x_get_top_level_position (XtDisplay (shell), XtWindow (shell), &x, &y); - + FROB (Qleft, make_int (x)); FROB (Qtop, make_int (y)); @@ -676,7 +676,7 @@ } } -static void +static void x_set_title_from_bufbyte (struct frame *f, Bufbyte *name) { x_set_frame_text_value (f, name, XtNtitle, XtNtitleEncoding); @@ -713,23 +713,23 @@ /* and also set the WMShell's geometry */ (flags & XNegative) ? (xval = -x, xsign = '-') : (xval = x, xsign = '+'); (flags & YNegative) ? (yval = -y, ysign = '-') : (yval = y, ysign = '+'); - + if (uspos && ussize) sprintf (shell_geom, "=%dx%d%c%d%c%d", w, h, xsign, xval, ysign, yval); else if (uspos) sprintf (shell_geom, "=%c%d%c%d", xsign, xval, ysign, yval); else if (ussize) sprintf (shell_geom, "=%dx%d", w, h); - + if (uspos || ussize) { - temp = xmalloc (1 + strlen (shell_geom)); + temp = (char *) xmalloc (1 + strlen (shell_geom)); strcpy (temp, shell_geom); FRAME_X_GEOM_FREE_ME_PLEASE (f) = temp; } else temp = NULL; - + XtSetArg (al [0], XtNgeometry, temp); XtSetValues (FRAME_X_SHELL_WIDGET (f), al, 1); } @@ -751,16 +751,16 @@ Lisp_Object tail; Widget w = FRAME_X_TEXT_WIDGET (f); Arg al [10]; - + for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail))) { Lisp_Object prop = Fcar (tail); Lisp_Object val = Fcar (Fcdr (tail)); - + if (STRINGP (prop)) { CONST char *extprop; - + if (XSTRING_LENGTH (prop) == 0) continue; @@ -898,7 +898,7 @@ width = FRAME_WIDTH (f); if (!height_specified_p) height = FRAME_HEIGHT (f); - + /* Kludge kludge kludge kludge. */ if (position_specified_p && (!x_position_specified_p || !y_position_specified_p)) @@ -913,7 +913,7 @@ y = (int) (FRAME_X_SHELL_WIDGET (f)->core.y); #endif } - + if (!f->init_finished) { int flags = (size_specified_p ? WidthValue | HeightValue : 0) | @@ -951,7 +951,7 @@ { /* Only do this if this is the first X frame we're creating. - + If the *title resource (or -title option) was specified, then set frame-title-format to its value. */ @@ -1092,7 +1092,7 @@ dnd_convert_cb_rec[0].closure = (XtPointer) Ctext; dnd_convert_cb_rec[1].callback = NULL; dnd_convert_cb_rec[1].closure = NULL; - + dnd_destroy_cb_rec[0].callback = x_cde_destroy_callback; dnd_destroy_cb_rec[0].closure = (XtPointer) Ctext; dnd_destroy_cb_rec[1].callback = NULL; @@ -1118,19 +1118,19 @@ Lisp_Object frame = Qnil; Lisp_Object data = Qnil; struct gcpro gcpro1, gcpro2, gcpro3; - + DtDndTransferCallbackStruct *transferInfo = (DtDndTransferCallbackStruct *) callData; if (transferInfo == NULL) return; - + GCPRO3 (path, frame, data); - + frame = make_frame ((struct frame *) clientData); if (transferInfo->dropData->protocol == DtDND_FILENAME_TRANSFER) { - for (ii = 0; ii < transferInfo->dropData->numItems; ii++) + for (ii = 0; ii < transferInfo->dropData->numItems; ii++) { filePath = transferInfo->dropData->data.files[ii]; /* ### Mule-izing required */ @@ -1141,7 +1141,7 @@ else if (transferInfo->dropData->protocol == DtDND_BUFFER_TRANSFER) { int speccount = specpdl_depth(); - + record_unwind_protect(abort_current_drag, Qnil); drag_not_done = 1; for (ii = 0; ii < transferInfo->dropData->numItems; ii++) @@ -1168,11 +1168,11 @@ #ifdef HAVE_OFFIX_DND #include <OffiX/DragAndDrop.h> -void +void x_offix_drop_event_handler (Widget widget, XtPointer data, XEvent *event, Boolean *b) { - int i, len, Type; + int i, len, Type; unsigned char *Data; unsigned long Size; @@ -1188,16 +1188,16 @@ stderr_out("DndDropHandler: pseudo drop received (ignore me!)\n"); return; } - - Type = DndDataType (event); + + Type = DndDataType (event); DndGetData (&Data, &Size); - + GCPRO4 (path, frame, dnd_data, dnd_type); frame = make_frame ((struct frame *) data); stderr_out("DndDropHandler: valid drop received (T%d S%u)\n",Type,Size); - + switch (Type) { case DndFiles: @@ -1337,7 +1337,7 @@ ApplicationShell EmacsShell EmacsManager EmacsFrame #ifdef EXTERNAL_WIDGET - The ExternalShell widget is simply a replacement for the Shell widget + The ExternalShell widget is simply a replacement for the Shell widget which is able to deal with using an externally-supplied window instead of always creating its own. #endif @@ -1393,14 +1393,14 @@ int app_y = 0; unsigned int app_w = 0; unsigned int app_h = 0; - + /* Geometry of the EmacsFrame */ int frame_flags = 0; int frame_x = 0; int frame_y = 0; unsigned int frame_w = 0; unsigned int frame_h = 0; - + /* Hairily merged geometry */ int x = 0; int y = 0; @@ -1490,7 +1490,7 @@ XtSetArg (al [0], XtNwidth, &frame_w); XtSetArg (al [1], XtNheight, &frame_h); XtGetValues (ew, al, 2); - + if (frame_flags & XNegative) frame_x += frame_w; if (frame_flags & YNegative) @@ -1552,7 +1552,7 @@ frame_flags = XParseGeometry (ew_geom, &frame_x, &frame_y, &frame_w, &frame_h); - + if (first_x_frame_p (f)) { /* If this is the first frame created: @@ -1691,7 +1691,7 @@ just need to know which sides they are supposed to go on. */ unsigned char scrollbar_placement; Arg al [1]; - + XtSetArg (al [0], XtNscrollBarPlacement, &scrollbar_placement); XtGetValues (text, al, 1); f->scrollbar_on_left = (scrollbar_placement == XtTOP_LEFT || @@ -1766,7 +1766,7 @@ GET_C_STRING_CTEXT_DATA_ALLOCA (f->name, name); else name = "emacs"; - + /* The widget hierarchy is argv[0] shell pane FRAME-NAME @@ -1869,12 +1869,12 @@ text = XtCreateWidget (name, emacsFrameClass, container, al, 2); FRAME_X_TEXT_WIDGET (f) = text; -#ifdef HAVE_MENUBARS +#ifdef HAVE_MENUBARS /* Create the initial menubar widget. */ menubar_visible = x_initialize_frame_menubar (f); FRAME_X_TOP_WIDGETS (f)[0] = menubar = FRAME_X_MENUBAR_WIDGET (f); FRAME_X_NUM_TOP_WIDGETS (f) = 1; - + if (menubar_visible) XtManageChild (menubar); #endif /* HAVE_MENUBARS */ @@ -1978,7 +1978,7 @@ #ifdef HAVE_XIM XIM_init_frame (f); #endif /* HAVE_XIM */ - + #ifdef HACK_EDITRES /* Allow XEmacs to respond to EditRes requests. See the O'Reilly Xt */ /* Instrinsics Programming Manual, Motif Edition, Aug 1993, Sect 14.14, */ @@ -1986,7 +1986,7 @@ XtAddEventHandler (shell_widget, /* the shell widget in question */ (EventMask) NoEventMask,/* OR with existing mask */ True, /* called on non-maskable events? */ - _XEditResCheckMessages, /* the handler */ + (XtEventHandler) _XEditResCheckMessages, /* the handler */ NULL); #endif /* HACK_EDITRES */ @@ -2010,7 +2010,7 @@ { DndInitialize (FRAME_X_SHELL_WIDGET (f)); DndRegisterDropWidget (FRAME_X_TEXT_WIDGET (f), - x_offix_drop_event_handler, + x_offix_drop_event_handler, (XtPointer) f); } @@ -2023,7 +2023,7 @@ XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget), DEVICE_XATOM_WM_PROTOCOLS (d), XA_ATOM, 32, PropModeAppend, (unsigned char*) NULL, 0); - + x_send_synthetic_mouse_event (f); } @@ -2031,7 +2031,7 @@ allocate_x_frame_struct (struct frame *f) { /* zero out all slots. */ - f->frame_data = malloc_type_and_zero (struct x_frame); + f->frame_data = xnew_and_zero (struct x_frame); /* yeah, except the lisp ones */ FRAME_X_ICON_PIXMAP (f) = Qnil; @@ -2222,7 +2222,7 @@ XtSetArg (al [1], XtNx, xoff); XtSetArg (al [2], XtNy, yoff); XtSetValues (w, al, 3); - + /* Sometimes you will find that (set-frame-position (selected-frame) -50 -50) @@ -2336,7 +2336,7 @@ if (FRAME_VISIBLE_P(f) || force) { emacs_window = XtWindow (FRAME_X_SHELL_WIDGET (f)); - /* first raises all the dialog boxes, then put emacs just below the + /* first raises all the dialog boxes, then put emacs just below the * bottom most dialog box */ bottom_dialog = lw_raise_all_pop_up_widgets (); if (bottom_dialog && XtWindow (bottom_dialog)) @@ -2371,7 +2371,7 @@ Display *display = DEVICE_X_DISPLAY (XDEVICE (f->device)); XWindowChanges xwc; unsigned int flags; - + if (FRAME_VISIBLE_P(f)) { xwc.stack_mode = Below; @@ -2509,7 +2509,7 @@ f->visible = xwa.map_state == IsViewable; */ viewable = xwa.map_state == IsViewable; - + if (viewable) { Window focus; @@ -2671,7 +2671,7 @@ frame. May be set only at startup, and only if external widget support was compiled in; doing so causes the frame - to be created as an \"external widget\" + to be created as an "external widget" in another program that uses an existing window in the program rather than creating a new one. @@ -2680,7 +2680,7 @@ need to call `make-frame-visible' to make the frame appear. popup If non-nil, it should be a frame, and this - frame will be created as a \"popup\" frame + frame will be created as a "popup" frame whose parent is the given frame. This will make the window manager treat the frame as a dialog box, which may entail
--- a/src/frame.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/frame.c Mon Aug 13 09:55:28 2007 +0200 @@ -219,7 +219,7 @@ /* This function can GC */ Lisp_Object frame = Qnil; Lisp_Object root_window; - struct frame *f = alloc_lcrecord (sizeof (struct frame), lrecord_frame); + struct frame *f = alloc_lcrecord_type (struct frame, lrecord_frame); zero_lcrecord (f); nuke_all_frame_slots (f); @@ -1899,10 +1899,10 @@ /* FSF returns 'icon for iconized frames. What a crock! */ DEFUN ("frame-visible-p", Fframe_visible_p, 0, 1, 0, /* -Return non NIL if FRAME is now \"visible\" (actually in use for display). +Return non NIL if FRAME is now "visible" (actually in use for display). A frame that is not visible is not updated, and, if it works through a window system, may not show at all. -N.B. Under X \"visible\" means Mapped. It the window is mapped but not +N.B. Under X "visible" means Mapped. It the window is mapped but not actually visible on screen then frame_visible returns 'hidden. */ (frame)) @@ -1940,7 +1940,7 @@ } DEFUN ("visible-frame-list", Fvisible_frame_list, 0, 1, 0, /* -Return a list of all frames now \"visible\" (being updated). +Return a list of all frames now "visible" (being updated). If DEVICE is specified only frames on that device will be returned. Note that under virtual window managers not all these frame are necessarily really updated.
--- a/src/frame.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/frame.h Mon Aug 13 09:55:28 2007 +0200 @@ -152,7 +152,7 @@ /* True if frame actually has a minibuffer window on it. 0 if using a minibuffer window that isn't on this frame. */ unsigned int has_minibuffer :1; - + /* True if frame's root window can't be split. */ unsigned int no_split :1; @@ -340,7 +340,7 @@ #define FRAME_CURSOR_X(f) ((f)->cursor_x) #define FRAME_CURSOR_Y(f) ((f)->cursor_y) #define FRAME_VISIBLE_P(f) ((f)->visible) -#define FRAME_REPAINT_P(f) ((f)->visible>0) +#define FRAME_REPAINT_P(f) ((f)->visible>0) #define FRAME_NO_SPLIT_P(f) ((f)->no_split) #define FRAME_ICONIFIED_P(f) ((f)->iconified) #define FRAME_FOCUS_FRAME(f) ((f)->focus_frame) @@ -529,8 +529,8 @@ Lisp_Object console); Lisp_Object prev_frame (Lisp_Object f, Lisp_Object frametype, Lisp_Object console); -void store_in_alist (Lisp_Object *alistptr, - CONST char *propname, +void store_in_alist (Lisp_Object *alistptr, + CONST char *propname, Lisp_Object val); void pixel_to_char_size (struct frame *f, int pixel_width, int pixel_height, int *char_width, int *char_height); @@ -539,7 +539,7 @@ void round_size_to_char (struct frame *f, int in_width, int in_height, int *out_width, int *out_height); void change_frame_size (struct frame *frame, - int newlength, int newwidth, + int newlength, int newwidth, int delay); void hold_frame_size_changes (void); void unhold_one_frame_size_changes (struct frame *f);
--- a/src/free-hook.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/free-hook.c Mon Aug 13 09:55:28 2007 +0200 @@ -203,7 +203,7 @@ { #ifdef SAVE_STACK FRAME start_frame; - + init_frame (&start_frame); #endif @@ -218,7 +218,8 @@ unsigned long rounded_up_size; #endif - EMACS_INT present = (EMACS_INT) gethash (ptr, pointer_table, (void *) &size); + EMACS_INT present = (EMACS_INT) gethash (ptr, pointer_table, + (void **) &size); if (!present) /* This can only happen if you try to free something that didn't @@ -291,7 +292,7 @@ end: return; -} +} static void * check_malloc (unsigned long size) @@ -337,8 +338,8 @@ EMACS_INT present; unsigned long old_size; void *result = malloc (size); - - present = (EMACS_INT) gethash (ptr, pointer_table, (void *) &old_size); + + present = (EMACS_INT) gethash (ptr, pointer_table, (void **) &old_size); if (!present) /* This can only happen by reallocing a pointer that didn't come from malloc. */ @@ -351,14 +352,14 @@ return result; } -void enable_strict_free_check (void); +void enable_strict_free_check (void); void enable_strict_free_check (void) { strict_free_check = 1; } -void disable_strict_free_check (void); +void disable_strict_free_check (void); void disable_strict_free_check (void) { @@ -445,7 +446,7 @@ count[0] = 0; count[1] = 0; __free_hook = 0; - maphash ((maphash_function)really_free_one_entry, + maphash ((maphash_function)really_free_one_entry, pointer_table, (void *)&count); memset (free_queue, 0, sizeof (free_queue_entry) * FREE_QUEUE_LIMIT); current_free = 0; @@ -494,7 +495,8 @@ gcpro1_type, gcpro2_type, gcpro3_type, gcpro4_type, ungcpro_type } blocktype; -struct block_input_history_struct { +struct block_input_history_struct +{ char *file; int line; blocktype type; @@ -539,7 +541,7 @@ init_frame (&start_frame); #endif - + blhist[blhistptr].file = file; blhist[blhistptr].line = line; blhist[blhistptr].type = type;
--- a/src/getloadavg.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/getloadavg.c Mon Aug 13 09:55:28 2007 +0200 @@ -537,7 +537,7 @@ #ifdef XEMACS #if ! defined (LDAV_DONE) && defined (HAVE_KSTAT_H) && defined (HAVE_LIBKSTAT) #define LDAV_DONE - + /* getloadavg is best implemented using kstat (kernel stats), on systems (like SunOS5) that support it, since you don't have to be superusers to use it. @@ -559,7 +559,7 @@ return -1; if (kstat_read(kc, ksp, ksp->ks_data) < 0) return -1; - buf = malloc(ksp->ks_data_size); + buf = (kstat_named_t *) malloc (ksp->ks_data_size); if (!buf) return -1; memcpy(buf, ksp->ks_data, ksp->ks_data_size); @@ -568,7 +568,7 @@ for (elem = 0; elem < nelem; elem++) loadavg[elem] = (buf + 6 + elem)->value.ul / 256.0; free(buf); - + #endif /* HAVE_KSTAT_H && HAVE_LIBKSTAT */ #if !defined (LDAV_DONE) && defined (HAVE_SYS_PSTAT_H)
--- a/src/glyphs-x.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/glyphs-x.c Mon Aug 13 09:55:28 2007 +0200 @@ -29,7 +29,7 @@ subwindow support added by Chuck Thompson additional XPM support added by Chuck Thompson initial X-Face support added by Stig - rewritten/restructured by Ben Wing for 19.12/19.13 + rewritten/restructured by Ben Wing for 19.12/19.13 GIF/JPEG support added by Ben Wing for 19.14 PNG support added by Bill Perry for 19.14 Improved GIF/JPEG support added by Bill Perry for 19.14 @@ -58,7 +58,13 @@ #include "sysfile.h" #ifdef HAVE_PNG +#ifdef __cplusplus +extern "C" { +#endif #include <png.h> +#ifdef __cplusplus +} +#endif #else #include <setjmp.h> #endif @@ -249,7 +255,7 @@ x_initialize_pixmap_image_instance (struct Lisp_Image_Instance *ii, enum image_instance_type type) { - ii->data = malloc_type_and_zero (struct x_image_instance_data); + ii->data = xnew_and_zero (struct x_image_instance_data); IMAGE_INSTANCE_TYPE (ii) = type; IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = Qnil; IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (ii) = Qnil; @@ -370,7 +376,7 @@ Lisp_Object data; assert (VECTORP (instantiator)); - + data = find_keyword_in_vector (instantiator, data_keyword); file = find_keyword_in_vector (instantiator, file_keyword); @@ -395,7 +401,7 @@ Lisp_Object file = Qnil; struct gcpro gcpro1, gcpro2; Lisp_Object alist = Qnil; - + GCPRO2 (file, alist); /* Now, convert any file data into inline data. At the end of this, @@ -439,7 +445,7 @@ Extbyte *bytes; Extcount len; FILE *stream; - + /* #### This is a definite problem under Mule due to the amount of stack data it might allocate. Need to be able to convert and write out to a file. */ @@ -516,7 +522,7 @@ xfg->pixel = 0; xfg->red = xfg->green = xfg->blue = 0; } - + if (!NILP (*background) && !COLOR_INSTANCEP (*background)) *background = Fmake_color_instance (*background, device, @@ -598,7 +604,7 @@ if (!(dest_mask & IMAGE_COLOR_PIXMAP_MASK)) incompatible_image_types (instantiator, dest_mask, IMAGE_COLOR_PIXMAP_MASK); - + pixmap = XCreatePixmap (dpy, d, ximage->width, ximage->height, ximage->depth); if (!pixmap) @@ -610,17 +616,17 @@ XFreePixmap (dpy, pixmap); signal_simple_error ("Unable to create GC", instantiator); } - + XPutImage (dpy, pixmap, gc, ximage, 0, 0, 0, 0, ximage->width, ximage->height); - + XFreeGC (dpy, gc); x_initialize_pixmap_image_instance (ii, IMAGE_COLOR_PIXMAP); IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = find_keyword_in_vector (instantiator, Q_file); - + IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap; IMAGE_INSTANCE_X_MASK (ii) = 0; IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = ximage->width; @@ -688,7 +694,7 @@ return Qt. -- maybe return an error, or return Qnil. */ - + static Lisp_Object bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot, @@ -787,7 +793,7 @@ Lisp_Object file = Qnil, mask_file = Qnil; struct gcpro gcpro1, gcpro2, gcpro3; Lisp_Object alist = Qnil; - + GCPRO3 (file, mask_file, alist); /* Now, convert any file data into inline data for both the regular @@ -1060,8 +1066,14 @@ * JPEG * **********************************************************************/ +#ifdef __cplusplus +extern "C" { +#endif #include <jpeglib.h> #include <jerror.h> +#ifdef __cplusplus +} +#endif /* The in-core jpeg code doesn't work, so I'm avoiding it for now. -sb */ /* Late-breaking update, we're going to give it a try, I think it's */ @@ -1237,7 +1249,7 @@ jpeg_memory_src (j_decompress_ptr cinfo, JOCTET *data, unsigned int len) { struct jpeg_source_mgr *src = NULL; - + if (cinfo->src == NULL) { /* first time for this JPEG object? */ cinfo->src = (struct jpeg_source_mgr *) (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT, @@ -1332,7 +1344,7 @@ list1 (build_string (unwind.tempfile))); } #endif - + /* Step 1: allocate and initialize JPEG decompression object */ /* We set up the normal JPEG error routines, then override error_exit. */ @@ -1349,11 +1361,11 @@ { Lisp_Object errstring; char buffer[JMSG_LENGTH_MAX]; - + /* Create the message */ (*cinfo.err->format_message) ((j_common_ptr) &cinfo, buffer); errstring = build_string (buffer); - + signal_simple_error_2 ("JPEG decoding error", errstring, instantiator); } @@ -1372,7 +1384,7 @@ Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); Extbyte *bytes; Extcount len; - + /* #### This is a definite problem under Mule due to the amount of stack data it might allocate. Need to be able to convert and write out to a file. */ @@ -1431,7 +1443,7 @@ /* Just in case the image contains out-of-range pixels, we go ahead and allocate space for all of them. */ - unwind.pixels = (unsigned long *) xmalloc (256 * sizeof (unsigned long)); + unwind.pixels = xnew_array (unsigned long, 256); unwind.npixels = cinfo.actual_number_of_colors; for (i = 0; i < 256; i++) @@ -1466,17 +1478,14 @@ int width = cinfo.output_width; int depth; int bitmap_pad; - + depth = DefaultDepthOfScreen (scr); - + /* first get bitmap_pad (from XPM) */ - if (depth > 16) - bitmap_pad = 32; - else if (depth > 8) - bitmap_pad = 16; - else - bitmap_pad = 8; - + bitmap_pad = ((depth > 16) ? 32 : + (depth > 8) ? 16 : + 8); + unwind.ximage = XCreateImage (dpy, DefaultVisualOfScreen (scr), depth, ZPixmap, 0, 0, width, height, bitmap_pad, 0); @@ -1499,7 +1508,7 @@ * output image dimensions available, as well as the output colormap * if we asked for color quantization. * In this example, we need to make an output work buffer of the right size. - */ + */ /* JSAMPLEs per row in output buffer. Since we asked for quantized output, cinfo.output_components will always be 1. */ @@ -1508,7 +1517,7 @@ with image */ row_buffer = ((*cinfo.mem->alloc_sarray) ((j_common_ptr) &cinfo, JPOOL_IMAGE, row_stride, 1)); - + /* Here we use the library's state variable cinfo.output_scanline as the * loop counter, so that we don't have to keep track ourselves. */ @@ -1662,7 +1671,7 @@ GifPixelType *ScreenBuffer = (GifPixelType *) xmalloc (GifFile->SHeight * GifFile->SWidth * sizeof (GifPixelType)); - GifFile->SavedImages = (SavedImage *) xmalloc (sizeof(SavedImage)); + GifFile->SavedImages = xnew (SavedImage); for (i = 0; i < GifFile->SHeight * GifFile->SWidth; i++) ScreenBuffer[i] = GifFile->SBackGroundColor; @@ -1690,7 +1699,7 @@ sp->RasterBits = (GifPixelType*) xmalloc(Width * Height * sizeof (GifPixelType)); - + if (GifFile->Image.Interlace) { /* Need to perform 4 passes on the images: */ @@ -1800,7 +1809,7 @@ if (our_own_dgif_slurp_from_gif2x11_c(unwind.giffile) != GIF_OK) #else /* DGifSlurp() doesn't handle interlaced files. */ - /* Actually, it does, sort of. It just sets the Interlace flag + /* Actually, it does, sort of. It just sets the Interlace flag and stores RasterBits in interlaced order. We handle that below. */ if (DGifSlurp (unwind.giffile) != GIF_OK) #endif @@ -1813,7 +1822,7 @@ ColorMapObject *cmap = unwind.giffile->SColorMap; /* Just in case the image contains out-of-range pixels, we go ahead and allocate space for all of them. */ - unwind.pixels = (unsigned long *) xmalloc (256 * sizeof (unsigned long)); + unwind.pixels = xnew_array (unsigned long, 256); unwind.npixels = cmap->ColorCount; for (i = 0; i < 256; i++) @@ -1846,17 +1855,14 @@ static int InterlacedOffset[] = { 0, 4, 2, 1 }; static int InterlacedJumps[] = { 8, 8, 4, 2 }; - + depth = DefaultDepthOfScreen (scr); - + /* first get bitmap_pad (from XPM) */ - if (depth > 16) - bitmap_pad = 32; - else if (depth > 8) - bitmap_pad = 16; - else - bitmap_pad = 8; - + bitmap_pad = ((depth > 16) ? 32 : + (depth > 8) ? 16 : + 8); + unwind.ximage = XCreateImage (dpy, DefaultVisualOfScreen (scr), depth, ZPixmap, 0, 0, width, height, bitmap_pad, 0); @@ -1877,8 +1883,8 @@ to be a bottleneck here, maybe we should just copy the optimization routines from XPM (they're in turn mostly copied from the Xlib source code). */ - - /* Note: We just use the first image in the file and ignore the rest. + + /* Note: We just use the first image in the file and ignore the rest. We check here that that image covers the full "screen" size. I don't know whether that's always the case. -dkindred@cs.cmu.edu */ @@ -2053,8 +2059,8 @@ dpy = DEVICE_X_DISPLAY (XDEVICE (device)); scr = DefaultScreenOfDisplay (dpy); - png_ptr = (png_struct *) xmalloc (sizeof (png_struct)); - info_ptr = (png_info *) xmalloc (sizeof (png_info)); + png_ptr = xnew (png_struct); + info_ptr = xnew (png_info); memset (&unwind, 0, sizeof (unwind)); unwind.png_ptr = png_ptr; @@ -2111,9 +2117,9 @@ Extbyte *bytes; Extcount len; struct png_memory_storage tbr; /* Data to be read */ - + assert (!NILP (data)); - + /* #### This is a definite problem under Mule due to the amount of stack data it might allocate. Need to be able to convert and write out to a file. */ @@ -2149,9 +2155,9 @@ png_color static_color_cube[216]; /* Wow, allocate all the memory. Truly, exciting. */ - unwind.pixels = (unsigned long *) xmalloc (256 * sizeof (unsigned long)); - png_pixels = (png_byte *) xmalloc (linesize * height * sizeof (png_byte*)); - row_pointers = (png_byte **) xmalloc (height * sizeof (png_byte *)); + unwind.pixels = xnew_array (unsigned long, 256); + png_pixels = xnew_array (png_byte, linesize * height); + row_pointers = xnew_array (png_byte *, height); for (y = 0; y < 256; y++) unwind.pixels[y] = 0; @@ -2195,7 +2201,7 @@ info_ptr->num_palette, info_ptr->hist, 1); } } - + png_read_image (png_ptr, row_pointers); png_read_end (png_ptr, info_ptr); @@ -2254,17 +2260,14 @@ #endif /* Now create the image */ - + depth = DefaultDepthOfScreen (scr); - + /* first get bitmap_pad (from XPM) */ - if (depth > 16) - bitmap_pad = 32; - else if (depth > 8) - bitmap_pad = 16; - else - bitmap_pad = 8; - + bitmap_pad = ((depth > 16) ? 32 : + (depth > 8) ? 16 : + 8); + unwind.ximage = XCreateImage (dpy, DefaultVisualOfScreen (scr), depth, ZPixmap, 0, 0, width, height, bitmap_pad, 0); @@ -2284,7 +2287,7 @@ XPutPixel (unwind.ximage, j, i, unwind.pixels[png_pixels[i * width + j]]); } - + xfree (row_pointers); xfree (png_pixels); } @@ -2346,7 +2349,7 @@ check_valid_xpm_color_symbols (Lisp_Object data) { Lisp_Object rest; - + for (rest = data; !NILP (rest); rest = XCDR (rest)) { if (!CONSP (rest) || @@ -2485,7 +2488,7 @@ Lisp_Object color_symbols; struct gcpro gcpro1, gcpro2; Lisp_Object alist = Qnil; - + GCPRO2 (file, alist); /* Now, convert any file data into inline data. At the end of this, @@ -2603,7 +2606,7 @@ if (i == 0) return 0; - symbols = (XpmColorSymbol *) xmalloc (i * sizeof (XpmColorSymbol)); + symbols = xnew_array (XpmColorSymbol, i); xpmattrs->valuemask |= XpmColorSymbols; xpmattrs->colorsymbols = symbols; xpmattrs->numsymbols = i; @@ -2701,7 +2704,7 @@ xpmattrs.closeness = 65535; xpmattrs.valuemask |= XpmCloseness; } - + color_symbols = extract_xpm_color_names (&xpmattrs, device, domain, color_symbol_alist); @@ -2771,15 +2774,15 @@ { int npixels = xpmattrs.npixels; - Pixel *pixels = 0; + Pixel *pixels; if (npixels != 0) { - pixels = xmalloc (npixels * sizeof (Pixel)); + pixels = xnew_array (Pixel, npixels); memcpy (pixels, xpmattrs.pixels, npixels * sizeof (Pixel)); } else - pixels = 0; + pixels = NULL; IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap; IMAGE_INSTANCE_X_MASK (ii) = mask; @@ -2849,7 +2852,7 @@ and which is background, or rather, it's implicit: in an XBM file, a 1 bit is foreground, and a 0 bit is background. - + XCreatePixmapCursor() assumes this property of the pixmap it is called with as well; the `foreground' color argument is used for the 1 bits. @@ -2861,25 +2864,25 @@ background. We do it by comparing RGB and assuming that the darker color is the foreground. This works with the result of xbmtopbm|ppmtoxpm, at least. - + It might be nice if there was some way to tag the colors in the XPM file with whether they are the foreground - perhaps with logical color names somehow? - + Once we have decided which color is the foreground, we need to ensure that that color corresponds to a `1' bit in the Pixmap. The XPM library wrote into the (1-bit) pixmap with XPutPixel, which will ignore all but the least significant bit. - + This means that a 1 bit in the image corresponds to `fg' only if `fg.pixel' is odd. - + (This also means that the image will be all the same color if both `fg' and `bg' are odd or even, but we can safely assume that that won't happen if the XPM file is sensible I think.) - + The desired result is that the image use `1' to represent the foreground color, and `0' to represent the background color. So, we may need to invert the @@ -2924,7 +2927,7 @@ bg = swap; } } - + /* If the fg pixel corresponds to a `0' in the bitmap, invert it. (This occurs (only?) on servers with Black=0, White=1.) */ @@ -2958,7 +2961,7 @@ default: abort (); } - + xpm_free (&xpmattrs); /* after we've read pixels and hotspot */ } @@ -2984,7 +2987,7 @@ Lisp_Object file = Qnil, mask_file = Qnil; struct gcpro gcpro1, gcpro2, gcpro3; Lisp_Object alist = Qnil; - + GCPRO3 (file, mask_file, alist); /* Now, convert any file data into inline data for both the regular @@ -3043,7 +3046,13 @@ /* We have to define SYSV32 so that compface.h includes string.h instead of strings.h. */ #define SYSV32 +#ifdef __cplusplus +extern "C" { +#endif #include <compface.h> +#ifdef __cplusplus +} +#endif /* JMP_BUF cannot be used here because if it doesn't get defined to jmp_buf we end up with a conflicting type error with the definition in compface.h */ @@ -3151,7 +3160,7 @@ if the given file is not a valid XPM file. Instead, they just seg fault. It is definitely caused by passing a bitmap. To try and avoid this we check for bitmaps first. */ - + data = bitmap_to_lisp_data (filename, &xhot, &yhot, 1); if (!EQ (data, Qt)) @@ -3541,7 +3550,7 @@ /* This is stolen from frame.c. Subwindows are strange in that they are specific to a particular frame so we want to print in their description what that frame is. */ - + write_c_string (" on #<", printcharfun); if (!FRAME_LIVE_P (frm)) write_c_string ("dead", printcharfun); @@ -3641,8 +3650,8 @@ } { - struct Lisp_Subwindow *sw = alloc_lcrecord (sizeof (struct Lisp_Subwindow), - lrecord_subwindow); + struct Lisp_Subwindow *sw = + alloc_lcrecord_type (struct Lisp_Subwindow, lrecord_subwindow); Lisp_Object val; sw->frame = frame; sw->xscreen = xs; @@ -3898,7 +3907,7 @@ IIFORMAT_VALID_KEYWORD (png, Q_data, check_valid_string); IIFORMAT_VALID_KEYWORD (png, Q_file, check_valid_string); #endif - + #ifdef HAVE_TIFF INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (tiff, "tiff"); @@ -3938,7 +3947,7 @@ IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_y, check_valid_int); IIFORMAT_VALID_KEYWORD (xface, Q_foreground, check_valid_string); IIFORMAT_VALID_KEYWORD (xface, Q_background, check_valid_string); -#endif +#endif INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (autodetect, "autodetect"); @@ -3965,7 +3974,7 @@ #ifdef HAVE_PNG Fprovide (Qpng); #endif - + #ifdef HAVE_TIFF Fprovide (Qtiff); #endif @@ -3985,15 +3994,15 @@ \"foreground\" and \"background\" to be the colors of the `default' face. */ ); Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */ -#endif +#endif #ifdef HAVE_XFACE Fprovide (Qxface); -#endif +#endif DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path /* A list of the directories in which X bitmap files may be found. -If nil, this is initialized from the \"*bitmapFilePath\" resource. +If nil, this is initialized from the "*bitmapFilePath" resource. This is used by the `make-image-instance' function (however, note that if the environment variable XBMLANGPATH is set, it is consulted first). */ );
--- a/src/glyphs.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/glyphs.c Mon Aug 13 09:55:28 2007 +0200 @@ -76,13 +76,14 @@ MAC_DEFINE (struct image_instantiator_methods *, MTiiformat_meth_or_given) +typedef struct image_instantiator_format_entry image_instantiator_format_entry; struct image_instantiator_format_entry { Lisp_Object symbol; struct image_instantiator_methods *meths; }; -typedef struct image_instantiator_format_entry_dynarr_type +typedef struct { Dynarr_declare (struct image_instantiator_format_entry); } image_instantiator_format_entry_dynarr; @@ -267,7 +268,7 @@ return Fcopy_tree (*get_image_conversion_list (console_type), Qt); } -/* Process an string instantiator according to the image-conversion-list for +/* Process a string instantiator according to the image-conversion-list for CONSOLE_TYPE. Returns a vector. */ static Lisp_Object @@ -437,7 +438,7 @@ alist_to_tagged_vector (Lisp_Object tag, Lisp_Object alist) { int len = 1 + 2 * XINT (Flength (alist)); - Lisp_Object *elt = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); + Lisp_Object *elt = alloca_array (Lisp_Object, len); int i; Lisp_Object rest; @@ -615,7 +616,7 @@ write_c_string (" @", printcharfun); if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii))) { - sprintf (buf, "%ld", + sprintf (buf, "%ld", (long) XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii))); write_c_string (buf, printcharfun); } @@ -624,7 +625,7 @@ write_c_string (",", printcharfun); if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii))) { - sprintf (buf, "%ld", + sprintf (buf, "%ld", (long) XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii))); write_c_string (buf, printcharfun); } @@ -783,8 +784,7 @@ allocate_image_instance (Lisp_Object device) { struct Lisp_Image_Instance *lp = - alloc_lcrecord (sizeof (struct Lisp_Image_Instance), - lrecord_image_instance); + alloc_lcrecord_type (struct Lisp_Image_Instance, lrecord_image_instance); Lisp_Object val = Qnil; zero_lcrecord (lp); @@ -801,22 +801,17 @@ if (ERRB_EQ (errb, ERROR_ME)) CHECK_SYMBOL (type); - if (EQ (type, Qnothing)) - return IMAGE_NOTHING; - if (EQ (type, Qtext)) - return IMAGE_TEXT; - if (EQ (type, Qmono_pixmap)) - return IMAGE_MONO_PIXMAP; - if (EQ (type, Qcolor_pixmap)) - return IMAGE_COLOR_PIXMAP; - if (EQ (type, Qpointer)) - return IMAGE_POINTER; - if (EQ (type, Qsubwindow)) - return IMAGE_SUBWINDOW; + if (EQ (type, Qnothing)) return IMAGE_NOTHING; + if (EQ (type, Qtext)) return IMAGE_TEXT; + if (EQ (type, Qmono_pixmap)) return IMAGE_MONO_PIXMAP; + if (EQ (type, Qcolor_pixmap)) return IMAGE_COLOR_PIXMAP; + if (EQ (type, Qpointer)) return IMAGE_POINTER; + if (EQ (type, Qsubwindow)) return IMAGE_SUBWINDOW; maybe_signal_simple_error ("Invalid image-instance type", type, Qimage, errb); - return IMAGE_UNKNOWN; + + return IMAGE_UNKNOWN; /* not reached */ } static Lisp_Object @@ -824,18 +819,12 @@ { switch (type) { - case IMAGE_NOTHING: - return Qnothing; - case IMAGE_TEXT: - return Qtext; - case IMAGE_MONO_PIXMAP: - return Qmono_pixmap; - case IMAGE_COLOR_PIXMAP: - return Qcolor_pixmap; - case IMAGE_POINTER: - return Qpointer; - case IMAGE_SUBWINDOW: - return Qsubwindow; + case IMAGE_NOTHING: return Qnothing; + case IMAGE_TEXT: return Qtext; + case IMAGE_MONO_PIXMAP: return Qmono_pixmap; + case IMAGE_COLOR_PIXMAP: return Qcolor_pixmap; + case IMAGE_POINTER: return Qpointer; + case IMAGE_SUBWINDOW: return Qsubwindow; default: abort (); } @@ -916,9 +905,7 @@ static int valid_image_instance_type_p (Lisp_Object type) { - if (!NILP (memq_no_quit (type, Vimage_instance_type_list))) - return 1; - return 0; + return !NILP (memq_no_quit (type, Vimage_instance_type_list)); } DEFUN ("valid-image-instance-type-p", Fvalid_image_instance_type_p, 1, 1, 0, /* @@ -928,10 +915,7 @@ */ (image_instance_type)) { - if (valid_image_instance_type_p (image_instance_type)) - return Qt; - else - return Qnil; + return valid_image_instance_type_p (image_instance_type) ? Qt : Qnil; } DEFUN ("image-instance-type-list", Fimage_instance_type_list, 0, 0, 0, /* @@ -945,12 +929,9 @@ Error_behavior decode_error_behavior_flag (Lisp_Object no_error) { - if (NILP (no_error)) - return ERROR_ME; - else if (EQ (no_error, Qt)) - return ERROR_ME_NOT; - else - return ERROR_ME_WARN; + if (NILP (no_error)) return ERROR_ME; + else if (EQ (no_error, Qt)) return ERROR_ME_NOT; + else return ERROR_ME_WARN; } Lisp_Object @@ -1030,7 +1011,7 @@ Not currently implemented. The DEST-TYPES list is unordered. If multiple destination types -are possible for a given instantiator, the \"most natural\" type +are possible for a given instantiator, the "most natural" type for the instantiator's format is chosen. (For XBM, the most natural types are `mono-pixmap', followed by `color-pixmap', followed by `pointer'. For the other normal image formats, the most natural @@ -1772,8 +1753,8 @@ `color-pixmap', `text', `pointer', etc. This refers to the behavior of the image and the sorts of places it can appear. (For example, a color-pixmap image has fixed colors specified for it, while a -mono-pixmap image comes in two unspecified shades \"foreground\" and -\"background\" that are determined from the face of the glyph or +mono-pixmap image comes in two unspecified shades "foreground" and +"background" that are determined from the face of the glyph or surrounding text; a text image appears as a string of text and has an unspecified foreground, background, and font; a pointer image behaves like a mono-pixmap image but can only be used as a mouse pointer @@ -1829,15 +1810,15 @@ 'tiff (A TIFF image; not currently implemented.) 'cursor-font - (One of the standard cursor-font names, such as \"watch\" or - \"right_ptr\" under X. Under X, this is, more specifically, any + (One of the standard cursor-font names, such as "watch" or + "right_ptr" under X. Under X, this is, more specifically, any of the standard cursor names from appendix B of the Xlib manual [also known as the file <X11/cursorfont.h>] minus the XC_ prefix. On other window systems, the valid names will be specific to the type of window system. Can only be instanced as `pointer'.) 'font (A glyph from a font; i.e. the name of a font, and glyph index into it - of the form \"FONT fontname index [[mask-font] mask-index]\". + of the form "FONT fontname index [[mask-font] mask-index]". Currently can only be instanced as `pointer', although this should probably be fixed.) 'subwindow @@ -1886,10 +1867,10 @@ (For `xbm' and `xface'. This specifies a file containing the mask data. If neither a mask file nor inline mask data is given for an XBM image, and the XBM image comes from a file, XEmacs will look for a mask file - with the same name as the image file but with \"Mask\" or \"msk\" - appended. For example, if you specify the XBM file \"left_ptr\" - [usually located in \"/usr/include/X11/bitmaps\"], the associated - mask file \"left_ptrmsk\" will automatically be picked up.) + with the same name as the image file but with "Mask" or "msk" + appended. For example, if you specify the XBM file "left_ptr" + [usually located in "/usr/include/X11/bitmaps"], the associated + mask file "left_ptrmsk" will automatically be picked up.) :hotspot-x :hotspot-y (For `xbm' and `xface'. These keywords specify a hotspot if the image @@ -1990,48 +1971,33 @@ depth++; - if (!internal_equal (g1->image, g2->image, depth) || - !internal_equal (g1->contrib_p, g2->contrib_p, depth) || - !internal_equal (g1->baseline, g2->baseline, depth) || - !internal_equal (g1->face, g2->face, depth) || - plists_differ (g1->plist, g2->plist, 0, 0, depth + 1)) - return 0; - - return 1; + return (internal_equal (g1->image, g2->image, depth) && + internal_equal (g1->contrib_p, g2->contrib_p, depth) && + internal_equal (g1->baseline, g2->baseline, depth) && + internal_equal (g1->face, g2->face, depth) && + !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1)); } static unsigned long glyph_hash (Lisp_Object obj, int depth) { - struct Lisp_Glyph *g = XGLYPH (obj); - depth++; /* No need to hash all of the elements; that would take too long. Just hash the most common ones. */ - return HASH2 (internal_hash (g->image, depth), - internal_hash (g->face, depth)); + return HASH2 (internal_hash (XGLYPH (obj)->image, depth), + internal_hash (XGLYPH (obj)->face, depth)); } static Lisp_Object glyph_getprop (Lisp_Object obj, Lisp_Object prop) { struct Lisp_Glyph *g = XGLYPH (obj); - -#define FROB(propprop) \ -do { \ - if (EQ (prop, Q##propprop)) \ - { \ - return g->propprop; \ - } \ -} while (0) - - FROB (image); - FROB (contrib_p); - FROB (baseline); - FROB (face); - -#undef FROB + + if (EQ (prop, Qimage)) return g->image; + if (EQ (prop, Qcontrib_p)) return g->contrib_p; + if (EQ (prop, Qbaseline)) return g->baseline; + if (EQ (prop, Qface)) return g->face; return external_plist_get (&g->plist, prop, 0, ERROR_ME); } @@ -2039,54 +2005,36 @@ static int glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value) { - struct Lisp_Glyph *g = XGLYPH (obj); - -#define FROB(propprop) \ -do { \ - if (EQ (prop, Q##propprop)) \ - return 0; \ -} while (0) - - FROB (image); - FROB (contrib_p); - FROB (baseline); - -#undef FROB + if ((EQ (prop, Qimage)) || + (EQ (prop, Qcontrib_p)) || + (EQ (prop, Qbaseline))) + return 0; if (EQ (prop, Qface)) { - value = Fget_face (value); - g->face = value; + XGLYPH (obj)->face = Fget_face (value); return 1; } - external_plist_put (&g->plist, prop, value, 0, ERROR_ME); + external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME); return 1; } static int glyph_remprop (Lisp_Object obj, Lisp_Object prop) { - struct Lisp_Glyph *g = XGLYPH (obj); - -#define FROB(propprop) \ -do { \ - if (EQ (prop, Q##propprop)) \ - return -1; \ -} while (0) - - FROB (image); - FROB (contrib_p); - FROB (baseline); + if ((EQ (prop, Qimage)) || + (EQ (prop, Qcontrib_p)) || + (EQ (prop, Qbaseline))) + return -1; if (EQ (prop, Qface)) { - g->face = Qnil; + XGLYPH (obj)->face = Qnil; return 1; } -#undef FROB - return external_remprop (&g->plist, prop, 0, ERROR_ME); + return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME); } static Lisp_Object @@ -2095,18 +2043,12 @@ struct Lisp_Glyph *g = XGLYPH (obj); Lisp_Object result = Qnil; -#define FROB(propprop) \ -do { \ - /* backwards order; we reverse it below */ \ - result = Fcons (g->propprop, Fcons (Q##propprop, result)); \ -} while (0) - - FROB (image); - FROB (contrib_p); - FROB (baseline); - FROB (face); - -#undef FROB + /* backwards order; we reverse it below */ + result = Fcons (g->image, Fcons (Qimage, result)); + result = Fcons (g->contrib_p, Fcons (Qcontrib_p, result)); + result = Fcons (g->baseline, Fcons (Qbaseline, result)); + result = Fcons (g->face, Fcons (Qface, result)); + return nconc2 (Fnreverse (result), g->plist); } @@ -2117,7 +2059,7 @@ { Lisp_Object obj = Qnil; struct Lisp_Glyph *g = - alloc_lcrecord (sizeof (struct Lisp_Glyph), lrecord_glyph); + alloc_lcrecord_type (struct Lisp_Glyph, lrecord_glyph); g->type = type; g->image = Fmake_specifier (Qimage); @@ -2165,23 +2107,19 @@ if (ERRB_EQ (errb, ERROR_ME)) CHECK_SYMBOL (type); - if (EQ (type, Qbuffer)) - return GLYPH_BUFFER; - if (EQ (type, Qpointer)) - return GLYPH_POINTER; - if (EQ (type, Qicon)) - return GLYPH_ICON; + if (EQ (type, Qbuffer)) return GLYPH_BUFFER; + if (EQ (type, Qpointer)) return GLYPH_POINTER; + if (EQ (type, Qicon)) return GLYPH_ICON; maybe_signal_simple_error ("Invalid glyph type", type, Qimage, errb); + return GLYPH_UNKNOWN; } static int valid_glyph_type_p (Lisp_Object type) { - if (!NILP (memq_no_quit (type, Vglyph_type_list))) - return 1; - return 0; + return !NILP (memq_no_quit (type, Vglyph_type_list)); } DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /* @@ -2190,10 +2128,7 @@ */ (glyph_type)) { - if (valid_glyph_type_p (glyph_type)) - return Qt; - else - return Qnil; + return valid_glyph_type_p (glyph_type) ? Qt : Qnil; } DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /* @@ -2254,17 +2189,13 @@ CHECK_GLYPH (glyph); switch (XGLYPH_TYPE (glyph)) { - case GLYPH_BUFFER: - return Qbuffer; - case GLYPH_POINTER: - return Qpointer; - case GLYPH_ICON: - return Qicon; + case GLYPH_BUFFER: return Qbuffer; + case GLYPH_POINTER: return Qpointer; + case GLYPH_ICON: return Qicon; default: abort (); + return Qnil; /* not reached */ } - - return Qnil; /* not reached */ } /***************************************************************************** @@ -2402,15 +2333,15 @@ face_cachel_charset_font_metric_info (cachel, charsets, &fm); - if (function == RETURN_ASCENT) - return fm.ascent; - else if (function == RETURN_DESCENT) - return fm.descent; - else if (function == RETURN_HEIGHT) - return fm.ascent + fm.descent; - else - abort (); - return 0; + switch (function) + { + case RETURN_ASCENT: return fm.ascent; + case RETURN_DESCENT: return fm.descent; + case RETURN_HEIGHT: return fm.ascent + fm.descent; + default: + abort (); + return 0; /* not reached */ + } } case IMAGE_MONO_PIXMAP: @@ -2535,10 +2466,7 @@ glyph_face (Lisp_Object glyph, Lisp_Object domain) { /* #### Domain parameter not currently used but it will be */ - if (!GLYPHP (glyph)) - return Qnil; - else - return GLYPH_FACE (XGLYPH (glyph)); + return GLYPHP (glyph) ? GLYPH_FACE (XGLYPH (glyph)) : Qnil; } int @@ -2598,23 +2526,13 @@ Lisp_Object window = Qnil; XSETWINDOW (window, w); - cachel->glyph = glyph; - -#define FROB(field) \ - do { \ - unsigned short new_val = glyph_##field (glyph, Qnil, DEFAULT_INDEX, \ - window); \ - if (cachel->field != new_val) \ - cachel->field = new_val; \ - } while (0) /* #### This could be sped up if we redid things to grab the glyph instantiation and passed it to the size functions. */ - FROB (width); - FROB (ascent); - FROB (descent); -#undef FROB - + cachel->glyph = glyph; + cachel->width = glyph_width (glyph, Qnil, DEFAULT_INDEX, window); + cachel->ascent = glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window); + cachel->descent = glyph_descent (glyph, Qnil, DEFAULT_INDEX, window); } cachel->updated = 1; @@ -2849,7 +2767,7 @@ /* image instantiators */ the_image_instantiator_format_entry_dynarr = - Dynarr_new (struct image_instantiator_format_entry); + Dynarr_new (image_instantiator_format_entry); Vimage_instantiator_format_list = Qnil; staticpro (&Vimage_instantiator_format_list); @@ -2920,7 +2838,7 @@ What to use to indicate the presence of invisible text. This is the glyph that is displayed when an ellipsis is called for \(see `selective-display-ellipses' and `buffer-invisibility-spec'). -Normally this is three dots (\"...\"). +Normally this is three dots ("..."). */); Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
--- a/src/glyphs.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/glyphs.h Mon Aug 13 09:55:28 2007 +0200 @@ -55,19 +55,27 @@ text */ -typedef struct ii_keyword_entry_dynarr_type -{ - Dynarr_declare (struct ii_keyword_entry); -} Ii_keyword_entry_dynarr; - /* These are methods specific to a particular format of image instantiator (e.g. xpm, string, etc.). */ +typedef struct ii_keyword_entry ii_keyword_entry; +struct ii_keyword_entry +{ + Lisp_Object keyword; + void (*validate) (Lisp_Object data); + int multiple_p; +}; + +typedef struct +{ + Dynarr_declare (ii_keyword_entry); +} ii_keyword_entry_dynarr; + struct image_instantiator_methods { Lisp_Object symbol; - Ii_keyword_entry_dynarr *keywords; + ii_keyword_entry_dynarr *keywords; /* Implementation specific methods: */ /* Validate method: Given an instantiator vector, signal an error if @@ -99,13 +107,6 @@ Lisp_Object domain); }; -struct ii_keyword_entry -{ - Lisp_Object keyword; - void (*validate) (Lisp_Object data); - int multiple_p; -}; - /***** Calling an image-instantiator method *****/ #define HAS_IIFORMAT_METH_P(mstruc, m) ((mstruc)->m##_method) @@ -135,23 +136,23 @@ /***** Defining new image-instantiator types *****/ -#define DECLARE_IMAGE_INSTANTIATOR_FORMAT(format) \ +#define DECLARE_IMAGE_INSTANTIATOR_FORMAT(format) \ extern struct image_instantiator_methods *format##_image_instantiator_methods -#define DEFINE_IMAGE_INSTANTIATOR_FORMAT(format) \ +#define DEFINE_IMAGE_INSTANTIATOR_FORMAT(format) \ struct image_instantiator_methods *format##_image_instantiator_methods #define INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(format, obj_name) \ - do { \ - format##_image_instantiator_methods = \ - malloc_type_and_zero (struct image_instantiator_methods); \ - defsymbol (&Q##format, obj_name); \ - format##_image_instantiator_methods->symbol = Q##format; \ - format##_image_instantiator_methods->keywords = \ - Dynarr_new (struct ii_keyword_entry); \ - add_entry_to_image_instantiator_format_list \ - (Q##format, format##_image_instantiator_methods); \ - } while (0) +do { \ + format##_image_instantiator_methods = \ + xnew_and_zero (struct image_instantiator_methods); \ + defsymbol (&Q##format, obj_name); \ + format##_image_instantiator_methods->symbol = Q##format; \ + format##_image_instantiator_methods->keywords = \ + Dynarr_new (ii_keyword_entry); \ + add_entry_to_image_instantiator_format_list \ + (Q##format, format##_image_instantiator_methods); \ +} while (0) /* Declare that image-instantiator format FORMAT has method M; used in initialization routines */ @@ -507,6 +508,7 @@ * Glyph Cachels * *****************************************************************************/ +typedef struct glyph_cachel glyph_cachel; struct glyph_cachel { Lisp_Object glyph;
--- a/src/gmalloc.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/gmalloc.c Mon Aug 13 09:55:28 2007 +0200 @@ -218,21 +218,21 @@ /* Doubly linked lists of free fragments. */ struct list - { - struct list *next; - struct list *prev; - }; +{ + struct list *next; + struct list *prev; +}; /* Free list headers for each fragment size. */ extern struct list _fraghead[]; /* List of blocks allocated with `memalign' (or `valloc'). */ struct alignlist - { - struct alignlist *next; - __ptr_t aligned; /* The address that memaligned returned. */ - __ptr_t exact; /* The address that malloc returned. */ - }; +{ + struct alignlist *next; + __ptr_t aligned; /* The address that memaligned returned. */ + __ptr_t exact; /* The address that malloc returned. */ +}; extern struct alignlist *_aligned_blocks; /* Instrumentation. */ @@ -268,13 +268,13 @@ /* Return values for `mprobe': these are the kinds of inconsistencies that `mcheck' enables detection of. */ enum mcheck_status - { - MCHECK_DISABLED = -1, /* Consistency checking is not turned on. */ - MCHECK_OK, /* Block is fine. */ - MCHECK_FREE, /* Block freed twice. */ - MCHECK_HEAD, /* Memory before the block was clobbered. */ - MCHECK_TAIL /* Memory after the block was clobbered. */ - }; +{ + MCHECK_DISABLED = -1, /* Consistency checking is not turned on. */ + MCHECK_OK, /* Block is fine. */ + MCHECK_FREE, /* Block freed twice. */ + MCHECK_HEAD, /* Memory before the block was clobbered. */ + MCHECK_TAIL /* Memory after the block was clobbered. */ +}; /* Activate a standard collection of debugging hooks. This must be called before `malloc' is ever called. ABORTFUNC is called with an error code @@ -293,13 +293,13 @@ /* Statistics available to the user. */ struct mstats - { - __malloc_size_t bytes_total; /* Total size of the heap. */ - __malloc_size_t chunks_used; /* Chunks allocated by the user. */ - __malloc_size_t bytes_used; /* Byte total of user-allocated chunks. */ - __malloc_size_t chunks_free; /* Chunks in the free list. */ - __malloc_size_t bytes_free; /* Byte total of chunks in the free list. */ - }; +{ + __malloc_size_t bytes_total; /* Total size of the heap. */ + __malloc_size_t chunks_used; /* Chunks allocated by the user. */ + __malloc_size_t bytes_used; /* Byte total of user-allocated chunks. */ + __malloc_size_t chunks_free; /* Chunks in the free list. */ + __malloc_size_t bytes_free; /* Byte total of chunks in the free list. */ +}; /* Pick up the current statistics. */ extern struct mstats mstats __P ((void)); @@ -367,8 +367,7 @@ static __malloc_size_t pagesize; __ptr_t -valloc (size) - __malloc_size_t size; +valloc (__malloc_size_t size) { if (pagesize == 0) pagesize = __getpagesize (); @@ -440,8 +439,7 @@ /* Aligned allocation. */ static __ptr_t align __P ((__malloc_size_t)); static __ptr_t -align (size) - __malloc_size_t size; +align (__malloc_size_t size) { __ptr_t result; unsigned long int adj; @@ -489,8 +487,7 @@ growing the heap info table as necessary. */ static __ptr_t morecore __P ((__malloc_size_t)); static __ptr_t -morecore (size) - __malloc_size_t size; +morecore (__malloc_size_t size) { __ptr_t result; malloc_info *newinfo, *oldinfo; @@ -533,8 +530,7 @@ /* Allocate memory from the heap. */ __ptr_t -malloc (size) - __malloc_size_t size; +malloc (__malloc_size_t size) { __ptr_t result; __malloc_size_t block, blocks, lastblocks, start; @@ -781,8 +777,7 @@ /* Return memory to the heap. Like `free' but don't call a __free_hook if there is one. */ void -_free_internal (ptr) - __ptr_t ptr; +_free_internal (__ptr_t ptr) { int type; __malloc_size_t block, blocks; @@ -934,8 +929,7 @@ /* Return memory to the heap. */ __free_ret_t -free (ptr) - __ptr_t ptr; +free (__ptr_t ptr) { struct alignlist *l; @@ -1040,9 +1034,7 @@ /* Like bcopy except never gets confused by overlap. */ static void -safe_bcopy (from, to, size) - char *from, *to; - int size; +safe_bcopy (char *from, char *to, int size) { if (size <= 0 || from == to) return; @@ -1090,7 +1082,7 @@ bcopy (from, to, endt - from); } } -} +} #endif /* Not emacs. */ #define memmove(to, from, size) safe_bcopy ((from), (to), (size)) @@ -1114,9 +1106,7 @@ new region. This module has incestuous knowledge of the internals of both free and malloc. */ __ptr_t -realloc (ptr, size) - __ptr_t ptr; - __malloc_size_t size; +realloc (__ptr_t ptr, __malloc_size_t size) { __ptr_t result; int type; @@ -1254,9 +1244,7 @@ /* Allocate an array of NMEMB elements each SIZE bytes long. The entire array is initialized to zeros. */ __ptr_t -calloc (nmemb, size) - __malloc_size_t nmemb; - __malloc_size_t size; +calloc (__malloc_size_t nmemb, __malloc_size_t size) { __ptr_t result = malloc (nmemb * size); @@ -1313,16 +1301,17 @@ and return the start of data space, or NULL on errors. If INCREMENT is negative, shrink data space. */ __ptr_t -__default_morecore (increment) +__default_morecore ( #ifdef __STDC__ - ptrdiff_t increment; + ptrdiff_t increment #else #ifdef OSF1 - long increment; + long increment #else - int increment; + int increment #endif #endif + ) { #ifdef OSF1 __ptr_t result = (__ptr_t) __sbrk ((ssize_t) increment); @@ -1356,9 +1345,7 @@ #endif __ptr_t -memalign (alignment, size) - __malloc_size_t alignment; - __malloc_size_t size; +memalign (__malloc_size_t alignment, __malloc_size_t size) { __ptr_t result; unsigned long int adj;
--- a/src/gui-x.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/gui-x.c Mon Aug 13 09:55:28 2007 +0200 @@ -126,7 +126,7 @@ Lisp_Object lpdata = Qnil; assert (NILP (assq_no_quit (lid, Vpopup_callbacks))); - pdata = alloc_lcrecord (sizeof (struct popup_data), lrecord_popup_data); + pdata = alloc_lcrecord_type (struct popup_data, lrecord_popup_data); pdata->id = id; pdata->last_menubar_buffer = Qnil; pdata->menubar_contents_up_to_date = 0; @@ -478,7 +478,7 @@ if (NILP (accel)) accel = menu_name_to_accelerator (wv->name); wv->accel = LISP_TO_VOID (accel); - + if (!NILP (suffix)) { CONST char *const_bogosity;
--- a/src/hash.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/hash.c Mon Aug 13 09:55:28 2007 +0200 @@ -89,17 +89,14 @@ } static int -string_eq (CONST void *st1v, CONST void *st2v) +string_eq (CONST void *st1, CONST void *st2) { - CONST char *st1 = (CONST char *)st1v; - CONST char *st2 = (CONST char *)st2v; - if (!st1) - return (st2)?0:1; + return st2 ? 0 : 1; else if (!st2) return 0; else - return !strcmp (st1, st2); + return !strcmp ( (CONST char *) st1, (CONST char *) st2); } @@ -181,10 +178,9 @@ c_hashtable make_hashtable (unsigned int hsize) { - c_hashtable res = (c_hashtable) xmalloc (sizeof (struct _C_hashtable)); - memset (res, 0, sizeof (struct _C_hashtable)); + c_hashtable res = xnew_and_zero (struct _C_hashtable); res->size = prime_size ((13 * hsize) / 10); - res->harray = (hentry *) xmalloc (sizeof (hentry) * res->size); + res->harray = xnew_array (hentry, res->size); #ifdef emacs res->elisp_table = Qnil; #endif @@ -197,10 +193,9 @@ unsigned long (*hash_function) (CONST void *), int (*test_function) (CONST void *, CONST void *)) { - c_hashtable res = (c_hashtable) xmalloc (sizeof (struct _C_hashtable)); - memset (res, 0, sizeof (struct _C_hashtable)); + c_hashtable res = xnew_and_zero (struct _C_hashtable); res->size = prime_size ((13 * hsize) / 10); - res->harray = (hentry *) xmalloc (sizeof (hentry) * res->size); + res->harray = xnew_array (hentry, res->size); res->hash_function = hash_function; res->test_function = test_function; #ifdef emacs @@ -253,7 +248,7 @@ dest->elisp_table); else #endif - dest->harray = (hentry *) xmalloc (sizeof (hentry) * dest->size); + dest->harray = xnew_array (hentry, dest->size); } dest->fullness = src->fullness; dest->zero_entry = src->zero_entry;
--- a/src/indent.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/indent.c Mon Aug 13 09:55:28 2007 +0200 @@ -114,7 +114,7 @@ /* Cancel any recorded value of the horizontal position. */ - + void invalidate_current_column (void) { @@ -243,7 +243,7 @@ CHECK_INT (minimum); XSETBUFFER (buffer, buf); - + fromcol = current_column (buf); mincol = fromcol + XINT (minimum); if (mincol < XINT (col)) mincol = XINT (col); @@ -252,7 +252,7 @@ return make_int (mincol); if (tab_width <= 0 || tab_width > 1000) tab_width = 8; - + if (!NILP (Fextent_at (make_int (BUF_PT (buf)), buffer, Qinvisible, Qnil, Qnil))) { @@ -261,7 +261,7 @@ opoint = BUF_PT (buf); if (last_visible >= BUF_BEGV (buf)) BUF_SET_PT (buf, last_visible); - else + else error ("Visible portion of buffer not modifiable"); }
--- a/src/inline.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/inline.c Mon Aug 13 09:55:28 2007 +0200 @@ -33,7 +33,7 @@ Some compilers that recognize `inline' may not do the same `extern inline' business, so on those we just do `static inline'. */ - + #define DONT_EXTERN_INLINE_FUNCTIONS #include <config.h>
--- a/src/input-method-motif.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/input-method-motif.c Mon Aug 13 09:55:28 2007 +0200 @@ -40,7 +40,7 @@ Initialize_Locale (void) { char *locale; - + XtSetLanguageProc (NULL, (XtLanguageProc) NULL, NULL); if ((locale = setlocale (LC_ALL, "")) == NULL) { @@ -72,7 +72,7 @@ return; } } - + if (XSetLocaleModifiers ("") == NULL) { stderr_out ("XSetLocaleModifiers(\"\") failed\n"); @@ -103,9 +103,9 @@ Pixel fg; Pixel bg; } xim_resources_t; - + xim_resources_t xim_resources; - + /* mrb: #### Fix so that background and foreground is set from default face, rather than foreground and background resources, or that the user can use set-frame-parameters to set xic attributes */
--- a/src/input-method-xlib.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/input-method-xlib.c Mon Aug 13 09:55:28 2007 +0200 @@ -78,7 +78,7 @@ Initialize_Locale (void) { char *locale; - + XtSetLanguageProc (NULL, (XtLanguageProc) NULL, NULL); if ((locale = setlocale (LC_ALL, "")) == NULL) { @@ -110,7 +110,7 @@ return; } } - + if (XSetLocaleModifiers ("") == NULL) { stderr_out ("XSetLocaleModifiers(\"\") failed\n"); @@ -127,9 +127,9 @@ XIM xim; XtGetApplicationNameAndClass (dpy, &name, &class); - + DEVICE_X_XIM (d) = xim = XOpenIM (dpy, XtDatabase (dpy), name, class); - + if (xim == NULL) { stderr_out ("Warning: XOpenIM() failed...no input server available\n"); @@ -168,7 +168,7 @@ } xic_vars_t; xic_vars_t xic_vars; - + /* mrb: #### Fix so that background and foreground is set from default face, rather than foreground and background resources, or that the user can use set-frame-parameters to set xic attributes */ @@ -187,17 +187,17 @@ }; assert (win != 0 && w != NULL && d != NULL); - + if (!xim) { /* No input method? */ FRAME_X_XIC (f) = NULL; return; } - + XtGetApplicationResources (w, &xic_vars, resources, XtNumber (resources), NULL, 0); - + if (!xic_vars.fontset) { stderr_out ("Can't get fontset resource for Input Method\n"); @@ -207,7 +207,7 @@ FRAME_X_XIC_STYLE (f) = style = best_style (&xic_vars.styles, DEVICE_X_XIM_STYLES (d)); - + /* Hopefully we don't have to conditionalize the following based on style; the IM should ignore values it doesn't use */ p_list = XVaCreateNestedList (0, @@ -234,7 +234,7 @@ NULL); XFree (p_list); XFree (s_list); - + if (!xic) { stderr_out ("Warning: XCreateIC failed\n"); @@ -248,7 +248,7 @@ } XIM_SetGeometry (f); - + XSetICFocus (xic); #ifdef DEBUG_XIM @@ -262,17 +262,17 @@ XIC xic = FRAME_X_XIC (f); XIMStyle style = FRAME_X_XIC_STYLE (f); XRectangle area; - + if (!xic || !f) return; - + if (style & XIMStatusArea) { /* Place Status Area in bottom right corner */ /* Negotiate geometry of status area */ /* See O'Reilly Xlib XIM chapter (but beware, it's buggy) */ XRectangle *needed; - + /* If input method has existing status area, use its current size */ /* The following at least works for Sun's htt */ area.x = area.y = area.width = area.height = 0; @@ -280,17 +280,17 @@ XIC_Value (Get, xic, XNStatusAttributes, XNAreaNeeded, &needed); if (needed->width == 0) /* Use XNArea instead of XNAreaNeeded */ XIC_Value (Get, xic, XNStatusAttributes, XNArea, &needed); - + area.width = needed->width; area.height = needed->height; area.x = FRAME_RIGHT_BORDER_START (f) - area.width; area.y = FRAME_BOTTOM_BORDER_START (f) - area.height; - + #ifdef DEBUG_XIM stderr_out ("Putting StatusArea in x=%d y=%d w=%d h=%d\n", area.x, area.y, area.width, area.height); #endif /* DEBUG_XIM */ - + XIC_Value (Set, xic, XNStatusAttributes, XNArea, &area); } @@ -306,7 +306,7 @@ area.height = FRAME_BOTTOM_BORDER_END (f) - area.y; XIC_Value(Set, xic, XNPreeditAttributes, XNArea, &area); } - + #ifdef DEBUG_XIM describe_XIC (xic); #endif @@ -325,7 +325,7 @@ (spot->x == (short) x && spot->y == (short) y)) return; - + spot->x = (short) x; spot->y = (short) y; @@ -377,7 +377,7 @@ int len; int i; XClientMessageEvent new_event; - + try_again: len = XwcLookupString (ic, x_key_event, composed_input_buf.data, composed_input_buf.size, &keysym, &status); @@ -391,7 +391,7 @@ default: abort (); } - + new_event.type = ClientMessage; new_event.display = x_key_event->display; new_event.window = x_key_event->window; @@ -472,7 +472,7 @@ STYLE_INFO (XIMPreeditNone|XIMStatusNone) }; #undef STYLE_INFO - + CONST char *s = (char *) fromVal->addr; CONST char *end = s + fromVal->size; XIMStyles * CONST p = (XIMStyles *) toVal->addr; @@ -485,7 +485,7 @@ stderr_out ("EmacsCvtStringToXIMStyles called with size=%d, string=\"%s\"\n", fromVal->size, (char *) fromVal->addr); #endif /* DEBUG_XIM */ - + if (*num_args != 0) { XtAppContext the_app_con = XtDisplayToApplicationContext (dpy); @@ -505,7 +505,7 @@ #endif /* DEBUG_XEMACS */ p->count_styles = 0; - p->supported_styles = xmalloc (max_styles * sizeof (XIMStyle)); + p->supported_styles = xnew_array (XIMStyle, max_styles); /* * The following routine assumes that the style name resource is @@ -517,7 +517,7 @@ if ((c = strtok(s, delimiter)) == NULL) c = end; - + while (c < end) { for(i=0 ; i<max_styles ; i++) @@ -533,13 +533,13 @@ break ; } } - + if (p->count_styles == 0) { /* No valid styles? */ char buf[1024]; XrmValue new_from; XtAppContext the_app_con = XtDisplayToApplicationContext (dpy); - + sprintf(buf, "Cannot convert string \"%s\" to type XIMStyles.\n" "Using default string \"%s\" instead.\n", fromVal->addr, DefaultXIMStyles); @@ -551,8 +551,7 @@ return EmacsXtCvtStringToXIMStyles (dpy, args, num_args, &new_from, toVal, converter_data); } - p->supported_styles = xrealloc (p->supported_styles, - p->count_styles * sizeof(XIMStyle)); + XREALLOC_ARRAY (p->supported_styles, XIMStyle, p->count_styles); *converter_data = (char *) True; return True; } @@ -570,7 +569,7 @@ stderr_out ("Converter data: %x\n", converter_data); stderr_out ("EmacsFreeXIMStyles called\n"); #endif /* DEBUG_XIM */ - + if (*num_args != 0) { XtAppWarningMsg(app, "wrongParameters","freeXIMStyles","XtToolkitError", @@ -578,7 +577,7 @@ (String *)NULL, (Cardinal *)NULL); return; } - + if (converter_data) { Boolean free_p = (Boolean) (int) converter_data; @@ -597,7 +596,7 @@ { #define CHECK_XIMStyle_BIT(bit) \ if ((s ^ t) & bit) { return (s & bit) ? s : t; } - + CHECK_XIMStyle_BIT (XIMPreeditCallbacks); CHECK_XIMStyle_BIT (XIMPreeditPosition); CHECK_XIMStyle_BIT (XIMPreeditArea); @@ -678,7 +677,7 @@ stderr_out ("NULL\n"); return; } - + count = XFontsOfFontSet (fontset, &font_struct_list, &font_name_list); stderr_out ( "%d font(s) available:\n", count); for (i=0 ; i < count ; i++) @@ -690,7 +689,7 @@ { #define DESCRIBE_STATUS(value) \ if (status == value) stderr_out ("Status: " #value "\n") - + DESCRIBE_STATUS (XBufferOverflow); DESCRIBE_STATUS (XLookupNone); DESCRIBE_STATUS (XLookupKeySym); @@ -700,7 +699,7 @@ } void -describe_Window (Window win) +describe_Window (Window win) { char xwincmd[64]; sprintf (xwincmd, "xwininfo -id 0x%x >&2; xwininfo -events -id 0x%x >&2", @@ -727,10 +726,10 @@ /* Check for valid input context and method */ if (!xic) stderr_out ("Input method is NULL\n"); - + if (!XIMOfIC(xic)) stderr_out ("XIMOfIC() returns NULL\n"); - + /* Print out Input Context Attributes */ p_list = XVaCreateNestedList (0, XNFontSet, &p_fontset, @@ -748,7 +747,7 @@ XNForeground, &s_fg, XNBackground, &s_bg, NULL); - + bad_arg = XGetICValues(xic, XNInputStyle, &style, XNFilterEvents, &filter_mask, @@ -761,10 +760,10 @@ NULL); XFree(p_list); XFree(s_list); - + if (bad_arg != NULL) stderr_out ("Couldn't get IC value: %s\n", bad_arg); - + stderr_out ("\nInput method context attributes:\n"); stderr_out ("Style: "); describe_XIMStyle (style); stderr_out ("Client window: %x\n", client_win); @@ -838,7 +837,7 @@ #define DESCRIBE_STYLE(bit) \ if (bit & style) \ stderr_out (#bit " "); - + DESCRIBE_STYLE (XIMPreeditArea); DESCRIBE_STYLE (XIMPreeditCallbacks); DESCRIBE_STYLE (XIMPreeditPosition); @@ -878,7 +877,7 @@ fromVal.size = strlen (s); toVal.addr = (XtPointer) &user_preferred_XIMStyles; toVal.size = sizeof (XIMStyles); - + if (XtConvertAndStore (FRAME_X_TEXT_WIDGET (f), XtRString, &fromVal, XtRXimStyles, &toVal) != False) { @@ -903,7 +902,7 @@ char * default_string; /* char * font_set_string = "-dt-interface user-medium-r-normal-s*-*-*-*-*-*-*-*-*";*/ char * font_set_string = "-dt-interface user-medium-r-normal-s*-*-*-*-*-*-*-*-*, -misc-fixed-medium-r-normal--14-130-75-75-c-70-jisx0201.1976-0,-misc-fixed-medium-r-normal--14-130-75-75-c-140-jisx0208.1983-0, -misc-fixed-medium-r-normal--14-130-75-75-c-70-jisx0201.1976-0" ; - + DEVICE_X_FONTSET (d) = fontset = XCreateFontSet (dpy, font_set_string, @@ -927,7 +926,7 @@ XFreeStringList (missing_charsets); stderr_out ("Default string: %s\n", default_string); } - + #ifdef DEBUG_XIM describe_XFontSet (fontset); #endif
--- a/src/insdel.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/insdel.c Mon Aug 13 09:55:28 2007 +0200 @@ -30,7 +30,7 @@ There are three possible ways to specify positions in a buffer. All of these are one-based: the beginning of the buffer is position or index 1, and 0 is not a valid position. - + As a "buffer position" (typedef Bufpos): This is an index specifying an offset in characters from the @@ -161,7 +161,7 @@ Similar to a Charcount but represents a count of bytes. The difference between two Bytind's is a Bytecount. - + Usage of the various representations: ===================================== @@ -194,7 +194,7 @@ Strings are always passed around internally using internal format. Conversions between external format are performed at the time that the data goes in or out of Emacs. - + Working with the various representations: ========================================= */ @@ -239,14 +239,14 @@ #define SET_BUF_END_GAP_SIZE(buf, value) \ do { (buf)->text->end_gap_size = (value); } while (0) -/* Gap location. */ +/* Gap location. */ #define BI_BUF_GPT(buf) ((buf)->text->gpt + 0) #define BUF_GPT_ADDR(buf) (BUF_BEG_ADDR (buf) + BI_BUF_GPT (buf) - 1) /* Set gap location. */ #define SET_BI_BUF_GPT(buf, value) do { (buf)->text->gpt = (value); } while (0) -/* Set end of buffer. */ +/* Set end of buffer. */ #define SET_BOTH_BUF_Z(buf, val, bival) \ do \ { \ @@ -268,7 +268,7 @@ Every time we change the total size (characters plus gap) of the buffer, we have to call SET_END_SENTINEL(). */ - + #ifdef MULE # define GAP_CAN_HOLD_SIZE_P(buf, len) (BUF_GAP_SIZE (buf) >= (len) + 1) @@ -345,7 +345,7 @@ /* Now do it. */ while (ptr < aligned_end) { - + if ((* (unsigned long *) ptr) & HIGH_BIT_MASK) goto bail; ptr += LONG_BYTES; @@ -398,7 +398,7 @@ Similar considerations apply to bytind_to_bufpos_func(), although less so because the function is not called so often. - + #### At some point this should use a more sophisticated method; see buffer.h. */ @@ -453,7 +453,7 @@ /* Check if the position is closer to PT or ZV than to the end of the known region. */ - + if (diffpt < 0) diffpt = -diffpt; if (diffzv < 0) @@ -465,7 +465,7 @@ which might be annoying if the known region is large and PT or ZV is not that much closer than the end of the known region. */ - + diffzv += heuristic_hack; diffpt += heuristic_hack; if (diffpt < diffmax && diffpt <= diffzv) @@ -506,7 +506,7 @@ /* But also implement a heuristic that favors the known region -- see above. */ - + diffbegv += heuristic_hack; diffpt += heuristic_hack; @@ -575,7 +575,7 @@ while (x > bufmax) { newmax = bytmax; - + INC_BYTIND (buf, newmax); newsize = newmax - bytmax; if (newsize != size) @@ -601,7 +601,7 @@ while (x < bufmin) { newmin = bytmin; - + DEC_BYTIND (buf, newmin); newsize = bytmin - newmin; if (newsize != size) @@ -730,7 +730,7 @@ /* Check if the position is closer to PT or ZV than to the end of the known region. */ - + if (diffpt < 0) diffpt = -diffpt; if (diffzv < 0) @@ -742,7 +742,7 @@ which might be annoying if the known region is large and BI_PT or BI_ZV is not that much closer than the end of the known region. */ - + diffzv += heuristic_hack; diffpt += heuristic_hack; if (diffpt < diffmax && diffpt <= diffzv) @@ -783,7 +783,7 @@ /* But also implement a heuristic that favors the known region -- see above. */ - + diffbegv += heuristic_hack; diffpt += heuristic_hack; @@ -852,7 +852,7 @@ while (x > bytmax) { newmax = bytmax; - + INC_BYTIND (buf, newmax); newsize = newmax - bytmax; if (newsize != size) @@ -878,7 +878,7 @@ while (x < bytmin) { newmin = bytmin; - + DEC_BYTIND (buf, newmin); newsize = bytmin - newmin; if (newsize != size) @@ -969,6 +969,7 @@ /* Adjust the cache of known positions. */ for (i = 0; i < 16; i++) { + if (buf->text->mule_bufpos_cache[i] > start) { buf->text->mule_bufpos_cache[i] += charlength; @@ -1200,7 +1201,7 @@ ind = XINT (pos); min_allowed = flags & GB_ALLOW_PAST_ACCESSIBLE ? BUF_BEG (b) : BUF_BEGV (b); max_allowed = flags & GB_ALLOW_PAST_ACCESSIBLE ? BUF_Z (b) : BUF_ZV (b); - + if (ind < min_allowed || ind > max_allowed) { if (flags & GB_COERCE_RANGE) @@ -1576,7 +1577,7 @@ if (mpos > from && mpos <= to) mpos += amount; return mpos; -} +} /* Do the following: @@ -1597,7 +1598,7 @@ `from' and `to' are the same, both pointing to the boundary between the gap and the deleted region, and there are no markers affected by (1)). - + The reason for the use of exclusive and inclusive is that markers at the gap always sit at the beginning, not at the end. */ @@ -1793,7 +1794,7 @@ SET_BUF_END_GAP_SIZE (buf, 0); SET_END_SENTINEL (buf); } - + QUIT; } @@ -1823,7 +1824,7 @@ increment = BUF_END_GAP_SIZE (buf); SET_BUF_END_GAP_SIZE (buf, 0); - + if (increment > 0) { /* Prevent quitting in move_gap. */ @@ -1873,7 +1874,7 @@ /* Don't allow a buffer size that won't fit in an int even if it will fit in a Lisp integer. That won't work because so many places use `int'. */ - + if (BUF_Z (buf) - BUF_BEG (buf) + BUF_GAP_SIZE (buf) + increment >= ((unsigned) 1 << (min (INTBITS, VALBITS) - 1))) error ("Buffer exceeds maximum size"); @@ -1884,12 +1885,12 @@ BUF_END_SENTINEL_SIZE); if (result == 0) memory_full (); - + SET_BUF_BEG_ADDR (buf, result); } else increment = BUF_END_GAP_SIZE (buf); - + /* Prevent quitting in move_gap. */ tem = Vinhibit_quit; Vinhibit_quit = Qt; @@ -1969,6 +1970,7 @@ signal_after_change (struct buffer *buf, Bufpos start, Bufpos orig_end, Bufpos new_end); + /* Call the after-change-functions according to the changes made so far and treat all further changes as single until the outermost multiple change exits. This is called when the outermost multiple @@ -2036,7 +2038,7 @@ begin_multiple_change() returns a number (actually a specpdl depth) that you must pass to end_multiple_change() when you are done. */ - + int begin_multiple_change (struct buffer *buf, Bufpos start, Bufpos end) { @@ -2390,7 +2392,7 @@ /* Make sure that point-max won't exceed the size of an emacs int. */ { Lisp_Object temp; - + XSETINT (temp, (int) (length + BUF_Z (buf))); if ((int) (length + BUF_Z (buf)) != XINT (temp)) error ("maximum buffer size exceeded"); @@ -2523,7 +2525,7 @@ int flags) { /* This function can GC */ - + CONST char *translated = GETTEXT (s); return buffer_insert_string_1 (buf, pos, (CONST Bufbyte *) translated, Qnil, 0, strlen (translated), flags); @@ -2549,7 +2551,7 @@ return buffer_insert_emacs_char_1 (buf, pos, (Emchar) (unsigned char) c, flags); } - + Charcount buffer_insert_from_buffer_1 (struct buffer *buf, Bufpos pos, struct buffer *buf2, Bufpos pos2, @@ -2627,20 +2629,17 @@ bi_from > BI_BUF_GPT (buf)) { /* avoid moving the gap just to delete from the bottom. */ - + record_delete (buf, from, numdel); BUF_MODIFF (buf)++; MARK_BUFFERS_CHANGED; - /* Relocate point as if it were a marker. */ - if (bi_from < BI_BUF_PT (buf)) - { - if (BI_BUF_PT (buf) < bi_to) - JUST_SET_POINT (buf, from, bi_from); - else - JUST_SET_POINT (buf, BUF_PT (buf) - numdel, - BI_BUF_PT (buf) - bc_numdel); - } + /* ### Point used to be modified here, but this causes problems with MULE, + as point is used to calculate bytinds, and if the offset in bc_numdel causes + point to move to a non first-byte location, causing some other function to + throw an assertion in ASSERT_VALID_BYTIND. I've moved the code to right after + the other movements and adjustments, but before the gap is moved. + -- jh 970813 */ /* Detach any extents that are completely within the range [FROM, TO], if the extents are detachable. @@ -2660,8 +2659,19 @@ /* Relocate any extent endpoints just like markers. */ adjust_extents_for_deletion (bufobj, bi_from, bi_to, BUF_GAP_SIZE (buf), bc_numdel, 0); + + /* Relocate point as if it were a marker. */ + if (bi_from < BI_BUF_PT (buf)) + { + if (BI_BUF_PT (buf) < bi_to) + JUST_SET_POINT (buf, from, bi_from); + else + JUST_SET_POINT (buf, BUF_PT (buf) - numdel, + BI_BUF_PT (buf) - bc_numdel); + } + SET_BUF_END_GAP_SIZE (buf, BUF_END_GAP_SIZE (buf) + bc_numdel); - + SET_BOTH_BUF_ZV (buf, BUF_ZV (buf) - numdel, BI_BUF_ZV (buf) - bc_numdel); SET_BOTH_BUF_Z (buf, BUF_Z (buf) - numdel, BI_BUF_Z (buf) - bc_numdel); SET_GAP_SENTINEL (buf); @@ -2680,7 +2690,7 @@ /* ### Point used to be modified here, but this causes problems with MULE, as point is used to calculate bytinds, and if the offset in bc_numdel causes - point to move to a non first-byte location, causing some other function to + point to move to a non first-byte location, causing some other function to throw an assertion in ASSERT_VALID_BYTIND. I've moved the code to right after the other movements and adjustments, but before the gap is moved. -- jh 970813 */ @@ -2959,6 +2969,7 @@ int i; for (i = 0; i < len; i++) + cols += XCHARSET_COLUMNS (CHAR_CHARSET (str[i])); return cols; @@ -2968,7 +2979,7 @@ void convert_bufbyte_string_into_emchar_dynarr (CONST Bufbyte *str, Bytecount len, - emchar_dynarr *dyn) + Emchar_dynarr *dyn) { CONST Bufbyte *strend = str + len; @@ -3001,7 +3012,7 @@ void convert_emchar_string_into_bufbyte_dynarr (Emchar *arr, int nels, - bufbyte_dynarr *dyn) + Bufbyte_dynarr *dyn) { Bufbyte str[MAX_EMCHAR_LEN]; int i; @@ -3027,14 +3038,14 @@ Bufbyte *str = (Bufbyte *) alloca (nels * MAX_EMCHAR_LEN + 1); Bufbyte *strorig = str; Bytecount len; - + int i; for (i = 0; i < nels; i++) str += set_charptr_emchar (str, arr[i]); *str = '\0'; len = str - strorig; - str = xmalloc (1 + len); + str = (Bufbyte *) xmalloc (1 + len); memcpy (str, strorig, 1 + len); if (len_out) *len_out = len; @@ -3076,12 +3087,12 @@ #ifdef MULE { int i; - + b->text->mule_bufmin = b->text->mule_bufmax = 1; b->text->mule_bytmin = b->text->mule_bytmax = 1; b->text->mule_shifter = 0; b->text->mule_three_p = 0; - + for (i = 0; i < 16; i++) { b->text->mule_bufpos_cache[i] = 1; @@ -3097,10 +3108,7 @@ SET_BOTH_BUF_BEGV (b, 1, 1); SET_BOTH_BUF_ZV (b, 1, 1); - b->text->changes = - (struct buffer_text_change_data *) - xmalloc (sizeof (*b->text->changes)); - memset (b->text->changes, 0, sizeof (*b->text->changes)); + b->text->changes = xnew_and_zero (struct buffer_text_change_data); } else { @@ -3111,9 +3119,7 @@ BI_BUF_ZV (b->base_buffer)); } - b->changes = - (struct each_buffer_change_data *) xmalloc (sizeof (*b->changes)); - memset (b->changes, 0, sizeof (*b->changes)); + b->changes = xnew_and_zero (struct each_buffer_change_data); BUF_FACECHANGE (b) = 1; #ifdef REGION_CACHE_NEEDS_WORK
--- a/src/intl.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/intl.c Mon Aug 13 09:55:28 2007 +0200 @@ -49,15 +49,15 @@ { XIMStyles *styles; unsigned short i; - + input_method = 0; input_method_style = 0; initial_input_context = 0; input_method_event_mask = 0; - + input_method = XOpenIM (display, NULL, (char *) res_name, (char *) res_class); - + if (!input_method) { stderr_out ("WARNING: XOpenIM() failed...no input server\n"); @@ -75,7 +75,7 @@ break; } } - + if (!input_method_style) { stderr_out ("WARNING: Could not find suitable input style.\n"); @@ -90,11 +90,11 @@ stderr_out ("WARNING: Could not create input context.\n"); return; } - + XGetICValues (initial_input_context, XNFilterEvents, &input_method_event_mask, NULL); - + /* Get a new atom for wide character client messages. */ wc_atom = XInternAtom (display, "Wide Character Event", False); } @@ -169,7 +169,7 @@ Lisp_Object Qdefer_gettext; DEFUN ("ignore-defer-gettext", Fignore_defer_gettext, 1, 1, 0, /* -If OBJ is of the form (defer-gettext \"string\"), return the string. +If OBJ is of the form (defer-gettext "string"), return the string. The purpose of the defer-gettext symbol is to identify strings which are translated when they are referenced instead of when they are defined. */
--- a/src/keymap.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/keymap.c Mon Aug 13 09:55:28 2007 +0200 @@ -97,7 +97,7 @@ Each combination of modifiers (e.g. control-hyper) gets its own submap off of the main map. The hash key for a modifier combination is an integer, computed by MAKE_MODIFIER_HASH_KEY(). - + If the key `C-a' was bound to some command, the hierarchy would look like keymap-1: associates the integer MOD_CONTROL with keymap-2 @@ -142,7 +142,7 @@ Since keymaps are opaque, the only way to extract information from them is with the functions lookup-key, key-binding, local-key-binding, and global-key-binding, which work just as before, and the new function - map-keymap, which is roughly analagous to maphash. + map-keymap, which is roughly analagous to maphash. Note that map-keymap perpetuates the illusion that the "bucky" submaps don't exist: if you map over a keymap with bucky submaps, it will also @@ -164,7 +164,7 @@ * An ordered list */ Lisp_Object prompt; /* Qnil or a string to print in the minibuffer * when reading from this keymap */ - + Lisp_Object table; /* The contents of this keymap */ Lisp_Object inverse_table; /* The inverse mapping of the above */ @@ -229,8 +229,8 @@ static void describe_command (Lisp_Object definition); static void describe_map (Lisp_Object keymap, Lisp_Object elt_prefix, void (*elt_describer) (Lisp_Object), - int partial, - Lisp_Object shadow, + int partial, + Lisp_Object shadow, int mice_only_p); Lisp_Object Qcontrol, Qctrl, Qmeta, Qsuper, Qhyper, Qalt, Qshift; /* Lisp_Object Qsymbol; defined in general.c */ @@ -269,7 +269,7 @@ ((markobj) (keymap->name)); return keymap->table; } - + static void print_keymap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { @@ -407,20 +407,15 @@ static unsigned int bucky_sym_to_bucky_bit (Lisp_Object sym) { - if (EQ (sym, Qcontrol)) - return MOD_CONTROL; - else if (EQ (sym, Qmeta)) - return MOD_META; - else if (EQ (sym, Qsuper)) - return MOD_SUPER; - else if (EQ (sym, Qhyper)) - return MOD_HYPER; - else if (EQ (sym, Qalt) || EQ (sym, Qsymbol)) /* #### - reverse compat */ - return MOD_ALT; - else if (EQ (sym, Qshift)) - return MOD_SHIFT; - else - return 0; + if (EQ (sym, Qcontrol)) return MOD_CONTROL; + if (EQ (sym, Qmeta)) return MOD_META; + if (EQ (sym, Qsuper)) return MOD_SUPER; + if (EQ (sym, Qhyper)) return MOD_HYPER; + if (EQ (sym, Qalt)) return MOD_ALT; + if (EQ (sym, Qsymbol)) return MOD_ALT; /* #### - reverse compat */ + if (EQ (sym, Qshift)) return MOD_SHIFT; + + return 0; } static Lisp_Object @@ -545,7 +540,7 @@ static void keymap_delete_inverse_internal (Lisp_Object inverse_table, - Lisp_Object keysym, + Lisp_Object keysym, Lisp_Object value) { Lisp_Object keys = Fgethash (value, inverse_table, Qunbound); @@ -592,7 +587,7 @@ if (EQ (prev_value, value)) return; if (!NILP (prev_value)) - keymap_delete_inverse_internal (keymap->inverse_table, + keymap_delete_inverse_internal (keymap->inverse_table, keysym, prev_value); if (NILP (value)) { @@ -605,7 +600,7 @@ if (NILP (prev_value)) keymap->fullness++; Fputhash (keysym, value, keymap->table); - keymap_store_inverse_internal (keymap->inverse_table, + keymap_store_inverse_internal (keymap->inverse_table, keysym, value); } keymap_tick++; @@ -683,7 +678,7 @@ }; static void -keymap_submaps_mapper_0 (CONST void *hash_key, void *hash_contents, +keymap_submaps_mapper_0 (CONST void *hash_key, void *hash_contents, void *keymap_submaps_closure) { /* This function can GC */ @@ -694,13 +689,14 @@ } static void -keymap_submaps_mapper (CONST void *hash_key, void *hash_contents, +keymap_submaps_mapper (CONST void *hash_key, void *hash_contents, void *keymap_submaps_closure) { /* This function can GC */ Lisp_Object key, contents; Lisp_Object *result_locative; - struct keymap_submaps_closure *cl = keymap_submaps_closure; + struct keymap_submaps_closure *cl = + (struct keymap_submaps_closure *) keymap_submaps_closure; CVOID_TO_LISP (key, hash_key); VOID_TO_LISP (contents, hash_contents); result_locative = cl->result_locative; @@ -709,7 +705,7 @@ *result_locative = Fcons (Fcons (key, contents), *result_locative); } -static int map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, +static int map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, Lisp_Object pred); static Lisp_Object @@ -733,7 +729,7 @@ elisp_maphash (keymap_submaps_mapper, k->table, &keymap_submaps_closure); /* keep it sorted so that the result of accessible-keymaps is ordered */ - k->sub_maps_cache = list_sort (result, + k->sub_maps_cache = list_sort (result, Qnil, map_keymap_sort_predicate); UNGCPRO; @@ -750,8 +746,7 @@ make_keymap (int size) { Lisp_Object result = Qnil; - struct keymap *keymap = alloc_lcrecord (sizeof (struct keymap), - lrecord_keymap); + struct keymap *keymap = alloc_lcrecord_type (struct keymap, lrecord_keymap); XSETKEYMAP (result, keymap); @@ -775,7 +770,7 @@ DEFUN ("make-keymap", Fmake_keymap, 0, 1, 0, /* Construct and return a new keymap object. -All entries in it are nil, meaning \"command undefined\". +All entries in it are nil, meaning "command undefined". Optional argument NAME specifies a name to assign to the keymap, as in `set-keymap-name'. This name is only a debugging convenience; @@ -791,9 +786,9 @@ DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, 0, 1, 0, /* Construct and return a new keymap object. -All entries in it are nil, meaning \"command undefined\". The only +All entries in it are nil, meaning "command undefined". The only difference between this function and make-keymap is that this function -returns a \"smaller\" keymap (one that is expected to contain fewer +returns a "smaller" keymap (one that is expected to contain fewer entries). As keymaps dynamically resize, the distinction is not great. Optional argument NAME specifies a name to assign to the keymap, @@ -820,8 +815,8 @@ return Fcopy_sequence (XKEYMAP (keymap)->parents); } - - + + static Lisp_Object traverse_keymaps_noop (Lisp_Object keymap, void *arg) { @@ -901,7 +896,7 @@ (keymap, new_prompt)) { keymap = get_keymap (keymap, 1, 1); - + if (!NILP (new_prompt)) CHECK_STRING (new_prompt); @@ -945,7 +940,7 @@ { /* This function can GC */ keymap = get_keymap (keymap, 1, 1); - + XKEYMAP (keymap)->default_binding = command; return command; } @@ -971,8 +966,7 @@ (object)) { /* This function can GC */ - Lisp_Object tem = get_keymap (object, 0, 1); - return KEYMAPP (tem) ? Qt : Qnil; + return KEYMAPP (get_keymap (object, 0, 0)) ? Qt : Qnil; } /* Check that OBJECT is a keymap (after dereferencing through any @@ -980,10 +974,17 @@ If AUTOLOAD is non-zero and OBJECT is a symbol whose function value is an autoload form, do the autoload and try again. + If AUTOLOAD is nonzero, callers must assume GC is possible. ERRORP controls how we respond if OBJECT isn't a keymap. - If ERRORP is non-zero, signal an error; otherwise, just return Qnil. - */ + If ERRORP is non-zero, signal an error; otherwise, just return Qnil. + + Note that most of the time, we don't want to pursue autoloads. + Functions like Faccessible_keymaps which scan entire keymap trees + shouldn't load every autoloaded keymap. I'm not sure about this, + but it seems to me that only read_key_sequence, Flookup_key, and + Fdefine_key should cause keymaps to be autoloaded. */ + Lisp_Object get_keymap (Lisp_Object object, int errorp, int autoload) { @@ -991,7 +992,7 @@ while (1) { Lisp_Object tem = indirect_function (object, 0); - + if (KEYMAPP (tem)) return tem; /* Should we do an autoload? */ @@ -1106,11 +1107,12 @@ }; static void -copy_keymap_inverse_mapper (CONST void *hash_key, void *hash_contents, +copy_keymap_inverse_mapper (CONST void *hash_key, void *hash_contents, void *copy_keymap_inverse_closure) { Lisp_Object key, inverse_table, inverse_contents; - struct copy_keymap_inverse_closure *closure = copy_keymap_inverse_closure; + struct copy_keymap_inverse_closure *closure = + (struct copy_keymap_inverse_closure *) copy_keymap_inverse_closure; VOID_TO_LISP (inverse_table, closure); VOID_TO_LISP (inverse_contents, hash_contents); @@ -1152,12 +1154,13 @@ }; static void -copy_keymap_mapper (CONST void *hash_key, void *hash_contents, +copy_keymap_mapper (CONST void *hash_key, void *hash_contents, void *copy_keymap_closure) { /* This function can GC */ Lisp_Object key, contents; - struct copy_keymap_closure *closure = copy_keymap_closure; + struct copy_keymap_closure *closure = + (struct copy_keymap_closure *) copy_keymap_closure; CVOID_TO_LISP (key, hash_key); VOID_TO_LISP (contents, hash_contents); @@ -1307,7 +1310,7 @@ same problem as above. (Gag!) Maybe we should just silently accept these as aliases for the "real" names? */ - (string_length (XSYMBOL (*keysym)->name) < 4 && + (string_length (XSYMBOL (*keysym)->name) <= 3 && (!strcmp (name, "LFD") || !strcmp (name, "TAB") || !strcmp (name, "RET") || @@ -1381,7 +1384,7 @@ event.event_type = empty_event; character_to_event (XCHAR_OR_CHAR_INT (spec), &event, XCONSOLE (Vselected_console), 0); - returned_value->keysym = event.event.key.keysym; + returned_value->keysym = event.event.key.keysym; returned_value->modifiers = event.event.key.modifiers; } else if (EVENTP (spec)) @@ -1390,7 +1393,7 @@ { case key_press_event: { - returned_value->keysym = XEVENT (spec)->event.key.keysym; + returned_value->keysym = XEVENT (spec)->event.key.keysym; returned_value->modifiers = XEVENT (spec)->event.key.modifiers; break; } @@ -1415,7 +1418,7 @@ case 7: returned_value->keysym = (down ? Qbutton7 : Qbutton7up); break; default: - returned_value->keysym =(down ? Qbutton0 : Qbutton0up); break; + returned_value->keysym = (down ? Qbutton0 : Qbutton0up); break; } returned_value->modifiers = XEVENT (spec)->event.button.modifiers; break; @@ -1601,8 +1604,8 @@ } /* ASCII grunge. - Given a keysym, return another keysym/modifier pair which could be - considered the same key in an ASCII world. Backspace returns ^H, for + Given a keysym, return another keysym/modifier pair which could be + considered the same key in an ASCII world. Backspace returns ^H, for example. */ static void @@ -1762,7 +1765,7 @@ the `A' keystroke is represented by all of these forms: A ?A 65 (A) (?A) (65) [A] [?A] [65] [(A)] [(?A)] [(65)] - + the `control-a' keystroke is represented by these forms: (control A) (control ?A) (control 65) [(control A)] [(control ?A)] [(control 65)] @@ -1782,7 +1785,7 @@ For backward compatibility, a key sequence may also be represented by a string. In this case, it represents the key sequence(s) that would produce that sequence of ASCII characters in a purely ASCII world. For -example, a string containing the ASCII backspace character, \"\\^H\", would +example, a string containing the ASCII backspace character, "\\^H", would represent two key sequences: `(control h)' and `backspace'. Binding a command to this will actually bind both of those key sequences. Likewise for the following pairs: @@ -1796,7 +1799,7 @@ After binding a command to two key sequences with a form like - (define-key global-map \"\\^X\\^I\" \'command-1) + (define-key global-map "\\^X\\^I" \'command-1) it is possible to redefine only one of those sequences like so: @@ -1912,7 +1915,7 @@ raw_key2.keysym = Qnil; raw_key2.modifiers = 0; } - + if (metized) { raw_key1.modifiers |= MOD_META; @@ -1933,7 +1936,7 @@ UNGCPRO; return def; } - + { Lisp_Object cmd; struct gcpro ngcpro1; @@ -1966,7 +1969,7 @@ /* Looking up keys in keymaps */ /************************************************************************/ -/* We need a very fast (i.e., non-consing) version of lookup-key in order +/* We need a very fast (i.e., non-consing) version of lookup-key in order to make where-is-internal really fly. */ struct raw_lookup_key_mapper_closure @@ -2001,18 +2004,19 @@ raw_lookup_key_mapper (Lisp_Object k, void *arg) { /* This function can GC */ - struct raw_lookup_key_mapper_closure *c = arg; + struct raw_lookup_key_mapper_closure *c = + (struct raw_lookup_key_mapper_closure *) arg; int accept_default = c->accept_default; int remaining = c->remaining; int keys_so_far = c->keys_so_far; CONST struct key_data *raw_keys = c->raw_keys; Lisp_Object cmd; - + if (! meta_prefix_char_p (&(raw_keys[0]))) { /* Normal case: every case except the meta-hack (see below). */ cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default); - + if (remaining == 0) /* Return whatever we found if we're out of keys */ ; @@ -2025,7 +2029,7 @@ */ cmd = make_int (keys_so_far + 1); else - cmd = raw_lookup_key (cmd, raw_keys + 1, remaining, + cmd = raw_lookup_key (cmd, raw_keys + 1, remaining, keys_so_far + 1, accept_default); } else @@ -2043,7 +2047,7 @@ cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default); if (NILP (cmd)) { - /* Do kludgy return of the meta-map */ + /* Do kludgy return of the meta-map */ cmd = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META), XKEYMAP (k)->table, Qnil); } @@ -2054,7 +2058,7 @@ cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default); cmd = get_keymap (cmd, 0, 1); if (!NILP (cmd)) - cmd = raw_lookup_key (cmd, raw_keys + 1, remaining, + cmd = raw_lookup_key (cmd, raw_keys + 1, remaining, keys_so_far + 1, accept_default); else if ((raw_keys[1].modifiers & MOD_META) == 0) { @@ -2099,7 +2103,7 @@ if (nkeys < (countof (kkk))) raw_keys = kkk; else - raw_keys = (struct key_data *) alloca (sizeof (struct key_data) * nkeys); + raw_keys = alloca_array (struct key_data, nkeys); for (i = 0; i < nkeys; i++) { @@ -2129,7 +2133,7 @@ if (nkeys < (countof (kkk))) raw_keys = kkk; else - raw_keys = (struct key_data *) alloca (sizeof (struct key_data) * nkeys); + raw_keys = alloca_array (struct key_data, nkeys); nkeys = 0; EVENT_CHAIN_LOOP (event, event_head) @@ -2159,7 +2163,7 @@ In keymap KEYMAP, look up key-sequence KEYS. Return the definition. Nil is returned if KEYS is unbound. See documentation of `define-key' for valid key definitions and key-sequence specifications. -A number is returned if KEYS is \"too long\"; that is, the leading +A number is returned if KEYS is "too long"; that is, the leading characters fail to be a valid sequence of prefix characters in KEYMAP. The number is how many characters at the front of KEYS it takes to reach a non-prefix command. @@ -2188,8 +2192,7 @@ { int length = string_char_length (XSTRING (keys)); int i; - struct key_data *raw_keys - = (struct key_data *) alloca (sizeof (struct key_data) * length); + struct key_data *raw_keys = alloca_array (struct key_data, length); if (length == 0) return Qnil; @@ -2212,7 +2215,7 @@ semi-heuristic command-lookup behaviour could be readily understood and customised. However, this needs to be pretty fast, or performance of keyboard macros goes to shit; putting this in lisp slows macros down - 2-3x. And they're already slower than v18 by 5-6x. + 2-3x. And they're already slower than v18 by 5-6x. */ struct relevant_maps @@ -2232,7 +2235,7 @@ static void relevant_map_push (Lisp_Object map, struct relevant_maps *closure) -{ +{ unsigned int nmaps = closure->nmaps; if (!KEYMAPP (map)) @@ -2278,7 +2281,7 @@ } else con = XCONSOLE (Vselected_console); - + if (KEYMAPP (con->overriding_terminal_local_map) || KEYMAPP (Voverriding_local_map)) { @@ -2288,7 +2291,7 @@ relevant_map_push (Voverriding_local_map, &closure); } else if (!EVENTP (terminal) - || (XEVENT (terminal)->event_type != button_press_event + || (XEVENT (terminal)->event_type != button_press_event && XEVENT (terminal)->event_type != button_release_event)) { Lisp_Object tem; @@ -2420,7 +2423,7 @@ if (!NILP (keymap)) relevant_map_push (get_keymap (keymap, 1, 1), closure); } - + /* Next check the extents at the text position, if any */ if (!NILP (pos)) { @@ -2501,7 +2504,7 @@ gubbish); if (nmaps > countof (maps)) { - gubbish = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); + gubbish = alloca_array (Lisp_Object, nmaps); nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish); } UNGCPRO; @@ -2624,13 +2627,10 @@ event_binding_in (Lisp_Object event0, Lisp_Object keymap, int accept_default) { /* This function can GC */ - Lisp_Object maps[1]; - if (!KEYMAPP (keymap)) return Qnil; - - maps[0] = keymap; - return process_event_binding_result (lookup_events (event0, 1, maps, + + return process_event_binding_result (lookup_events (event0, 1, &keymap, accept_default)); } @@ -2641,23 +2641,14 @@ munging_key_map_event_binding (Lisp_Object event0, enum munge_me_out_the_door munge) { - Lisp_Object the_map; - Lisp_Object maps[1]; - - if (munge == MUNGE_ME_FUNCTION_KEY) - { - struct console *c = event_console_or_selected (event0); - - the_map = CONSOLE_FUNCTION_KEY_MAP (c); - } - else - the_map = Vkey_translation_map; - - if (NILP (the_map)) + Lisp_Object keymap = (munge == MUNGE_ME_FUNCTION_KEY) ? + CONSOLE_FUNCTION_KEY_MAP (event_console_or_selected (event0)) : + Vkey_translation_map; + + if (NILP (keymap)) return Qnil; - maps[0] = the_map; - return process_event_binding_result (lookup_events (event0, 1, maps, 1)); + return process_event_binding_result (lookup_events (event0, 1, &keymap, 1)); } @@ -2717,7 +2708,7 @@ /************************************************************************/ /* Since keymaps are arranged in a hierarchy, one keymap per bucky bit or - prefix key, it's not entirely objvious what map-keymap should do, but + prefix key, it's not entirely obvious what map-keymap should do, but what it does is: map over all keys in this map; then recursively map over all submaps of this map that are "bucky" submaps. This means that, when mapping over a keymap, it appears that "x" and "C-x" are in the @@ -2741,13 +2732,14 @@ /* used by map_keymap() */ static void -map_keymap_unsorted_mapper (CONST void *hash_key, void *hash_contents, +map_keymap_unsorted_mapper (CONST void *hash_key, void *hash_contents, void *map_keymap_unsorted_closure) { /* This function can GC */ Lisp_Object keysym; Lisp_Object contents; - struct map_keymap_unsorted_closure *closure = map_keymap_unsorted_closure; + struct map_keymap_unsorted_closure *closure = + (struct map_keymap_unsorted_closure *) map_keymap_unsorted_closure; unsigned int modifiers = closure->modifiers; unsigned int mod_bit; CVOID_TO_LISP (keysym, hash_key); @@ -2757,7 +2749,7 @@ { int omod = modifiers; closure->modifiers = (modifiers | mod_bit); - contents = get_keymap (contents, 1, 1); + contents = get_keymap (contents, 1, 0); elisp_maphash (map_keymap_unsorted_mapper, XKEYMAP (contents)->table, map_keymap_unsorted_closure); @@ -2780,10 +2772,11 @@ /* used by map_keymap_sorted() */ static void -map_keymap_sorted_mapper (CONST void *hash_key, void *hash_contents, +map_keymap_sorted_mapper (CONST void *hash_key, void *hash_contents, void *map_keymap_sorted_closure) { - struct map_keymap_sorted_closure *cl = map_keymap_sorted_closure; + struct map_keymap_sorted_closure *cl = + (struct map_keymap_sorted_closure *) map_keymap_sorted_closure; Lisp_Object key, contents; Lisp_Object *list = cl->result_locative; CVOID_TO_LISP (key, hash_key); @@ -2796,7 +2789,7 @@ and keymap_submaps(). */ static int -map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, +map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, Lisp_Object pred) { /* obj1 and obj2 are conses with keysyms in their cars. Cdrs are ignored. @@ -2811,7 +2804,7 @@ return -1; bit1 = MODIFIER_HASH_KEY_BITS (obj1); bit2 = MODIFIER_HASH_KEY_BITS (obj2); - + /* If either is a symbol with a character-set-property, then sort it by that code instead of alphabetically. */ @@ -2854,7 +2847,7 @@ /* else they're both symbols. If they're both buckys, then order them. */ if (bit1 && bit2) return bit1 < bit2 ? 1 : -1; - + /* if only one is a bucky, then it comes later */ if (bit1 || bit2) return bit2 ? 1 : -1; @@ -2875,9 +2868,9 @@ /* used by map_keymap() */ static void map_keymap_sorted (Lisp_Object keymap_table, - unsigned int modifiers, + unsigned int modifiers, void (*function) (CONST struct key_data *key, - Lisp_Object binding, + Lisp_Object binding, void *map_keymap_sorted_closure), void *map_keymap_sorted_closure) { @@ -2922,7 +2915,7 @@ /* used by Fmap_keymap() */ static void map_keymap_mapper (CONST struct key_data *key, - Lisp_Object binding, + Lisp_Object binding, void *function) { /* This function can GC */ @@ -2964,7 +2957,7 @@ The function will not be called on elements of this keymap's parents (see the function `keymap-parents') or upon keymaps which are contained within this keymap (multi-character definitions). -It will be called on \"meta\" characters since they are not really +It will be called on "meta" characters since they are not really two-character sequences. If the optional third argument SORT-FIRST is non-nil, then the elements of @@ -3058,7 +3051,8 @@ accessible_keymaps_keymap_mapper (Lisp_Object thismap, void *arg) { /* This function can GC */ - struct accessible_keymaps_closure *closure = arg; + struct accessible_keymaps_closure *closure = + (struct accessible_keymaps_closure *) arg; Lisp_Object submaps = keymap_submaps (thismap); for (; !NILP (submaps); submaps = XCDR (submaps)) @@ -3073,24 +3067,24 @@ DEFUN ("accessible-keymaps", Faccessible_keymaps, 1, 2, 0, /* -Find all keymaps accessible via prefix characters from STARTMAP. +Find all keymaps accessible via prefix characters from KEYMAP. Returns a list of elements of the form (KEYS . MAP), where the sequence -KEYS starting from STARTMAP gets you to MAP. These elements are ordered -so that the KEYS increase in length. The first element is ([] . STARTMAP). +KEYS starting from KEYMAP gets you to MAP. These elements are ordered +so that the KEYS increase in length. The first element is ([] . KEYMAP). An optional argument PREFIX, if non-nil, should be a key sequence; then the value includes only maps for prefixes that start with PREFIX. */ - (startmap, prefix)) + (keymap, prefix)) { /* This function can GC */ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; Lisp_Object accessible_keymaps = Qnil; struct accessible_keymaps_closure c; c.tail = Qnil; - GCPRO4 (accessible_keymaps, c.tail, prefix, startmap); + GCPRO4 (accessible_keymaps, c.tail, prefix, keymap); retry: - startmap = get_keymap (startmap, 1, 1); + keymap = get_keymap (keymap, 1, 1); if (NILP (prefix)) prefix = make_vector (0, Qnil); else if (!VECTORP (prefix) || STRINGP (prefix)) @@ -3101,7 +3095,7 @@ else { int len = XINT (Flength (prefix)); - Lisp_Object def = Flookup_key (startmap, prefix, Qnil); + Lisp_Object def = Flookup_key (keymap, prefix, Qnil); Lisp_Object p; int iii; struct gcpro ngcpro1; @@ -3110,7 +3104,7 @@ if (!KEYMAPP (def)) goto RETURN; - startmap = def; + keymap = def; p = make_vector (len, Qnil); NGCPRO1 (p); for (iii = 0; iii < len; iii++) @@ -3122,8 +3116,8 @@ NUNGCPRO; prefix = p; } - - accessible_keymaps = list1 (Fcons (prefix, startmap)); + + accessible_keymaps = list1 (Fcons (prefix, keymap)); /* For each map in the list maps, look at any other maps it points to @@ -3151,8 +3145,8 @@ DEFUN ("key-description", Fkey_description, 1, 1, 0, /* Return a pretty description of key-sequence KEYS. -Control characters turn into \"C-foo\" sequences, meta into \"M-foo\" - spaces are put between sequence elements, etc. +Control characters turn into "C-foo" sequences, meta into "M-foo", +spaces are put between sequence elements, etc... */ (keys)) { @@ -3243,13 +3237,13 @@ { CHECK_SYMBOL (keysym); #if 0 /* This is bogus */ - if (EQ (keysym, QKlinefeed)) strcpy (bufp, "LFD"); - else if (EQ (keysym, QKtab)) strcpy (bufp, "TAB"); - else if (EQ (keysym, QKreturn)) strcpy (bufp, "RET"); - else if (EQ (keysym, QKescape)) strcpy (bufp, "ESC"); - else if (EQ (keysym, QKdelete)) strcpy (bufp, "DEL"); - else if (EQ (keysym, QKspace)) strcpy (bufp, "SPC"); - else if (EQ (keysym, QKbackspace)) strcpy (bufp, "BS"); + if (EQ (keysym, QKlinefeed)) strcpy (bufp, "LFD"); + else if (EQ (keysym, QKtab)) strcpy (bufp, "TAB"); + else if (EQ (keysym, QKreturn)) strcpy (bufp, "RET"); + else if (EQ (keysym, QKescape)) strcpy (bufp, "ESC"); + else if (EQ (keysym, QKdelete)) strcpy (bufp, "DEL"); + else if (EQ (keysym, QKspace)) strcpy (bufp, "SPC"); + else if (EQ (keysym, QKbackspace)) strcpy (bufp, "BS"); else #endif strcpy (bufp, (char *) string_data (XSYMBOL (keysym)->name)); @@ -3266,7 +3260,7 @@ DEFUN ("text-char-description", Ftext_char_description, 1, 1, 0, /* Return a pretty description of file-character CHR. -Unprintable characters turn into \"^char\" or \\NNN, depending on the value +Unprintable characters turn into "^char" or \\NNN, depending on the value of the `ctl-arrow' variable. This differs from `single-key-description' in that it returns a description of a character from a buffer rather than a key read from the user. @@ -3379,7 +3373,7 @@ gubbish); if (nmaps > countof (maps)) { - gubbish = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); + gubbish = alloca_array (Lisp_Object, nmaps); nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish); } } @@ -3391,7 +3385,7 @@ nmaps = XINT (Flength (keymaps)); if (nmaps > countof (maps)) { - gubbish = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); + gubbish = alloca_array (Lisp_Object, nmaps); } for (rest = keymaps, i = 0; !NILP (rest); rest = XCDR (keymaps), i++) @@ -3409,13 +3403,13 @@ nmaps++; } } - + return where_is_internal (definition, gubbish, nmaps, firstonly, 0); } /* This function is like (key-description (where-is-internal definition nil t)) - except that it writes its output into a (char *) buffer that you + except that it writes its output into a (char *) buffer that you provide; it doesn't cons (or allocate memory) at all, so it's very fast. This is used by menubar.c. */ @@ -3431,7 +3425,7 @@ nmaps = get_relevant_keymaps (Qnil, countof (maps), gubbish); if (nmaps > countof (maps)) { - gubbish = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); + gubbish = alloca_array (Lisp_Object, nmaps); nmaps = get_relevant_keymaps (Qnil, nmaps, gubbish); } @@ -3440,7 +3434,7 @@ } -static Lisp_Object +static Lisp_Object raw_keys_to_keys (struct key_data *keys, int count) { Lisp_Object result = make_vector (count, Qnil); @@ -3481,10 +3475,10 @@ will be MOD_META. That is, keys_so_far is the chain of keys that we have followed, and modifiers_so_far_so_far is the bits (partial keys) beyond that. - + (keys_so_far is a global buffer and the keys_count arg says how much of it we're currently interested in.) - + If target_buffer is provided, then we write a key-description into it, to avoid consing a string. This only works with firstonly on. */ @@ -3509,7 +3503,7 @@ where_is_recursive_mapper (Lisp_Object map, void *arg) { /* This function can GC */ - struct where_is_closure *c = arg; + struct where_is_closure *c = (struct where_is_closure *) arg; Lisp_Object definition = c->definition; CONST int firstonly = c->firstonly; CONST unsigned int keys_count = c->keys_count; @@ -3523,18 +3517,17 @@ if (!NILP (keys)) { - /* One or more keys in this map match the definition we're looking - for. Verify that these bindings aren't shadowed by other bindings + /* One or more keys in this map match the definition we're looking for. + Verify that these bindings aren't shadowed by other bindings in the shadow maps. Either nil or number as value from - raw_lookup_key() means undefined. - */ + raw_lookup_key() means undefined. */ struct key_data *so_far = c->keys_so_far; for (;;) /* loop over all keys that match */ { Lisp_Object k = ((CONSP (keys)) ? XCAR (keys) : keys); int i; - + so_far [keys_count].keysym = k; so_far [keys_count].modifiers = modifiers_so_far; @@ -3543,7 +3536,7 @@ { Lisp_Object shadowed = raw_lookup_key (c->shadow[i], so_far, - keys_count + 1, + keys_count + 1, 0, 1); if (NILP (shadowed) || CHARP (shadowed) || @@ -3576,7 +3569,7 @@ } /* Now search the sub-keymaps of this map. - If we're in "firstonly" mode and have already found one, this + If we're in "firstonly" mode and have already found one, this point is not reached. If we get one from lower down, either return it immediately (in firstonly mode) or tack it onto the end of the ones we've gotten so far. @@ -3591,7 +3584,7 @@ int lower_keys_count = keys_count; unsigned int bucky; - submap = get_keymap (submap, 0, 1); + submap = get_keymap (submap, 0, 0); if (EQ (submap, map)) /* Arrgh! Some loser has introduced a loop... */ @@ -3629,13 +3622,12 @@ int size = lower_keys_count + 50; if (! c->keys_so_far_malloced) { - struct key_data *new = xmalloc (size * sizeof (struct key_data)); + struct key_data *new = xnew_array (struct key_data, size); memcpy ((void *)new, (const void *)c->keys_so_far, c->keys_so_far_total_size * sizeof (struct key_data)); } else - c->keys_so_far = xrealloc (c->keys_so_far, - size * sizeof (struct key_data)); + XREALLOC_ARRAY (c->keys_so_far, struct key_data, size); c->keys_so_far_total_size = size; c->keys_so_far_malloced = 1; @@ -3647,8 +3639,8 @@ c->keys_count = lower_keys_count; c->modifiers_so_far = lower_modifiers; - lower = traverse_keymaps (submap, Qnil, where_is_recursive_mapper, - c); + lower = traverse_keymaps (submap, Qnil, where_is_recursive_mapper, c); + c->keys_count = keys_count; c->modifiers_so_far = modifiers_so_far; @@ -3718,7 +3710,7 @@ DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, 1, 5, 0, /* Insert a list of all defined keys and their definitions in MAP. -Optional second argument ALL says whether to include even \"uninteresting\" +Optional second argument ALL says whether to include even "uninteresting" definitions (ie symbols with a non-nil `suppress-keymap' property. Third argument SHADOW is a list of keymaps whose bindings shadow those of map; if a binding is present in any shadowing map, it is not printed. @@ -3741,7 +3733,7 @@ (such as `undefined'). If SHADOW is non-nil, it is a list of other maps; don't mention keys which would be shadowed by any of them - If PREFIX is non-nil, only list bindings which start with those keys + If PREFIX is non-nil, only list bindings which start with those keys. */ void @@ -3759,15 +3751,15 @@ { Lisp_Object sub_shadow = Qnil; Lisp_Object elt = Fcar (maps); - Lisp_Object tail = shadow; + Lisp_Object tail; int no_prefix = (VECTORP (Fcar (elt)) && XINT (Flength (Fcar (elt))) == 0); struct gcpro ngcpro1, ngcpro2, ngcpro3; NGCPRO3 (sub_shadow, elt, tail); - for (; CONSP (tail); tail = XCDR (tail)) + for (tail = shadow; CONSP (tail); tail = XCDR (tail)) { - Lisp_Object sh = XCAR (tail); + Lisp_Object shmap = XCAR (tail); /* If the sequence by which we reach this keymap is zero-length, then the shadow maps for this keymap are just SHADOW. */ @@ -3778,17 +3770,17 @@ what we should use. */ else { - sh = Flookup_key (sh, Fcar (elt), Qt); - if (CHARP (sh)) - sh = Qnil; + shmap = Flookup_key (shmap, Fcar (elt), Qt); + if (CHARP (shmap)) + shmap = Qnil; } - if (!NILP (sh)) + if (!NILP (shmap)) { - Lisp_Object shm = get_keymap (sh, 0, 1); + Lisp_Object shm = get_keymap (shmap, 0, 1); + /* If shmap is not nil and not a keymap, it completely + shadows this map, so don't describe this map at all. */ if (!KEYMAPP (shm)) - /* If sh is not nil and not a keymap, it completely shadows - this map, so don't describe this map at all. */ goto SKIP; sub_shadow = Fcons (shm, sub_shadow); } @@ -3848,7 +3840,7 @@ if (STRINGP (name) || (SYMBOLP (name) && !NILP (name))) { buffer_insert_c_string (XBUFFER (buffer), "Prefix command "); - if (SYMBOLP (name) + if (SYMBOLP (name) && EQ (find_symbol_value (name), definition)) buffer_insert1 (XBUFFER (buffer), Fsymbol_name (name)); else @@ -3888,23 +3880,23 @@ static Lisp_Object describe_map_mapper_shadow_search (Lisp_Object map, void *arg) { - struct describe_map_shadow_closure *c = arg; + struct describe_map_shadow_closure *c = + (struct describe_map_shadow_closure *) arg; if (EQ (map, c->self)) return Qzero; /* Not shadowed; terminate search */ - if (!NILP (keymap_lookup_directly (map, - c->raw_key->keysym, - c->raw_key->modifiers))) - return Qt; - else - return Qnil; + + return (!NILP (keymap_lookup_directly (map, + c->raw_key->keysym, + c->raw_key->modifiers))) + ? Qt : Qnil; } - + static Lisp_Object keymap_lookup_inherited_mapper (Lisp_Object km, void *arg) { - struct key_data *k = arg; + struct key_data *k = (struct key_data *) arg; return keymap_lookup_directly (km, k->keysym, k->modifiers); } @@ -3915,7 +3907,8 @@ void *describe_map_closure) { /* This function can GC */ - struct describe_map_closure *closure = describe_map_closure; + struct describe_map_closure *closure = + (struct describe_map_closure *) describe_map_closure; Lisp_Object keysym = key->keysym; unsigned int modifiers = key->modifiers; @@ -3924,14 +3917,18 @@ && !NILP (closure->partial) && !NILP (Fget (binding, closure->partial, Qnil))) return; - + /* If we're only supposed to display mouse bindings and this isn't one, then bug out. */ if (closure->mice_only_p && - (! (EQ (keysym, Qbutton0) || EQ (keysym, Qbutton1) - || EQ (keysym, Qbutton2) || EQ (keysym, Qbutton3) - || EQ (keysym, Qbutton4) || EQ (keysym, Qbutton5) - || EQ (keysym, Qbutton6) || EQ (keysym, Qbutton7)))) + (! (EQ (keysym, Qbutton0) || + EQ (keysym, Qbutton1) || + EQ (keysym, Qbutton2) || + EQ (keysym, Qbutton3) || + EQ (keysym, Qbutton4) || + EQ (keysym, Qbutton5) || + EQ (keysym, Qbutton6) || + EQ (keysym, Qbutton7)))) return; /* If this command in this map is shadowed by some other map, ignore it. */ @@ -3972,7 +3969,7 @@ static int -describe_map_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, +describe_map_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, Lisp_Object pred) { /* obj1 and obj2 are conses of the form @@ -4036,10 +4033,8 @@ else return 0; } - if (XCHAR (s1) == XCHAR (s2) || - XCHAR (s1) + 1 == XCHAR (s2)) - return 1; - return 0; + return (XCHAR (s1) == XCHAR (s2) || + XCHAR (s1) + 1 == XCHAR (s2)); } @@ -4047,7 +4042,8 @@ describe_map_parent_mapper (Lisp_Object keymap, void *arg) { /* This function can GC */ - struct describe_map_closure *describe_map_closure = arg; + struct describe_map_closure *describe_map_closure = + (struct describe_map_closure *) arg; describe_map_closure->self = keymap; map_keymap (XKEYMAP (keymap)->table, 0, /* don't sort: we'll do it later */ @@ -4056,10 +4052,14 @@ } +/* Describe the contents of map MAP, assuming that this map itself is + reached by the sequence of prefix keys KEYS (a string or vector). + PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */ + static void describe_map (Lisp_Object keymap, Lisp_Object elt_prefix, void (*elt_describer) (Lisp_Object), - int partial, + int partial, Lisp_Object shadow, int mice_only_p) { @@ -4127,7 +4127,7 @@ buffer_insert_c_string (buf, "SPC"); else if (EQ (keysym, QKbackspace)) buffer_insert_c_string (buf, "BS"); - else + else #endif if (c >= printable_min) buffer_insert_emacs_char (buf, c); @@ -4216,9 +4216,9 @@ defsymbol (&Qcontrol, "control"); defsymbol (&Qctrl, "ctrl"); - defsymbol (&Qmeta, "meta"); - defsymbol (&Qsuper, "super"); - defsymbol (&Qhyper, "hyper"); + defsymbol (&Qmeta, "meta"); + defsymbol (&Qsuper, "super"); + defsymbol (&Qhyper, "hyper"); defsymbol (&Qalt, "alt"); defsymbol (&Qshift, "shift"); defsymbol (&Qbutton0, "button0");
--- a/src/keymap.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/keymap.h Mon Aug 13 09:55:28 2007 +0200 @@ -42,7 +42,7 @@ extern Lisp_Object Fkey_description (Lisp_Object keys); extern Lisp_Object Fsingle_key_description (Lisp_Object key); -extern Lisp_Object Fwhere_is_internal (Lisp_Object definition, +extern Lisp_Object Fwhere_is_internal (Lisp_Object definition, Lisp_Object keymaps, Lisp_Object firstonly, Lisp_Object noindirect,
--- a/src/lisp-disunion.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/lisp-disunion.h Mon Aug 13 09:55:28 2007 +0200 @@ -25,12 +25,9 @@ #define Qzero 0 -/* #define Lisp_Object int */ typedef EMACS_INT Lisp_Object; -#ifndef VALMASK -# define VALMASK ((1L << (VALBITS)) - 1L) -#endif +#define VALMASK ((1L << (VALBITS)) - 1L) #define GCTYPEMASK ((1L << (GCTYPEBITS)) - 1L) /* comment from FSFmacs (perhaps not accurate here): @@ -48,33 +45,17 @@ /* These macros extract various sorts of values from a Lisp_Object. - For example, if tem is a Lisp_Object whose type is Lisp_Cons, - XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */ + For example, if tem is a Lisp_Object whose type is Lisp_Type_Cons, + XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */ -/* One need to override this if there must be high bits set in data space +/* One needs to override this if there must be high bits set in data space (doing the result of the below & ((1 << (GCTYPE + 1)) - 1) would work - on all machines, but would penalise machines which don't need it) - */ -#ifndef XTYPE -# define XTYPE(a) ((enum Lisp_Type) ((a) >> VALBITS)) -#endif - -#ifndef XSETTYPE -# define XSETTYPE(a,b) ((a) = XUINT (a) | ((EMACS_INT)(b) << VALBITS)) -#endif + on all machines, but would penalize machines which don't need it) */ +#define XTYPE(a) ((enum Lisp_Type) ((a) >> VALBITS)) #define EQ(x,y) ((x) == (y)) #define GC_EQ(x,y) (XGCTYPE (x) == XGCTYPE (y) && XPNTR (x) == XPNTR (y)) -#if 0 -/* XFASTINT is error-prone and saves a few instructions at best, - so there's really no point to it. Just use XINT() or make_int() - instead. --ben */ -/* Use XFASTINT for fast retrieval and storage of integers known - to be positive. This takes advantage of the fact that Lisp_Int is 0. */ -#define XFASTINT(a) (a) -#endif /* 0 */ - /* Extract the value of a Lisp_Object as a signed integer. */ #ifndef XREALINT /* Some machines need to do this differently. */ @@ -84,12 +65,9 @@ /* Extract the value as an unsigned integer. This is a basis for extracting it as a pointer to a structure in storage. */ -#ifndef XUINT -# define XUINT(a) ((a) & VALMASK) -#endif +#define XUINT(a) ((a) & VALMASK) -#ifndef XPNTR -# ifdef HAVE_SHM +#ifdef HAVE_SHM /* In this representation, data is found in two widely separated segments. */ extern int pure_size; # define XPNTR(a) \ @@ -100,52 +78,30 @@ In the diffs I was given, it checked for ptr = 0 and did not adjust it in that case. But I don't think that zero should ever be found - in a Lisp object whose data type says it points to something. - */ + in a Lisp object whose data type says it points to something. */ # define XPNTR(a) (XUINT (a) | DATA_SEG_BITS) # else # define XPNTR(a) XUINT (a) # endif -# endif /* not HAVE_SHM */ -#endif /* no XPNTR */ - -#ifndef XSETINT -# if 1 /* Back in the dark ages, this def "broke things" */ -# define XSETINT(a, b) do { XSETOBJ (a, Lisp_Int, b); } while (0) -# else /* alternate def to work around some putative bug with the above */ -# define XSETINT(a, b) do { (a) = (((a) & ~VALMASK) | ((b) & VALMASK)); \ - } while (0) -# endif -#endif /* !XSETINT */ +#endif /* not HAVE_SHM */ -#ifndef XSETUINT -#define XSETUINT(a, b) XSETINT (a, b) -#endif +#define XSETINT(a, b) XSETOBJ (a, Lisp_Type_Int, b) -#ifndef XSETPNTR -#define XSETPNTR(a, b) XSETINT (a, b) -#endif - -/* characters do not need to sign extend so there's no need for special - futzing like with ints. */ -#define XSETCHAR(a, b) do { XSETOBJ (a, Lisp_Char, b); } while (0) +#define XSETCHAR(var, value) XSETOBJ (var, Lisp_Type_Char, value) /* XSETOBJ was formerly named XSET. The name change was made to catch C code that attempts to use this macro. You should always use the individual settor macros (XSETCONS, XSETBUFFER, etc.) instead. */ -#ifndef XSETOBJ -# define XSETOBJ(var,type,ptr) \ - do { (var) = (((EMACS_INT) (type) << VALBITS) \ - + ((EMACS_INT) (ptr) & VALMASK)); \ - } while(0) -#endif +#define XSETOBJ(var, type_tag, value) \ + ((void) ((var) = (((EMACS_INT) (type_tag) << VALBITS) \ + + ((EMACS_INT) (value) & VALMASK)))) /* During garbage collection, XGCTYPE must be used for extracting types - so that the mark bit is ignored. XMARKBIT accesses the markbit. - Markbits are used only in particular slots of particular structure types. - Other markbits are always zero. - Outside of garbage collection, all mark bits are always zero. */ + so that the mark bit is ignored. XMARKBIT accesses the markbit. + Markbits are used only in particular slots of particular structure types. + Other markbits are always zero. + Outside of garbage collection, all mark bits are always zero. */ #ifndef XGCTYPE # define XGCTYPE(a) ((enum Lisp_Type) (((a) >> VALBITS) & GCTYPEMASK)) @@ -153,36 +109,20 @@ #if ((VALBITS) + (GCTYPEBITS)) == ((LONGBITS) - 1L) /* Make XMARKBIT faster if mark bit is sign bit. */ -# ifndef XMARKBIT -# define XMARKBIT(a) ((a) < 0L) -# endif +# define XMARKBIT(a) ((a) < 0L) +#else +# define XMARKBIT(a) ((a) & (MARKBIT)) #endif /* markbit is sign bit */ -#ifndef XMARKBIT -# define XMARKBIT(a) ((a) & (MARKBIT)) -#endif - -#ifndef XSETMARKBIT -#define XSETMARKBIT(a,b) \ - do { ((a) = ((a) & ~(MARKBIT)) | ((b) ? (MARKBIT) : 0)); } while (0) -#endif - -#ifndef XMARK -# define XMARK(a) do { ((a) |= (MARKBIT)); } while (0) -#endif - -#ifndef XUNMARK -/* no 'do {} while' because this is used in a mondo macro in lrecord.h */ -# define XUNMARK(a) ((a) &= (~(MARKBIT))) -#endif +# define XMARK(a) ((void) ((a) |= (MARKBIT))) +# define XUNMARK(a) ((void) ((a) &= (~(MARKBIT)))) /* Use this for turning a (void *) into a Lisp_Object, as when the Lisp_Object is passed into a toolkit callback function */ -#define VOID_TO_LISP(larg,varg) \ - do { ((larg) = ((Lisp_Object) (varg))); } while (0) +#define VOID_TO_LISP(larg,varg) ((void) ((larg) = ((Lisp_Object) (varg)))) #define CVOID_TO_LISP VOID_TO_LISP -/* Use this for turning a Lisp_Object into a (void *), as when the +/* Use this for turning a Lisp_Object into a (void *), as when the Lisp_Object is passed into a toolkit callback function */ #define LISP_TO_VOID(larg) ((void *) (larg)) #define LISP_TO_CVOID(varg) ((CONST void *) (larg))
--- a/src/lisp-union.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/lisp-union.h Mon Aug 13 09:55:28 2007 +0200 @@ -21,87 +21,63 @@ /* Synched up with: FSF 19.30. Split out from lisp.h. */ -#if (!!defined (WORDS_BIGENDIAN) != !!defined (LOWTAGS)) - -/* Big-endian lowtags, little-endian hightags */ typedef union Lisp_Object +{ + struct { - struct - { - unsigned EMACS_INT type_mark: GCTYPEBITS + 1; - signed EMACS_INT val: VALBITS; - } s; - struct - { -#ifdef __GNUC__ /* Non-ANSI extension */ - enum Lisp_Type type: GCTYPEBITS; -#else - unsigned EMACS_INT type: GCTYPEBITS; -#endif /* __GNUC__ */ - /* The markbit is not really part of the value of a Lisp_Object, - and is always zero except during garbage collection. */ - unsigned EMACS_INT markbit: 1; - unsigned EMACS_INT val: VALBITS; - } gu; - EMACS_INT i; - /* GCC bites yet again. I fart in the general direction of - the GCC authors. - - This was formerly declared 'void *v' etc. but that causes - GCC to accept any (yes, any) pointer as the argument of - a function declared to accept a Lisp_Object. */ - struct __nosuchstruct__ *v; - CONST struct __nosuchstruct__ *cv; /* C wanks */ - } -Lisp_Object; - +#if (!!defined (WORDS_BIGENDIAN) != !!defined (LOWTAGS)) + /* Big-endian lowtags, little-endian hightags */ + unsigned EMACS_INT type_mark: GCTYPEBITS + 1; + signed EMACS_INT val: VALBITS; #else /* If WORDS_BIGENDIAN, or little-endian hightags */ - -/* Big-endian hightags, little-endian lowtags */ -typedef -union Lisp_Object + signed EMACS_INT val: VALBITS; + unsigned EMACS_INT mark_type: GCTYPEBITS + 1; +#endif /* BIG/LITTLE_ENDIAN vs HIGH/LOWTAGS */ + } s; + struct { - struct - { - signed EMACS_INT val: VALBITS; - unsigned EMACS_INT mark_type: GCTYPEBITS + 1; - } s; - struct - { - unsigned EMACS_INT val: VALBITS; +#if (!!defined (WORDS_BIGENDIAN) == !!defined (LOWTAGS)) + unsigned EMACS_INT val: VALBITS; +#endif #ifdef __GNUC__ /* Non-ANSI extension */ - enum Lisp_Type type: GCTYPEBITS; + enum Lisp_Type type: GCTYPEBITS; #else - unsigned EMACS_INT type: GCTYPEBITS; + unsigned EMACS_INT type: GCTYPEBITS; #endif /* __GNUC__ */ - /* The markbit is not really part of the value of a Lisp_Object, - and is always zero except during garbage collection. */ - unsigned EMACS_INT markbit: 1; - } gu; - EMACS_INT i; - struct __nosuchstruct__ *v; - CONST struct __nosuchstruct__ *cv; /* C sucks */ - } + /* The markbit is not really part of the value of a Lisp_Object, + and is always zero except during garbage collection. */ + unsigned EMACS_INT markbit: 1; +#if (!!defined (WORDS_BIGENDIAN) != !!defined (LOWTAGS)) + unsigned EMACS_INT val: VALBITS; +#endif + } gu; + EMACS_INT i; + /* GCC bites yet again. I fart in the general direction of + the GCC authors. + + This was formerly declared 'void *v' etc. but that causes + GCC to accept any (yes, any) pointer as the argument of + a function declared to accept a Lisp_Object. */ + struct __nosuchstruct__ *v; + CONST struct __nosuchstruct__ *cv; /* C wanks */ +} Lisp_Object; -#endif /* BIG/LITTLE_ENDIAN vs HIGH/LOWTAGS */ - - #ifndef XMAKE_LISP #if (__GNUC__ > 1) /* Use GCC's struct initializers feature */ -#define XMAKE_LISP(vartype,ptr) \ +#define XMAKE_LISP(vartype,value) \ ((union Lisp_Object) { gu: { markbit: 0, \ type: (vartype), \ - val: ((unsigned EMACS_INT) ptr) } }) + val: ((unsigned EMACS_INT) value) } }) #endif /* __GNUC__ */ #endif /* !XMAKE_LISP */ #ifdef XMAKE_LISP -#define Qzero (XMAKE_LISP (Lisp_Int, 0)) -#define make_int(a) (XMAKE_LISP (Lisp_Int, (a))) +#define Qzero (XMAKE_LISP (Lisp_Type_Int, 0)) +#define make_int(a) (XMAKE_LISP (Lisp_Type_Int, (a))) #else extern Lisp_Object Qzero; #endif @@ -111,7 +87,6 @@ #define GC_EQ(x,y) ((x).gu.val == (y).gu.val && (x).gu.type == (y).gu.type) #define XTYPE(a) ((enum Lisp_Type) (a).gu.type) -#define XSETTYPE(a,b) ((a).gu.type = (b)) #define XGCTYPE(a) XTYPE (a) /* This was commented out a long time ago. I uncommented it, but it @@ -124,14 +99,6 @@ #define XREALINT(a) ((a).s.val) #endif /* EXPLICIT_SIGN_EXTEND */ -#if 0 -/* XFASTINT is error-prone and saves a few instructions at best, - so there's really no point to it. Just use XINT() or make_int() - instead. --ben */ -/* The + 0 is to prevent XFASTINT being used on the LHS of an assignment */ -#define XFASTINT(a) ((a).gu.val + 0) -#endif /* 0 */ - #define XUINT(a) ((a).gu.val) #ifdef HAVE_SHM /* In this representation, data is found in two widely separated segments. */ @@ -150,20 +117,17 @@ # else /* not DATA_SEG_BITS */ # define XPNTR(a) ((void *) ((a).gu.val)) # endif /* not DATA_SEG_BITS */ -#endif /* not HAVE_SHM */ -#define XSETINT(a, b) do { ((a) = make_int (b)); } while (0) -#define XSETUINT(a, b) XSETINT (a, b) -#define XSETPNTR(a, b) XSETINT (a, b) +#endif /* not HAVE_SHM */ +#define XSETINT(a, b) ((void) ((a) = make_int (b))) -#define XSETCHAR(a, b) do { ((a) = make_char (b)); } while (0) +#define XSETCHAR(a, b) ((void) ((a) = make_char (b))) /* XSETOBJ was formerly named XSET. The name change was made to catch C code that attempts to use this macro. You should always use the individual settor macros (XSETCONS, XSETBUFFER, etc.) instead. */ #ifdef XMAKE_LISP -#define XSETOBJ(var,vartype,ptr) \ - do { ((var) = XMAKE_LISP (vartype, ptr)); } while (0) +#define XSETOBJ(a, type, b) ((void) ((a) = XMAKE_LISP (type, b))) #else /* This is haired up to avoid evaluating var twice... This is necessary only in the "union" version. @@ -171,34 +135,31 @@ */ /* XEmacs change: put the assignment to val first; otherwise you can trip up the error_check_*() stuff */ -#define XSETOBJ(var, vartype, ptr) \ - do { \ - Lisp_Object *tmp_xset_var = &(var); \ - (*tmp_xset_var).s.val = ((EMACS_INT) (ptr)); \ - (*tmp_xset_var).gu.markbit = 0; \ - (*tmp_xset_var).gu.type = (vartype); \ +#define XSETOBJ(var, vartype, value) \ + do { \ + Lisp_Object *tmp_xset_var = &(var); \ + (*tmp_xset_var).s.val = ((EMACS_INT) (value)); \ + (*tmp_xset_var).gu.markbit = 0; \ + (*tmp_xset_var).gu.type = (vartype); \ } while (0) #endif /* undefined XMAKE_LISP */ /* During garbage collection, XGCTYPE must be used for extracting types - so that the mark bit is ignored. XMARKBIT access the markbit. - Markbits are used only in particular slots of particular structure types. - Other markbits are always zero. - Outside of garbage collection, all mark bits are always zero. */ - + so that the mark bit is ignored. XMARKBIT access the markbit. + Markbits are used only in particular slots of particular structure types. + Other markbits are always zero. + Outside of garbage collection, all mark bits are always zero. */ #define XMARKBIT(a) ((a).gu.markbit) -#define XSETMARKBIT(a,b) do { (XMARKBIT (a) = (b)); } while (0) -#define XMARK(a) do { XMARKBIT (a) = 1; } while (0) -/* no 'do {} while' because this is used in a mondo macro in lrecord.h */ -#define XUNMARK(a) (XMARKBIT (a) = 0) +#define XMARK(a) ((void) (XMARKBIT (a) = 1)) +#define XUNMARK(a) ((void) (XMARKBIT (a) = 0)) /* Use this for turning a (void *) into a Lisp_Object, as when the Lisp_Object is passed into a toolkit callback function */ #define VOID_TO_LISP(larg,varg) \ - do { ((larg).v = (struct __nosuchstruct__ *) (varg)); } while (0) + ((void) ((larg).v = (struct __nosuchstruct__ *) (varg))) #define CVOID_TO_LISP(larg,varg) \ - do { ((larg).cv = (CONST struct __nosuchstruct__ *) (varg)); } while (0) + ((void) ((larg).cv = (CONST struct __nosuchstruct__ *) (varg))) /* Use this for turning a Lisp_Object into a (void *), as when the Lisp_Object is passed into a toolkit callback function */ @@ -215,4 +176,3 @@ will catch errors. */ #define NON_LVALUE(larg) (larg) #endif -
--- a/src/lisp.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/lisp.h Mon Aug 13 09:55:28 2007 +0200 @@ -167,12 +167,22 @@ # define sys_fclose fclose #endif +/* Memory allocation */ +void malloc_warning (CONST char *); +void *xmalloc (size_t size); +void *xmalloc_and_zero (size_t size); +void *xrealloc (void *, size_t size); +char *xstrdup (CONST char *); /* generally useful */ #define countof(x) (sizeof(x)/sizeof(x[0])) #define slot_offset(type, slot_name) \ ((unsigned) (((char *) (&(((type *)0)->slot_name))) - ((char *)0))) -#define malloc_type(type) ((type *) xmalloc (sizeof (type))) -#define malloc_type_and_zero(type) ((type *) xmalloc_and_zero (sizeof (type))) +#define xnew(type) ((type *) xmalloc (sizeof (type))) +#define xnew_array(type, len) ((type *) xmalloc ((len) * sizeof (type))) +#define xnew_and_zero(type) ((type *) xmalloc_and_zero (sizeof (type))) +#define xnew_array_and_zero(type, len) ((type *) xmalloc_and_zero ((len) * sizeof (type))) +#define XREALLOC_ARRAY(ptr, type, len) ((void) (ptr = (type *) xrealloc (ptr, (len) * sizeof (type)))) +#define alloca_array(type, len) ((type *) alloca ((len) * sizeof (type))) /* also generally useful if you want to avoid arbitrary size limits but don't need a full dynamic array. Assumes that BASEVAR points @@ -181,34 +191,35 @@ macro will realloc BASEVAR as necessary so that it can hold at least NEEDED_SIZE objects. The reallocing is done by doubling, which ensures constant amortized time per element. */ -#define DO_REALLOC(basevar, sizevar, needed_size, type) do \ -{ \ - /* Avoid side-effectualness. */ \ - /* Dammit! Macros suffer from dynamic scope! */ \ - /* We demand inline functions! */ \ - int do_realloc_needed_size = (needed_size); \ - int newsize = 0; \ - while ((sizevar) < (do_realloc_needed_size)) { \ - newsize = 2*(sizevar); \ - if (newsize < 32) \ - newsize = 32; \ - (sizevar) = newsize; \ - } \ - if (newsize) \ - (basevar) = (type *) xrealloc (basevar, \ - (newsize)*sizeof(type)); \ +#define DO_REALLOC(basevar, sizevar, needed_size, type) do \ +{ \ + /* Avoid side-effectualness. */ \ + /* Dammit! Macros suffer from dynamic scope! */ \ + /* We demand inline functions! */ \ + int do_realloc_needed_size = (needed_size); \ + int newsize = 0; \ + while ((sizevar) < (do_realloc_needed_size)) { \ + newsize = 2*(sizevar); \ + if (newsize < 32) \ + newsize = 32; \ + (sizevar) = newsize; \ + } \ + if (newsize) \ + XREALLOC_ARRAY (basevar, type, newsize); \ } while (0) #ifdef ERROR_CHECK_MALLOC -#define xfree(lvalue) do \ -{ \ - void **ptr = (void **) &(lvalue); \ - xfree_1 (*ptr); \ - *ptr = (void *) 0xDEADBEEF; \ +void xfree_1 (void *); +#define xfree(lvalue) do \ +{ \ + void **ptr = (void **) &(lvalue); \ + xfree_1 (*ptr); \ + *ptr = (void *) 0xDEADBEEF; \ } while (0) #else +void xfree (void *); #define xfree_1 xfree -#endif +#endif /* ERROR_CHECK_MALLOC */ /* We assume an ANSI C compiler and libraries and memcpy, memset, memcmp */ /* (This definition is here because system header file macros may want @@ -431,13 +442,15 @@ typedef struct lstream Lstream; typedef unsigned int face_index; -typedef struct face_cachel_dynarr_type + +typedef struct { Dynarr_declare (struct face_cachel); } face_cachel_dynarr; typedef unsigned int glyph_index; -typedef struct glyph_cachel_dynarr_type + +typedef struct { Dynarr_declare (struct glyph_cachel); } glyph_cachel_dynarr; @@ -447,6 +460,7 @@ struct device; /* "device.h" */ struct extent_fragment; struct extent; +typedef struct extent *EXTENT; struct frame; /* "frame.h" */ struct window; /* "window.h" */ struct Lisp_Event; /* "events.h" */ @@ -464,52 +478,53 @@ struct face_cachel; struct console_type_entry; -typedef struct bufbyte_dynarr_type +typedef struct { Dynarr_declare (Bufbyte); -} bufbyte_dynarr; +} Bufbyte_dynarr; -typedef struct extbyte_dynarr_type +typedef struct { Dynarr_declare (Extbyte); -} extbyte_dynarr; +} Extbyte_dynarr; -typedef struct emchar_dynarr_type +typedef struct { Dynarr_declare (Emchar); -} emchar_dynarr; +} Emchar_dynarr; -typedef struct unsigned_char_dynarr_type +typedef unsigned char unsigned_char; +typedef struct { Dynarr_declare (unsigned char); } unsigned_char_dynarr; -typedef struct int_dynarr_type +typedef struct { Dynarr_declare (int); } int_dynarr; -typedef struct bufpos_dynarr_type +typedef struct { Dynarr_declare (Bufpos); -} bufpos_dynarr; +} Bufpos_dynarr; -typedef struct bytind_dynarr_type +typedef struct { Dynarr_declare (Bytind); -} bytind_dynarr; +} Bytind_dynarr; -typedef struct charcount_dynarr_type +typedef struct { Dynarr_declare (Charcount); -} charcount_dynarr; +} Charcount_dynarr; -typedef struct bytecount_dynarr_type +typedef struct { Dynarr_declare (Bytecount); -} bytecount_dynarr; +} Bytecount_dynarr; -typedef struct console_type_entry_dynarr_type +typedef struct { Dynarr_declare (struct console_type_entry); } console_type_entry_dynarr; @@ -627,37 +642,37 @@ enum Lisp_Type { /* Integer. XINT(obj) is the integer value. */ - Lisp_Int /* 0 DTP-FIXNUM */ + Lisp_Type_Int, /* 0 DTP-FIXNUM */ /* XRECORD_LHEADER (object) points to a struct lrecord_header lheader->implementation determines the type (and GC behaviour) of the object. */ - ,Lisp_Record /* 1 DTP-OTHER-POINTER */ + Lisp_Type_Record, /* 1 DTP-OTHER-POINTER */ /* Cons. XCONS (object) points to a struct Lisp_Cons. */ - ,Lisp_Cons /* 2 DTP-LIST */ + Lisp_Type_Cons, /* 2 DTP-LIST */ /* LRECORD_STRING is NYI */ /* String. XSTRING (object) points to a struct Lisp_String. The length of the string, and its contents, are stored therein. */ - ,Lisp_String /* 3 DTP-STRING */ + Lisp_Type_String, /* 3 DTP-STRING */ #ifndef LRECORD_VECTOR /* Vector of Lisp objects. XVECTOR(object) points to a struct Lisp_Vector. The length of the vector, and its contents, are stored therein. */ - ,Lisp_Vector /* 4 DTP-SIMPLE-ARRAY */ -#endif + Lisp_Type_Vector, /* 4 DTP-SIMPLE-ARRAY */ +#endif /* !LRECORD_VECTOR */ #ifndef LRECORD_SYMBOL /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */ - ,Lisp_Symbol + Lisp_Type_Symbol, #endif /* !LRECORD_SYMBOL */ - ,Lisp_Char /* 5 DTP-CHAR */ + Lisp_Type_Char /* 5 DTP-CHAR */ }; /* unsafe! */ -#define POINTER_TYPE_P(type) ((type) != Lisp_Int && (type) != Lisp_Char) +#define POINTER_TYPE_P(type) ((type) != Lisp_Type_Int && (type) != Lisp_Type_Char) /* This should be the underlying type into which a Lisp_Object must fit. In a strict ANSI world, this must be `int', since ANSI says you can't @@ -696,10 +711,10 @@ /* WARNING WARNING WARNING. You must ensure on your own that proper GC protection is provided for the elements in this array. */ -typedef struct lisp_dynarr_type +typedef struct { Dynarr_declare (Lisp_Object); -} lisp_dynarr; +} Lisp_Object_dynarr; /* Close your eyes now lest you vomit or spontaneously combust ... */ @@ -757,13 +772,13 @@ }; #endif -DECLARE_NONRECORD (cons, Lisp_Cons, struct Lisp_Cons); -#define XCONS(a) XNONRECORD (a, cons, Lisp_Cons, struct Lisp_Cons) -#define XSETCONS(c, p) XSETOBJ (c, Lisp_Cons, p) -#define CONSP(x) (XTYPE (x) == Lisp_Cons) -#define GC_CONSP(x) (XGCTYPE (x) == Lisp_Cons) -#define CHECK_CONS(x) CHECK_NONRECORD (x, Lisp_Cons, Qconsp) -#define CONCHECK_CONS(x) CONCHECK_NONRECORD (x, Lisp_Cons, Qconsp) +DECLARE_NONRECORD (cons, Lisp_Type_Cons, struct Lisp_Cons); +#define XCONS(a) XNONRECORD (a, cons, Lisp_Type_Cons, struct Lisp_Cons) +#define XSETCONS(c, p) XSETOBJ (c, Lisp_Type_Cons, p) +#define CONSP(x) (XTYPE (x) == Lisp_Type_Cons) +#define GC_CONSP(x) (XGCTYPE (x) == Lisp_Type_Cons) +#define CHECK_CONS(x) CHECK_NONRECORD (x, Lisp_Type_Cons, Qconsp) +#define CONCHECK_CONS(x) CONCHECK_NONRECORD (x, Lisp_Type_Cons, Qconsp) /* Define these because they're used in a few places, inside and out of alloc.c */ @@ -843,17 +858,17 @@ #define CHECK_STRING(x) CHECK_RECORD (x, string) #define CONCHECK_STRING(x) CONCHECK_RECORD (x, string) -#else +#else /* ! LRECORD_STRING */ -DECLARE_NONRECORD (string, Lisp_String, struct Lisp_String); -#define XSTRING(x) XNONRECORD (x, string, Lisp_String, struct Lisp_String) -#define XSETSTRING(x, p) XSETOBJ (x, Lisp_String, p) -#define STRINGP(x) (XTYPE (x) == Lisp_String) -#define GC_STRINGP(x) (XGCTYPE (x) == Lisp_String) -#define CHECK_STRING(x) CHECK_NONRECORD (x, Lisp_String, Qstringp) -#define CONCHECK_STRING(x) CONCHECK_NONRECORD (x, Lisp_String, Qstringp) +DECLARE_NONRECORD (string, Lisp_Type_String, struct Lisp_String); +#define XSTRING(x) XNONRECORD (x, string, Lisp_Type_String, struct Lisp_String) +#define XSETSTRING(x, p) XSETOBJ (x, Lisp_Type_String, p) +#define STRINGP(x) (XTYPE (x) == Lisp_Type_String) +#define GC_STRINGP(x) (XGCTYPE (x) == Lisp_Type_String) +#define CHECK_STRING(x) CHECK_NONRECORD (x, Lisp_Type_String, Qstringp) +#define CONCHECK_STRING(x) CONCHECK_NONRECORD (x, Lisp_Type_String, Qstringp) -#endif +#endif /* ! LRECORD_STRING */ #ifdef MULE @@ -874,9 +889,9 @@ #define string_byte(s, i) ((s)->_data[i] + 0) #define XSTRING_BYTE(s, i) string_byte (XSTRING (s), i) #define string_byte_addr(s, i) (&((s)->_data[i])) -#define set_string_length(s, len) do { (s)->_size = (len); } while (0) -#define set_string_data(s, ptr) do { (s)->_data = (ptr); } while (0) -#define set_string_byte(s, i, c) do { (s)->_data[i] = (c); } while (0) +#define set_string_length(s, len) ((void) ((s)->_size = (len))) +#define set_string_data(s, ptr) ((void) ((s)->_data = (ptr))) +#define set_string_byte(s, i, c) ((void) ((s)->_data[i] = (c))) void resize_string (struct Lisp_String *s, Bytecount pos, Bytecount delta); @@ -928,13 +943,13 @@ #else -DECLARE_NONRECORD (vector, Lisp_Vector, struct Lisp_Vector); -#define XVECTOR(x) XNONRECORD (x, vector, Lisp_Vector, struct Lisp_Vector) -#define XSETVECTOR(x, p) XSETOBJ (x, Lisp_Vector, p) -#define VECTORP(x) (XTYPE (x) == Lisp_Vector) -#define GC_VECTORP(x) (XGCTYPE (x) == Lisp_Vector) -#define CHECK_VECTOR(x) CHECK_NONRECORD (x, Lisp_Vector, Qvectorp) -#define CONCHECK_VECTOR(x) CONCHECK_NONRECORD (x, Lisp_Vector, Qvectorp) +DECLARE_NONRECORD (vector, Lisp_Type_Vector, struct Lisp_Vector); +#define XVECTOR(x) XNONRECORD (x, vector, Lisp_Type_Vector, struct Lisp_Vector) +#define XSETVECTOR(x, p) XSETOBJ (x, Lisp_Type_Vector, p) +#define VECTORP(x) (XTYPE (x) == Lisp_Type_Vector) +#define GC_VECTORP(x) (XGCTYPE (x) == Lisp_Type_Vector) +#define CHECK_VECTOR(x) CHECK_NONRECORD (x, Lisp_Type_Vector, Qvectorp) +#define CONCHECK_VECTOR(x) CONCHECK_NONRECORD (x, Lisp_Type_Vector, Qvectorp) #endif @@ -1047,13 +1062,13 @@ #else -DECLARE_NONRECORD (symbol, Lisp_Symbol, struct Lisp_Symbol); -#define XSYMBOL(x) XNONRECORD (x, symbol, Lisp_Symbol, struct Lisp_Symbol) -#define XSETSYMBOL(s, p) XSETOBJ ((s), Lisp_Symbol, (p)) -#define SYMBOLP(x) (XTYPE (x) == Lisp_Symbol) -#define GC_SYMBOLP(x) (XGCTYPE (x) == Lisp_Symbol) -#define CHECK_SYMBOL(x) CHECK_NONRECORD (x, Lisp_Symbol, Qsymbolp) -#define CONCHECK_SYMBOL(x) CONCHECK_NONRECORD (x, Lisp_Symbol, Qsymbolp) +DECLARE_NONRECORD (symbol, Lisp_Type_Symbol, struct Lisp_Symbol); +#define XSYMBOL(x) XNONRECORD (x, symbol, Lisp_Type_Symbol, struct Lisp_Symbol) +#define XSETSYMBOL(s, p) XSETOBJ ((s), Lisp_Type_Symbol, (p)) +#define SYMBOLP(x) (XTYPE (x) == Lisp_Type_Symbol) +#define GC_SYMBOLP(x) (XGCTYPE (x) == Lisp_Type_Symbol) +#define CHECK_SYMBOL(x) CHECK_NONRECORD (x, Lisp_Type_Symbol, Qsymbolp) +#define CONCHECK_SYMBOL(x) CONCHECK_NONRECORD (x, Lisp_Type_Symbol, Qsymbolp) #endif @@ -1115,8 +1130,8 @@ /*********** char ***********/ -#define CHARP(x) (XTYPE (x) == Lisp_Char) -#define GC_CHARP(x) (XGCTYPE (x) == Lisp_Char) +#define CHARP(x) (XTYPE (x) == Lisp_Type_Char) +#define GC_CHARP(x) (XGCTYPE (x) == Lisp_Type_Char) #ifdef ERROR_CHECK_TYPECHECK @@ -1134,8 +1149,8 @@ #endif -#define CHECK_CHAR(x) CHECK_NONRECORD (x, Lisp_Char, Qcharacterp) -#define CONCHECK_CHAR(x) CONCHECK_NONRECORD (x, Lisp_Char, Qcharacterp) +#define CHECK_CHAR(x) CHECK_NONRECORD (x, Lisp_Type_Char, Qcharacterp) +#define CONCHECK_CHAR(x) CONCHECK_NONRECORD (x, Lisp_Type_Char, Qcharacterp) /*********** float ***********/ @@ -1171,24 +1186,24 @@ /* These are always continuable because they change their arguments even when no error is signalled. */ -#define CHECK_INT_OR_FLOAT_COERCE_MARKER(x) do \ -{ if (INTP (x) || FLOATP (x)) \ - ; \ - else if (MARKERP (x)) \ - x = make_int (marker_position (x)); \ - else \ - x = wrong_type_argument (Qnumber_or_marker_p, x); \ +#define CHECK_INT_OR_FLOAT_COERCE_MARKER(x) do \ +{ if (INTP (x) || FLOATP (x)) \ + ; \ + else if (MARKERP (x)) \ + x = make_int (marker_position (x)); \ + else \ + x = wrong_type_argument (Qnumber_or_marker_p, x); \ } while (0) -#define CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER(x) do \ -{ if (INTP (x) || FLOATP (x)) \ - ; \ - else if (CHARP (x)) \ - x = make_int (XCHAR (x)); \ - else if (MARKERP (x)) \ - x = make_int (marker_position (x)); \ - else \ - x = wrong_type_argument (Qnumber_char_or_marker_p, x); \ +#define CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER(x) do \ +{ if (INTP (x) || FLOATP (x)) \ + ; \ + else if (CHARP (x)) \ + x = make_int (XCHAR (x)); \ + else if (MARKERP (x)) \ + x = make_int (marker_position (x)); \ + else \ + x = wrong_type_argument (Qnumber_char_or_marker_p, x); \ } while (0) # define INT_OR_FLOATP(x) (INTP (x) || FLOATP (x)) @@ -1214,8 +1229,8 @@ #endif /* not LISP_FLOAT_TYPE */ -#define INTP(x) (XTYPE (x) == Lisp_Int) -#define GC_INTP(x) (XGCTYPE (x) == Lisp_Int) +#define INTP(x) (XTYPE (x) == Lisp_Type_Int) +#define GC_INTP(x) (XGCTYPE (x) == Lisp_Type_Int) #define ZEROP(x) EQ (x, Qzero) #define GC_ZEROP(x) GC_EQ (x, Qzero) @@ -1236,8 +1251,8 @@ #endif -#define CHECK_INT(x) CHECK_NONRECORD (x, Lisp_Int, Qintegerp) -#define CONCHECK_INT(x) CONCHECK_NONRECORD (x, Lisp_Int, Qintegerp) +#define CHECK_INT(x) CHECK_NONRECORD (x, Lisp_Type_Int, Qintegerp) +#define CONCHECK_INT(x) CONCHECK_NONRECORD (x, Lisp_Type_Int, Qintegerp) #define NATNUMP(x) (INTP (x) && XINT (x) >= 0) #define GC_NATNUMP(x) (GC_INTP (x) && XINT (x) >= 0) @@ -1248,33 +1263,33 @@ do { if (!NATNUMP (x)) x = wrong_type_argument (Qnatnump, x); } while (0) /* next three always continuable because they coerce their arguments. */ -#define CHECK_INT_COERCE_CHAR(x) do \ -{ if (INTP (x)) \ - ; \ - else if (CHARP (x)) \ - x = make_int (XCHAR (x)); \ - else \ - x = wrong_type_argument (Qinteger_or_char_p, x); \ +#define CHECK_INT_COERCE_CHAR(x) do \ +{ if (INTP (x)) \ + ; \ + else if (CHARP (x)) \ + x = make_int (XCHAR (x)); \ + else \ + x = wrong_type_argument (Qinteger_or_char_p, x); \ } while (0) -#define CHECK_INT_COERCE_MARKER(x) do \ -{ if (INTP (x)) \ - ; \ - else if (MARKERP (x)) \ - x = make_int (marker_position (x)); \ - else \ - x = wrong_type_argument (Qinteger_or_marker_p, x); \ +#define CHECK_INT_COERCE_MARKER(x) do \ +{ if (INTP (x)) \ + ; \ + else if (MARKERP (x)) \ + x = make_int (marker_position (x)); \ + else \ + x = wrong_type_argument (Qinteger_or_marker_p, x); \ } while (0) -#define CHECK_INT_COERCE_CHAR_OR_MARKER(x) do \ -{ if (INTP (x)) \ - ; \ - else if (CHARP (x)) \ - x = make_int (XCHAR (x)); \ - else if (MARKERP (x)) \ - x = make_int (marker_position (x)); \ - else \ - x = wrong_type_argument (Qinteger_char_or_marker_p, x); \ +#define CHECK_INT_COERCE_CHAR_OR_MARKER(x) do \ +{ if (INTP (x)) \ + ; \ + else if (CHARP (x)) \ + x = make_int (XCHAR (x)); \ + else if (MARKERP (x)) \ + x = make_int (marker_position (x)); \ + else \ + x = wrong_type_argument (Qinteger_char_or_marker_p, x); \ } while (0) /*********** pure space ***********/ @@ -1284,6 +1299,7 @@ /*********** structures ***********/ +typedef struct structure_keyword_entry structure_keyword_entry; struct structure_keyword_entry { Lisp_Object keyword; @@ -1291,23 +1307,24 @@ Error_behavior errb); }; -typedef struct structure_keyword_entry_dynarr_type +typedef struct { - Dynarr_declare (struct structure_keyword_entry); -} Structure_keyword_entry_dynarr; + Dynarr_declare (structure_keyword_entry); +} structure_keyword_entry_dynarr; +typedef struct structure_type structure_type; struct structure_type { Lisp_Object type; - Structure_keyword_entry_dynarr *keywords; + structure_keyword_entry_dynarr *keywords; int (*validate) (Lisp_Object data, Error_behavior errb); Lisp_Object (*instantiate) (Lisp_Object data); }; -typedef struct structure_type_dynarr_type +typedef struct { - Dynarr_declare (struct structure_type); -} Structure_type_dynarr; + Dynarr_declare (structure_type); +} structure_type_dynarr; struct structure_type *define_structure_type (Lisp_Object type, int (*validate) @@ -1759,39 +1776,39 @@ #endif /* Evaluate expr, UNGCPRO, and then return the value of expr. */ -#define RETURN_UNGCPRO(expr) do \ -{ \ - Lisp_Object ret_ungc_val = (expr); \ - UNGCPRO; \ - RETURN__ ret_ungc_val; \ +#define RETURN_UNGCPRO(expr) do \ +{ \ + Lisp_Object ret_ungc_val = (expr); \ + UNGCPRO; \ + RETURN__ ret_ungc_val; \ } while (0) /* Evaluate expr, NUNGCPRO, UNGCPRO, and then return the value of expr. */ -#define RETURN_NUNGCPRO(expr) do \ -{ \ - Lisp_Object ret_ungc_val = (expr); \ - NUNGCPRO; \ - UNGCPRO; \ - RETURN__ ret_ungc_val; \ +#define RETURN_NUNGCPRO(expr) do \ +{ \ + Lisp_Object ret_ungc_val = (expr); \ + NUNGCPRO; \ + UNGCPRO; \ + RETURN__ ret_ungc_val; \ } while (0) /* Evaluate expr, NNUNGCPRO, NUNGCPRO, UNGCPRO, and then return the value of expr. */ -#define RETURN_NNUNGCPRO(expr) do \ -{ \ - Lisp_Object ret_ungc_val = (expr); \ - NNUNGCPRO; \ - NUNGCPRO; \ - UNGCPRO; \ - RETURN__ ret_ungc_val; \ +#define RETURN_NNUNGCPRO(expr) do \ +{ \ + Lisp_Object ret_ungc_val = (expr); \ + NNUNGCPRO; \ + NUNGCPRO; \ + UNGCPRO; \ + RETURN__ ret_ungc_val; \ } while (0) /* Evaluate expr, return it if it's not Qunbound. */ -#define RETURN_IF_NOT_UNBOUND(expr) do \ -{ \ - Lisp_Object ret_nunb_val = (expr); \ - if (!UNBOUNDP (ret_nunb_val)) \ - RETURN__ ret_nunb_val; \ +#define RETURN_IF_NOT_UNBOUND(expr) do \ +{ \ + Lisp_Object ret_nunb_val = (expr); \ + if (!UNBOUNDP (ret_nunb_val)) \ + RETURN__ ret_nunb_val; \ } while (0) /* Call staticpro (&var) to protect static variable `var'. */
--- a/src/lread.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/lread.c Mon Aug 13 09:55:28 2007 +0200 @@ -146,7 +146,7 @@ static int load_byte_code_version; /* An array describing all known built-in structure types */ -static Structure_type_dynarr *the_structure_type_dynarr; +static structure_type_dynarr *the_structure_type_dynarr; #if 0 /* FSFmacs defun hack */ /* When nonzero, read conses in pure space */ @@ -830,7 +830,7 @@ DEFUN ("locate-file", Flocate_file, 2, 4, 0, /* Search for FILENAME through PATH-LIST, expanded by one of the optional -SUFFIXES (string of suffixes separated by \":\"s), checking for access +SUFFIXES (string of suffixes separated by ":"s), checking for access MODE (0|1|2|4 = exists|executable|writeable|readable), default readable. `locate-file' keeps hash tables of the directories it searches through, @@ -1909,7 +1909,7 @@ static Lisp_Object read_bit_vector (Lisp_Object readcharfun) { - unsigned_char_dynarr *dyn = Dynarr_new (unsigned char); + unsigned_char_dynarr *dyn = Dynarr_new (unsigned_char); Emchar c; while (1) @@ -1940,7 +1940,7 @@ struct structure_type st; st.type = type; - st.keywords = Dynarr_new (struct structure_keyword_entry); + st.keywords = Dynarr_new (structure_keyword_entry); st.validate = validate; st.instantiate = instantiate; Dynarr_add (the_structure_type_dynarr, st); @@ -2625,7 +2625,7 @@ static void * read_list_conser (Lisp_Object readcharfun, void *state, Charcount len) { - struct read_list_state *s = state; + struct read_list_state *s = (struct read_list_state *) state; Lisp_Object elt; elt = read1 (readcharfun); @@ -2823,7 +2823,7 @@ GCPRO2 (s.head, s.tail); sequence_reader (readcharfun, terminator, &s, read_list_conser); - + UNGCPRO; tem = s.head; len = XINT (Flength (tem)); @@ -2930,7 +2930,7 @@ #if 0 #ifndef WINDOWSNT /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is - almost never correct, thereby causing a warning to be printed out that + almost never correct, thereby causing a warning to be printed out that confuses users. Since PATH_LOADSEARCH is always overriden by the EMACSLOADPATH environment variable below, disable the warning on NT. */ @@ -3013,7 +3013,7 @@ void structure_type_create (void) { - the_structure_type_dynarr = Dynarr_new (struct structure_type); + the_structure_type_dynarr = Dynarr_new (structure_type); } void @@ -3034,7 +3034,7 @@ *List of directories to search for files to load. Each element is a string (directory name) or nil (try default directory). -Note that the elements of this list *may not* begin with \"~\", so you must +Note that the elements of this list *may not* begin with "~", so you must call `expand-file-name' on them before adding them to this list. Initialized based on EMACSLOADPATH environment variable, if any, @@ -3169,7 +3169,7 @@ #ifdef LISP_BACKQUOTES old_backquote_flag = new_backquote_flag = 0; #endif - + #ifdef I18N3 Vfile_domain = Qnil; #endif
--- a/src/lrecord.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/lrecord.h Mon Aug 13 09:55:28 2007 +0200 @@ -66,12 +66,12 @@ table of lrecord-implementations rather than a direct pointer. There would be 24 (or 16) bits left over for datatype-specific per-instance flags. - + The below is the simplest thing to do for the present, and doesn't incur that much overhead as most Emacs records are of such a size that the overhead isn't too bad. (The marker datatype is the worst case.) - + It also has the very very very slight advantage that type-checking involves one memory read (of the "implementation" slot) and a comparison against a link-time constant address rather than a @@ -90,7 +90,7 @@ /* The "next" field is normally used to chain all lrecords together so that the GC can find (and free) all of them. "alloc_lcrecord" threads records together. - + The "next" field may be used for other purposes as long as some other mechanism is provided for letting the GC do its work. (For example, the event and marker datatypes allocate members out of @@ -118,7 +118,7 @@ Lisp_Object chain; }; -/* This as the value of lheader->implementation->finalizer +/* This as the value of lheader->implementation->finalizer * means that this record is already marked */ extern void this_marks_a_marked_record (void *, int); @@ -147,7 +147,7 @@ case). It should perform any necessary cleanup (e.g. freeing malloc()ed memory. This can be NULL, meaning no special finalization is necessary. - + WARNING: remember that the finalizer is called at dump time even though the object is not being freed. */ void (*finalizer) (void *header, int for_disksave); @@ -259,7 +259,7 @@ &(lrecord_##c_name##_lrecord_type_index), 0 }, \ { 0, 0, 0, this_marks_a_marked_record, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 } } -#define LRECORDP(a) (XTYPE ((a)) == Lisp_Record) +#define LRECORDP(a) (XTYPE ((a)) == Lisp_Type_Record) #define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a)) #define RECORD_TYPEP(x, ty) \ (LRECORDP (x) && XRECORD_LHEADER (x)->implementation == (ty)) @@ -305,7 +305,7 @@ # define XSETRECORD(var, p, c_name) do \ { \ - XSETOBJ (var, Lisp_Record, p); \ + XSETOBJ (var, Lisp_Type_Record, p); \ assert (RECORD_TYPEP (var, lrecord_##c_name) || \ MARKED_RECORD_P (var)); \ } while (0) @@ -321,7 +321,7 @@ # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x)) # define XNONRECORD(x, c_name, type_enum, structtype) \ ((structtype *) XPNTR (x)) -# define XSETRECORD(var, p, c_name) XSETOBJ (var, Lisp_Record, p) +# define XSETRECORD(var, p, c_name) XSETOBJ (var, Lisp_Type_Record, p) #endif /* not ERROR_CHECK_TYPECHECK */ @@ -331,7 +331,7 @@ /* Note: we now have two different kinds of type-checking macros. The "old" kind has now been renamed CONCHECK_foo. The reason for this is that the CONCHECK_foo macros signal a continuable error, - allowing the user (through debug-on-error) to subsitute a different + allowing the user (through debug-on-error) to substitute a different value and return from the signal, which causes the lvalue argument to get changed. Quite a lot of code would crash if that happened, because it did things like @@ -351,25 +351,28 @@ FSF Emacs does not have this problem because RMS took the cheesy way out and disabled returning from a signal entirely. */ -#define CONCHECK_RECORD(x, c_name) do \ -{ if (!RECORD_TYPEP (x, lrecord_##c_name)) \ - x = wrong_type_argument (Q##c_name##p, x); } \ - while (0) -#define CONCHECK_NONRECORD(x, lisp_enum, predicate) do \ -{ if (XTYPE (x) != lisp_enum) \ - x = wrong_type_argument (predicate, x); } \ - while (0) -#define CHECK_RECORD(x, c_name) do \ -{ if (!RECORD_TYPEP (x, lrecord_##c_name)) \ - dead_wrong_type_argument (Q##c_name##p, x); } \ - while (0) -#define CHECK_NONRECORD(x, lisp_enum, predicate) do \ -{ if (XTYPE (x) != lisp_enum) \ - dead_wrong_type_argument (predicate, x); } \ - while (0) +#define CONCHECK_RECORD(x, c_name) do { \ + if (!RECORD_TYPEP (x, lrecord_##c_name)) \ + x = wrong_type_argument (Q##c_name##p, x); \ +} while (0) +#define CONCHECK_NONRECORD(x, lisp_enum, predicate) do {\ + if (XTYPE (x) != lisp_enum) \ + x = wrong_type_argument (predicate, x); \ + } while (0) +#define CHECK_RECORD(x, c_name) do { \ + if (!RECORD_TYPEP (x, lrecord_##c_name)) \ + dead_wrong_type_argument (Q##c_name##p, x); \ + } while (0) +#define CHECK_NONRECORD(x, lisp_enum, predicate) do { \ + if (XTYPE (x) != lisp_enum) \ + dead_wrong_type_argument (predicate, x); \ + } while (0) void *alloc_lcrecord (int size, CONST struct lrecord_implementation *); +#define alloc_lcrecord_type(type, lrecord_implementation) \ + ((type *) alloc_lcrecord (sizeof (type), lrecord_implementation)) + int gc_record_type_p (Lisp_Object frob, CONST struct lrecord_implementation *type);
--- a/src/lstream.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/lstream.c Mon Aug 13 09:55:28 2007 +0200 @@ -72,7 +72,7 @@ it is very efficient. The C argument is only evaluated once but the STREAM argument is evaluated more than once. Returns 0 on success, -1 on error. - + int Lstream_getc (Lstream *stream) Read one byte from the stream. This is a macro and so it is very efficient. The STREAM argument is evaluated more @@ -92,7 +92,7 @@ int Lstream_fputc (Lstream *stream, int c) int Lstream_fgetc (Lstream *stream) void Lstream_fungetc (Lstream *stream, int c) - Function equivalents of the above macros. + Function equivalents of the above macros. int Lstream_read (Lstream *stream, void *data, int size) Read SIZE bytes of DATA from the stream. Return the number of @@ -110,6 +110,11 @@ same bytes back. Note that this will be the case even if there is other pending unread data. +int Lstream_delete (Lstream *stream) + Frees all memory associated with the stream is freed. Calling + this is not strictly necessary, but it is much more efficient + than having the Lstream be garbage-collected. + int Lstream_close (Lstream *stream) Close the stream. All data will be flushed out. @@ -429,7 +434,7 @@ static int Lstream_write_1 (Lstream *lstr, CONST void *data, int size) { - CONST unsigned char *p = data; + CONST unsigned char *p = (CONST unsigned char *) data; int off = 0; if (! (lstr->flags & LSTREAM_FL_IS_OPEN)) { @@ -500,7 +505,7 @@ Lstream_write (Lstream *lstr, CONST void *data, int size) { int i; - CONST unsigned char *p = data; + CONST unsigned char *p = (CONST unsigned char *) data; assert (size >= 0); if (size == 0) @@ -539,7 +544,7 @@ signal_simple_internal_error ("Internal error: lstream has no reader", obj); } - + return (lstr->imp->reader) (lstr, buffer, size); } @@ -562,7 +567,7 @@ lstr->in_buffer_current = max (0, size_gotten); lstr->in_buffer_ind = 0; return size_gotten < 0 ? -1 : size_gotten; -} +} int Lstream_read (Lstream *lstr, void *data, int size) @@ -672,7 +677,7 @@ lstr->byte_count = 0; return (lstr->imp->rewinder) (lstr); } - + int Lstream_seekable_p (Lstream *lstr) { @@ -974,7 +979,7 @@ { struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream); int retval; - int need_newline = 0; + int need_newline = 0; /* This function would be simple if it were not for the blasted PTY max-bytes stuff. Why the hell can't they just have written @@ -1182,7 +1187,7 @@ XSETLSTREAM (obj, lstr); return obj; } - + static int lisp_string_reader (Lstream *stream, unsigned char *data, int size) { @@ -1264,7 +1269,7 @@ XSETLSTREAM (obj, lstr); return obj; } - + Lisp_Object make_fixed_buffer_output_stream (unsigned char *buf, int size) { @@ -1351,7 +1356,7 @@ XSETLSTREAM (obj, Lstream_new (lstream_resizing_buffer, "w")); return obj; } - + static int resizing_buffer_writer (Lstream *stream, CONST unsigned char *data, int size) { @@ -1413,7 +1418,7 @@ DYNARR_STREAM_DATA (XLSTREAM (obj))->dyn = dyn; return obj; } - + static int dynarr_writer (Lstream *stream, CONST unsigned char *data, int size) { @@ -1469,7 +1474,7 @@ /* Make sure the luser didn't pass "w" in. */ if (!strcmp (mode, "w")) abort (); - + if (flags & LSTR_IGNORE_ACCESSIBLE) { bmin = BUF_BEG (buf); @@ -1562,7 +1567,7 @@ end = bytind_clip_to_bounds (BI_BUF_BEGV (buf), end, BI_BUF_ZV (buf)); } - + size = min (size, end - start); end = start + size; /* We cannot return a partial character. */
--- a/src/lstream.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/lstream.h Mon Aug 13 09:55:28 2007 +0200 @@ -126,7 +126,7 @@ /* Mark this object for garbage collection. Same semantics as a standard Lisp_Object marker. This function can be NULL. */ Lisp_Object (*marker) (Lisp_Object lstream, void (*markfun) (Lisp_Object)); -} Lstream_implementation; +} Lstream_implementation; #define DEFINE_LSTREAM_IMPLEMENTATION(name,c_name,size) \ Lstream_implementation c_name[1] = \ @@ -211,7 +211,7 @@ /* Call the function equivalent if the out buffer is full. Otherwise, add to the end of the out buffer and, if line buffering is called for and the character marks the end of a line, write out the buffer. */ - + #define Lstream_putc(stream, c) \ ((stream)->out_buffer_ind >= (stream)->out_buffer_size ? \ Lstream_fputc (stream, c) : \
--- a/src/menubar-x.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/menubar-x.c Mon Aug 13 09:55:28 2007 +0200 @@ -85,7 +85,7 @@ strdup(). */ static widget_value * -menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, +menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, int menu_type, int deep_p, int filter_p, int depth) @@ -118,7 +118,7 @@ if (wv->type == SEPARATOR_TYPE) { wv->value = menu_separator_style (string_chars); - } + } else { wv->name = string_chars; @@ -162,7 +162,7 @@ desc = Fcdr (desc); if (NILP (desc)) signal_simple_error ("keyword in menu lacks a value", - cascade); + cascade); val = Fcar (desc); desc = Fcdr (desc); if (EQ (key, Q_included)) @@ -179,7 +179,7 @@ else signal_simple_error ("bad keyboard accelerator", val); } - else + else signal_simple_error ("unknown menu cascade keyword", cascade); } @@ -195,7 +195,7 @@ #ifdef LWLIB_MENUBARS_LUCID if (filter_p || depth == 0) { -#endif +#endif desc = call1_trapping_errors ("Error in menubar filter", hook_fn, desc); if (UNBOUNDP (desc)) @@ -231,7 +231,7 @@ sep_wv->type = SEPARATOR_TYPE; sep_wv->value = menu_separator_style ("=="); sep_wv->next = 0; - + wv->contents = title_wv; prev = sep_wv; } @@ -301,12 +301,12 @@ } static widget_value * -menu_item_descriptor_to_widget_value (Lisp_Object desc, +menu_item_descriptor_to_widget_value (Lisp_Object desc, int menu_type, /* if this is a menubar, popup or sub menu */ int deep_p, /* */ int filter_p) /* if :filter forms - should run now */ + should run now */ { widget_value *wv; int count = specpdl_depth (); @@ -345,7 +345,7 @@ If client_data != NULL, then client_data is a (widget_value *) and client_data->data is a Lisp_Object pointing to a lisp submenu description that must be converted into widget_values. *client_data is destructively - modified. + modified. #### Stig thinks that there may be a GC problem here due to the fact that pre_activate_callback() is called multiple times, but I @@ -429,7 +429,7 @@ (!CONSP (Vactivate_menubar_hook) || EQ (XCAR (Vactivate_menubar_hook), Qlambda))) Vactivate_menubar_hook = Fcons (Vactivate_menubar_hook, Qnil); - + GCPRO1 (rest); for (rest = Vactivate_menubar_hook; !NILP (rest); rest = Fcdr (rest)) if (!EQ (call0 (XCAR (rest)), Qt)) @@ -445,7 +445,7 @@ that an INCREMENTAL_TYPE widget_value can be recreated... Hmmmmm. */ if (any_changes || !XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date) -#endif +#endif set_frame_menubar (f, 1, 0); DEVICE_X_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) = DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) = @@ -542,11 +542,11 @@ data = compute_menubar_data (f, menubar, deep_p); if (!data || (!data->next && !data->contents)) abort (); - + if (NILP (FRAME_MENUBAR_DATA (f))) { struct popup_data *mdata = - alloc_lcrecord (sizeof (struct popup_data), lrecord_popup_data); + alloc_lcrecord_type (struct popup_data, lrecord_popup_data); mdata->id = new_lwlib_id (); mdata->last_menubar_buffer = Qnil; @@ -584,7 +584,7 @@ lw_modify_all_widgets (id, data, deep_p ? True : False); } free_popup_widget_value_tree (data); - + XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date = deep_p; XFRAME_MENUBAR_DATA (f)->last_menubar_buffer = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer; @@ -632,7 +632,7 @@ static void make_dummy_xbutton_event (XEvent *dummy, - Widget daddy, + Widget daddy, struct Lisp_Event *eev) /* NULL for eev means query pointer */ { @@ -703,7 +703,7 @@ Boolean menubar_visibility_changed; Cardinal new_num_top_widgets = 1; /* for the menubar */ Widget container = FRAME_X_CONTAINER_WIDGET (f); - + #ifdef ENERGIZE int *old_sheets = FRAME_X_CURRENT_PSHEETS (f); int *new_sheets = FRAME_X_DESIRED_PSHEETS (f); @@ -743,7 +743,7 @@ if (menubar_visibility_changed) (menubar_will_be_visible ? XtManageChild : XtUnmanageChild) (FRAME_X_MENUBAR_WIDGET (f)); - + #ifdef ENERGIZE /* Set debugger panel visibility */ @@ -859,7 +859,7 @@ Widget menubar_widget; assert (FRAME_X_P (f)); - + menubar_widget = FRAME_X_MENUBAR_WIDGET (f); if (menubar_widget) { @@ -948,7 +948,7 @@ data = menu_item_descriptor_to_widget_value (menu_desc, POPUP_TYPE, 1, 1); if (! data) error ("no menu"); - + menu_id = new_lwlib_id (); menu = lw_create_widget ("popup", "popup" /* data->name */, menu_id, data, parent, 1, 0, @@ -964,7 +964,7 @@ sequence of magic-events (destined for the popup-menu widget) to begin. Eventually, a menu item is selected, and a menu-event blip is pushed onto the end of the input stream, which is then executed by the event loop. - + So there are two command-events, with a bunch of magic-events between them. We don't want the *first* command event to alter the state of the region, so that the region can be available as an argument for the second
--- a/src/menubar.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/menubar.c Mon Aug 13 09:55:28 2007 +0200 @@ -114,9 +114,9 @@ Otherwise, the element must be a vector, which describes a menu item. A menu item can have any of the following forms: - [ \"name\" callback <active-p> ] - [ \"name\" callback <active-p> \"suffix\" ] - [ \"name\" callback :<keyword> <value> :<keyword> <value> ... ] + [ "name" callback <active-p> ] + [ "name" callback <active-p> "suffix" ] + [ "name" callback :<keyword> <value> :<keyword> <value> ... ] The name is the string to display on the menu; it is filtered through the resource database, so it is possible for resources to override what string @@ -133,12 +133,12 @@ displayed, and the menu will be selectable only if the result is non-nil. - :suffix \"string\" Same as \"suffix\" in the second form: the suffix is + :suffix "string" Same as "suffix" in the second form: the suffix is appended to the displayed name, providing a convenient way of adding the name of a command's ``argument'' to the menu, like ``Kill Buffer NAME''. - :keys \"string\" Normally, the keyboard equivalents of commands in + :keys "string" Normally, the keyboard equivalents of commands in menus are displayed when the `callback' is a symbol. This can be used to specify keys for more complex menu items. It is passed through `substitute-command-keys' @@ -165,9 +165,9 @@ For example: - [ \"Save As...\" write-file t ] - [ \"Revert Buffer\" revert-buffer (buffer-modified-p) ] - [ \"Read Only\" toggle-read-only :style toggle :selected buffer-read-only ] + [ "Save As..." write-file t ] + [ "Revert Buffer" revert-buffer (buffer-modified-p) ] + [ "Read Only" toggle-read-only :style toggle :selected buffer-read-only ] See menubar.el for many more examples. */ @@ -207,8 +207,8 @@ menu_item[0] = build_string (""); menu_item[1] = Qnil; menu_item[2] = Qnil; - Vblank_menubar = Fcons (Fcons (build_string (blank_msg), - Fcons (Fvector (3, &menu_item[0]), + Vblank_menubar = Fcons (Fcons (build_string (blank_msg), + Fcons (Fvector (3, &menu_item[0]), Qnil)), Qnil); Vblank_menubar = Fpurecopy (Vblank_menubar); @@ -261,9 +261,9 @@ Otherwise, the element must be a vector, which describes a menu item. A menu item can have any of the following forms: - [ \"name\" callback <active-p> ] - [ \"name\" callback <active-p> \"suffix\" ] - [ \"name\" callback :<keyword> <value> :<keyword> <value> ... ] + [ "name" callback <active-p> ] + [ "name" callback <active-p> "suffix" ] + [ "name" callback :<keyword> <value> :<keyword> <value> ... ] The name is the string to display on the menu; it is filtered through the resource database, so it is possible for resources to override what string @@ -280,12 +280,12 @@ displayed, and the menu will be selectable only if the result is non-nil. - :suffix \"string\" Same as \"suffix\" in the second form: the suffix is + :suffix "string" Same as "suffix" in the second form: the suffix is appended to the displayed name, providing a convenient way of adding the name of a command's ``argument'' to the menu, like ``Kill Buffer NAME''. - :keys \"string\" Normally, the keyboard equivalents of commands in + :keys "string" Normally, the keyboard equivalents of commands in menus are displayed when the `callback' is a symbol. This can be used to specify keys for more complex menu items. It is passed through `substitute-command-keys' @@ -336,13 +336,13 @@ For example: - (\"File\" + ("File" :filter file-menu-filter ; file-menu-filter is a function that takes ; one argument (a list of menu items) and ; returns a list of menu items - [ \"Save As...\" write-file t ] - [ \"Revert Buffer\" revert-buffer (buffer-modified-p) ] - [ \"Read Only\" toggle-read-only :style toggle + [ "Save As..." write-file t ] + [ "Revert Buffer" revert-buffer (buffer-modified-p) ] + [ "Read Only" toggle-read-only :style toggle :selected buffer-read-only ] )
--- a/src/msdos.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/msdos.c Mon Aug 13 09:55:28 2007 +0200 @@ -1639,7 +1639,7 @@ if (have_mouse <= 0) return XM_IA_SELECT; - state = alloca (menu->panecount * sizeof (struct IT_menu_state)); + state = alloca_array (struct IT_menu_state, menu->panecount); screensize = screen_size * 2; faces[0] = compute_glyph_face (&the_only_frame, @@ -2161,7 +2161,7 @@ lst = Vprocess_environment; len = XINT (Flength (lst)); - envv = alloca ((len + 1) * sizeof (char *)); + envv = alloca_array (char *, len + 1); for (i = 0; i < len; i++) { tmp = Fcar (lst);
--- a/src/mule-ccl.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/mule-ccl.c Mon Aug 13 09:55:28 2007 +0200 @@ -544,7 +544,7 @@ set_ccl_program_from_lisp_values (&ccl, ccl_program, status); CHECK_STRING (str); - outbuf = Dynarr_new (unsigned char); + outbuf = Dynarr_new (unsigned_char); len = ccl_driver (&ccl, XSTRING_DATA (str), outbuf, XSTRING_LENGTH (str), 0); ccl_driver (&ccl, (unsigned char *) "", outbuf, 0, 1); set_lisp_status_from_ccl_program (status, &ccl);
--- a/src/mule-charset.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/mule-charset.c Mon Aug 13 09:55:28 2007 +0200 @@ -444,8 +444,7 @@ struct Lisp_Charset *cs; Lisp_Object obj = Qnil; - cs = (struct Lisp_Charset *) alloc_lcrecord (sizeof (struct Lisp_Charset), - lrecord_charset); + cs = alloc_lcrecord_type (struct Lisp_Charset, lrecord_charset); XSETCHARSET (obj, cs); CHARSET_NAME (cs) = name; @@ -568,7 +567,8 @@ /* This function can GC */ Lisp_Object key, contents; Lisp_Object *charset_list; - struct charset_list_closure *chcl = charset_list_closure; + struct charset_list_closure *chcl = + (struct charset_list_closure*) charset_list_closure; CVOID_TO_LISP (key, hash_key); VOID_TO_LISP (contents, hash_contents); charset_list = chcl->charset_list;
--- a/src/mule-charset.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/mule-charset.h Mon Aug 13 09:55:28 2007 +0200 @@ -251,7 +251,7 @@ following bytes of all characters is in the range 0xA0 - 0xFF. This means that it is impossible to get out of sync, or more specifically: - + 1. Given any byte position, the beginning of the character it is within can be determined in constant time. 2. Given any byte position at the beginning of a character, the @@ -450,7 +450,7 @@ Lisp_Object reverse_direction_charset; Lisp_Object ccl_program; - + unsigned int leading_byte :8; /* Number of bytes (1 - 4) required in the internal representation
--- a/src/mule-coding.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/mule-coding.c Mon Aug 13 09:55:28 2007 +0200 @@ -187,15 +187,16 @@ static void mule_encode (Lstream *encoding, CONST unsigned char *src, unsigned_char_dynarr *dst, unsigned int n); +typedef struct codesys_prop codesys_prop; struct codesys_prop { Lisp_Object sym; int prop_type; }; -typedef struct codesys_prop_dynarr_type +typedef struct { - Dynarr_declare (struct codesys_prop); + Dynarr_declare (codesys_prop); } codesys_prop_dynarr; codesys_prop_dynarr *the_codesys_prop_dynarr; @@ -383,8 +384,8 @@ For example, many ISO2022-compliant coding systems (such as Compound Text, which is used for inter-client data under the X Window System) use escape sequences to switch between different charsets -- Japanese -Kanji, for example, is invoked with \"ESC $ ( B\"; ASCII is invoked -with \"ESC ( B\"; and Cyrillic is invoked with \"ESC - L\". See +Kanji, for example, is invoked with "ESC $ ( B"; ASCII is invoked +with "ESC ( B"; and Cyrillic is invoked with "ESC - L". See `make-coding-system' for more information. Coding systems are normally identified using a symbol, and the @@ -444,10 +445,11 @@ /* This function can GC */ Lisp_Object key, contents; Lisp_Object *coding_system_list; - struct coding_system_list_closure *chcl = coding_system_list_closure; + struct coding_system_list_closure *cscl = + (struct coding_system_list_closure *) coding_system_list_closure; CVOID_TO_LISP (key, hash_key); VOID_TO_LISP (contents, hash_contents); - coding_system_list = chcl->coding_system_list; + coding_system_list = cscl->coding_system_list; *coding_system_list = Fcons (XCODING_SYSTEM (contents)->name, *coding_system_list); @@ -483,10 +485,8 @@ static struct Lisp_Coding_System * allocate_coding_system (enum coding_system_type type, Lisp_Object name) { - struct Lisp_Coding_System *codesys; - - codesys = (struct Lisp_Coding_System *) - alloc_lcrecord (sizeof (struct Lisp_Coding_System), lrecord_coding_system); + struct Lisp_Coding_System *codesys = + alloc_lcrecord_type (struct Lisp_Coding_System, lrecord_coding_system); zero_lcrecord (codesys); CODING_SYSTEM_PRE_WRITE_CONVERSION (codesys) = Qnil; @@ -676,9 +676,9 @@ using the specified register. 'short - If non-nil, use the short forms \"ESC $ @\", \"ESC $ A\", and - \"ESC $ B\" on output in place of the full designation sequences - \"ESC $ ( @\", \"ESC $ ( A\", and \"ESC $ ( B\". + If non-nil, use the short forms "ESC $ @", "ESC $ A", and + "ESC $ B" on output in place of the full designation sequences + "ESC $ ( @", "ESC $ ( A", and "ESC $ ( B". 'no-ascii-eol If non-nil, don't designate ASCII to G0 at each end of line on output. @@ -703,7 +703,7 @@ If non-nil, literal control characters that are the same as the beginning of a recognized ISO2022 or ISO6429 escape sequence (in particular, ESC (0x1B), SO (0x0E), SI (0x0F), SS2 (0x8E), - SS3 (0x8F), and CSI (0x9B)) are \"quoted\" with an escape character + SS3 (0x8F), and CSI (0x9B)) are "quoted" with an escape character so that they can be properly distinguished from an escape sequence. (Note that doing this results in a non-portable encoding.) This encoding flag is used for byte-compiled files. Note that ESC @@ -738,7 +738,7 @@ { struct Lisp_Coding_System *codesys; Lisp_Object rest, key, value; - int ty; + enum coding_system_type ty; int need_to_setup_eol_systems = 1; /* Convert type to constant */ @@ -817,14 +817,14 @@ else if (EQ (key, Qinput_charset_conversion)) { codesys->iso2022.input_conv = - Dynarr_new (struct charset_conversion_spec); + Dynarr_new (charset_conversion_spec); parse_charset_conversion_specs (codesys->iso2022.input_conv, value); } else if (EQ (key, Qoutput_charset_conversion)) { codesys->iso2022.output_conv = - Dynarr_new (struct charset_conversion_spec); + Dynarr_new (charset_conversion_spec); parse_charset_conversion_specs (codesys->iso2022.output_conv, value); } @@ -1480,23 +1480,25 @@ Lisp_Object val = Qnil; struct buffer *buf = decode_buffer (buffer, 0); Bufpos b, e; - Lisp_Object instream; + Lisp_Object instream, lb_instream; + Lstream *istr, *lb_istr; struct detection_state decst; + struct gcpro gcpro1, gcpro2; get_buffer_range_char (buf, start, end, &b, &e, 0); - instream = make_lisp_buffer_input_stream (buf, b, e, 0); - instream = make_encoding_input_stream (XLSTREAM (instream), - Fget_coding_system (Qbinary)); + lb_instream = make_lisp_buffer_input_stream (buf, b, e, 0); + lb_istr = XLSTREAM (lb_instream); + instream = make_encoding_input_stream (lb_istr, Fget_coding_system (Qbinary)); + istr = XLSTREAM (instream); + GCPRO2 (instream, lb_instream); memset (&decst, 0, sizeof (decst)); decst.eol_type = EOL_AUTODETECT; decst.mask = ~0; while (1) { unsigned char random_buffer[4096]; - int nread; - - nread = Lstream_read (XLSTREAM (instream), random_buffer, - sizeof (random_buffer)); + int nread = Lstream_read (istr, random_buffer, sizeof (random_buffer)); + if (!nread) break; if (detect_coding_type (&decst, random_buffer, nread, 0)) @@ -1526,6 +1528,10 @@ } } } + Lstream_close (istr); + UNGCPRO; + Lstream_delete (istr); + Lstream_delete (lb_istr); return val; } @@ -1862,7 +1868,7 @@ memset (str, 0, sizeof (*str)); str->other_end = stream; - str->runoff = (unsigned_char_dynarr *) Dynarr_new (unsigned char); + str->runoff = (unsigned_char_dynarr *) Dynarr_new (unsigned_char); str->eol_type = EOL_AUTODETECT; if (!strcmp (mode, "r") && Lstream_seekable_p (stream)) @@ -1964,21 +1970,11 @@ } } -static Lisp_Object -close_both_streams (Lisp_Object cons) -{ - Lisp_Object instream = XCAR (cons); - Lisp_Object outstream = XCDR (cons); - Lstream_close (XLSTREAM (outstream)); - Lstream_close (XLSTREAM (instream)); - return Qnil; -} - DEFUN ("decode-coding-region", Fdecode_coding_region, 3, 4, 0, /* Decode the text between START and END which is encoded in CODING-SYSTEM. This is useful if you've read in encoded text from a file without decoding it (e.g. you read in a JIS-formatted file but used the `binary' or -`no-conversion' coding system, so that it shows up as \"^[$B!<!+^[(B\"). +`no-conversion' coding system, so that it shows up as "^[$B!<!+^[(B"). Return length of decoded text. BUFFER defaults to the current buffer if unspecified. */ @@ -1986,23 +1982,24 @@ { Bufpos b, e; struct buffer *buf = decode_buffer (buffer, 0); - Lisp_Object instream, outstream; - int speccount = specpdl_depth (); - struct gcpro gcpro1, gcpro2; + Lisp_Object instream, lb_outstream, de_outstream, outstream; + Lstream *istr, *ostr; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; get_buffer_range_char (buf, start, end, &b, &e, 0); barf_if_buffer_read_only (buf, b, e); coding_system = Fget_coding_system (coding_system); - instream = make_lisp_buffer_input_stream (buf, b, e, 0); - outstream = make_lisp_buffer_output_stream (buf, b, 0); - outstream = make_decoding_output_stream (XLSTREAM (outstream), - coding_system); - outstream = make_encoding_output_stream (XLSTREAM (outstream), + instream = make_lisp_buffer_input_stream (buf, b, e, 0); + lb_outstream = make_lisp_buffer_output_stream (buf, b, 0); + de_outstream = make_decoding_output_stream (XLSTREAM (lb_outstream), + coding_system); + outstream = make_encoding_output_stream (XLSTREAM (de_outstream), Fget_coding_system (Qbinary)); - GCPRO2 (instream, outstream); - record_unwind_protect (close_both_streams, Fcons (instream, outstream)); + istr = XLSTREAM (instream); + ostr = XLSTREAM (outstream); + GCPRO4 (instream, lb_outstream, de_outstream, outstream); /* The chain of streams looks like this: @@ -2012,28 +2009,28 @@ ------> [BUFFER] */ - { - char tempbuf[1024]; /* some random amount */ - Lstream *in = XLSTREAM(instream); - Lstream *out = XLSTREAM(outstream); - Bufpos newpos, even_newer_pos; - - while (1) - { - Bufpos oldpos = lisp_buffer_stream_startpos (in); - int size_in_bytes = Lstream_read (in, tempbuf, sizeof (tempbuf)); - if (!size_in_bytes) - break; - newpos = lisp_buffer_stream_startpos (in); - Lstream_write (out, tempbuf, size_in_bytes); - even_newer_pos = lisp_buffer_stream_startpos (in); - buffer_delete_range (buf, even_newer_pos - (newpos - oldpos), - even_newer_pos, 0); - } - } - - unbind_to (speccount, Qnil); + while (1) + { + char tempbuf[1024]; /* some random amount */ + Bufpos newpos, even_newer_pos; + Bufpos oldpos = lisp_buffer_stream_startpos (istr); + int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); + + if (!size_in_bytes) + break; + newpos = lisp_buffer_stream_startpos (istr); + Lstream_write (ostr, tempbuf, size_in_bytes); + even_newer_pos = lisp_buffer_stream_startpos (istr); + buffer_delete_range (buf, even_newer_pos - (newpos - oldpos), + even_newer_pos, 0); + } + Lstream_close (istr); + Lstream_close (ostr); UNGCPRO; + Lstream_delete (istr); + Lstream_delete (ostr); + Lstream_delete (XLSTREAM (de_outstream)); + Lstream_delete (XLSTREAM (lb_outstream)); return Qnil; } @@ -2314,7 +2311,7 @@ Lisp_Object obj; memset (str, 0, sizeof (*str)); - str->runoff = (unsigned_char_dynarr *) Dynarr_new (unsigned char); + str->runoff = Dynarr_new (unsigned_char); str->other_end = stream; set_encoding_stream_coding_system (lstr, codesys); XSETLSTREAM (obj, lstr); @@ -2376,17 +2373,16 @@ DEFUN ("encode-coding-region", Fencode_coding_region, 3, 4, 0, /* Encode the text between START and END using CODING-SYSTEM. This will, for example, convert Japanese characters into stuff such as -\"^[$B!<!+^[(B\" if you use the JIS encoding. Return length of encoded +"^[$B!<!+^[(B" if you use the JIS encoding. Return length of encoded text. BUFFER defaults to the current buffer if unspecified. */ (start, end, coding_system, buffer)) { Bufpos b, e; struct buffer *buf = decode_buffer (buffer, 0); - Lisp_Object instream, outstream; - char tempbuf[1024]; /* some random amount */ - int speccount = specpdl_depth (); - struct gcpro gcpro1, gcpro2; + Lisp_Object instream, lb_outstream, de_outstream, outstream; + Lstream *istr, *ostr; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; get_buffer_range_char (buf, start, end, &b, &e, 0); @@ -2394,13 +2390,14 @@ coding_system = Fget_coding_system (coding_system); instream = make_lisp_buffer_input_stream (buf, b, e, 0); - outstream = make_lisp_buffer_output_stream (buf, b, 0); - outstream = make_decoding_output_stream (XLSTREAM (outstream), - Fget_coding_system (Qbinary)); - outstream = make_encoding_output_stream (XLSTREAM (outstream), + lb_outstream = make_lisp_buffer_output_stream (buf, b, 0); + de_outstream = make_decoding_output_stream (XLSTREAM (lb_outstream), + Fget_coding_system (Qbinary)); + outstream = make_encoding_output_stream (XLSTREAM (de_outstream), coding_system); - GCPRO2 (instream, outstream); - record_unwind_protect (close_both_streams, Fcons (instream, outstream)); + istr = XLSTREAM (instream); + ostr = XLSTREAM (outstream); + GCPRO4 (instream, outstream, de_outstream, lb_outstream); /* The chain of streams looks like this: [BUFFER] <----- send through @@ -2410,17 +2407,16 @@ */ while (1) { - int size_in_bytes; - Bufpos oldpos, newpos, even_newer_pos; - - oldpos = lisp_buffer_stream_startpos (XLSTREAM (instream)); - size_in_bytes = Lstream_read (XLSTREAM (instream), tempbuf, - sizeof (tempbuf)); + char tempbuf[1024]; /* some random amount */ + Bufpos newpos, even_newer_pos; + Bufpos oldpos = lisp_buffer_stream_startpos (istr); + int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); + if (!size_in_bytes) break; - newpos = lisp_buffer_stream_startpos (XLSTREAM (instream)); - Lstream_write (XLSTREAM (outstream), tempbuf, size_in_bytes); - even_newer_pos = lisp_buffer_stream_startpos (XLSTREAM (instream)); + newpos = lisp_buffer_stream_startpos (istr); + Lstream_write (ostr, tempbuf, size_in_bytes); + even_newer_pos = lisp_buffer_stream_startpos (istr); buffer_delete_range (buf, even_newer_pos - (newpos - oldpos), even_newer_pos, 0); } @@ -2428,8 +2424,13 @@ { Charcount retlen = lisp_buffer_stream_startpos (XLSTREAM (instream)) - b; - unbind_to (speccount, Qnil); + Lstream_close (istr); + Lstream_close (ostr); UNGCPRO; + Lstream_delete (istr); + Lstream_delete (ostr); + Lstream_delete (XLSTREAM (de_outstream)); + Lstream_delete (XLSTREAM (lb_outstream)); return make_int (retlen); } } @@ -3771,7 +3772,7 @@ if (str->iso2022.composite_chars) Dynarr_reset (str->iso2022.composite_chars); else - str->iso2022.composite_chars = Dynarr_new (unsigned char); + str->iso2022.composite_chars = Dynarr_new (unsigned_char); dst = str->iso2022.composite_chars; break; case ISO_ESC_END_COMPOSITE: @@ -4440,8 +4441,8 @@ /* Simple internal/external functions */ /************************************************************************/ -static extbyte_dynarr *conversion_out_dynarr; -static bufbyte_dynarr *conversion_in_dynarr; +static Extbyte_dynarr *conversion_out_dynarr; +static Bufbyte_dynarr *conversion_in_dynarr; /* Determine coding system from coding format */ @@ -4492,27 +4493,32 @@ } else { - Lisp_Object instream = - make_fixed_buffer_input_stream ((unsigned char *) ptr, len); - Lisp_Object outstream = make_dynarr_output_stream + Lisp_Object instream, outstream, da_outstream; + Lstream *istr, *ostr; + struct gcpro gcpro1, gcpro2, gcpro3; + char tempbuf[1024]; /* some random amount */ + + instream = make_fixed_buffer_input_stream ((unsigned char *) ptr, len); + da_outstream = make_dynarr_output_stream ((unsigned_char_dynarr *) conversion_out_dynarr); - struct gcpro gcpro1, gcpro2; - char tempbuf[1024]; /* some random amount */ - outstream = - make_encoding_output_stream (XLSTREAM (outstream), coding_system); - GCPRO2 (instream, outstream); /* Necessary?? */ + make_encoding_output_stream (XLSTREAM (da_outstream), coding_system); + istr = XLSTREAM (instream); + ostr = XLSTREAM (outstream); + GCPRO3 (instream, outstream, da_outstream); while (1) { - int size_in_bytes = Lstream_read (XLSTREAM (instream), - tempbuf, sizeof (tempbuf)); + int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); if (!size_in_bytes) break; - Lstream_write (XLSTREAM (outstream), tempbuf, size_in_bytes); + Lstream_write (ostr, tempbuf, size_in_bytes); } - Lstream_close (XLSTREAM (instream)); - Lstream_close (XLSTREAM (outstream)); + Lstream_close (istr); + Lstream_close (ostr); UNGCPRO; + Lstream_delete (istr); + Lstream_delete (ostr); + Lstream_delete (XLSTREAM (da_outstream)); } *len_out = Dynarr_length (conversion_out_dynarr); @@ -4544,27 +4550,32 @@ } else { - Lisp_Object instream = - make_fixed_buffer_input_stream ((unsigned char *) ptr, len); - Lisp_Object outstream = make_dynarr_output_stream + Lisp_Object instream, outstream, da_outstream; + Lstream *istr, *ostr; + struct gcpro gcpro1, gcpro2, gcpro3; + char tempbuf[1024]; /* some random amount */ + + instream = make_fixed_buffer_input_stream ((unsigned char *) ptr, len); + da_outstream = make_dynarr_output_stream ((unsigned_char_dynarr *) conversion_in_dynarr); - struct gcpro gcpro1, gcpro2; - char tempbuf[1024]; /* some random amount */ - outstream = - make_decoding_output_stream (XLSTREAM (outstream), coding_system); - GCPRO2 (instream, outstream); /* Necessary?? */ + make_decoding_output_stream (XLSTREAM (da_outstream), coding_system); + istr = XLSTREAM (instream); + ostr = XLSTREAM (outstream); + GCPRO3 (instream, outstream, da_outstream); while (1) { - int size_in_bytes = Lstream_read (XLSTREAM (instream), - tempbuf, sizeof (tempbuf)); + int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); if (!size_in_bytes) break; - Lstream_write (XLSTREAM (outstream), tempbuf, size_in_bytes); + Lstream_write (ostr, tempbuf, size_in_bytes); } - Lstream_close (XLSTREAM (instream)); - Lstream_close (XLSTREAM (outstream)); + Lstream_close (istr); + Lstream_close (ostr); UNGCPRO; + Lstream_delete (istr); + Lstream_delete (ostr); + Lstream_delete (XLSTREAM (da_outstream)); } *len_out = Dynarr_length (conversion_in_dynarr); @@ -4759,7 +4770,7 @@ Vcoding_system_hashtable = make_lisp_hashtable (50, HASHTABLE_NONWEAK, HASHTABLE_EQ); - the_codesys_prop_dynarr = Dynarr_new (struct codesys_prop); + the_codesys_prop_dynarr = Dynarr_new (codesys_prop); #define DEFINE_CODESYS_PROP(Prop_Type, Sym) do \ { \
--- a/src/mule-coding.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/mule-coding.h Mon Aug 13 09:55:28 2007 +0200 @@ -72,15 +72,16 @@ int status; }; +typedef struct charset_conversion_spec charset_conversion_spec; struct charset_conversion_spec { Lisp_Object from_charset; Lisp_Object to_charset; }; -typedef struct charset_conversion_spec_dynarr_type +typedef struct { - Dynarr_declare (struct charset_conversion_spec); + Dynarr_declare (charset_conversion_spec); } charset_conversion_spec_dynarr; struct Lisp_Coding_System
--- a/src/mule.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/mule.c Mon Aug 13 09:55:28 2007 +0200 @@ -53,8 +53,7 @@ CHECK_STRING (XVECTOR_DATA (temp)[0]); s = XSTRING (XVECTOR_DATA (temp)[0]); if (!wordbuf[i]) - wordbuf[i] = (struct re_pattern_buffer *) - xmalloc (sizeof (struct re_pattern_buffer)); + wordbuf[i] = xnew (struct re_pattern_buffer); else if (wordbuf[i]->buffer) xfree (wordbuf[i]->buffer); wordbuf[i]->buffer = (char *) xmalloc (s->size + 1); @@ -74,7 +73,7 @@ wordbuf[i]->category_version = 0; wordbuf[i]->regs_allocated = REGS_UNALLOCATED; - wordbuf[i]->re_nsub = 0; + wordbuf[i]->re_nsub = 0; wordbuf[i]->no_sub = 0; wordbuf[i]->newline_anchor = 1; @@ -88,7 +87,7 @@ if (wordbuf[i]->buffer) xfree (wordbuf[i]->buffer); xfree (wordbuf[i]); wordbuf[i] = (struct re_pattern_buffer *) 0; - } + } return Qnil; }
--- a/src/objects-tty.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/objects-tty.c Mon Aug 13 09:55:28 2007 +0200 @@ -161,7 +161,7 @@ } /* Don't allocate the data until we're sure that we will succeed. */ - c->data = malloc_type (struct tty_color_instance_data); + c->data = xnew (struct tty_color_instance_data); COLOR_INSTANCE_TTY_SYMBOL (c) = name; return 1; @@ -239,7 +239,7 @@ } /* Don't allocate the data until we're sure that we will succeed. */ - f->data = malloc_type (struct tty_font_instance_data); + f->data = xnew (struct tty_font_instance_data); FONT_INSTANCE_TTY_CHARSET (f) = charset; #ifdef MULE if (CHARSETP (charset)) @@ -290,21 +290,20 @@ Bytecount offset, Bytecount length) { CONST Bufbyte *the_nonreloc = nonreloc; - + if (!the_nonreloc) the_nonreloc = XSTRING_DATA (reloc); fixup_internal_substring (nonreloc, reloc, offset, &length); the_nonreloc += offset; - + if (UNBOUNDP (charset)) return !memchr (the_nonreloc, '/', length); - the_nonreloc = memchr (the_nonreloc, '/', length); + the_nonreloc = (CONST Bufbyte *) memchr (the_nonreloc, '/', length); if (!the_nonreloc) return 0; the_nonreloc++; { - struct Lisp_String *s = - symbol_name (XSYMBOL (XCHARSET_NAME (charset))); + struct Lisp_String *s = symbol_name (XSYMBOL (XCHARSET_NAME (charset))); return !strcmp ((CONST char *) the_nonreloc, (CONST char *) string_data (s)); }
--- a/src/objects-x.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/objects-x.c Mon Aug 13 09:55:28 2007 +0200 @@ -67,7 +67,7 @@ int x; no_cells = XDisplayCells (display, XDefaultScreen (display)); - cells = (XColor *) alloca (sizeof (XColor) * no_cells); + cells = alloca_array (XColor, no_cells); for (x = 0; x < no_cells; x++) cells[x].pixel = x; @@ -116,11 +116,11 @@ Screen *xs; Colormap cmap; int result; - + dpy = DEVICE_X_DISPLAY (d); xs = DefaultScreenOfDisplay (dpy); cmap = DefaultColormapOfScreen (xs); - + memset (color, 0, sizeof (*color)); { CONST Extbyte *extname; @@ -163,7 +163,7 @@ /* Don't allocate the data until we're sure that we will succeed, or the finalize method may get fucked. */ - c->data = malloc_type (struct x_color_instance_data); + c->data = xnew (struct x_color_instance_data); COLOR_INSTANCE_X_COLOR (c) = color; return 1; } @@ -188,7 +188,7 @@ if (DEVICE_LIVE_P (XDEVICE (c->device))) { Display *dpy = DEVICE_X_DISPLAY (XDEVICE (c->device)); - + XFreeColors (dpy, DefaultColormapOfScreen (DefaultScreenOfDisplay (dpy)), &COLOR_INSTANCE_X_COLOR (c).pixel, 1, 0); @@ -226,7 +226,7 @@ x_color_instance_rgb_components (struct Lisp_Color_Instance *c) { XColor color = COLOR_INSTANCE_X_COLOR (c); - return (list3 (make_int (color.red), + return (list3 (make_int (color.red), make_int (color.green), make_int (color.blue))); } @@ -237,7 +237,7 @@ XColor c; Display *dpy = DEVICE_X_DISPLAY (d); CONST char *extname; - + GET_C_STRING_CTEXT_DATA_ALLOCA (color, extname); return XParseColor (dpy, @@ -257,18 +257,18 @@ Display *dpy; XFontStruct *xf; CONST char *extname; - + dpy = DEVICE_X_DISPLAY (XDEVICE (device)); GET_C_STRING_CTEXT_DATA_ALLOCA (f->name, extname); xf = XLoadQueryFont (dpy, extname); - + if (!xf) { maybe_signal_simple_error ("couldn't load font", f->name, Qfont, errb); return 0; } - + if (!xf->max_bounds.width) { /* yes, this has been known to happen. */ @@ -277,10 +277,10 @@ Qfont, errb); return 0; } - + /* Don't allocate the data until we're sure that we will succeed, or the finalize method may get fucked. */ - f->data = malloc_type (struct x_font_instance_data); + f->data = xnew (struct x_font_instance_data); FONT_INSTANCE_X_TRUENAME (f) = Qnil; FONT_INSTANCE_X_FONT (f) = xf; f->ascent = xf->ascent; @@ -310,7 +310,7 @@ } else f->width = xf->max_bounds.width; - + /* Some fonts have a default char whose width is 0. This is no good. If that's the case, first try 'n' as the default char, and if n has 0 width too (unlikely) then just use the max width. */ @@ -363,7 +363,7 @@ static void x_finalize_font_instance (struct Lisp_Font_Instance *f) { - + if (f->data) { if (DEVICE_LIVE_P (XDEVICE (f->device))) @@ -452,7 +452,7 @@ So this is yet another example of XListFonts() and XOpenFont() using completely different algorithms. This, however, is a goofier example of - this bug, because in this case, it's not just the search order that is + this bug, because in this case, it's not just the search order that is different -- the sets don't even intersect. If anyone has any better ideas how to do this, or any insights on what it is @@ -550,7 +550,7 @@ if (ok) { int L = strlen (composed_name) + 1; - result = xmalloc (L); + result = (char *) xmalloc (L); strncpy (result, composed_name, L); } else @@ -608,7 +608,7 @@ char *truename_FONT = 0; char *truename_random = 0; char *truename = 0; - + /* The search order is: - if FONT property exists, and is a valid name, return it. - if the other props exist, and add up to a valid name, return it. @@ -696,7 +696,7 @@ Lisp_Object result = Qnil; XFontProp *props; Display *dpy; - + dpy = DEVICE_X_DISPLAY (d); props = FONT_INSTANCE_X_FONT (f)->properties; for (i = FONT_INSTANCE_X_FONT (f)->n_properties - 1; i >= 0; i--) @@ -750,7 +750,7 @@ CONST char *patternext; GET_C_STRING_BINARY_DATA_ALLOCA (pattern, patternext); - + names = XListFonts (DEVICE_X_DISPLAY (XDEVICE (device)), patternext, MAX_FONT_COUNT, &count); while (count--) @@ -779,7 +779,7 @@ CONST Bufbyte *the_nonreloc = nonreloc; int i; Bytecount the_length = length; - + if (!the_nonreloc) the_nonreloc = XSTRING_DATA (reloc); fixup_internal_substring (nonreloc, reloc, offset, &the_length); @@ -788,7 +788,7 @@ { for (i = 0;; i++) { - CONST Bufbyte *new_nonreloc = + CONST Bufbyte *new_nonreloc = (CONST Bufbyte *) memchr (the_nonreloc, '-', the_length); if (!new_nonreloc) break; @@ -796,7 +796,7 @@ the_length -= new_nonreloc - the_nonreloc; the_nonreloc = new_nonreloc; } - + /* If it has less than 5 dashes, it's a short font. Of course, long fonts always have 14 dashes or so, but short fonts never have more than 1 or 2 dashes, so this is some @@ -805,7 +805,7 @@ return 1; } } - + return (fast_string_match (XCHARSET_REGISTRY (charset), nonreloc, reloc, offset, length, 1, ERROR_ME, 0) >= 0); @@ -824,7 +824,7 @@ int i; GET_C_STRING_BINARY_DATA_ALLOCA (font, patternext); - + names = XListFonts (DEVICE_X_DISPLAY (XDEVICE (device)), patternext, MAX_FONT_COUNT, &count); for (i = 0; i < count; i ++) @@ -912,7 +912,7 @@ Xatoms_of_objects_x (struct device *d) { Display *D = DEVICE_X_DISPLAY (d); - + DEVICE_XATOM_FOUNDRY (d) = XInternAtom (D, "FOUNDRY", False); DEVICE_XATOM_FAMILY_NAME (d) = XInternAtom (D, "FAMILY_NAME", False); DEVICE_XATOM_WEIGHT_NAME (d) = XInternAtom (D, "WEIGHT_NAME", False);
--- a/src/objects.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/objects.c Mon Aug 13 09:55:28 2007 +0200 @@ -43,7 +43,7 @@ finalose (void *ptr) { Lisp_Object obj; - XSETOBJ (obj, Lisp_Record, ptr); + XSETOBJ (obj, Lisp_Type_Record, ptr); signal_simple_error ("Can't dump an emacs containing window system objects", obj); @@ -158,8 +158,7 @@ CHECK_STRING (name); XSETDEVICE (device, decode_device (device)); - c = alloc_lcrecord (sizeof (struct Lisp_Color_Instance), - lrecord_color_instance); + c = alloc_lcrecord_type (struct Lisp_Color_Instance, lrecord_color_instance); c->name = name; c->device = device; @@ -336,8 +335,7 @@ XSETDEVICE (device, decode_device (device)); - f = alloc_lcrecord (sizeof (struct Lisp_Font_Instance), - lrecord_font_instance); + f = alloc_lcrecord_type (struct Lisp_Font_Instance, lrecord_font_instance); f->name = name; f->device = device; @@ -630,12 +628,12 @@ Valid instantiators for color specifiers are: --- a string naming a color (e.g. under X this might be \"lightseagreen2\" - or \"#F534B2\") +-- a string naming a color (e.g. under X this might be "lightseagreen2" + or "#F534B2") -- a color instance (use that instance directly if the device matches, or use the string that generated it) -- a vector of no elements (only on TTY's; this means to set no color - at all, thus using the \"natural\" color of the terminal's text) + at all, thus using the "natural" color of the terminal's text) -- a vector of one or two elements: a face to inherit from, and optionally a symbol naming which property of that face to inherit, either `foreground' or `background' (if omitted, defaults to the same @@ -841,12 +839,12 @@ Valid instantiators for font specifiers are: -- a string naming a font (e.g. under X this might be - \"-*-courier-medium-r-*-*-*-140-*-*-*-*-iso8859-*\" for a 14-point + "-*-courier-medium-r-*-*-*-140-*-*-*-*-iso8859-*" for a 14-point upright medium-weight Courier font) -- a font instance (use that instance directly if the device matches, or use the string that generated it) -- a vector of no elements (only on TTY's; this means to set no font - at all, thus using the \"natural\" font of the terminal's text) + at all, thus using the "natural" font of the terminal's text) -- a vector of one element (a face to inherit from) */ (object)) @@ -1071,10 +1069,8 @@ { staticpro (&Vthe_null_color_instance); { - struct Lisp_Color_Instance *c; - - c = alloc_lcrecord (sizeof (struct Lisp_Color_Instance), - lrecord_color_instance); + struct Lisp_Color_Instance *c = + alloc_lcrecord_type (struct Lisp_Color_Instance, lrecord_color_instance); c->name = Qnil; c->device = Qnil; c->data = 0; @@ -1084,10 +1080,8 @@ staticpro (&Vthe_null_font_instance); { - struct Lisp_Font_Instance *f; - - f = alloc_lcrecord (sizeof (struct Lisp_Font_Instance), - lrecord_font_instance); + struct Lisp_Font_Instance *f = + alloc_lcrecord_type (struct Lisp_Font_Instance, lrecord_font_instance); f->name = Qnil; f->device = Qnil; f->data = 0;
--- a/src/opaque.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/opaque.c Mon Aug 13 09:55:28 2007 +0200 @@ -107,8 +107,8 @@ Lisp_Object make_opaque (int size, CONST void *data) { - struct Lisp_Opaque *p = alloc_lcrecord (sizeof (*p) + size - sizeof (int), - lrecord_opaque); + struct Lisp_Opaque *p = (struct Lisp_Opaque *) + alloc_lcrecord (sizeof (*p) + size - sizeof (int), lrecord_opaque); Lisp_Object val; p->markfun = 0; @@ -140,9 +140,9 @@ Lisp_Object (*markfun) (Lisp_Object obj, void (*markobj) (Lisp_Object))) { - struct Lisp_Opaque_List *p = alloc_lcrecord (sizeof (*p), - lrecord_opaque_list); Lisp_Object val = Qnil; + struct Lisp_Opaque_List *p = + alloc_lcrecord_type (struct Lisp_Opaque_List, lrecord_opaque_list); p->markfun = markfun; p->size = size;
--- a/src/prefix-args.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/prefix-args.c Mon Aug 13 09:55:28 2007 +0200 @@ -29,7 +29,7 @@ #include <stdio.h> #include <stdlib.h> -void +int main (int argc, char **argv) { char *progname; @@ -51,5 +51,5 @@ for (; argc > 0; argc--, argv++) printf ("%s %s%c", prefix, argv[0], (argc > 1) ? ' ' : '\n'); - exit (0); + return 0; }
--- a/src/print.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/print.c Mon Aug 13 09:55:28 2007 +0200 @@ -928,14 +928,14 @@ switch (XTYPE (obj)) { - case Lisp_Int: + case Lisp_Type_Int: { sprintf (buf, "%ld", (long) XINT (obj)); write_c_string (buf, printcharfun); break; } - case Lisp_Char: + case Lisp_Type_Char: { /* God intended that this be #\..., you know. */ Emchar ch = XCHAR (obj); @@ -974,7 +974,7 @@ break; } - case Lisp_String: + case Lisp_Type_String: { Bytecount size = XSTRING_LENGTH (obj); struct gcpro gcpro1, gcpro2; @@ -1041,7 +1041,7 @@ break; } - case Lisp_Cons: + case Lisp_Type_Cons: { struct gcpro gcpro1, gcpro2; @@ -1104,7 +1104,7 @@ } #ifndef LRECORD_VECTOR - case Lisp_Vector: + case Lisp_Type_Vector: { /* If deeper than spec'd depth, print placeholder. */ if (INTP (Vprint_level) @@ -1121,14 +1121,14 @@ #endif /* !LRECORD_VECTOR */ #ifndef LRECORD_SYMBOL - case Lisp_Symbol: + case Lisp_Type_Symbol: { print_symbol (obj, printcharfun, escapeflag); break; } #endif /* !LRECORD_SYMBOL */ - case Lisp_Record: + case Lisp_Type_Record: { struct lrecord_header *lheader = XRECORD_LHEADER (obj); struct gcpro gcpro1, gcpro2; @@ -1640,8 +1640,8 @@ After that comes an integer precision specification, and then a letter which controls the format. The letters allowed are `e', `f' and `g'. -Use `e' for exponential notation \"DIG.DIGITSeEXPT\" -Use `f' for decimal point notation \"DIGITS.DIGITS\". +Use `e' for exponential notation "DIG.DIGITSeEXPT" +Use `f' for decimal point notation "DIGITS.DIGITS". Use `g' to choose the shorter of those two formats for the number at hand. The precision in any of these cases is the number of digits following the decimal point. With `f', a precision of 0 means to omit the @@ -1697,7 +1697,7 @@ those which were made with `make-symbol' or by calling `intern' with a second argument. -When print-gensym is true, such symbols will be preceded by \"#:\", which +When print-gensym is true, such symbols will be preceded by "#:", which causes the reader to create a new symbol instead of interning and returning an existing one. Beware: the #: syntax creates a new symbol each time it is seen, so if you print an object which contains two pointers to the same
--- a/src/process.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/process.c Mon Aug 13 09:55:28 2007 +0200 @@ -223,11 +223,11 @@ print_process (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { struct Lisp_Process *proc = XPROCESS (obj); - + if (print_readably) error ("printing unreadable object #<process %s>", XSTRING_DATA (proc->name)); - + if (!escapeflag) { print_internal (proc->name, printcharfun, 0); @@ -541,8 +541,8 @@ { Lisp_Object val, name1; int i; - struct Lisp_Process *p - = alloc_lcrecord (sizeof (struct Lisp_Process), lrecord_process); + struct Lisp_Process *p = + alloc_lcrecord_type (struct Lisp_Process, lrecord_process); /* If name is already in use, modify it until it is unused. */ name1 = name; @@ -550,7 +550,7 @@ { char suffix[10]; Lisp_Object tem = Fget_process (name1); - if (NILP (tem)) + if (NILP (tem)) break; sprintf (suffix, "<%d>", i); name1 = concat2 (name, build_string (suffix)); @@ -707,11 +707,11 @@ get_eof_char (struct Lisp_Process *p) { /* Figure out the eof character for the outfd of the given process. - * The following code is similar to that in process_send_signal, and + * The following code is similar to that in process_send_signal, and * should probably be merged with that code somehow. */ CONST Bufbyte ctrl_d = (Bufbyte) '\004'; - + if (!isatty (p->outfd)) return ctrl_d; #ifdef HAVE_TERMIOS @@ -749,7 +749,7 @@ return (Bufbyte) t.c_cc[VINTR]; } #else /* ! defined (TCGETA) */ - /* Rather than complain, we'll just guess ^D, which is what + /* Rather than complain, we'll just guess ^D, which is what * earlier emacsen always used. */ return ctrl_d; #endif /* ! defined (TCGETA) */ @@ -807,7 +807,7 @@ } static void -create_process (Lisp_Object process, +create_process (Lisp_Object process, char **new_argv, CONST char *current_dir) { /* This function rewritten by wing@666.com. */ @@ -959,11 +959,11 @@ /* Miscellaneous setup required for some systems. Must be done before using tc* functions on xforkin. This guarantees that isatty(xforkin) is true. */ - + # ifdef SETUP_SLAVE_PTY SETUP_SLAVE_PTY; # endif /* SETUP_SLAVE_PTY */ - + # ifdef TIOCSCTTY /* We ignore the return value because faith@cs.unc.edu says that is necessary on Linux. */ @@ -1022,7 +1022,7 @@ #ifdef WINDOWSNT pid = child_setup (xforkin, xforkout, xforkout, new_argv, current_dir); -#else /* not WINDOWSNT */ +#else /* not WINDOWSNT */ child_setup (xforkin, xforkout, xforkout, new_argv, current_dir); #endif /* not WINDOWSNT */ #endif /* not MSDOS */ @@ -1207,7 +1207,7 @@ } /* Nothing below here GCs so our string pointers shouldn't move. */ - new_argv = (char **) alloca ((nargs - 1) * sizeof (char *)); + new_argv = alloca_array (char *, nargs - 1); new_argv[0] = (char *) XSTRING_DATA (program); for (i = 3; i < nargs; i++) { @@ -1411,7 +1411,7 @@ address.sin_port = port; s = socket (address.sin_family, SOCK_STREAM, 0); - if (s < 0) + if (s < 0) report_file_error ("error creating socket", list1 (name)); /* Turn off interrupts here -- see comments below. There used to @@ -1894,7 +1894,7 @@ list1 (proc)); while (filedesc_stream_was_blocked (XLSTREAM (p->filedesc_stream))) { - /* Buffer is full. Wait, accepting input; + /* Buffer is full. Wait, accepting input; that may allow the program to finish doing output and read more. */ Faccept_process_output (Qnil, make_int (1), Qnil); @@ -1925,6 +1925,7 @@ } Lstream_flush (XLSTREAM (p->outstream)); UNGCPRO; + Lstream_delete (XLSTREAM (lstream)); } DEFUN ("process-tty-name", Fprocess_tty_name, 1, 1, 0, /* @@ -2314,7 +2315,7 @@ p->tick++; process_tick++; update_status_from_wait_code (p, &w); - + /* If process has terminated, stop waiting for its output. */ if (WIFSIGNALED (w) || WIFEXITED (w)) { @@ -2348,7 +2349,7 @@ } exited_processes_index = 0; - + EMACS_UNBLOCK_SIGNAL (SIGCHLD); } @@ -2381,9 +2382,9 @@ { int pid; int w; - + /* Keep trying to get a status until we get a definitive result. */ - do + do { errno = 0; #ifdef WNOHANG @@ -2400,17 +2401,17 @@ #endif /* not WNOHANG */ } while (pid <= 0 && errno == EINTR); - + if (pid <= 0) break; - + if (exited_processes_index < MAX_EXITED_PROCESSES) { exited_processes[exited_processes_index] = pid; exited_processes_status[exited_processes_index] = w; exited_processes_index++; } - + /* On systems with WNOHANG, we just ignore the number of times that SIGCHLD was signalled, and keep looping until there are no more processes to wait on. If we @@ -2435,7 +2436,7 @@ and the signal-catching function will be continually reentered until the queue is empty". Invoking signal() causes the kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems Inc. - + (Note that now this only applies in SYS V Release 2 and before. On SYS V Release 3, we use sigset() to set the signal handler for the first time, and so we don't have to reestablish the signal handler @@ -2464,7 +2465,7 @@ /* Return a string describing a process status list. */ -static Lisp_Object +static Lisp_Object status_message (struct Lisp_Process *p) { Lisp_Object symbol = p->status_symbol; @@ -2593,7 +2594,7 @@ /* If process is terminated, deactivate it or delete it. */ symbol = p->status_symbol; - if (EQ (symbol, Qsignal) + if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)) { if (delete_exited_processes) @@ -2835,7 +2836,7 @@ } #endif /* ! defined (SIGNALS_VIA_CHARACTERS) */ -#ifdef TIOCGPGRP +#ifdef TIOCGPGRP /* Get the pgrp using the tty itself, if we have that. Otherwise, use the pty to get the pgrp. On pfa systems, saka@pfu.fujitsu.co.JP writes: @@ -3201,7 +3202,7 @@ #ifdef VMS { VMS_PROC_STUFF *get_vms_process_pointer (), *vs; - if (outchannel >= 0) + if (outchannel >= 0) sys$dassgn (outchannel); vs = get_vms_process_pointer (XINT (p->pid)); if (vs) @@ -3369,7 +3370,7 @@ defsymbol (&Qstop, "stop"); defsymbol (&Qsignal, "signal"); /* Qexit is already defined by syms_of_eval - * defsymbol (&Qexit, "exit"); + * defsymbol (&Qexit, "exit"); */ defsymbol (&Qopen, "open"); defsymbol (&Qclosed, "closed");
--- a/src/process.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/process.h Mon Aug 13 09:55:28 2007 +0200 @@ -56,7 +56,7 @@ Lisp_Object Fget_buffer_process (Lisp_Object name); Lisp_Object Fprocessp (Lisp_Object object); Lisp_Object Fprocess_status (Lisp_Object process); -Lisp_Object Fkill_process (Lisp_Object process, +Lisp_Object Fkill_process (Lisp_Object process, Lisp_Object current_group); Lisp_Object Fdelete_process (Lisp_Object process); Lisp_Object Fopen_network_stream_internal (Lisp_Object name, @@ -125,7 +125,7 @@ #else void #endif -child_setup (int in, int out, int err, +child_setup (int in, int out, int err, char **new_argv, CONST char *current_dir); Charcount read_process_output (Lisp_Object proc);
--- a/src/profile.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/profile.c Mon Aug 13 09:55:28 2007 +0200 @@ -104,11 +104,11 @@ /* #### see comment about memory allocation in start-profiling. Allocating memory in a signal handler is BAD BAD BAD. If you are using the non-mmap rel-alloc code, you might - lose because of this. Even worse, if the memory allocation + lose because of this. Even worse, if the memory allocation fails, the `error' generated whacks everything hard. */ long count; CONST void *vval; - + if (gethash (LISP_TO_VOID (fun), big_profile_table, &vval)) count = (long) vval; else @@ -117,7 +117,7 @@ vval = (CONST void *) count; puthash (LISP_TO_VOID (fun), (void *) vval, big_profile_table); } - + inside_profiling = 0; } } @@ -187,7 +187,7 @@ static Lisp_Object profile_lock_unwind (Lisp_Object ignore) { - inside_profiling = 0; + inside_profiling = 0; return Qnil; } @@ -203,14 +203,14 @@ { /* This function does not GC */ Lisp_Object key; - struct get_profiling_info_closure *closure = void_closure; + struct get_profiling_info_closure *closure + = (struct get_profiling_info_closure *) void_closure; EMACS_INT val; CVOID_TO_LISP (key, void_key); val = (EMACS_INT) void_val; - closure->accum = Fcons (Fcons (key, make_int (val)), - closure->accum); + closure->accum = Fcons (Fcons (key, make_int (val)), closure->accum); } DEFUN ("get-profiling-info", Fget_profiling_info, 0, 0, 0, /* @@ -244,10 +244,9 @@ void *void_closure) { Lisp_Object key; - struct mark_profiling_info_closure *closure = void_closure; CVOID_TO_LISP (key, void_key); - (closure->markfun) (key); + (((struct mark_profiling_info_closure *) void_closure)->markfun) (key); } void
--- a/src/puresize.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/puresize.h Mon Aug 13 09:55:28 2007 +0200 @@ -37,7 +37,7 @@ # define BASE_PURESIZE 938000 #else # define BASE_PURESIZE 563000 -#endif +#endif */ #define BASE_PURESIZE 1400000 @@ -169,7 +169,7 @@ (TOOLTALK_PURESIZE_EXTRA) + \ (ENERGIZE_PURESIZE_EXTRA) + \ (SUNPRO_PURESIZE_EXTRA)) - + #endif /* !RAW_PURESIZE */ extern long int get_PURESIZE(void);
--- a/src/ralloc.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/ralloc.c Mon Aug 13 09:55:28 2007 +0200 @@ -1,4 +1,4 @@ -/* Block-relocating memory allocator. +/* Block-relocating memory allocator. Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc. This file is part of XEmacs. @@ -97,7 +97,7 @@ /* This is the size of a page. We round memory requests to this boundary. */ static int page_size; -/* Whenever we get memory from the system, get this many extra bytes. This +/* Whenever we get memory from the system, get this many extra bytes. This must be a multiple of page_size. */ static int extra_bytes; @@ -164,7 +164,7 @@ break_value -= size; new_page_break = (POINTER) ROUNDUP (break_value); excess = (char *) page_break_value - (char *) new_page_break; - + if (excess > extra_bytes * 2) { /* Keep extra_bytes worth of empty space. @@ -273,7 +273,7 @@ SIZE offset = address - bloc->data; SIZE data_size = 0; bloc_ptr b; - + for (b = bloc; b != NIL_BLOC; b = b->next) { data_size += b->size; @@ -331,7 +331,7 @@ __morecore hook values - in particular, __default_morecore in the GNU malloc package. */ -POINTER +POINTER r_alloc_sbrk (long size) { /* This is the first address not currently available for the heap. */ @@ -510,7 +510,7 @@ } #else /* HAVE_MMAP */ -/* +/* A relocating allocator built using the mmap(2) facility available in some OSes. Based on another version written by Paul Flinders, from which code (and comments) are snarfed. @@ -523,7 +523,7 @@ Unfortunately, such a scheme doesn't work for certain systems like HP-UX that have a system-wide virtual->real address map, and consequently impose restrictions on the virtual address values - permitted. + permitted. NB: The mapping scheme in HP-UX is motivated by the inverted page table design in some HP processors. @@ -720,7 +720,7 @@ UNDERLYING_FREE( h ); /* Free the sole item */ mmap_start = 0; return; } - else if (h == mmap_start) + else if (h == mmap_start) { mmap_start = nex; /* Make sure mmap_start isn't bogus. */ } @@ -745,7 +745,7 @@ init_MHASH_table (void) { int i = 0; - for (; i < MHASH_PRIME; i++) + for (; i < MHASH_PRIME; i++) { MHASH_HITS[i].n_hits = 0; MHASH_HITS[i].addr = 0; @@ -762,7 +762,7 @@ #else unsigned int addr_shift = (unsigned int)(addr) >> USELESS_LOWER_ADDRESS_BITS; #endif - int hval = addr_shift % MHASH_PRIME; /* We could have addresses which are -ve + int hval = addr_shift % MHASH_PRIME; /* We could have addresses which are -ve when converted to signed ints */ return ((hval >= 0) ? hval : MHASH_PRIME + hval); } @@ -834,10 +834,10 @@ DEFUN ("mmap-allocator-status", Fmmap_allocator_status, 0, 0, 0, /* Return some information about mmap-based allocator. - mmap-addrlist-size: number of entries in address picking list. - mmap-times-mapped: number of times r_alloc was called. - mmap-pages-mapped: number of pages mapped by r_alloc calls only. - mmap-times-unmapped: number of times r_free was called. + mmap-addrlist-size: number of entries in address picking list. + mmap-times-mapped: number of times r_alloc was called. + mmap-pages-mapped: number of pages mapped by r_alloc calls only. + mmap-times-unmapped: number of times r_free was called. mmap-times-remapped: number of times r_re_alloc was called. mmap-didnt-copy: number of times re-alloc didn\'t have to move the block. mmap-pages-copied: total number of pages copied. @@ -868,7 +868,7 @@ #else /* !MMAP_METERING */ -#define MEMMETER(x) +#define MEMMETER(x) #define MVAL(x) #endif /* MMAP_METERING */ @@ -885,8 +885,8 @@ return 0; case 1: - if (*alias == MHASH_HITS[kval].addr) - { + if (*alias == MHASH_HITS[kval].addr) + { MEMMETER( MVAL( M_Hash_Worked) ++ ); return MHASH_HITS[kval].handle; } @@ -896,7 +896,7 @@ } /* switch */ } -/* +/* Some kernels don't like being asked to pick addresses for mapping themselves---IRIX is known to become extremely slow if mmap is passed a ZERO as the first argument. In such cases, we use an @@ -946,7 +946,7 @@ /* Start off the address block chain with a humongous address block which is empty to start with. Note that addr_chain is invariant WRT the addition/deletion of address blocks because of the assert - in Coalesce() and the strict ordering of blocks by their address + in Coalesce() and the strict ordering of blocks by their address */ static void Addr_Block_initialize() { @@ -973,8 +973,8 @@ if (p->flag == occupied) break; /* No cigar */ /* Check if the addresses are contiguous. */ - if (p->addr + p->sz != np->addr) break; - + if (p->addr + p->sz != np->addr) break; + MEMMETER( MVAL( M_Addrlist_Size )--) /* We can coalesce these two. */ p->sz += np->sz; @@ -1002,7 +1002,7 @@ remainder->sz = p->sz - sz; MEMMETER( MVAL( M_Addrlist_Size )++) - + /* Now make p become an occupied block with the appropriate size */ p->next = remainder; p->sz = sz; @@ -1036,7 +1036,7 @@ break; } } - if (!p) abort(); /* Can't happen... we've got a block to free which is not in + if (!p) abort(); /* Can't happen... we've got a block to free which is not in the address list. */ Coalesce_Addr_Blocks(); } @@ -1051,13 +1051,13 @@ static VM_ADDR New_Addr_Block( SIZE sz ) { - return mmap( 0, sz, PROT_READ|PROT_WRITE, MAP_FLAGS, + return mmap (0, sz, PROT_READ|PROT_WRITE, MAP_FLAGS, DEV_ZERO_FD, 0 ); } static void Free_Addr_Block( VM_ADDR addr, SIZE sz ) { - munmap( addr, sz ); + munmap ((caddr_t) addr, sz ); } #endif /* MMAP_GENERATE_ADDRESSES */ @@ -1067,7 +1067,7 @@ /* r_alloc( POINTER, SIZE ): Allocate a relocatable area with the start - address aliased to the first parameter. + address aliased to the first parameter. */ POINTER r_alloc (POINTER *ptr, SIZE size); @@ -1075,7 +1075,7 @@ r_alloc (POINTER *ptr, SIZE size) { MMAP_HANDLE mh; - + switch(r_alloc_initialized) { case 0: @@ -1102,7 +1102,7 @@ MHASH_ADD( mh->vm_addr, mh ); mh->space_for = mmapped_size; mh->aliased_address = ptr; - *ptr = mh->vm_addr; + *ptr = (POINTER) mh->vm_addr; } else *ptr = 0; /* Malloc of block failed */ @@ -1196,16 +1196,16 @@ { /* Also, if a shrinkage was asked for. */ MEMMETER( MVAL(M_Didnt_Copy)++ ) MEMMETER( MVAL(M_Wastage) -= (sz - h->size)) - /* We're pretty dumb at handling shrinkage. We should check for + /* We're pretty dumb at handling shrinkage. We should check for a larger gap than the standard hysteresis allowable, and if so, shrink the number of pages. Right now, we simply reset the size component and return. */ h->size = sz; return *ptr; } - + new_vm_addr = New_Addr_Block( actual_sz ); - if (new_vm_addr == VM_FAILURE_ADDR) + if (new_vm_addr == VM_FAILURE_ADDR) {/* Failed to realloc. */ /* *ptr = 0; */ return 0; @@ -1229,7 +1229,7 @@ h->size = sz; /* New (requested) size */ h->vm_addr = new_vm_addr; /* New VM start address */ h->aliased_address = ptr; /* Change alias to reflect block relocation. */ - *ptr = h->vm_addr; + *ptr = (POINTER) h->vm_addr; return *ptr; } } @@ -1291,11 +1291,11 @@ { DEFVAR_INT ("mmap-hysteresis", &mmap_hysteresis /* Extra room left at the end of an allocated arena, -so that a re-alloc requesting extra space smaller than this +so that a re-alloc requesting extra space smaller than this does not actually cause a new arena to be allocated. -A negative value is considered equal to zero. This is the -minimum amount of space guaranteed to be left at the end of +A negative value is considered equal to zero. This is the +minimum amount of space guaranteed to be left at the end of the arena. Because allocation happens in multiples of the OS page size, it is possible for more space to be left unused. */ );
--- a/src/rangetab.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/rangetab.c Mon Aug 13 09:55:28 2007 +0200 @@ -26,6 +26,7 @@ #include <config.h> #include "lisp.h" +typedef struct range_table_entry range_table_entry; struct range_table_entry { EMACS_INT first; @@ -33,9 +34,9 @@ Lisp_Object val; }; -typedef struct range_table_entry_dynarr_type +typedef struct { - Dynarr_declare (struct range_table_entry); + Dynarr_declare (range_table_entry); } range_table_entry_dynarr; struct Lisp_Range_Table @@ -117,7 +118,7 @@ if (Dynarr_length (rt1->entries) != Dynarr_length (rt2->entries)) return 0; - + for (i = 0; i < Dynarr_length (rt1->entries); i++) { struct range_table_entry *rte1 = Dynarr_atp (rt1->entries, i); @@ -155,7 +156,7 @@ depth)); return hash; } - + /* just pick five elements scattered throughout the array. A slightly better approach would be to offset by some noise factor from the points chosen below. */ @@ -202,7 +203,7 @@ Lisp_Object default_) { int left = 0, right = nentries; - + /* binary search for the entry. Based on similar code in extent_list_locate(). */ while (left != right) @@ -237,12 +238,10 @@ */ ()) { - struct Lisp_Range_Table *rt; Lisp_Object obj; - - rt = (struct Lisp_Range_Table *) - alloc_lcrecord (sizeof (struct Lisp_Range_Table), lrecord_range_table); - rt->entries = Dynarr_new (struct range_table_entry); + struct Lisp_Range_Table *rt = alloc_lcrecord_type (struct Lisp_Range_Table, + lrecord_range_table); + rt->entries = Dynarr_new (range_table_entry); XSETRANGE_TABLE (obj, rt); return obj; } @@ -258,9 +257,9 @@ CHECK_RANGE_TABLE (old_table); rt = XRANGE_TABLE (old_table); - rtnew = (struct Lisp_Range_Table *) - alloc_lcrecord (sizeof (struct Lisp_Range_Table), lrecord_range_table); - rtnew->entries = Dynarr_new (struct range_table_entry); + + rtnew = alloc_lcrecord_type (struct Lisp_Range_Table, lrecord_range_table); + rtnew->entries = Dynarr_new (range_table_entry); Dynarr_add_many (rtnew->entries, Dynarr_atp (rt->entries, 0), Dynarr_length (rt->entries)); @@ -331,12 +330,12 @@ [ NEW ] [ EXISTING ] - + */ /* need to split this one in two. */ { struct range_table_entry insert_me_too; - + insert_me_too.first = last + 1; insert_me_too.last = entry->last; insert_me_too.val = entry->val; @@ -346,7 +345,7 @@ else if (entry->last > last) { /* looks like: - + [ NEW ] [ EXISTING ] @@ -365,15 +364,15 @@ /* Someone asked us to delete the range, not insert it. */ if (UNBOUNDP (val)) return; - + /* Now insert the new entry, maybe at the end. */ - + if (insert_me_here < 0) insert_me_here = i; { struct range_table_entry insert_me; - + insert_me.first = first; insert_me.last = last; insert_me.val = val; @@ -383,7 +382,7 @@ /* Now see if we can combine this entry with adjacent ones just before or after. */ - + if (insert_me_here > 0) { struct range_table_entry *entry = Dynarr_atp (rt->entries, @@ -500,7 +499,7 @@ { Lisp_Object range = Fcar (data); Lisp_Object val = Fcar (Fcdr (data)); - + data = Fcdr (Fcdr (data)); if (CONSP (range)) Fput_range_table (Fcar (range), Fcar (Fcdr (range)), val, @@ -556,7 +555,7 @@ -- look up a value -- retrieve all the ranges in an iterative fashion - + */ /* The format of a unified range table is as follows: @@ -579,7 +578,7 @@ int nentries; struct range_table_entry first; }; - + /* Return size in bytes needed to store the data in a range table. */ int @@ -632,7 +631,7 @@ + ((* ((unsigned char *) unrangetab + 3)) << 16)); } -/* Make sure the table is aligned, and move it around if it's not. */ +/* Make sure the table is aligned, and move it around if it's not. */ static void align_the_damn_table (void *unrangetab) { @@ -653,7 +652,7 @@ * (char *) unrangetab = (char) ((char *) new_dest - (char *) unrangetab); } } - + /* Look up a value in a unified range table. */ Lisp_Object
--- a/src/redisplay-output.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/redisplay-output.c Mon Aug 13 09:55:28 2007 +0200 @@ -102,7 +102,7 @@ if (line >= Dynarr_largest (cdla)) { clp = &dl; - clp->display_blocks = Dynarr_new (struct display_block); + clp->display_blocks = Dynarr_new (display_block); } else { @@ -144,7 +144,7 @@ { cdb = &db; memcpy (cdb, ddb, sizeof (struct display_block)); - cdb->runes = Dynarr_new (struct rune); + cdb->runes = Dynarr_new (rune); Dynarr_add (clp->display_blocks, *cdb); } else @@ -869,7 +869,7 @@ { rb->cursor_type = CURSOR_ON; dl->cursor_elt = cur_rb; - + output_display_line (w, 0, cla, cur_dl, rb->xpos, rb->xpos + rb->width); @@ -989,7 +989,7 @@ } if (window_is_rightmost (w)) width += FRAME_BORDER_WIDTH (f); - + y = FRAME_TOP_BORDER_START (f) - 1; height = FRAME_BORDER_HEIGHT (f) + 1;
--- a/src/redisplay-tty.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/redisplay-tty.c Mon Aug 13 09:55:28 2007 +0200 @@ -53,11 +53,17 @@ invoking them correctly. */ /* # include <curses.h> */ /* # include <term.h> */ +#ifdef __cplusplus +extern "C" { +#endif extern int tgetent (CONST char *, CONST char *); extern int tgetflag (CONST char *); extern int tgetnum (CONST char *); extern char *tgetstr (CONST char *, char **); extern void tputs (CONST char *, int, void (*)(int)); +#ifdef __cplusplus +} +#endif #define FORCE_CURSOR_UPDATE(c) send_string_to_tty_console (c, 0, 0) #define OUTPUTN(c, a, n) \ do { \ @@ -77,7 +83,7 @@ static void tty_output_emchar_dynarr (struct window *w, struct display_line *dl, - emchar_dynarr *buf, int xpos, + Emchar_dynarr *buf, int xpos, face_index findex, int cursor); static void tty_output_bufbyte_string (struct window *w, @@ -194,7 +200,7 @@ int cursor_height) { struct frame *f = XFRAME (w->frame); - emchar_dynarr *buf = Dynarr_new (Emchar); + Emchar_dynarr *buf = Dynarr_new (Emchar); struct display_block *db = Dynarr_atp (dl->display_blocks, block); rune_dynarr *rba = db->runes; @@ -370,7 +376,7 @@ tty_output_bufbyte_string (w, dl, temptemp, len, xpos, findex, 0); - + if (xpos >= cursor_start && (cursor_start < xpos + (bufbyte_string_displayed_columns @@ -580,7 +586,7 @@ tty_turn_off_face (w, findex); } -static bufbyte_dynarr *tty_output_emchar_dynarr_dynarr; +static Bufbyte_dynarr *tty_output_emchar_dynarr_dynarr; /***************************************************************************** tty_output_emchar_dynarr @@ -590,7 +596,7 @@ ****************************************************************************/ static void tty_output_emchar_dynarr (struct window *w, struct display_line *dl, - emchar_dynarr *buf, int xpos, face_index findex, + Emchar_dynarr *buf, int xpos, face_index findex, int cursor) { if (!tty_output_emchar_dynarr_dynarr) @@ -610,7 +616,7 @@ #if 0 -static bufbyte_dynarr *sidcs_dynarr; +static Bufbyte_dynarr *sidcs_dynarr; static void substitute_in_dynamic_color_string (Lisp_Object spec, Lisp_Object string) @@ -775,7 +781,7 @@ struct frame *f = XFRAME (w->frame); struct console *c = XCONSOLE (FRAME_CONSOLE (f)); - tty_turn_on_face_1 (c, + tty_turn_on_face_1 (c, WINDOW_FACE_CACHEL_HIGHLIGHT_P (w, findex), WINDOW_FACE_CACHEL_BLINKING_P (w, findex), WINDOW_FACE_CACHEL_DIM_P (w, findex), @@ -838,9 +844,9 @@ { Lisp_Object frame = Qnil; struct console *c = XCONSOLE (FRAME_CONSOLE (f)); - + XSETFRAME (frame, f); - tty_turn_on_face_1 (c, + tty_turn_on_face_1 (c, FACE_HIGHLIGHT_P (face, frame), FACE_BLINKING_P (face, frame), FACE_DIM_P (face, frame), @@ -1094,7 +1100,7 @@ doing this after all the tgetstr()s and adjusting all the pointers. */ CONSOLE_TTY_DATA (c)->term_entry_buffer = (char *) xmalloc (2044); - bufptr = CONSOLE_TTY_DATA (c)->term_entry_buffer; + bufptr = CONSOLE_TTY_DATA (c)->term_entry_buffer; EMACS_BLOCK_SIGNAL (SIGTTOU); status = tgetent (entry_buffer, terminal_type); @@ -1241,10 +1247,10 @@ if (TTY_FLAGS (c).underline_width == -1) TTY_FLAGS (c).underline_width = 0; - TTY_FLAGS (c).meta_key = + TTY_FLAGS (c).meta_key = eight_bit_tty (d) ? tgetflag ("km") || tgetflag ("MT") ? 1 : 2 : 0; - - + + /* * Setup the costs tables for this tty console. */ @@ -1274,7 +1280,9 @@ color, too. */ char foobuf[500]; char *fooptr = foobuf; - if (tgetstr ("AB", &fooptr) && tgetstr ("AF", &fooptr)) + if ((tgetstr ("AB", &fooptr) && tgetstr ("AF", &fooptr)) || + (tgetstr ("Sf", &fooptr) && tgetstr ("Sb", &fooptr)) || + ((tgetnum ("Co") > 0) && (tgetnum ("pa") > 0))) DEVICE_CLASS (d) = Qcolor; else DEVICE_CLASS (d) = Qmono; @@ -1378,7 +1386,7 @@ static Lisp_Object term_get_fkeys_error (Lisp_Object err, Lisp_Object arg); /* Find the escape codes sent by the function keys for Vfunction_key_map. - This function scans the termcap function key sequence entries, and + This function scans the termcap function key sequence entries, and adds entries to Vfunction_key_map for each function key it finds. */ static void @@ -1483,7 +1491,7 @@ build_string (sequence), \ vector1 (intern (sym))); \ } - + /* if there's no key_next keycap, map key_npage to `next' keysym */ CONDITIONAL_REASSIGN ("%5", "kN", "next"); /* if there's no key_prev keycap, map key_ppage to `previous' keysym */
--- a/src/redisplay-x.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/redisplay-x.c Mon Aug 13 09:55:28 2007 +0200 @@ -263,8 +263,7 @@ { int width_so_far = 0; unsigned char *text_storage = (unsigned char *) alloca (2 * len); - struct textual_run *runs = - (struct textual_run *) alloca (len * sizeof (struct textual_run)); + struct textual_run *runs = alloca_array (struct textual_run, len); int nruns; int i; @@ -349,7 +348,7 @@ int cursor_width, int cursor_height) { struct frame *f = XFRAME (w->frame); - emchar_dynarr *buf = Dynarr_new (Emchar); + Emchar_dynarr *buf = Dynarr_new (Emchar); Lisp_Object window; struct display_block *db = Dynarr_atp (dl->display_blocks, block); @@ -778,7 +777,7 @@ ****************************************************************************/ void x_output_string (struct window *w, struct display_line *dl, - emchar_dynarr *buf, int xpos, int xoffset, int clip_start, + Emchar_dynarr *buf, int xpos, int xoffset, int clip_start, int width, face_index findex, int cursor, int cursor_start, int cursor_width, int cursor_height) { @@ -804,8 +803,8 @@ GC bgc, gc; int height; int len = Dynarr_length (buf); - unsigned char *text_storage = alloca (2 * len); - struct textual_run *runs = alloca (len * sizeof (struct textual_run)); + unsigned char *text_storage = (unsigned char *) alloca (2 * len); + struct textual_run *runs = alloca_array (struct textual_run, len); int nruns; int i; struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, findex); @@ -1707,16 +1706,16 @@ XColor topc, botc; int top_frobbed = 0, bottom_frobbed = 0; - /* If the top shadow is the same color as the background, try and + /* If the top shadow is the same color as the background, try to adjust it. */ if (*top_shadow == background) { topc.pixel = background; XQueryColor (dpy, cmap, &topc); /* don't overflow/wrap! */ - topc.red = MINL (65535, topc.red * 1.2); - topc.green = MINL (65535, topc.green * 1.2); - topc.blue = MINL (65535, topc.blue * 1.2); + topc.red = MINL (65535, (unsigned long) topc.red * 6 / 5); + topc.green = MINL (65535, (unsigned long) topc.green * 6 / 5); + topc.blue = MINL (65535, (unsigned long) topc.blue * 6 / 5); if (allocate_nearest_color (dpy, cmap, &topc)) { *top_shadow = topc.pixel; @@ -1724,15 +1723,15 @@ } } - /* If the bottom shadow is the same color as the background, try and + /* If the bottom shadow is the same color as the background, try to adjust it. */ if (*bottom_shadow == background) { botc.pixel = background; XQueryColor (dpy, cmap, &botc); - botc.red *= 0.6; - botc.green *= 0.6; - botc.blue *= 0.6; + botc.red = (unsigned short) ((unsigned long) botc.red * 3 / 5); + botc.green = (unsigned short) ((unsigned long) botc.green * 3 / 5); + botc.blue = (unsigned short) ((unsigned long) botc.blue * 3 / 5); if (allocate_nearest_color (dpy, cmap, &botc)) { *bottom_shadow = botc.pixel;
--- a/src/redisplay.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/redisplay.c Mon Aug 13 09:55:28 2007 +0200 @@ -192,6 +192,7 @@ #### It's unclean that both Emchars and Bufbytes are here. */ +typedef struct prop_block prop_block; struct prop_block { enum prop_type type; @@ -219,9 +220,9 @@ } data; }; -typedef struct prop_block_dynarr_type +typedef struct { - Dynarr_declare (struct prop_block); + Dynarr_declare (prop_block); } prop_block_dynarr; @@ -284,8 +285,8 @@ struct display_line *dl); static void regenerate_window (struct window *w, Bufpos start_pos, Bufpos point, int type); -static void regenerate_window_point_center (struct window *w, Bufpos point, - int type); +static Bufpos regenerate_window_point_center (struct window *w, Bufpos point, + int type); int window_half_pixpos (struct window *w); int line_at_center (struct window *w, int type, Bufpos start, Bufpos point); Bufpos point_at_center (struct window *w, int type, Bufpos start, @@ -329,7 +330,7 @@ /* Used by generate_formatted_string. Global because they get used so much that the dynamic allocation time adds up. */ -emchar_dynarr *formatted_string_emchar_dynarr; +Emchar_dynarr *formatted_string_emchar_dynarr; struct display_line formatted_string_display_line; /* We store the extents that we need to generate in a Dynarr and then frob them all on at the end of generating the string. We do it @@ -338,9 +339,9 @@ (to avoid having to resize the string multiple times), and we don't want to go around adding extents to a string when the extents might stretch off the end of the string. */ -extent_dynarr *formatted_string_extent_dynarr; -bytecount_dynarr *formatted_string_extent_start_dynarr; -bytecount_dynarr *formatted_string_extent_end_dynarr; +EXTENT_dynarr *formatted_string_extent_dynarr; +Bytecount_dynarr *formatted_string_extent_start_dynarr; +Bytecount_dynarr *formatted_string_extent_end_dynarr; /* #### probably temporary */ @@ -348,7 +349,7 @@ /* This holds a string representing the text corresponding to a single modeline % spec. */ -static bufbyte_dynarr *mode_spec_bufbyte_string; +static Bufbyte_dynarr *mode_spec_bufbyte_string; int in_display; /* 1 if in redisplay. */ @@ -509,7 +510,7 @@ str, len)); } -static emchar_dynarr *rtw_emchar_dynarr; +static Emchar_dynarr *rtw_emchar_dynarr; int redisplay_text_width_string (struct window *w, int findex, @@ -594,14 +595,14 @@ { /* This line doesn't have any display blocks, so initialize the display bock array. */ - dl->display_blocks = Dynarr_new (struct display_block); + dl->display_blocks = Dynarr_new (display_block); } /* The line doesn't have a block of the desired type so go ahead and create one and add it to the line. */ memset (&db, 0, sizeof (struct display_block)); db.type = type; - db.runes = Dynarr_new (struct rune); + db.runes = Dynarr_new (rune); Dynarr_add (dl->display_blocks, db); /* Return the newly added display block. */ @@ -996,11 +997,10 @@ { struct prop_block pb; Bytecount len = end - pos; - prop = Dynarr_new (struct prop_block); + prop = Dynarr_new (prop_block); pb.type = PROP_STRING; - pb.data.p_string.str = - (Bufbyte *) xmalloc (sizeof (Bufbyte) * len); + pb.data.p_string.str = xnew_array (Bufbyte, len); strncpy ((char *) pb.data.p_string.str, (char *) pos, len); pb.data.p_string.len = len; @@ -1108,7 +1108,7 @@ { \ struct prop_block pb; \ if (!prop) \ - prop = Dynarr_new (struct prop_block); \ + prop = Dynarr_new (prop_block); \ \ pb.type = PROP_CHAR; \ pb.data.p_char.ch = data->ch; \ @@ -1243,7 +1243,7 @@ { struct prop_block pb; if (!prop) - prop = Dynarr_new (struct prop_block); + prop = Dynarr_new (prop_block); pb.type = PROP_CHAR; pb.data.p_char.ch = data->ch; @@ -1716,14 +1716,14 @@ if (pos_type == BEGIN_GLYPHS) { if (!data->dl->left_glyphs) - data->dl->left_glyphs = Dynarr_new (struct glyph_block); + data->dl->left_glyphs = Dynarr_new (glyph_block); Dynarr_add (data->dl->left_glyphs, *gb); return NULL; } else if (pos_type == END_GLYPHS) { if (!data->dl->right_glyphs) - data->dl->right_glyphs = Dynarr_new (struct glyph_block); + data->dl->right_glyphs = Dynarr_new (glyph_block); Dynarr_add (data->dl->right_glyphs, *gb); return NULL; } @@ -2300,7 +2300,7 @@ if (prop_width) { struct prop_block pb; - *prop = Dynarr_new (struct prop_block); + *prop = Dynarr_new (prop_block); pb.type = PROP_BLANK; pb.data.p_blank.width = prop_width; @@ -2917,7 +2917,7 @@ elt = 0; used_in = used_out = 0; - ib = Dynarr_new (struct glyph_block); + ib = Dynarr_new (glyph_block); while (elt < Dynarr_length (dl->left_glyphs)) { struct glyph_block *gb = Dynarr_atp (dl->left_glyphs, elt); @@ -3236,7 +3236,7 @@ elt = 0; used_in = used_out = 0; - ib = Dynarr_new (struct glyph_block); + ib = Dynarr_new (glyph_block); while (elt < Dynarr_length (dl->right_glyphs)) { struct glyph_block *gb = Dynarr_atp (dl->right_glyphs, elt); @@ -4162,28 +4162,21 @@ int real_current_modeline_height (struct window *w) { - Fset_marker (w->start[CMOTION_DISP], w->start[CURRENT_DISP], w->buffer); + Fset_marker (w->start[CMOTION_DISP], w->start[CURRENT_DISP], w->buffer); Fset_marker (w->pointm[CMOTION_DISP], w->pointm[CURRENT_DISP], w->buffer); if (ensure_modeline_generated (w, CMOTION_DISP)) { - display_line_dynarr *dla; - - dla = window_display_lines (w, CMOTION_DISP); + display_line_dynarr *dla = window_display_lines (w, CMOTION_DISP); if (Dynarr_length (dla)) { if (Dynarr_atp (dla, 0)->modeline) return (Dynarr_atp (dla, 0)->ascent + Dynarr_atp (dla, 0)->descent); - else - return 0; - } - else - return 0; - } - else - return 0; + } + } + return 0; } @@ -4248,7 +4241,7 @@ { struct prop_block pb; Lisp_Object string; - prop = Dynarr_new (struct prop_block); + prop = Dynarr_new (prop_block); string = concat2(Vminibuf_preprompt, Vminibuf_prompt); pb.type = PROP_MINIBUF_PROMPT; @@ -4797,9 +4790,10 @@ } /* Given a window and a point, update the given display lines such - that point is displayed in the middle of the window. */ - -static void + that point is displayed in the middle of the window. + Return the window's new start position. */ + +static Bufpos regenerate_window_point_center (struct window *w, Bufpos point, int type) { Bufpos startp; @@ -4812,7 +4806,7 @@ regenerate_window (w, startp, point, type); Fset_marker (w->start[type], make_int (startp), w->buffer); - return; + return startp; } /* Given a window and a set of display lines, return a boolean @@ -5024,7 +5018,7 @@ if (!MINI_WINDOW_P (w) && !EQ (Fmarker_buffer (w->start[CURRENT_DISP]), w->buffer)) { - regenerate_window_point_center (w, pointm, DESIRED_DISP); + startp = regenerate_window_point_center (w, pointm, DESIRED_DISP); goto regeneration_done; } @@ -5158,7 +5152,7 @@ startp < marker_position (w->last_start[CURRENT_DISP])) || (startp == BUF_ZV (b))) { - regenerate_window_point_center (w, pointm, DESIRED_DISP); + startp = regenerate_window_point_center (w, pointm, DESIRED_DISP); goto regeneration_done; } @@ -5196,11 +5190,9 @@ back onto the screen. */ if (scroll_step) { - Bufpos bufpos; - - bufpos = vmotion (w, startp, + startp = vmotion (w, startp, (pointm < startp) ? -scroll_step : scroll_step, 0); - regenerate_window (w, bufpos, pointm, DESIRED_DISP); + regenerate_window (w, startp, pointm, DESIRED_DISP); if (point_visible (w, pointm, DESIRED_DISP)) goto regeneration_done; @@ -5208,7 +5200,7 @@ /* We still haven't managed to get the screen drawn with point on the screen, so just center it and be done with it. */ - regenerate_window_point_center (w, pointm, DESIRED_DISP); + startp = regenerate_window_point_center (w, pointm, DESIRED_DISP); regeneration_done: @@ -5416,17 +5408,17 @@ update_frame_title (f); - f->buffers_changed = 0; - f->clip_changed = 0; - f->extents_changed = 0; - f->faces_changed = 0; - f->frame_changed = 0; - f->icon_changed = 0; - f->menubar_changed = 0; + f->buffers_changed = 0; + f->clip_changed = 0; + f->extents_changed = 0; + f->faces_changed = 0; + f->frame_changed = 0; + f->icon_changed = 0; + f->menubar_changed = 0; f->modeline_changed = 0; - f->point_changed = 0; - f->toolbar_changed = 0; - f->windows_changed = 0; + f->point_changed = 0; + f->toolbar_changed = 0; + f->windows_changed = 0; f->windows_structure_changed = 0; f->window_face_cache_reset = 0; @@ -5479,11 +5471,11 @@ if (FRAME_REPAINT_P (f)) { - if (f->buffers_changed || f->clip_changed || f->extents_changed - || f->faces_changed || f->frame_changed || f->menubar_changed - || f->modeline_changed || f->point_changed || f->size_changed - || f->toolbar_changed || f->windows_changed - || f->windows_structure_changed) + if (f->buffers_changed || f->clip_changed || f->extents_changed || + f->faces_changed || f->frame_changed || f->menubar_changed || + f->modeline_changed || f->point_changed || f->size_changed || + f->toolbar_changed || f->windows_changed || + f->windows_structure_changed) { preempted = redisplay_frame (f, 0); } @@ -5513,11 +5505,11 @@ if (FRAME_REPAINT_P (f)) { - if (f->buffers_changed || f->clip_changed || f->extents_changed - || f->faces_changed || f->frame_changed || f->menubar_changed - || f->modeline_changed || f->point_changed || f->size_changed - || f->toolbar_changed || f->windows_changed - || f->windows_structure_changed) + if (f->buffers_changed || f->clip_changed || f->extents_changed || + f->faces_changed || f->frame_changed || f->menubar_changed || + f->modeline_changed || f->point_changed || f->size_changed || + f->toolbar_changed || f->windows_changed || + f->windows_structure_changed) { preempted = redisplay_frame (f, 0); } @@ -5532,17 +5524,17 @@ /* If we get here then we redisplayed all of our frames without getting preempted so mark ourselves as clean. */ - d->buffers_changed = 0; - d->clip_changed = 0; - d->extents_changed = 0; - d->faces_changed = 0; - d->frame_changed = 0; - d->icon_changed = 0; - d->menubar_changed = 0; + d->buffers_changed = 0; + d->clip_changed = 0; + d->extents_changed = 0; + d->faces_changed = 0; + d->frame_changed = 0; + d->icon_changed = 0; + d->menubar_changed = 0; d->modeline_changed = 0; - d->point_changed = 0; - d->toolbar_changed = 0; - d->windows_changed = 0; + d->point_changed = 0; + d->toolbar_changed = 0; + d->windows_changed = 0; d->windows_structure_changed = 0; if (!size_change_failed) @@ -5582,11 +5574,12 @@ if (asynch_device_change_pending) handle_asynch_device_change (); - if (!buffers_changed && !clip_changed && !extents_changed && !faces_changed - && !frame_changed && !icon_changed && !menubar_changed - && !modeline_changed && !point_changed && !size_changed - && !toolbar_changed && !windows_changed && !windows_structure_changed - && !disable_preemption && preemption_count < max_preempts) + if (!buffers_changed && !clip_changed && !extents_changed && + !faces_changed && !frame_changed && !icon_changed && + !menubar_changed && !modeline_changed && !point_changed && + !size_changed && !toolbar_changed && !windows_changed && + !windows_structure_changed && !disable_preemption && + preemption_count < max_preempts) goto done; DEVICE_LOOP_NO_BREAK (devcons, concons) @@ -5594,12 +5587,11 @@ struct device *d = XDEVICE (XCAR (devcons)); int preempted; - if (d->buffers_changed || d->clip_changed || d->extents_changed - || d->faces_changed || d->frame_changed - || d->icon_changed || d->menubar_changed - || d->modeline_changed || d->point_changed || d->size_changed - || d->toolbar_changed || d->windows_changed - || d->windows_structure_changed) + if (d->buffers_changed || d->clip_changed || d->extents_changed || + d->faces_changed || d->frame_changed || d->icon_changed || + d->menubar_changed || d->modeline_changed || d->point_changed || + d->size_changed || d->toolbar_changed || d->windows_changed || + d->windows_structure_changed) { preempted = redisplay_device (d); @@ -5618,16 +5610,16 @@ preemption_count = 0; /* Mark redisplay as accurate */ - buffers_changed = 0; - clip_changed = 0; - extents_changed = 0; - frame_changed = 0; - icon_changed = 0; - menubar_changed = 0; + buffers_changed = 0; + clip_changed = 0; + extents_changed = 0; + frame_changed = 0; + icon_changed = 0; + menubar_changed = 0; modeline_changed = 0; - point_changed = 0; - toolbar_changed = 0; - windows_changed = 0; + point_changed = 0; + toolbar_changed = 0; + windows_changed = 0; windows_structure_changed = 0; RESET_CHANGED_SET_FLAGS; @@ -5747,7 +5739,7 @@ size++; } - buf = (char *) alloca (size * sizeof (char)); + buf = alloca_array (char, size); sprintf (buf, "%d", col); Dynarr_add_many (mode_spec_bufbyte_string, @@ -5789,7 +5781,7 @@ struct frame *f = XFRAME (w->frame); if (FRAME_TTY_P (f) && f->order_count > 1) { - str = alloca (10); + str = (CONST char *) alloca (10); sprintf (str, "-%d", f->order_count); } } @@ -6012,19 +6004,19 @@ } Dynarr_free (dl->display_blocks); - dl->display_blocks = 0; + dl->display_blocks = NULL; } if (dl->left_glyphs) { Dynarr_free (dl->left_glyphs); - dl->left_glyphs = 0; + dl->left_glyphs = NULL; } if (dl->right_glyphs) { Dynarr_free (dl->right_glyphs); - dl->right_glyphs = 0; + dl->right_glyphs = NULL; } } @@ -6065,54 +6057,53 @@ static void -mark_redisplay_structs (display_line_dynarr *dla, - void (*markobj) (Lisp_Object)) +mark_glyph_block_dynarr (glyph_block_dynarr *gba, void (*markobj) (Lisp_Object)) +{ + if (gba) + { + glyph_block *gb = Dynarr_atp (gba, 0); + glyph_block *gb_last = Dynarr_atp (gba, Dynarr_length (gba)); + + for (; gb < gb_last; gb++) + { + if (!NILP (gb->glyph)) ((markobj) (gb->glyph)); + if (!NILP (gb->extent)) ((markobj) (gb->extent)); + } + } +} + +static void +mark_redisplay_structs (display_line_dynarr *dla, void (*markobj) (Lisp_Object)) { - int line; - - for (line = 0; line < Dynarr_length (dla); line++) - { - int block, loop; - struct display_line *dl = Dynarr_atp (dla, line); - - for (block = 0; block < Dynarr_length (dl->display_blocks); block++) - { - int rune; - struct display_block *db = Dynarr_atp (dl->display_blocks, block); - - for (rune = 0; rune < Dynarr_length (db->runes); rune++) + display_line *dl = Dynarr_atp (dla, 0); + display_line *dl_last = Dynarr_atp (dla, Dynarr_length (dla)); + + for (; dl < dl_last; dl++) + { + display_block_dynarr *dba = dl->display_blocks; + display_block *db = Dynarr_atp (dba, 0); + display_block *db_last = Dynarr_atp (dba, Dynarr_length (dba)); + + for (; db < db_last; db++) + { + rune_dynarr *ra = db->runes; + rune *r = Dynarr_atp (ra, 0); + rune *r_last = Dynarr_atp (ra, Dynarr_length (ra)); + + for (; r < r_last; r++) { - struct rune *rb = Dynarr_atp (db->runes, rune); - - if (rb->type == RUNE_DGLYPH) + if (r->type == RUNE_DGLYPH) { - if (!NILP (rb->object.dglyph.glyph)) - ((markobj) (rb->object.dglyph.glyph)); - if (!NILP (rb->object.dglyph.extent)) - ((markobj) (rb->object.dglyph.extent)); + if (!NILP (r->object.dglyph.glyph)) + ((markobj) (r->object.dglyph.glyph)); + if (!NILP (r->object.dglyph.extent)) + ((markobj) (r->object.dglyph.extent)); } } } - for (loop = 0; loop < 2; loop++) - { - glyph_block_dynarr *gba = (loop - ? dl->right_glyphs - : dl->left_glyphs); - - if (gba != NULL) - { - for (block = 0; block < Dynarr_length (gba); block++) - { - struct glyph_block *gb = Dynarr_atp (gba, block); - - if (!NILP (gb->glyph)) - ((markobj) (gb->glyph)); - if (!NILP (gb->extent)) - ((markobj) (gb->extent)); - } - } - } + mark_glyph_block_dynarr (dl->left_glyphs, markobj); + mark_glyph_block_dynarr (dl->right_glyphs, markobj); } } @@ -7189,9 +7180,9 @@ } if (*pix_x > w->pixel_left + w->pixel_width) - *pix_x = w->pixel_left + w->pixel_width; + *pix_x = w->pixel_left + w->pixel_width; if (*pix_y > w->pixel_top + w->pixel_height) - *pix_y = w->pixel_top + w->pixel_height; + *pix_y = w->pixel_top + w->pixel_height; *pix_x -= w->pixel_left; *pix_y -= w->pixel_top; @@ -8085,13 +8076,13 @@ if (!initialized) { - cmotion_display_lines = Dynarr_new (struct display_line); + cmotion_display_lines = Dynarr_new (display_line); mode_spec_bufbyte_string = Dynarr_new (Bufbyte); formatted_string_emchar_dynarr = Dynarr_new (Emchar); - formatted_string_extent_dynarr = Dynarr_new (struct extent *); + formatted_string_extent_dynarr = Dynarr_new (EXTENT); formatted_string_extent_start_dynarr = Dynarr_new (Bytecount); formatted_string_extent_end_dynarr = Dynarr_new (Bytecount); - internal_cache = Dynarr_new (struct line_start_cache); + internal_cache = Dynarr_new (line_start_cache); memset (&formatted_string_display_line, 0, sizeof (struct display_line)); } @@ -8192,7 +8183,7 @@ horizontal_clip = 5; DEFVAR_LISP ("global-mode-string", &Vglobal_mode_string /* -String displayed by modeline-format's \"%m\" specification. +String displayed by modeline-format's "%m" specification. */ ); Vglobal_mode_string = Qnil;
--- a/src/redisplay.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/redisplay.h Mon Aug 13 09:55:28 2007 +0200 @@ -46,15 +46,16 @@ end buffer positions for a contiguous set of lines on that piece of paper. */ +typedef struct line_start_cache line_start_cache; struct line_start_cache { Bufpos start, end; int height; }; -typedef struct line_start_cache_dynarr_type +typedef struct { - Dynarr_declare (struct line_start_cache); + Dynarr_declare (line_start_cache); } line_start_cache_dynarr; /* The possible types of runes. @@ -88,7 +89,8 @@ (Printable characters typically have one rune associated with them, but control characters have two -- a ^ and a letter -- and other non-printing characters (those displayed in octal) have four. */ - + +typedef struct rune rune; struct rune { face_index findex; /* face rune is displayed with. The @@ -132,13 +134,13 @@ glyph to the left while still clipping at XPOS. */ } dglyph; - + /* CHAR */ struct { Emchar ch; /* Cbaracter of this rune. */ } chr; - + /* HLINE */ struct { @@ -148,9 +150,9 @@ } object; /* actual rune object */ }; -typedef struct rune_dynarr_type +typedef struct { - Dynarr_declare (struct rune); + Dynarr_declare (rune); } rune_dynarr; /* These must have distinct values. Note that the ordering actually @@ -188,6 +190,7 @@ reduce the amount of X traffic, which will help things significantly on a slow line. */ +typedef struct display_block display_block; struct display_block { enum display_type type; /* type of display block */ @@ -198,9 +201,9 @@ rune_dynarr *runes; /* Dynamic array of runes */ }; -typedef struct display_block_dynarr_type +typedef struct { - Dynarr_declare (struct display_block); + Dynarr_declare (display_block); } display_block_dynarr; typedef struct layout_bounds_type @@ -213,6 +216,7 @@ int right_out; } layout_bounds; +typedef struct glyph_block glyph_block; struct glyph_block { Lisp_Object glyph; @@ -223,11 +227,12 @@ int width; }; -typedef struct glyph_block_dynarr_type +typedef struct { - Dynarr_declare (struct glyph_block); + Dynarr_declare (glyph_block); } glyph_block_dynarr; +typedef struct display_line display_line; struct display_line { short ypos; /* vertical position in pixels @@ -264,19 +269,19 @@ glyph_block_dynarr *right_glyphs; }; -typedef struct display_line_dynarr_type +typedef struct { - Dynarr_declare (struct display_line); + Dynarr_declare (display_line); } display_line_dynarr; /* It could be argued that the following two structs belong in extents.h, but they're only used by redisplay and it simplifies the header files to put them here. */ -typedef struct extent_dynarr_type +typedef struct { - Dynarr_declare (struct extent *); -} extent_dynarr; + Dynarr_declare (EXTENT); +} EXTENT_dynarr; struct font_metric_info { @@ -296,7 +301,7 @@ Lisp_Object object; /* buffer or string */ struct frame *frm; Bytind pos, end; - extent_dynarr *extents; + EXTENT_dynarr *extents; glyph_block_dynarr *begin_glyphs, *end_glyphs; unsigned int invisible:1; unsigned int invisible_ellipses:1;
--- a/src/regex.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/regex.c Mon Aug 13 09:55:28 2007 +0200 @@ -188,7 +188,7 @@ if (done) return; - bzero (re_syntax_table, sizeof re_syntax_table); + memset (re_syntax_table, 0, sizeof (re_syntax_table)); for (c = 'a'; c <= 'z'; c++) re_syntax_table[c] = Sword; @@ -248,7 +248,7 @@ #define ISASCII(c) (((unsigned EMACS_INT) (c)) < 0x100 && ISASCII_1 (c)) #else #define ISASCII(c) ISASCII_1 (c) -#endif +#endif /* MULE */ #ifdef isblank #define ISBLANK(c) (ISASCII (c) && isblank (c)) @@ -550,7 +550,7 @@ 2.3 code to enable some language specific processing */ ,categoryspec, /* Matches entries in the character category tables */ notcategoryspec /* The opposite of the above */ -#endif +#endif /* MULE */ } re_opcode_t; @@ -1806,7 +1806,7 @@ char *translate, reg_syntax_t syntax, Lisp_Object rtab); -#endif +#endif /* MULE */ static boolean group_match_null_string_p (unsigned char **p, unsigned char *end, register_info_type *reg_info); @@ -2058,32 +2058,26 @@ } { - /* Are we optimizing this jump? */ - boolean keep_string_p = false; - - /* 1 means zero (many) matches is allowed. */ - char zero_times_ok = 0, many_times_ok = 0; + /* true means zero/many matches are allowed. */ + boolean zero_times_ok = c != '+'; + boolean many_times_ok = c != '?'; + + /* true means match shortest string possible. */ + boolean minimal = false; /* If there is a sequence of repetition chars, collapse it down to just one (the right one). We can't combine interval operators with these because of, e.g., `a{2}*', - which should only match an even number of `a's. */ - - for (;;) + which should only match an even number of `a's. */ + while (p != pend) { - zero_times_ok |= c != '+'; - many_times_ok |= c != '?'; - - if (p == pend) - break; - PATFETCH (c); - if (c == '*' - || (!(syntax & RE_BK_PLUS_QM) && (c == '+' || c == '?'))) + if (c == '*' || (!(syntax & RE_BK_PLUS_QM) + && (c == '+' || c == '?'))) ; - else if (syntax & RE_BK_PLUS_QM && c == '\\') + else if (syntax & RE_BK_PLUS_QM && c == '\\') { if (p == pend) FREE_STACK_RETURN (REG_EESCAPE); @@ -2104,73 +2098,137 @@ } /* If we get here, we found another repeat character. */ - } + if (!(syntax & RE_NO_MINIMAL_MATCHING)) + { + /* `*?' and `+?' and `??' are okay (and mean match + minimally), but other sequences (such as `*??' and + `+++') are rejected (reserved for future use). */ + if (minimal || c != '?') + FREE_STACK_RETURN (REG_BADRPT); + minimal = true; + } + else + { + zero_times_ok |= c != '+'; + many_times_ok |= c != '?'; + } + } /* Star, etc. applied to an empty pattern is equivalent to an empty pattern. */ if (!laststart) break; - /* Now we know whether or not zero matches is allowed - and also whether or not two or more matches is allowed. */ - if (many_times_ok) - { /* More than one repetition is allowed, so put in at the - end a backward relative jump from `b' to before the next - jump we're going to put in below (which jumps from - laststart to after this jump). - - But if we are at the `*' in the exact sequence `.*\n', - insert an unconditional jump backwards to the ., - instead of the beginning of the loop. This way we only - push a failure point once, instead of every time - through the loop. */ - assert (p - 1 > pattern); - - /* Allocate the space for the jump. */ - GET_BUFFER_SPACE (3); - - /* We know we are not at the first character of the pattern, - because laststart was nonzero. And we've already - incremented `p', by the way, to be the character after - the `*'. Do we have to do something analogous here - for null bytes, because of RE_DOT_NOT_NULL? */ - if (TRANSLATE (*(p - 2)) == TRANSLATE ('.') - && zero_times_ok - && p < pend && TRANSLATE (*p) == TRANSLATE ('\n') - && !(syntax & RE_DOT_NEWLINE)) - { /* We have .*\n. */ - STORE_JUMP (jump, b, laststart); - keep_string_p = true; + /* Now we know whether zero matches is allowed + and whether two or more matches is allowed + and whether we want minimal or maximal matching. */ + if (minimal) + { + if (!many_times_ok) + { + /* "a??" becomes: + 0: /on_failure_jump to 6 + 3: /jump to 9 + 6: /exactn/1/A + 9: end of pattern. + */ + GET_BUFFER_SPACE (6); + INSERT_JUMP (jump, laststart, b + 3); + b += 3; + INSERT_JUMP (on_failure_jump, laststart, laststart + 6); + b += 3; + } + else if (zero_times_ok) + { + /* "a*?" becomes: + 0: /jump to 6 + 3: /exactn/1/A + 6: /on_failure_jump to 3 + 9: end of pattern. + */ + GET_BUFFER_SPACE (6); + INSERT_JUMP (jump, laststart, b + 3); + b += 3; + STORE_JUMP (on_failure_jump, b, laststart + 3); + b += 3; } else - /* Anything else. */ - STORE_JUMP (maybe_pop_jump, b, laststart - 3); - - /* We've added more stuff to the buffer. */ - b += 3; + { + /* "a+?" becomes: + 0: /exactn/1/A + 3: /on_failure_jump to 0 + 6: end of pattern. + */ + GET_BUFFER_SPACE (3); + STORE_JUMP (on_failure_jump, b, laststart); + b += 3; + } } - - /* On failure, jump from laststart to b + 3, which will be the - end of the buffer after this jump is inserted. */ - GET_BUFFER_SPACE (3); - INSERT_JUMP (keep_string_p ? on_failure_keep_string_jump - : on_failure_jump, - laststart, b + 3); + else + { + /* Are we optimizing this jump? */ + boolean keep_string_p = false; + + if (many_times_ok) + { /* More than one repetition is allowed, so put in at the + end a backward relative jump from `b' to before the next + jump we're going to put in below (which jumps from + laststart to after this jump). + + But if we are at the `*' in the exact sequence `.*\n', + insert an unconditional jump backwards to the ., + instead of the beginning of the loop. This way we only + push a failure point once, instead of every time + through the loop. */ + assert (p - 1 > pattern); + + /* Allocate the space for the jump. */ + GET_BUFFER_SPACE (3); + + /* We know we are not at the first character of the + pattern, because laststart was nonzero. And we've + already incremented `p', by the way, to be the + character after the `*'. Do we have to do something + analogous here for null bytes, because of + RE_DOT_NOT_NULL? */ + if (TRANSLATE (*(p - 2)) == TRANSLATE ('.') + && zero_times_ok + && p < pend && TRANSLATE (*p) == TRANSLATE ('\n') + && !(syntax & RE_DOT_NEWLINE)) + { /* We have .*\n. */ + STORE_JUMP (jump, b, laststart); + keep_string_p = true; + } + else + /* Anything else. */ + STORE_JUMP (maybe_pop_jump, b, laststart - 3); + + /* We've added more stuff to the buffer. */ + b += 3; + } + + /* On failure, jump from laststart to b + 3, which will be the + end of the buffer after this jump is inserted. */ + GET_BUFFER_SPACE (3); + INSERT_JUMP (keep_string_p ? on_failure_keep_string_jump + : on_failure_jump, + laststart, b + 3); + b += 3; + + if (!zero_times_ok) + { + /* At least one repetition is required, so insert a + `dummy_failure_jump' before the initial + `on_failure_jump' instruction of the loop. This + effects a skip over that instruction the first time + we hit that loop. */ + GET_BUFFER_SPACE (3); + INSERT_JUMP (dummy_failure_jump, laststart, laststart + 6); + b += 3; + } + } pending_exact = 0; - b += 3; - - if (!zero_times_ok) - { - /* At least one repetition is required, so insert a - `dummy_failure_jump' before the initial - `on_failure_jump' instruction of the loop. This - effects a skip over that instruction the first time - we hit that loop. */ - GET_BUFFER_SPACE (3); - INSERT_JUMP (dummy_failure_jump, laststart, laststart + 6); - b += 3; - } - } + } break; @@ -2502,47 +2560,72 @@ goto normal_backslash; handle_open: - bufp->re_nsub++; - regnum++; - - if (COMPILE_STACK_FULL) - { - RETALLOC (compile_stack.stack, compile_stack.size << 1, - compile_stack_elt_t); - if (compile_stack.stack == NULL) return REG_ESPACE; - - compile_stack.size <<= 1; - } - - /* These are the values to restore when we hit end of this - group. They are all relative offsets, so that if the - whole pattern moves because of realloc, they will still - be valid. */ - COMPILE_STACK_TOP.begalt_offset = begalt - bufp->buffer; - COMPILE_STACK_TOP.fixup_alt_jump - = fixup_alt_jump ? fixup_alt_jump - bufp->buffer + 1 : 0; - COMPILE_STACK_TOP.laststart_offset = b - bufp->buffer; - COMPILE_STACK_TOP.regnum = regnum; - - /* We will eventually replace the 0 with the number of - groups inner to this one. But do not push a - start_memory for groups beyond the last one we can - represent in the compiled pattern. */ - if (regnum <= MAX_REGNUM) - { - COMPILE_STACK_TOP.inner_group_offset = b - bufp->buffer + 2; - BUF_PUSH_3 (start_memory, regnum, 0); - } - - compile_stack.avail++; - - fixup_alt_jump = 0; - laststart = 0; - begalt = b; - /* If we've reached MAX_REGNUM groups, then this open - won't actually generate any code, so we'll have to - clear pending_exact explicitly. */ - pending_exact = 0; + { + regnum_t r; + + if (!(syntax & RE_NO_SHY_GROUPS) + && p != pend + && TRANSLATE(*p) == TRANSLATE('?')) + { + p++; + PATFETCH(c); + switch (c) + { + case ':': /* shy groups */ + r = MAX_REGNUM + 1; + break; + + /* All others are reserved for future constructs. */ + default: + FREE_STACK_RETURN (REG_BADPAT); + } + } + else + { + bufp->re_nsub++; + r = ++regnum; + } + + if (COMPILE_STACK_FULL) + { + RETALLOC (compile_stack.stack, compile_stack.size << 1, + compile_stack_elt_t); + if (compile_stack.stack == NULL) return REG_ESPACE; + + compile_stack.size <<= 1; + } + + /* These are the values to restore when we hit end of this + group. They are all relative offsets, so that if the + whole pattern moves because of realloc, they will still + be valid. */ + COMPILE_STACK_TOP.begalt_offset = begalt - bufp->buffer; + COMPILE_STACK_TOP.fixup_alt_jump + = fixup_alt_jump ? fixup_alt_jump - bufp->buffer + 1 : 0; + COMPILE_STACK_TOP.laststart_offset = b - bufp->buffer; + COMPILE_STACK_TOP.regnum = r; + + /* We will eventually replace the 0 with the number of + groups inner to this one. But do not push a + start_memory for groups beyond the last one we can + represent in the compiled pattern. */ + if (r <= MAX_REGNUM) + { + COMPILE_STACK_TOP.inner_group_offset + = b - bufp->buffer + 2; + BUF_PUSH_3 (start_memory, r, 0); + } + + compile_stack.avail++; + + fixup_alt_jump = 0; + laststart = 0; + begalt = b; + /* If we've reached MAX_REGNUM groups, then this open + won't actually generate any code, so we'll have to + clear pending_exact explicitly. */ + pending_exact = 0; + } break; @@ -3408,10 +3491,10 @@ /* And all extended characters must be allowed, too. */ for (j = 0x80; j < 0xA0; j++) fastmap[j] = 1; -#else +#else /* ! MULE */ for (j = *p * BYTEWIDTH; j < (1 << BYTEWIDTH); j++) fastmap[j] = 1; -#endif +#endif /* ! MULE */ for (j = *p++ * BYTEWIDTH - 1; j >= 0; j--) if (!(p[j / BYTEWIDTH] & (1 << (j % BYTEWIDTH)))) @@ -4299,6 +4382,13 @@ unsigned num_regs_pushed = 0; #endif + /* 1 if this match ends in the same string (string1 or string2) + as the best previous match. */ + boolean same_str_p; + + /* 1 if this match is the best seen so far. */ + boolean best_match_p; + DEBUG_PRINT1 ("\n\nEntering re_match_2.\n"); INIT_FAIL_STACK (); @@ -4311,14 +4401,14 @@ array indexing. We should fix this. */ if (bufp->re_nsub) { - regstart = REGEX_TALLOC (num_regs, CONST char *); - regend = REGEX_TALLOC (num_regs, CONST char *); - old_regstart = REGEX_TALLOC (num_regs, CONST char *); - old_regend = REGEX_TALLOC (num_regs, CONST char *); - best_regstart = REGEX_TALLOC (num_regs, CONST char *); - best_regend = REGEX_TALLOC (num_regs, CONST char *); - reg_info = REGEX_TALLOC (num_regs, register_info_type); - reg_dummy = REGEX_TALLOC (num_regs, CONST char *); + regstart = REGEX_TALLOC (num_regs, CONST char *); + regend = REGEX_TALLOC (num_regs, CONST char *); + old_regstart = REGEX_TALLOC (num_regs, CONST char *); + old_regend = REGEX_TALLOC (num_regs, CONST char *); + best_regstart = REGEX_TALLOC (num_regs, CONST char *); + best_regend = REGEX_TALLOC (num_regs, CONST char *); + reg_info = REGEX_TALLOC (num_regs, register_info_type); + reg_dummy = REGEX_TALLOC (num_regs, CONST char *); reg_info_dummy = REGEX_TALLOC (num_regs, register_info_type); if (!(regstart && regend && old_regstart && old_regend && reg_info @@ -4421,12 +4511,8 @@ longest match, try backtracking. */ if (d != end_match_2) { - /* 1 if this match ends in the same string (string1 or string2) - as the best previous match. */ - boolean same_str_p = (FIRST_STRING_P (match_end) - == MATCHING_IN_FIRST_STRING); - /* 1 if this match is the best seen so far. */ - boolean best_match_p; + same_str_p = (FIRST_STRING_P (match_end) + == MATCHING_IN_FIRST_STRING); /* AIX compiler got confused when this was combined with the previous declaration. */ @@ -4687,7 +4773,7 @@ INC_CHARPTR (d); break; } -#endif +#endif /* MULE */ /* The beginning of a group is represented by start_memory. @@ -5016,7 +5102,7 @@ EXTRACT_NUMBER_AND_INCR (mcnt, p); DEBUG_PRINT3 (" %d (to 0x%p):\n", mcnt, p + mcnt); - PUSH_FAILURE_POINT (p + mcnt, (void *) 0, -2); + PUSH_FAILURE_POINT (p + mcnt, (char *) 0, -2); break; @@ -5272,7 +5358,7 @@ DEBUG_PRINT1 ("EXECUTING dummy_failure_jump.\n"); /* It doesn't matter what we push for the string here. What the code at `fail' tests is the value for the pattern. */ - PUSH_FAILURE_POINT ((void *) 0, (void *) 0, -2); + PUSH_FAILURE_POINT ((unsigned char *) 0, (char *) 0, -2); goto unconditional_jump; @@ -5285,7 +5371,7 @@ DEBUG_PRINT1 ("EXECUTING push_dummy_failure.\n"); /* See comments just above at `dummy_failure_jump' about the two zeroes. */ - PUSH_FAILURE_POINT ((void *) 0, (void *) 0, -2); + PUSH_FAILURE_POINT ((unsigned char *) 0, (char *) 0, -2); break; /* Have to succeed matching what follows at least n times.
--- a/src/regex.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/regex.h Mon Aug 13 09:55:28 2007 +0200 @@ -34,10 +34,11 @@ /* The following bits are used to determine the regexp syntax we - recognize. The set/not-set meanings are chosen so that Emacs syntax - remains the value 0. The bits are given in alphabetical order, and - the definitions shifted by one from the previous bit; thus, when we - add or remove a bit, only one other definition need change. */ + recognize. The not-set meaning typically corresponds to the syntax + used by Emacs (the exception is RE_INTERVAL, made for historical + reasons). The bits are given in alphabetical order, and the + definitions shifted by one from the previous bit; thus, when we add or + remove a bit, only one other definition need change. */ typedef unsigned reg_syntax_t; /* If this bit is not set, then \ inside a bracket expression is literal. @@ -45,7 +46,7 @@ #define RE_BACKSLASH_ESCAPE_IN_LISTS (1) /* If this bit is not set, then + and ? are operators, and \+ and \? are - literals. + literals. If set, then \+ and \? are operators and + and ? are literals. */ #define RE_BK_PLUS_QM (RE_BACKSLASH_ESCAPE_IN_LISTS << 1) @@ -61,7 +62,7 @@ ^ is an anchor if it is at the beginning of a regular expression or after an open-group or an alternation operator; $ is an anchor if it is at the end of a regular expression, or - before a close-group or an alternation operator. + before a close-group or an alternation operator. This bit could be (re)combined with RE_CONTEXT_INDEP_OPS, because POSIX draft 11.2 says that * etc. in leading positions is undefined. @@ -72,7 +73,7 @@ /* If this bit is set, then special characters are always special regardless of where they are in the pattern. If this bit is not set, then special characters are special only in - some contexts; otherwise they are ordinary. Specifically, + some contexts; otherwise they are ordinary. Specifically, * + ? and intervals are only special when not after the beginning, open-group, or alternation operator. */ #define RE_CONTEXT_INDEP_OPS (RE_CONTEXT_INDEP_ANCHORS << 1) @@ -94,7 +95,7 @@ #define RE_HAT_LISTS_NOT_NEWLINE (RE_DOT_NOT_NULL << 1) /* If this bit is set, either \{...\} or {...} defines an - interval, depending on RE_NO_BK_BRACES. + interval, depending on RE_NO_BK_BRACES. If not set, \{, \}, {, and } are literals. */ #define RE_INTERVALS (RE_HAT_LISTS_NOT_NEWLINE << 1) @@ -119,7 +120,7 @@ If not set, then \<digit> is a back-reference. */ #define RE_NO_BK_REFS (RE_NO_BK_PARENS << 1) -/* If this bit is set, then | is an alternation operator, and \| is literal. +/* If this bit is set, then | is an alternation operator, and \| is literal. If not set, then \| is an alternation operator, and | is literal. */ #define RE_NO_BK_VBAR (RE_NO_BK_REFS << 1) @@ -129,13 +130,28 @@ starting range point, the range is ignored. */ #define RE_NO_EMPTY_RANGES (RE_NO_BK_VBAR << 1) -/* If this bit is set, then an unmatched ) is ordinary. - If not set, then an unmatched ) is invalid. */ -#define RE_UNMATCHED_RIGHT_PAREN_ORD (RE_NO_EMPTY_RANGES << 1) +/* If this bit is not set, allow minimal matching: + - a*? and a+? and a?? perform shortest-possible matching (compare with a* + and a+ and a?, respectively, which perform longest-possible matching) + - other juxtaposing of * + and ? is rejected. + If this bit is set, consecutive * + and ?'s are collapsed in a logical + manner: + - a*? and a+? are the same as a* + - a?? is the same as a? + */ +#define RE_NO_MINIMAL_MATCHING (RE_NO_EMPTY_RANGES << 1) /* If this bit is set, succeed as soon as we match the whole pattern, without further backtracking. */ -#define RE_NO_POSIX_BACKTRACKING (RE_UNMATCHED_RIGHT_PAREN_ORD << 1) +#define RE_NO_POSIX_BACKTRACKING (RE_NO_MINIMAL_MATCHING << 1) + +/* If this bit is not set, (?:re) behaves like (re) (or \(?:re\) behaves like + \(re\)) except that the matched string is not registered. */ +#define RE_NO_SHY_GROUPS (RE_NO_POSIX_BACKTRACKING << 1) + +/* If this bit is set, then an unmatched ) is ordinary. + If not set, then an unmatched ) is invalid. */ +#define RE_UNMATCHED_RIGHT_PAREN_ORD (RE_NO_SHY_GROUPS << 1) /* This global variable defines the particular regexp syntax to use (for some interfaces). When a regexp is compiled, the syntax used is @@ -145,15 +161,16 @@ /* Define combinations of the above bits for the standard possibilities. (The [[[ comments delimit what gets put into the Texinfo file, so - don't delete them!) */ + don't delete them!) */ /* [[[begin syntaxes]]] */ -#define RE_SYNTAX_EMACS 0 +#define RE_SYNTAX_EMACS RE_INTERVALS #define RE_SYNTAX_AWK \ (RE_BACKSLASH_ESCAPE_IN_LISTS | RE_DOT_NOT_NULL \ | RE_NO_BK_PARENS | RE_NO_BK_REFS \ | RE_NO_BK_VBAR | RE_NO_EMPTY_RANGES \ - | RE_UNMATCHED_RIGHT_PAREN_ORD) + | RE_UNMATCHED_RIGHT_PAREN_ORD | RE_NO_SHY_GROUPS \ + | RE_NO_MINIMAL_MATCHING) #define RE_SYNTAX_POSIX_AWK \ (RE_SYNTAX_POSIX_EXTENDED | RE_BACKSLASH_ESCAPE_IN_LISTS) @@ -161,13 +178,15 @@ #define RE_SYNTAX_GREP \ (RE_BK_PLUS_QM | RE_CHAR_CLASSES \ | RE_HAT_LISTS_NOT_NEWLINE | RE_INTERVALS \ - | RE_NEWLINE_ALT) + | RE_NEWLINE_ALT | RE_NO_SHY_GROUPS \ + | RE_NO_MINIMAL_MATCHING) #define RE_SYNTAX_EGREP \ (RE_CHAR_CLASSES | RE_CONTEXT_INDEP_ANCHORS \ | RE_CONTEXT_INDEP_OPS | RE_HAT_LISTS_NOT_NEWLINE \ | RE_NEWLINE_ALT | RE_NO_BK_PARENS \ - | RE_NO_BK_VBAR) + | RE_NO_BK_VBAR | RE_NO_SHY_GROUPS \ + | RE_NO_MINIMAL_MATCHING) #define RE_SYNTAX_POSIX_EGREP \ (RE_SYNTAX_EGREP | RE_INTERVALS | RE_NO_BK_BRACES) @@ -180,7 +199,8 @@ /* Syntax bits common to both basic and extended POSIX regex syntax. */ #define _RE_SYNTAX_POSIX_COMMON \ (RE_CHAR_CLASSES | RE_DOT_NEWLINE | RE_DOT_NOT_NULL \ - | RE_INTERVALS | RE_NO_EMPTY_RANGES) + | RE_INTERVALS | RE_NO_EMPTY_RANGES | RE_NO_SHY_GROUPS \ + | RE_NO_MINIMAL_MATCHING) #define RE_SYNTAX_POSIX_BASIC \ (_RE_SYNTAX_POSIX_COMMON | RE_BK_PLUS_QM) @@ -212,7 +232,7 @@ #ifdef RE_DUP_MAX #undef RE_DUP_MAX #endif -#define RE_DUP_MAX ((1 << 15) - 1) +#define RE_DUP_MAX ((1 << 15) - 1) /* POSIX `cflags' bits (i.e., information for `regcomp'). */ @@ -224,7 +244,7 @@ /* If this bit is set, then ignore case when matching. If not set, then case is significant. */ #define REG_ICASE (REG_EXTENDED << 1) - + /* If this bit is set, then anchors do not match at newline characters in the string. If not set, then anchors do match at newlines. */ @@ -263,7 +283,7 @@ REG_EESCAPE, /* Trailing backslash. */ REG_ESUBREG, /* Invalid back reference. */ REG_EBRACK, /* Unmatched left bracket. */ - REG_EPAREN, /* Parenthesis imbalance. */ + REG_EPAREN, /* Parenthesis imbalance. */ REG_EBRACE, /* Unmatched \{. */ REG_BADBR, /* Invalid contents of \{\}. */ REG_ERANGE, /* Invalid range end. */ @@ -301,7 +321,7 @@ unsigned long allocated; /* Number of bytes actually used in `buffer'. */ - unsigned long used; + unsigned long used; /* Syntax setting with which the pattern was compiled. */ reg_syntax_t syntax; @@ -345,7 +365,7 @@ unsigned no_sub : 1; /* If set, a beginning-of-line anchor doesn't match at the - beginning of the string. */ + beginning of the string. */ unsigned not_bol : 1; /* Similarly for an end-of-line anchor. */ @@ -452,7 +472,7 @@ /* Relates to `re_match' as `re_search_2' relates to `re_search'. */ -extern int re_match_2 +extern int re_match_2 _RE_ARGS ((struct re_pattern_buffer *buffer, CONST char *string1, int length1, CONST char *string2, int length2, int start, struct re_registers *regs, int stop));
--- a/src/scrollbar-x.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/scrollbar-x.c Mon Aug 13 09:55:28 2007 +0200 @@ -101,7 +101,7 @@ char buffer[32]; /* initialize the X specific data section. */ - instance->scrollbar_data = malloc_type_and_zero (struct x_scrollbar_data); + instance->scrollbar_data = xnew_and_zero (struct x_scrollbar_data); SCROLLBAR_X_ID (instance) = new_lwlib_id (); sprintf (buffer, "scrollbar_%d", SCROLLBAR_X_ID (instance)); @@ -196,7 +196,7 @@ { unsigned long mask = CWBackingStore; XSetWindowAttributes attrs; - + attrs.backing_store = Always; XChangeWindowAttributes (XtDisplay (sb_widget), XtWindow (sb_widget), @@ -215,8 +215,7 @@ wv = xmalloc_widget_value (); /* #### maybe should add malloc_scrollbar_values to resource these? */ - wv->scrollbar_data = (scrollbar_values *) - xmalloc (sizeof (scrollbar_values)); + wv->scrollbar_data = xnew (scrollbar_values); wv->name = SCROLLBAR_X_NAME (instance); wv->value = 0; @@ -238,7 +237,7 @@ { if (POINTER_IMAGE_INSTANCEP (w->scrollbar_pointer)) { - XDefineCursor (XtDisplay (wid), XtWindow (wid), + XDefineCursor (XtDisplay (wid), XtWindow (wid), XIMAGE_INSTANCE_X_CURSOR (w->scrollbar_pointer)); XSync (XtDisplay (wid), False); } @@ -325,7 +324,7 @@ f->scrollbar_width = oldval; XtQueryGeometry (FRAME_X_CONTAINER_WIDGET (f), &req, &repl); f->scrollbar_width = newval; - + repl.width += XINT (newval) - XINT (oldval); EmacsManagerChangeSize (FRAME_X_CONTAINER_WIDGET (f), repl.width, repl.height); @@ -370,7 +369,7 @@ f->scrollbar_height = oldval; XtQueryGeometry (FRAME_X_CONTAINER_WIDGET (f), &req, &repl); f->scrollbar_height = newval; - + repl.height += XINT (newval) - XINT (oldval); EmacsManagerChangeSize (FRAME_X_CONTAINER_WIDGET (f), repl.width, repl.height); @@ -551,7 +550,7 @@ (double) SCROLLBAR_X_POS_DATA(instance).scrollbar_height); double line = tmp * (double) window_displayed_height (XWINDOW (win)); - + if (line > -1.0) line = -1.0; signal_special_Xt_user_event (win, Qscrollbar_page_up, @@ -624,8 +623,8 @@ we get line-based scrolling. */ vertical_drag_in_progress = 1; - - if (SCROLLBAR_X_VDRAG_ORIG_VALUE (instance) < 0) + + if (SCROLLBAR_X_VDRAG_ORIG_VALUE (instance) < 0) { SCROLLBAR_X_VDRAG_ORIG_VALUE (instance) = data->slider_value; SCROLLBAR_X_VDRAG_ORIG_WINDOW_START (instance) = @@ -635,13 +634,13 @@ /* Could replace this piecewise linear scrolling with a quadratic through the three points, but I'm not sure that would feel any nicer in practice. */ - if (data->slider_value < SCROLLBAR_X_VDRAG_ORIG_VALUE (instance)) + if (data->slider_value < SCROLLBAR_X_VDRAG_ORIG_VALUE (instance)) { /* We've dragged up; slide linearly from original position to window-start=data.minimum, slider-value=data.minimum. */ if (SCROLLBAR_X_VDRAG_ORIG_VALUE (instance) - <= SCROLLBAR_X_POS_DATA (instance).minimum) + <= SCROLLBAR_X_POS_DATA (instance).minimum) { /* shouldn't get here, but just in case */ value = SCROLLBAR_X_POS_DATA (instance).minimum; @@ -650,33 +649,33 @@ { value = (SCROLLBAR_X_POS_DATA (instance).minimum + (((double) - (SCROLLBAR_X_VDRAG_ORIG_WINDOW_START (instance) + (SCROLLBAR_X_VDRAG_ORIG_WINDOW_START (instance) - SCROLLBAR_X_POS_DATA (instance).minimum) * (data->slider_value - - SCROLLBAR_X_POS_DATA (instance).minimum)) + SCROLLBAR_X_POS_DATA (instance).minimum)) / (SCROLLBAR_X_VDRAG_ORIG_VALUE (instance) - SCROLLBAR_X_POS_DATA (instance).minimum))); } } - else + else { /* We've dragged down; slide linearly from original position to window-start=data.maximum, slider-value=data.maximum. */ - if (SCROLLBAR_X_VDRAG_ORIG_VALUE (instance) + if (SCROLLBAR_X_VDRAG_ORIG_VALUE (instance) >= (SCROLLBAR_X_POS_DATA (instance).maximum - SCROLLBAR_X_POS_DATA (instance).slider_size)) { /* avoid divide by zero */ value = SCROLLBAR_X_VDRAG_ORIG_WINDOW_START (instance); - } - else + } + else { value = (SCROLLBAR_X_VDRAG_ORIG_WINDOW_START (instance) + (((double) (SCROLLBAR_X_POS_DATA (instance).maximum - SCROLLBAR_X_VDRAG_ORIG_WINDOW_START (instance)) - * (data->slider_value - - SCROLLBAR_X_VDRAG_ORIG_VALUE (instance))) + * (data->slider_value + - SCROLLBAR_X_VDRAG_ORIG_VALUE (instance))) / (SCROLLBAR_X_POS_DATA (instance).maximum - SCROLLBAR_X_POS_DATA (instance).slider_size - SCROLLBAR_X_VDRAG_ORIG_VALUE (instance))));
--- a/src/scrollbar.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/scrollbar.c Mon Aug 13 09:55:28 2007 +0200 @@ -168,9 +168,8 @@ { struct device *d = XDEVICE (f->device); struct scrollbar_instance *instance = - (struct scrollbar_instance *) xmalloc (sizeof (*instance)); + xnew_and_zero (struct scrollbar_instance); - memset (instance, 0, sizeof (*instance)); MAYBE_DEVMETH (d, create_scrollbar_instance, (f, vertical, instance)); return instance; @@ -705,7 +704,7 @@ } DEFUN ("scrollbar-page-up", Fscrollbar_page_up, 1, 1, 0, /* -Function called when the user gives the \"page-up\" scrollbar action. +Function called when the user gives the "page-up" scrollbar action. (The way this is done can vary from scrollbar to scrollbar.) One argument, a cons containing the scrollbar's window and a value (#### document me! This value is nil for Motif/Lucid scrollbars and a number for Athena @@ -746,7 +745,7 @@ } DEFUN ("scrollbar-page-down", Fscrollbar_page_down, 1, 1, 0, /* -Function called when the user gives the \"page-down\" scrollbar action. +Function called when the user gives the "page-down" scrollbar action. (The way this is done can vary from scrollbar to scrollbar.) One argument, a cons containing the scrollbar's window and a value (#### document me! This value is nil for Motif/Lucid scrollbars and a number for Athena @@ -778,7 +777,7 @@ } DEFUN ("scrollbar-to-top", Fscrollbar_to_top, 1, 1, 0, /* -Function called when the user invokes the \"to-top\" scrollbar action. +Function called when the user invokes the "to-top" scrollbar action. The way this is done can vary from scrollbar to scrollbar, but C-button1 on the up-arrow is very common. One argument, the scrollbar's window. You can advise this function to change the @@ -795,7 +794,7 @@ } DEFUN ("scrollbar-to-bottom", Fscrollbar_to_bottom, 1, 1, 0, /* -Function called when the user invokes the \"to-bottom\" scrollbar action. +Function called when the user invokes the "to-bottom" scrollbar action. The way this is done can vary from scrollbar to scrollbar, but C-button1 on the down-arrow is very common. One argument, the scrollbar's window. You can advise this function to change the @@ -885,7 +884,7 @@ defsymbol (&Qscrollbar_to_top, "scrollbar-to-top"); defsymbol (&Qscrollbar_to_bottom, "scrollbar-to-bottom"); defsymbol (&Qscrollbar_vertical_drag, "scrollbar-vertical-drag"); - + defsymbol (&Qscrollbar_char_left, "scrollbar-char-left"); defsymbol (&Qscrollbar_char_right, "scrollbar-char-right"); defsymbol (&Qscrollbar_page_left, "scrollbar-page-left");
--- a/src/search.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/search.c Mon Aug 13 09:55:28 2007 +0200 @@ -223,7 +223,7 @@ called. However, this complexifies the code a lot (e.g. the buffer could have changed and the Bytinds stored might be invalid) and is probably not a great time-saver. */ - + static void fixup_search_regs_for_buffer (struct buffer *buf) { @@ -551,12 +551,12 @@ ((count > 0) ? BI_BUF_ZV (buf) : BI_BUF_BEGV (buf)); /* #### newline cache stuff in this function not yet ported */ - + assert (count != 0); if (shortage) *shortage = 0; - + if (count > 0) { #ifdef MULE @@ -581,7 +581,7 @@ { Bytind ceil; Bufbyte *bufptr; - + ceil = BI_BUF_CEILING_OF (buf, st); ceil = min (lim, ceil); bufptr = (Bufbyte *) memchr (BI_BUF_BYTE_ADDRESS (buf, st), @@ -622,7 +622,7 @@ Bytind floor; Bufbyte *bufptr; Bufbyte *floorptr; - + floor = BI_BUF_FLOOR_OF (buf, st); floor = max (lim, floor); /* No memrchr() ... */ @@ -707,7 +707,7 @@ if (shortage == 0) pos--; - + return pos; } @@ -744,7 +744,7 @@ memset (fastmap, 0, sizeof (fastmap)); Fclear_range_table (Vskip_chars_range_table); - + if (p != pend && *p == '^') { negate = 1; @@ -778,7 +778,7 @@ if (p != pend && *p == '-') { Emchar cend; - + p++; if (p == pend) break; cend = charptr_emchar (p); @@ -834,7 +834,7 @@ else { while (BUF_PT (buf) > XINT (lim) - && fastmap[(unsigned char) + && fastmap[(unsigned char) syntax_code_spec [(int) SYNTAX (syntax_table, BUF_FETCH_CHAR @@ -863,7 +863,7 @@ { while (BUF_PT (buf) > XINT (lim)) { - Emchar ch = BUF_FETCH_CHAR (buf, BUF_PT (buf) - 1); + Emchar ch = BUF_FETCH_CHAR (buf, BUF_PT (buf) - 1); if ((ch < 0400) ? fastmap[ch] : (NILP (Fget_range_table (make_int (ch), Vskip_chars_range_table, @@ -884,8 +884,8 @@ Move point forward, stopping before a char not in STRING, or at pos LIM. STRING is like the inside of a `[...]' in a regular expression except that `]' is never special and `\\' quotes `^', `-' or `\\'. -Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter. -With arg \"^a-zA-Z\", skips nonletters stopping before first letter. +Thus, with arg "a-zA-Z", this skips letters stopping before first nonletter. +With arg "^a-zA-Z", skips nonletters stopping before first letter. Returns the distance traveled, either zero or positive. Optional argument BUFFER defaults to the current buffer. @@ -1074,7 +1074,7 @@ EMACS_INT k; Bytecount stride_for_teases = 0; register Bufbyte *pat = 0; - register Bufbyte *cursor, *p_limit, *ptr2; + register Bufbyte *cursor, *p_limit, *ptr2; register EMACS_INT i, j; Bytind p1, p2; Bytecount s1, s2; @@ -1110,7 +1110,7 @@ p2 = BI_BUF_CEILING_OF (buf, p1); s1 = p2 - p1; s2 = BI_BUF_ZV (buf) - p2; - + while (n < 0) { Bytecount val; @@ -1221,10 +1221,10 @@ EMACS_INT BM_tab_space[0400]; BM_tab = &BM_tab_space[0]; #else - BM_tab = (EMACS_INT *) alloca (0400 * sizeof (EMACS_INT)); + BM_tab = alloca_array (EMACS_INT, 256); #endif { - Bufbyte *patbuf = (Bufbyte *) alloca (len); + Bufbyte *patbuf = alloca_array (Bufbyte, len); pat = patbuf; while (--len >= 0) { @@ -1259,14 +1259,14 @@ /* a single test, a test for having gone past the end of the */ /* permissible match region, to test for both possible matches (when */ /* the stride goes past the end immediately) and failure to */ - /* match (where you get nudged past the end one stride at a time). */ + /* match (where you get nudged past the end one stride at a time). */ /* Here we make a "mickey mouse" BM table. The stride of the search */ /* is determined only by the last character of the putative match. */ /* If that character does not match, we will stride the proper */ /* distance to propose a match that superimposes it on the last */ /* instance of a character that matches it (per trt), or misses */ - /* it entirely if there is none. */ + /* it entirely if there is none. */ dirlen = len * direction; infinity = dirlen - (lim + pos + len + len) * direction; @@ -1296,7 +1296,7 @@ stride_for_teases = BM_tab[j]; BM_tab[j] = dirlen - i; /* A translation table is accompanied by its inverse -- see */ - /* comment following downcase_table for details */ + /* comment following downcase_table for details */ while ((j = inverse_trt[j]) != k) BM_tab[j] = dirlen - i; @@ -1409,7 +1409,7 @@ ? 1 - len : 0)); Bufpos bufstart = bytind_to_bufpos (buf, bytstart); Bufpos bufend = bytind_to_bufpos (buf, bytstart + len); - + set_search_regs (buf, bufstart, bufend - bufstart); } @@ -1443,7 +1443,7 @@ /* This loop can be coded for space rather than */ /* speed because it will usually run only once. */ /* (the reach is at most len + 21, and typically */ - /* does not exceed len) */ + /* does not exceed len) */ while ((limit - pos) * direction >= 0) /* *not* BI_BUF_FETCH_CHAR. We are working here with bytes, not characters. */ @@ -1479,7 +1479,7 @@ ? 1 - len : 0)); Bufpos bufstart = bytind_to_bufpos (buf, bytstart); Bufpos bufend = bytind_to_bufpos (buf, bytstart + len); - + set_search_regs (buf, bufstart, bufend - bufstart); } @@ -1512,9 +1512,8 @@ the match position. */ if (search_regs.num_regs == 0) { - /* #### XEmacs: the ones were twos before, which is surely broken. */ - search_regs.start = (regoff_t *) xmalloc (1 * sizeof (regoff_t)); - search_regs.end = (regoff_t *) xmalloc (1 * sizeof (regoff_t)); + search_regs.start = xnew (regoff_t); + search_regs.end = xnew (regoff_t); search_regs.num_regs = 1; } @@ -1566,7 +1565,7 @@ for (i = 0; i < len; i++) { Emchar ch = string_char (XSTRING (string), i); - + if (WORD_SYNTAX_P (syntax_table, ch)) o += set_charptr_emchar (o, ch); else if (i > 0 @@ -1828,7 +1827,7 @@ } syntax_table = XCHAR_TABLE (buf->mirror_syntax_table); - + case_action = nochange; /* We tried an initialization */ /* but some C compilers blew it */ @@ -2044,7 +2043,7 @@ int cur_action = 'E'; Charcount stlen = string_char_length (XSTRING (newtext)); Charcount strpos; - + for (strpos = 0; strpos < stlen; strpos++) { Emchar curchar = string_char (XSTRING (newtext), strpos); @@ -2086,7 +2085,7 @@ /* begin_multiple_change() records an unwind-protect, so we need to record this value now. */ speccount = specpdl_depth (); - + /* We insert the replacement text before the old text, and then delete the original text. This means that markers at the beginning or end of the original will float to the corresponding @@ -2109,7 +2108,7 @@ { c = string_char (XSTRING (newtext), ++strpos); if (c == '&') - Finsert_buffer_substring + Finsert_buffer_substring (buffer, make_int (search_regs.start[0] + offset), make_int (search_regs.end[0] + offset)); @@ -2241,7 +2240,7 @@ (num)) { return match_limit (num, 0); -} +} DEFUN ("match-data", Fmatch_data, 0, 0, 0, /* Return a list containing all info on what the last regexp search matched. @@ -2260,8 +2259,7 @@ if (NILP (last_thing_searched)) error ("match-data called before any match found"); - data = (Lisp_Object *) alloca ((2 * search_regs.num_regs) - * sizeof (Lisp_Object)); + data = alloca_array (Lisp_Object, 2 * search_regs.num_regs); len = -1; for (i = 0; i < search_regs.num_regs; i++) @@ -2282,7 +2280,7 @@ last_thing_searched); data[2 * i + 1] = Fmake_marker (); Fset_marker (data[2 * i + 1], - make_int (search_regs.end[i]), + make_int (search_regs.end[i]), last_thing_searched); } else @@ -2314,7 +2312,7 @@ if (!CONSP (list) && !NILP (list)) list = wrong_type_argument (Qconsp, list); - /* Unless we find a marker with a buffer in LIST, assume that this + /* Unless we find a marker with a buffer in LIST, assume that this match data came from a string. */ last_thing_searched = Qt; @@ -2326,19 +2324,13 @@ { if (search_regs.num_regs == 0) { - search_regs.start - = (regoff_t *) xmalloc (length * sizeof (regoff_t)); - search_regs.end - = (regoff_t *) xmalloc (length * sizeof (regoff_t)); + search_regs.start = xnew_array (regoff_t, length); + search_regs.end = xnew_array (regoff_t, length); } else { - search_regs.start - = (regoff_t *) xrealloc (search_regs.start, - length * sizeof (regoff_t)); - search_regs.end - = (regoff_t *) xrealloc (search_regs.end, - length * sizeof (regoff_t)); + XREALLOC_ARRAY (search_regs.start, regoff_t, length); + XREALLOC_ARRAY (search_regs.end, regoff_t, length); } search_regs.num_regs = length; @@ -2377,7 +2369,7 @@ list = Fcdr (list); } - return Qnil; + return Qnil; } /* If non-zero the match data have been saved in saved_search_regs @@ -2441,7 +2433,7 @@ in = XSTRING_DATA (str); end = in + XSTRING_LENGTH (str); - out = temp; + out = temp; for (; in != end; in++) {
--- a/src/sgiplay.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/sgiplay.c Mon Aug 13 09:55:28 2007 +0200 @@ -324,7 +324,7 @@ audio_port_state[2] = make_int (saved_device_state[5]); record_unwind_protect (restore_audio_port, Fvector (3, &audio_port_state[0])); - + ac = initialize_audio_port (& desc); desc = * ac; return ac; @@ -397,7 +397,7 @@ short * obuf, * bufp; long n_samples = limit - data; - obuf = alloca (n_samples * sizeof (short)); + obuf = alloca_array (short, n_samples); bufp = &obuf[0]; while (data < limit) @@ -436,7 +436,7 @@ long * obuf, * bufp; long n_samples = limit-data; - obuf = alloca (n_samples * sizeof (long)); + obuf = alloca_array (long, n_samples); bufp = &obuf[0]; while (data < limit)
--- a/src/specifier.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/specifier.c Mon Aug 13 09:55:28 2007 +0200 @@ -52,15 +52,16 @@ MAC_DEFINE (struct Lisp_Specifier *, MTspecmeth_or_given) MAC_DEFINE (struct Lisp_Specifier *, MTspecifier_data) +typedef struct specifier_type_entry specifier_type_entry; struct specifier_type_entry { Lisp_Object symbol; struct specifier_methods *meths; }; -typedef struct specifier_type_entry_dynarr_type +typedef struct { - Dynarr_declare (struct specifier_type_entry); + Dynarr_declare (specifier_type_entry); } specifier_type_entry_dynarr; specifier_type_entry_dynarr *the_specifier_type_entry_dynarr; @@ -76,7 +77,7 @@ not yet implemented. #### Look into this for 19.14. */ -lisp_dynarr current_specifiers; +Lisp_Object_dynarr current_specifiers; static void recompute_cached_specifier_everywhere (Lisp_Object specifier); @@ -401,12 +402,11 @@ static Lisp_Object make_specifier (struct specifier_methods *spec_meths) { - struct Lisp_Specifier *sp; Lisp_Object specifier = Qnil; struct gcpro gcpro1; - - sp = alloc_lcrecord (sizeof (struct Lisp_Specifier) + - spec_meths->extra_data_size - 1, lrecord_specifier); + struct Lisp_Specifier *sp = (struct Lisp_Specifier *) + alloc_lcrecord (sizeof (struct Lisp_Specifier) + + spec_meths->extra_data_size - 1, lrecord_specifier); sp->methods = spec_meths; sp->global_specs = Qnil; @@ -672,7 +672,7 @@ A specifier tag set consists of a list of zero of more specifier tags, each of which is a symbol that is recognized by XEmacs as a tag. (The valid device types and device classes are always tags, as are -any tags defined by `define-specifier-tag'.) It is called a \"tag set\" +any tags defined by `define-specifier-tag'.) It is called a "tag set" (as opposed to a list) because the order of the tags or the number of times a particular tag occurs does not matter. @@ -727,7 +727,7 @@ /* most common case */ return tag_set; - tags = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); + tags = alloca_array (Lisp_Object, len); i = 0; LIST_LOOP (rest, tag_set) @@ -1185,43 +1185,38 @@ enum spec_add_meth decode_how_to_add_specification (Lisp_Object how_to_add) { - enum spec_add_meth add_meth = 0; - if (NILP (how_to_add) || EQ (Qremove_tag_set_prepend, how_to_add)) - add_meth = SPEC_REMOVE_TAG_SET_PREPEND; - else if (EQ (Qremove_tag_set_append, how_to_add)) - add_meth = SPEC_REMOVE_TAG_SET_APPEND; - else if (EQ (Qappend, how_to_add)) - add_meth = SPEC_APPEND; - else if (EQ (Qprepend, how_to_add)) - add_meth = SPEC_PREPEND; - else if (EQ (Qremove_locale, how_to_add)) - add_meth = SPEC_REMOVE_LOCALE; - else if (EQ (Qremove_locale_type, how_to_add)) - add_meth = SPEC_REMOVE_LOCALE_TYPE; - else if (EQ (Qremove_all, how_to_add)) - add_meth = SPEC_REMOVE_ALL; - else - signal_simple_error ("Invalid `how-to-add' flag", how_to_add); - return add_meth; + return SPEC_REMOVE_TAG_SET_PREPEND; + if (EQ (Qremove_tag_set_append, how_to_add)) + return SPEC_REMOVE_TAG_SET_APPEND; + if (EQ (Qappend, how_to_add)) + return SPEC_APPEND; + if (EQ (Qprepend, how_to_add)) + return SPEC_PREPEND; + if (EQ (Qremove_locale, how_to_add)) + return SPEC_REMOVE_LOCALE; + if (EQ (Qremove_locale_type, how_to_add)) + return SPEC_REMOVE_LOCALE_TYPE; + if (EQ (Qremove_all, how_to_add)) + return SPEC_REMOVE_ALL; + + signal_simple_error ("Invalid `how-to-add' flag", how_to_add); + + return SPEC_PREPEND; /* not reached */ } /* This gets hit so much that the function call overhead had a measurable impact (according to Quantify). #### We should figure out the frequency with which this is called with the various types and reorder the check accordingly. */ -#define SPECIFIER_GET_SPEC_LIST(specifier, type) \ -(type == LOCALE_GLOBAL \ - ? &(XSPECIFIER (specifier)->global_specs) \ - : (type == LOCALE_DEVICE \ - ? &(XSPECIFIER (specifier)->device_specs) \ - : (type == LOCALE_FRAME \ - ? &(XSPECIFIER (specifier)->frame_specs) \ - : (type == LOCALE_WINDOW \ - ? &(XWEAK_LIST_LIST (XSPECIFIER (specifier)->window_specs)) \ - : (type == LOCALE_BUFFER \ - ? &(XSPECIFIER (specifier)->buffer_specs) \ - : 0))))) +#define SPECIFIER_GET_SPEC_LIST(specifier, type) \ +(type == LOCALE_GLOBAL ? &(XSPECIFIER (specifier)->global_specs) : \ + type == LOCALE_DEVICE ? &(XSPECIFIER (specifier)->device_specs) : \ + type == LOCALE_FRAME ? &(XSPECIFIER (specifier)->frame_specs) : \ + type == LOCALE_WINDOW ? &(XWEAK_LIST_LIST \ + (XSPECIFIER (specifier)->window_specs)) : \ + type == LOCALE_BUFFER ? &(XSPECIFIER (specifier)->buffer_specs) : \ + 0) static Lisp_Object * specifier_get_inst_list (Lisp_Object specifier, Lisp_Object locale, @@ -1746,8 +1741,8 @@ 'remove-tag-set-prepend (this is the default) Remove any existing instantiators whose tag set is the same as TAG-SET; then put the new instantiator - at the beginning of the current list. (\"Same tag - set\" means that they contain the same elements. + at the beginning of the current list. ("Same tag + set" means that they contain the same elements. The order may be different.) 'remove-tag-set-append Remove any existing instantiators whose tag set is @@ -1938,11 +1933,11 @@ Return the specification(s) for SPECIFIER in LOCALE. If LOCALE is a single locale or is a list of one element containing a -single locale, then a \"short form\" of the instantiators for that locale +single locale, then a "short form" of the instantiators for that locale will be returned. Otherwise, this function is identical to `specifier-spec-list'. -The \"short form\" is designed for readability and not for ease of use +The "short form" is designed for readability and not for ease of use in Lisp programs, and is as follows: 1. If there is only one instantiator, then an inst-pair (i.e. cons of @@ -2436,8 +2431,8 @@ `valid-specifier-domain-p'). DOMAIN defaults to the selected window if omitted. -\"Instantiating\" a specifier in a particular domain means determining -the specifier's \"value\" in that domain. This is accomplished by +"Instantiating" a specifier in a particular domain means determining +the specifier's "value" in that domain. This is accomplished by searching through the specifications in the specifier that correspond to all locales that can be derived from the given domain, from specific to general. In most cases, the domain is an Emacs window. In that case @@ -2491,7 +2486,7 @@ This function is identical to `specifier-instance' except that a specification will only be considered if it matches MATCHSPEC. -The definition of \"match\", and allowed values for MATCHSPEC, are +The definition of "match", and allowed values for MATCHSPEC, are dependent on the particular type of specifier. Here are some examples: -- For chartable (e.g. display table) specifiers, MATCHSPEC should be a @@ -2608,7 +2603,7 @@ struct Lisp_Specifier *sp = XSPECIFIER (specifier); if (!sp->caching) - sp->caching = malloc_type_and_zero (struct specifier_caching); + sp->caching = xnew_and_zero (struct specifier_caching); sp->caching->offset_into_struct_window = struct_window_offset; sp->caching->value_changed_in_window = value_changed_in_window; sp->caching->offset_into_struct_frame = struct_frame_offset; @@ -2979,7 +2974,7 @@ void specifier_type_create (void) { - the_specifier_type_entry_dynarr = Dynarr_new (struct specifier_type_entry); + the_specifier_type_entry_dynarr = Dynarr_new (specifier_type_entry); Vspecifier_type_list = Qnil; staticpro (&Vspecifier_type_list);
--- a/src/specifier.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/specifier.h Mon Aug 13 09:55:28 2007 +0200 @@ -152,22 +152,18 @@ /***** Defining new specifier types *****/ -#define DECLARE_SPECIFIER_TYPE(type) \ +#define DECLARE_SPECIFIER_TYPE(type) \ extern struct specifier_methods * type##_specifier_methods -#define DEFINE_SPECIFIER_TYPE(type) \ +#define DEFINE_SPECIFIER_TYPE(type) \ struct specifier_methods * type##_specifier_methods -#define INITIALIZE_SPECIFIER_TYPE(type, obj_name, pred_sym) \ - do { \ - type##_specifier_methods = \ - malloc_type_and_zero (struct specifier_methods); \ - type##_specifier_methods->name = obj_name; \ - defsymbol (&type##_specifier_methods->predicate_symbol, \ - pred_sym); \ - add_entry_to_specifier_type_list (Q##type, \ - type##_specifier_methods); \ - } while (0) \ +#define INITIALIZE_SPECIFIER_TYPE(type, obj_name, pred_sym) do { \ + type##_specifier_methods = xnew_and_zero (struct specifier_methods); \ + type##_specifier_methods->name = obj_name; \ + defsymbol (&type##_specifier_methods->predicate_symbol, pred_sym); \ + add_entry_to_specifier_type_list (Q##type, type##_specifier_methods); \ +} while (0) \ #define INITIALIZE_SPECIFIER_TYPE_WITH_DATA(type, obj_name, pred_sym) \ do { \
--- a/src/sunplay.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/sunplay.c Mon Aug 13 09:55:28 2007 +0200 @@ -61,8 +61,8 @@ # define warn(str) fprintf (stderr, "%s\n", (str)) #endif /* emacs */ -static SIGTYPE (*sighup_handler) (); -static SIGTYPE (*sigint_handler) (); +static SIGTYPE (*sighup_handler) (int sig); +static SIGTYPE (*sigint_handler) (int sig); static SIGTYPE sighandler (int sig); static int audio_fd; @@ -85,7 +85,7 @@ return 0; #else Audio_hdr file_hdr; - + reset_volume_p = 0; reset_device_p = 0; @@ -96,7 +96,7 @@ perror ("Not a valid audio device"); return 1; } - + if (AUDIO_SUCCESS != (data ? audio_decode_filehdr (data, &file_hdr, header_length) : audio_read_filehdr (fd, &file_hdr, 0, 0))) @@ -107,7 +107,7 @@ perror ("invalid audio file"); return 1; } - + audio_flush_play (audio_fd); if (0 != audio_cmp_hdr (&dev_hdr, &file_hdr)) @@ -166,7 +166,7 @@ int rrtn, wrtn; unsigned char buf [255]; int file_fd; - + audio_fd = audio_open (); if (audio_fd < 0) @@ -178,7 +178,7 @@ /* where to find the proto for signal()... */ sighup_handler = (SIGTYPE (*) (int)) signal (SIGHUP, sighandler); sigint_handler = (SIGTYPE (*) (int)) signal (SIGINT, sighandler); - + file_fd = open (sound_file, O_RDONLY, 0); if (file_fd < 0) { @@ -188,7 +188,7 @@ if (init_device (volume, (unsigned char *) 0, file_fd, (unsigned int *) 0)) goto END_OF_PLAY; - + while (1) { rrtn = read (file_fd, (char *) buf, sizeof (buf)); @@ -199,7 +199,7 @@ } if (rrtn == 0) break; - + while (1) { wrtn = write (audio_fd, (char *) buf, rrtn); @@ -222,7 +222,7 @@ goto END_OF_PLAY; } } - + END_OF_PLAY: if (file_fd > 0) @@ -271,15 +271,15 @@ /* where to find the proto for signal()... */ sighup_handler = (SIGTYPE (*) (int)) signal (SIGHUP, sighandler); sigint_handler = (SIGTYPE (*) (int)) signal (SIGINT, sighandler); - + if (init_device (volume, data, 0, &ilen)) goto END_OF_PLAY; - + data += (ilen<<2); length -= (ilen<<2); if (length <= 1) goto END_OF_PLAY; - + while (1) { wrtn = write (audio_fd, (char *) (data+start), length-start); @@ -303,7 +303,7 @@ warn (buf); goto END_OF_PLAY; } - + END_OF_PLAY: if (audio_fd > 0)
--- a/src/symbols.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/symbols.c Mon Aug 13 09:55:28 2007 +0200 @@ -2017,8 +2017,8 @@ { struct symbol_value_buffer_local *bfwd - = alloc_lcrecord (sizeof (struct symbol_value_buffer_local), - lrecord_symbol_value_buffer_local); + = alloc_lcrecord_type (struct symbol_value_buffer_local, + lrecord_symbol_value_buffer_local); Lisp_Object foo = Qnil; bfwd->magic.type = SYMVAL_BUFFER_LOCAL; @@ -2124,8 +2124,8 @@ } /* Make sure variable is set up to hold per-buffer values */ - bfwd = alloc_lcrecord (sizeof (struct symbol_value_buffer_local), - lrecord_symbol_value_buffer_local); + bfwd = alloc_lcrecord_type (struct symbol_value_buffer_local, + lrecord_symbol_value_buffer_local); bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL; bfwd->current_buffer = Qnil; @@ -2662,12 +2662,12 @@ that will be called to control this behavior. HARG is a value that will be passed to HANDLER but is otherwise uninterpreted. KEEP-EXISTING specifies what to do with existing -handlers of the same type; nil means \"erase them all\", t means -\"keep them but insert at the beginning\", the list (t) means -\"keep them but insert at the end\", a function means \"keep -them but insert before the specified function\", a list containing -a function means \"keep them but insert after the specified -function\". +handlers of the same type; nil means "erase them all", t means +"keep them but insert at the beginning", the list (t) means +"keep them but insert at the end", a function means "keep +them but insert before the specified function", a list containing +a function means "keep them but insert after the specified +function". You can specify magic behavior for any type of variable at all, and for any handler types that are unspecified, the standard @@ -2878,8 +2878,8 @@ valcontents = XSYMBOL (variable)->value; if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents)) { - bfwd = alloc_lcrecord (sizeof (struct symbol_value_lisp_magic), - lrecord_symbol_value_lisp_magic); + bfwd = alloc_lcrecord_type (struct symbol_value_lisp_magic, + lrecord_symbol_value_lisp_magic); bfwd->magic.type = SYMVAL_LISP_MAGIC; for (i = 0; i < MAGIC_HANDLER_MAX; i++) { @@ -3018,8 +3018,8 @@ signal_simple_error ("Variable is magic and cannot be aliased", variable); reject_constant_symbols (variable, Qunbound, 0, Qt); - bfwd = alloc_lcrecord (sizeof (struct symbol_value_varalias), - lrecord_symbol_value_varalias); + bfwd = alloc_lcrecord_type (struct symbol_value_varalias, + lrecord_symbol_value_varalias); bfwd->magic.type = SYMVAL_VARALIAS; bfwd->aliasee = alias; bfwd->shadowed = valcontents; @@ -3139,7 +3139,7 @@ /* abort (); */ /* Can't represent a pointer to constant C data using a Lisp_Object. So heap-allocate it. */ - struct symbol_value_magic *urk = xmalloc (sizeof (*urk)); + struct symbol_value_magic *urk = xnew (struct symbol_value_magic); memcpy (urk, &guts_of_unbound_marker, sizeof (*urk)); XSETSYMBOL_VALUE_MAGIC (Qunbound, urk); } @@ -3298,7 +3298,7 @@ Qnil); /* Check that magic points somewhere we can represent as a Lisp pointer */ - XSETOBJ (kludge, Lisp_Record, magic); + XSETOBJ (kludge, Lisp_Type_Record, magic); if (magic != (CONST void *) XPNTR (kludge)) { /* This might happen on DATA_SEG_BITS machines. */ @@ -3306,10 +3306,10 @@ /* Copy it to somewhere which is representable. */ void *f = xmalloc (sizeof_magic); memcpy (f, magic, sizeof_magic); - XSETOBJ (XSYMBOL (sym)->value, Lisp_Record, f); + XSETOBJ (XSYMBOL (sym)->value, Lisp_Type_Record, f); } else - XSETOBJ (XSYMBOL (sym)->value, Lisp_Record, magic); + XSETOBJ (XSYMBOL (sym)->value, Lisp_Type_Record, magic); } void
--- a/src/symeval.h Mon Aug 13 09:54:24 2007 +0200 +++ b/src/symeval.h Mon Aug 13 09:55:28 2007 +0200 @@ -26,56 +26,53 @@ #ifndef _XEMACS_SYMEVAL_H_ #define _XEMACS_SYMEVAL_H_ +enum symbol_value_type +{ + /* The following tags use the 'symbol_value_forward' structure + and are strictly for variables DEFVARed on the C level. */ + SYMVAL_FIXNUM_FORWARD, /* Forward C "int" */ + SYMVAL_CONST_FIXNUM_FORWARD, /* Same, but can't be set */ + SYMVAL_BOOLEAN_FORWARD, /* Forward C boolean ("int") */ + SYMVAL_CONST_BOOLEAN_FORWARD, /* Same, but can't be set */ + SYMVAL_OBJECT_FORWARD, /* Forward C Lisp_Object */ + SYMVAL_CONST_OBJECT_FORWARD, /* Same, but can't be set */ + SYMVAL_CONST_SPECIFIER_FORWARD, /* Same, can't be set, but gives a + different message when attempting to + set that says "use set-specifier" */ + SYMVAL_DEFAULT_BUFFER_FORWARD, /* Forward Lisp_Object into Vbuffer_defaults */ + SYMVAL_CURRENT_BUFFER_FORWARD, /* Forward Lisp_Object into current_buffer */ + SYMVAL_CONST_CURRENT_BUFFER_FORWARD, /* Forward Lisp_Object into + current_buffer, can't be set */ + SYMVAL_DEFAULT_CONSOLE_FORWARD, /* Forward Lisp_Object into + Vconsole_defaults */ + SYMVAL_SELECTED_CONSOLE_FORWARD, /* Forward Lisp_Object into + Vselected_console */ + SYMVAL_CONST_SELECTED_CONSOLE_FORWARD, /* Forward Lisp_Object into + Vselected_console, + can't be set */ + SYMVAL_UNBOUND_MARKER, /* Only Qunbound actually has this tag */ + + /* The following tags use the 'symbol_value_buffer_local' structure */ + SYMVAL_BUFFER_LOCAL, /* make-variable-buffer-local */ + SYMVAL_SOME_BUFFER_LOCAL, /* make-local-variable */ + + /* The following tag uses the 'symbol_value_lisp_magic' structure */ + SYMVAL_LISP_MAGIC, /* Forward to lisp callbacks */ + + /* The following tag uses the 'symbol_value_varalias' structure */ + SYMVAL_VARALIAS /* defvaralias */ + +#if 0 + /* NYI */ + SYMVAL_CONSTANT_SYMBOL, /* Self-evaluating symbol */ + /* NYI */ +#endif +}; + struct symbol_value_magic { struct lcrecord_header lcheader; - enum - { - /* The following tags use the 'symbol_value_forward' structure - and are strictly for variables DEFVARed on the C level. */ - SYMVAL_FIXNUM_FORWARD, /* Forward C "int" */ - SYMVAL_CONST_FIXNUM_FORWARD, /* Same, but can't be set */ - SYMVAL_BOOLEAN_FORWARD, /* Forward C boolean ("int") */ - SYMVAL_CONST_BOOLEAN_FORWARD, /* Same, but can't be set */ - SYMVAL_OBJECT_FORWARD, /* Forward C Lisp_Object */ - SYMVAL_CONST_OBJECT_FORWARD, /* Same, but can't be set */ - SYMVAL_CONST_SPECIFIER_FORWARD, /* Same, can't be set, but gives - a different message when attempting - to set that says "use set-specifier" - */ - SYMVAL_DEFAULT_BUFFER_FORWARD, /* Forward Lisp_Object into - Vbuffer_defaults */ - SYMVAL_CURRENT_BUFFER_FORWARD, /* Forward Lisp_Object into - current_buffer */ - SYMVAL_CONST_CURRENT_BUFFER_FORWARD, /* Forward Lisp_Object into - current_buffer, can't - be set */ - SYMVAL_DEFAULT_CONSOLE_FORWARD, /* Forward Lisp_Object into - Vconsole_defaults */ - SYMVAL_SELECTED_CONSOLE_FORWARD, /* Forward Lisp_Object into - Vselected_console */ - SYMVAL_CONST_SELECTED_CONSOLE_FORWARD, /* Forward Lisp_Object into - Vselected_console, can't - be set */ - SYMVAL_UNBOUND_MARKER, /* Only Qunbound actually has this - tag */ - - /* The following tags use the 'symbol_value_buffer_local' structure */ - SYMVAL_BUFFER_LOCAL, /* make-variable-buffer-local */ - SYMVAL_SOME_BUFFER_LOCAL, /* make-local-variable */ - - /* The following tag uses the 'symbol_value_lisp_magic' structure */ - SYMVAL_LISP_MAGIC, /* Forward to lisp callbacks */ - - /* The following tag uses the 'symbol_value_varalias' structure */ - SYMVAL_VARALIAS /* defvaralias */ - -#if 0 - /* NYI */ - SYMVAL_CONSTANT_SYMBOL, /* Self-evaluating symbol */ - /* NYI */ -#endif - } type; + enum symbol_value_type type; }; #define SYMBOL_VALUE_MAGIC_P(x) \ (LRECORDP (x) \ @@ -83,7 +80,7 @@ == print_symbol_value_magic)) #define XSYMBOL_VALUE_MAGIC_TYPE(v) \ (((struct symbol_value_magic *) XPNTR (v))->type) -#define XSETSYMBOL_VALUE_MAGIC(s, p) XSETOBJ (s, Lisp_Record, p) +#define XSETSYMBOL_VALUE_MAGIC(s, p) XSETOBJ (s, Lisp_Type_Record, p) extern void print_symbol_value_magic (Lisp_Object, Lisp_Object, int); /********** The various different symbol-value-magic types ***********/ @@ -98,7 +95,7 @@ Then, the symbol's value field contains a symbol-value-buffer-local, whose CURRENT-VALUE field then contains a symbol-value-forward. */ - + extern CONST_IF_NOT_DEBUG struct lrecord_implementation lrecord_symbol_value_forward[]; struct symbol_value_forward @@ -140,7 +137,7 @@ or implicitly by the current buffer being changed. */ - + int (*magicfun) (Lisp_Object sym, Lisp_Object *val, Lisp_Object in_object, int flags); }; @@ -206,7 +203,7 @@ These slots are called CURRENT-BUFFER, CURRENT-VALUE, and CURRENT-ALIST-ELEMENT, respectively. - + If we want to examine or set the value in BUFFER and CURRENT-BUFFER equals BUFFER, we just examine or set CURRENT-VALUE. Otherwise, we store CURRENT-VALUE value into CURRENT-ALIST-ELEMENT (or maybe @@ -214,17 +211,17 @@ BUFFER and set up CURRENT-ALIST-ELEMENT. Then we set CURRENT-VALUE out of that element (or maybe out of DEFAULT-VALUE), and store BUFFER into CURRENT-BUFFER. - + If we are setting the variable and the current buffer does not have an alist entry for this variable, an alist entry is created. - + Note that CURRENT-BUFFER's local_var_alist value for this variable might be out-of-date (the correct value is stored in CURRENT-VALUE). Similarly, if CURRENT-BUFFER sees the default value, then DEFAULT-VALUE might be out-of-date. - + Note that CURRENT-VALUE (but not DEFAULT-VALUE) can be a - forwarding pointer. Each time it is examined or set, + forwarding pointer. Each time it is examined or set, forwarding must be done. */ Lisp_Object default_value; @@ -303,58 +300,52 @@ extern void defvar_mumble (CONST char *names, CONST void *magic, int sizeof_magic); -#define DEFVAR_HEADER(lname, c_location, forward_type) \ - static CONST struct symbol_value_forward I_hate_C \ - = { { { { lrecord_symbol_value_forward }, (void *) (c_location), 69 }, \ - forward_type }, 0 }; \ - defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C)) +#define DEFVAR_HEADER(lname, c_location, forward_type) do { \ + static CONST struct symbol_value_forward I_hate_C \ + = { { { { lrecord_symbol_value_forward }, \ + (struct lcrecord_header *) (c_location), 69 }, \ + forward_type }, 0 }; \ + defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C)); \ +} while (0) -#define DEFVAR_MAGIC_HEADER(lname, c_location, forward_type, magicfun) \ - static CONST struct symbol_value_forward I_hate_C \ - = { { { { lrecord_symbol_value_forward }, (void *) (c_location), 69 }, \ - forward_type }, magicfun }; \ - defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C)) +#define DEFVAR_MAGIC_HEADER(lname, c_location, forward_type, magicfun) do { \ + static CONST struct symbol_value_forward I_hate_C \ + = { { { { lrecord_symbol_value_forward }, \ + (struct lcrecord_header *) (c_location), 69 }, \ + forward_type }, magicfun }; \ + defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C)); \ +} while (0) /* These discard their DOC arg because it is snarfed by make-docfile * and stored in an external file. */ -#define DEFVAR_LISP(lname, c_location) \ - do { DEFVAR_HEADER (lname, c_location, SYMVAL_OBJECT_FORWARD); \ - staticpro (c_location); \ - } while (0) -#define DEFVAR_CONST_LISP(lname, c_location) \ - do { DEFVAR_HEADER (lname, c_location, SYMVAL_CONST_OBJECT_FORWARD); \ - staticpro (c_location); \ - } while (0) -#define DEFVAR_SPECIFIER(lname, c_location) \ - do { DEFVAR_HEADER (lname, c_location, SYMVAL_CONST_SPECIFIER_FORWARD); \ - staticpro (c_location); \ - } while (0) -#define DEFVAR_INT(lname, c_location) \ - do { DEFVAR_HEADER (lname, c_location, SYMVAL_FIXNUM_FORWARD); \ - } while (0) -#define DEFVAR_CONST_INT(lname, c_location) \ - do { DEFVAR_HEADER (lname, c_location, SYMVAL_CONST_FIXNUM_FORWARD); \ - } while (0) -#define DEFVAR_BOOL(lname, c_location) \ - do { DEFVAR_HEADER (lname, c_location, SYMVAL_BOOLEAN_FORWARD);\ - } while (0) -#define DEFVAR_CONST_BOOL(lname, c_location) \ - do { DEFVAR_HEADER (lname, c_location, SYMVAL_CONST_BOOLEAN_FORWARD); \ - } while (0) +#define DEFVAR_HEADER_GCPRO(lname, c_location, symbol_value_type) do { \ + DEFVAR_HEADER (lname, c_location, symbol_value_type); \ + staticpro (c_location); \ +} while (0) -#define DEFVAR_LISP_MAGIC(lname, c_location, magicfun) \ - do { DEFVAR_MAGIC_HEADER (lname, c_location, \ - SYMVAL_OBJECT_FORWARD, magicfun); \ - staticpro (c_location); \ - } while (0) -#define DEFVAR_INT_MAGIC(lname, c_location, magicfun) \ - do { DEFVAR_MAGIC_HEADER (lname, c_location, \ - SYMVAL_FIXNUM_FORWARD, magicfun); \ - } while (0) -#define DEFVAR_BOOL_MAGIC(lname, c_location, magicfun) \ - do { DEFVAR_MAGIC_HEADER (lname, c_location, \ - SYMVAL_BOOLEAN_FORWARD, magicfun); \ - } while (0) +#define DEFVAR_LISP(lname, c_location) \ + DEFVAR_HEADER_GCPRO (lname, c_location, SYMVAL_OBJECT_FORWARD) +#define DEFVAR_CONST_LISP(lname, c_location) \ + DEFVAR_HEADER_GCPRO (lname, c_location, SYMVAL_CONST_OBJECT_FORWARD) +#define DEFVAR_SPECIFIER(lname, c_location) \ + DEFVAR_HEADER_GCPRO (lname, c_location, SYMVAL_CONST_SPECIFIER_FORWARD) +#define DEFVAR_INT(lname, c_location) \ + DEFVAR_HEADER (lname, c_location, SYMVAL_FIXNUM_FORWARD) +#define DEFVAR_CONST_INT(lname, c_location) \ + DEFVAR_HEADER (lname, c_location, SYMVAL_CONST_FIXNUM_FORWARD) +#define DEFVAR_BOOL(lname, c_location) \ + DEFVAR_HEADER (lname, c_location, SYMVAL_BOOLEAN_FORWARD) +#define DEFVAR_CONST_BOOL(lname, c_location) \ + DEFVAR_HEADER (lname, c_location, SYMVAL_CONST_BOOLEAN_FORWARD) + +#define DEFVAR_LISP_MAGIC(lname, c_location, magicfun) do { \ + DEFVAR_MAGIC_HEADER (lname, c_location, SYMVAL_OBJECT_FORWARD, magicfun); \ + staticpro (c_location); \ +} while (0) +#define DEFVAR_INT_MAGIC(lname, c_location, magicfun) \ + DEFVAR_MAGIC_HEADER (lname, c_location, SYMVAL_FIXNUM_FORWARD, magicfun); +#define DEFVAR_BOOL_MAGIC(lname, c_location, magicfun) \ + DEFVAR_MAGIC_HEADER (lname, c_location, SYMVAL_BOOLEAN_FORWARD, magicfun); #endif /* _XEMACS_SYMEVAL_H_ */
--- a/src/syntax.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/syntax.c Mon Aug 13 09:55:28 2007 +0200 @@ -74,7 +74,7 @@ /* Tell the regex routines which buffer to access for SYNTAX() lookups and the like. */ struct buffer *regex_emacs_buffer; - + Lisp_Object Vstandard_syntax_table; Lisp_Object Vsyntax_designator_chars_string; @@ -354,7 +354,7 @@ while (count > 0) { QUIT; - + while (1) { if (from == limit) @@ -372,7 +372,7 @@ } count--; } - + while (count < 0) { QUIT; @@ -421,7 +421,7 @@ static void scan_sexps_forward (struct buffer *buf, struct lisp_parse_state *, - Bufpos from, Bufpos end, + Bufpos from, Bufpos end, int targetdepth, int stopbefore, Lisp_Object oldstate, int commentstop); @@ -438,7 +438,7 @@ When we reach a safe place, assume that's not in a string; then step the main scan to the earliest comment-starter seen an even number of string quotes away from the safe place. - + OFROM[I] is position of the earliest comment-starter seen which is I+2X quotes from the comment-end. PARITY is current parity of quotes from the comment end. */ @@ -477,7 +477,7 @@ BUF_FETCH_CHAR (buf, from+1), mask); } - + /* or are we looking at a 1-char comment start sequence of the style matching mask? */ else if (code == Scomment @@ -485,7 +485,7 @@ { styles_match_p = 1; } - + /* or possibly, a 2-char comment start sequence */ else if (from >= stop && SYNTAX_STYLES_MATCH_START_P (mirrortab, c, @@ -656,7 +656,7 @@ else if (from < stop && SYNTAX_START_P (mirrortab, c, BUF_FETCH_CHAR (buf, from+1))) { - /* we have encountered a 2char comment start sequence and we + /* we have encountered a 2char comment start sequence and we are ignoring all text inside comments. we must record the comment style this sequence begins so that later, only a comment end of the same style actually ends @@ -712,7 +712,7 @@ from--; continue; } - + c = BUF_FETCH_CHAR (buf, from); code = SYNTAX (mirrortab, c); @@ -800,7 +800,7 @@ && SYNTAX_START_P (mirrortab, c, BUF_FETCH_CHAR (buf, from)) && parse_sexp_ignore_comments) { - /* we have encountered a comment start sequence and we + /* we have encountered a comment start sequence and we are ignoring all text inside comments. we must record the comment style this sequence begins so that later, only a comment end of the same style actually ends @@ -810,7 +810,7 @@ BUF_FETCH_CHAR (buf, from)); from++; } - + if (SYNTAX_PREFIX_UNSAFE (mirrortab, c)) continue; @@ -900,7 +900,7 @@ stringterm = XCHAR (stermobj); else stringterm = ch; - + while (1) { if (from >= stop) @@ -922,7 +922,7 @@ if (!depth && sexpflag) goto done; break; } - + default: break; } @@ -987,13 +987,13 @@ case Sword: case Ssymbol: if (depth || !sexpflag) break; - /* This word counts as a sexp; count object finished after + /* This word counts as a sexp; count object finished after passing it. */ while (from > stop) { enum syntaxcode syncode; quoted = char_quoted (buf, from - 1); - + if (quoted) from--; if (! (quoted @@ -1164,7 +1164,7 @@ DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, 0, 1, 0, /* Move point backward over any number of chars with prefix syntax. -This includes chars with \"quote\" or \"prefix\" syntax (' or p). +This includes chars with "quote" or "prefix" syntax (' or p). Optional arg BUFFER defaults to the current buffer. */ @@ -1193,7 +1193,7 @@ static void scan_sexps_forward (struct buffer *buf, struct lisp_parse_state *stateptr, - Bufpos from, Bufpos end, + Bufpos from, Bufpos end, int targetdepth, int stopbefore, Lisp_Object oldstate, int commentstop) @@ -1287,7 +1287,7 @@ state.comstyle = (mask == SYNTAX_COMMENT_STYLE_B); state.comstart = from - 1; } - + else if (from < end && SYNTAX_START_P (mirrortab, BUF_FETCH_CHAR (buf, from-1), BUF_FETCH_CHAR (buf, from))) @@ -1577,7 +1577,7 @@ { struct chartab_range range; struct cmst_arg arg; - + arg.mirrortab = ct->mirror_table; arg.check_inherit = (CHAR_TABLEP (Vstandard_syntax_table) && ct != XCHAR_TABLE (Vstandard_syntax_table)); @@ -1718,7 +1718,7 @@ Vstandard_syntax_table); Fput_char_table (make_char ('\\'), make_int ((int) Sescape), Vstandard_syntax_table); - + { CONST char *p; for (p = "_-+*/&|<>="; *p; p++)
--- a/src/sysdep.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/sysdep.c Mon Aug 13 09:55:28 2007 +0200 @@ -112,7 +112,7 @@ #endif /* USG */ #ifdef HAVE_SYS_STROPTS_H -#include <sys/stropts.h> +#include <sys/stropts.h> #endif /* HAVE_SYS_STROPTS_H */ /* LPASS8 is new in 4.3, and makes cbreak mode provide all 8 bits. */ @@ -401,7 +401,7 @@ * flush any pending output * (may flush input as well; it does not matter the way we use it) */ - + void flush_pending_output (int channel) { @@ -646,7 +646,7 @@ #ifdef SET_EMACS_PRIORITY if (emacs_priority != 0) - nice (-emacs_priority); /* Give the new shell the default priority */ + nice (-emacs_priority); /* Give the new shell the default priority */ #endif #ifdef MSDOS @@ -755,8 +755,7 @@ /* Suspend a process if possible; give terminal to its superior. */ void -sys_suspend_process (process) - int process; +sys_suspend_process (int process) { /* I don't doubt that it is possible to suspend processes on * VMS machines or thost that use USG_JOBCTRL, @@ -788,7 +787,7 @@ #elif defined (TIOCSSIZE) /* SunOS - style. */ - struct ttysize size; + struct ttysize size; size.ts_lines = height; size.ts_cols = width; @@ -822,13 +821,13 @@ does this. Also it is known that telnet mode will hang in such a way that Emacs must be stopped (perhaps this is the same problem). - + If TIOCREMOTE is turned off, then there is a bug in hp-ux which sometimes loses data. Apparently the code which blocks the master process when the internal buffer fills up does not work. Other than this, though, everything else seems to work fine. - + Since the latter lossage is more benign, we may as well lose that way. -- cph */ #if defined (FIONBIO) && defined (SYSV_PTYS) @@ -891,13 +890,13 @@ DEVICE_TTY_DATA (d)->ospeed = 15; #elif defined (VMS) struct vms_sensemode sg; - + SYS$QIOW (0, input_fd, IO$_SENSEMODE, &sg, 0, 0, &sg.class, 12, 0, 0, 0, 0 ); DEVICE_TTY_DATA (d)->ospeed = sg.xmit_baud; #elif defined (HAVE_TERMIOS) struct termios sg; - + sg.c_cflag = B9600; tcgetattr (input_fd, &sg); DEVICE_TTY_DATA (d)->ospeed = cfgetospeed (&sg); @@ -908,7 +907,7 @@ # endif #elif defined (HAVE_TERMIO) struct termio sg; - + sg.c_cflag = B9600; # ifdef HAVE_TCATTR tcgetattr (input_fd, &sg); @@ -918,14 +917,14 @@ DEVICE_TTY_DATA (d)->ospeed = sg.c_cflag & CBAUD; #else /* neither VMS nor TERMIOS nor TERMIO */ struct sgttyb sg; - + sg.sg_ospeed = B9600; if (ioctl (input_fd, TIOCGETP, &sg) < 0) abort (); DEVICE_TTY_DATA (d)->ospeed = sg.sg_ospeed; #endif } - + DEVICE_BAUD_RATE (d) = (DEVICE_TTY_DATA (d)->ospeed < sizeof baud_convert / sizeof baud_convert[0] ? baud_convert[DEVICE_TTY_DATA (d)->ospeed] @@ -1091,7 +1090,7 @@ { ioctl_status = ioctl (filedesc, FIOSSAIOSTAT, &off); } - else + else { ioctl_status = ioctl (filedesc, FIOASYNC, &off); } @@ -1255,7 +1254,7 @@ Also record whether we were in our own process group. (In general, we will already be in our own process group if we were started from a job-control shell like csh, but not if we were started from sh). - + If we succeeded in changing our process group, then we will no longer be in the foreground process group of our controlling terminal. Therefore, if we have a console open onto this terminal, @@ -1312,7 +1311,7 @@ disconnect our controlling terminal. Here is what the man page for termio(7) from a SYSV 3.2 system says: - + "The first terminal file opened by the process group leader of a terminal file not already associated with a process group becomes the control terminal for that process group. @@ -1321,7 +1320,7 @@ terminal is inherited by a child process during a fork(2). A process can break this association by changing its process group using setpgrp(2)." - + */ # endif /* not HAVE_SETSID */ } @@ -1470,7 +1469,7 @@ || ioctl (fd, TIOCLSET, &settings->lmode) < 0) return -1; #endif - + /* We have survived the tempest. */ return 0; } @@ -1494,7 +1493,7 @@ #else char _sobuf[BUFSIZ]; #endif - + #if defined (TIOCGLTC) && defined (HAVE_LTCHARS) /* HAVE_LTCHARS */ static struct ltchars new_ltchars = {-1,-1,-1,-1,-1,-1}; #endif @@ -1502,7 +1501,7 @@ #ifdef HAVE_TCHARS static struct tchars new_tchars = {-1,-1,-1,-1,-1,-1}; #endif -#endif +#endif static void tty_init_sys_modes_on_device (struct device *d) @@ -1546,7 +1545,7 @@ } else tty.main.c_iflag &= ~IXON; /* Disable start/stop output control */ - tty.main.c_oflag &= ~ONLCR; /* Disable map of NL to CR-NL + tty.main.c_oflag &= ~ONLCR; /* Disable map of NL to CR-NL on output */ tty.main.c_oflag &= ~TAB3; /* Disable tab expansion */ #ifdef CS8 @@ -1615,7 +1614,7 @@ Ultrix's termios does not work correctly. */ tty.main.c_line = SET_LINE_DISCIPLINE; #endif - + #ifdef AIX #ifndef IBMR2AIX /* AIX enhanced edit loses NULs, so disable it. */ @@ -1644,7 +1643,7 @@ tty.main.sg_flags |= /* interrupt_input ? RAW : */ CBREAK; #endif /* not MSDOS */ #endif /* not HAVE_TERMIO */ - + /* If going to use CBREAK mode, we must request C-g to interrupt and turn off start and stop chars, etc. If not going to use CBREAK mode, do this anyway so as to turn off local flow @@ -1661,10 +1660,10 @@ tty.tchars.t_startc = '\021'; tty.tchars.t_stopc = '\023'; } - + tty.lmode = LDECCTQ | LLITOUT | LPASS8 | LNOFLSH | CONSOLE_TTY_DATA (con)->old_tty.lmode; - + #if defined (ultrix) || defined (__bsdi__) /* Under Ultrix 4.2a, leaving this out doesn't seem to hurt anything, and leaving it in breaks the meta key. Go figure. */ @@ -1673,10 +1672,10 @@ doesn't get reset after XEmacs goes away. */ tty.lmode &= ~LLITOUT; #endif - + #endif /* HAVE_TCHARS */ #endif /* not HAVE_TERMIO */ - + #ifdef HAVE_LTCHARS tty.ltchars = new_ltchars; #endif /* HAVE_LTCHARS */ @@ -1684,12 +1683,12 @@ internal_terminal_init (); dos_ttraw (); #endif - + EMACS_SET_TTY (input_fd, &tty, 0); - + /* This code added to insure that, if flow-control is not to be used, we have an unlocked terminal at the start. */ - + #ifdef TCXONC if (!TTY_FLAGS (con).flow_control) ioctl (input_fd, TCXONC, 1); #endif @@ -1698,7 +1697,7 @@ if (!TTY_FLAGS (con).flow_control) ioctl (input_fd, TIOCSTART, 0); #endif #endif - + #if defined (HAVE_TERMIOS) || defined (HPUX9) #ifdef TCOON if (!TTY_FLAGS (con).flow_control) tcflow (input_fd, TCOON); @@ -1712,7 +1711,7 @@ We need it to be only LF. This is the way that is done. */ struct termio tty; - + if (ioctl (output_fd, HFTGETID, &tty) != -1) write (output_fd, "\033[20l", 5); } @@ -1766,7 +1765,7 @@ CONSOLE_DEVICE_LOOP (devcons, con) { struct device *d = XDEVICE (XCAR (devcons)); - + init_one_device (d); } } @@ -1791,7 +1790,7 @@ /* Return nonzero if safe to use tabs in output. At the time this is called, init_sys_modes has not been done yet. */ - + int tabs_safe_p (struct device *d) { @@ -1799,7 +1798,7 @@ if (DEVICE_TTY_P (d)) { struct emacs_tty tty; - + EMACS_GET_TTY (DEVICE_INFD (d), &tty); return EMACS_TTY_TABS_OK (&tty); } @@ -1824,7 +1823,7 @@ { /* BSD-style. */ struct winsize size; - + if (ioctl (input_fd, TIOCGWINSZ, &size) == -1) *widthp = *heightp = 0; else @@ -1837,8 +1836,8 @@ #ifdef TIOCGSIZE { /* SunOS - style. */ - struct ttysize size; - + struct ttysize size; + if (ioctl (input_fd, TIOCGSIZE, &size) == -1) *widthp = *heightp = 0; else @@ -1851,7 +1850,7 @@ #ifdef VMS { struct vms_sensemode tty; - + SYS$QIOW (0, input_fd, IO$_SENSEMODE, &tty, 0, 0, &tty.class, 12, 0, 0, 0, 0); *widthp = tty.scr_wid; @@ -1925,10 +1924,10 @@ #if defined (IBMR2AIX) && defined (AIXHFT) { - /* HFT consoles normally use ^J as a LF/CR. We forced it to + /* HFT consoles normally use ^J as a LF/CR. We forced it to do the LF only. Now, we need to reset it. */ struct termio tty; - + if (ioctl (output_fd, HFTGETID, &tty) != -1) write (output_fd, "\033[20h", 5); } @@ -1937,7 +1936,7 @@ tty_redisplay_shutdown (con); /* reset_tty_modes() flushes the connection at its end. */ reset_tty_modes (con); - + #if defined (BSD) /* Avoid possible loss of output when changing terminal modes. */ fsync (output_fd); @@ -1946,11 +1945,11 @@ while (EMACS_SET_TTY (input_fd, &CONSOLE_TTY_DATA (con)->old_tty, 0) < 0 && errno == EINTR) ; - + #ifdef MSDOS dos_ttcooked (); #endif - + #ifdef SET_LINE_DISCIPLINE /* Ultrix's termios *ignores* any line discipline except TERMIODISC. A different old line discipline is therefore not restored, yet. @@ -1997,7 +1996,7 @@ CONSOLE_DEVICE_LOOP (devcons, con) { struct device *d = XDEVICE (XCAR (devcons)); - + reset_one_device (d); } } @@ -2011,7 +2010,7 @@ CONSOLE_LOOP (concons) { struct console *con = XCONSOLE (XCAR (concons)); - + reset_one_console (con); } @@ -2046,7 +2045,7 @@ /* If we're not on an HFT we shouldn't do any of this. We determine if we are on an HFT by trying to get an HFT error code. If this - call fails, we're not on an HFT. */ + call fails, we're not on an HFT. */ #ifdef IBMR2AIX if (ioctl (input_fd, HFQERROR, &junk) < 0) return; @@ -2157,7 +2156,7 @@ { /* #### broken. */ int status; - + if (input_fd == 0) { status = SYS$ASSIGN (&vms_input_dsc, &input_fd, 0, 0); @@ -2213,7 +2212,7 @@ exit (1); printf ("Ast # %d,", vms_input_count); printf (" iosb = %x, %x, %x, %x", - vms_input_iosb.offset, vms_input_iosb.status, + vms_input_iosb.offset, vms_input_iosb.status, vms_input_iosb.termlen, vms_input_iosb.term); #endif if (vms_input_iosb.offset) @@ -2378,6 +2377,12 @@ * */ +#ifdef __cplusplus + extern "C" int _start (); +#else + extern int _start (); +#endif + #ifndef HAVE_TEXT_START char * start_of_text (void) @@ -2389,7 +2394,6 @@ extern csrt (); return ((char *) csrt); #else /* not GOULD */ - extern int _start (); return ((char *) _start); #endif /* GOULD */ #endif /* TEXT_START */ @@ -2421,7 +2425,7 @@ * will be patched by unexec to the correct value. * */ - + void * start_of_data (void) { @@ -2453,7 +2457,7 @@ * Return the address of the end of the text segment prior to * doing an unexec. After unexec the return value is undefined. */ - + char * end_of_text (void) { @@ -2464,7 +2468,7 @@ return ((char *) &etext); #endif } - + /* * Return the address of the end of the data segment prior to * doing an unexec. After unexec the return value is undefined. @@ -2616,7 +2620,7 @@ You can't use X under it (I think) because there's no select(). Anyway, the signal stuff has all been changed. If someone wants to get this stuff working again, look in the FSF Emacs sources. */ - + /* POSIX signals support - DJB */ #ifdef HAVE_SIGPROCMASK @@ -2815,7 +2819,7 @@ { int mode; va_list ap; - + va_start (ap, oflag); mode = va_arg (ap, int); va_end (ap); @@ -2895,7 +2899,7 @@ #else int rtnval; int bytes_written = 0; - CONST char *b = buf; + CONST char *b = (CONST char *) buf; /* No harm in looping regardless of the INTERRUPTIBLE_IO setting. */ while (nbyte > 0) @@ -3082,7 +3086,7 @@ #ifdef ENCAPSULATE_READDIR DIRENTRY * sys_readdir (DIR *dirp) -{ +{ DIRENTRY *rtnval; /* Apparently setting errno is necessary on some systems? @@ -3099,7 +3103,7 @@ Extcount external_len; int ascii_filename_p = 1; CONST Extbyte * CONST external_name = (CONST Extbyte *) rtnval->d_name; - + /* Optimize for the common all-ASCII case, computing len en passant */ for (external_len = 0; external_name[external_len] ; external_len++) { @@ -3110,7 +3114,7 @@ return rtnval; { /* Non-ASCII filename */ - static bufbyte_dynarr *internal_DIRENTRY; + static Bufbyte_dynarr *internal_DIRENTRY; CONST Bufbyte *internal_name; Bytecount internal_len; if (!internal_DIRENTRY) @@ -3289,11 +3293,11 @@ { int i, argc; CONST char ** new_argv; - + PATHNAME_CONVERT_OUT (path); for (argc = 0; argv[argc]; argc++) ; - new_argv = (CONST char **) alloca ( (argc + 1) * sizeof (* new_argv)); + new_argv = alloca_array (CONST char *, argc + 1); for (i = 0; i < argc; i++) GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA (argv[i], new_argv[i]); new_argv[argc] = NULL; @@ -3392,7 +3396,7 @@ dup2 (int oldd, int newd) { int fd, ret; - + sys_close (newd); #ifdef F_DUPFD @@ -3419,21 +3423,21 @@ */ #if !defined (HAVE_GETTIMEOFDAY) - + int gettimeofday (struct timeval *tp, struct timezone *tzp) { extern long time (); - tp->tv_sec = time ((long *)0); + tp->tv_sec = time ((long *)0); tp->tv_usec = 0; if (tzp != 0) tzp->tz_minuteswest = -1; return (0); } - + #endif /* !HAVE_GETTIMEOFDAY */ - + /* No need to encapsulate utime and utimes explicitly because all access to those functions goes through the following. */ @@ -4173,7 +4177,7 @@ #ifdef access #undef access - + /* The following is necessary because 'access' emulation by VMS C (2.0) does * not work correctly. (It also doesn't work well in version 2.3.) */ @@ -4212,7 +4216,7 @@ * access can treat the directory like a file. */ if (directory_file_name (path, dir_fn)) path = dir_fn; - + if (mode == F_OK) return access (path, mode); if (user == NULL && (user = (char *) getenv ("USER")) == NULL) @@ -4226,7 +4230,7 @@ static int constant = ACL$C_FILE; DESCRIPTOR (path_desc, path); DESCRIPTOR (user_desc, user); - + flags = 0; acces = 0; if ((mode & X_OK) && ((stat = access (path, mode)) < 0 || mode == X_OK)) @@ -4288,7 +4292,7 @@ return access (filename, type); /* Check write protection. */ - + #define CHECKPRIV(bit) (prvmask.bit) #define WRITEABLE(field) (! ((xab.xab$w_pro >> field) & XAB$M_NOWRITE)) @@ -4350,7 +4354,7 @@ } #endif /* not VMS4_4 */ #endif /* access */ - + static char vtbuf[NAM$C_MAXRSS+1]; /* translate a vms file spec to a unix path */ @@ -4390,7 +4394,7 @@ *targ++ = '.'; *targ++ = '.'; break; - + default: *targ++ = *vfile; break; @@ -4482,7 +4486,7 @@ ufile++; } *targ = '\0'; - + return utbuf; } @@ -4806,7 +4810,7 @@ * when this is not the desired behavior, for instance, when writing an * auto save file (you only want one version), or when you don't have * write permission in the directory containing the file (but the file - * itself is writable). Hence this routine, which is equivalent to + * itself is writable). Hence this routine, which is equivalent to * "close (creat (fn, 0));" on Unix if fn already exists. */ int @@ -4861,7 +4865,7 @@ status; struct FAB uaf_fab; struct RAB uaf_rab; - + uaf_fab = cc$rms_fab; uaf_rab = cc$rms_rab; /* initialize fab fields */ @@ -4924,7 +4928,7 @@ status; struct FAB uaf_fab; struct RAB uaf_rab; - + uaf_fab = cc$rms_fab; uaf_rab = cc$rms_rab; /* initialize fab fields */ @@ -5195,7 +5199,7 @@ bits). To maintain portability, the VMS implementation of `chmod' wires the W and D bits together. */ - + static char vms_file_written[NAM$C_MAXRSS]; int
--- a/src/toolbar-x.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/toolbar-x.c Mon Aug 13 09:55:28 2007 +0200 @@ -169,7 +169,7 @@ struct display_line dl; Lisp_Object string = IMAGE_INSTANCE_TEXT_STRING (p); unsigned char charsets[NUM_LEADING_BYTES]; - emchar_dynarr *buf; + Emchar_dynarr *buf; struct font_metric_info fm; /* This could be true if we were called via the Expose event @@ -188,7 +188,7 @@ Dynarr_length (buf)); ensure_face_cachel_complete (cachel, window, charsets); face_cachel_charset_font_metric_info (cachel, charsets, &fm); - + dl.ascent = fm.ascent; dl.descent = fm.descent; dl.ypos = tb->y + y_offset + fm.ascent; @@ -457,7 +457,7 @@ height = -thickness_change; } } - + SET_TOOLBAR_WAS_VISIBLE_FLAG (f, pos, 0); DEVMETH (d, clear_region, (frame, DEFAULT_INDEX, x, y, width, height)); @@ -632,7 +632,7 @@ f->toolbar_size[pos] = make_int (newval); if (!EQ (old_visibility, Qzero)) f->toolbar_visible_p[pos] = new_visibility; - + if (change < 0) x_clear_toolbar (f, pos, change); if (pos == LEFT_TOOLBAR || pos == RIGHT_TOOLBAR)
--- a/src/toolbar.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/toolbar.c Mon Aug 13 09:55:28 2007 +0200 @@ -309,8 +309,7 @@ if (!tb) { - tb = alloc_lcrecord (sizeof (struct toolbar_button), - lrecord_toolbar_button); + tb = alloc_lcrecord_type (struct toolbar_button, lrecord_toolbar_button); tb->next = Qnil; XSETFRAME (tb->frame, f); tb->up_glyph = Qnil; @@ -714,18 +713,15 @@ if (NILP (f->toolbar_data[pos])) { - struct toolbar_data *td = alloc_lcrecord (sizeof (struct toolbar_data), - lrecord_toolbar_data); + struct toolbar_data *td = alloc_lcrecord_type (struct toolbar_data, + lrecord_toolbar_data); td->last_toolbar_buffer = Qnil; td->toolbar_buttons = Qnil; XSETTOOLBAR_DATA (f->toolbar_data[pos], td); } - if (visible) - buttons = compute_frame_toolbar_buttons (f, pos, toolbar); - else - buttons = Qnil; + buttons = visible ? compute_frame_toolbar_buttons (f, pos, toolbar) : Qnil; FRAME_TOOLBAR_DATA (f, pos)->last_toolbar_buffer = buffer; FRAME_TOOLBAR_DATA (f, pos)->toolbar_buttons = buttons; @@ -1195,7 +1191,7 @@ `left-toolbar', `right-toolbar', and `bottom-toolbar' are always toolbar specifiers. -Valid toolbar instantiators are called \"toolbar descriptors\" +Valid toolbar instantiators are called "toolbar descriptors" and are lists of vectors. See `default-toolbar' for a description of the exact format. */ @@ -1238,7 +1234,7 @@ assert (pos < countof (Vtoolbar_size)); MAYBE_FRAMEMETH (f, toolbar_size_changed_in_frame, - (f, pos, oldval)); + (f, (enum toolbar_pos) pos, oldval)); /* Let redisplay know that something has possibly changed. */ MARK_TOOLBAR_CHANGED; @@ -1257,7 +1253,7 @@ assert (pos < countof (Vtoolbar_visible_p)); MAYBE_FRAMEMETH (f, toolbar_visible_p_changed_in_frame, - (f, pos, oldval)); + (f, (enum toolbar_pos) pos, oldval)); /* Let redisplay know that something has possibly changed. */ MARK_TOOLBAR_CHANGED; @@ -1402,9 +1398,9 @@ -- GLYPH-LIST should be a list of one to six glyphs (as created by `make-glyph') or a symbol whose value is such a list. The first glyph, which must be provided, is the glyph used to display the - toolbar button when it is in the \"up\" (not pressed) state. The + toolbar button when it is in the "up" (not pressed) state. The optional second glyph is for displaying the button when it is in - the \"down\" (pressed) state. The optional third glyph is for when + the "down" (pressed) state. The optional third glyph is for when the button is disabled. The optional fourth, fifth and sixth glyphs are used to specify captioned versions for the up, down and disabled states respectively. The function `toolbar-make-button-list' is
--- a/src/tooltalk.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/tooltalk.c Mon Aug 13 09:55:28 2007 +0200 @@ -41,7 +41,7 @@ static FILE *tooltalk_log_file; #endif -static Lisp_Object +static Lisp_Object Vtooltalk_message_handler_hook, Vtooltalk_pattern_handler_hook, Vtooltalk_unprocessed_message_hook; @@ -51,7 +51,7 @@ Qtooltalk_pattern_handler_hook, Qtooltalk_unprocessed_message_hook; -static Lisp_Object +static Lisp_Object Qreceive_tooltalk_message, Qtt_address, Qtt_args_count, @@ -78,7 +78,7 @@ Qtt_state, Qtt_status, Qtt_status_string, - Qtt_uid, + Qtt_uid, Qtt_callback, Qtt_plist, Qtt_prop, @@ -154,7 +154,7 @@ static Lisp_Object mark_tooltalk_message (Lisp_Object, void (*) (Lisp_Object)); static void print_tooltalk_message (Lisp_Object, Lisp_Object, int); DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-message", tooltalk_message, - mark_tooltalk_message, print_tooltalk_message, + mark_tooltalk_message, print_tooltalk_message, 0, 0, 0, struct Lisp_Tooltalk_Message); @@ -170,7 +170,7 @@ int escapeflag) { struct Lisp_Tooltalk_Message *p = XTOOLTALK_MESSAGE (obj); - + char buf[200]; if (print_readably) @@ -184,23 +184,23 @@ static Lisp_Object make_tooltalk_message (Tt_message m) { - struct Lisp_Tooltalk_Message *message_ - = alloc_lcrecord (sizeof (struct Lisp_Tooltalk_Message), - lrecord_tooltalk_message); + struct Lisp_Tooltalk_Message *msg = + alloc_lcrecord_type (struct Lisp_Tooltalk_Message, + lrecord_tooltalk_message); Lisp_Object val; - message_->m = m; - message_->callback = Qnil; - message_->plist_sym = Fmake_symbol (Tooltalk_Message_plist_str); - XSETTOOLTALK_MESSAGE (val, message_); + msg->m = m; + msg->callback = Qnil; + msg->plist_sym = Fmake_symbol (Tooltalk_Message_plist_str); + XSETTOOLTALK_MESSAGE (val, msg); return val; } Tt_message -unbox_tooltalk_message (Lisp_Object message_) +unbox_tooltalk_message (Lisp_Object msg) { - CHECK_TOOLTALK_MESSAGE (message_); - return XTOOLTALK_MESSAGE (message_)->m; + CHECK_TOOLTALK_MESSAGE (msg); + return XTOOLTALK_MESSAGE (msg)->m; } DEFUN ("tooltalk-message-p", Ftooltalk_message_p, 1, 1, 0, /* @@ -230,7 +230,7 @@ static Lisp_Object mark_tooltalk_pattern (Lisp_Object, void (*) (Lisp_Object)); static void print_tooltalk_pattern (Lisp_Object, Lisp_Object, int); DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-pattern", tooltalk_pattern, - mark_tooltalk_pattern, print_tooltalk_pattern, + mark_tooltalk_pattern, print_tooltalk_pattern, 0, 0, 0, struct Lisp_Tooltalk_Pattern); @@ -246,7 +246,7 @@ int escapeflag) { struct Lisp_Tooltalk_Pattern *p = XTOOLTALK_PATTERN (obj); - + char buf[200]; if (print_readably) @@ -260,15 +260,15 @@ static Lisp_Object make_tooltalk_pattern (Tt_pattern p) { - struct Lisp_Tooltalk_Pattern *pat - = alloc_lcrecord (sizeof (struct Lisp_Tooltalk_Pattern), - lrecord_tooltalk_pattern); + struct Lisp_Tooltalk_Pattern *pat = + alloc_lcrecord_type (struct Lisp_Tooltalk_Pattern, + lrecord_tooltalk_pattern); Lisp_Object val; pat->p = p; pat->callback = Qnil; pat->plist_sym = Fmake_symbol (Tooltalk_Pattern_plist_str); - + XSETTOOLTALK_PATTERN (val, pat); return val; } @@ -291,7 +291,7 @@ -static int +static int tooltalk_constant_value (Lisp_Object s) { if (INTP (s)) @@ -418,7 +418,7 @@ switch (n) { case TT_MODE_UNDEFINED: return Q_TT_MODE_UNDEFINED; - case TT_IN: return Q_TT_IN; + case TT_IN: return Q_TT_IN; case TT_OUT: return Q_TT_OUT; case TT_INOUT: return Q_TT_INOUT; case TT_MODE_LAST: return Q_TT_MODE_LAST; @@ -426,7 +426,7 @@ } } -static Lisp_Object +static Lisp_Object tt_scope_symbol (Tt_scope n) { switch (n) @@ -548,10 +548,10 @@ identified by symbols with the same name (underscores and all) as the suffix of the Tooltalk tt_message_<attribute> function that extracts the value. String attribute values are copied, enumerated type values (except disposition) -are converted to symbols - e.g. TT_HANDLER is 'TT_HANDLER, uid and gid are +are converted to symbols - e.g. TT_HANDLER is 'TT_HANDLER, uid and gid are represented by fixnums (small integers), opnum is converted to a string, -and disposition is converted to a fixnum. We convert opnum (a C int) to a -string, e.g. 123 => \"123\" because there's no guarantee that opnums will fit +and disposition is converted to a fixnum. We convert opnum (a C int) to a +string, e.g. 123 => "123" because there's no guarantee that opnums will fit within the range of Lisp integers. Use the 'plist attribute instead of the C API 'user attribute @@ -569,7 +569,7 @@ As you can see, argument numbers are zero based. The type of each argument can be retrieved with the 'arg_type attribute; however, Tooltalk doesn't define any semantics for the string value of 'arg_type. Conventionally -\"string\" is used for strings and \"int\" for 32 bit integers. Note that +"string" is used for strings and "int" for 32 bit integers. Note that Emacs Lisp stores the lengths of strings explicitly (unlike C) so treating the value returned by 'arg_bval like a string is fine. */ @@ -579,10 +579,10 @@ int n = 0; CHECK_SYMBOL (attribute); - if (EQ (attribute, (Qtt_arg_bval)) || - EQ (attribute, (Qtt_arg_ival)) || - EQ (attribute, (Qtt_arg_mode)) || - EQ (attribute, (Qtt_arg_type)) || + if (EQ (attribute, (Qtt_arg_bval)) || + EQ (attribute, (Qtt_arg_ival)) || + EQ (attribute, (Qtt_arg_mode)) || + EQ (attribute, (Qtt_arg_type)) || EQ (attribute, (Qtt_arg_val))) { CHECK_INT (argn); @@ -666,7 +666,7 @@ else if (EQ (attribute, Qtt_uid)) return make_int (tt_message_uid (m)); - + else if (EQ (attribute, Qtt_callback)) return XTOOLTALK_MESSAGE (message_)->callback; @@ -709,8 +709,8 @@ int n = 0; CHECK_SYMBOL (attribute); - if (EQ (attribute, (Qtt_arg_bval)) || - EQ (attribute, (Qtt_arg_ival)) || + if (EQ (attribute, (Qtt_arg_bval)) || + EQ (attribute, (Qtt_arg_ival)) || EQ (attribute, (Qtt_arg_val))) { CHECK_INT (argn); @@ -723,17 +723,18 @@ else if (EQ (attribute, Qtt_address)) { CHECK_TOOLTALK_CONSTANT (value); - tt_message_address_set (m, tooltalk_constant_value (value)); + tt_message_address_set (m, (Tt_address) tooltalk_constant_value (value)); } else if (EQ (attribute, Qtt_class)) { CHECK_TOOLTALK_CONSTANT (value); - tt_message_class_set (m, tooltalk_constant_value (value)); + tt_message_class_set (m, (Tt_class) tooltalk_constant_value (value)); } else if (EQ (attribute, Qtt_disposition)) { CHECK_TOOLTALK_CONSTANT (value); - tt_message_disposition_set (m, tooltalk_constant_value (value)); + tt_message_disposition_set (m, ((Tt_disposition) + tooltalk_constant_value (value))); } else if (EQ (attribute, Qtt_file)) { @@ -780,10 +781,10 @@ else if (EQ (attribute, Qtt_scope)) { CHECK_TOOLTALK_CONSTANT (value); - tt_message_scope_set (m, tooltalk_constant_value (value)); + tt_message_scope_set (m, (Tt_scope) tooltalk_constant_value (value)); } else if (EQ (attribute, Qtt_sender_ptype)) - { + { CONST char *value_ext; CHECK_STRING (value); GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); @@ -931,7 +932,7 @@ and VALUE can be a string or an integer. Tooltalk doesn't define any semantics for VTYPE, so only the participants in the protocol you're using need to agree what types mean (if anything). -Conventionally \"string\" is used for strings and \"int\" for 32 bit integers. +Conventionally "string" is used for strings and "int" for 32 bit integers. Arguments can initialized by providing a value or with `set-tooltalk-message-attribute'. The latter is necessary if you want to initialize the argument with a string that can contain @@ -1025,7 +1026,7 @@ Add one value to the indicated pattern attribute. All Tooltalk pattern attributes are supported except 'user. The names of attributes are the same as the Tooltalk accessors used to set them -less the \"tooltalk_pattern_\" prefix and the \"_add\" ... +less the "tooltalk_pattern_" prefix and the "_add" ... */ (value, pattern, attribute)) { @@ -1039,22 +1040,25 @@ else if (EQ (attribute, Qtt_category)) { CHECK_TOOLTALK_CONSTANT (value); - tt_pattern_category_set (p, tooltalk_constant_value (value)); + tt_pattern_category_set (p, ((Tt_category) + tooltalk_constant_value (value))); } else if (EQ (attribute, Qtt_address)) { CHECK_TOOLTALK_CONSTANT (value); - tt_pattern_address_add (p, tooltalk_constant_value (value)); + tt_pattern_address_add (p, ((Tt_address) + tooltalk_constant_value (value))); } else if (EQ (attribute, Qtt_class)) { CHECK_TOOLTALK_CONSTANT (value); - tt_pattern_class_add (p, tooltalk_constant_value (value)); + tt_pattern_class_add (p, (Tt_class) tooltalk_constant_value (value)); } else if (EQ (attribute, Qtt_disposition)) { CHECK_TOOLTALK_CONSTANT (value); - tt_pattern_disposition_add (p, tooltalk_constant_value (value)); + tt_pattern_disposition_add (p, ((Tt_disposition) + tooltalk_constant_value (value))); } else if (EQ (attribute, Qtt_file)) { @@ -1087,7 +1091,7 @@ else if (EQ (attribute, Qtt_scope)) { CHECK_TOOLTALK_CONSTANT (value); - tt_pattern_scope_add (p, tooltalk_constant_value (value)); + tt_pattern_scope_add (p, (Tt_scope) tooltalk_constant_value (value)); } else if (EQ (attribute, Qtt_sender)) { @@ -1113,7 +1117,7 @@ else if (EQ (attribute, Qtt_state)) { CHECK_TOOLTALK_CONSTANT (value); - tt_pattern_state_add (p, tooltalk_constant_value (value)); + tt_pattern_state_add (p, (Tt_state) tooltalk_constant_value (value)); } else if (EQ (attribute, Qtt_callback)) { @@ -1144,7 +1148,7 @@ if (!VALID_TOOLTALK_PATTERNP (p)) return Qnil; - + { CONST char *vtype_ext; @@ -1237,9 +1241,7 @@ ()) { char *procid = tt_default_procid (); - if (!procid) - return Qnil; - return build_string (procid); + return procid ? build_string (procid) : Qnil; } DEFUN ("tooltalk-default-session", Ftooltalk_default_session, 0, 0, 0, /* @@ -1248,9 +1250,7 @@ ()) { char *session = tt_default_session (); - if (!session) - return Qnil; - return build_string (session); + return session ? build_string (session) : Qnil; } static void @@ -1264,7 +1264,7 @@ retval = tt_open (); if (tt_ptr_error (retval) != TT_OK) return; - + Vtooltalk_fd = make_int (tt_fd ()); tt_session_join (tt_default_session ()); @@ -1291,7 +1291,7 @@ No big deal if we don't do the following under those systems. */ { Tt_message exit_msg = tt_message_create (); - + tt_message_op_set (exit_msg, "emacs-aborted"); tt_message_scope_set (exit_msg, TT_SESSION); tt_message_class_set (exit_msg, TT_NOTICE); @@ -1337,11 +1337,11 @@ DEFSUBR (Fsend_tooltalk_message); DEFSUBR (Freturn_tooltalk_message); DEFSUBR (Fcreate_tooltalk_pattern); - DEFSUBR (Fdestroy_tooltalk_pattern); - DEFSUBR (Fadd_tooltalk_pattern_attribute); - DEFSUBR (Fadd_tooltalk_pattern_arg); - DEFSUBR (Fregister_tooltalk_pattern); - DEFSUBR (Funregister_tooltalk_pattern); + DEFSUBR (Fdestroy_tooltalk_pattern); + DEFSUBR (Fadd_tooltalk_pattern_attribute); + DEFSUBR (Fadd_tooltalk_pattern_arg); + DEFSUBR (Fregister_tooltalk_pattern); + DEFSUBR (Funregister_tooltalk_pattern); DEFSUBR (Ftooltalk_pattern_plist_get); DEFSUBR (Ftooltalk_pattern_prop_set); DEFSUBR (Ftooltalk_pattern_prop_get); @@ -1396,7 +1396,7 @@ */ ); Vtooltalk_fd = Qnil; - DEFVAR_LISP ("tooltalk-message-handler-hook", + DEFVAR_LISP ("tooltalk-message-handler-hook", &Vtooltalk_message_handler_hook /* List of functions to be applied to each ToolTalk message reply received. This will always occur as a result of our sending a request message. @@ -1407,7 +1407,7 @@ */ ); Vtooltalk_message_handler_hook = Qnil; - DEFVAR_LISP ("tooltalk-pattern-handler-hook", + DEFVAR_LISP ("tooltalk-pattern-handler-hook", &Vtooltalk_pattern_handler_hook /* List of functions to be applied to each pattern-matching ToolTalk message. This is all messages except those handled by `tooltalk-message-handler-hook'. @@ -1424,13 +1424,13 @@ Vtooltalk_unprocessed_message_hook = Qnil; Tooltalk_Message_plist_str = build_string ("Tooltalk Message plist"); - Tooltalk_Pattern_plist_str = build_string ("Tooltalk Pattern plist"); + Tooltalk_Pattern_plist_str = build_string ("Tooltalk Pattern p plist"); #define MAKE_CONSTANT(name) do { \ defsymbol (&Q_ ## name, #name); \ Fset (Q_ ## name, make_int (name)); \ } while (0) - + MAKE_CONSTANT (TT_MODE_UNDEFINED); MAKE_CONSTANT (TT_IN); MAKE_CONSTANT (TT_OUT);
--- a/src/undo.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/undo.c Mon Aug 13 09:55:28 2007 +0200 @@ -80,7 +80,7 @@ undo_boundary (b); XSETBUFFER (last_undo_buffer, b); } - + /* Allocate a cons cell to be the undo boundary after this command. */ if (hack_pending_boundary && NILP (pending_boundary)) pending_boundary = Fcons (Qnil, Qnil); @@ -136,7 +136,7 @@ } } - b->undo_list = Fcons (Fcons (make_int (beg), + b->undo_list = Fcons (Fcons (make_int (beg), make_int (beg + length)), b->undo_list); } @@ -172,7 +172,7 @@ else sbeg = make_int (beg); - /* If we are just after an undo boundary, and + /* If we are just after an undo boundary, and point wasn't at start of deleted range, record where it was. */ if (at_boundary && BUFFERP (last_point_position_buffer) @@ -448,7 +448,7 @@ /* Element (extent start end) means that EXTENT was detached, and we need to reattach it. */ Lisp_Object extent_obj, start, end; - + extent_obj = car; start = Fcar (cdr); end = Fcar (Fcdr (cdr)); @@ -512,7 +512,7 @@ track of the mark, this isn't really necessary, but it may lead to better behavior in certain situations. - + I'm doubtful that this is safe; you could mess up the process-output mark in shell buffers, so until I hear a compelling reason for this change,
--- a/src/vm-limit.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/vm-limit.c Mon Aug 13 09:55:28 2007 +0200 @@ -25,8 +25,8 @@ #include "lisp.h" #endif +#include <stddef.h> #ifndef emacs -#include <stddef.h> typedef size_t SIZE; typedef void *POINTER; #define EXCEEDS_LISP_PTR(x) 0 @@ -52,7 +52,7 @@ static void check_memory_limits (void) { - extern POINTER (*__morecore) (); + extern POINTER (*__morecore) (ptrdiff_t size); POINTER cp; unsigned long five_percent; @@ -69,7 +69,7 @@ if (warn_function) switch (warnlevel) { - case 0: + case 0: if (data_size > five_percent * 15) { warnlevel++; @@ -77,7 +77,7 @@ } break; - case 1: + case 1: if (data_size > five_percent * 17) { warnlevel++; @@ -85,7 +85,7 @@ } break; - case 2: + case 2: if (data_size > five_percent * 19) { warnlevel++; @@ -121,7 +121,7 @@ void memory_warnings (void *start, void (*warnfun) (CONST char *)) { - extern void (* __after_morecore_hook) (); /* From gmalloc.c */ + extern void (* __after_morecore_hook) (void); /* From gmalloc.c */ if (start) data_space_start = start;
--- a/src/window.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/window.c Mon Aug 13 09:55:28 2007 +0200 @@ -42,7 +42,6 @@ Lisp_Object Qwindow_configurationp; Lisp_Object Qscroll_up; Lisp_Object Qscroll_down; -Lisp_Object Qtemp_buffer_show_hook; Lisp_Object Qdisplay_buffer; #ifdef MEMORY_USAGE_STATS @@ -224,7 +223,7 @@ if (print_readably) error ("printing unreadable object #<window 0x%x>", XWINDOW (obj)->header.uid); - + write_c_string ("#<window", printcharfun); if (!NILP (XWINDOW (obj)->buffer)) { @@ -289,8 +288,7 @@ allocate_window (void) { Lisp_Object val = Qnil; - struct window *p = alloc_lcrecord (sizeof (struct window), - lrecord_window); + struct window *p = alloc_lcrecord_type (struct window, lrecord_window); zero_lcrecord (p); XSETWINDOW (val, p); @@ -300,8 +298,8 @@ p->mini_p = Qnil; p->next = Qnil; p->prev = Qnil; - p->hchild = Qnil; - p->vchild = Qnil; + p->hchild = Qnil; + p->vchild = Qnil; p->parent = Qnil; p->buffer = Qnil; INIT_DISP_VARIABLE (start, Fmake_marker ()); @@ -312,9 +310,9 @@ INIT_DISP_VARIABLE (last_point, Fmake_marker ()); INIT_DISP_VARIABLE (last_start, Fmake_marker ()); INIT_DISP_VARIABLE (last_facechange, Qzero); - p->face_cachels = Dynarr_new (struct face_cachel); - p->glyph_cachels = Dynarr_new (struct glyph_cachel); - p->line_start_cache = Dynarr_new (struct line_start_cache); + p->face_cachels = Dynarr_new (face_cachel); + p->glyph_cachels = Dynarr_new (glyph_cachel); + p->line_start_cache = Dynarr_new (line_start_cache); p->line_cache_last_updated = Qzero; INIT_DISP_VARIABLE (last_point_x, 0); INIT_DISP_VARIABLE (last_point_y, 0); @@ -381,16 +379,12 @@ static struct window_mirror * new_window_mirror (struct frame *f) { - struct window_mirror *t; - - t = (struct window_mirror *) - xmalloc (sizeof (struct window_mirror)); - memset (t, 0, sizeof (struct window_mirror)); + struct window_mirror *t = xnew_and_zero (struct window_mirror); t->frame = f; - t->current_display_lines = Dynarr_new (struct display_line); - t->desired_display_lines = Dynarr_new (struct display_line); + t->current_display_lines = Dynarr_new (display_line); + t->desired_display_lines = Dynarr_new (display_line); t->buffer = NULL; #ifdef HAVE_SCROLLBARS @@ -438,8 +432,8 @@ non-leaf windows can add up to a lot of wasted space. So don't do it. */ free_display_structs (mir); - mir->current_display_lines = Dynarr_new (struct display_line); - mir->desired_display_lines = Dynarr_new (struct display_line); + mir->current_display_lines = Dynarr_new (display_line); + mir->desired_display_lines = Dynarr_new (display_line); #ifdef HAVE_SCROLLBARS update_window_scrollbars (XWINDOW (win), mir, 0, 0); @@ -1027,7 +1021,7 @@ int window_bottom_gutter_height (struct window *w) { - int other_height; + int other_height; if (!NILP (w->hchild) || !NILP (w->vchild)) return 0; @@ -1408,7 +1402,7 @@ beyond VALUE, the functions in `redisplay-end-trigger-functions' are called with two arguments: WINDOW, and the end trigger value. Afterwards the end-trigger value is reset to nil. -*/ +*/ (window, value)) { return (decode_window (window)->redisplay_end_trigger = value); @@ -1754,9 +1748,9 @@ WINDOW. */ { Lisp_Object pwindow; - + pwindow = FRAME_SELECTED_WINDOW (f); - + while (!NILP (pwindow)) { if (EQ (window, pwindow)) @@ -1769,7 +1763,7 @@ /* OK, we found it. */ Lisp_Object alternative; alternative = Fnext_window (window, Qlambda, Qnil, Qnil); - + /* If we're about to delete the selected window on the selected frame, then we should use Fselect_window to select the new window. On the other hand, if we're about to @@ -1798,7 +1792,7 @@ configuration get deleted and multiple frames are in use. */ /* w->buffer = Qnil; */ } - + /* close up the hole in the sibling list */ if (!NILP (w->next)) XWINDOW (w->next)->prev = w->prev; @@ -1822,7 +1816,7 @@ WINDOW_TOP (XWINDOW (sib)) = WINDOW_TOP (w); WINDOW_LEFT (XWINDOW (sib)) = WINDOW_LEFT (w); } - + /* Stretch that sibling. */ if (!NILP (par->vchild)) set_window_pixheight @@ -2279,7 +2273,7 @@ static Lisp_Object window_loop (enum window_loop type, - Lisp_Object obj, + Lisp_Object obj, int mini, Lisp_Object frames, int dedicated_too, @@ -2296,7 +2290,7 @@ /* #### I think the change of "precomputing" last_window and next_window * #### catch the lossage this is meant(?) to punt on... */ - int lose_lose = 0; + int lose_lose = 0; Lisp_Object devcons, concons; /* FRAME_ARG is Qlambda to stick to one frame, @@ -2319,7 +2313,7 @@ frame_arg = frames; else if (EQ (frames, Qvisible)) frame_arg = frames; - + DEVICE_LOOP_NO_BREAK (devcons, concons) { Lisp_Object device = XCAR (devcons); @@ -2362,7 +2356,7 @@ next_window = Fnext_window (w, mini ? Qt : Qnil, frame_arg, Qt); /* #### Still needed ?? */ - /* Given the outstanding quality of the rest of this code, + /* Given the outstanding quality of the rest of this code, I feel no shame about putting this piece of shit in. */ if (++lose_lose >= 500) return Qnil; @@ -2556,7 +2550,7 @@ break; } - default: + default: abort (); } @@ -2587,7 +2581,7 @@ int buffer_window_mru (struct window *w) { - Lisp_Object window = + Lisp_Object window = window_loop (GET_BUFFER_MRU_WINDOW, w->buffer, 0, w->frame, 1, Qnil); if (NILP (window)) @@ -3077,7 +3071,7 @@ { struct window *w; Lisp_Object old_selected_window = Fselected_window (Qnil); - + CHECK_LIVE_WINDOW (window); w = XWINDOW (window); @@ -3109,7 +3103,7 @@ /* now select the window's frame */ set_frame_selected_window (XFRAME (WINDOW_FRAME (w)), window); - + select_frame_1 (WINDOW_FRAME (w)); /* also select the window's buffer */ @@ -3176,7 +3170,7 @@ set_marker_restricted (w->pointm[CURRENT_DISP], make_int (1), buf); set_marker_restricted (w->sb_point, make_int (1), buf); - /* Run temp-buffer-show-hook, with the chosen window selected. */ + /* Run temp-buffer-show-hook, with the chosen window selected. */ if (!preparing_for_armageddon) { Lisp_Object tem; @@ -3207,17 +3201,16 @@ { Lisp_Object new = Qnil; struct window *o = XWINDOW (window); - struct window *p = alloc_lcrecord (sizeof (struct window), - lrecord_window); + struct window *p = alloc_lcrecord_type (struct window, lrecord_window); XSETWINDOW (new, p); copy_lcrecord (p, o); /* Don't copy the pointers to the line start cache or the face instances. */ - p->line_start_cache = Dynarr_new (struct line_start_cache); - p->face_cachels = Dynarr_new (struct face_cachel); - p->glyph_cachels = Dynarr_new (struct glyph_cachel); + p->line_start_cache = Dynarr_new (line_start_cache); + p->face_cachels = Dynarr_new (face_cachel); + p->glyph_cachels = Dynarr_new (glyph_cachel); /* Put new into window structure in place of window */ replace_window (window, new); @@ -3297,7 +3290,7 @@ if (size < window_min_height) error ("Window height %d too small (after splitting)", size); if (size + window_min_height > window_char_height (o, 1)) - error ("Window height %d too small (after splitting)", + error ("Window height %d too small (after splitting)", window_char_height (o, 1) - size); if (NILP (o->parent) || NILP (XWINDOW (o->parent)->vchild)) @@ -3314,7 +3307,7 @@ if (size < window_min_width) error ("Window width %d too small (after splitting)", size); if (size + window_min_width > window_char_width (o, 0)) - error ("Window width %d too small (after splitting)", + error ("Window width %d too small (after splitting)", window_char_width (o, 0) - size); if (NILP (o->parent) || NILP (XWINDOW (o->parent)->hchild)) @@ -3346,7 +3339,7 @@ reset_face_cachels (p); reset_glyph_cachels (p); - + /* Apportion the available frame space among the two new windows */ @@ -3417,14 +3410,14 @@ int defheight, defwidth; int char_height; Lisp_Object window; - + XSETWINDOW (window, w); - + avail_height = (pixel_height - (include_gutters_p ? 0 : window_top_gutter_height (w) + window_bottom_gutter_height (w))); - + default_face_height_and_width (window, &defheight, &defwidth); char_height = avail_height / defheight; @@ -3449,9 +3442,9 @@ int pixel_height; Lisp_Object window; - + XSETWINDOW (window, w); - + default_face_height_and_width (window, &defheight, &defwidth); avail_height = char_height * defheight; @@ -3566,17 +3559,17 @@ int char_width; int defheight, defwidth; Lisp_Object window; - + XSETWINDOW (window, w); - + avail_width = (pixel_width - window_left_gutter_width (w, 0) - window_right_gutter_width (w, 0) - (include_margins_p ? 0 : window_left_margin_width (w)) - (include_margins_p ? 0 : window_right_margin_width (w))); - + default_face_height_and_width (window, &defheight, &defwidth); - + char_width = (avail_width / defwidth); /* It's the calling function's responsibility to check these values @@ -3725,7 +3718,7 @@ ? (*sizefun) (w->next) - MINSIZE (w->next) : ((!NILP (w->prev)) ? (*sizefun) (w->prev) - MINSIZE (w->prev) - /* This is a frame with only one window, + /* This is a frame with only one window, a minibuffer-only or a minibufferless frame. */ : (delta = 0)))); @@ -4040,7 +4033,7 @@ } DEFUN ("other-window-for-scrolling", Fother_window_for_scrolling, 0, 0, 0, /* -Return the other window for \"other window scroll\" commands. +Return the other window for "other window scroll" commands. If in the minibuffer, `minibuffer-scroll-window' if non-nil specifies the window. If `other-window-scroll-buffer' is non-nil, a window @@ -4180,7 +4173,7 @@ } Fset_marker (w->start[CURRENT_DISP], make_int (startp), w->buffer); - + w->start_at_line_beg = beginning_of_line_p (b, startp); w->force_start = 1; MARK_WINDOWS_CHANGED (w); @@ -4308,7 +4301,7 @@ int (*mapfun) (struct window *w, void *closure), void *closure) { - int retval; + int retval; for (; !NILP (window); window = XWINDOW (window)->next) { @@ -4533,7 +4526,7 @@ DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("window-configuration", window_configuration, mark_window_config, - print_window_config, + print_window_config, 0, 0, 0, sizeof_window_config, struct window_config); @@ -4574,7 +4567,7 @@ static unsigned int sizeof_window_config (CONST void *h) { - CONST struct window_config *c = h; + CONST struct window_config *c = (CONST struct window_config *) h; return sizeof_window_config_for_n_windows (c->saved_windows_count); } @@ -4763,17 +4756,17 @@ if (FRAME_X_P (f)) { Lisp_Object new_desired = config->p_sheet_buffer; - + if (BUFFERP (new_desired) && !BUFFER_LIVE_P (XBUFFER (new_desired))) new_desired = Qnil; /* the desired buffer was killed */ - + /* need to restore the desired buffer */ if (!EQ (new_desired, desired_psheet_buffer (f))) make_psheets_desired (f, new_desired); } #endif - + new_current_buffer = config->current_buffer; if (!BUFFER_LIVE_P (XBUFFER (new_current_buffer))) new_current_buffer = Qnil; @@ -4849,13 +4842,13 @@ structures were freed, so we need to reallocate them. */ if (!w->face_cachels) { - w->face_cachels = Dynarr_new (struct face_cachel); + w->face_cachels = Dynarr_new (face_cachel); reset_face_cachels (w); } if (!w->glyph_cachels) - w->glyph_cachels = Dynarr_new (struct glyph_cachel); + w->glyph_cachels = Dynarr_new (glyph_cachel); if (!w->line_start_cache) - w->line_start_cache = Dynarr_new (struct line_start_cache); + w->line_start_cache = Dynarr_new (line_start_cache); w->dead = 0; if (p->parent_index >= 0) @@ -5237,8 +5230,9 @@ [n_windows - 1])); else /* More than ten windows; just allocate directly */ - config = alloc_lcrecord (sizeof_window_config_for_n_windows (n_windows), - lrecord_window_configuration); + config = (struct window_config *) + alloc_lcrecord (sizeof_window_config_for_n_windows (n_windows), + lrecord_window_configuration); XSETWINDOW_CONFIGURATION (result, config); config->frame_width = FRAME_WIDTH (f); @@ -5516,7 +5510,7 @@ modeline_shadow_thickness), modeline_shadow_thickness_changed, 0, 0); - + DEFVAR_SPECIFIER ("has-modeline-p", &Vhas_modeline_p /* *Whether the modeline should be displayed. This is a specifier; use `set-specifier' to change it.
--- a/src/xgccache.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/xgccache.c Mon Aug 13 09:55:28 2007 +0200 @@ -26,7 +26,7 @@ Then assume that one stipple or background is used for text selections, and another is used for highlighting mousable regions. That makes 16 GCs already. Add in the fact that another GC may be needed to display - the text cursor in any of those regions, and you've got 32. Add in + the text cursor in any of those regions, and you've got 32. Add in more fonts, and it keeps increasing exponentially. We used to keep these GCs in a cache of merged (fully qualified) faces. @@ -37,7 +37,7 @@ was changed, which caused an unpleasant amount of flicker (since faces are created/destroyed (= changed) whenever a frame is created/destroyed. - So this code maintains a cache at the GC level instead of at the face + So this code maintains a cache at the GC level instead of at the face level. There is an upper limit on the size of the cache, after which we will stop creating GCs and start reusing them (reusing the least-recently- used ones first). So if faces get changed, their GCs will eventually be @@ -92,7 +92,7 @@ }; #ifdef GCCACHE_HASH -static unsigned long +static unsigned long gc_cache_hash (CONST void *arg) { CONST struct gcv_and_mask *gcvm = (CONST struct gcv_and_mask *) arg; @@ -111,18 +111,17 @@ #endif /* GCCACHE_HASH */ -static int +static int gc_cache_eql (CONST void *arg1, CONST void *arg2) { /* See comment in gc_cache_hash */ - return (!memcmp (arg1, arg2, sizeof (struct gcv_and_mask))); + return !memcmp (arg1, arg2, sizeof (struct gcv_and_mask)); } struct gc_cache * make_gc_cache (Display *dpy, Window window) { - struct gc_cache *cache = - (struct gc_cache *) xmalloc (sizeof (struct gc_cache)); + struct gc_cache *cache = xnew (struct gc_cache); cache->dpy = dpy; cache->window = window; cache->size = 0; @@ -167,7 +166,7 @@ #ifdef GCCACHE_HASH - if (gethash (&gcvm, cache->table, (void *) &cell)) + if (gethash (&gcvm, cache->table, (void **) &cell)) #else /* !GCCACHE_HASH */ @@ -235,9 +234,8 @@ abort (); else { - /* Allocate a new cell (don't put it in the list or table yet). - */ - cell = (struct gc_cache_cell *) xmalloc (sizeof (struct gc_cache_cell)); + /* Allocate a new cell (don't put it in the list or table yet). */ + cell = xnew (struct gc_cache_cell); cache->size++; }
--- a/src/xmu.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/xmu.c Mon Aug 13 09:55:28 2007 +0200 @@ -533,7 +533,7 @@ return XmuPrintDefaultErrorMessage (dpy, errorp, stderr); } -void XmuCopyISOLatin1Lowered(char *dst, char *src) +void XmuCopyISOLatin1Lowered(char *dst, CONST char *src) { unsigned char *dest = (unsigned char *) dst; unsigned char *source = (unsigned char *) src;
--- a/src/xselect.c Mon Aug 13 09:54:24 2007 +0200 +++ b/src/xselect.c Mon Aug 13 09:55:28 2007 +0200 @@ -946,8 +946,7 @@ expect_property_change (Display *display, Window window, Atom property, int state) { - struct prop_location *pl = (struct prop_location *) - xmalloc (sizeof (struct prop_location)); + struct prop_location *pl = xnew (struct prop_location); pl->tick = ++prop_location_tick; pl->display = display; pl->window = window; @@ -1394,7 +1393,7 @@ type == DEVICE_XATOM_COMPOUND_TEXT (d) ? FORMAT_CTEXT : FORMAT_BINARY); - /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to + /* Convert a single atom to a Lisp Symbol. Convert a set of atoms to a vector of symbols. */ else if (type == XA_ATOM) @@ -1413,7 +1412,7 @@ } } - /* Convert a single 16 or small 32 bit number to a Lisp_Int. + /* Convert a single 16 or small 32 bit number to a Lisp Int. If the number is > 16 bits, convert it to a cons of integers, 16 bits in each half. */ @@ -1557,7 +1556,7 @@ } else if (VECTORP (obj)) { - /* Lisp_Vectors may represent a set of ATOMs; + /* Lisp Vectors may represent a set of ATOMs; a set of 16 or 32 bit INTEGERs; or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...] */