Now on revision 104689. ------------------------------------------------------------ revno: 104689 committer: Glenn Morris branch nick: trunk timestamp: Thu 2011-06-23 06:18:34 -0400 message: Auto-commit of generated files. diff: === modified file 'autogen/Makefile.in' --- autogen/Makefile.in 2011-06-21 10:18:39 +0000 +++ autogen/Makefile.in 2011-06-23 10:18:34 +0000 @@ -24,7 +24,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink socklen stdarg stdio strftime strtoumax symlink sys_stat +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink socklen stdarg stdio strftime strtoumax symlink sys_stat VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ @@ -51,10 +51,10 @@ subdir = lib ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/m4/00gnulib.m4 \ - $(top_srcdir)/m4/c-strtod.m4 $(top_srcdir)/m4/extensions.m4 \ - $(top_srcdir)/m4/filemode.m4 $(top_srcdir)/m4/getloadavg.m4 \ - $(top_srcdir)/m4/getopt.m4 $(top_srcdir)/m4/gl-comp.m4 \ - $(top_srcdir)/m4/gnulib-common.m4 \ + $(top_srcdir)/m4/alloca.m4 $(top_srcdir)/m4/c-strtod.m4 \ + $(top_srcdir)/m4/extensions.m4 $(top_srcdir)/m4/filemode.m4 \ + $(top_srcdir)/m4/getloadavg.m4 $(top_srcdir)/m4/getopt.m4 \ + $(top_srcdir)/m4/gl-comp.m4 $(top_srcdir)/m4/gnulib-common.m4 \ $(top_srcdir)/m4/include_next.m4 $(top_srcdir)/m4/inttypes.m4 \ $(top_srcdir)/m4/longlong.m4 $(top_srcdir)/m4/lstat.m4 \ $(top_srcdir)/m4/md5.m4 $(top_srcdir)/m4/mktime.m4 \ @@ -104,6 +104,7 @@ DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) ACLOCAL = @ACLOCAL@ ALLOCA = @ALLOCA@ +ALLOCA_H = @ALLOCA_H@ ALSA_CFLAGS = @ALSA_CFLAGS@ ALSA_LIBS = @ALSA_LIBS@ AMTAR = @AMTAR@ @@ -732,10 +733,10 @@ # statements but through direct file reference. Therefore this snippet must be # present in all Makefile.am that need it. This is ensured by the applicability # 'all' defined above. -BUILT_SOURCES = arg-nonnull.h c++defs.h $(GETOPT_H) inttypes.h \ - $(STDARG_H) $(STDBOOL_H) $(STDDEF_H) $(STDINT_H) stdio.h \ - stdlib.h sys/stat.h time.h unistd.h warn-on-use.h -EXTRA_DIST = allocator.h $(top_srcdir)/./arg-nonnull.h \ +BUILT_SOURCES = $(ALLOCA_H) arg-nonnull.h c++defs.h $(GETOPT_H) \ + inttypes.h $(STDARG_H) $(STDBOOL_H) $(STDDEF_H) $(STDINT_H) \ + stdio.h stdlib.h sys/stat.h time.h unistd.h warn-on-use.h +EXTRA_DIST = alloca.in.h allocator.h $(top_srcdir)/./arg-nonnull.h \ $(top_srcdir)/./c++defs.h careadlinkat.h md5.h sha1.h sha256.h \ sha512.h dosname.h ftoastr.c ftoastr.h filemode.h getloadavg.c \ getopt.c getopt.in.h getopt1.c getopt_int.h ignore-value.h \ @@ -746,12 +747,12 @@ sys_stat.in.h time.in.h time_r.c u64.h unistd.in.h verify.h \ $(top_srcdir)/./warn-on-use.h MOSTLYCLEANDIRS = sys -MOSTLYCLEANFILES = core *.stackdump arg-nonnull.h arg-nonnull.h-t \ - c++defs.h c++defs.h-t getopt.h getopt.h-t inttypes.h \ - inttypes.h-t stdarg.h stdarg.h-t stdbool.h stdbool.h-t \ - stddef.h stddef.h-t stdint.h stdint.h-t stdio.h stdio.h-t \ - stdlib.h stdlib.h-t sys/stat.h sys/stat.h-t time.h time.h-t \ - unistd.h unistd.h-t warn-on-use.h warn-on-use.h-t +MOSTLYCLEANFILES = core *.stackdump alloca.h alloca.h-t arg-nonnull.h \ + arg-nonnull.h-t c++defs.h c++defs.h-t getopt.h getopt.h-t \ + inttypes.h inttypes.h-t stdarg.h stdarg.h-t stdbool.h \ + stdbool.h-t stddef.h stddef.h-t stdint.h stdint.h-t stdio.h \ + stdio.h-t stdlib.h stdlib.h-t sys/stat.h sys/stat.h-t time.h \ + time.h-t unistd.h unistd.h-t warn-on-use.h warn-on-use.h-t noinst_LIBRARIES = libgnu.a DEFAULT_INCLUDES = -I. -I../src -I$(top_srcdir)/src libgnu_a_SOURCES = allocator.c careadlinkat.c md5.c sha1.c sha256.c \ @@ -1052,6 +1053,17 @@ mostlyclean-generic mostlyclean-local pdf pdf-am ps ps-am tags \ uninstall uninstall-am + +# We need the following in order to create when the system +# doesn't have one that works with the given compiler. +@GL_GENERATE_ALLOCA_H_TRUE@alloca.h: alloca.in.h $(top_builddir)/config.status +@GL_GENERATE_ALLOCA_H_TRUE@ $(AM_V_GEN)rm -f $@-t $@ && \ +@GL_GENERATE_ALLOCA_H_TRUE@ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ +@GL_GENERATE_ALLOCA_H_TRUE@ cat $(srcdir)/alloca.in.h; \ +@GL_GENERATE_ALLOCA_H_TRUE@ } > $@-t && \ +@GL_GENERATE_ALLOCA_H_TRUE@ mv -f $@-t $@ +@GL_GENERATE_ALLOCA_H_FALSE@alloca.h: $(top_builddir)/config.status +@GL_GENERATE_ALLOCA_H_FALSE@ rm -f $@ # The arg-nonnull.h that gets inserted into generated .h files is the same as # build-aux/arg-nonnull.h, except that it has the copyright header cut off. arg-nonnull.h: $(top_srcdir)/./arg-nonnull.h === modified file 'autogen/aclocal.m4' --- autogen/aclocal.m4 2011-06-21 10:18:39 +0000 +++ autogen/aclocal.m4 2011-06-23 10:18:34 +0000 @@ -985,6 +985,7 @@ ]) # _AM_PROG_TAR m4_include([m4/00gnulib.m4]) +m4_include([m4/alloca.m4]) m4_include([m4/c-strtod.m4]) m4_include([m4/extensions.m4]) m4_include([m4/filemode.m4]) === modified file 'autogen/config.in' --- autogen/config.in 2011-06-07 10:18:29 +0000 +++ autogen/config.in 2011-06-23 10:18:34 +0000 @@ -104,7 +104,8 @@ /* Define to 1 if you have the `alarm' function. */ #undef HAVE_ALARM -/* Define to 1 if you have `alloca', as a function or macro. */ +/* Define to 1 if you have 'alloca' after including , a header that + may be supplied by this distribution. */ #undef HAVE_ALLOCA /* Define to 1 if you have and it should be used (not on Ultrix). @@ -1290,6 +1291,12 @@ #undef volatile +/* On AIX 3 this must be included before any other include file. */ +#include +#if ! HAVE_ALLOCA +# error "alloca not available on this machine" +#endif + /* Define AMPERSAND_FULL_NAME if you use the convention that & in the full name stands for the login id. */ /* Turned on June 1996 supposing nobody will mind it. */ @@ -1366,20 +1373,6 @@ #include #include -#ifdef HAVE_ALLOCA_H -# include -#elif defined __GNUC__ -# define alloca __builtin_alloca -#elif defined _AIX -# define alloca __alloca -#else -# include -# ifdef __cplusplus -extern "C" -# endif -void *alloca (size_t); -#endif - #ifndef HAVE_STRCHR #define strchr(a, b) index (a, b) #endif === modified file 'autogen/configure' --- autogen/configure 2011-06-21 10:18:39 +0000 +++ autogen/configure 2011-06-23 10:18:34 +0000 @@ -1070,12 +1070,15 @@ GNULIB_CALLOC_POSIX GNULIB_ATOLL GNULIB__EXIT +GL_GENERATE_ALLOCA_H_FALSE +GL_GENERATE_ALLOCA_H_TRUE +ALLOCA_H +ALLOCA GL_COND_LIBTOOL_FALSE GL_COND_LIBTOOL_TRUE BLESSMAIL_TARGET LIBS_MAIL liblockfile -ALLOCA LIBXML2_LIBS LIBXML2_CFLAGS LIBXSM @@ -6535,6 +6538,7 @@ + # Code from module alloca-opt: # Code from module allocator: # Code from module arg-nonnull: # Code from module c++defs: @@ -13313,201 +13317,6 @@ fi -# The Ultrix 4.2 mips builtin alloca declared by alloca.h only works -# for constant arguments. Useless! -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working alloca.h" >&5 -$as_echo_n "checking for working alloca.h... " >&6; } -if test "${ac_cv_working_alloca_h+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -char *p = (char *) alloca (2 * sizeof (int)); - if (p) return 0; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_working_alloca_h=yes -else - ac_cv_working_alloca_h=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_working_alloca_h" >&5 -$as_echo "$ac_cv_working_alloca_h" >&6; } -if test $ac_cv_working_alloca_h = yes; then - -$as_echo "#define HAVE_ALLOCA_H 1" >>confdefs.h - -fi - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for alloca" >&5 -$as_echo_n "checking for alloca... " >&6; } -if test "${ac_cv_func_alloca_works+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#ifdef __GNUC__ -# define alloca __builtin_alloca -#else -# ifdef _MSC_VER -# include -# define alloca _alloca -# else -# ifdef HAVE_ALLOCA_H -# include -# else -# ifdef _AIX - #pragma alloca -# else -# ifndef alloca /* predefined by HP cc +Olibcalls */ -char *alloca (); -# endif -# endif -# endif -# endif -#endif - -int -main () -{ -char *p = (char *) alloca (1); - if (p) return 0; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_func_alloca_works=yes -else - ac_cv_func_alloca_works=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_alloca_works" >&5 -$as_echo "$ac_cv_func_alloca_works" >&6; } - -if test $ac_cv_func_alloca_works = yes; then - -$as_echo "#define HAVE_ALLOCA 1" >>confdefs.h - -else - # The SVR3 libPW and SVR4 libucb both contain incompatible functions -# that cause trouble. Some versions do not even contain alloca or -# contain a buggy version. If you still want to use their alloca, -# use ar to extract alloca.o from them instead of compiling alloca.c. - -ALLOCA=\${LIBOBJDIR}alloca.$ac_objext - -$as_echo "#define C_ALLOCA 1" >>confdefs.h - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether \`alloca.c' needs Cray hooks" >&5 -$as_echo_n "checking whether \`alloca.c' needs Cray hooks... " >&6; } -if test "${ac_cv_os_cray+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#if defined CRAY && ! defined CRAY2 -webecray -#else -wenotbecray -#endif - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "webecray" >/dev/null 2>&1; then : - ac_cv_os_cray=yes -else - ac_cv_os_cray=no -fi -rm -f conftest* - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_os_cray" >&5 -$as_echo "$ac_cv_os_cray" >&6; } -if test $ac_cv_os_cray = yes; then - for ac_func in _getb67 GETB67 getb67; do - as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` -ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : - -cat >>confdefs.h <<_ACEOF -#define CRAY_STACKSEG_END $ac_func -_ACEOF - - break -fi - - done -fi - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking stack direction for C alloca" >&5 -$as_echo_n "checking stack direction for C alloca... " >&6; } -if test "${ac_cv_c_stack_direction+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - ac_cv_c_stack_direction=0 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$ac_includes_default -int -find_stack_direction () -{ - static char *addr = 0; - auto char dummy; - if (addr == 0) - { - addr = &dummy; - return find_stack_direction (); - } - else - return (&dummy > addr) ? 1 : -1; -} - -int -main () -{ - return find_stack_direction () < 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - ac_cv_c_stack_direction=1 -else - ac_cv_c_stack_direction=-1 -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_stack_direction" >&5 -$as_echo "$ac_cv_c_stack_direction" >&6; } -cat >>confdefs.h <<_ACEOF -#define STACK_DIRECTION $ac_cv_c_stack_direction -_ACEOF - - -fi - - -if test x"$ac_cv_func_alloca_works" != xyes; then - as_fn_error "a system implementation of alloca is required " "$LINENO" 5 -fi - # fmod, logb, and frexp are found in -lm on most systems. # On HPUX 9.01, -lm does not contain logb, so check for sqrt. { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sqrt in -lm" >&5 @@ -13962,6 +13771,197 @@ LIBC_FATAL_STDERR_=1 export LIBC_FATAL_STDERR_ +# The Ultrix 4.2 mips builtin alloca declared by alloca.h only works +# for constant arguments. Useless! +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working alloca.h" >&5 +$as_echo_n "checking for working alloca.h... " >&6; } +if test "${ac_cv_working_alloca_h+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +char *p = (char *) alloca (2 * sizeof (int)); + if (p) return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_working_alloca_h=yes +else + ac_cv_working_alloca_h=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_working_alloca_h" >&5 +$as_echo "$ac_cv_working_alloca_h" >&6; } +if test $ac_cv_working_alloca_h = yes; then + +$as_echo "#define HAVE_ALLOCA_H 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for alloca" >&5 +$as_echo_n "checking for alloca... " >&6; } +if test "${ac_cv_func_alloca_works+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __GNUC__ +# define alloca __builtin_alloca +#else +# ifdef _MSC_VER +# include +# define alloca _alloca +# else +# ifdef HAVE_ALLOCA_H +# include +# else +# ifdef _AIX + #pragma alloca +# else +# ifndef alloca /* predefined by HP cc +Olibcalls */ +char *alloca (); +# endif +# endif +# endif +# endif +#endif + +int +main () +{ +char *p = (char *) alloca (1); + if (p) return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_func_alloca_works=yes +else + ac_cv_func_alloca_works=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_alloca_works" >&5 +$as_echo "$ac_cv_func_alloca_works" >&6; } + +if test $ac_cv_func_alloca_works = yes; then + +$as_echo "#define HAVE_ALLOCA 1" >>confdefs.h + +else + # The SVR3 libPW and SVR4 libucb both contain incompatible functions +# that cause trouble. Some versions do not even contain alloca or +# contain a buggy version. If you still want to use their alloca, +# use ar to extract alloca.o from them instead of compiling alloca.c. + + + + + +ALLOCA=\${LIBOBJDIR}alloca.$ac_objext + +$as_echo "#define C_ALLOCA 1" >>confdefs.h + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether \`alloca.c' needs Cray hooks" >&5 +$as_echo_n "checking whether \`alloca.c' needs Cray hooks... " >&6; } +if test "${ac_cv_os_cray+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#if defined CRAY && ! defined CRAY2 +webecray +#else +wenotbecray +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "webecray" >/dev/null 2>&1; then : + ac_cv_os_cray=yes +else + ac_cv_os_cray=no +fi +rm -f conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_os_cray" >&5 +$as_echo "$ac_cv_os_cray" >&6; } +if test $ac_cv_os_cray = yes; then + for ac_func in _getb67 GETB67 getb67; do + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +eval as_val=\$$as_ac_var + if test "x$as_val" = x""yes; then : + +cat >>confdefs.h <<_ACEOF +#define CRAY_STACKSEG_END $ac_func +_ACEOF + + break +fi + + done +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking stack direction for C alloca" >&5 +$as_echo_n "checking stack direction for C alloca... " >&6; } +if test "${ac_cv_c_stack_direction+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + ac_cv_c_stack_direction=0 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_includes_default +int +find_stack_direction (int *addr, int depth) +{ + int dir, dummy = 0; + if (! addr) + addr = &dummy; + *addr = addr < &dummy ? 1 : addr == &dummy ? 0 : -1; + dir = depth ? find_stack_direction (addr, depth - 1) : 0; + return dir + dummy; +} + +int +main (int argc, char **argv) +{ + return find_stack_direction (0, argc + !argv + 20) < 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + ac_cv_c_stack_direction=1 +else + ac_cv_c_stack_direction=-1 +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_stack_direction" >&5 +$as_echo "$ac_cv_c_stack_direction" >&6; } +cat >>confdefs.h <<_ACEOF +#define STACK_DIRECTION $ac_cv_c_stack_direction +_ACEOF + + +fi + @@ -16682,6 +16682,61 @@ gl_source_base='lib' + if test $ac_cv_func_alloca_works = no; then + : + fi + + # Define an additional variable used in the Makefile substitution. + if test $ac_cv_working_alloca_h = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for alloca as a compiler built-in" >&5 +$as_echo_n "checking for alloca as a compiler built-in... " >&6; } +if test "${gl_cv_rpl_alloca+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#if defined __GNUC__ || defined _AIX || defined _MSC_VER + Need own alloca +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "Need own alloca" >/dev/null 2>&1; then : + gl_cv_rpl_alloca=yes +else + gl_cv_rpl_alloca=no +fi +rm -f conftest* + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_rpl_alloca" >&5 +$as_echo "$gl_cv_rpl_alloca" >&6; } + if test $gl_cv_rpl_alloca = yes; then + +$as_echo "#define HAVE_ALLOCA 1" >>confdefs.h + + ALLOCA_H=alloca.h + else + ALLOCA_H= + fi + else + ALLOCA_H=alloca.h + fi + + if test -n "$ALLOCA_H"; then + GL_GENERATE_ALLOCA_H_TRUE= + GL_GENERATE_ALLOCA_H_FALSE='#' +else + GL_GENERATE_ALLOCA_H_TRUE='#' + GL_GENERATE_ALLOCA_H_FALSE= +fi + + + + : @@ -18798,6 +18853,9 @@ if $condition; then func_gl_gnulib_m4code_dosname fi + if $condition; then + func_gl_gnulib_m4code_verify + fi fi } func_gl_gnulib_m4code_strtoull () @@ -21098,6 +21156,10 @@ as_fn_error "conditional \"GL_COND_LIBTOOL\" was never defined. Usually this means the macro was only invoked conditionally." "$LINENO" 5 fi +if test -z "${GL_GENERATE_ALLOCA_H_TRUE}" && test -z "${GL_GENERATE_ALLOCA_H_FALSE}"; then + as_fn_error "conditional \"GL_GENERATE_ALLOCA_H\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi if test -z "${GL_GENERATE_STDINT_H_TRUE}" && test -z "${GL_GENERATE_STDINT_H_FALSE}"; then as_fn_error "conditional \"GL_GENERATE_STDINT_H\" was never defined. ------------------------------------------------------------ revno: 104688 committer: martin rudalics branch nick: trunk timestamp: Thu 2011-06-23 10:58:45 +0200 message: Fix display-buffer related bugs reported by Thierry Volpiatto. * window.el (get-lru-window, get-mru-window) (get-largest-window): Never return a minibuffer window. (display-buffer-pop-up-window): Fix a bug that could lead to reusing the minibuffer window. (display-buffer): Pass original specifier argument to display-buffer-function instead of the normalized one. Reported by Thierry Volpiatto . diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-23 03:35:05 +0000 +++ lisp/ChangeLog 2011-06-23 08:58:45 +0000 @@ -1,3 +1,13 @@ +2011-06-23 Martin Rudalics + + * window.el (get-lru-window, get-mru-window) + (get-largest-window): Never return a minibuffer window. + (display-buffer-pop-up-window): Fix a bug that could lead to + reusing the minibuffer window. + (display-buffer): Pass original specifier argument to + display-buffer-function instead of the normalized one. + Reported by Thierry Volpiatto . + 2011-06-22 Leo Liu * minibuffer.el (completing-read-function) === modified file 'lisp/mail/rmail.el' --- lisp/mail/rmail.el 2011-03-10 03:41:17 +0000 +++ lisp/mail/rmail.el 2011-06-23 08:58:45 +0000 @@ -4316,7 +4316,7 @@ ;;;*** -;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "c530622b53038152ca84f2ec9313bd7a") +;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "5e3ff91cc650ca2c5c147dcf3397dfcf") ;;; Generated autoloads from rmailmm.el (autoload 'rmail-mime "rmailmm" "\ === modified file 'lisp/window.el' --- lisp/window.el 2011-06-22 09:23:31 +0000 +++ lisp/window.el 2011-06-23 08:58:45 +0000 @@ -1231,7 +1231,7 @@ Any other value of ALL-FRAMES means consider all windows on the selected frame and no others." (let (best-window best-time second-best-window second-best-time time) - (dolist (window (window-list-1 nil nil all-frames)) + (dolist (window (window-list-1 nil 'nomini all-frames)) (when (or dedicated (not (window-dedicated-p window))) (setq time (window-use-time window)) (if (or (eq window (selected-window)) @@ -1264,7 +1264,7 @@ Any other value of ALL-FRAMES means consider all windows on the selected frame and no others." (let (best-window best-time time) - (dolist (window (window-list-1 nil nil all-frames)) + (dolist (window (window-list-1 nil 'nomini all-frames)) (setq time (window-use-time window)) (when (or (not best-time) (> time best-time)) (setq best-time time) @@ -1294,7 +1294,7 @@ selected frame and no others." (let ((best-size 0) best-window size) - (dolist (window (window-list-1 nil nil all-frames)) + (dolist (window (window-list-1 nil 'nomini all-frames)) (when (or dedicated (not (window-dedicated-p window))) (setq size (* (window-total-size window) (window-total-size window t))) @@ -5012,65 +5012,69 @@ description." (let* ((frame (display-buffer-frame)) (selected-window (frame-selected-window frame)) - window side atomic) + cand window side atomic) (unless (and (cdr (assq 'unsplittable (frame-parameters frame))) ;; Don't split an unsplittable frame unless ;; SPECIFIERS allow it. (not (cdr (assq 'split-unsplittable-frame specifiers)))) (catch 'done (dolist (method methods) - (setq window (car method)) + (setq cand (car method)) (setq side (cdr method)) - (and (setq window - (cond - ((eq window 'largest) - (get-largest-window frame t)) - ((eq window 'lru) - (get-lru-window frame t)) - ((eq window 'selected) - (frame-selected-window frame)) - ((eq window 'root) - ;; If there are side windows, split the main - ;; window else the frame root window. - (or (window-with-parameter 'window-side 'none nil t) - (frame-root-window frame))) - ((memq window window-sides) - ;; This should gets us the "root" side - ;; window if there exists more than one. - (window-with-parameter 'window-side window nil t)) - ((windowp window) - ;; A window, directly specified. - window))) - ;; The window must be on the selected frame, - (eq (window-frame window) frame) - ;; and must be neither a minibuffer window, - (not (window-minibuffer-p window)) - ;; nor a side window. - (not (eq (window-parameter window 'window-side) 'side)) - (setq window - (cond - ((memq side display-buffer-side-specifiers) - (if (and (window-buffer window) - (setq atomic (cdr (assq 'atomic specifiers)))) - (display-buffer-split-atom-window - window side (eq atomic 'nest) specifiers) - (display-buffer-split-window window side specifiers))) - ((functionp side) - (ignore-errors - ;; Don't pass any specifiers to this function. - (funcall side window))))) - (throw 'done window)))) - - (when window - ;; Adjust sizes if asked for. - (display-buffer-set-height window specifiers) - (display-buffer-set-width window specifiers) - (set-window-parameter - window 'quit-restore (list 'new-window buffer selected-window)) - (setq display-buffer-window (cons window 'new-window)) - (display-buffer-in-window buffer window specifiers) - (set-window-prev-buffers window nil) - window)))) + (setq window + (cond + ((eq cand 'largest) + ;; The largest window. + (get-largest-window frame t)) + ((eq cand 'lru) + ;; The least recently used window. + (get-lru-window frame t)) + ((eq cand 'selected) + ;; The selected window. + (frame-selected-window frame)) + ((eq cand 'root) + ;; If there are side windows, split the main window + ;; else the frame's root window. + (or (window-with-parameter 'window-side 'none nil t) + (frame-root-window frame))) + ((memq cand window-sides) + ;; This should gets us the "root" side window if there + ;; exists more than one window on that side. + (window-with-parameter 'window-side cand nil t)) + ((windowp cand) + ;; A window, directly specified. + cand))) + + (when (and (window-live-p window) + ;; The window must be on the correct frame, + (eq (window-frame window) frame) + ;; and must be neither a minibuffer window + (not (window-minibuffer-p window)) + ;; nor a side window. + (not (eq (window-parameter window 'window-side) 'side))) + (setq window + (cond + ((memq side display-buffer-side-specifiers) + (if (and (window-buffer window) + (setq atomic (cdr (assq 'atomic specifiers)))) + (display-buffer-split-atom-window + window side (eq atomic 'nest) specifiers) + (display-buffer-split-window window side specifiers))) + ((functionp side) + (ignore-errors + ;; Don't pass any specifiers to this function. + (funcall side window))))) + + (when window + ;; Adjust sizes if asked for. + (display-buffer-set-height window specifiers) + (display-buffer-set-width window specifiers) + (set-window-parameter + window 'quit-restore (list 'new-window buffer selected-window)) + (setq display-buffer-window (cons window 'new-window)) + (display-buffer-in-window buffer window specifiers) + (set-window-prev-buffers window nil) + (throw 'done window)))))))) (defun display-buffer-pop-up-frame (buffer &optional graphic-only specifiers) "Make a new frame for displaying BUFFER. @@ -5632,7 +5636,7 @@ (interactive "BDisplay buffer:\nP") (let* ((buffer (normalize-buffer-to-display buffer-or-name)) (buffer-name (buffer-name buffer)) - (specifiers + (normalized ;; Normalize specifiers. (display-buffer-normalize-specifiers buffer-name specifiers label)) ;; Don't use a minibuffer frame. @@ -5646,24 +5650,24 @@ (funcall display-buffer-function buffer specifiers) ;; Retrieve the next location specifier while there a specifiers ;; left and we don't have a valid window. - (while (and specifiers (not (window-live-p window))) - (setq specifier (car specifiers)) - (setq specifiers (cdr specifiers)) + (while (and normalized (not (window-live-p window))) + (setq specifier (car normalized)) + (setq normalized (cdr normalized)) (setq method (car specifier)) (setq window (cond ((eq method 'reuse-window) (display-buffer-reuse-window - buffer (cdr specifier) specifiers)) + buffer (cdr specifier) normalized)) ((eq method 'pop-up-window) (display-buffer-pop-up-window - buffer (cdr specifier) specifiers)) + buffer (cdr specifier) normalized)) ((eq method 'pop-up-frame) (display-buffer-pop-up-frame - buffer (cdr specifier) specifiers)) + buffer (cdr specifier) normalized)) ((eq method 'use-side-window) (display-buffer-in-side-window - buffer (nth 1 specifier) (nth 2 specifier) specifiers)) + buffer (nth 1 specifier) (nth 2 specifier) normalized)) ((eq method 'fun-with-args) (apply (cadr specifier) buffer (cddr specifier)))))) ------------------------------------------------------------ revno: 104687 [merge] committer: Paul Eggert branch nick: trunk timestamp: Thu 2011-06-23 01:12:57 -0700 message: Merge from gnulib. diff: === modified file 'ChangeLog' --- ChangeLog 2011-06-22 16:28:41 +0000 +++ ChangeLog 2011-06-23 08:10:57 +0000 @@ -1,3 +1,7 @@ +2011-06-23 Paul Eggert + + * lib/getopt.c, lib/stat.c, m4/gl-comp.m4: Merge from gnulib. + 2011-06-22 Paul Eggert Use gnulib's alloca-opt module. === modified file 'lib/getopt.c' --- lib/getopt.c 2011-06-04 16:51:28 +0000 +++ lib/getopt.c 2011-06-23 08:10:57 +0000 @@ -829,7 +829,7 @@ return '?'; } /* Convenience. Treat POSIX -W foo same as long option --foo */ - if (temp[0] == 'W' && temp[1] == ';') + if (temp[0] == 'W' && temp[1] == ';' && longopts) { char *nameend; const struct option *p; === modified file 'lib/stat.c' --- lib/stat.c 2011-02-25 20:05:36 +0000 +++ lib/stat.c 2011-06-23 08:10:57 +0000 @@ -38,6 +38,7 @@ #include #include #include "dosname.h" +#include "verify.h" /* Store information about NAME into ST. Work around bugs with trailing slashes. Mingw has other bugs (such as st_ino always @@ -63,6 +64,12 @@ } #endif /* REPLACE_FUNC_STAT_FILE */ #if REPLACE_FUNC_STAT_DIR + /* The only known systems where REPLACE_FUNC_STAT_DIR is needed also + have a constant PATH_MAX. */ +# ifndef PATH_MAX +# error "Please port this replacement to your platform" +# endif + if (result == -1 && errno == ENOENT) { /* Due to mingw's oddities, there are some directories (like @@ -77,6 +84,7 @@ char fixed_name[PATH_MAX + 1] = {0}; size_t len = strlen (name); bool check_dir = false; + verify (PATH_MAX <= 4096); if (PATH_MAX <= len) errno = ENAMETOOLONG; else if (len) === modified file 'm4/gl-comp.m4' --- m4/gl-comp.m4 2011-06-21 16:15:07 +0000 +++ m4/gl-comp.m4 2011-06-23 08:10:57 +0000 @@ -206,6 +206,9 @@ if $condition; then func_gl_gnulib_m4code_dosname fi + if $condition; then + func_gl_gnulib_m4code_verify + fi fi } func_gl_gnulib_m4code_strtoull () ------------------------------------------------------------ revno: 104686 [merge] committer: Paul Eggert branch nick: trunk timestamp: Thu 2011-06-23 00:51:45 -0700 message: Merge: Integer and buffer overflow fixes. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-23 03:35:05 +0000 +++ src/ChangeLog 2011-06-23 07:37:31 +0000 @@ -1,3 +1,49 @@ +2011-06-23 Paul Eggert + + Integer and buffer overflow fixes (Bug#8873). + + * print.c (printchar, strout): Check for string overflow. + (PRINTPREPARE, printchar, strout): + Don't set size unless allocation succeeds. + + * minibuf.c (read_minibuf_noninteractive): Use ptrdiff_t, not int, + for sizes. Check for string overflow more accurately. + Simplify newline removal at end; this suppresses a GCC 4.6.0 warning. + + * macros.c: Integer and buffer overflow fixes. + * keyboard.h (struct keyboard.kbd_macro_bufsize): + * macros.c (Fstart_kbd_macro, store_kbd_macro_char): + Use ptrdiff_t, not int, for sizes. + Don't increment bufsize until after realloc succeeds. + Check for size-calculation overflow. + (Fstart_kbd_macro): Use EMACS_INT, not int, for XINT result. + + * lisp.h (DEFVAR_KBOARD): Use offsetof instead of char * finagling. + + * lread.c: Integer overflow fixes. + (read_integer): Radix is now EMACS_INT, not int, + to improve quality of diagnostics for out-of-range radices. + Calculate buffer size correctly for out-of-range radices. + (read1): Check for integer overflow in radices, and in + read-circle numbers. + (read_escape): Avoid int overflow. + (Fload, openp, read_buffer_size, read1) + (substitute_object_recurse, read_vector, read_list, map_obarray): + Use ptrdiff_t, not int, for sizes. + (read1): Use EMACS_INT, not int, for sizes. + Check for size overflow. + + * image.c (cache_image): Check for size arithmetic overflow. + + * lread.c: Integer overflow issues. + (saved_doc_string_size, saved_doc_string_length) + (prev_saved_doc_string_size, prev_saved_doc_string_length): + Now ptrdiff_t, not int. + (read1): Don't assume doc string length fits in int. Check for + out-of-range doc string lengths. + (read_list): Don't assume file position fits in int. + (read_escape): Check for hex character overflow. + 2011-06-22 Leo Liu * minibuf.c (Fcompleting_read_default, Vcompleting_read_function): === modified file 'src/image.c' --- src/image.c 2011-06-22 16:01:00 +0000 +++ src/image.c 2011-06-23 00:46:41 +0000 @@ -1836,6 +1836,8 @@ /* If no free slot found, maybe enlarge c->images. */ if (i == c->used && c->used == c->size) { + if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof *c->images / 2 < c->size) + memory_full (SIZE_MAX); c->size *= 2; c->images = (struct image **) xrealloc (c->images, c->size * sizeof *c->images); === modified file 'src/keyboard.h' --- src/keyboard.h 2011-06-11 21:31:32 +0000 +++ src/keyboard.h 2011-06-23 06:31:41 +0000 @@ -123,7 +123,7 @@ Lisp_Object *kbd_macro_end; /* Allocated size of kbd_macro_buffer. */ - int kbd_macro_bufsize; + ptrdiff_t kbd_macro_bufsize; /* Last anonymous kbd macro defined. */ Lisp_Object KBOARD_INTERNAL_FIELD (Vlast_kbd_macro); === modified file 'src/lisp.h' --- src/lisp.h 2011-06-22 06:16:16 +0000 +++ src/lisp.h 2011-06-23 05:35:51 +0000 @@ -1980,10 +1980,7 @@ #define DEFVAR_KBOARD(lname, vname, doc) \ do { \ static struct Lisp_Kboard_Objfwd ko_fwd; \ - defvar_kboard (&ko_fwd, \ - lname, \ - (int)((char *)(¤t_kboard->vname ## _) \ - - (char *)current_kboard)); \ + defvar_kboard (&ko_fwd, lname, offsetof (KBOARD, vname ## _)); \ } while (0) === modified file 'src/lread.c' --- src/lread.c 2011-06-20 06:11:36 +0000 +++ src/lread.c 2011-06-23 05:41:40 +0000 @@ -120,9 +120,9 @@ /* This contains the last string skipped with #@. */ static char *saved_doc_string; /* Length of buffer allocated in saved_doc_string. */ -static int saved_doc_string_size; +static ptrdiff_t saved_doc_string_size; /* Length of actual data in saved_doc_string. */ -static int saved_doc_string_length; +static ptrdiff_t saved_doc_string_length; /* This is the file position that string came from. */ static file_offset saved_doc_string_position; @@ -131,9 +131,9 @@ is put in saved_doc_string. */ static char *prev_saved_doc_string; /* Length of buffer allocated in prev_saved_doc_string. */ -static int prev_saved_doc_string_size; +static ptrdiff_t prev_saved_doc_string_size; /* Length of actual data in prev_saved_doc_string. */ -static int prev_saved_doc_string_length; +static ptrdiff_t prev_saved_doc_string_length; /* This is the file position that string came from. */ static file_offset prev_saved_doc_string_position; @@ -1069,9 +1069,9 @@ /* Avoid weird lossage with null string as arg, since it would try to load a directory as a Lisp file */ - if (SCHARS (file) > 0) + if (SBYTES (file) > 0) { - int size = SBYTES (file); + ptrdiff_t size = SBYTES (file); found = Qnil; GCPRO2 (file, found); @@ -1472,7 +1472,7 @@ for (tail = NILP (suffixes) ? Fcons (empty_unibyte_string, Qnil) : suffixes; CONSP (tail); tail = XCDR (tail)) { - int lsuffix = SBYTES (XCAR (tail)); + ptrdiff_t lsuffix = SBYTES (XCAR (tail)); Lisp_Object handler; int exists; @@ -2037,7 +2037,7 @@ Fmake_string (make_number (1), make_number (c))); } -static int read_buffer_size; +static ptrdiff_t read_buffer_size; static char *read_buffer; /* Read a \-escape sequence, assuming we already read the `\'. @@ -2208,7 +2208,9 @@ UNREAD (c); break; } - count++; + if (MAX_CHAR < i) + error ("Hex character out of range: \\x%x...", i); + count += count < 3; } if (count < 3 && i >= 0x80) @@ -2236,10 +2238,7 @@ else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10; else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10; else - { - error ("Non-hex digit used for Unicode escape"); - break; - } + error ("Non-hex digit used for Unicode escape"); } if (i > 0x10FFFF) error ("Non-Unicode character: 0x%x", i); @@ -2278,10 +2277,12 @@ range. */ static Lisp_Object -read_integer (Lisp_Object readcharfun, int radix) +read_integer (Lisp_Object readcharfun, EMACS_INT radix) { - /* Room for sign, leading 0, other digits, trailing null byte. */ - char buf[1 + 1 + sizeof (uintmax_t) * CHAR_BIT + 1]; + /* Room for sign, leading 0, other digits, trailing null byte. + Also, room for invalid syntax diagnostic. */ + char buf[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT + 1, + sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT))]; int valid = -1; /* 1 if valid, 0 if not, -1 if incomplete. */ @@ -2333,7 +2334,7 @@ if (! valid) { - sprintf (buf, "integer, radix %d", radix); + sprintf (buf, "integer, radix %"pI"d", radix); invalid_syntax (buf); } @@ -2471,7 +2472,7 @@ if (c == '[') { Lisp_Object tmp; - int depth, size; + EMACS_INT depth, size; tmp = read_vector (readcharfun, 0); if (!INTEGERP (AREF (tmp, 0))) @@ -2497,7 +2498,7 @@ if (c == '"') { Lisp_Object tmp, val; - int size_in_chars + EMACS_INT size_in_chars = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1) / BOOL_VECTOR_BITS_PER_CHAR); @@ -2569,13 +2570,16 @@ and function definitions. */ if (c == '@') { - int i, nskip = 0; + enum { extra = 100 }; + ptrdiff_t i, nskip = 0; load_each_byte = 1; /* Read a decimal integer. */ while ((c = READCHAR) >= 0 && c >= '0' && c <= '9') { + if ((STRING_BYTES_BOUND - extra) / 10 <= nskip) + string_overflow (); nskip *= 10; nskip += c - '0'; } @@ -2594,9 +2598,9 @@ with prev_saved_doc_string, so we save two strings. */ { char *temp = saved_doc_string; - int temp_size = saved_doc_string_size; + ptrdiff_t temp_size = saved_doc_string_size; file_offset temp_pos = saved_doc_string_position; - int temp_len = saved_doc_string_length; + ptrdiff_t temp_len = saved_doc_string_length; saved_doc_string = prev_saved_doc_string; saved_doc_string_size = prev_saved_doc_string_size; @@ -2611,12 +2615,12 @@ if (saved_doc_string_size == 0) { - saved_doc_string_size = nskip + 100; + saved_doc_string_size = nskip + extra; saved_doc_string = (char *) xmalloc (saved_doc_string_size); } if (nskip > saved_doc_string_size) { - saved_doc_string_size = nskip + 100; + saved_doc_string_size = nskip + extra; saved_doc_string = (char *) xrealloc (saved_doc_string, saved_doc_string_size); } @@ -2661,49 +2665,60 @@ /* Reader forms that can reuse previously read objects. */ if (c >= '0' && c <= '9') { - int n = 0; + EMACS_INT n = 0; Lisp_Object tem; /* Read a non-negative integer. */ while (c >= '0' && c <= '9') { - n *= 10; - n += c - '0'; + if (MOST_POSITIVE_FIXNUM / 10 < n + || MOST_POSITIVE_FIXNUM < n * 10 + c - '0') + n = MOST_POSITIVE_FIXNUM + 1; + else + n = n * 10 + c - '0'; c = READCHAR; } - /* #n=object returns object, but associates it with n for #n#. */ - if (c == '=' && !NILP (Vread_circle)) - { - /* Make a placeholder for #n# to use temporarily */ - Lisp_Object placeholder; - Lisp_Object cell; - - placeholder = Fcons (Qnil, Qnil); - cell = Fcons (make_number (n), placeholder); - read_objects = Fcons (cell, read_objects); - - /* Read the object itself. */ - tem = read0 (readcharfun); - - /* Now put it everywhere the placeholder was... */ - substitute_object_in_subtree (tem, placeholder); - - /* ...and #n# will use the real value from now on. */ - Fsetcdr (cell, tem); - - return tem; - } - /* #n# returns a previously read object. */ - if (c == '#' && !NILP (Vread_circle)) - { - tem = Fassq (make_number (n), read_objects); - if (CONSP (tem)) - return XCDR (tem); - /* Fall through to error message. */ - } - else if (c == 'r' || c == 'R') - return read_integer (readcharfun, n); - + + if (n <= MOST_POSITIVE_FIXNUM) + { + if (c == 'r' || c == 'R') + return read_integer (readcharfun, n); + + if (! NILP (Vread_circle)) + { + /* #n=object returns object, but associates it with + n for #n#. */ + if (c == '=') + { + /* Make a placeholder for #n# to use temporarily */ + Lisp_Object placeholder; + Lisp_Object cell; + + placeholder = Fcons (Qnil, Qnil); + cell = Fcons (make_number (n), placeholder); + read_objects = Fcons (cell, read_objects); + + /* Read the object itself. */ + tem = read0 (readcharfun); + + /* Now put it everywhere the placeholder was... */ + substitute_object_in_subtree (tem, placeholder); + + /* ...and #n# will use the real value from now on. */ + Fsetcdr (cell, tem); + + return tem; + } + + /* #n# returns a previously read object. */ + if (c == '#') + { + tem = Fassq (make_number (n), read_objects); + if (CONSP (tem)) + return XCDR (tem); + } + } + } /* Fall through to error message. */ } else if (c == 'x' || c == 'X') @@ -2846,14 +2861,16 @@ a single-byte character. */ int force_singlebyte = 0; int cancel = 0; - int nchars = 0; + ptrdiff_t nchars = 0; while ((ch = READCHAR) >= 0 && ch != '\"') { if (end - p < MAX_MULTIBYTE_LENGTH) { - int offset = p - read_buffer; + ptrdiff_t offset = p - read_buffer; + if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size) + memory_full (SIZE_MAX); read_buffer = (char *) xrealloc (read_buffer, read_buffer_size *= 2); p = read_buffer + offset; @@ -2996,7 +3013,9 @@ { if (end - p < MAX_MULTIBYTE_LENGTH) { - int offset = p - read_buffer; + ptrdiff_t offset = p - read_buffer; + if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size) + memory_full (SIZE_MAX); read_buffer = (char *) xrealloc (read_buffer, read_buffer_size *= 2); p = read_buffer + offset; @@ -3023,7 +3042,9 @@ if (p == end) { - int offset = p - read_buffer; + ptrdiff_t offset = p - read_buffer; + if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size) + memory_full (SIZE_MAX); read_buffer = (char *) xrealloc (read_buffer, read_buffer_size *= 2); p = read_buffer + offset; @@ -3135,7 +3156,7 @@ { case Lisp_Vectorlike: { - int i, length = 0; + ptrdiff_t i, length = 0; if (BOOL_VECTOR_P (subtree)) return subtree; /* No sub-objects anyway. */ else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree) @@ -3358,8 +3379,7 @@ static Lisp_Object read_vector (Lisp_Object readcharfun, int bytecodeflag) { - register int i; - register int size; + ptrdiff_t i, size; register Lisp_Object *ptr; register Lisp_Object tem, item, vector; register struct Lisp_Cons *otem; @@ -3528,15 +3548,15 @@ doc string, caller must make it multibyte. */ - int pos = XINT (XCDR (val)); + EMACS_INT pos = XINT (XCDR (val)); /* Position is negative for user variables. */ if (pos < 0) pos = -pos; if (pos >= saved_doc_string_position && pos < (saved_doc_string_position + saved_doc_string_length)) { - int start = pos - saved_doc_string_position; - int from, to; + ptrdiff_t start = pos - saved_doc_string_position; + ptrdiff_t from, to; /* Process quoting with ^A, and find the end of the string, @@ -3567,8 +3587,9 @@ && pos < (prev_saved_doc_string_position + prev_saved_doc_string_length)) { - int start = pos - prev_saved_doc_string_position; - int from, to; + ptrdiff_t start = + pos - prev_saved_doc_string_position; + ptrdiff_t from, to; /* Process quoting with ^A, and find the end of the string, @@ -3891,7 +3912,7 @@ void map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg) { - register int i; + ptrdiff_t i; register Lisp_Object tail; CHECK_VECTOR (obarray); for (i = ASIZE (obarray) - 1; i >= 0; i--) @@ -3991,7 +4012,7 @@ #endif /* NOTDEF */ /* Define an "integer variable"; a symbol whose value is forwarded to a - C variable of type int. Sample call (munged w "xx" to fool make-docfile): + C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile): DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */ void defvar_int (struct Lisp_Intfwd *i_fwd, === modified file 'src/macros.c' --- src/macros.c 2011-04-14 05:04:02 +0000 +++ src/macros.c 2011-06-23 06:31:41 +0000 @@ -71,10 +71,10 @@ { if (current_kboard->kbd_macro_bufsize > 200) { + current_kboard->kbd_macro_buffer + = (Lisp_Object *)xrealloc (current_kboard->kbd_macro_buffer, + 30 * sizeof (Lisp_Object)); current_kboard->kbd_macro_bufsize = 30; - current_kboard->kbd_macro_buffer - = (Lisp_Object *)xrealloc (current_kboard->kbd_macro_buffer, - 30 * sizeof (Lisp_Object)); } current_kboard->kbd_macro_ptr = current_kboard->kbd_macro_buffer; current_kboard->kbd_macro_end = current_kboard->kbd_macro_buffer; @@ -82,7 +82,8 @@ } else { - int i, len; + ptrdiff_t i; + EMACS_INT len; int cvt; /* Check the type of last-kbd-macro in case Lisp code changed it. */ @@ -94,10 +95,13 @@ has put another macro there. */ if (current_kboard->kbd_macro_bufsize < len + 30) { + if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object) - 30 + < current_kboard->kbd_macro_bufsize) + memory_full (SIZE_MAX); + current_kboard->kbd_macro_buffer + = (Lisp_Object *)xrealloc (current_kboard->kbd_macro_buffer, + (len + 30) * sizeof (Lisp_Object)); current_kboard->kbd_macro_bufsize = len + 30; - current_kboard->kbd_macro_buffer - = (Lisp_Object *)xrealloc (current_kboard->kbd_macro_buffer, - (len + 30) * sizeof (Lisp_Object)); } /* Must convert meta modifier when copying string to vector. */ @@ -191,14 +195,17 @@ { if (kb->kbd_macro_ptr - kb->kbd_macro_buffer == kb->kbd_macro_bufsize) { - int ptr_offset, end_offset, nbytes; + ptrdiff_t ptr_offset, end_offset, nbytes; ptr_offset = kb->kbd_macro_ptr - kb->kbd_macro_buffer; end_offset = kb->kbd_macro_end - kb->kbd_macro_buffer; - kb->kbd_macro_bufsize *= 2; - nbytes = kb->kbd_macro_bufsize * sizeof *kb->kbd_macro_buffer; + if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof *kb->kbd_macro_buffer / 2 + < kb->kbd_macro_bufsize) + memory_full (SIZE_MAX); + nbytes = kb->kbd_macro_bufsize * 2 * sizeof *kb->kbd_macro_buffer; kb->kbd_macro_buffer = (Lisp_Object *) xrealloc (kb->kbd_macro_buffer, nbytes); + kb->kbd_macro_bufsize *= 2; kb->kbd_macro_ptr = kb->kbd_macro_buffer + ptr_offset; kb->kbd_macro_end = kb->kbd_macro_buffer + end_offset; } === modified file 'src/minibuf.c' --- src/minibuf.c 2011-06-23 03:35:05 +0000 +++ src/minibuf.c 2011-06-23 07:37:31 +0000 @@ -236,7 +236,7 @@ Lisp_Object defalt, int allow_props, int inherit_input_method) { - size_t size, len; + ptrdiff_t size, len; char *line, *s; Lisp_Object val; @@ -246,12 +246,12 @@ val = Qnil; size = 100; len = 0; - line = (char *) xmalloc (size * sizeof *line); + line = (char *) xmalloc (size); while ((s = fgets (line + len, size - len, stdin)) != NULL && (len = strlen (line), len == size - 1 && line[len - 1] != '\n')) { - if ((size_t) -1 / 2 < size) + if (STRING_BYTES_BOUND / 2 < size) memory_full (SIZE_MAX); size *= 2; line = (char *) xrealloc (line, size); @@ -259,11 +259,9 @@ if (s) { - len = strlen (line); - - if (len > 0 && line[len - 1] == '\n') - line[--len] = '\0'; - + char *nl = strchr (line, '\n'); + if (nl) + *nl = '\0'; val = build_string (line); xfree (line); } === modified file 'src/print.c' --- src/print.c 2011-06-08 21:43:46 +0000 +++ src/print.c 2011-06-23 07:33:28 +0000 @@ -159,8 +159,9 @@ } \ else \ { \ - print_buffer_size = 1000; \ - print_buffer = (char *) xmalloc (print_buffer_size); \ + ptrdiff_t new_size = 1000; \ + print_buffer = (char *) xmalloc (new_size); \ + print_buffer_size = new_size; \ free_print_buffer = 1; \ } \ print_buffer_pos = 0; \ @@ -235,9 +236,15 @@ if (NILP (fun)) { - if (print_buffer_pos_byte + len >= print_buffer_size) - print_buffer = (char *) xrealloc (print_buffer, - print_buffer_size *= 2); + if (print_buffer_size - len <= print_buffer_pos_byte) + { + ptrdiff_t new_size; + if (STRING_BYTES_BOUND / 2 < print_buffer_size) + string_overflow (); + new_size = print_buffer_size * 2; + print_buffer = (char *) xrealloc (print_buffer, new_size); + print_buffer_size = new_size; + } memcpy (print_buffer + print_buffer_pos_byte, str, len); print_buffer_pos += 1; print_buffer_pos_byte += len; @@ -280,11 +287,14 @@ if (NILP (printcharfun)) { - if (print_buffer_pos_byte + size_byte > print_buffer_size) + if (print_buffer_size - size_byte < print_buffer_pos_byte) { - print_buffer_size = print_buffer_size * 2 + size_byte; - print_buffer = (char *) xrealloc (print_buffer, - print_buffer_size); + ptrdiff_t new_size; + if (STRING_BYTES_BOUND / 2 - size_byte < print_buffer_size) + string_overflow (); + new_size = print_buffer_size * 2 + size_byte; + print_buffer = (char *) xrealloc (print_buffer, new_size); + print_buffer_size = new_size; } memcpy (print_buffer + print_buffer_pos_byte, ptr, size_byte); print_buffer_pos += size; ------------------------------------------------------------ revno: 104685 committer: Leo Liu branch nick: trunk timestamp: Thu 2011-06-23 11:35:05 +0800 message: Move completing-read-function and completing-read-default to elisp diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-22 23:39:29 +0000 +++ lisp/ChangeLog 2011-06-23 03:35:05 +0000 @@ -1,3 +1,8 @@ +2011-06-22 Leo Liu + + * minibuffer.el (completing-read-function) + (completing-read-default): Move from minibuf.c + 2011-06-22 Richard Stallman * mail/sendmail.el (mail-bury): If Rmail is in use, return nicely === modified file 'lisp/minibuffer.el' --- lisp/minibuffer.el 2011-06-20 20:16:20 +0000 +++ lisp/minibuffer.el 2011-06-23 03:35:05 +0000 @@ -2710,7 +2710,40 @@ (let ((newstr (completion-initials-expand string table pred))) (when newstr (completion-pcm-try-completion newstr table pred (length newstr))))) - + +(defvar completing-read-function 'completing-read-default + "The function called by `completing-read' to do its work. +It should accept the same arguments as `completing-read'.") + +(defun completing-read-default (prompt collection &optional predicate + require-match initial-input + hist def inherit-input-method) + "Default method for reading from the minibuffer with completion. +See `completing-read' for the meaning of the arguments." + + (when (consp initial-input) + (setq initial-input + (cons (car initial-input) + ;; `completing-read' uses 0-based index while + ;; `read-from-minibuffer' uses 1-based index. + (1+ (cdr initial-input))))) + + (let* ((minibuffer-completion-table collection) + (minibuffer-completion-predicate predicate) + (minibuffer-completion-confirm (unless (eq require-match t) + require-match)) + (keymap (if require-match + (if (memq minibuffer-completing-file-name '(nil lambda)) + minibuffer-local-must-match-map + minibuffer-local-filename-must-match-map) + (if (memq minibuffer-completing-file-name '(nil lambda)) + minibuffer-local-completion-map + minibuffer-local-filename-completion-map))) + (result (read-from-minibuffer prompt initial-input keymap + nil hist def inherit-input-method))) + (when (and (equal result "") def) + (setq result (if (consp def) (car def) def))) + result)) ;; Miscellaneous === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-22 18:20:15 +0000 +++ src/ChangeLog 2011-06-23 03:35:05 +0000 @@ -1,3 +1,8 @@ +2011-06-22 Leo Liu + + * minibuf.c (Fcompleting_read_default, Vcompleting_read_function): + Move to minibuffer.el. + 2011-06-22 Paul Eggert Fixes for GLYPH_DEBUG found by GCC 4.6.0 static checking. === modified file 'src/minibuf.c' --- src/minibuf.c 2011-06-20 06:14:57 +0000 +++ src/minibuf.c 2011-06-23 03:35:05 +0000 @@ -72,7 +72,6 @@ static Lisp_Object Qminibuffer_completion_table; static Lisp_Object Qminibuffer_completion_predicate; static Lisp_Object Qminibuffer_completion_confirm; -static Lisp_Object Qcompleting_read_default; static Lisp_Object Quser_variable_p; static Lisp_Object Qminibuffer_default; @@ -1694,7 +1693,7 @@ (Lisp_Object prompt, Lisp_Object collection, Lisp_Object predicate, Lisp_Object require_match, Lisp_Object initial_input, Lisp_Object hist, Lisp_Object def, Lisp_Object inherit_input_method) { Lisp_Object args[9]; - args[0] = Vcompleting_read_function; + args[0] = Fsymbol_value (intern ("completing-read-function")); args[1] = prompt; args[2] = collection; args[3] = predicate; @@ -1705,76 +1704,6 @@ args[8] = inherit_input_method; return Ffuncall (9, args); } - -DEFUN ("completing-read-default", Fcompleting_read_default, Scompleting_read_default, 2, 8, 0, - doc: /* Default method for reading from the minibuffer with completion. -See `completing-read' for the meaning of the arguments. */) - (Lisp_Object prompt, Lisp_Object collection, Lisp_Object predicate, Lisp_Object require_match, Lisp_Object initial_input, Lisp_Object hist, Lisp_Object def, Lisp_Object inherit_input_method) -{ - Lisp_Object val, histvar, histpos, position; - Lisp_Object init; - int pos = 0; - int count = SPECPDL_INDEX (); - struct gcpro gcpro1; - - init = initial_input; - GCPRO1 (def); - - specbind (Qminibuffer_completion_table, collection); - specbind (Qminibuffer_completion_predicate, predicate); - specbind (Qminibuffer_completion_confirm, - EQ (require_match, Qt) ? Qnil : require_match); - - position = Qnil; - if (!NILP (init)) - { - if (CONSP (init)) - { - position = Fcdr (init); - init = Fcar (init); - } - CHECK_STRING (init); - if (!NILP (position)) - { - CHECK_NUMBER (position); - /* Convert to distance from end of input. */ - pos = XINT (position) - SCHARS (init); - } - } - - if (SYMBOLP (hist)) - { - histvar = hist; - histpos = Qnil; - } - else - { - histvar = Fcar_safe (hist); - histpos = Fcdr_safe (hist); - } - if (NILP (histvar)) - histvar = Qminibuffer_history; - if (NILP (histpos)) - XSETFASTINT (histpos, 0); - - val = read_minibuf (NILP (require_match) - ? (NILP (Vminibuffer_completing_file_name) - || EQ (Vminibuffer_completing_file_name, Qlambda) - ? Vminibuffer_local_completion_map - : Vminibuffer_local_filename_completion_map) - : (NILP (Vminibuffer_completing_file_name) - || EQ (Vminibuffer_completing_file_name, Qlambda) - ? Vminibuffer_local_must_match_map - : Vminibuffer_local_filename_must_match_map), - init, prompt, make_number (pos), 0, - histvar, histpos, def, 0, - !NILP (inherit_input_method)); - - if (STRINGP (val) && SCHARS (val) == 0 && ! NILP (def)) - val = CONSP (def) ? XCAR (def) : def; - - RETURN_UNGCPRO (unbind_to (count, val)); -} Lisp_Object Fassoc_string (register Lisp_Object key, Lisp_Object list, Lisp_Object case_fold); @@ -2013,7 +1942,6 @@ minibuf_save_list = Qnil; staticpro (&minibuf_save_list); - DEFSYM (Qcompleting_read_default, "completing-read-default"); DEFSYM (Qcompletion_ignore_case, "completion-ignore-case"); DEFSYM (Qread_file_name_internal, "read-file-name-internal"); DEFSYM (Qminibuffer_default, "minibuffer-default"); @@ -2132,12 +2060,6 @@ doc: /* Non-nil means completing file names. */); Vminibuffer_completing_file_name = Qnil; - DEFVAR_LISP ("completing-read-function", - Vcompleting_read_function, - doc: /* The function called by `completing-read' to do the work. -It should accept the same arguments as `completing-read'. */); - Vcompleting_read_function = Qcompleting_read_default; - DEFVAR_LISP ("minibuffer-help-form", Vminibuffer_help_form, doc: /* Value that `help-form' takes on inside the minibuffer. */); Vminibuffer_help_form = Qnil; @@ -2214,5 +2136,4 @@ defsubr (&Stest_completion); defsubr (&Sassoc_string); defsubr (&Scompleting_read); - defsubr (&Scompleting_read_default); } ------------------------------------------------------------ revno: 104684 committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Thu 2011-06-23 02:18:46 +0200 message: Fix typo in last check-in. diff: === modified file 'lisp/erc/erc.el' --- lisp/erc/erc.el 2011-06-23 00:17:41 +0000 +++ lisp/erc/erc.el 2011-06-23 00:18:46 +0000 @@ -2178,7 +2178,7 @@ The process will be given the name NAME, its target buffer will be BUFFER. HOST and PORT specify the connection target." (open-network-stream name buffer host port - :type 'tls))) + :type 'tls)) ;;; Displaying error messages ------------------------------------------------------------ revno: 104683 committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Thu 2011-06-23 02:17:41 +0200 message: Clean up the ssl/tls support to be able to use the built-in support, too. diff: === modified file 'lisp/erc/ChangeLog' --- lisp/erc/ChangeLog 2011-05-28 02:10:32 +0000 +++ lisp/erc/ChangeLog 2011-06-23 00:17:41 +0000 @@ -1,3 +1,12 @@ +2011-06-23 Lars Magne Ingebrigtsen + + * erc.el (erc-ssl): Made into a synonym for erc-tls, which + provides a superset of the same functionality. + (erc-open-ssl-stream): Removed. + (erc-open-tls-stream): Use `open-network-stream' instead of + `open-tls-stream' directly to be able to use the built-in TLS + support. + 2011-05-28 Stefan Monnier * erc-pcomplete.el (erc-pcompletions-at-point): Mark the completion === modified file 'lisp/erc/erc.el' --- lisp/erc/erc.el 2011-05-03 08:37:51 +0000 +++ lisp/erc/erc.el 2011-06-23 00:17:41 +0000 @@ -2164,34 +2164,7 @@ ;;;###autoload (defalias 'erc-select 'erc) - -(defun erc-ssl (&rest r) - "Interactively select SSL connection parameters and run ERC. -Arguments are the same as for `erc'." - (interactive (erc-select-read-args)) - (let ((erc-server-connect-function 'erc-open-ssl-stream)) - (apply 'erc r))) - -(defalias 'erc-select-ssl 'erc-ssl) - -(declare-function open-ssl-stream "ext:ssl" (name buffer host service)) - -(defun erc-open-ssl-stream (name buffer host port) - "Open an SSL stream to an IRC server. -The process will be given the name NAME, its target buffer will be -BUFFER. HOST and PORT specify the connection target." - (when (condition-case nil - (require 'ssl) - (error (message "You don't have ssl.el. %s" - "Try using `erc-tls' instead.") - nil)) - (let ((proc (open-ssl-stream name buffer host port))) - ;; Ugly hack, but it works for now. Problem is it is - ;; very hard to detect when ssl is established, because s_client - ;; doesn't give any CONNECTIONESTABLISHED kind of message, and - ;; most IRC servers send nothing and wait for you to identify. - (sit-for 5) - proc))) +(defalias 'erc-ssl 'erc-tls) (defun erc-tls (&rest r) "Interactively select TLS connection parameters and run ERC. @@ -2200,18 +2173,12 @@ (let ((erc-server-connect-function 'erc-open-tls-stream)) (apply 'erc r))) -(declare-function open-tls-stream "tls" (name buffer host port)) - (defun erc-open-tls-stream (name buffer host port) "Open an TLS stream to an IRC server. The process will be given the name NAME, its target buffer will be BUFFER. HOST and PORT specify the connection target." - (when (condition-case nil - (require 'tls) - (error (message "You don't have tls.el. %s" - "Try using `erc-ssl' instead.") - nil)) - (open-tls-stream name buffer host port))) + (open-network-stream name buffer host port + :type 'tls))) ;;; Displaying error messages ------------------------------------------------------------ revno: 104682 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Thu 2011-06-23 00:00:38 +0000 message: nnimap.el (nnimap-open-connection-1): Fix indentation. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2011-06-21 22:13:24 +0000 +++ lisp/gnus/ChangeLog 2011-06-23 00:00:38 +0000 @@ -1,3 +1,10 @@ +2011-06-22 Lars Magne Ingebrigtsen + + * auth-source.el (auth-source-netrc-create): Don't query the bits that + we already know. + (auth-source-forget-all-cached): Clear auth-source-netrc-cache, too. + (auth-source-netrc-create): Don't prompt for the stuff we already know. + 2011-06-21 Lars Magne Ingebrigtsen * auth-source.el (auth-source-netrc-create): Don't print all tokens in === modified file 'lisp/gnus/nnimap.el' --- lisp/gnus/nnimap.el 2011-06-21 22:13:24 +0000 +++ lisp/gnus/nnimap.el 2011-06-23 00:00:38 +0000 @@ -420,9 +420,9 @@ (nnimap-login (car credentials) (cadr credentials)))) (if (car login-result) (progn - ;; Save the credentials if a save function exists - ;; (such a function will only be passed if a new - ;; token was created). + ;; Save the credentials if a save function exists + ;; (such a function will only be passed if a new + ;; token was created). (when (functionp (nth 2 credentials)) (funcall (nth 2 credentials))) ;; See if CAPABILITY is set as part of login ------------------------------------------------------------ revno: 104681 committer: Richard Stallman branch nick: trunk timestamp: Wed 2011-06-22 19:39:29 -0400 message: Make mail exit more nicely when Rmail is in use. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-22 23:35:21 +0000 +++ lisp/ChangeLog 2011-06-22 23:39:29 +0000 @@ -1,5 +1,8 @@ 2011-06-22 Richard Stallman + * mail/sendmail.el (mail-bury): If Rmail is in use, return nicely + to Rmail even if not started by a special Rmail command. + * mail/rmailmm.el (rmail-insert-mime-forwarded-message): Copy the buffer currently showing just one message. === modified file 'lisp/mail/sendmail.el' --- lisp/mail/sendmail.el 2011-06-09 05:33:26 +0000 +++ lisp/mail/sendmail.el 2011-06-22 23:39:29 +0000 @@ -806,10 +806,18 @@ (defun mail-bury (&optional arg) "Bury this mail buffer." - (let ((newbuf (other-buffer (current-buffer)))) + (let ((newbuf (other-buffer (current-buffer))) + (return-action mail-return-action) + some-rmail) (bury-buffer (current-buffer)) - (if (and (null arg) mail-return-action) - (apply (car mail-return-action) (cdr mail-return-action)) + ;; If there is an Rmail buffer, return to it nicely + ;; even if this message was not started by an Rmail command. + (unless return-action + (dolist (buffer (buffer-list)) + (if (eq (buffer-local-value 'major-mode buffer) 'rmail-mode) + (setq return-action `(rmail-mail-return ,newbuf))))) + (if (and (null arg) return-action) + (apply (car return-action) (cdr return-action)) (switch-to-buffer newbuf)))) (defcustom mail-send-hook nil ------------------------------------------------------------ revno: 104680 committer: Richard Stallman branch nick: trunk timestamp: Wed 2011-06-22 19:35:21 -0400 message: Fix bug: Rmail f copied the entire Rmail file into *mail*. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-22 20:59:48 +0000 +++ lisp/ChangeLog 2011-06-22 23:35:21 +0000 @@ -1,3 +1,8 @@ +2011-06-22 Richard Stallman + + * mail/rmailmm.el (rmail-insert-mime-forwarded-message): + Copy the buffer currently showing just one message. + 2011-06-22 Roland Winkler * textmodes/bibtex.el (bibtex-entry-update): Use mapc. === modified file 'lisp/mail/rmailmm.el' --- lisp/mail/rmailmm.el 2011-02-23 04:19:28 +0000 +++ lisp/mail/rmailmm.el 2011-06-22 23:35:21 +0000 @@ -1333,12 +1333,16 @@ (setq rmail-show-mime-function 'rmail-show-mime) (defun rmail-insert-mime-forwarded-message (forward-buffer) - "Function to set in `rmail-insert-mime-forwarded-message-function' (which see)." - (let ((rmail-mime-mbox-buffer - (with-current-buffer forward-buffer rmail-view-buffer))) + "Insert the message in FORWARD-BUFFER as a forwarded message. +This is the usual value of `rmail-insert-mime-forwarded-message-function'." + (let ((message-buffer + (with-current-buffer forward-buffer + (if rmail-buffer-swapped + forward-buffer + rmail-view-buffer)))) (save-restriction (narrow-to-region (point) (point)) - (message-forward-make-body-mime rmail-mime-mbox-buffer)))) + (message-forward-make-body-mime message-buffer)))) (setq rmail-insert-mime-forwarded-message-function 'rmail-insert-mime-forwarded-message) ------------------------------------------------------------ revno: 104679 committer: Roland Winkler branch nick: trunk timestamp: Wed 2011-06-22 15:59:48 -0500 message: lisp/textmodes/bibtex.el: minor cleanup and bug fixes diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-22 19:24:51 +0000 +++ lisp/ChangeLog 2011-06-22 20:59:48 +0000 @@ -1,3 +1,13 @@ +2011-06-22 Roland Winkler + + * textmodes/bibtex.el (bibtex-entry-update): Use mapc. + (bibtex-clean-entry): First delete the old key so that a + customized algorithm for generating the new key does not get + confused by the old key. + (bibtex-url): Obey regexp of first step. + (bibtex-search-entries): Do not use add-to-list with local + list-var. + 2011-06-22 Lars Magne Ingebrigtsen * mail/smtpmail.el (smtpmail-try-auth-methods): If the user has === modified file 'lisp/textmodes/bibtex.el' --- lisp/textmodes/bibtex.el 2011-06-05 05:46:43 +0000 +++ lisp/textmodes/bibtex.el 2011-06-22 20:59:48 +0000 @@ -3154,8 +3154,8 @@ (insert (bibtex-field-left-delimiter))) (goto-char end))) (skip-chars-backward " \t\n") - (dolist (field required) (bibtex-make-field field)) - (dolist (field optional) (bibtex-make-optional-field field)))))) + (mapc 'bibtex-make-field required) + (mapc 'bibtex-make-optional-field optional))))) (defun bibtex-parse-entry (&optional content) "Parse entry at point, return an alist. @@ -4247,21 +4247,24 @@ ;; (bibtex-format-string) (t (bibtex-format-entry))) ;; set key - (when (or new-key (not key)) - (setq key (bibtex-generate-autokey)) - ;; Sometimes `bibtex-generate-autokey' returns an empty string - (if (or bibtex-autokey-edit-before-use (string= "" key)) - (setq key (if (eq entry-type 'string) - (bibtex-read-string-key key) - (bibtex-read-key "Key to use: " key)))) - (save-excursion - (re-search-forward (if (eq entry-type 'string) - bibtex-string-maybe-empty-head - bibtex-entry-maybe-empty-head)) - (if (match-beginning bibtex-key-in-head) - (delete-region (match-beginning bibtex-key-in-head) - (match-end bibtex-key-in-head))) - (insert key))) + (if (or new-key (not key)) + (save-excursion + ;; First delete the old key so that a customized algorithm + ;; for generating the new key does not get confused by the + ;; old key. + (re-search-forward (if (eq entry-type 'string) + bibtex-string-maybe-empty-head + bibtex-entry-maybe-empty-head)) + (if (match-beginning bibtex-key-in-head) + (delete-region (match-beginning bibtex-key-in-head) + (match-end bibtex-key-in-head))) + (setq key (bibtex-generate-autokey)) + ;; Sometimes `bibtex-generate-autokey' returns an empty string + (if (or bibtex-autokey-edit-before-use (string= "" key)) + (setq key (if (eq entry-type 'string) + (bibtex-read-string-key key) + (bibtex-read-key "Key to use: " key)))) + (insert key))) (unless called-by-reformat (let* ((end (save-excursion @@ -4718,7 +4721,7 @@ (fields-alist (save-excursion (bibtex-parse-entry t))) ;; Always ignore case, (case-fold-search t) - text url scheme obj fmt fl-match step) + text url scheme obj fmt fl-match) ;; The return value of `bibtex-parse-entry' (i.e., FIELDS-ALIST) ;; is always used to generate the URL. However, if the BibTeX ;; entry contains more than one URL, we have multiple matches @@ -4773,11 +4776,8 @@ (setq url (if (null scheme) (match-string 0 text) (if (stringp (car scheme)) (setq fmt (pop scheme))) - (dotimes (i (length scheme)) - (setq step (nth i scheme)) - ;; The first step shall use TEXT as obtained earlier. - (unless (= i 0) - (setq text (cdr (assoc-string (car step) fields-alist t)))) + (dolist (step scheme) + (setq text (cdr (assoc-string (car step) fields-alist t))) (if (string-match (nth 1 step) text) (push (cond ((functionp (nth 2 step)) (funcall (nth 2 step) text)) @@ -4857,24 +4857,24 @@ (save-excursion (goto-char beg) (and (looking-at bibtex-entry-head) - (setq key (bibtex-key-in-head))))) - (add-to-list 'entries - (list key file - (buffer-substring-no-properties - beg end)))))) + (setq key (bibtex-key-in-head)))) + (not (assoc key entries))) + (push (list key file + (buffer-substring-no-properties beg end)) + entries)))) ;; The following is slow. But it works reliably even in more ;; complicated cases with BibTeX string constants and crossrefed ;; entries. If you prefer speed over reliability, perform an ;; unrestricted search. (bibtex-map-entries (lambda (key beg end) - (if (cond (funp (funcall regexp beg end)) - ((and (setq text (bibtex-text-in-field field t)) - (string-match regexp text)))) - (add-to-list 'entries - (list key file - (buffer-substring-no-properties - beg end)))))))))) + (if (and (cond (funp (funcall regexp beg end)) + ((and (setq text (bibtex-text-in-field field t)) + (string-match regexp text)))) + (not (assoc key entries))) + (push (list key file + (buffer-substring-no-properties beg end)) + entries)))))))) (if display (if entries (bibtex-display-entries entries) ------------------------------------------------------------ revno: 104678 committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Wed 2011-06-22 21:24:51 +0200 message: (smtpmail-try-auth-methods): If the user has stored a user name, then query for the password first, instead of waiting for SMTP to give an error message and the trying again. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-22 16:44:53 +0000 +++ lisp/ChangeLog 2011-06-22 19:24:51 +0000 @@ -1,3 +1,9 @@ +2011-06-22 Lars Magne Ingebrigtsen + + * mail/smtpmail.el (smtpmail-try-auth-methods): If the user has + stored a user name, then query for the password first, instead of + waiting for SMTP to give an error message and the trying again. + 2011-06-22 Lawrence Mitchell * net/browse-url.el (browse-url-xdg-open): Use 0, rather than nil === modified file 'lisp/mail/smtpmail.el' --- lisp/mail/smtpmail.el 2011-06-22 14:48:31 +0000 +++ lisp/mail/smtpmail.el 2011-06-22 19:24:51 +0000 @@ -477,6 +477,10 @@ (defun smtpmail-try-auth-methods (process supported-extensions host port &optional ask-for-password) + (setq port + (if port + (format "%s" port) + "smtp")) (let* ((mechs (cdr-safe (assoc 'auth supported-extensions))) (mech (car (smtpmail-intersection mechs smtpmail-auth-supported))) (auth-source-creation-prompts @@ -486,9 +490,7 @@ (auth-source-search :max 1 :host host - :port (if port - (format "%s" port) - "smtp") + :port port :require (and ask-for-password '(:user :secret)) :create ask-for-password))) @@ -497,6 +499,20 @@ (save-function (and ask-for-password (plist-get auth-info :save-function))) ret) + (when (and user + (not password)) + ;; The user has stored the user name, but not the password, so + ;; ask for the password, even if we're not forcing that through + ;; `ask-for-password'. + (setq auth-info + (car + (auth-source-search + :max 1 + :host host + :port port + :require '(:user :secret) + :create t)) + password (plist-get auth-info :secret))) (when (functionp password) (setq password (funcall password))) (cond ------------------------------------------------------------ revno: 104677 [merge] committer: Paul Eggert branch nick: trunk timestamp: Wed 2011-06-22 11:20:15 -0700 message: Merge: Fixes for GLYPH_DEBUG found by GCC 4.6.0 static checking. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-22 16:15:41 +0000 +++ src/ChangeLog 2011-06-22 18:20:15 +0000 @@ -1,5 +1,33 @@ 2011-06-22 Paul Eggert + Fixes for GLYPH_DEBUG found by GCC 4.6.0 static checking. + The following patches are for when GLYPH_DEBUG && !XASSERT. + * dispextern.h (trace_redisplay_p, dump_glyph_string): + * dispnew.c (flush_stdout): + * xdisp.c (dump_glyph_row, dump_glyph_matrix, dump_glyph): + Mark as externally visible. + * dispnew.c (check_window_matrix_pointers): Now static. + * dispnew.c (window_to_frame_vpos): + * xfns.c (unwind_create_frame): + * xterm.c (x_check_font): Remove unused local. + * scroll.c (CHECK_BOUNDS): + * xfaces.c (cache_fache): Rename local to avoid shadowing. + * xfns.c, w32fns.c (image_cache_refcount, dpyinfo_refcount): Now static. + * xdisp.c (check_window_end): Now a no-op if !XASSERTS. + (debug_first_unchanged_at_end_vpos, debug_last_unchanged_at_beg_vpos) + (debug_dvpos, debug_dy, debug_delta, debug_delta_bytes, debug_end_vpos): + Now static. + (debug_method_add): Use va_list and vsprintf rather than relying + on undefined behavior with wrong number of arguments. + (dump_glyph, dump_glyph_row, Fdump_glyph_matrix): + Don't assume ptrdiff_t and EMACS_INT are the same width as int. + In this code, it's OK to assume C99 behavior for ptrdiff_t formats + since we're not interested in debugging glyphs with old libraries. + * xfaces.c (cache_face): Move debugging code earlier; this pacifies + GCC 4.6.0's static checking. + +2011-06-22 Paul Eggert + Integer overflow and signedness fixes (Bug#8873). A few related buffer overrun fixes, too. === modified file 'src/dispextern.h' --- src/dispextern.h 2011-06-22 06:16:16 +0000 +++ src/dispextern.h 2011-06-22 18:15:23 +0000 @@ -151,7 +151,7 @@ #if GLYPH_DEBUG -extern int trace_redisplay_p; +extern int trace_redisplay_p EXTERNALLY_VISIBLE; #include #define TRACE(X) \ @@ -3010,7 +3010,7 @@ #ifdef HAVE_WINDOW_SYSTEM #if GLYPH_DEBUG -extern void dump_glyph_string (struct glyph_string *); +extern void dump_glyph_string (struct glyph_string *) EXTERNALLY_VISIBLE; #endif extern void x_get_glyph_overhangs (struct glyph *, struct frame *, === modified file 'src/dispnew.c' --- src/dispnew.c 2011-06-18 19:15:06 +0000 +++ src/dispnew.c 2011-06-22 18:15:23 +0000 @@ -155,7 +155,6 @@ static void make_current (struct glyph_matrix *, struct glyph_matrix *, int); static void mirror_make_current (struct window *, int); -void check_window_matrix_pointers (struct window *); #if GLYPH_DEBUG static void check_matrix_pointers (struct glyph_matrix *, struct glyph_matrix *); @@ -1478,6 +1477,8 @@ stdout. */ +void flush_stdout (void) EXTERNALLY_VISIBLE; + void flush_stdout (void) { @@ -3052,7 +3053,7 @@ matrices of leaf window agree with their frame matrices about glyph pointers. */ -void +static void check_window_matrix_pointers (struct window *w) { while (w) @@ -3116,12 +3117,10 @@ static int window_to_frame_vpos (struct window *w, int vpos) { - struct frame *f = XFRAME (w->frame); - - xassert (!FRAME_WINDOW_P (f)); + xassert (!FRAME_WINDOW_P (XFRAME (w->frame))); xassert (vpos >= 0 && vpos <= w->desired_matrix->nrows); vpos += WINDOW_TOP_EDGE_LINE (w); - xassert (vpos >= 0 && vpos <= FRAME_LINES (f)); + xassert (vpos >= 0 && vpos <= FRAME_LINES (XFRAME (w->frame))); return vpos; } === modified file 'src/scroll.c' --- src/scroll.c 2011-04-14 02:20:00 +0000 +++ src/scroll.c 2011-06-22 18:15:23 +0000 @@ -268,10 +268,10 @@ # define CHECK_BOUNDS \ do \ { \ - int k; \ - for (k = 0; k < window_size; ++k) \ - xassert (copy_from[k] == -1 \ - || (copy_from[k] >= 0 && copy_from[k] < window_size)); \ + int ck; \ + for (ck = 0; ck < window_size; ++ck) \ + xassert (copy_from[ck] == -1 \ + || (copy_from[ck] >= 0 && copy_from[ck] < window_size)); \ } \ while (0); #endif === modified file 'src/w32fns.c' --- src/w32fns.c 2011-06-10 06:55:18 +0000 +++ src/w32fns.c 2011-06-22 18:15:23 +0000 @@ -184,7 +184,7 @@ static unsigned menu_free_timer = 0; #if GLYPH_DEBUG -int image_cache_refcount, dpyinfo_refcount; +static int image_cache_refcount, dpyinfo_refcount; #endif static HWND w32_visible_system_caret_hwnd; === modified file 'src/xdisp.c' --- src/xdisp.c 2011-06-21 21:32:10 +0000 +++ src/xdisp.c 2011-06-22 18:15:23 +0000 @@ -2242,7 +2242,7 @@ #endif /* not 0 */ -#if GLYPH_DEBUG +#if GLYPH_DEBUG && XASSERTS /* Check that the window end of window W is what we expect it to be---the last row in the current matrix displaying text. */ @@ -2264,11 +2264,11 @@ #define CHECK_WINDOW_END(W) check_window_end ((W)) -#else /* not GLYPH_DEBUG */ +#else #define CHECK_WINDOW_END(W) (void) 0 -#endif /* not GLYPH_DEBUG */ +#endif @@ -11101,40 +11101,42 @@ /* First and last unchanged row for try_window_id. */ -int debug_first_unchanged_at_end_vpos; -int debug_last_unchanged_at_beg_vpos; +static int debug_first_unchanged_at_end_vpos; +static int debug_last_unchanged_at_beg_vpos; /* Delta vpos and y. */ -int debug_dvpos, debug_dy; +static int debug_dvpos, debug_dy; /* Delta in characters and bytes for try_window_id. */ -EMACS_INT debug_delta, debug_delta_bytes; +static EMACS_INT debug_delta, debug_delta_bytes; /* Values of window_end_pos and window_end_vpos at the end of try_window_id. */ -EMACS_INT debug_end_vpos; +static EMACS_INT debug_end_vpos; /* Append a string to W->desired_matrix->method. FMT is a printf - format string. A1...A9 are a supplement for a variable-length - argument list. If trace_redisplay_p is non-zero also printf the + format string. If trace_redisplay_p is non-zero also printf the resulting string to stderr. */ +static void debug_method_add (struct window *, char const *, ...) + ATTRIBUTE_FORMAT_PRINTF (2, 3); + static void -debug_method_add (w, fmt, a1, a2, a3, a4, a5, a6, a7, a8, a9) - struct window *w; - char *fmt; - int a1, a2, a3, a4, a5, a6, a7, a8, a9; +debug_method_add (struct window *w, char const *fmt, ...) { char buffer[512]; char *method = w->desired_matrix->method; int len = strlen (method); int size = sizeof w->desired_matrix->method; int remaining = size - len - 1; + va_list ap; - sprintf (buffer, fmt, a1, a2, a3, a4, a5, a6, a7, a8, a9); + va_start (ap, fmt); + vsprintf (buffer, fmt, ap); + va_end (ap); if (len && remaining) { method[len] = '|'; @@ -16265,9 +16267,9 @@ #if GLYPH_DEBUG -void dump_glyph_row (struct glyph_row *, int, int); -void dump_glyph_matrix (struct glyph_matrix *, int); -void dump_glyph (struct glyph_row *, struct glyph *, int); +void dump_glyph_row (struct glyph_row *, int, int) EXTERNALLY_VISIBLE; +void dump_glyph_matrix (struct glyph_matrix *, int) EXTERNALLY_VISIBLE; +void dump_glyph (struct glyph_row *, struct glyph *, int) EXTERNALLY_VISIBLE; /* Dump the contents of glyph matrix MATRIX on stderr. @@ -16294,7 +16296,7 @@ if (glyph->type == CHAR_GLYPH) { fprintf (stderr, - " %5d %4c %6d %c %3d 0x%05x %c %4d %1.1d%1.1d\n", + " %5td %4c %6"pI"d %c %3d 0x%05x %c %4d %1.1d%1.1d\n", glyph - row->glyphs[TEXT_AREA], 'C', glyph->charpos, @@ -16315,7 +16317,7 @@ else if (glyph->type == STRETCH_GLYPH) { fprintf (stderr, - " %5d %4c %6d %c %3d 0x%05x %c %4d %1.1d%1.1d\n", + " %5td %4c %6"pI"d %c %3d 0x%05x %c %4d %1.1d%1.1d\n", glyph - row->glyphs[TEXT_AREA], 'S', glyph->charpos, @@ -16334,7 +16336,7 @@ else if (glyph->type == IMAGE_GLYPH) { fprintf (stderr, - " %5d %4c %6d %c %3d 0x%05x %c %4d %1.1d%1.1d\n", + " %5td %4c %6"pI"d %c %3d 0x%05x %c %4d %1.1d%1.1d\n", glyph - row->glyphs[TEXT_AREA], 'I', glyph->charpos, @@ -16353,7 +16355,7 @@ else if (glyph->type == COMPOSITE_GLYPH) { fprintf (stderr, - " %5d %4c %6d %c %3d 0x%05x", + " %5td %4c %6"pI"d %c %3d 0x%05x", glyph - row->glyphs[TEXT_AREA], '+', glyph->charpos, @@ -16389,7 +16391,7 @@ fprintf (stderr, "Row Start End Used oE><\\CTZFesm X Y W H V A P\n"); fprintf (stderr, "======================================================================\n"); - fprintf (stderr, "%3d %5d %5d %4d %1.1d%1.1d%1.1d%1.1d\ + fprintf (stderr, "%3d %5"pI"d %5"pI"d %4d %1.1d%1.1d%1.1d%1.1d\ %1.1d%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d %4d %4d %4d %4d %4d %4d %4d\n", vpos, MATRIX_ROW_START_CHARPOS (row), @@ -16417,7 +16419,7 @@ fprintf (stderr, "%9d %5d\t%5d\n", row->start.overlay_string_index, row->end.overlay_string_index, row->continuation_lines_width); - fprintf (stderr, "%9d %5d\n", + fprintf (stderr, "%9"pI"d %5"pI"d\n", CHARPOS (row->start.string_pos), CHARPOS (row->end.string_pos)); fprintf (stderr, "%9d %5d\n", row->start.dpvec_index, @@ -16482,7 +16484,7 @@ struct window *w = XWINDOW (selected_window); struct buffer *buffer = XBUFFER (w->buffer); - fprintf (stderr, "PT = %d, BEGV = %d. ZV = %d\n", + fprintf (stderr, "PT = %"pI"d, BEGV = %"pI"d. ZV = %"pI"d\n", BUF_PT (buffer), BUF_BEGV (buffer), BUF_ZV (buffer)); fprintf (stderr, "Cursor x = %d, y = %d, hpos = %d, vpos = %d\n", w->cursor.x, w->cursor.y, w->cursor.hpos, w->cursor.vpos); === modified file 'src/xfaces.c' --- src/xfaces.c 2011-06-22 06:16:16 +0000 +++ src/xfaces.c 2011-06-22 18:15:23 +0000 @@ -4380,6 +4380,21 @@ break; face->id = i; +#if GLYPH_DEBUG + /* Check that FACE got a unique id. */ + { + int j, n; + struct face *face1; + + for (j = n = 0; j < FACE_CACHE_BUCKETS_SIZE; ++j) + for (face1 = c->buckets[j]; face1; face1 = face1->next) + if (face1->id == i) + ++n; + + xassert (n == 1); + } +#endif /* GLYPH_DEBUG */ + /* Maybe enlarge C->faces_by_id. */ if (i == c->used) { @@ -4396,21 +4411,6 @@ c->used++; } -#if GLYPH_DEBUG - /* Check that FACE got a unique id. */ - { - int j, n; - struct face *face; - - for (j = n = 0; j < FACE_CACHE_BUCKETS_SIZE; ++j) - for (face = c->buckets[j]; face; face = face->next) - if (face->id == i) - ++n; - - xassert (n == 1); - } -#endif /* GLYPH_DEBUG */ - c->faces_by_id[i] = face; } === modified file 'src/xfns.c' --- src/xfns.c 2011-06-21 01:38:04 +0000 +++ src/xfns.c 2011-06-22 18:15:23 +0000 @@ -145,7 +145,7 @@ Lisp_Object Qfont_param; #if GLYPH_DEBUG -int image_cache_refcount, dpyinfo_refcount; +static int image_cache_refcount, dpyinfo_refcount; #endif #if defined (USE_GTK) && defined (HAVE_FREETYPE) @@ -2927,7 +2927,7 @@ /* If frame is ``official'', nothing to do. */ if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame)) { -#if GLYPH_DEBUG +#if GLYPH_DEBUG && XASSERTS struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); #endif === modified file 'src/xterm.c' --- src/xterm.c 2011-06-22 06:16:16 +0000 +++ src/xterm.c 2011-06-22 18:15:23 +0000 @@ -9673,8 +9673,6 @@ static void x_check_font (struct frame *f, struct font *font) { - Lisp_Object frame; - xassert (font != NULL && ! NILP (font->props[FONT_TYPE_INDEX])); if (font->driver->check) xassert (font->driver->check (f, font) == 0); ------------------------------------------------------------ revno: 104676 committer: Jan D. branch nick: trunk timestamp: Wed 2011-06-22 18:44:53 +0200 message: From Lawrence Mitchell : Don't hang in browse-url-xdg-open. * net/browse-url.el (browse-url-xdg-open): Use 0, rather than nil BUFFER in call-process. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-22 14:48:31 +0000 +++ lisp/ChangeLog 2011-06-22 16:44:53 +0000 @@ -1,3 +1,8 @@ +2011-06-22 Lawrence Mitchell + + * net/browse-url.el (browse-url-xdg-open): Use 0, rather than nil + BUFFER in call-process. + 2011-06-22 Lars Magne Ingebrigtsen * mail/smtpmail.el (smtpmail-via-smtp): Make sure we don't send === modified file 'lisp/net/browse-url.el' --- lisp/net/browse-url.el 2011-05-08 18:34:51 +0000 +++ lisp/net/browse-url.el 2011-06-22 16:44:53 +0000 @@ -958,7 +958,7 @@ ;;;###autoload (defun browse-url-xdg-open (url &optional new-window) (interactive (browse-url-interactive-arg "URL: ")) - (call-process "nohup" nil nil nil "xdg-open" url)) + (call-process "xdg-open" nil 0 nil url)) ;;;###autoload (defun browse-url-netscape (url &optional new-window) ------------------------------------------------------------ revno: 104675 [merge] committer: Paul Eggert branch nick: trunk timestamp: Wed 2011-06-22 09:28:41 -0700 message: Merge: Use gnulib's alloca-opt module. diff: === modified file '.bzrignore' --- .bzrignore 2011-05-20 09:54:04 +0000 +++ .bzrignore 2011-06-21 16:15:07 +0000 @@ -47,6 +47,7 @@ lib/.deps/ lib/Makefile.in lib/deps/ +lib/alloca.h lib/arg-nonnull.h lib/c++defs.h lib/getopt.h === modified file 'ChangeLog' --- ChangeLog 2011-06-21 08:45:39 +0000 +++ ChangeLog 2011-06-22 16:28:41 +0000 @@ -1,3 +1,14 @@ +2011-06-22 Paul Eggert + + Use gnulib's alloca-opt module. + * .bzrignore: Add lib/alloca.h. + * Makefile.in (GNULIB_MODULES): Add alloca-opt. + * configure.in (AC_FUNC_ALLOCA): Remove almost all the alloca stuff, + as gnulib now does that for us. Put alloca check in config.h. + Include before any other include file, for AIX 3. + * lib/gnulib.mk, m4/gl-comp.m4: Regenerate. + * lib/alloca.in.h, m4/alloca.m4: New files, from gnulib. + 2011-06-21 Leo Liu * m4/sha256.m4: === modified file 'Makefile.in' --- Makefile.in 2011-06-21 08:45:39 +0000 +++ Makefile.in 2011-06-21 16:15:07 +0000 @@ -332,6 +332,7 @@ # $(gnulib_srcdir) (relative to $(srcdir) and should have build tools # as per $(gnulib_srcdir)/DEPENDENCIES. GNULIB_MODULES = \ + alloca-opt \ careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr \ filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink \ socklen stdarg stdio strftime strtoumax symlink sys_stat === modified file 'configure.in' --- configure.in 2011-06-17 17:32:58 +0000 +++ configure.in 2011-06-21 17:10:10 +0000 @@ -990,7 +990,7 @@ ## If user specified a crt-dir, use that unconditionally. if test "X$CRT_DIR" = "X"; then - + case "$canonical" in x86_64-*-linux-gnu* | s390x-*-linux-gnu*) ## On x86-64 and s390x GNU/Linux distributions, the standard library @@ -2565,15 +2565,6 @@ AC_DEFINE(HAVE_H_ERRNO, 1, [Define to 1 if netdb.h declares h_errno.]) fi -AC_FUNC_ALLOCA - -dnl src/alloca.c has been removed. Could also check if $ALLOCA is set? -dnl FIXME is there an autoconf test that does the right thing, without -dnl needing to call A_M_E afterwards? -if test x"$ac_cv_func_alloca_works" != xyes; then - AC_MSG_ERROR( [a system implementation of alloca is required] ) -fi - # fmod, logb, and frexp are found in -lm on most systems. # On HPUX 9.01, -lm does not contain logb, so check for sqrt. AC_CHECK_LIB(m, sqrt) @@ -3459,6 +3450,12 @@ ])dnl AH_BOTTOM([ +/* On AIX 3 this must be included before any other include file. */ +#include +#if ! HAVE_ALLOCA +# error "alloca not available on this machine" +#endif + /* Define AMPERSAND_FULL_NAME if you use the convention that & in the full name stands for the login id. */ /* Turned on June 1996 supposing nobody will mind it. */ @@ -3535,20 +3532,6 @@ #include #include -#ifdef HAVE_ALLOCA_H -# include -#elif defined __GNUC__ -# define alloca __builtin_alloca -#elif defined _AIX -# define alloca __alloca -#else -# include -# ifdef __cplusplus -extern "C" -# endif -void *alloca (size_t); -#endif - #ifndef HAVE_STRCHR #define strchr(a, b) index (a, b) #endif === added file 'lib/alloca.in.h' --- lib/alloca.in.h 1970-01-01 00:00:00 +0000 +++ lib/alloca.in.h 2011-06-21 16:15:07 +0000 @@ -0,0 +1,56 @@ +/* Memory allocation on the stack. + + Copyright (C) 1995, 1999, 2001-2004, 2006-2011 Free Software Foundation, + Inc. + + This program is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published + by the Free Software Foundation; either version 3, or (at your option) + any later version. + + This program 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 this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, + USA. */ + +/* Avoid using the symbol _ALLOCA_H here, as Bison assumes _ALLOCA_H + means there is a real alloca function. */ +#ifndef _GL_ALLOCA_H +#define _GL_ALLOCA_H + +/* alloca (N) returns a pointer to N bytes of memory + allocated on the stack, which will last until the function returns. + Use of alloca should be avoided: + - inside arguments of function calls - undefined behaviour, + - in inline functions - the allocation may actually last until the + calling function returns, + - for huge N (say, N >= 65536) - you never know how large (or small) + the stack is, and when the stack cannot fulfill the memory allocation + request, the program just crashes. + */ + +#ifndef alloca +# ifdef __GNUC__ +# define alloca __builtin_alloca +# elif defined _AIX +# define alloca __alloca +# elif defined _MSC_VER +# include +# define alloca _alloca +# elif defined __DECC && defined __VMS +# define alloca __ALLOCA +# else +# include +# ifdef __cplusplus +extern "C" +# endif +void *alloca (size_t); +# endif +#endif + +#endif /* _GL_ALLOCA_H */ === modified file 'lib/gnulib.mk' --- lib/gnulib.mk 2011-06-21 08:45:39 +0000 +++ lib/gnulib.mk 2011-06-21 16:15:07 +0000 @@ -9,7 +9,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink socklen stdarg stdio strftime strtoumax symlink sys_stat +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink socklen stdarg stdio strftime strtoumax symlink sys_stat MOSTLYCLEANFILES += core *.stackdump @@ -21,6 +21,29 @@ libgnu_a_DEPENDENCIES = $(gl_LIBOBJS) EXTRA_libgnu_a_SOURCES = +## begin gnulib module alloca-opt + +BUILT_SOURCES += $(ALLOCA_H) + +# We need the following in order to create when the system +# doesn't have one that works with the given compiler. +if GL_GENERATE_ALLOCA_H +alloca.h: alloca.in.h $(top_builddir)/config.status + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ + cat $(srcdir)/alloca.in.h; \ + } > $@-t && \ + mv -f $@-t $@ +else +alloca.h: $(top_builddir)/config.status + rm -f $@ +endif +MOSTLYCLEANFILES += alloca.h alloca.h-t + +EXTRA_DIST += alloca.in.h + +## end gnulib module alloca-opt + ## begin gnulib module allocator libgnu_a_SOURCES += allocator.c === added file 'm4/alloca.m4' --- m4/alloca.m4 1970-01-01 00:00:00 +0000 +++ m4/alloca.m4 2011-06-21 16:15:07 +0000 @@ -0,0 +1,121 @@ +# alloca.m4 serial 12 +dnl Copyright (C) 2002-2004, 2006-2007, 2009-2011 Free Software Foundation, +dnl Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_FUNC_ALLOCA], +[ + AC_REQUIRE([AC_FUNC_ALLOCA]) + if test $ac_cv_func_alloca_works = no; then + gl_PREREQ_ALLOCA + fi + + # Define an additional variable used in the Makefile substitution. + if test $ac_cv_working_alloca_h = yes; then + AC_CACHE_CHECK([for alloca as a compiler built-in], [gl_cv_rpl_alloca], [ + AC_EGREP_CPP([Need own alloca], [ +#if defined __GNUC__ || defined _AIX || defined _MSC_VER + Need own alloca +#endif + ], [gl_cv_rpl_alloca=yes], [gl_cv_rpl_alloca=no]) + ]) + if test $gl_cv_rpl_alloca = yes; then + dnl OK, alloca can be implemented through a compiler built-in. + AC_DEFINE([HAVE_ALLOCA], [1], + [Define to 1 if you have 'alloca' after including , + a header that may be supplied by this distribution.]) + ALLOCA_H=alloca.h + else + dnl alloca exists as a library function, i.e. it is slow and probably + dnl a memory leak. Don't define HAVE_ALLOCA in this case. + ALLOCA_H= + fi + else + ALLOCA_H=alloca.h + fi + AC_SUBST([ALLOCA_H]) + AM_CONDITIONAL([GL_GENERATE_ALLOCA_H], [test -n "$ALLOCA_H"]) +]) + +# Prerequisites of lib/alloca.c. +# STACK_DIRECTION is already handled by AC_FUNC_ALLOCA. +AC_DEFUN([gl_PREREQ_ALLOCA], [:]) + +# This works around a bug in autoconf <= 2.68. +# See . + +m4_version_prereq([2.69], [] ,[ + +# This is taken from the following Autoconf patch: +# http://git.savannah.gnu.org/cgit/autoconf.git/commit/?id=6cd9f12520b0d6f76d3230d7565feba1ecf29497 + +# _AC_LIBOBJ_ALLOCA +# ----------------- +# Set up the LIBOBJ replacement of `alloca'. Well, not exactly +# AC_LIBOBJ since we actually set the output variable `ALLOCA'. +# Nevertheless, for Automake, AC_LIBSOURCES it. +m4_define([_AC_LIBOBJ_ALLOCA], +[# The SVR3 libPW and SVR4 libucb both contain incompatible functions +# that cause trouble. Some versions do not even contain alloca or +# contain a buggy version. If you still want to use their alloca, +# use ar to extract alloca.o from them instead of compiling alloca.c. +AC_LIBSOURCES(alloca.c) +AC_SUBST([ALLOCA], [\${LIBOBJDIR}alloca.$ac_objext])dnl +AC_DEFINE(C_ALLOCA, 1, [Define to 1 if using `alloca.c'.]) + +AC_CACHE_CHECK(whether `alloca.c' needs Cray hooks, ac_cv_os_cray, +[AC_EGREP_CPP(webecray, +[#if defined CRAY && ! defined CRAY2 +webecray +#else +wenotbecray +#endif +], ac_cv_os_cray=yes, ac_cv_os_cray=no)]) +if test $ac_cv_os_cray = yes; then + for ac_func in _getb67 GETB67 getb67; do + AC_CHECK_FUNC($ac_func, + [AC_DEFINE_UNQUOTED(CRAY_STACKSEG_END, $ac_func, + [Define to one of `_getb67', `GETB67', + `getb67' for Cray-2 and Cray-YMP + systems. This function is required for + `alloca.c' support on those systems.]) + break]) + done +fi + +AC_CACHE_CHECK([stack direction for C alloca], + [ac_cv_c_stack_direction], +[AC_RUN_IFELSE([AC_LANG_SOURCE( +[AC_INCLUDES_DEFAULT +int +find_stack_direction (int *addr, int depth) +{ + int dir, dummy = 0; + if (! addr) + addr = &dummy; + *addr = addr < &dummy ? 1 : addr == &dummy ? 0 : -1; + dir = depth ? find_stack_direction (addr, depth - 1) : 0; + return dir + dummy; +} + +int +main (int argc, char **argv) +{ + return find_stack_direction (0, argc + !argv + 20) < 0; +}])], + [ac_cv_c_stack_direction=1], + [ac_cv_c_stack_direction=-1], + [ac_cv_c_stack_direction=0])]) +AH_VERBATIM([STACK_DIRECTION], +[/* If using the C implementation of alloca, define if you know the + direction of stack growth for your system; otherwise it will be + automatically deduced at runtime. + STACK_DIRECTION > 0 => grows toward higher addresses + STACK_DIRECTION < 0 => grows toward lower addresses + STACK_DIRECTION = 0 => direction of growth unknown */ +@%:@undef STACK_DIRECTION])dnl +AC_DEFINE_UNQUOTED(STACK_DIRECTION, $ac_cv_c_stack_direction) +])# _AC_LIBOBJ_ALLOCA +]) === modified file 'm4/gl-comp.m4' --- m4/gl-comp.m4 2011-06-21 08:45:39 +0000 +++ m4/gl-comp.m4 2011-06-21 16:15:07 +0000 @@ -26,6 +26,7 @@ m4_pattern_allow([^gl_LIBOBJS$])dnl a variable m4_pattern_allow([^gl_LTLIBOBJS$])dnl a variable AC_REQUIRE([AC_PROG_RANLIB]) + # Code from module alloca-opt: # Code from module allocator: # Code from module arg-nonnull: # Code from module c++defs: @@ -94,6 +95,7 @@ m4_pushdef([gl_LIBSOURCES_DIR], []) gl_COMMON gl_source_base='lib' +gl_FUNC_ALLOCA AC_CHECK_FUNCS_ONCE([readlinkat]) gl_MD5 gl_SHA1 @@ -392,6 +394,7 @@ build-aux/arg-nonnull.h build-aux/c++defs.h build-aux/warn-on-use.h + lib/alloca.in.h lib/allocator.c lib/allocator.h lib/careadlinkat.c @@ -445,6 +448,7 @@ lib/unistd.in.h lib/verify.h m4/00gnulib.m4 + m4/alloca.m4 m4/c-strtod.m4 m4/extensions.m4 m4/filemode.m4 ------------------------------------------------------------ revno: 104674 [merge] committer: Paul Eggert branch nick: trunk timestamp: Wed 2011-06-22 09:15:41 -0700 message: Merge: Integer overflow and signedness fixes (Bug#8873). A few related buffer overrun fixes, too. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-22 12:23:17 +0000 +++ src/ChangeLog 2011-06-22 16:15:41 +0000 @@ -1,3 +1,205 @@ +2011-06-22 Paul Eggert + + Integer overflow and signedness fixes (Bug#8873). + A few related buffer overrun fixes, too. + + * font.c (font_score): Use EMACS_INT, not int, to store XINT value. + + * dispextern.h (struct face.stipple): + * image.c (x_bitmap_height, x_bitmap_width, x_bitmap_pixmap) + (x_bitmap_mask, x_allocate_bitmap_record) + (x_create_bitmap_from_data, x_create_bitmap_from_file) + (x_destroy_bitmap, x_destroy_all_bitmaps, x_create_bitmap_mask) + (x_create_bitmap_from_xpm_data): + * nsterm.h (struct ns_display_info.bitmaps_size, .bitmaps_last): + * w32term.h (struct w32_display_info.icon_bitmap_id, .bitmaps_size) + (.bitmaps_last): + * xfaces.c (load_pixmap): + * xterm.c (x_bitmap_icon, x_wm_set_icon_pixmap): + * xterm.h (struct x_display_info.icon_bitmap_id, .bitmaps_size) + (.bitmaps_last, struct x_output.icon_bitmap): + Use ptrdiff_t, not int, for bitmap indexes. + (x_allocate_bitmap_record): Check for size overflow. + * dispextern.h, lisp.h: Adjust to API changes elsewhere. + + Use ptrdiff_t, not int, for overlay counts. + * buffer.h (overlays_at, sort_overlays, GET_OVERLAYS_AT): + * editfns.c (overlays_around, get_pos_property): + * textprop.c (get_char_property_and_overlay): + * xdisp.c (next_overlay_change, note_mouse_highlight): + * xfaces.c (face_at_buffer_position): + * buffer.c (OVERLAY_COUNT_MAX): New macro. + (overlays_at, overlays_in, sort_overlays, Foverlays_at) + (Fnext_overlay_change, Fprevious_overlay_change) + (mouse_face_overlay_overlaps, Foverlays_in): + Use ptrdiff_t, not int, for sizes. + (overlays_at, overlays_in): Check for size-calculation overflow. + + * xterm.c (xim_initialize, same_x_server): Strlen may not fit in int. + + * xsmfns.c (smc_save_yourself_CB, x_session_initialize): Avoid strlen. + (x_session_initialize): Do not assume string length fits in int. + + * xsettings.c (apply_xft_settings): Fix potential buffer overrun. + This is unlikely, but can occur if DPI is outlandish. + + * xsettings.c (Ffont_get_system_normal_font, Ffont_get_system_font): + * xselect.c (Fx_get_atom_name): Avoid need for strlen. + + * xrdb.c: Don't assume strlen fits in int; avoid some strlens. + * xrdb.c (magic_file_p, search_magic_path): + Omit last arg SUFFIX; it was always 0. All callers changed. + (magic_file_p): Use ptrdiff_t, not int. Check for size overflow. + + * xfont.c (xfont_match): Avoid need for strlen. + + * xfns.c: Don't assume strlen fits in int. + (xic_create_fontsetname, x_window): Use ptrdiff_t, not int. + + * xdisp.c (message_log_check_duplicate): Return intmax_t, + not unsigned long, as we prefer signed integers. All callers changed. + Detect integer overflow in repeat count. + (message_dolog): Don't assume print length fits in 39 bytes. + (display_mode_element): Don't assume strlen fits in int. + + * termcap.c: Don't assume sizes fit in int and never overflow. + (struct termcap_buffer, tgetent): Use ptrdiff_t, not int, for sizes. + (gobble_line): Check for size-calculation overflow. + + * minibuf.c (Fread_buffer): + * lread.c (intern, intern_c_string): + * image.c (xpm_scan) [HAVE_NS && !HAVE_XPM]: + Don't assume string length fits in int. + + * keyboard.c (parse_tool_bar_item): + * gtkutil.c (style_changed_cb): Avoid need for strlen. + + * font.c: Don't assume string length fits in int. + (font_parse_xlfd, font_parse_fcname, font_unparse_fcname): + Use ptrdiff_t, not int. + (font_intern_prop): Don't assume string length fits in int. + Don't assume integer property fits in fixnum. + * font.h (font_intern_prop): 2nd arg is now ptrdiff_t, not int. + + * filelock.c: Fix some buffer overrun and integer overflow issues. + (get_boot_time): Don't assume gzip command string fits in 100 bytes. + Reformulate so as not to need the command string. + Invoke gzip -cd rather than gunzip, as it's more portable. + (lock_info_type, lock_file_1, lock_file): + Don't assume pid_t and time_t fit in unsigned long. + (LOCK_PID_MAX): Remove; we now use more-reliable bounds. + (current_lock_owner): Prefer signed type for sizes. + Use memcpy, not strncpy, where memcpy is what is really wanted. + Don't assume (via atoi) that time_t and pid_t fit in int. + Check for time_t and/or pid_t out of range, e.g., via a network share. + Don't alloca where an auto var works fine. + + * fileio.c: Fix some integer overflow issues. + (file_name_as_directory, Fexpand_file_name, Fsubstitute_in_file_name): + Don't assume string length fits in int. + (directory_file_name): Don't assume string length fits in long. + (make_temp_name): Don't assume pid fits in int, or that its print + length is less than 20. + + * data.c (Fsubr_name): Rewrite to avoid a strlen call. + + * coding.c (make_subsidiaries): Don't assume string length fits in int. + + * callproc.c (child_setup): Rewrite to avoid two strlen calls. + + * process.c (Fformat_network_address): Use EMACS_INT, not EMACS_UINT. + We prefer signed integers, even for size calculations. + + * emacs.c: Don't assume string length fits in 'int'. + (DEFINE_DUMMY_FUNCTION, sort_args): Use ptrdiff_t, not int. + (main): Don't invoke strlen when not needed. + + * dbusbind.c (XD_ERROR): Don't arbitrarily truncate string. + (XD_DEBUG_MESSAGE): Don't waste a byte. + + * callproc.c (getenv_internal_1, getenv_internal) + (Fgetenv_internal): + * buffer.c (init_buffer): Don't assume string length fits in 'int'. + + * lread.c (invalid_syntax): Omit length argument. + All uses changed. This doesn't fix a bug, but it simplifies the + code away from its former Hollerith-constant appearance, and it's + one less 'int' to worry about when looking at integer-overflow issues. + (string_to_number): Simplify 2011-04-26 change by invoking xsignal1. + + * lisp.h (DEFUN): Remove bogus use of sizeof (struct Lisp_Subr). + This didn't break anything, but it didn't help either. + It's confusing to put a bogus integer in a place where the actual + value does not matter. + (LIST_END_P): Remove unused macro and its bogus comment. + (make_fixnum_or_float): Remove unnecessary cast to EMACS_INT. + + * lisp.h (union Lisp_Object.i): EMACS_INT, not EMACS_UINT. + This is for consistency with the ordinary, non-USE_LISP_UNION_TYPE, + implementation. + (struct Lisp_Bool_Vector.size): EMACS_INT, not EMACS_UINT. + We prefer signed types, and the value cannot exceed the EMACS_INT + range anyway (because otherwise the length would not be representable). + (XSET) [USE_LISP_UNION_TYPE]: Use uintptr_t and intptr_t, + not EMACS_UINT and EMACS_INT, when converting pointer to integer. + This avoids a GCC warning when WIDE_EMACS_INT. + + * indent.c (sane_tab_width): New function. + (current_column, scan_for_column, Findent_to, position_indentation) + (compute_motion): Use it. This is just for clarity. + (Fcompute_motion): Don't assume hscroll and tab offset fit in int. + + * image.c (xbm_image_p): Don't assume stated width, height fit in int. + + * lisp.h (lint_assume): New macro. + * composite.c (composition_gstring_put_cache): + * ftfont.c (ftfont_shape_by_flt): Use it to pacify GCC 4.6.0. + + * editfns.c, insdel.c: + Omit unnecessary forward decls, to simplify future changes. + + * ftfont.c (ftfont_shape_by_flt): Use signed integers for lengths. + + * font.c (Ffont_shape_gstring): Don't assume glyph len fits in 'int'. + + * fns.c (Ffillarray): Don't assume bool vector size fits in 'int'. + Use much-faster test for byte-length change. + Don't assume string byte-length fits in 'int'. + Check that character arg fits in 'int'. + (mapcar1): Declare byte as byte, for clarity. + + * alloc.c (Fmake_bool_vector): Avoid unnecessary multiplication. + + * fns.c (concat): Catch string overflow earlier. + Do not rely on integer wraparound. + + * dispextern.h (struct it.overlay_strings_charpos) + (struct it.selective): Now EMACS_INT, not int. + * xdisp.c (forward_to_next_line_start) + (back_to_previous_visible_line_start) + (reseat_at_next_visible_line_start, next_element_from_buffer): + Don't arbitrarily truncate the value of 'selective' to int. + + * xdisp.c (init_iterator): Use XINT, not XFASTINT; it might be < 0. + + * composite.c: Don't truncate sizes to 'int'. + (composition_gstring_p, composition_reseat_it) + (composition_adjust_point): Use EMACS_INT, not int. + (get_composition_id, composition_gstring_put_cache): Use EMACS_INT, + not EMACS_UINT, for indexes. + + * category.h (CATEGORY_SET_P): Remove unnecessary cast to EMACS_INT. + + * buffer.c: Include . + (struct sortvec.priority, struct sortstr.priority): + Now EMACS_INT, not int. + (compare_overlays, cmp_for_strings): Avoid subtraction overflow. + (struct sortstr.size, record_overlay_string) + (struct sortstrlist.size, struct sortlist.used): + Don't truncate size to int. + (record_overlay_string): Check for size-calculation overflow. + (init_buffer_once): Check at compile-time, not run-time. + 2011-06-22 Jim Meyering don't leak an XBM-image-sized buffer === modified file 'src/alloc.c' --- src/alloc.c 2011-06-14 21:30:16 +0000 +++ src/alloc.c 2011-06-18 15:39:24 +0000 @@ -2257,12 +2257,14 @@ p = XBOOL_VECTOR (val); p->size = XFASTINT (length); - memset (p->data, NILP (init) ? 0 : -1, length_in_chars); + if (length_in_chars) + { + memset (p->data, ! NILP (init) ? -1 : 0, length_in_chars); - /* Clear the extraneous bits in the last byte. */ - if (XINT (length) != length_in_chars * BOOL_VECTOR_BITS_PER_CHAR) - p->data[length_in_chars - 1] - &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1; + /* Clear any extraneous bits in the last byte. */ + p->data[length_in_chars - 1] + &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1; + } return val; } === modified file 'src/buffer.c' --- src/buffer.c 2011-06-13 08:00:15 +0000 +++ src/buffer.c 2011-06-21 23:16:43 +0000 @@ -27,6 +27,8 @@ #include #include +#include + #include "lisp.h" #include "intervals.h" #include "window.h" @@ -92,6 +94,11 @@ #define PER_BUFFER_SYMBOL(OFFSET) \ (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_symbols)) +/* Maximum length of an overlay vector. */ +#define OVERLAY_COUNT_MAX \ + ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, \ + min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object))) + /* Flags indicating which built-in buffer-local variables are permanent locals. */ static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS]; @@ -2516,14 +2523,15 @@ *NEXT_PTR is guaranteed to be not equal to POS, unless it is the default (BEGV or ZV). */ -int -overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr, int *len_ptr, +ptrdiff_t +overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr, + ptrdiff_t *len_ptr, EMACS_INT *next_ptr, EMACS_INT *prev_ptr, int change_req) { Lisp_Object overlay, start, end; struct Lisp_Overlay *tail; - int idx = 0; - int len = *len_ptr; + ptrdiff_t idx = 0; + ptrdiff_t len = *len_ptr; Lisp_Object *vec = *vec_ptr; EMACS_INT next = ZV; EMACS_INT prev = BEGV; @@ -2559,10 +2567,10 @@ Either make it bigger, or don't store any more in it. */ if (extend) { + if ((OVERLAY_COUNT_MAX - 4) / 2 < len) + memory_full (SIZE_MAX); /* Make it work with an initial len == 0. */ - len *= 2; - if (len == 0) - len = 4; + len = len * 2 + 4; *len_ptr = len; vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object)); *vec_ptr = vec; @@ -2602,10 +2610,10 @@ { if (extend) { + if ((OVERLAY_COUNT_MAX - 4) / 2 < len) + memory_full (SIZE_MAX); /* Make it work with an initial len == 0. */ - len *= 2; - if (len == 0) - len = 4; + len = len * 2 + 4; *len_ptr = len; vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object)); *vec_ptr = vec; @@ -2655,15 +2663,15 @@ and we store only as many overlays as will fit. But we still return the total number of overlays. */ -static int +static ptrdiff_t overlays_in (EMACS_INT beg, EMACS_INT end, int extend, - Lisp_Object **vec_ptr, int *len_ptr, + Lisp_Object **vec_ptr, ptrdiff_t *len_ptr, EMACS_INT *next_ptr, EMACS_INT *prev_ptr) { Lisp_Object overlay, ostart, oend; struct Lisp_Overlay *tail; - int idx = 0; - int len = *len_ptr; + ptrdiff_t idx = 0; + ptrdiff_t len = *len_ptr; Lisp_Object *vec = *vec_ptr; EMACS_INT next = ZV; EMACS_INT prev = BEGV; @@ -2699,10 +2707,10 @@ Either make it bigger, or don't store any more in it. */ if (extend) { + if ((OVERLAY_COUNT_MAX - 4) / 2 < len) + memory_full (SIZE_MAX); /* Make it work with an initial len == 0. */ - len *= 2; - if (len == 0) - len = 4; + len = len * 2 + 4; *len_ptr = len; vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object)); *vec_ptr = vec; @@ -2747,10 +2755,10 @@ { if (extend) { + if ((OVERLAY_COUNT_MAX - 4) / 2 < len) + memory_full (SIZE_MAX); /* Make it work with an initial len == 0. */ - len *= 2; - if (len == 0) - len = 4; + len = len * 2 + 4; *len_ptr = len; vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object)); *vec_ptr = vec; @@ -2783,7 +2791,7 @@ { EMACS_INT start = OVERLAY_POSITION (OVERLAY_START (overlay)); EMACS_INT end = OVERLAY_POSITION (OVERLAY_END (overlay)); - int n, i, size; + ptrdiff_t n, i, size; Lisp_Object *v, tem; size = 10; @@ -2849,7 +2857,7 @@ { Lisp_Object overlay; EMACS_INT beg, end; - int priority; + EMACS_INT priority; }; static int @@ -2858,21 +2866,21 @@ const struct sortvec *s1 = (const struct sortvec *) v1; const struct sortvec *s2 = (const struct sortvec *) v2; if (s1->priority != s2->priority) - return s1->priority - s2->priority; + return s1->priority < s2->priority ? -1 : 1; if (s1->beg != s2->beg) - return s1->beg - s2->beg; + return s1->beg < s2->beg ? -1 : 1; if (s1->end != s2->end) - return s2->end - s1->end; + return s2->end < s1->end ? -1 : 1; return 0; } /* Sort an array of overlays by priority. The array is modified in place. The return value is the new size; this may be smaller than the original size if some of the overlays were invalid or were window-specific. */ -int -sort_overlays (Lisp_Object *overlay_vec, int noverlays, struct window *w) +ptrdiff_t +sort_overlays (Lisp_Object *overlay_vec, ptrdiff_t noverlays, struct window *w) { - int i, j; + ptrdiff_t i, j; struct sortvec *sortvec; sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec)); @@ -2926,15 +2934,15 @@ struct sortstr { Lisp_Object string, string2; - int size; - int priority; + ptrdiff_t size; + EMACS_INT priority; }; struct sortstrlist { struct sortstr *buf; /* An array that expands as needed; never freed. */ - int size; /* Allocated length of that array. */ - int used; /* How much of the array is currently in use. */ + ptrdiff_t size; /* Allocated length of that array. */ + ptrdiff_t used; /* How much of the array is currently in use. */ EMACS_INT bytes; /* Total length of the strings in buf. */ }; @@ -2955,20 +2963,24 @@ struct sortstr *s1 = (struct sortstr *)as1; struct sortstr *s2 = (struct sortstr *)as2; if (s1->size != s2->size) - return s2->size - s1->size; + return s2->size < s1->size ? -1 : 1; if (s1->priority != s2->priority) - return s1->priority - s2->priority; + return s1->priority < s2->priority ? -1 : 1; return 0; } static void -record_overlay_string (struct sortstrlist *ssl, Lisp_Object str, Lisp_Object str2, Lisp_Object pri, int size) +record_overlay_string (struct sortstrlist *ssl, Lisp_Object str, + Lisp_Object str2, Lisp_Object pri, ptrdiff_t size) { EMACS_INT nbytes; if (ssl->used == ssl->size) { - if (ssl->buf) + if (min (PTRDIFF_MAX, SIZE_MAX) / (sizeof (struct sortstr) * 2) + < ssl->size) + memory_full (SIZE_MAX); + else if (0 < ssl->size) ssl->size *= 2; else ssl->size = 5; @@ -3874,9 +3886,8 @@ doc: /* Return a list of the overlays that contain the character at POS. */) (Lisp_Object pos) { - int noverlays; + ptrdiff_t len, noverlays; Lisp_Object *overlay_vec; - int len; Lisp_Object result; CHECK_NUMBER_COERCE_MARKER (pos); @@ -3906,9 +3917,8 @@ end of the buffer. */) (Lisp_Object beg, Lisp_Object end) { - int noverlays; + ptrdiff_t len, noverlays; Lisp_Object *overlay_vec; - int len; Lisp_Object result; CHECK_NUMBER_COERCE_MARKER (beg); @@ -3936,11 +3946,9 @@ the value is (point-max). */) (Lisp_Object pos) { - int noverlays; + ptrdiff_t i, len, noverlays; EMACS_INT endpos; Lisp_Object *overlay_vec; - int len; - int i; CHECK_NUMBER_COERCE_MARKER (pos); @@ -3979,7 +3987,7 @@ { EMACS_INT prevpos; Lisp_Object *overlay_vec; - int len; + ptrdiff_t len; CHECK_NUMBER_COERCE_MARKER (pos); @@ -4971,7 +4979,7 @@ The local flag bits are in the local_var_flags slot of the buffer. */ /* Nothing can work if this isn't true */ - if (sizeof (EMACS_INT) != sizeof (Lisp_Object)) abort (); + { verify (sizeof (EMACS_INT) == sizeof (Lisp_Object)); } /* 0 means not a lisp var, -1 means always local, else mask */ memset (&buffer_local_flags, 0, sizeof buffer_local_flags); @@ -5077,7 +5085,7 @@ { char *pwd; Lisp_Object temp; - int len; + ptrdiff_t len; #ifdef USE_MMAP_FOR_BUFFERS { === modified file 'src/buffer.h' --- src/buffer.h 2011-06-16 06:19:26 +0000 +++ src/buffer.h 2011-06-21 21:32:10 +0000 @@ -887,10 +887,10 @@ extern void delete_all_overlays (struct buffer *); extern void reset_buffer (struct buffer *); extern void evaporate_overlays (EMACS_INT); -extern int overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr, - int *len_ptr, EMACS_INT *next_ptr, - EMACS_INT *prev_ptr, int change_req); -extern int sort_overlays (Lisp_Object *, int, struct window *); +extern ptrdiff_t overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr, + ptrdiff_t *len_ptr, EMACS_INT *next_ptr, + EMACS_INT *prev_ptr, int change_req); +extern ptrdiff_t sort_overlays (Lisp_Object *, ptrdiff_t, struct window *); extern void recenter_overlay_lists (struct buffer *, EMACS_INT); extern EMACS_INT overlay_strings (EMACS_INT, struct window *, unsigned char **); extern void validate_region (Lisp_Object *, Lisp_Object *); @@ -908,7 +908,7 @@ #define GET_OVERLAYS_AT(posn, overlays, noverlays, nextp, chrq) \ do { \ - int maxlen = 40; \ + ptrdiff_t maxlen = 40; \ overlays = (Lisp_Object *) alloca (maxlen * sizeof (Lisp_Object)); \ noverlays = overlays_at (posn, 0, &overlays, &maxlen, \ nextp, NULL, chrq); \ === modified file 'src/callproc.c' --- src/callproc.c 2011-06-14 18:57:19 +0000 +++ src/callproc.c 2011-06-21 01:06:45 +0000 @@ -1230,8 +1230,7 @@ if (STRINGP (display)) { - int vlen = strlen ("DISPLAY=") + strlen (SSDATA (display)) + 1; - char *vdata = (char *) alloca (vlen); + char *vdata = (char *) alloca (sizeof "DISPLAY=" + SBYTES (display)); strcpy (vdata, "DISPLAY="); strcat (vdata, SSDATA (display)); new_env = add_env (env, new_env, vdata); @@ -1378,8 +1377,8 @@ #endif /* not WINDOWSNT */ static int -getenv_internal_1 (const char *var, int varlen, char **value, int *valuelen, - Lisp_Object env) +getenv_internal_1 (const char *var, ptrdiff_t varlen, char **value, + ptrdiff_t *valuelen, Lisp_Object env) { for (; CONSP (env); env = XCDR (env)) { @@ -1413,8 +1412,8 @@ } static int -getenv_internal (const char *var, int varlen, char **value, int *valuelen, - Lisp_Object frame) +getenv_internal (const char *var, ptrdiff_t varlen, char **value, + ptrdiff_t *valuelen, Lisp_Object frame) { /* Try to find VAR in Vprocess_environment first. */ if (getenv_internal_1 (var, varlen, value, valuelen, @@ -1454,7 +1453,7 @@ (Lisp_Object variable, Lisp_Object env) { char *value; - int valuelen; + ptrdiff_t valuelen; CHECK_STRING (variable); if (CONSP (env)) @@ -1478,7 +1477,7 @@ egetenv (const char *var) { char *value; - int valuelen; + ptrdiff_t valuelen; if (getenv_internal (var, strlen (var), &value, &valuelen, Qnil)) return value; === modified file 'src/category.h' --- src/category.h 2011-04-11 06:28:35 +0000 +++ src/category.h 2011-06-17 08:17:29 +0000 @@ -62,7 +62,7 @@ #define XCATEGORY_SET XBOOL_VECTOR #define CATEGORY_SET_P(x) \ - (BOOL_VECTOR_P ((x)) && (EMACS_INT) (XBOOL_VECTOR ((x))->size) == 128) + (BOOL_VECTOR_P (x) && XBOOL_VECTOR (x)->size == 128) /* Return a new empty category set. */ #define MAKE_CATEGORY_SET (Fmake_bool_vector (make_number (128), Qnil)) === modified file 'src/coding.c' --- src/coding.c 2011-06-14 18:57:19 +0000 +++ src/coding.c 2011-06-19 18:44:09 +0000 @@ -9442,7 +9442,7 @@ make_subsidiaries (Lisp_Object base) { Lisp_Object subsidiaries; - int base_name_len = SBYTES (SYMBOL_NAME (base)); + ptrdiff_t base_name_len = SBYTES (SYMBOL_NAME (base)); char *buf = (char *) alloca (base_name_len + 6); int i; @@ -9450,7 +9450,7 @@ subsidiaries = Fmake_vector (make_number (3), Qnil); for (i = 0; i < 3; i++) { - memcpy (buf + base_name_len, suffixes[i], strlen (suffixes[i]) + 1); + strcpy (buf + base_name_len, suffixes[i]); ASET (subsidiaries, i, intern (buf)); } return subsidiaries; === modified file 'src/composite.c' --- src/composite.c 2011-06-21 16:47:56 +0000 +++ src/composite.c 2011-06-22 16:01:00 +0000 @@ -285,7 +285,7 @@ && VECTORP (AREF (components, 0))) { /* COMPONENTS is a glyph-string. */ - EMACS_UINT len = ASIZE (key); + EMACS_INT len = ASIZE (key); for (i = 1; i < len; i++) if (! VECTORP (AREF (key, i))) @@ -293,7 +293,7 @@ } else if (VECTORP (components) || CONSP (components)) { - EMACS_UINT len = ASIZE (key); + EMACS_INT len = ASIZE (key); /* The number of elements should be odd. */ if ((len % 2) == 0) @@ -673,13 +673,14 @@ hash = h->hashfn (h, header); if (len < 0) { - EMACS_UINT j, glyph_len = LGSTRING_GLYPH_LEN (gstring); + EMACS_INT j, glyph_len = LGSTRING_GLYPH_LEN (gstring); for (j = 0; j < glyph_len; j++) if (NILP (LGSTRING_GLYPH (gstring, j))) break; len = j; } + lint_assume (len <= TYPE_MAXIMUM (EMACS_INT) - 2); copy = Fmake_vector (make_number (len + 2), Qnil); LGSTRING_SET_HEADER (copy, Fcopy_sequence (header)); for (i = 0; i < len; i++) @@ -705,7 +706,7 @@ composition_gstring_p (Lisp_Object gstring) { Lisp_Object header; - int i; + EMACS_INT i; if (! VECTORP (gstring) || ASIZE (gstring) < 2) return 0; @@ -1252,7 +1253,7 @@ { Lisp_Object lgstring = Qnil; Lisp_Object val, elt; - int i; + EMACS_INT i; val = CHAR_TABLE_REF (Vcomposition_function_table, cmp_it->ch); for (i = 0; i < cmp_it->rule_idx; i++, val = XCDR (val)); @@ -1684,9 +1685,8 @@ EMACS_INT composition_adjust_point (EMACS_INT last_pt, EMACS_INT new_pt) { - EMACS_INT beg, end; + EMACS_INT i, beg, end; Lisp_Object val; - int i; if (new_pt == BEGV || new_pt == ZV) return new_pt; === modified file 'src/data.c' --- src/data.c 2011-06-14 18:57:19 +0000 +++ src/data.c 2011-06-19 18:44:58 +0000 @@ -703,7 +703,7 @@ const char *name; CHECK_SUBR (subr); name = XSUBR (subr)->symbol_name; - return make_string (name, strlen (name)); + return build_string (name); } DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0, === modified file 'src/dbusbind.c' --- src/dbusbind.c 2011-06-14 18:57:19 +0000 +++ src/dbusbind.c 2011-06-19 18:32:55 +0000 @@ -111,13 +111,12 @@ /* Raise a Lisp error from a D-Bus ERROR. */ #define XD_ERROR(error) \ do { \ - char s[1024]; \ - strncpy (s, error.message, 1023); \ + /* Remove the trailing newline. */ \ + char const *mess = error.message; \ + char const *nl = strchr (mess, '\n'); \ + Lisp_Object err = make_string (mess, nl ? nl - mess : strlen (mess)); \ dbus_error_free (&error); \ - /* Remove the trailing newline. */ \ - if (strchr (s, '\n') != NULL) \ - s[strlen (s) - 1] = '\0'; \ - XD_SIGNAL1 (build_string (s)); \ + XD_SIGNAL1 (err); \ } while (0) /* Macros for debugging. In order to enable them, build with @@ -126,7 +125,7 @@ #define XD_DEBUG_MESSAGE(...) \ do { \ char s[1024]; \ - snprintf (s, 1023, __VA_ARGS__); \ + snprintf (s, sizeof s, __VA_ARGS__); \ printf ("%s: %s\n", __func__, s); \ message ("%s: %s", __func__, s); \ } while (0) === modified file 'src/dispextern.h' --- src/dispextern.h 2011-06-13 05:15:27 +0000 +++ src/dispextern.h 2011-06-22 06:16:16 +0000 @@ -1532,12 +1532,12 @@ /* Background stipple or bitmap used for this face. This is an id as returned from load_pixmap. */ - int stipple; + ptrdiff_t stipple; #else /* not HAVE_WINDOW_SYSTEM */ /* Dummy. */ - int stipple; + ptrdiff_t stipple; #endif /* not HAVE_WINDOW_SYSTEM */ @@ -2183,7 +2183,7 @@ be set at the same time as n_overlay_strings. It is needed because we show before-strings at the start of invisible text; see handle_invisible_prop in xdisp.c. */ - int overlay_strings_charpos; + EMACS_INT overlay_strings_charpos; /* Vector of overlays to process. Overlay strings are processed OVERLAY_STRING_CHUNK_SIZE at a time. */ @@ -2259,7 +2259,7 @@ /* -1 means selective display hides everything between a \r and the next newline; > 0 means hide lines indented more than that value. */ - int selective; + EMACS_INT selective; /* An enumeration describing what the next display element is after a call to get_next_display_element. */ @@ -3082,21 +3082,21 @@ #ifdef HAVE_WINDOW_SYSTEM -extern int x_bitmap_height (struct frame *, int); -extern int x_bitmap_width (struct frame *, int); -extern int x_bitmap_pixmap (struct frame *, int); +extern int x_bitmap_height (struct frame *, ptrdiff_t); +extern int x_bitmap_width (struct frame *, ptrdiff_t); +extern int x_bitmap_pixmap (struct frame *, ptrdiff_t); extern void x_reference_bitmap (struct frame *, int); -extern int x_create_bitmap_from_data (struct frame *, char *, - unsigned int, unsigned int); -extern int x_create_bitmap_from_file (struct frame *, Lisp_Object); +extern ptrdiff_t x_create_bitmap_from_data (struct frame *, char *, + unsigned int, unsigned int); +extern ptrdiff_t x_create_bitmap_from_file (struct frame *, Lisp_Object); #if defined HAVE_XPM && defined HAVE_X_WINDOWS && !defined USE_GTK -extern int x_create_bitmap_from_xpm_data (struct frame *f, const char **bits); +extern ptrdiff_t x_create_bitmap_from_xpm_data (struct frame *, const char **); #endif #ifndef x_destroy_bitmap -extern void x_destroy_bitmap (struct frame *, int); +extern void x_destroy_bitmap (struct frame *, ptrdiff_t); #endif extern void x_destroy_all_bitmaps (Display_Info *); -extern int x_create_bitmap_mask (struct frame * , int); +extern int x_create_bitmap_mask (struct frame *, ptrdiff_t); extern Lisp_Object x_find_image_file (Lisp_Object); void x_kill_gs_process (Pixmap, struct frame *); === modified file 'src/editfns.c' --- src/editfns.c 2011-06-16 17:44:43 +0000 +++ src/editfns.c 2011-06-21 21:32:10 +0000 @@ -86,21 +86,7 @@ static void time_overflow (void) NO_RETURN; static int tm_diff (struct tm *, struct tm *); -static void find_field (Lisp_Object, Lisp_Object, Lisp_Object, - EMACS_INT *, Lisp_Object, EMACS_INT *); static void update_buffer_properties (EMACS_INT, EMACS_INT); -static Lisp_Object region_limit (int); -static size_t emacs_nmemftime (char *, size_t, const char *, - size_t, const struct tm *, int, int); -static void general_insert_function (void (*) (const char *, EMACS_INT), - void (*) (Lisp_Object, EMACS_INT, - EMACS_INT, EMACS_INT, - EMACS_INT, int), - int, ptrdiff_t, Lisp_Object *); -static Lisp_Object subst_char_in_region_unwind (Lisp_Object); -static Lisp_Object subst_char_in_region_unwind_1 (Lisp_Object); -static void transpose_markers (EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT, - EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT); static Lisp_Object Qbuffer_access_fontify_functions; static Lisp_Object Fuser_full_name (Lisp_Object); @@ -345,13 +331,13 @@ Return the number found, and store them in a vector in VEC of length LEN. */ -static int -overlays_around (EMACS_INT pos, Lisp_Object *vec, int len) +static ptrdiff_t +overlays_around (EMACS_INT pos, Lisp_Object *vec, ptrdiff_t len) { Lisp_Object overlay, start, end; struct Lisp_Overlay *tail; EMACS_INT startpos, endpos; - int idx = 0; + ptrdiff_t idx = 0; for (tail = current_buffer->overlays_before; tail; tail = tail->next) { @@ -419,7 +405,7 @@ else { EMACS_INT posn = XINT (position); - int noverlays; + ptrdiff_t noverlays; Lisp_Object *overlay_vec, tem; struct buffer *obuf = current_buffer; === modified file 'src/emacs.c' --- src/emacs.c 2011-06-04 18:29:18 +0000 +++ src/emacs.c 2011-06-19 18:37:51 +0000 @@ -585,7 +585,7 @@ int minlen, char **valptr, int *skipptr) { char *p = NULL; - int arglen; + ptrdiff_t arglen; char *arg; /* Don't access argv[argc]; give up in advance. */ @@ -1087,7 +1087,7 @@ dname_arg2[0] = '\0'; sscanf (dname_arg, "\n%d,%d\n%s", &(daemon_pipe[0]), &(daemon_pipe[1]), dname_arg2); - dname_arg = strlen (dname_arg2) ? dname_arg2 : NULL; + dname_arg = *dname_arg2 ? dname_arg2 : NULL; } #endif /* NS_IMPL_COCOA */ @@ -1846,8 +1846,7 @@ priority[from] = 0; if (argv[from][0] == '-') { - int match, thislen; - char *equals; + int match; /* If we have found "--", don't consider any more arguments as options. */ @@ -1879,11 +1878,11 @@ >= 0 (the table index of the match) if just one match so far. */ if (argv[from][1] == '-') { + char const *equals = strchr (argv[from], '='); + ptrdiff_t thislen = + equals ? equals - argv[from] : strlen (argv[from]); + match = -1; - thislen = strlen (argv[from]); - equals = strchr (argv[from], '='); - if (equals != 0) - thislen = equals - argv[from]; for (i = 0; i < sizeof (standard_args) / sizeof (standard_args[0]); i++) === modified file 'src/fileio.c' --- src/fileio.c 2011-06-16 21:18:12 +0000 +++ src/fileio.c 2011-06-19 19:06:16 +0000 @@ -440,11 +440,9 @@ static char * file_name_as_directory (char *out, const char *in) { - int size = strlen (in) - 1; - - strcpy (out, in); - - if (size < 0) + ptrdiff_t len = strlen (in); + + if (len == 0) { out[0] = '.'; out[1] = '/'; @@ -452,11 +450,13 @@ return out; } + strcpy (out, in); + /* For Unix syntax, Append a slash if necessary */ - if (!IS_DIRECTORY_SEP (out[size])) + if (!IS_DIRECTORY_SEP (out[len - 1])) { - out[size + 1] = DIRECTORY_SEP; - out[size + 2] = '\0'; + out[len] = DIRECTORY_SEP; + out[len + 1] = '\0'; } #ifdef DOS_NT dostounix_filename (out); @@ -503,7 +503,7 @@ static int directory_file_name (char *src, char *dst) { - long slen; + ptrdiff_t slen; slen = strlen (src); @@ -587,9 +587,9 @@ { Lisp_Object val; int len, clen; - int pid; + intmax_t pid; char *p, *data; - char pidbuf[20]; + char pidbuf[INT_BUFSIZE_BOUND (pid_t)]; int pidlen; CHECK_STRING (prefix); @@ -599,7 +599,7 @@ three are incremented if the file already exists. This ensures 262144 unique file names per PID per PREFIX. */ - pid = (int) getpid (); + pid = getpid (); if (base64_p) { @@ -611,8 +611,7 @@ else { #ifdef HAVE_LONG_FILE_NAMES - sprintf (pidbuf, "%d", pid); - pidlen = strlen (pidbuf); + pidlen = sprintf (pidbuf, "%"PRIdMAX, pid); #else pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6; pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6; @@ -737,14 +736,14 @@ /* This should only point to alloca'd data. */ char *target; - int tlen; + ptrdiff_t tlen; struct passwd *pw; #ifdef DOS_NT int drive = 0; int collapse_newdir = 1; int is_escaped = 0; #endif /* DOS_NT */ - int length; + ptrdiff_t length; Lisp_Object handler, result; int multibyte; Lisp_Object hdir; @@ -1314,7 +1313,7 @@ unsigned char *nm; register unsigned char *newdir, *p, *o; - int tlen; + ptrdiff_t tlen; unsigned char *target; struct passwd *pw; int lose; @@ -1366,7 +1365,7 @@ unsigned char *user = nm + 1; /* Find end of name. */ unsigned char *ptr = (unsigned char *) strchr (user, '/'); - int len = ptr ? ptr - user : strlen (user); + ptrdiff_t len = ptr ? ptr - user : strlen (user); /* Copy the user name into temp storage. */ o = (unsigned char *) alloca (len + 1); memcpy (o, user, len); @@ -1672,7 +1671,7 @@ else { Lisp_Object orig, decoded; - int orig_length, decoded_length; + ptrdiff_t orig_length, decoded_length; orig_length = strlen (o); orig = make_unibyte_string (o, orig_length); decoded = DECODE_FILE (orig); === modified file 'src/filelock.c' --- src/filelock.c 2011-04-14 05:04:02 +0000 +++ src/filelock.c 2011-06-20 03:11:40 +0000 @@ -168,7 +168,7 @@ /* If we did not find a boot time in wtmp, look at wtmp, and so on. */ for (counter = 0; counter < 20 && ! boot_time; counter++) { - char cmd_string[100]; + char cmd_string[sizeof WTMP_FILE ".19.gz"]; Lisp_Object tempname, filename; int delete_flag = 0; @@ -191,19 +191,16 @@ character long prefix, and call make_temp_file with second arg non-zero, so that it will add not more than 6 characters to the prefix. */ - tempname = Fexpand_file_name (build_string ("wt"), + filename = Fexpand_file_name (build_string ("wt"), Vtemporary_file_directory); - tempname = make_temp_name (tempname, 1); - args[0] = Vshell_file_name; + filename = make_temp_name (filename, 1); + args[0] = build_string ("gzip"); args[1] = Qnil; - args[2] = Qnil; + args[2] = list2 (QCfile, filename); args[3] = Qnil; - args[4] = build_string ("-c"); - sprintf (cmd_string, "gunzip < %s.%d.gz > %s", - WTMP_FILE, counter, SDATA (tempname)); - args[5] = build_string (cmd_string); + args[4] = build_string ("-cd"); + args[5] = tempname; Fcall_process (6, args); - filename = tempname; delete_flag = 1; } } @@ -284,14 +281,10 @@ { char *user; char *host; - unsigned long pid; + pid_t pid; time_t boot_time; } lock_info_type; -/* When we read the info back, we might need this much more, - enough for decimal representation plus null. */ -#define LOCK_PID_MAX (4 * sizeof (unsigned long)) - /* Free the two dynamically-allocated pieces in PTR. */ #define FREE_LOCK_INFO(i) do { xfree ((i).user); xfree ((i).host); } while (0) @@ -344,7 +337,7 @@ lock_file_1 (char *lfname, int force) { register int err; - time_t boot; + intmax_t boot, pid; const char *user_name; const char *host_name; char *lock_info_str; @@ -361,14 +354,16 @@ else host_name = ""; lock_info_str = (char *)alloca (strlen (user_name) + strlen (host_name) - + LOCK_PID_MAX + 30); + + 2 * INT_STRLEN_BOUND (intmax_t) + + sizeof "@.:"); + pid = getpid (); if (boot) - sprintf (lock_info_str, "%s@%s.%lu:%lu", user_name, host_name, - (unsigned long) getpid (), (unsigned long) boot); + sprintf (lock_info_str, "%s@%s.%"PRIdMAX":%"PRIdMAX, + user_name, host_name, pid, boot); else - sprintf (lock_info_str, "%s@%s.%lu", user_name, host_name, - (unsigned long) getpid ()); + sprintf (lock_info_str, "%s@%s.%"PRIdMAX, + user_name, host_name, pid); err = symlink (lock_info_str, lfname); if (errno == EEXIST && force) @@ -397,8 +392,9 @@ current_lock_owner (lock_info_type *owner, char *lfname) { int ret; - size_t len; - int local_owner = 0; + ptrdiff_t len; + lock_info_type local_owner; + intmax_t n; char *at, *dot, *colon; char readlink_buf[READLINK_BUFSIZE]; char *lfinfo = emacs_readlink (lfname, readlink_buf); @@ -408,12 +404,9 @@ return errno == ENOENT ? 0 : -1; /* Even if the caller doesn't want the owner info, we still have to - read it to determine return value, so allocate it. */ + read it to determine return value. */ if (!owner) - { - owner = (lock_info_type *) alloca (sizeof (lock_info_type)); - local_owner = 1; - } + owner = &local_owner; /* Parse USER@HOST.PID:BOOT_TIME. If can't parse, return -1. */ /* The USER is everything before the last @. */ @@ -427,24 +420,34 @@ } len = at - lfinfo; owner->user = (char *) xmalloc (len + 1); - strncpy (owner->user, lfinfo, len); + memcpy (owner->user, lfinfo, len); owner->user[len] = 0; /* The PID is everything from the last `.' to the `:'. */ - owner->pid = atoi (dot + 1); - colon = dot; - while (*colon && *colon != ':') - colon++; + errno = 0; + n = strtoimax (dot + 1, NULL, 10); + owner->pid = + ((0 <= n && n <= TYPE_MAXIMUM (pid_t) + && (TYPE_MAXIMUM (pid_t) < INTMAX_MAX || errno != ERANGE)) + ? n : 0); + + colon = strchr (dot + 1, ':'); /* After the `:', if there is one, comes the boot time. */ - if (*colon == ':') - owner->boot_time = atoi (colon + 1); - else - owner->boot_time = 0; + n = 0; + if (colon) + { + errno = 0; + n = strtoimax (colon + 1, NULL, 10); + } + owner->boot_time = + ((0 <= n && n <= TYPE_MAXIMUM (time_t) + && (TYPE_MAXIMUM (time_t) < INTMAX_MAX || errno != ERANGE)) + ? n : 0); /* The host is everything in between. */ len = dot - at - 1; owner->host = (char *) xmalloc (len + 1); - strncpy (owner->host, at + 1, len); + memcpy (owner->host, at + 1, len); owner->host[len] = 0; /* We're done looking at the link info. */ @@ -476,7 +479,7 @@ } /* Avoid garbage. */ - if (local_owner || ret <= 0) + if (owner == &local_owner || ret <= 0) { FREE_LOCK_INFO (*owner); } @@ -539,6 +542,7 @@ register Lisp_Object attack, orig_fn, encoded_fn; register char *lfname, *locker; lock_info_type lock_info; + intmax_t pid; struct gcpro gcpro1; /* Don't do locking while dumping Emacs. @@ -577,9 +581,10 @@ /* Else consider breaking the lock */ locker = (char *) alloca (strlen (lock_info.user) + strlen (lock_info.host) - + LOCK_PID_MAX + 9); - sprintf (locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host, - lock_info.pid); + + INT_STRLEN_BOUND (intmax_t) + sizeof "@ (pid )"); + pid = lock_info.pid; + sprintf (locker, "%s@%s (pid %"PRIdMAX")", + lock_info.user, lock_info.host, pid); FREE_LOCK_INFO (lock_info); attack = call2 (intern ("ask-user-about-lock"), fn, build_string (locker)); === modified file 'src/fns.c' --- src/fns.c 2011-06-21 16:47:56 +0000 +++ src/fns.c 2011-06-22 16:01:00 +0000 @@ -23,6 +23,8 @@ #include #include +#include + #include "lisp.h" #include "commands.h" #include "character.h" @@ -567,8 +569,8 @@ } result_len += len; - if (result_len < 0) - error ("String overflow"); + if (STRING_BYTES_BOUND < result_len) + string_overflow (); } if (! some_multibyte) @@ -2141,7 +2143,6 @@ (Lisp_Object array, Lisp_Object item) { register EMACS_INT size, idx; - int charval; if (VECTORP (array)) { @@ -2161,27 +2162,21 @@ else if (STRINGP (array)) { register unsigned char *p = SDATA (array); - CHECK_NUMBER (item); - charval = XINT (item); + int charval; + CHECK_CHARACTER (item); + charval = XFASTINT (item); size = SCHARS (array); if (STRING_MULTIBYTE (array)) { unsigned char str[MAX_MULTIBYTE_LENGTH]; int len = CHAR_STRING (charval, str); EMACS_INT size_byte = SBYTES (array); - unsigned char *p1 = p, *endp = p + size_byte; - int i; - if (size != size_byte) - while (p1 < endp) - { - int this_len = BYTES_BY_CHAR_HEAD (*p1); - if (len != this_len) - error ("Attempt to change byte length of a string"); - p1 += this_len; - } - for (i = 0; i < size_byte; i++) - *p++ = str[i % len]; + if (INT_MULTIPLY_OVERFLOW (SCHARS (array), len) + || SCHARS (array) * len != size_byte) + error ("Attempt to change byte length of a string"); + for (idx = 0; idx < size_byte; idx++) + *p++ = str[idx % len]; } else for (idx = 0; idx < size; idx++) @@ -2190,19 +2185,18 @@ else if (BOOL_VECTOR_P (array)) { register unsigned char *p = XBOOL_VECTOR (array)->data; - int size_in_chars - = ((XBOOL_VECTOR (array)->size + BOOL_VECTOR_BITS_PER_CHAR - 1) + EMACS_INT size_in_chars; + size = XBOOL_VECTOR (array)->size; + size_in_chars + = ((size + BOOL_VECTOR_BITS_PER_CHAR - 1) / BOOL_VECTOR_BITS_PER_CHAR); - charval = (! NILP (item) ? -1 : 0); - for (idx = 0; idx < size_in_chars - 1; idx++) - p[idx] = charval; - if (idx < size_in_chars) + if (size_in_chars) { - /* Mask out bits beyond the vector size. */ - if (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR) - charval &= (1 << (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR)) - 1; - p[idx] = charval; + memset (p, ! NILP (item) ? -1 : 0, size_in_chars); + + /* Clear any extraneous bits in the last byte. */ + p[size_in_chars - 1] &= (1 << (size % BOOL_VECTOR_BITS_PER_CHAR)) - 1; } } else @@ -2316,7 +2310,7 @@ { for (i = 0; i < leni; i++) { - int byte; + unsigned char byte; byte = XBOOL_VECTOR (seq)->data[i / BOOL_VECTOR_BITS_PER_CHAR]; dummy = (byte & (1 << (i % BOOL_VECTOR_BITS_PER_CHAR))) ? Qt : Qnil; dummy = call1 (fn, dummy); === modified file 'src/font.c' --- src/font.c 2011-06-14 18:57:19 +0000 +++ src/font.c 2011-06-22 06:18:06 +0000 @@ -232,22 +232,35 @@ STR. */ Lisp_Object -font_intern_prop (const char *str, int len, int force_symbol) +font_intern_prop (const char *str, ptrdiff_t len, int force_symbol) { - int i; + ptrdiff_t i; Lisp_Object tem; Lisp_Object obarray; EMACS_INT nbytes, nchars; if (len == 1 && *str == '*') return Qnil; - if (!force_symbol && len >=1 && isdigit (*str)) + if (!force_symbol && 0 < len && '0' <= *str && *str <= '9') { for (i = 1; i < len; i++) - if (! isdigit (str[i])) + if (! ('0' <= str[i] && str[i] <= '9')) break; if (i == len) - return make_number (atoi (str)); + { + EMACS_INT n; + + i = 0; + for (n = 0; (n += str[i++] - '0') <= MOST_POSITIVE_FIXNUM; n *= 10) + { + if (i == len) + return make_number (n); + if (MOST_POSITIVE_FIXNUM / 10 < n) + break; + } + + xsignal1 (Qoverflow_error, make_string (str, len)); + } } /* The following code is copied from the function intern (in @@ -982,7 +995,7 @@ int font_parse_xlfd (char *name, Lisp_Object font) { - int len = strlen (name); + ptrdiff_t len = strlen (name); int i, j, n; char *f[XLFD_LAST_INDEX + 1]; Lisp_Object val; @@ -1310,7 +1323,7 @@ char *p, *q; char *size_beg = NULL, *size_end = NULL; char *props_beg = NULL, *family_end = NULL; - int len = strlen (name); + ptrdiff_t len = strlen (name); if (len == 0) return -1; @@ -1376,7 +1389,7 @@ if (*q != '=') { /* Must be an enumerated value. */ - int word_len; + ptrdiff_t word_len; p = p + 1; word_len = q - p; val = font_intern_prop (p, q - p, 1); @@ -1452,7 +1465,7 @@ Lisp_Object weight = Qnil, slant = Qnil; Lisp_Object width = Qnil, size = Qnil; char *word_start; - int word_len; + ptrdiff_t word_len; /* Scan backwards from the end, looking for a size. */ for (p = name + len - 1; p >= name; p--) @@ -1542,7 +1555,8 @@ Lisp_Object family, foundry; Lisp_Object tail, val; int point_size; - int i, len = 1; + int i; + ptrdiff_t len = 1; char *p; Lisp_Object styles[3]; const char *style_names[3] = { "weight", "slant", "width" }; @@ -2093,8 +2107,8 @@ { /* We use the higher 6-bit for the actual size difference. The lowest bit is set if the DPI is different. */ - int diff; - int pixel_size = XINT (spec_prop[FONT_SIZE_INDEX]); + EMACS_INT diff; + EMACS_INT pixel_size = XINT (spec_prop[FONT_SIZE_INDEX]); if (CONSP (Vface_font_rescale_alist)) pixel_size *= font_rescale_ratio (entity); @@ -4294,7 +4308,7 @@ { struct font *font; Lisp_Object font_object, n, glyph; - int i, j, from, to; + EMACS_INT i, j, from, to; if (! composition_gstring_p (gstring)) signal_error ("Invalid glyph-string: ", gstring); === modified file 'src/font.h' --- src/font.h 2011-05-29 19:04:01 +0000 +++ src/font.h 2011-06-20 05:51:47 +0000 @@ -777,7 +777,8 @@ extern Lisp_Object font_open_by_spec (FRAME_PTR f, Lisp_Object spec); extern Lisp_Object font_open_by_name (FRAME_PTR f, const char *name); -extern Lisp_Object font_intern_prop (const char *str, int len, int force_symbol); +extern Lisp_Object font_intern_prop (const char *str, ptrdiff_t len, + int force_symbol); extern void font_update_sort_order (int *order); extern void font_parse_family_registry (Lisp_Object family, === modified file 'src/ftfont.c' --- src/ftfont.c 2011-06-10 19:31:15 +0000 +++ src/ftfont.c 2011-06-18 18:09:17 +0000 @@ -2385,8 +2385,8 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font, FT_Face ft_face, OTF *otf, FT_Matrix *matrix) { - EMACS_UINT len = LGSTRING_GLYPH_LEN (lgstring); - EMACS_UINT i; + EMACS_INT len = LGSTRING_GLYPH_LEN (lgstring); + EMACS_INT i; struct MFLTFontFT flt_font_ft; MFLT *flt = NULL; int with_variation_selector = 0; @@ -2412,7 +2412,10 @@ if (CHAR_VARIATION_SELECTOR_P (c)) with_variation_selector++; } + len = i; + lint_assume (len <= TYPE_MAXIMUM (EMACS_INT) - 2); + if (with_variation_selector) { setup_otf_gstring (len); === modified file 'src/gtkutil.c' --- src/gtkutil.c 2011-06-14 21:08:20 +0000 +++ src/gtkutil.c 2011-06-20 05:54:33 +0000 @@ -1015,7 +1015,7 @@ EVENT_INIT (event); event.kind = CONFIG_CHANGED_EVENT; - event.frame_or_window = make_string (display_name, strlen (display_name)); + event.frame_or_window = build_string (display_name); /* Theme doesn't change often, so intern is called seldom. */ event.arg = intern ("theme-name"); kbd_buffer_store_event (&event); @@ -1024,7 +1024,7 @@ /* If scroll bar width changed, we need set the new size on all frames on this display. */ - if (dpy) + if (dpy) { Lisp_Object rest, frame; FOR_EACH_FRAME (rest, frame) === modified file 'src/image.c' --- src/image.c 2011-06-22 12:23:17 +0000 +++ src/image.c 2011-06-22 16:01:00 +0000 @@ -182,20 +182,20 @@ /* Functions to access the contents of a bitmap, given an id. */ int -x_bitmap_height (FRAME_PTR f, int id) +x_bitmap_height (FRAME_PTR f, ptrdiff_t id) { return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].height; } int -x_bitmap_width (FRAME_PTR f, int id) +x_bitmap_width (FRAME_PTR f, ptrdiff_t id) { return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].width; } #if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) int -x_bitmap_pixmap (FRAME_PTR f, int id) +x_bitmap_pixmap (FRAME_PTR f, ptrdiff_t id) { return (int) FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap; } @@ -203,7 +203,7 @@ #ifdef HAVE_X_WINDOWS int -x_bitmap_mask (FRAME_PTR f, int id) +x_bitmap_mask (FRAME_PTR f, ptrdiff_t id) { return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].mask; } @@ -211,11 +211,11 @@ /* Allocate a new bitmap record. Returns index of new record. */ -static int +static ptrdiff_t x_allocate_bitmap_record (FRAME_PTR f) { Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); - int i; + ptrdiff_t i; if (dpyinfo->bitmaps == NULL) { @@ -233,6 +233,9 @@ if (dpyinfo->bitmaps[i].refcount == 0) return i + 1; + if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Bitmap_Record) / 2 + < dpyinfo->bitmaps_size) + memory_full (SIZE_MAX); dpyinfo->bitmaps_size *= 2; dpyinfo->bitmaps = (Bitmap_Record *) xrealloc (dpyinfo->bitmaps, @@ -250,11 +253,11 @@ /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */ -int +ptrdiff_t x_create_bitmap_from_data (struct frame *f, char *bits, unsigned int width, unsigned int height) { Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); - int id; + ptrdiff_t id; #ifdef HAVE_X_WINDOWS Pixmap bitmap; @@ -309,7 +312,7 @@ /* Create bitmap from file FILE for frame F. */ -int +ptrdiff_t x_create_bitmap_from_file (struct frame *f, Lisp_Object file) { Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); @@ -319,7 +322,7 @@ #endif /* HAVE_NTGUI */ #ifdef HAVE_NS - int id; + ptrdiff_t id; void *bitmap = ns_image_from_file (file); if (!bitmap) @@ -340,7 +343,8 @@ #ifdef HAVE_X_WINDOWS unsigned int width, height; Pixmap bitmap; - int xhot, yhot, result, id; + int xhot, yhot, result; + ptrdiff_t id; Lisp_Object found; int fd; char *filename; @@ -413,7 +417,7 @@ /* Remove reference to bitmap with id number ID. */ void -x_destroy_bitmap (FRAME_PTR f, int id) +x_destroy_bitmap (FRAME_PTR f, ptrdiff_t id) { Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); @@ -435,7 +439,7 @@ void x_destroy_all_bitmaps (Display_Info *dpyinfo) { - int i; + ptrdiff_t i; Bitmap_Record *bm = dpyinfo->bitmaps; for (i = 0; i < dpyinfo->bitmaps_last; i++, bm++) @@ -467,7 +471,7 @@ It's nicer with some borders in this context */ int -x_create_bitmap_mask (struct frame *f, int id) +x_create_bitmap_mask (struct frame *f, ptrdiff_t id) { Pixmap pixmap, mask; XImagePtr ximg, mask_img; @@ -2308,7 +2312,7 @@ else { Lisp_Object data; - int width, height; + EMACS_INT width, height; /* Entries for `:width', `:height' and `:data' must be present. */ if (!kw[XBM_WIDTH].count @@ -2324,7 +2328,7 @@ data. */ if (VECTORP (data)) { - int i; + EMACS_INT i; /* Number of elements of the vector must be >= height. */ if (ASIZE (data) < height) @@ -3282,11 +3286,12 @@ #endif /* HAVE_XPM || HAVE_NS */ #if defined HAVE_XPM && defined HAVE_X_WINDOWS && !defined USE_GTK -int +ptrdiff_t x_create_bitmap_from_xpm_data (struct frame *f, const char **bits) { Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); - int id, rc; + ptrdiff_t id; + int rc; XpmAttributes attrs; Pixmap bitmap, mask; @@ -3590,25 +3595,14 @@ /* XPM support functions for NS where libxpm is not available. Only XPM version 3 (without any extensions) is supported. */ -static int xpm_scan (const unsigned char **, const unsigned char *, - const unsigned char **, int *); -static Lisp_Object xpm_make_color_table_v - (void (**) (Lisp_Object, const unsigned char *, int, Lisp_Object), - Lisp_Object (**) (Lisp_Object, const unsigned char *, int)); static void xpm_put_color_table_v (Lisp_Object, const unsigned char *, int, Lisp_Object); static Lisp_Object xpm_get_color_table_v (Lisp_Object, const unsigned char *, int); -static Lisp_Object xpm_make_color_table_h - (void (**) (Lisp_Object, const unsigned char *, int, Lisp_Object), - Lisp_Object (**) (Lisp_Object, const unsigned char *, int)); static void xpm_put_color_table_h (Lisp_Object, const unsigned char *, int, Lisp_Object); static Lisp_Object xpm_get_color_table_h (Lisp_Object, const unsigned char *, int); -static int xpm_str_to_color_key (const char *); -static int xpm_load_image (struct frame *, struct image *, - const unsigned char *, const unsigned char *); /* Tokens returned from xpm_scan. */ @@ -3630,7 +3624,7 @@ xpm_scan (const unsigned char **s, const unsigned char *end, const unsigned char **beg, - int *len) + ptrdiff_t *len) { int c; @@ -3800,7 +3794,8 @@ unsigned char buffer[BUFSIZ]; int width, height, x, y; int num_colors, chars_per_pixel; - int len, LA1; + ptrdiff_t len; + int LA1; void (*put_color_table) (Lisp_Object, const unsigned char *, int, Lisp_Object); Lisp_Object (*get_color_table) (Lisp_Object, const unsigned char *, int); Lisp_Object frame, color_symbols, color_table; === modified file 'src/indent.c' --- src/indent.c 2011-06-07 09:26:21 +0000 +++ src/indent.c 2011-06-18 18:29:19 +0000 @@ -318,6 +318,15 @@ last_known_column_point = 0; } +/* Return a non-outlandish value for the tab width. */ + +static int +sane_tab_width (void) +{ + EMACS_INT n = XFASTINT (BVAR (current_buffer, tab_width)); + return 0 < n && n <= 1000 ? n : 8; +} + EMACS_INT current_column (void) { @@ -326,7 +335,7 @@ register int tab_seen; EMACS_INT post_tab; register int c; - register EMACS_INT tab_width = XINT (BVAR (current_buffer, tab_width)); + int tab_width = sane_tab_width (); int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow)); register struct Lisp_Char_Table *dp = buffer_display_table (); @@ -356,9 +365,6 @@ else stop = GAP_END_ADDR; - if (tab_width <= 0 || tab_width > 1000) - tab_width = 8; - col = 0, tab_seen = 0, post_tab = 0; while (1) @@ -509,7 +515,7 @@ static void scan_for_column (EMACS_INT *endpos, EMACS_INT *goalcol, EMACS_INT *prevcol) { - register EMACS_INT tab_width = XINT (BVAR (current_buffer, tab_width)); + int tab_width = sane_tab_width (); register int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow)); register struct Lisp_Char_Table *dp = buffer_display_table (); int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); @@ -535,7 +541,6 @@ window = Fget_buffer_window (Fcurrent_buffer (), Qnil); w = ! NILP (window) ? XWINDOW (window) : NULL; - if (tab_width <= 0 || tab_width > 1000) tab_width = 8; memset (&cmp_it, 0, sizeof cmp_it); cmp_it.id = -1; composition_compute_stop_pos (&cmp_it, scan, scan_byte, end, Qnil); @@ -728,7 +733,7 @@ register int tab_seen; int post_tab; register int c; - register int tab_width = XINT (current_buffer->tab_width); + int tab_width = sane_tab_width (); int ctl_arrow = !NILP (current_buffer->ctl_arrow); register struct Lisp_Char_Table *dp = buffer_display_table (); int b, e; @@ -755,8 +760,6 @@ going backwards from point. */ stop = SDATA (string) + b; - if (tab_width <= 0 || tab_width > 1000) tab_width = 8; - col = 0, tab_seen = 0, post_tab = 0; while (1) @@ -806,7 +809,7 @@ { EMACS_INT mincol; register EMACS_INT fromcol; - register EMACS_INT tab_width = XINT (BVAR (current_buffer, tab_width)); + int tab_width = sane_tab_width (); CHECK_NUMBER (column); if (NILP (minimum)) @@ -820,8 +823,6 @@ if (fromcol == mincol) return make_number (mincol); - if (tab_width <= 0 || tab_width > 1000) tab_width = 8; - if (indent_tabs_mode) { Lisp_Object n; @@ -867,15 +868,13 @@ position_indentation (register int pos_byte) { register EMACS_INT column = 0; - register EMACS_INT tab_width = XINT (BVAR (current_buffer, tab_width)); + int tab_width = sane_tab_width (); register unsigned char *p; register unsigned char *stop; unsigned char *start; EMACS_INT next_boundary_byte = pos_byte; EMACS_INT ceiling = next_boundary_byte; - if (tab_width <= 0 || tab_width > 1000) tab_width = 8; - p = BYTE_POS_ADDR (pos_byte); /* STOP records the value of P at which we will need to think about the gap, or about invisible text, @@ -1118,7 +1117,7 @@ register EMACS_INT pos; EMACS_INT pos_byte; register int c = 0; - register EMACS_INT tab_width = XFASTINT (BVAR (current_buffer, tab_width)); + int tab_width = sane_tab_width (); register int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow)); register struct Lisp_Char_Table *dp = window_display_table (win); EMACS_INT selective @@ -1173,9 +1172,6 @@ run cache, because that's based on the buffer's display table. */ width_table = 0; - if (tab_width <= 0 || tab_width > 1000) - tab_width = 8; - /* Negative width means use all available text columns. */ if (width < 0) { @@ -1747,7 +1743,7 @@ struct window *w; Lisp_Object bufpos, hpos, vpos, prevhpos; struct position *pos; - int hscroll, tab_offset; + EMACS_INT hscroll, tab_offset; CHECK_NUMBER_COERCE_MARKER (from); CHECK_CONS (frompos); === modified file 'src/insdel.c' --- src/insdel.c 2011-06-16 21:18:12 +0000 +++ src/insdel.c 2011-06-18 18:28:32 +0000 @@ -44,12 +44,6 @@ int inherit); static void gap_left (EMACS_INT charpos, EMACS_INT bytepos, int newgap); static void gap_right (EMACS_INT charpos, EMACS_INT bytepos); -static void adjust_markers_for_insert (EMACS_INT from, EMACS_INT from_byte, - EMACS_INT to, EMACS_INT to_byte, - int before_markers); -static void adjust_markers_for_replace (EMACS_INT, EMACS_INT, EMACS_INT, - EMACS_INT, EMACS_INT, EMACS_INT); -static void adjust_point (EMACS_INT nchars, EMACS_INT nbytes); static Lisp_Object Fcombine_after_change_execute (void); === modified file 'src/keyboard.c' --- src/keyboard.c 2011-06-14 18:57:19 +0000 +++ src/keyboard.c 2011-06-20 06:07:16 +0000 @@ -8225,7 +8225,7 @@ /* `:label LABEL-STRING'. */ PROP (TOOL_BAR_ITEM_LABEL) = STRINGP (value) ? value - : make_string (bad_label, strlen (bad_label)); + : build_string (bad_label); have_label = 1; } else if (EQ (ikey, QCfilter)) @@ -8291,7 +8291,7 @@ else label = ""; - new_lbl = Fupcase_initials (make_string (label, strlen (label))); + new_lbl = Fupcase_initials (build_string (label)); if (SCHARS (new_lbl) <= tool_bar_max_label_size) PROP (TOOL_BAR_ITEM_LABEL) = new_lbl; else === modified file 'src/lisp.h' --- src/lisp.h 2011-06-16 22:50:46 +0000 +++ src/lisp.h 2011-06-22 06:16:16 +0000 @@ -291,7 +291,7 @@ { /* Used for comparing two Lisp_Objects; also, positive integers can be accessed fast this way. */ - EMACS_UINT i; + EMACS_INT i; struct { @@ -315,7 +315,7 @@ { /* Used for comparing two Lisp_Objects; also, positive integers can be accessed fast this way. */ - EMACS_UINT i; + EMACS_INT i; struct { @@ -494,8 +494,8 @@ #ifdef USE_LSB_TAG # define XSET(var, vartype, ptr) \ - (eassert ((((EMACS_UINT) (ptr)) & ((1 << GCTYPEBITS) - 1)) == 0), \ - (var).u.val = ((EMACS_UINT) (ptr)) >> GCTYPEBITS, \ + (eassert ((((uintptr_t) (ptr)) & ((1 << GCTYPEBITS) - 1)) == 0), \ + (var).u.val = ((uintptr_t) (ptr)) >> GCTYPEBITS, \ (var).u.type = ((char) (vartype))) /* Some versions of gcc seem to consider the bitfield width when issuing @@ -512,7 +512,7 @@ # define XSETFASTINT(a, b) ((a).i = (b)) # define XSET(var, vartype, ptr) \ - (((var).s.val = ((EMACS_INT) (ptr))), ((var).s.type = ((char) (vartype)))) + (((var).s.val = ((intptr_t) (ptr))), ((var).s.type = ((char) (vartype)))) #ifdef DATA_SEG_BITS /* DATA_SEG_BITS forces extra bits to be or'd in with any pointers @@ -1013,7 +1013,7 @@ just the subtype information. */ struct vectorlike_header header; /* This is the size in bits. */ - EMACS_UINT size; + EMACS_INT size; /* This contains the actual bits, packed into bytes. */ unsigned char data[1]; }; @@ -1890,7 +1890,7 @@ #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \ static DECL_ALIGN (struct Lisp_Subr, sname) = \ - { PVEC_SUBR | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)), \ + { PVEC_SUBR, \ { .a ## maxargs = fnname }, \ minargs, maxargs, lname, intspec, 0}; \ Lisp_Object fnname @@ -2628,7 +2628,7 @@ /* Defined in image.c */ extern Lisp_Object QCascent, QCmargin, QCrelief; extern Lisp_Object QCconversion; -extern int x_bitmap_mask (struct frame *, int); +extern int x_bitmap_mask (struct frame *, ptrdiff_t); extern void syms_of_image (void); extern void init_image (void); @@ -3590,29 +3590,19 @@ #define SWITCH_ENUM_CAST(x) (x) -/* Loop over Lisp list LIST. Signal an error if LIST is not a proper - list, or if it contains circles. - - HARE and TORTOISE should be the names of Lisp_Object variables, and - N should be the name of an EMACS_INT variable declared in the - function where the macro is used. Each nested loop should use - its own variables. - - In the loop body, HARE is set to each cons of LIST, and N is the - length of the list processed so far. */ - -#define LIST_END_P(list, obj) \ - (NILP (obj) \ - ? 1 \ - : (CONSP (obj) \ - ? 0 \ - : (wrong_type_argument (Qlistp, (list))), 1)) - -/* Use this to suppress gcc's `...may be used before initialized' warnings. */ +/* Use this to suppress gcc's warnings. */ #ifdef lint + +/* Use CODE only if lint checking is in effect. */ # define IF_LINT(Code) Code + +/* Assume that the expression COND is true. This differs in intent + from 'assert', as it is a message from the programmer to the compiler. */ +# define lint_assume(cond) ((cond) ? (void) 0 : abort ()) + #else # define IF_LINT(Code) /* empty */ +# define lint_assume(cond) ((void) (0 && (cond))) #endif /* The ubiquitous min and max macros. */ @@ -3635,9 +3625,7 @@ fixnum. */ #define make_fixnum_or_float(val) \ - (FIXNUM_OVERFLOW_P (val) \ - ? make_float (val) \ - : make_number ((EMACS_INT)(val))) + (FIXNUM_OVERFLOW_P (val) ? make_float (val) : make_number (val)) /* Checks the `cycle check' variable CHECK to see if it indicates that === modified file 'src/lread.c' --- src/lread.c 2011-06-13 05:18:27 +0000 +++ src/lread.c 2011-06-20 06:11:36 +0000 @@ -158,7 +158,7 @@ static Lisp_Object load_unwind (Lisp_Object); static Lisp_Object load_descriptor_unwind (Lisp_Object); -static void invalid_syntax (const char *, int) NO_RETURN; +static void invalid_syntax (const char *) NO_RETURN; static void end_of_file_error (void) NO_RETURN; @@ -2014,11 +2014,9 @@ S is error string of length N (if > 0) */ static void -invalid_syntax (const char *s, int n) +invalid_syntax (const char *s) { - if (!n) - n = strlen (s); - xsignal1 (Qinvalid_read_syntax, make_string (s, n)); + xsignal1 (Qinvalid_read_syntax, build_string (s)); } @@ -2336,7 +2334,7 @@ if (! valid) { sprintf (buf, "integer, radix %d", radix); - invalid_syntax (buf, 0); + invalid_syntax (buf); } return string_to_number (buf, radix, 0); @@ -2453,7 +2451,7 @@ return ht; } UNREAD (c); - invalid_syntax ("#", 1); + invalid_syntax ("#"); } if (c == '^') { @@ -2487,9 +2485,9 @@ XSETPVECTYPE (XVECTOR (tmp), PVEC_SUB_CHAR_TABLE); return tmp; } - invalid_syntax ("#^^", 3); + invalid_syntax ("#^^"); } - invalid_syntax ("#^", 2); + invalid_syntax ("#^"); } if (c == '&') { @@ -2513,7 +2511,7 @@ version. */ && ! (XFASTINT (length) == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR))) - invalid_syntax ("#&...", 5); + invalid_syntax ("#&..."); val = Fmake_bool_vector (length, Qnil); memcpy (XBOOL_VECTOR (val)->data, SDATA (tmp), size_in_chars); @@ -2523,7 +2521,7 @@ &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1; return val; } - invalid_syntax ("#&...", 5); + invalid_syntax ("#&..."); } if (c == '[') { @@ -2543,7 +2541,7 @@ /* Read the string itself. */ tmp = read1 (readcharfun, &ch, 0); if (ch != 0 || !STRINGP (tmp)) - invalid_syntax ("#", 1); + invalid_syntax ("#"); GCPRO1 (tmp); /* Read the intervals and their properties. */ while (1) @@ -2559,7 +2557,7 @@ if (ch == 0) plist = read1 (readcharfun, &ch, 0); if (ch) - invalid_syntax ("Invalid string property list", 0); + invalid_syntax ("Invalid string property list"); Fset_text_properties (beg, end, plist, tmp); } UNGCPRO; @@ -2716,7 +2714,7 @@ return read_integer (readcharfun, 2); UNREAD (c); - invalid_syntax ("#", 1); + invalid_syntax ("#"); case ';': while ((c = READCHAR) >= 0 && c != '\n'); @@ -2833,7 +2831,7 @@ if (ok) return make_number (c); - invalid_syntax ("?", 1); + invalid_syntax ("?"); } case '"': @@ -3335,7 +3333,7 @@ /* Unfortunately there's no simple and accurate way to convert non-base-10 numbers that are out of C-language range. */ if (base != 10) - xsignal (Qoverflow_error, list1 (build_string (string))); + xsignal1 (Qoverflow_error, build_string (string)); } else if (n <= (negative ? -MOST_NEGATIVE_FIXNUM : MOST_POSITIVE_FIXNUM)) { @@ -3501,7 +3499,7 @@ { if (ch == ']') return val; - invalid_syntax (") or . in a vector", 18); + invalid_syntax (") or . in a vector"); } if (ch == ')') return val; @@ -3603,9 +3601,9 @@ return val; } - invalid_syntax (". in wrong context", 18); + invalid_syntax (". in wrong context"); } - invalid_syntax ("] in a list", 11); + invalid_syntax ("] in a list"); } tem = (read_pure && flag <= 0 ? pure_cons (elt, Qnil) @@ -3652,7 +3650,7 @@ intern (const char *str) { Lisp_Object tem; - int len = strlen (str); + ptrdiff_t len = strlen (str); Lisp_Object obarray; obarray = Vobarray; @@ -3668,7 +3666,7 @@ intern_c_string (const char *str) { Lisp_Object tem; - int len = strlen (str); + ptrdiff_t len = strlen (str); Lisp_Object obarray; obarray = Vobarray; === modified file 'src/minibuf.c' --- src/minibuf.c 2011-06-10 20:05:21 +0000 +++ src/minibuf.c 2011-06-20 06:14:57 +0000 @@ -1115,7 +1115,7 @@ { Lisp_Object args[4], result; char *s; - int len; + ptrdiff_t len; int count = SPECPDL_INDEX (); if (BUFFERP (def)) @@ -1137,7 +1137,7 @@ if (STRINGP (prompt)) { s = SSDATA (prompt); - len = strlen (s); + len = SBYTES (prompt); if (len >= 2 && s[len - 2] == ':' && s[len - 1] == ' ') len = len - 2; else if (len >= 1 && (s[len - 1] == ':' || s[len - 1] == ' ')) === modified file 'src/nsterm.h' --- src/nsterm.h 2011-01-25 04:08:28 +0000 +++ src/nsterm.h 2011-06-22 06:16:16 +0000 @@ -468,8 +468,8 @@ int smallest_font_height; struct ns_bitmap_record *bitmaps; - int bitmaps_size; - int bitmaps_last; + ptrdiff_t bitmaps_size; + ptrdiff_t bitmaps_last; struct image_cache *image_cache; @@ -818,4 +818,3 @@ #endif /* HAVE_NS */ - === modified file 'src/process.c' --- src/process.c 2011-06-20 12:54:05 +0000 +++ src/process.c 2011-06-21 00:59:02 +0000 @@ -1187,7 +1187,7 @@ if (VECTORP (address)) /* AF_INET or AF_INET6 */ { register struct Lisp_Vector *p = XVECTOR (address); - EMACS_UINT size = p->header.size; + EMACS_INT size = p->header.size; Lisp_Object args[10]; int nargs, i; === modified file 'src/termcap.c' --- src/termcap.c 2011-04-12 10:20:32 +0000 +++ src/termcap.c 2011-06-20 07:21:06 +0000 @@ -323,10 +323,10 @@ struct termcap_buffer { char *beg; - int size; + ptrdiff_t size; char *ptr; int ateof; - int full; + ptrdiff_t full; }; /* Forward declarations of static functions. */ @@ -367,7 +367,7 @@ register char *bp1; char *tc_search_point; char *term; - int malloc_size = 0; + ptrdiff_t malloc_size = 0; register int c; char *tcenv = NULL; /* TERMCAP value, if it contains :tc=. */ char *indirect = NULL; /* Terminal type in :tc= in TERMCAP value. */ @@ -637,6 +637,8 @@ { if (bufp->full == bufp->size) { + if ((PTRDIFF_MAX - 1) / 2 < bufp->size) + memory_full (SIZE_MAX); bufp->size *= 2; /* Add 1 to size to ensure room for terminating null. */ tem = (char *) xrealloc (buf, bufp->size + 1); @@ -715,4 +717,3 @@ } #endif /* TEST */ - === modified file 'src/textprop.c' --- src/textprop.c 2011-05-28 22:39:39 +0000 +++ src/textprop.c 2011-06-21 21:32:10 +0000 @@ -613,7 +613,7 @@ } if (BUFFERP (object)) { - int noverlays; + ptrdiff_t noverlays; Lisp_Object *overlay_vec; struct buffer *obuf = current_buffer; === modified file 'src/w32term.h' --- src/w32term.h 2011-03-14 17:07:53 +0000 +++ src/w32term.h 2011-06-22 06:16:16 +0000 @@ -103,7 +103,7 @@ /* Emacs bitmap-id of the default icon bitmap for this frame. Or -1 if none has been allocated yet. */ - int icon_bitmap_id; + ptrdiff_t icon_bitmap_id; /* The root window of this screen. */ Window root_window; @@ -151,10 +151,10 @@ struct w32_bitmap_record *bitmaps; /* Allocated size of bitmaps field. */ - int bitmaps_size; + ptrdiff_t bitmaps_size; /* Last used bitmap index. */ - int bitmaps_last; + ptrdiff_t bitmaps_last; /* The frame (if any) which has the window that has keyboard focus. Zero if none. This is examined by Ffocus_frame in w32fns.c. Note === modified file 'src/xdisp.c' --- src/xdisp.c 2011-06-18 19:15:06 +0000 +++ src/xdisp.c 2011-06-21 21:32:10 +0000 @@ -810,7 +810,7 @@ static int try_scrolling (Lisp_Object, int, EMACS_INT, EMACS_INT, int, int); static int try_cursor_movement (Lisp_Object, struct text_pos, int *); static int trailing_whitespace_p (EMACS_INT); -static unsigned long int message_log_check_duplicate (EMACS_INT, EMACS_INT); +static intmax_t message_log_check_duplicate (EMACS_INT, EMACS_INT); static void push_it (struct it *, struct text_pos *); static void pop_it (struct it *); static void sync_frame_with_window_matrix_rows (struct window *); @@ -2384,7 +2384,7 @@ is invisible. >0 means lines indented more than this value are invisible. */ it->selective = (INTEGERP (BVAR (current_buffer, selective_display)) - ? XFASTINT (BVAR (current_buffer, selective_display)) + ? XINT (BVAR (current_buffer, selective_display)) : (!NILP (BVAR (current_buffer, selective_display)) ? -1 : 0)); it->selective_display_ellipsis_p @@ -3062,10 +3062,9 @@ static EMACS_INT next_overlay_change (EMACS_INT pos) { - int noverlays; + ptrdiff_t i, noverlays; EMACS_INT endpos; Lisp_Object *overlays; - int i; /* Get all overlays at the given position. */ GET_OVERLAYS_AT (pos, overlays, noverlays, &endpos, 1); @@ -5178,7 +5177,8 @@ static int forward_to_next_line_start (struct it *it, int *skipped_p) { - int old_selective, newline_found_p, n; + EMACS_INT old_selective; + int newline_found_p, n; const int MAX_NEWLINE_DISTANCE = 500; /* If already on a newline, just consume it to avoid unintended @@ -5270,7 +5270,7 @@ invisible. */ if (it->selective > 0 && indented_beyond_p (IT_CHARPOS (*it), IT_BYTEPOS (*it), - (double) it->selective)) /* iftc */ + it->selective)) continue; /* Check the newline before point for invisibility. */ @@ -5364,7 +5364,7 @@ if (it->selective > 0) while (IT_CHARPOS (*it) < ZV && indented_beyond_p (IT_CHARPOS (*it), IT_BYTEPOS (*it), - (double) it->selective)) /* iftc */ + it->selective)) { xassert (IT_BYTEPOS (*it) == BEGV || FETCH_BYTE (IT_BYTEPOS (*it) - 1) == '\n'); @@ -6812,7 +6812,7 @@ && IT_CHARPOS (*it) + 1 < ZV && indented_beyond_p (IT_CHARPOS (*it) + 1, IT_BYTEPOS (*it) + 1, - (double) it->selective)) /* iftc */ + it->selective)) { success_p = next_element_from_ellipsis (it); it->dpvec_char_len = -1; @@ -8063,7 +8063,7 @@ if (nlflag) { EMACS_INT this_bol, this_bol_byte, prev_bol, prev_bol_byte; - unsigned long int dups; + intmax_t dups; insert_1 ("\n", 1, 1, 0, 0); scan_newline (Z, Z_BYTE, BEG, BEG_BYTE, -2, 0); @@ -8086,12 +8086,13 @@ this_bol, this_bol_byte, 0); if (dups > 1) { - char dupstr[40]; + char dupstr[sizeof " [ times]" + + INT_STRLEN_BOUND (intmax_t)]; int duplen; /* If you change this format, don't forget to also change message_log_check_duplicate. */ - sprintf (dupstr, " [%lu times]", dups); + sprintf (dupstr, " [%"PRIdMAX" times]", dups); duplen = strlen (dupstr); TEMP_SET_PT_BOTH (Z - 1, Z_BYTE - 1); insert_1 (dupstr, duplen, 1, 0, 1); @@ -8153,7 +8154,7 @@ Return 0 if different, 1 if the new one should just replace it, or a value N > 1 if we should also append " [N times]". */ -static unsigned long int +static intmax_t message_log_check_duplicate (EMACS_INT prev_bol_byte, EMACS_INT this_bol_byte) { EMACS_INT i; @@ -8175,8 +8176,8 @@ if (*p1++ == ' ' && *p1++ == '[') { char *pend; - unsigned long int n = strtoul ((char *) p1, &pend, 10); - if (strncmp (pend, " times]\n", 8) == 0) + intmax_t n = strtoimax ((char *) p1, &pend, 10); + if (0 < n && n < INTMAX_MAX && strncmp (pend, " times]\n", 8) == 0) return n+1; } return 0; @@ -18728,8 +18729,7 @@ break; case MODE_LINE_STRING: { - int len = strlen (spec); - Lisp_Object tem = make_string (spec, len); + Lisp_Object tem = build_string (spec); props = Ftext_properties_at (make_number (charpos), elt); /* Should only keep face property in props */ n += store_mode_line_string (NULL, tem, 0, field, prec, props); @@ -25452,13 +25452,13 @@ && XFASTINT (w->last_modified) == BUF_MODIFF (b) && XFASTINT (w->last_overlay_modified) == BUF_OVERLAY_MODIFF (b)) { - int hpos, vpos, i, dx, dy, area; + int hpos, vpos, dx, dy, area; EMACS_INT pos; struct glyph *glyph; Lisp_Object object; Lisp_Object mouse_face = Qnil, position; Lisp_Object *overlay_vec = NULL; - int noverlays; + ptrdiff_t i, noverlays; struct buffer *obuf; EMACS_INT obegv, ozv; int same_region; === modified file 'src/xfaces.c' --- src/xfaces.c 2011-06-18 19:15:06 +0000 +++ src/xfaces.c 2011-06-22 06:16:16 +0000 @@ -463,7 +463,8 @@ static void set_font_frame_param (Lisp_Object, Lisp_Object); static int get_lface_attributes (struct frame *, Lisp_Object, Lisp_Object *, int, struct named_merge_point *); -static int load_pixmap (struct frame *, Lisp_Object, unsigned *, unsigned *); +static ptrdiff_t load_pixmap (struct frame *, Lisp_Object, + unsigned *, unsigned *); static struct frame *frame_or_selected_frame (Lisp_Object, int); static void load_face_colors (struct frame *, struct face *, Lisp_Object *); static void free_face_colors (struct frame *, struct face *); @@ -963,10 +964,10 @@ zero. Store the bitmap width in *W_PTR and its height in *H_PTR, if these pointers are not null. */ -static int +static ptrdiff_t load_pixmap (FRAME_PTR f, Lisp_Object name, unsigned int *w_ptr, unsigned int *h_ptr) { - int bitmap_id; + ptrdiff_t bitmap_id; if (NILP (name)) return 0; @@ -5934,7 +5935,7 @@ struct frame *f = XFRAME (w->frame); Lisp_Object attrs[LFACE_VECTOR_SIZE]; Lisp_Object prop, position; - int i, noverlays; + ptrdiff_t i, noverlays; Lisp_Object *overlay_vec; Lisp_Object frame; EMACS_INT endpos; === modified file 'src/xfns.c' --- src/xfns.c 2011-06-18 19:15:06 +0000 +++ src/xfns.c 2011-06-21 01:38:04 +0000 @@ -1883,7 +1883,7 @@ /* Make a fontset name from the base font name. */ if (xic_defaut_fontset == base_fontname) { /* There is no base font name, use the default. */ - int len = strlen (base_fontname) + 2; + ptrdiff_t len = strlen (base_fontname) + 2; fontsetname = xmalloc (len); memset (fontsetname, 0, len); strcpy (fontsetname, base_fontname); @@ -1896,7 +1896,7 @@ - the base font where the charset spec is replaced by -*-*. - the same but with the family also replaced with -*-*-. */ const char *p = base_fontname; - int i; + ptrdiff_t i; for (i = 0; *p; p++) if (*p == '-') i++; @@ -1904,7 +1904,8 @@ { /* As the font name doesn't conform to XLFD, we can't modify it to generalize it to allcs and allfamilies. Use the specified font plus the default. */ - int len = strlen (base_fontname) + strlen (xic_defaut_fontset) + 3; + ptrdiff_t len = + strlen (base_fontname) + strlen (xic_defaut_fontset) + 3; fontsetname = xmalloc (len); memset (fontsetname, 0, len); strcpy (fontsetname, base_fontname); @@ -1913,7 +1914,7 @@ } else { - int len; + ptrdiff_t len; const char *p1 = NULL, *p2 = NULL, *p3 = NULL; char *font_allcs = NULL; char *font_allfamilies = NULL; @@ -1940,7 +1941,7 @@ wildcard. */ if (*p3 != '*') { - int diff = (p2 - p3) - 2; + ptrdiff_t diff = (p2 - p3) - 2; base = alloca (strlen (base_fontname) + 1); memcpy (base, base_fontname, p3 - base_fontname); @@ -2434,7 +2435,7 @@ /* Do some needed geometry management. */ { - int len; + ptrdiff_t len; char *tem, shell_position[32]; Arg gal[10]; int gac = 0; === modified file 'src/xfont.c' --- src/xfont.c 2011-04-11 05:58:27 +0000 +++ src/xfont.c 2011-06-21 01:40:45 +0000 @@ -594,16 +594,14 @@ { if (XGetFontProperty (xfont, XA_FONT, &value)) { - int len; char *s; s = (char *) XGetAtomName (display, (Atom) value); - len = strlen (s); /* If DXPC (a Differential X Protocol Compressor) Ver.3.7 is running, XGetAtomName will return null string. We must avoid such a name. */ - if (len > 0) + if (*s) { entity = font_make_entity (); ASET (entity, FONT_TYPE_INDEX, Qx); === modified file 'src/xrdb.c' --- src/xrdb.c 2011-04-19 00:34:42 +0000 +++ src/xrdb.c 2011-06-21 02:15:16 +0000 @@ -120,20 +120,20 @@ refers to %L only when the LANG environment variable is set, or otherwise provided by X. - ESCAPED_SUFFIX and SUFFIX are postpended to STRING if they are - non-zero. %-escapes in ESCAPED_SUFFIX are expanded; STRING is left - alone. + ESCAPED_SUFFIX is postpended to STRING if it is non-zero. + %-escapes in ESCAPED_SUFFIX are expanded. Return NULL otherwise. */ static char * -magic_file_p (const char *string, EMACS_INT string_len, const char *class, const char *escaped_suffix, const char *suffix) +magic_file_p (const char *string, EMACS_INT string_len, const char *class, + const char *escaped_suffix) { char *lang = getenv ("LANG"); - int path_size = 100; + ptrdiff_t path_size = 100; char *path = (char *) xmalloc (path_size); - int path_len = 0; + ptrdiff_t path_len = 0; const char *p = string; @@ -141,7 +141,7 @@ { /* The chunk we're about to stick on the end of result. */ const char *next = NULL; - int next_len; + ptrdiff_t next_len; if (*p == '%') { @@ -201,8 +201,10 @@ next = p, next_len = 1; /* Do we have room for this component followed by a '\0' ? */ - if (path_len + next_len + 1 > path_size) + if (path_size - path_len <= next_len) { + if (min (PTRDIFF_MAX, SIZE_MAX) / 2 - 1 - path_len < next_len) + memory_full (SIZE_MAX); path_size = (path_len + next_len + 1) * 2; path = (char *) xrealloc (path, path_size); } @@ -222,21 +224,6 @@ } } - /* Perhaps we should add the SUFFIX now. */ - if (suffix) - { - int suffix_len = strlen (suffix); - - if (path_len + suffix_len + 1 > path_size) - { - path_size = (path_len + suffix_len + 1); - path = (char *) xrealloc (path, path_size); - } - - memcpy (path + path_len, suffix, suffix_len); - path_len += suffix_len; - } - path[path_len] = '\0'; if (! file_p (path)) @@ -295,7 +282,8 @@ the path name of the one we found otherwise. */ static char * -search_magic_path (const char *search_path, const char *class, const char *escaped_suffix, const char *suffix) +search_magic_path (const char *search_path, const char *class, + const char *escaped_suffix) { const char *s, *p; @@ -306,8 +294,7 @@ if (p > s) { - char *path = magic_file_p (s, p - s, class, escaped_suffix, - suffix); + char *path = magic_file_p (s, p - s, class, escaped_suffix); if (path) return path; } @@ -316,7 +303,7 @@ char *path; s = "%N%S"; - path = magic_file_p (s, strlen (s), class, escaped_suffix, suffix); + path = magic_file_p (s, strlen (s), class, escaped_suffix); if (path) return path; } @@ -340,7 +327,7 @@ path = getenv ("XFILESEARCHPATH"); if (! path) path = PATH_X_DEFAULTS; - p = search_magic_path (path, class, 0, 0); + p = search_magic_path (path, class, 0); if (p) { db = XrmGetFileDatabase (p); @@ -368,19 +355,19 @@ /* Check for XUSERFILESEARCHPATH. It is a path of complete file names, not directories. */ if (((path = getenv ("XUSERFILESEARCHPATH")) - && (file = search_magic_path (path, class, 0, 0))) + && (file = search_magic_path (path, class, 0))) /* Check for APPLRESDIR; it is a path of directories. In each, we have to search for LANG/CLASS and then CLASS. */ || ((path = getenv ("XAPPLRESDIR")) - && ((file = search_magic_path (path, class, "/%L/%N", 0)) - || (file = search_magic_path (path, class, "/%N", 0)))) + && ((file = search_magic_path (path, class, "/%L/%N")) + || (file = search_magic_path (path, class, "/%N")))) /* Check in the home directory. This is a bit of a hack; let's hope one's home directory doesn't contain any %-escapes. */ || (free_it = gethomedir (), - ((file = search_magic_path (free_it, class, "%L/%N", 0)) - || (file = search_magic_path (free_it, class, "%N", 0))))) + ((file = search_magic_path (free_it, class, "%L/%N")) + || (file = search_magic_path (free_it, class, "%N"))))) { XrmDatabase db = XrmGetFileDatabase (file); xfree (file); === modified file 'src/xselect.c' --- src/xselect.c 2011-06-06 19:43:39 +0000 +++ src/xselect.c 2011-06-21 02:16:54 +0000 @@ -2361,7 +2361,7 @@ x_uncatch_errors (); if (!had_errors) - ret = make_string (name, strlen (name)); + ret = build_string (name); if (atom && name) XFree (name); if (NILP (ret)) ret = empty_unibyte_string; === modified file 'src/xsettings.c' --- src/xsettings.c 2011-04-14 20:16:48 +0000 +++ src/xsettings.c 2011-06-21 17:52:14 +0000 @@ -18,6 +18,8 @@ along with GNU Emacs. If not, see . */ #include + +#include #include #include #include @@ -434,10 +436,8 @@ FcPattern *pat; struct xsettings oldsettings; int changed = 0; - char buf[256]; memset (&oldsettings, 0, sizeof (oldsettings)); - buf[0] = '\0'; pat = FcPatternCreate (); XftDefaultSubstitute (dpyinfo->display, XScreenNumberOfScreen (dpyinfo->screen), @@ -458,7 +458,6 @@ ++changed; oldsettings.aa = settings->aa; } - sprintf (buf, "Antialias: %d", oldsettings.aa); if ((settings->seen & SEEN_HINTING) != 0 && oldsettings.hinting != settings->hinting) @@ -468,8 +467,6 @@ ++changed; oldsettings.hinting = settings->hinting; } - if (strlen (buf) > 0) strcat (buf, ", "); - sprintf (buf+strlen (buf), "Hinting: %d", oldsettings.hinting); if ((settings->seen & SEEN_RGBA) != 0 && oldsettings.rgba != settings->rgba) { FcPatternDel (pat, FC_RGBA); @@ -477,8 +474,6 @@ oldsettings.rgba = settings->rgba; ++changed; } - if (strlen (buf) > 0) strcat (buf, ", "); - sprintf (buf+strlen (buf), "RGBA: %d", oldsettings.rgba); /* Older fontconfig versions don't have FC_LCD_FILTER. */ if ((settings->seen & SEEN_LCDFILTER) != 0 @@ -489,8 +484,6 @@ ++changed; oldsettings.lcdfilter = settings->lcdfilter; } - if (strlen (buf) > 0) strcat (buf, ", "); - sprintf (buf+strlen (buf), "LCDFilter: %d", oldsettings.lcdfilter); # ifdef FC_HINT_STYLE if ((settings->seen & SEEN_HINTSTYLE) != 0 @@ -502,8 +495,6 @@ oldsettings.hintstyle = settings->hintstyle; } # endif - if (strlen (buf) > 0) strcat (buf, ", "); - sprintf (buf+strlen (buf), "Hintstyle: %d", oldsettings.hintstyle); if ((settings->seen & SEEN_DPI) != 0 && oldsettings.dpi != settings->dpi && settings->dpi > 0) @@ -523,16 +514,31 @@ XFRAME (frame)->resy = XFRAME (frame)->resx = settings->dpi; } - if (strlen (buf) > 0) strcat (buf, ", "); - sprintf (buf+strlen (buf), "DPI: %lf", oldsettings.dpi); - if (changed) { + static char const format[] = + "Antialias: %d, Hinting: %d, RGBA: %d, LCDFilter: %d, " + "Hintstyle: %d, DPI: %lf"; + enum + { + d_formats = 5, + d_growth = INT_BUFSIZE_BOUND (int) - sizeof "%d", + lf_formats = 1, + max_f_integer_digits = DBL_MAX_10_EXP + 1, + f_precision = 6, + lf_growth = (sizeof "-." + max_f_integer_digits + f_precision + - sizeof "%lf") + }; + char buf[sizeof format + d_formats * d_growth + lf_formats * lf_growth]; + XftDefaultSet (dpyinfo->display, pat); if (send_event_p) store_config_changed_event (Qfont_render, XCAR (dpyinfo->name_list_element)); - Vxft_settings = make_string (buf, strlen (buf)); + sprintf (buf, format, oldsettings.aa, oldsettings.hinting, + oldsettings.rgba, oldsettings.lcdfilter, + oldsettings.hintstyle, oldsettings.dpi); + Vxft_settings = build_string (buf); } else FcPatternDestroy (pat); @@ -705,9 +711,7 @@ doc: /* Get the system default application font. */) (void) { - return current_font - ? make_string (current_font, strlen (current_font)) - : Qnil; + return current_font ? build_string (current_font) : Qnil; } DEFUN ("font-get-system-font", Ffont_get_system_font, Sfont_get_system_font, @@ -715,9 +719,7 @@ doc: /* Get the system default fixed width font. */) (void) { - return current_mono_font - ? make_string (current_mono_font, strlen (current_mono_font)) - : Qnil; + return current_mono_font ? build_string (current_mono_font) : Qnil; } DEFUN ("tool-bar-get-system-style", Ftool_bar_get_system_style, === modified file 'src/xsmfns.c' --- src/xsmfns.c 2011-04-16 03:06:07 +0000 +++ src/xsmfns.c 2011-06-21 20:32:19 +0000 @@ -190,7 +190,7 @@ props[props_idx]->type = xstrdup (SmARRAY8); props[props_idx]->num_vals = 1; props[props_idx]->vals = &values[val_idx++]; - props[props_idx]->vals[0].length = strlen (SSDATA (Vinvocation_name)); + props[props_idx]->vals[0].length = SBYTES (Vinvocation_name); props[props_idx]->vals[0].value = SDATA (Vinvocation_name); ++props_idx; @@ -200,7 +200,7 @@ props[props_idx]->type = xstrdup (SmARRAY8); props[props_idx]->num_vals = 1; props[props_idx]->vals = &values[val_idx++]; - props[props_idx]->vals[0].length = strlen (SSDATA (Vuser_login_name)); + props[props_idx]->vals[0].length = SBYTES (Vuser_login_name); props[props_idx]->vals[0].value = SDATA (Vuser_login_name); ++props_idx; @@ -398,7 +398,7 @@ char errorstring[SM_ERRORSTRING_LEN]; char* previous_id = NULL; SmcCallbacks callbacks; - int name_len = 0; + ptrdiff_t name_len = 0; ice_fd = -1; doing_interact = False; @@ -410,8 +410,8 @@ /* Construct the path to the Emacs program. */ if (! EQ (Vinvocation_directory, Qnil)) - name_len += strlen (SSDATA (Vinvocation_directory)); - name_len += strlen (SSDATA (Vinvocation_name)); + name_len += SBYTES (Vinvocation_directory); + name_len += SBYTES (Vinvocation_name); /* This malloc will not be freed, but it is only done once, and hopefully not very large */ @@ -457,7 +457,7 @@ if (smc_conn != 0) { - Vx_session_id = make_string (client_id, strlen (client_id)); + Vx_session_id = build_string (client_id); #ifdef USE_GTK /* GTK creats a leader window by itself, but we need to tell === modified file 'src/xterm.c' --- src/xterm.c 2011-06-13 16:08:46 +0000 +++ src/xterm.c 2011-06-22 06:16:16 +0000 @@ -356,7 +356,7 @@ interference with debugging failing X calls. */ static void x_connection_closed (Display *, const char *); static void x_wm_set_window_state (struct frame *, int); -static void x_wm_set_icon_pixmap (struct frame *, int); +static void x_wm_set_icon_pixmap (struct frame *, ptrdiff_t); static void x_initialize (void); @@ -7427,7 +7427,7 @@ int x_bitmap_icon (struct frame *f, Lisp_Object file) { - int bitmap_id; + ptrdiff_t bitmap_id; if (FRAME_X_WINDOW (f) == 0) return 1; @@ -7453,7 +7453,7 @@ /* Create the GNU bitmap and mask if necessary. */ if (FRAME_X_DISPLAY_INFO (f)->icon_bitmap_id < 0) { - int rc = -1; + ptrdiff_t rc = -1; #ifdef USE_GTK @@ -8084,7 +8084,7 @@ { #ifdef HAVE_X11R6_XIM struct xim_inst_t *xim_inst; - int len; + ptrdiff_t len; xim_inst = (struct xim_inst_t *) xmalloc (sizeof (struct xim_inst_t)); dpyinfo->xim_callback_data = xim_inst; @@ -9601,7 +9601,7 @@ } static void -x_wm_set_icon_pixmap (struct frame *f, int pixmap_id) +x_wm_set_icon_pixmap (struct frame *f, ptrdiff_t pixmap_id) { Pixmap icon_pixmap, icon_mask; @@ -9720,8 +9720,8 @@ { int seen_colon = 0; const char *system_name = SSDATA (Vsystem_name); - int system_name_length = strlen (system_name); - int length_until_period = 0; + ptrdiff_t system_name_length = SBYTES (Vsystem_name); + ptrdiff_t length_until_period = 0; while (system_name[length_until_period] != 0 && system_name[length_until_period] != '.') === modified file 'src/xterm.h' --- src/xterm.h 2011-06-11 21:31:32 +0000 +++ src/xterm.h 2011-06-22 06:16:16 +0000 @@ -158,7 +158,7 @@ /* Emacs bitmap-id of the default icon bitmap for this frame. Or -1 if none has been allocated yet. */ - int icon_bitmap_id; + ptrdiff_t icon_bitmap_id; /* The root window of this screen. */ Window root_window; @@ -202,10 +202,10 @@ struct x_bitmap_record *bitmaps; /* Allocated size of bitmaps field. */ - int bitmaps_size; + ptrdiff_t bitmaps_size; /* Last used bitmap index. */ - int bitmaps_last; + ptrdiff_t bitmaps_last; /* Which modifier keys are on which modifier bits? @@ -490,7 +490,7 @@ /* If >=0, a bitmap index. The indicated bitmap is used for the icon. */ - int icon_bitmap; + ptrdiff_t icon_bitmap; /* Default ASCII font of this frame. */ struct font *font; ------------------------------------------------------------ revno: 104673 committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Wed 2011-06-22 16:48:31 +0200 message: When the .authinfo file has a user name but not a password, prompt for the password. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-22 09:23:31 +0000 +++ lisp/ChangeLog 2011-06-22 14:48:31 +0000 @@ -2,6 +2,8 @@ * mail/smtpmail.el (smtpmail-via-smtp): Make sure we don't send QUIT twice. + (smtpmail-try-auth-methods): Require user name and password from + auth-source. 2011-06-22 Martin Rudalics === modified file 'lisp/gnus/auth-source.el' --- lisp/gnus/auth-source.el 2011-06-21 20:51:45 +0000 +++ lisp/gnus/auth-source.el 2011-06-22 14:48:31 +0000 @@ -713,7 +713,8 @@ when (string-match (concat "^" auth-source-magic) (symbol-name sym)) ;; remove that key - do (password-cache-remove (symbol-name sym)))) + do (password-cache-remove (symbol-name sym))) + (setq auth-source-netrc-cache nil)) (defun auth-source-remember (spec found) "Remember FOUND search results for SPEC." @@ -1144,6 +1145,9 @@ ;; we know (because of an assertion in auth-source-search) that the ;; :create parameter is either t or a list (which includes nil) (create-extra (if (eq t create) nil create)) + (current-data (car (auth-source-search :max 1 + :host host + :port port))) (required (append base-required create-extra)) (file (oref backend source)) (add "") @@ -1178,7 +1182,9 @@ (dolist (r required) (let* ((data (aget valist r)) ;; take the first element if the data is a list - (data (auth-source-netrc-element-or-first data)) + (data (or (auth-source-netrc-element-or-first data) + (plist-get current-data + (intern (format ":%s" r) obarray)))) ;; this is the default to be offered (given-default (aget auth-source-creation-defaults r)) ;; the default supplementals are simple: === modified file 'lisp/mail/smtpmail.el' --- lisp/mail/smtpmail.el 2011-06-22 09:13:50 +0000 +++ lisp/mail/smtpmail.el 2011-06-22 14:48:31 +0000 @@ -483,12 +483,15 @@ '((user . "SMTP user at %h: ") (secret . "SMTP password for %u@%h: "))) (auth-info (car - (auth-source-search :max 1 - :host host - :port (if port - (format "%s" port) - "smtp") - :create ask-for-password))) + (auth-source-search + :max 1 + :host host + :port (if port + (format "%s" port) + "smtp") + :require (and ask-for-password + '(:user :secret)) + :create ask-for-password))) (user (plist-get auth-info :user)) (password (plist-get auth-info :secret)) (save-function (and ask-for-password ------------------------------------------------------------ revno: 104672 committer: Jim Meyering branch nick: trunk timestamp: Wed 2011-06-22 14:23:17 +0200 message: don't leak an XBM-image-sized buffer * image.c (xbm_load): Free the image buffer after using it. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-21 16:47:56 +0000 +++ src/ChangeLog 2011-06-22 12:23:17 +0000 @@ -1,3 +1,8 @@ +2011-06-22 Jim Meyering + + don't leak an XBM-image-sized buffer + * image.c (xbm_load): Free the image buffer after using it. + 2011-06-21 Paul Eggert Port to Sun C. === modified file 'src/image.c' --- src/image.c 2011-06-13 08:00:15 +0000 +++ src/image.c 2011-06-22 12:23:17 +0000 @@ -2829,6 +2829,7 @@ } success_p = xbm_load_image (f, img, contents, contents + size); + xfree (contents); } else { ------------------------------------------------------------ revno: 104671 committer: martin rudalics branch nick: trunk timestamp: Wed 2011-06-22 11:23:31 +0200 message: Normalize SIDE argument of split-window (Bug#8916). * window.el (split-window): Normalize SIDE argument (Bug#8916). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-22 09:13:50 +0000 +++ lisp/ChangeLog 2011-06-22 09:23:31 +0000 @@ -8,6 +8,7 @@ * window.el (display-buffer-default-specifiers) (display-buffer-alist): Remove entries for pop-up-frame-alist. Suggested by Katsumi Yamaoka . + (split-window): Normalize SIDE argument (Bug#8916). * frame.el (pop-up-frame-alist, pop-up-frame-function) (special-display-frame-alist, special-display-popup-frame): === modified file 'lisp/window.el' --- lisp/window.el 2011-06-22 07:12:18 +0000 +++ lisp/window.el 2011-06-22 09:23:31 +0000 @@ -3014,7 +3014,11 @@ frame. The selected window is not changed by this function." (interactive "i") (setq window (normalize-any-window window)) - (let* ((horizontal (not (memq side '(nil below above)))) + (let* ((side (cond + ((not side) 'below) + ((memq side '(below above right left)) side) + (t 'right))) + (horizontal (not (memq side '(nil below above)))) (frame (window-frame window)) (parent (window-parent window)) (function (window-parameter window 'split-window)) ------------------------------------------------------------ revno: 104670 committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Wed 2011-06-22 11:13:50 +0200 message: (smtpmail-via-smtp): Make sure we don't send QUIT twice. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-22 07:12:18 +0000 +++ lisp/ChangeLog 2011-06-22 09:13:50 +0000 @@ -1,3 +1,8 @@ +2011-06-22 Lars Magne Ingebrigtsen + + * mail/smtpmail.el (smtpmail-via-smtp): Make sure we don't send + QUIT twice. + 2011-06-22 Martin Rudalics * window.el (display-buffer-default-specifiers) === modified file 'lisp/mail/smtpmail.el' --- lisp/mail/smtpmail.el 2011-06-21 22:55:52 +0000 +++ lisp/mail/smtpmail.el 2011-06-22 09:13:50 +0000 @@ -741,6 +741,7 @@ (smtpmail-send-command process "QUIT") (smtpmail-read-response process) (delete-process process) + (setq process nil) (throw 'done (smtpmail-via-smtp recipient smtpmail-text-buffer t))) (t @@ -768,6 +769,7 @@ (smtpmail-send-command process "QUIT") (smtpmail-read-response process) (delete-process process) + (setq process nil) (throw 'done (smtpmail-via-smtp recipient smtpmail-text-buffer t))) (t ------------------------------------------------------------ revno: 104669 committer: martin rudalics branch nick: trunk timestamp: Wed 2011-06-22 09:12:18 +0200 message: Remove preset entries for pop-up-frame-alist from window.el defaults. * window.el (display-buffer-default-specifiers) (display-buffer-alist): Remove entries for pop-up-frame-alist. Suggested by Katsumi Yamaoka . * frame.el (pop-up-frame-alist, pop-up-frame-function) (special-display-frame-alist, special-display-popup-frame): Remove duplicate declarations. These are now in window.el. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-21 22:55:52 +0000 +++ lisp/ChangeLog 2011-06-22 07:12:18 +0000 @@ -1,3 +1,13 @@ +2011-06-22 Martin Rudalics + + * window.el (display-buffer-default-specifiers) + (display-buffer-alist): Remove entries for pop-up-frame-alist. + Suggested by Katsumi Yamaoka . + + * frame.el (pop-up-frame-alist, pop-up-frame-function) + (special-display-frame-alist, special-display-popup-frame): + Remove duplicate declarations. These are now in window.el. + 2011-06-21 Lars Magne Ingebrigtsen * mail/smtpmail.el (smtpmail-via-smtp): Set === modified file 'lisp/frame.el' --- lisp/frame.el 2011-04-19 13:44:55 +0000 +++ lisp/frame.el 2011-06-22 07:12:18 +0000 @@ -95,96 +95,6 @@ (sexp :tag "Value"))) :group 'frames) -(defcustom pop-up-frame-alist nil - "Alist of parameters for automatically generated new frames. -You can set this in your init file; for example, - - (setq pop-up-frame-alist '((width . 80) (height . 20))) - -If non-nil, the value you specify here is used by the default -`pop-up-frame-function' for the creation of new frames. - -Since `pop-up-frame-function' is used by `display-buffer' for -making new frames, any value specified here by default affects -the automatic generation of new frames via `display-buffer' and -all functions based on it. The behavior of `make-frame' is not -affected by this variable." - :type '(repeat (cons :format "%v" - (symbol :tag "Parameter") - (sexp :tag "Value"))) - :group 'frames) - -(defcustom pop-up-frame-function - (lambda () (make-frame pop-up-frame-alist)) - "Function used by `display-buffer' for creating a new frame. -This function is called with no arguments and should return a new -frame. The default value calls `make-frame' with the argument -`pop-up-frame-alist'." - :type 'function - :group 'frames) - -(defcustom special-display-frame-alist - '((height . 14) (width . 80) (unsplittable . t)) - "Alist of parameters for special frames. -Special frames are used for buffers whose names are listed in -`special-display-buffer-names' and for buffers whose names match -one of the regular expressions in `special-display-regexps'. - -This variable can be set in your init file, like this: - - (setq special-display-frame-alist '((width . 80) (height . 20))) - -These supersede the values given in `default-frame-alist'." - :type '(repeat (cons :format "%v" - (symbol :tag "Parameter") - (sexp :tag "Value"))) - :group 'frames) - -(defun special-display-popup-frame (buffer &optional args) - "Display BUFFER and return the window chosen. -If BUFFER is already displayed in a visible or iconified frame, -raise that frame. Otherwise, display BUFFER in a new frame. - -Optional argument ARGS is a list specifying additional -information. - -If ARGS is an alist, use it as a list of frame parameters. If -these parameters contain \(same-window . t), display BUFFER in -the selected window. If they contain \(same-frame . t), display -BUFFER in a window of the selected frame. - -If ARGS is a list whose car is a symbol, use (car ARGS) as a -function to do the work. Pass it BUFFER as first argument, -and (cdr ARGS) as second." - (if (and args (symbolp (car args))) - (apply (car args) buffer (cdr args)) - (let ((window (get-buffer-window buffer 0))) - (or - ;; If we have a window already, make it visible. - (when window - (let ((frame (window-frame window))) - (make-frame-visible frame) - (raise-frame frame) - window)) - ;; Reuse the current window if the user requested it. - (when (cdr (assq 'same-window args)) - (condition-case nil - (progn (switch-to-buffer buffer) (selected-window)) - (error nil))) - ;; Stay on the same frame if requested. - (when (or (cdr (assq 'same-frame args)) (cdr (assq 'same-window args))) - (let* ((pop-up-windows t) - pop-up-frames - special-display-buffer-names special-display-regexps) - (display-buffer buffer))) - ;; If no window yet, make one in a new frame. - (let ((frame - (with-current-buffer buffer - (make-frame (append args special-display-frame-alist))))) - (set-window-buffer (frame-selected-window frame) buffer) - (set-window-dedicated-p (frame-selected-window frame) t) - (frame-selected-window frame)))))) - (defun handle-delete-frame (event) "Handle delete-frame events from the X server." (interactive "e") === modified file 'lisp/window.el' --- lisp/window.el 2011-06-21 15:16:32 +0000 +++ lisp/window.el 2011-06-22 07:12:18 +0000 @@ -3820,8 +3820,6 @@ (pop-up-window-min-height . 40) (pop-up-window-min-width . 80) (reuse-window other nil nil) - (pop-up-frame-alist - (height . 24) (width . 80)) (reuse-window nil other visible) (reuse-window nil nil t) (reuse-window-even-sizes . t)) @@ -4371,8 +4369,7 @@ (list :tag "Pop-up frame" :value (pop-up-frame - (pop-up-frame) - (pop-up-frame-alist (height . 24) (width . 80))) + (pop-up-frame)) :format "%t\n%v" :inline t (const :format "" pop-up-frame) ------------------------------------------------------------ revno: 104668 committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Wed 2011-06-22 00:55:52 +0200 message: Set :use-starttls-if-possible so that we always use STARTTLS if the server supports it. SMTP servers that support STARTTLS commonly require it. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-21 22:33:44 +0000 +++ lisp/ChangeLog 2011-06-21 22:55:52 +0000 @@ -1,5 +1,14 @@ 2011-06-21 Lars Magne Ingebrigtsen + * mail/smtpmail.el (smtpmail-via-smtp): Set + :use-starttls-if-possible so that we always use STARTTLS if the + server supports it. SMTP servers that support STARTTLS commonly + require it. + + * net/network-stream.el (network-stream-open-starttls): Support + upgrading to STARTTLS always, even if we don't have built-in support. + (open-network-stream): Add the :always-query-capabilies keyword. + * mail/smtpmail.el: Rewritten to do opportunistic STARTTLS upgrades with `open-network-stream', and rely solely on auth-source for all credentials. Big changes throughout the file, === modified file 'lisp/mail/smtpmail.el' --- lisp/mail/smtpmail.el 2011-06-21 22:33:44 +0000 +++ lisp/mail/smtpmail.el 2011-06-21 22:55:52 +0000 @@ -627,7 +627,8 @@ (lambda (capabilities) (and (string-match "-STARTTLS" capabilities) "STARTTLS\r\n")) - :client-certificate t)) + :client-certificate t + :use-starttls-if-possible t)) ;; If we couldn't access the server at all, we give up. (unless (setq process (car result)) === modified file 'lisp/net/network-stream.el' --- lisp/net/network-stream.el 2011-06-21 21:00:45 +0000 +++ lisp/net/network-stream.el 2011-06-21 22:55:52 +0000 @@ -120,6 +120,10 @@ certificate. This parameter will only be used when doing TLS or STARTTLS connections. +If :use-starttls-if-possible is non-nil, do opportunistic +STARTTLS upgrades even if Emacs doesn't have built-in TLS +functionality. + :nowait is a boolean that says the connection should be made asynchronously, if possible." (unless (featurep 'make-network-process) @@ -208,7 +212,8 @@ ;; If we have built-in STARTTLS support, try to upgrade the ;; connection. (when (and (or (fboundp 'open-gnutls-stream) - (and require-tls + (and (or require-tls + (plist-get parameters :use-starttls-if-possible)) (executable-find "gnutls-cli"))) capabilities success-string starttls-function (setq starttls-command @@ -236,6 +241,10 @@ starttls-extra-arguments))) (setq stream (starttls-open-stream name buffer host service))) (network-stream-get-response stream start eoc)) + ;; Requery capabilities for protocols that require it; i.e., + ;; EHLO for SMTP. + (when (plist-get parameters :always-query-capabilities) + (network-stream-command stream capability-command eoc)) (when (string-match success-string (network-stream-command stream starttls-command eoc)) ;; The server said it was OK to begin STARTTLS negotiations. ------------------------------------------------------------ revno: 104667 committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Wed 2011-06-22 00:33:44 +0200 message: (smtpmail-via-smtp): Check for servers saying they want AUTH after MAIL FROM, too. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-21 21:10:52 +0000 +++ lisp/ChangeLog 2011-06-21 22:33:44 +0000 @@ -6,6 +6,8 @@ but in particular: (smtpmail-auth-credentials): Removed. (smtpmail-starttls-credentials): Removed. + (smtpmail-via-smtp): Check for servers saying they want AUTH after + MAIL FROM, too. * net/network-stream.el (network-stream-open-starttls): Provide support for client certificates both for external and built-in === modified file 'lisp/mail/smtpmail.el' --- lisp/mail/smtpmail.el 2011-06-21 21:10:52 +0000 +++ lisp/mail/smtpmail.el 2011-06-21 22:33:44 +0000 @@ -470,7 +470,9 @@ (smtpmail-send-command process string) (unless (smtpmail-ok-p (setq ret (smtpmail-read-response process)) code) - (throw 'done (smtpmail-response-text ret))) + (throw 'done (format "%s in response to %s" + (smtpmail-response-text ret) + string))) ret)) (defun smtpmail-try-auth-methods (process supported-extensions host port @@ -483,7 +485,9 @@ (auth-info (car (auth-source-search :max 1 :host host - :port (or port "smtp") + :port (if port + (format "%s" port) + "smtp") :create ask-for-password))) (user (plist-get auth-info :user)) (password (plist-get auth-info :secret)) @@ -721,9 +725,27 @@ " BODY=8BITMIME" "") ""))) - (smtpmail-command-or-throw + (smtpmail-send-command process (format "MAIL FROM:<%s>%s%s" - envelope-from size-part body-part))) + envelope-from size-part body-part)) + (cond + ((smtpmail-ok-p (setq result (smtpmail-read-response process))) + ;; Success. + ) + ((and auth-mechanisms + (not ask-for-password) + (= (car result) 530)) + ;; We got a "530 auth required", so we close and try + ;; again, this time asking the user for a password. + (smtpmail-send-command process "QUIT") + (smtpmail-read-response process) + (delete-process process) + (throw 'done + (smtpmail-via-smtp recipient smtpmail-text-buffer t))) + (t + ;; Return the error code. + (throw 'done + (smtpmail-response-text result))))) ;; RCPT TO: (let ((n 0)) ------------------------------------------------------------ revno: 104666 author: Andrew Cohen committer: Katsumi Yamaoka branch nick: trunk timestamp: Tue 2011-06-21 22:13:24 +0000 message: nnimap.el (nnimap-find-article-by-message-id): return nil when no article found. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2011-06-21 20:51:45 +0000 +++ lisp/gnus/ChangeLog 2011-06-21 22:13:24 +0000 @@ -5,6 +5,11 @@ (auth-sources): Prefer the ~/.authinfo file over the ~/.authinfo.gpg file, especially when saving. +2011-06-21 Andrew Cohen + + * nnimap.el (nnimap-find-article-by-message-id): return nil when no + article found. + 2011-06-18 Teodor Zlatanov * auth-source.el (auth-source-netrc-use-gpg-tokens): Replace === modified file 'lisp/gnus/nnimap.el' --- lisp/gnus/nnimap.el 2011-05-30 22:11:52 +0000 +++ lisp/gnus/nnimap.el 2011-06-21 22:13:24 +0000 @@ -929,7 +929,7 @@ (car (setq result (nnimap-parse-response)))) ;; Select the last instance of the message in the group. (and (setq article - (car (last (assoc "SEARCH" (cdr result))))) + (car (last (cdr (assoc "SEARCH" (cdr result)))))) (string-to-number article)))))) (defun nnimap-delete-article (articles) ------------------------------------------------------------ revno: 104665 committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Tue 2011-06-21 23:10:52 +0200 message: Rewritten smtpmail.el to use `open-network-stream' to do STARTTLS upgrades opportunistically, and to only use auth-source for all credentials. Mostly backwards compatible, but `smtpmail-auth-credentials' and `smtpmail-starttls-credentials' are removed, and users who relied on those will have to put the credentials in ~/.authinfo instead. diff: === modified file 'etc/NEWS' --- etc/NEWS 2011-06-21 08:55:22 +0000 +++ etc/NEWS 2011-06-21 21:10:52 +0000 @@ -109,6 +109,26 @@ ** auto-mode-case-fold is now enabled by default. +** smtpmail changes + +** smtpmail has been largely rewritten to upgrade to STARTTLS if +possible, and uses the auth-source framework for getting credentials. +The rewrite should be largely compatible with previous versions of +smtpmail, but there are two major incompatibilities: + +** `smtpmail-auth-credentials' no longer exists. That variable could +be either ~/.authinfo (in which case you're fine -- you won't see any +difference), but if it were a direct list of user names and passwords, +you will be prompted for the user name and the password instead, and +they will then be saved to ~/.authinfo. + +** Similarly, if you had `smtpmail-starttls-credentials' set, then +then you need to put + +machine smtp.whatever.foo port 25 key "~/.my_smtp_tls.key" cert "~/.my_smtp_tls.cert" + +in your ~/.authinfo file instead. + ** Internationalization changes +++ === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-21 21:00:45 +0000 +++ lisp/ChangeLog 2011-06-21 21:10:52 +0000 @@ -1,5 +1,12 @@ 2011-06-21 Lars Magne Ingebrigtsen + * mail/smtpmail.el: Rewritten to do opportunistic STARTTLS + upgrades with `open-network-stream', and rely solely on + auth-source for all credentials. Big changes throughout the file, + but in particular: + (smtpmail-auth-credentials): Removed. + (smtpmail-starttls-credentials): Removed. + * net/network-stream.el (network-stream-open-starttls): Provide support for client certificates both for external and built-in STARTTLS. === modified file 'lisp/mail/smtpmail.el' --- lisp/mail/smtpmail.el 2011-05-30 17:23:47 +0000 +++ lisp/mail/smtpmail.el 2011-06-21 21:10:52 +0000 @@ -34,16 +34,10 @@ ;; ;;(setq send-mail-function 'smtpmail-send-it) ; if you use `mail' ;;(setq message-send-mail-function 'smtpmail-send-it) ; if you use message/Gnus -;;(setq smtpmail-default-smtp-server "YOUR SMTP HOST") +;;(setq smtpmail-smtp-server "YOUR SMTP HOST") ;;(setq smtpmail-local-domain "YOUR DOMAIN NAME") ;;(setq smtpmail-sendto-domain "YOUR DOMAIN NAME") ;;(setq smtpmail-debug-info t) ; only to debug problems -;;(setq smtpmail-auth-credentials ; or use ~/.authinfo -;; '(("YOUR SMTP HOST" 25 "username" "password"))) -;;(setq smtpmail-starttls-credentials -;; '(("YOUR SMTP HOST" 25 "~/.my_smtp_tls.key" "~/.my_smtp_tls.cert"))) -;; Where the 25 equals the value of `smtpmail-smtp-service', it can be an -;; integer or a string, just as long as they match (eq). ;; To queue mail, set `smtpmail-queue-mail' to t and use ;; `smtpmail-send-queued-mail' to send. @@ -58,17 +52,9 @@ ;; Authentication by the AUTH mechanism. ;; See http://www.ietf.org/rfc/rfc2554.txt -;; Modified by Simon Josefsson , 2000-10-07, to support -;; STARTTLS. Requires external program -;; ftp://ftp.opaopa.org/pub/elisp/starttls-*.tar.gz. -;; See http://www.ietf.org/rfc/rfc2246.txt, http://www.ietf.org/rfc/rfc2487.txt - ;;; Code: (require 'sendmail) -(autoload 'starttls-any-program-available "starttls") -(autoload 'starttls-open-stream "starttls") -(autoload 'starttls-negotiate "starttls") (autoload 'mail-strip-quoted-names "mail-utils") (autoload 'message-make-date "message") (autoload 'message-make-message-id "message") @@ -85,11 +71,9 @@ :group 'mail) -(defcustom smtpmail-default-smtp-server nil +(defvar smtpmail-default-smtp-server nil "Specify default SMTP server. -This only has effect if you specify it before loading the smtpmail library." - :type '(choice (const nil) string) - :group 'smtpmail) +This only has effect if you specify it before loading the smtpmail library.") (defcustom smtpmail-smtp-server (or (getenv "SMTPSERVER") smtpmail-default-smtp-server) @@ -110,6 +94,16 @@ :type '(choice (const nil) string) :group 'smtpmail) +(defcustom smtpmail-stream-type nil + "Connection type SMTP connections. +This may be either nil (plain connection) or `starttls' (use the +starttls mechanism to turn on TLS security after opening the +stream)." + :version "24.1" + :group 'smtpmail + :type '(choice (const :tag "Plain" nil) + (const starttls))) + (defcustom smtpmail-sendto-domain nil "Local domain name without a host name. This is appended (with an @-sign) to any specified recipients which do @@ -117,11 +111,7 @@ \(Some configurations of sendmail require this.) Don't bother to set this unless you have get an error like: - Sending failed; SMTP protocol error -when sending mail, and the *trace of SMTP session to * -buffer includes an exchange like: - RCPT TO: - 501 : recipient address must contain a domain." + Sending failed; 501 : recipient address must contain a domain." :type '(choice (const nil) string) :group 'smtpmail) @@ -157,39 +147,6 @@ :type 'directory :group 'smtpmail) -(defcustom smtpmail-auth-credentials "~/.authinfo" - "Specify username and password for servers, directly or via .netrc file. -This variable can either be a filename pointing to a file in netrc(5) -format, or list of four-element lists that contain, in order, -`servername' (a string), `port' (an integer), `user' (a string) and -`password' (a string, or nil to query the user when needed). If you -need to enter a `realm' too, add it to the user string, so that it -looks like `user@realm'." - :type '(choice file - (repeat (list (string :tag "Server") - (integer :tag "Port") - (string :tag "Username") - (choice (const :tag "Query when needed" nil) - (string :tag "Password"))))) - :version "22.1" - :group 'smtpmail) - -(defcustom smtpmail-starttls-credentials '(("" 25 "" "")) - "Specify STARTTLS keys and certificates for servers. -This is a list of four-element list with `servername' (a string), -`port' (an integer), `key' (a filename) and `certificate' (a -filename). -If you do not have a certificate/key pair, leave the `key' and -`certificate' fields as `nil'. A key/certificate pair is only -needed if you want to use X.509 client authenticated -connections." - :type '(repeat (list (string :tag "Server") - (integer :tag "Port") - (file :tag "Key") - (file :tag "Certificate"))) - :version "21.1" - :group 'smtpmail) - (defcustom smtpmail-warn-about-unknown-extensions nil "If set, print warnings about unknown SMTP extensions. This is mainly useful for development purposes, to learn about @@ -230,6 +187,7 @@ (tembuf (generate-new-buffer " smtpmail temp")) (case-fold-search nil) delimline + result (mailbuf (current-buffer)) ;; Examine this variable now, so that ;; local binding in the mail buffer will take effect. @@ -373,9 +331,10 @@ ;; Send or queue (if (not smtpmail-queue-mail) (if (not (null smtpmail-recipient-address-list)) - (if (not (smtpmail-via-smtp - smtpmail-recipient-address-list tembuf)) - (error "Sending failed; SMTP protocol error")) + (when (setq result + (smtpmail-via-smtp + smtpmail-recipient-address-list tembuf)) + (error "Sending failed: %s" result)) (error "Sending failed; no recipients")) (let* ((file-data (expand-file-name @@ -432,7 +391,8 @@ ;; mail, send it, etc... (let ((file-msg "") (qfile (expand-file-name smtpmail-queue-index-file - smtpmail-queue-dir))) + smtpmail-queue-dir)) + result) (insert-file-contents qfile) (goto-char (point-min)) (while (not (eobp)) @@ -448,17 +408,16 @@ (or (and mail-specify-envelope-from (mail-envelope-from)) user-mail-address))) (if (not (null smtpmail-recipient-address-list)) - (if (not (smtpmail-via-smtp smtpmail-recipient-address-list - (current-buffer))) - (error "Sending failed; SMTP protocol error")) + (when (setq result (smtpmail-via-smtp + smtpmail-recipient-address-list + (current-buffer))) + (error "Sending failed: %s" result)) (error "Sending failed; no recipients")))) (delete-file file-msg) (delete-file (concat file-msg ".el")) (delete-region (point-at-bol) (point-at-bol 2))) (write-region (point-min) (point-max) qfile)))) -;; (defun smtpmail-via-smtp (host,port,sender,destination,smtpmail-text-buffer) - (defun smtpmail-fqdn () (if smtpmail-local-domain (concat (system-name) "." smtpmail-local-domain) @@ -503,146 +462,126 @@ (push el2 result))) (nreverse result))) -(defvar starttls-extra-args) -(defvar starttls-extra-arguments) - -(defun smtpmail-open-stream (process-buffer host port) - (let ((cred (smtpmail-find-credentials - smtpmail-starttls-credentials host port))) - (if (null (and cred (starttls-any-program-available))) - ;; The normal case. - (open-network-stream "SMTP" process-buffer host port) - (let* ((cred-key (smtpmail-cred-key cred)) - (cred-cert (smtpmail-cred-cert cred)) - (starttls-extra-args - (append - starttls-extra-args - (when (and (stringp cred-key) (stringp cred-cert) - (file-regular-p - (setq cred-key (expand-file-name cred-key))) - (file-regular-p - (setq cred-cert (expand-file-name cred-cert)))) - (list "--key-file" cred-key "--cert-file" cred-cert)))) - (starttls-extra-arguments - (append - starttls-extra-arguments - (when (and (stringp cred-key) (stringp cred-cert) - (file-regular-p - (setq cred-key (expand-file-name cred-key))) - (file-regular-p - (setq cred-cert (expand-file-name cred-cert)))) - (list "--x509keyfile" cred-key "--x509certfile" cred-cert))))) - (starttls-open-stream "SMTP" process-buffer host port))))) - ;; `password-read' autoloads password-cache. (declare-function password-cache-add "password-cache" (key password)) -(defun smtpmail-try-auth-methods (process supported-extensions host port) +(defun smtpmail-command-or-throw (process string &optional code) + (let (ret) + (smtpmail-send-command process string) + (unless (smtpmail-ok-p (setq ret (smtpmail-read-response process)) + code) + (throw 'done (smtpmail-response-text ret))) + ret)) + +(defun smtpmail-try-auth-methods (process supported-extensions host port + &optional ask-for-password) (let* ((mechs (cdr-safe (assoc 'auth supported-extensions))) (mech (car (smtpmail-intersection mechs smtpmail-auth-supported))) - (auth-info (auth-source-search :max 1 - :host host - :port (or port "smtp"))) - (auth-user (plist-get (nth 0 auth-info) :user)) - (auth-pass (plist-get (nth 0 auth-info) :secret)) - (auth-pass (if (functionp auth-pass) - (funcall auth-pass) - auth-pass)) - (cred (if (and auth-user auth-pass) ; try user-auth-* before netrc-* - (list host port auth-user auth-pass) - ;; else, if auth-source didn't return them... - (if (stringp smtpmail-auth-credentials) - (let* ((netrc (netrc-parse smtpmail-auth-credentials)) - (port-name (format "%s" (or port "smtp"))) - (hostentry (netrc-machine netrc host port-name - port-name))) - (when hostentry - (list host port - (netrc-get hostentry "login") - (netrc-get hostentry "password")))) - ;; else, try `smtpmail-find-credentials' since - ;; `smtpmail-auth-credentials' is not a string - (smtpmail-find-credentials - smtpmail-auth-credentials host port)))) - (prompt (when cred (format "SMTP password for %s:%s: " - (smtpmail-cred-server cred) - (smtpmail-cred-port cred)))) - (passwd (when cred - (or (smtpmail-cred-passwd cred) - (password-read prompt prompt)))) + (auth-source-creation-prompts + '((user . "SMTP user at %h: ") + (secret . "SMTP password for %u@%h: "))) + (auth-info (car + (auth-source-search :max 1 + :host host + :port (or port "smtp") + :create ask-for-password))) + (user (plist-get auth-info :user)) + (password (plist-get auth-info :secret)) + (save-function (and ask-for-password + (plist-get auth-info :save-function))) ret) - (when (and cred mech) - (cond - ((eq mech 'cram-md5) - (smtpmail-send-command process (upcase (format "AUTH %s" mech))) - (if (or (null (car (setq ret (smtpmail-read-response process)))) - (not (integerp (car ret))) - (>= (car ret) 400)) - (throw 'done nil)) - (when (eq (car ret) 334) - (let* ((challenge (substring (cadr ret) 4)) - (decoded (base64-decode-string challenge)) - (hash (rfc2104-hash 'md5 64 16 passwd decoded)) - (response (concat (smtpmail-cred-user cred) " " hash)) - ;; Osamu Yamane : - ;; SMTP auth fails because the SMTP server identifies - ;; only the first part of the string (delimited by - ;; new line characters) as a response from the - ;; client, and the rest as distinct commands. - - ;; In my case, the response string is 80 characters - ;; long. Without the no-line-break option for - ;; `base64-encode-string', only the first 76 characters - ;; are taken as a response to the server, and the - ;; authentication fails. - (encoded (base64-encode-string response t))) - (smtpmail-send-command process (format "%s" encoded)) - (if (or (null (car (setq ret (smtpmail-read-response process)))) - (not (integerp (car ret))) - (>= (car ret) 400)) - (throw 'done nil))))) - ((eq mech 'login) - (smtpmail-send-command process "AUTH LOGIN") - (if (or (null (car (setq ret (smtpmail-read-response process)))) - (not (integerp (car ret))) - (>= (car ret) 400)) - (throw 'done nil)) - (smtpmail-send-command - process (base64-encode-string (smtpmail-cred-user cred) t)) - (if (or (null (car (setq ret (smtpmail-read-response process)))) - (not (integerp (car ret))) - (>= (car ret) 400)) - (throw 'done nil)) - (smtpmail-send-command process (base64-encode-string passwd t)) - (if (or (null (car (setq ret (smtpmail-read-response process)))) - (not (integerp (car ret))) - (>= (car ret) 400)) - (throw 'done nil))) - ((eq mech 'plain) - ;; We used to send an empty initial request, and wait for an - ;; empty response, and then send the password, but this - ;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this - ;; is not sent if the server did not advertise AUTH PLAIN in - ;; the EHLO response. See RFC 2554 for more info. - (smtpmail-send-command process - (concat "AUTH PLAIN " - (base64-encode-string - (concat "\0" - (smtpmail-cred-user cred) - "\0" - passwd) t))) - (if (or (null (car (setq ret (smtpmail-read-response process)))) - (not (integerp (car ret))) - (not (equal (car ret) 235))) - (throw 'done nil))) - - (t - (error "Mechanism %s not implemented" mech))) - ;; Remember the password. - (when (null (smtpmail-cred-passwd cred)) - (password-cache-add prompt passwd))))) - -(defun smtpmail-via-smtp (recipient smtpmail-text-buffer) + (when (functionp password) + (setq password (funcall password))) + (cond + ((or (not mech) + (not user) + (not password)) + ;; No mechanism, or no credentials. + mech) + ((eq mech 'cram-md5) + (setq ret (smtpmail-command-or-throw process "AUTH CRAM-MD5")) + (when (eq (car ret) 334) + (let* ((challenge (substring (cadr ret) 4)) + (decoded (base64-decode-string challenge)) + (hash (rfc2104-hash 'md5 64 16 password decoded)) + (response (concat user " " hash)) + ;; Osamu Yamane : + ;; SMTP auth fails because the SMTP server identifies + ;; only the first part of the string (delimited by + ;; new line characters) as a response from the + ;; client, and the rest as distinct commands. + + ;; In my case, the response string is 80 characters + ;; long. Without the no-line-break option for + ;; `base64-encode-string', only the first 76 characters + ;; are taken as a response to the server, and the + ;; authentication fails. + (encoded (base64-encode-string response t))) + (smtpmail-command-or-throw process encoded) + (when save-function + (funcall save-function))))) + ((eq mech 'login) + (smtpmail-command-or-throw process "AUTH LOGIN") + (smtpmail-command-or-throw + process (base64-encode-string user t)) + (smtpmail-command-or-throw process (base64-encode-string password t)) + (when save-function + (funcall save-function))) + ((eq mech 'plain) + ;; We used to send an empty initial request, and wait for an + ;; empty response, and then send the password, but this + ;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this + ;; is not sent if the server did not advertise AUTH PLAIN in + ;; the EHLO response. See RFC 2554 for more info. + (smtpmail-command-or-throw + process + (concat "AUTH PLAIN " + (base64-encode-string (concat "\0" user "\0" password) t)) + 235) + (when save-function + (funcall save-function))) + (t + (error "Mechanism %s not implemented" mech))))) + +(defun smtpmail-response-code (string) + (when string + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (and (re-search-forward "^\\([0-9]+\\) " nil t) + (string-to-number (match-string 1)))))) + +(defun smtpmail-ok-p (response &optional code) + (and (car response) + (integerp (car response)) + (< (car response) 400) + (or (null code) + (= code (car response))))) + +(defun smtpmail-response-text (response) + (mapconcat 'identity (cdr response) "\n")) + +(defun smtpmail-query-smtp-server () + (let ((server (read-string "Outgoing SMTP mail server: ")) + (ports '(587 "smtp")) + stream port) + (when (and smtpmail-smtp-server + (not (member smtpmail-smtp-server ports))) + (push smtpmail-smtp-server ports)) + (while (and (not smtpmail-smtp-server) + (setq port (pop ports))) + (when (setq stream (ignore-errors + (open-network-stream "smtp" nil server port))) + (customize-save-variable 'smtpmail-smtp-server server) + (customize-save-variable 'smtpmail-smtp-service port) + (delete-process stream))) + (unless smtpmail-smtp-server + (error "Couldn't contact an SMTP server")))) + +(defun smtpmail-via-smtp (recipient smtpmail-text-buffer + &optional ask-for-password) + (unless smtpmail-smtp-server + (smtpmail-query-smtp-server)) (let ((process nil) (host (or smtpmail-smtp-server (error "`smtpmail-smtp-server' not defined"))) @@ -654,14 +593,16 @@ (mail-envelope-from)) user-mail-address)) response-code - greeting process-buffer + result + auth-mechanisms (supported-extensions '())) (unwind-protect (catch 'done ;; get or create the trace buffer (setq process-buffer - (get-buffer-create (format "*trace of SMTP session to %s*" host))) + (get-buffer-create + (format "*trace of SMTP session to %s*" host))) ;; clear the trace buffer of old output (with-current-buffer process-buffer @@ -669,105 +610,88 @@ (erase-buffer)) ;; open the connection to the server - (setq process (smtpmail-open-stream process-buffer host port)) - (and (null process) (throw 'done nil)) + (setq result + (open-network-stream + "smtpmail" process-buffer host port + :type smtpmail-stream-type + :return-list t + :capability-command (format "EHLO %s\r\n" (smtpmail-fqdn)) + :end-of-command "^[0-9]+ .*\r\n" + :success "^2.*\n" + :always-query-capabilities t + :starttls-function + (lambda (capabilities) + (and (string-match "-STARTTLS" capabilities) + "STARTTLS\r\n")) + :client-certificate t)) + + ;; If we couldn't access the server at all, we give up. + (unless (setq process (car result)) + (throw 'done "Unable to contact server")) ;; set the send-filter (set-process-filter process 'smtpmail-process-filter) + (let* ((greeting (plist-get (cdr result) :greeting)) + (code (smtpmail-response-code greeting))) + (unless code + (throw 'done (format "No greeting: %s" greeting))) + (when (>= code 400) + (throw 'done (format "Connection not allowed: %s" greeting)))) + (with-current-buffer process-buffer (set-buffer-process-coding-system 'raw-text-unix 'raw-text-unix) (make-local-variable 'smtpmail-read-point) (setq smtpmail-read-point (point-min)) - - (if (or (null (car (setq greeting (smtpmail-read-response process)))) - (not (integerp (car greeting))) - (>= (car greeting) 400)) - (throw 'done nil)) - - (let ((do-ehlo t) - (do-starttls t)) - (while do-ehlo - ;; EHLO - (smtpmail-send-command process (format "EHLO %s" (smtpmail-fqdn))) - - (if (or (null (car (setq response-code - (smtpmail-read-response process)))) - (not (integerp (car response-code))) - (>= (car response-code) 400)) - (progn - ;; HELO - (smtpmail-send-command - process (format "HELO %s" (smtpmail-fqdn))) - - (if (or (null (car (setq response-code - (smtpmail-read-response process)))) - (not (integerp (car response-code))) - (>= (car response-code) 400)) - (throw 'done nil))) - (dolist (line (cdr (cdr response-code))) - (let ((name - (with-case-table ascii-case-table - (mapcar (lambda (s) (intern (downcase s))) - (split-string (substring line 4) "[ ]"))))) - (and (eq (length name) 1) - (setq name (car name))) - (and name - (cond ((memq (if (consp name) (car name) name) - '(verb xvrb 8bitmime onex xone - expn size dsn etrn - enhancedstatuscodes - help xusr - auth=login auth starttls)) - (setq supported-extensions - (cons name supported-extensions))) - (smtpmail-warn-about-unknown-extensions - (message "Unknown extension %s" name))))))) - - (if (and do-starttls - (smtpmail-find-credentials smtpmail-starttls-credentials host port) - (member 'starttls supported-extensions) - (numberp (process-id process))) - (progn - (smtpmail-send-command process (format "STARTTLS")) - (if (or (null (car (setq response-code (smtpmail-read-response process)))) - (not (integerp (car response-code))) - (>= (car response-code) 400)) - (throw 'done nil)) - (starttls-negotiate process) - (setq do-starttls nil)) - (setq do-ehlo nil)))) - - (smtpmail-try-auth-methods process supported-extensions host port) - - (if (or (member 'onex supported-extensions) - (member 'xone supported-extensions)) - (progn - (smtpmail-send-command process (format "ONEX")) - (if (or (null (car (setq response-code (smtpmail-read-response process)))) - (not (integerp (car response-code))) - (>= (car response-code) 400)) - (throw 'done nil)))) - - (if (and smtpmail-debug-verb - (or (member 'verb supported-extensions) - (member 'xvrb supported-extensions))) - (progn - (smtpmail-send-command process (format "VERB")) - (if (or (null (car (setq response-code (smtpmail-read-response process)))) - (not (integerp (car response-code))) - (>= (car response-code) 400)) - (throw 'done nil)))) - - (if (member 'xusr supported-extensions) - (progn - (smtpmail-send-command process (format "XUSR")) - (if (or (null (car (setq response-code (smtpmail-read-response process)))) - (not (integerp (car response-code))) - (>= (car response-code) 400)) - (throw 'done nil)))) - + (let* ((capabilities (plist-get (cdr result) :capabilities)) + (code (smtpmail-response-code capabilities))) + (if (or (null code) + (>= code 400)) + ;; The server didn't accept EHLO, so we fall back on HELO. + (smtpmail-command-or-throw + process (format "HELO %s" (smtpmail-fqdn))) + ;; EHLO was successful, so we parse the extensions. + (dolist (line (delete + "" + (split-string + (plist-get (cdr result) :capabilities) + "\r\n"))) + (let ((name + (with-case-table ascii-case-table + (mapcar (lambda (s) (intern (downcase s))) + (split-string (substring line 4) "[ ]"))))) + (when (= (length name) 1) + (setq name (car name))) + (when name + (cond ((memq (if (consp name) (car name) name) + '(verb xvrb 8bitmime onex xone + expn size dsn etrn + enhancedstatuscodes + help xusr + auth=login auth starttls)) + (setq supported-extensions + (cons name supported-extensions))) + (smtpmail-warn-about-unknown-extensions + (message "Unknown extension %s" name)))))))) + + (setq auth-mechanisms + (smtpmail-try-auth-methods + process supported-extensions host port + ask-for-password)) + + (when (or (member 'onex supported-extensions) + (member 'xone supported-extensions)) + (smtpmail-command-or-throw process (format "ONEX"))) + + (when (and smtpmail-debug-verb + (or (member 'verb supported-extensions) + (member 'xvrb supported-extensions))) + (smtpmail-command-or-throw process (format "VERB"))) + + (when (member 'xusr supported-extensions) + (smtpmail-command-or-throw process (format "XUSR"))) + ;; MAIL FROM: (let ((size-part (if (or (member 'size supported-extensions) @@ -797,65 +721,53 @@ " BODY=8BITMIME" "") ""))) - ;; (smtpmail-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtpmail-fqdn))) - (smtpmail-send-command process (format "MAIL FROM:<%s>%s%s" - envelope-from - size-part - body-part)) - - (if (or (null (car (setq response-code (smtpmail-read-response process)))) - (not (integerp (car response-code))) - (>= (car response-code) 400)) - (throw 'done nil))) + (smtpmail-command-or-throw + process (format "MAIL FROM:<%s>%s%s" + envelope-from size-part body-part))) ;; RCPT TO: (let ((n 0)) (while (not (null (nth n recipient))) - (smtpmail-send-command process (format "RCPT TO:<%s>" (smtpmail-maybe-append-domain (nth n recipient)))) - (setq n (1+ n)) - - (setq response-code (smtpmail-read-response process)) - (if (or (null (car response-code)) - (not (integerp (car response-code))) - (>= (car response-code) 400)) - (throw 'done nil)))) - - ;; DATA - (smtpmail-send-command process "DATA") - - (if (or (null (car (setq response-code (smtpmail-read-response process)))) - (not (integerp (car response-code))) - (>= (car response-code) 400)) - (throw 'done nil)) - - ;; Mail contents + (smtpmail-send-command + process (format "RCPT TO:<%s>" + (smtpmail-maybe-append-domain + (nth n recipient)))) + (cond + ((smtpmail-ok-p (setq result (smtpmail-read-response process))) + ;; Success. + nil) + ((and auth-mechanisms + (not ask-for-password) + (= (car result) 550)) + ;; We got a "550 relay not permitted", and the server + ;; accepts credentials, so we try again, but ask for a + ;; password first. + (smtpmail-send-command process "QUIT") + (smtpmail-read-response process) + (delete-process process) + (throw 'done + (smtpmail-via-smtp recipient smtpmail-text-buffer t))) + (t + ;; Return the error code. + (throw 'done + (smtpmail-response-text result)))) + (setq n (1+ n)))) + + ;; Send the contents. + (smtpmail-command-or-throw process "DATA") (smtpmail-send-data process smtpmail-text-buffer) - ;; DATA end "." - (smtpmail-send-command process ".") - - (if (or (null (car (setq response-code (smtpmail-read-response process)))) - (not (integerp (car response-code))) - (>= (car response-code) 400)) - (throw 'done nil)) - - ;; QUIT - ;; (smtpmail-send-command process "QUIT") - ;; (and (null (car (smtpmail-read-response process))) - ;; (throw 'done nil)) - t)) - (if process - (with-current-buffer (process-buffer process) - (smtpmail-send-command process "QUIT") - (smtpmail-read-response process) - - ;; (if (or (null (car (setq response-code (smtpmail-read-response process)))) - ;; (not (integerp (car response-code))) - ;; (>= (car response-code) 400)) - ;; (throw 'done nil)) - (delete-process process) - (unless smtpmail-debug-info - (kill-buffer process-buffer))))))) + (smtpmail-command-or-throw process ".") + ;; Return success. + nil)) + (when (and process + (buffer-live-p process-buffer)) + (with-current-buffer (process-buffer process) + (smtpmail-send-command process "QUIT") + (smtpmail-read-response process) + (delete-process process) + (unless smtpmail-debug-info + (kill-buffer process-buffer))))))) (defun smtpmail-process-filter (process output) ------------------------------------------------------------ revno: 104664 committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Tue 2011-06-21 23:00:45 +0200 message: (network-stream-certificate): Change cert-cert to cert and cert-key to key. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-21 20:39:08 +0000 +++ lisp/ChangeLog 2011-06-21 21:00:45 +0000 @@ -5,6 +5,8 @@ STARTTLS. (auth-source): Require. (open-network-stream): Document the :client-certificate keyword. + (network-stream-certificate): Change cert-cert to cert and + cert-key to key. 2011-06-21 Michael Albinus === modified file 'lisp/net/network-stream.el' --- lisp/net/network-stream.el 2011-06-21 20:39:08 +0000 +++ lisp/net/network-stream.el 2011-06-21 21:00:45 +0000 @@ -171,8 +171,8 @@ (car (auth-source-search :max 1 :host host :port service))) - (key (plist-get auth-info :cert-key)) - (cert (plist-get auth-info :cert-cert))) + (key (plist-get auth-info :key)) + (cert (plist-get auth-info :cert))) (and key cert (list key cert))))))) @@ -231,8 +231,8 @@ ;; the command line. (when cert (setq starttls-extra-arguments - (nconc (list "--x509keyfile" (nth 0 cert) - "--x509certfile" (nth 1 cert)) + (nconc (list "--x509keyfile" (expand-file-name (nth 0 cert)) + "--x509certfile" (expand-file-name (nth 1 cert))) starttls-extra-arguments))) (setq stream (starttls-open-stream name buffer host service))) (network-stream-get-response stream start eoc)) ------------------------------------------------------------ revno: 104663 committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Tue 2011-06-21 22:51:45 +0200 message: Prefer the ~/.authinfo file over the ~/.authinfo.gpg file, especially when saving. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2011-06-18 22:23:55 +0000 +++ lisp/gnus/ChangeLog 2011-06-21 20:51:45 +0000 @@ -1,3 +1,10 @@ +2011-06-21 Lars Magne Ingebrigtsen + + * auth-source.el (auth-source-netrc-create): Don't print all tokens in + %S format, since that looks odd. + (auth-sources): Prefer the ~/.authinfo file over the ~/.authinfo.gpg + file, especially when saving. + 2011-06-18 Teodor Zlatanov * auth-source.el (auth-source-netrc-use-gpg-tokens): Replace === modified file 'lisp/gnus/auth-source.el' --- lisp/gnus/auth-source.el 2011-06-18 22:23:55 +0000 +++ lisp/gnus/auth-source.el 2011-06-21 20:51:45 +0000 @@ -208,7 +208,7 @@ (function :tag "Function that takes arguments like `message'") (const :tag "Don't log anything" nil))) -(defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo" "~/.netrc") +(defcustom auth-sources '("~/.authinfo" "~/.authinfo.gpg" "~/.netrc") "List of authentication sources. The default will get login and password information from @@ -1281,7 +1281,7 @@ (let ((printer (lambda () ;; append the key (the symbol name of r) ;; and the value in r - (format "%s%s %S" + (format "%s%s %s" ;; prepend a space (if (zerop (length add)) "" " ") ;; remap auth-source tokens to netrc @@ -1291,8 +1291,9 @@ (secret "password") (port "port") ; redundant but clearer (t (symbol-name r))) - ;; the value will be printed in %S format - data)))) + (if (string-match "[\" ]" data) + (format "%S" data) + data))))) (setq add (concat add (funcall printer))))))) (plist-put ------------------------------------------------------------ revno: 104662 committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Tue 2011-06-21 22:39:08 +0200 message: Add support for client certificates for built-in and external STARTTLS. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-21 19:51:26 +0000 +++ lisp/ChangeLog 2011-06-21 20:39:08 +0000 @@ -1,3 +1,11 @@ +2011-06-21 Lars Magne Ingebrigtsen + + * net/network-stream.el (network-stream-open-starttls): Provide + support for client certificates both for external and built-in + STARTTLS. + (auth-source): Require. + (open-network-stream): Document the :client-certificate keyword. + 2011-06-21 Michael Albinus * net/tramp-cache.el (top): Don't load the persistency file when === modified file 'lisp/net/network-stream.el' --- lisp/net/network-stream.el 2011-06-15 20:44:45 +0000 +++ lisp/net/network-stream.el 2011-06-21 20:39:08 +0000 @@ -44,6 +44,7 @@ (require 'tls) (require 'starttls) +(require 'auth-source) (declare-function gnutls-negotiate "gnutls" t t) ; defun* @@ -110,10 +111,17 @@ STARTTLS if the server supports STARTTLS, and nil otherwise. :always-query-capabilies says whether to query the server for -capabilities, even if we're doing a `plain' network connection. + capabilities, even if we're doing a `plain' network connection. + +:client-certificate should either be a list where the first + element is the certificate key file name, and the second + element is the certificate file name itself, or `t', which + means that `auth-source' will be queried for the key and the + certificate. This parameter will only be used when doing TLS + or STARTTLS connections. :nowait is a boolean that says the connection should be made -asynchronously, if possible." + asynchronously, if possible." (unless (featurep 'make-network-process) (error "Emacs was compiled without networking support")) (let ((type (plist-get parameters :type)) @@ -152,6 +160,22 @@ :type (nth 3 result)) (car result)))))) +(defun network-stream-certificate (host service parameters) + (let ((spec (plist-get :client-certificate parameters))) + (cond + ((listp spec) + ;; Either nil or a list with a key/certificate pair. + spec) + ((eq spec t) + (let* ((auth-info + (car (auth-source-search :max 1 + :host host + :port service))) + (key (plist-get auth-info :cert-key)) + (cert (plist-get auth-info :cert-cert))) + (and key cert + (list key cert))))))) + ;;;###autoload (defalias 'open-protocol-stream 'open-network-stream) @@ -201,14 +225,24 @@ starttls-extra-arguments ;; For opportunistic TLS upgrades, we don't really ;; care about the identity of the peer. - (cons "--insecure" starttls-extra-arguments)))) + (cons "--insecure" starttls-extra-arguments))) + (cert (network-stream-certificate host service parameters))) + ;; There are client certificates requested, so add them to + ;; the command line. + (when cert + (setq starttls-extra-arguments + (nconc (list "--x509keyfile" (nth 0 cert) + "--x509certfile" (nth 1 cert)) + starttls-extra-arguments))) (setq stream (starttls-open-stream name buffer host service))) (network-stream-get-response stream start eoc)) (when (string-match success-string (network-stream-command stream starttls-command eoc)) ;; The server said it was OK to begin STARTTLS negotiations. (if (fboundp 'open-gnutls-stream) - (gnutls-negotiate :process stream :hostname host) + (let ((cert (network-stream-certificate host service parameters))) + (gnutls-negotiate :process stream :hostname host + :keylist (and cert (list cert)))) (unless (starttls-negotiate stream) (delete-process stream))) (if (memq (process-status stream) '(open run)) ------------------------------------------------------------ revno: 104661 committer: Michael Albinus branch nick: trunk timestamp: Tue 2011-06-21 21:51:26 +0200 message: * net/tramp-cache.el (top): Don't load the persistency file when "emacs -Q" has been called. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-21 18:45:36 +0000 +++ lisp/ChangeLog 2011-06-21 19:51:26 +0000 @@ -1,3 +1,8 @@ +2011-06-21 Michael Albinus + + * net/tramp-cache.el (top): Don't load the persistency file when + "emacs -Q" has been called. + 2011-06-21 Tim Harper * term/ns-win.el (ns-initialize-window-system): set === modified file 'lisp/net/tramp-cache.el' --- lisp/net/tramp-cache.el 2011-05-23 17:57:17 +0000 +++ lisp/net/tramp-cache.el 2011-06-21 19:51:26 +0000 @@ -177,9 +177,9 @@ (tramp-message vec 8 "%s" directory) (maphash (lambda (key value) - (when (and (stringp (tramp-file-name-localname key)) - (string-match directory (tramp-file-name-localname key))) - (remhash key tramp-cache-data))) + (when (and (stringp (tramp-file-name-localname key)) + (string-match directory (tramp-file-name-localname key))) + (remhash key tramp-cache-data))) tramp-cache-data))) ;; Reverting or killing a buffer should also flush file properties. @@ -200,12 +200,12 @@ (add-hook 'kill-buffer-hook 'tramp-flush-file-function) (add-hook 'tramp-cache-unload-hook (lambda () - (remove-hook 'before-revert-hook - 'tramp-flush-file-function) - (remove-hook 'eshell-pre-command-hook - 'tramp-flush-file-function) - (remove-hook 'kill-buffer-hook - 'tramp-flush-file-function))) + (remove-hook 'before-revert-hook + 'tramp-flush-file-function) + (remove-hook 'eshell-pre-command-hook + 'tramp-flush-file-function) + (remove-hook 'kill-buffer-hook + 'tramp-flush-file-function))) ;;; -- Properties -- @@ -290,17 +290,17 @@ (let (result) (maphash (lambda (key value) - (let ((tmp (format - "(%s %s)" - (if (processp key) - (prin1-to-string (prin1-to-string key)) - (prin1-to-string key)) - (if (hash-table-p value) - (tramp-cache-print value) - (if (bufferp value) - (prin1-to-string (prin1-to-string value)) - (prin1-to-string value)))))) - (setq result (if result (concat result " " tmp) tmp)))) + (let ((tmp (format + "(%s %s)" + (if (processp key) + (prin1-to-string (prin1-to-string key)) + (prin1-to-string key)) + (if (hash-table-p value) + (tramp-cache-print value) + (if (bufferp value) + (prin1-to-string (prin1-to-string value)) + (prin1-to-string value)))))) + (setq result (if result (concat result " " tmp) tmp)))) table) result))) @@ -310,8 +310,8 @@ (let (result) (maphash (lambda (key value) - (when (and (vectorp key) (null (aref key 3))) - (add-to-list 'result key))) + (when (and (vectorp key) (null (aref key 3))) + (add-to-list 'result key))) tramp-cache-data) result)) @@ -327,12 +327,12 @@ ;; Remove temporary data. (maphash (lambda (key value) - (if (and (vectorp key) (not (tramp-file-name-localname key))) - (progn - (remhash "process-name" value) - (remhash "process-buffer" value) - (remhash "first-password-request" value)) - (remhash key cache))) + (if (and (vectorp key) (not (tramp-file-name-localname key))) + (progn + (remhash "process-name" value) + (remhash "process-buffer" value) + (remhash "first-password-request" value)) + (remhash key cache))) cache) ;; Dump it. (with-temp-buffer @@ -357,8 +357,8 @@ (add-hook 'kill-emacs-hook 'tramp-dump-connection-properties)) (add-hook 'tramp-cache-unload-hook (lambda () - (remove-hook 'kill-emacs-hook - 'tramp-dump-connection-properties))) + (remove-hook 'kill-emacs-hook + 'tramp-dump-connection-properties))) ;;;###tramp-autoload (defun tramp-parse-connection-properties (method) @@ -368,18 +368,22 @@ (let (res) (maphash (lambda (key value) - (if (and (vectorp key) - (string-equal method (tramp-file-name-method key)) - (not (tramp-file-name-localname key))) - (push (list (tramp-file-name-user key) - (tramp-file-name-host key)) - res))) + (if (and (vectorp key) + (string-equal method (tramp-file-name-method key)) + (not (tramp-file-name-localname key))) + (push (list (tramp-file-name-user key) + (tramp-file-name-host key)) + res))) tramp-cache-data) res)) ;; Read persistent connection history. (when (and (stringp tramp-persistency-file-name) - (zerop (hash-table-count tramp-cache-data))) + (zerop (hash-table-count tramp-cache-data)) + ;; When "emacs -Q" has been called, both variables are nil. + ;; We do not load the persistency file then, in order to + ;; have a clean test environment. + (or init-file-user site-run-file)) (condition-case err (with-temp-buffer (insert-file-contents tramp-persistency-file-name) ------------------------------------------------------------ revno: 104660 committer: David Reitter branch nick: trunk timestamp: Tue 2011-06-21 11:45:36 -0700 message: ns-win: set ApplePressAndHoldEnabled to NO as it is unsupported. This is in preparation for OS X "Lion"; it is a stop-gap solution until this new input mechanism is supported correctly. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-21 15:16:32 +0000 +++ lisp/ChangeLog 2011-06-21 18:45:36 +0000 @@ -1,3 +1,9 @@ +2011-06-21 Tim Harper + + * term/ns-win.el (ns-initialize-window-system): set + application-specific `ApplePressAndHoldEnabled' system + resource to NO as it is not yet supported by the NS port. + 2011-06-21 Juanma Barranquero * misc.el (list-dynamic-libraries--refresh): Compute header here... === modified file 'lisp/term/ns-win.el' --- lisp/term/ns-win.el 2011-01-31 23:54:50 +0000 +++ lisp/term/ns-win.el 2011-06-21 18:45:36 +0000 @@ -916,6 +916,11 @@ ;; FIXME: This will surely lead to "MODIFIED OUTSIDE CUSTOM" warnings. (menu-bar-mode (if (get-lisp-resource nil "Menus") 1 -1)) + ;; OS X Lion introduces PressAndHold, which is unsupported by this port. + ;; See this thread for more details: + ;; http://lists.gnu.org/archive/html/emacs-devel/2011-06/msg00505.html + (ns-set-resource nil "ApplePressAndHoldEnabled" "NO") + (setq ns-initialized t)) (add-to-list 'handle-args-function-alist '(ns . x-handle-args)) ------------------------------------------------------------ revno: 104659 committer: Paul Eggert branch nick: trunk timestamp: Tue 2011-06-21 09:47:56 -0700 message: Port to Sun C. * composite.c (find_automatic_composition): Omit needless 'return 0;' that Sun C diagnosed. * fns.c (secure_hash): Fix pointer signedness issue. * intervals.c (static_offset_intervals): New function. (offset_intervals): Use it. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-21 08:55:22 +0000 +++ src/ChangeLog 2011-06-21 16:47:56 +0000 @@ -1,3 +1,12 @@ +2011-06-21 Paul Eggert + + Port to Sun C. + * composite.c (find_automatic_composition): Omit needless 'return 0;' + that Sun C diagnosed. + * fns.c (secure_hash): Fix pointer signedness issue. + * intervals.c (static_offset_intervals): New function. + (offset_intervals): Use it. + 2011-06-21 Leo Liu * deps.mk (fns.o): === modified file 'src/composite.c' --- src/composite.c 2011-06-13 01:35:47 +0000 +++ src/composite.c 2011-06-21 16:47:56 +0000 @@ -1676,7 +1676,6 @@ } BACKWARD_CHAR (cur, stop); } - return 0; } /* Return the adjusted point provided that point is moved from LAST_PT === modified file 'src/fns.c' --- src/fns.c 2011-06-21 08:55:22 +0000 +++ src/fns.c 2011-06-21 16:47:56 +0000 @@ -4802,7 +4802,7 @@ return digest; } else - return make_unibyte_string (SDATA (digest), digest_size); + return make_unibyte_string (SSDATA (digest), digest_size); } DEFUN ("md5", Fmd5, Smd5, 1, 5, 0, === modified file 'src/intervals.c' --- src/intervals.c 2011-06-06 19:43:39 +0000 +++ src/intervals.c 2011-06-21 16:47:56 +0000 @@ -1425,10 +1425,15 @@ /* Make the adjustments necessary to the interval tree of BUFFER to represent an addition or deletion of LENGTH characters starting at position START. Addition or deletion is indicated by the sign - of LENGTH. */ - -inline void -offset_intervals (struct buffer *buffer, EMACS_INT start, EMACS_INT length) + of LENGTH. + + The two inline functions (one static) pacify Sun C 5.8, a pre-C99 + compiler that does not allow calling a static function (here, + adjust_intervals_for_deletion) from a non-static inline function. */ + +static inline void +static_offset_intervals (struct buffer *buffer, EMACS_INT start, + EMACS_INT length) { if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) || length == 0) return; @@ -1441,6 +1446,12 @@ adjust_intervals_for_deletion (buffer, start, -length); } } + +inline void +offset_intervals (struct buffer *buffer, EMACS_INT start, EMACS_INT length) +{ + static_offset_intervals (buffer, start, length); +} /* Merge interval I with its lexicographic successor. The resulting interval is returned, and has the properties of the original ------------------------------------------------------------ revno: 104658 committer: martin rudalics branch nick: trunk timestamp: Tue 2011-06-21 17:16:32 +0200 message: Don't make popup frames unsplittable by default. (display-buffer-alist, display-buffer-default-specifiers): Don't make new frame unsplittable by default. (display-buffer-normalize-argument): Fix doc-string typo and use 'same-frame-other-window instead of 'other-window when associating with display-buffer-macro-specifiers. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-21 10:04:28 +0000 +++ lisp/ChangeLog 2011-06-21 15:16:32 +0000 @@ -20,6 +20,11 @@ options more faithfully. (pop-to-buffer): Don't rely on `display-buffer' selecting the window if it is on another frame. + (display-buffer-alist, display-buffer-default-specifiers): Don't + make new frame unsplittable by default. + (display-buffer-normalize-argument): Fix doc-string typo and use + 'same-frame-other-window instead of 'other-window when associating + with display-buffer-macro-specifiers. 2011-06-21 Vincent Belaïche === modified file 'lisp/window.el' --- lisp/window.el 2011-06-21 08:51:30 +0000 +++ lisp/window.el 2011-06-21 15:16:32 +0000 @@ -3821,7 +3821,7 @@ (pop-up-window-min-width . 80) (reuse-window other nil nil) (pop-up-frame-alist - (height . 24) (width . 80) (unsplittable . t)) + (height . 24) (width . 80)) (reuse-window nil other visible) (reuse-window nil nil t) (reuse-window-even-sizes . t)) @@ -4372,8 +4372,7 @@ :tag "Pop-up frame" :value (pop-up-frame (pop-up-frame) - (pop-up-frame-alist - (height . 24) (width . 80) (unsplittable . t))) + (pop-up-frame-alist (height . 24) (width . 80))) :format "%t\n%v" :inline t (const :format "" pop-up-frame) @@ -5306,7 +5305,7 @@ BUFFER-NAME is the name of the buffer that shall be displayed, SPECIFIERS is the second argument of `display-buffer'. LABEL the same argument of `display-buffer'. OTHER-FRAME non-nil means use -other-frame for other-windo." +other-frame for other-window." (let (normalized entry) (cond ((not specifiers) @@ -5321,7 +5320,7 @@ ;; `other-window' must be treated separately. (let ((entry (assq (if other-frame 'other-frame - 'other-window) + 'same-frame-other-window) display-buffer-macro-specifiers))) (dolist (item (cdr entry)) (setq normalized (cons item normalized))))) @@ -5434,14 +5433,16 @@ (when (listp pars) pars)) specifiers))))) - ;; `pop-up-frames', `display-buffer-reuse-frames', and - ;; `last-nonminibuffer-frame' set means search for a window shoing - ;; the same buffer of another frame. + ;; `pop-up-frames', `display-buffer-reuse-frames' means search for + ;; a window showing the buffer on some visible or iconfied frame. + ;; `last-nonminibuffer-frame' set and not the same frame means + ;; search that frame. (let ((frames (or (and (or use-pop-up-frames display-buffer-reuse-frames (not (last-nonminibuffer-frame))) ;; All visible or iconfied frames. 0) + ;; Same frame. (last-nonminibuffer-frame)))) (when frames (setq specifiers ------------------------------------------------------------ revno: 104657 committer: Glenn Morris branch nick: trunk timestamp: Tue 2011-06-21 06:18:39 -0400 message: Auto-commit of generated files. diff: === modified file 'autogen/Makefile.in' --- autogen/Makefile.in 2011-06-16 10:18:50 +0000 +++ autogen/Makefile.in 2011-06-21 10:18:39 +0000 @@ -24,7 +24,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files careadlinkat crypto/md5 crypto/sha1 dtoastr filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink socklen stdarg stdio strftime strtoumax symlink sys_stat +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink socklen stdarg stdio strftime strtoumax symlink sys_stat VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ @@ -59,7 +59,8 @@ $(top_srcdir)/m4/longlong.m4 $(top_srcdir)/m4/lstat.m4 \ $(top_srcdir)/m4/md5.m4 $(top_srcdir)/m4/mktime.m4 \ $(top_srcdir)/m4/multiarch.m4 $(top_srcdir)/m4/readlink.m4 \ - $(top_srcdir)/m4/sha1.m4 $(top_srcdir)/m4/socklen.m4 \ + $(top_srcdir)/m4/sha1.m4 $(top_srcdir)/m4/sha256.m4 \ + $(top_srcdir)/m4/sha512.m4 $(top_srcdir)/m4/socklen.m4 \ $(top_srcdir)/m4/ssize_t.m4 $(top_srcdir)/m4/st_dm_mode.m4 \ $(top_srcdir)/m4/stat.m4 $(top_srcdir)/m4/stdarg.m4 \ $(top_srcdir)/m4/stdbool.m4 $(top_srcdir)/m4/stddef_h.m4 \ @@ -82,11 +83,12 @@ libgnu_a_AR = $(AR) $(ARFLAGS) am__DEPENDENCIES_1 = am__libgnu_a_SOURCES_DIST = allocator.c careadlinkat.c md5.c sha1.c \ - dtoastr.c filemode.c gettext.h strftime.c + sha256.c sha512.c dtoastr.c filemode.c gettext.h strftime.c am__objects_1 = am_libgnu_a_OBJECTS = allocator.$(OBJEXT) careadlinkat.$(OBJEXT) \ - md5.$(OBJEXT) sha1.$(OBJEXT) dtoastr.$(OBJEXT) \ - filemode.$(OBJEXT) $(am__objects_1) strftime.$(OBJEXT) + md5.$(OBJEXT) sha1.$(OBJEXT) sha256.$(OBJEXT) sha512.$(OBJEXT) \ + dtoastr.$(OBJEXT) filemode.$(OBJEXT) $(am__objects_1) \ + strftime.$(OBJEXT) libgnu_a_OBJECTS = $(am_libgnu_a_OBJECTS) depcomp = $(SHELL) $(top_srcdir)/depcomp am__depfiles_maybe = depfiles @@ -734,14 +736,14 @@ $(STDARG_H) $(STDBOOL_H) $(STDDEF_H) $(STDINT_H) stdio.h \ stdlib.h sys/stat.h time.h unistd.h warn-on-use.h EXTRA_DIST = allocator.h $(top_srcdir)/./arg-nonnull.h \ - $(top_srcdir)/./c++defs.h careadlinkat.h md5.h sha1.h \ - dosname.h ftoastr.c ftoastr.h filemode.h getloadavg.c getopt.c \ - getopt.in.h getopt1.c getopt_int.h ignore-value.h intprops.h \ - inttypes.in.h lstat.c mktime-internal.h mktime.c readlink.c \ - stat.c stdarg.in.h stdbool.in.h stddef.in.h stdint.in.h \ - stdio.in.h stdlib.in.h strftime.h strtol.c strtoul.c \ - strtoull.c strtoimax.c strtoumax.c symlink.c sys_stat.in.h \ - time.in.h time_r.c unistd.in.h verify.h \ + $(top_srcdir)/./c++defs.h careadlinkat.h md5.h sha1.h sha256.h \ + sha512.h dosname.h ftoastr.c ftoastr.h filemode.h getloadavg.c \ + getopt.c getopt.in.h getopt1.c getopt_int.h ignore-value.h \ + intprops.h inttypes.in.h lstat.c mktime-internal.h mktime.c \ + readlink.c stat.c stdarg.in.h stdbool.in.h stddef.in.h \ + stdint.in.h stdio.in.h stdlib.in.h strftime.h strtol.c \ + strtoul.c strtoull.c strtoimax.c strtoumax.c symlink.c \ + sys_stat.in.h time.in.h time_r.c u64.h unistd.in.h verify.h \ $(top_srcdir)/./warn-on-use.h MOSTLYCLEANDIRS = sys MOSTLYCLEANFILES = core *.stackdump arg-nonnull.h arg-nonnull.h-t \ @@ -752,8 +754,8 @@ unistd.h unistd.h-t warn-on-use.h warn-on-use.h-t noinst_LIBRARIES = libgnu.a DEFAULT_INCLUDES = -I. -I../src -I$(top_srcdir)/src -libgnu_a_SOURCES = allocator.c careadlinkat.c md5.c sha1.c dtoastr.c \ - filemode.c $(am__append_1) strftime.c +libgnu_a_SOURCES = allocator.c careadlinkat.c md5.c sha1.c sha256.c \ + sha512.c dtoastr.c filemode.c $(am__append_1) strftime.c libgnu_a_LIBADD = $(gl_LIBOBJS) libgnu_a_DEPENDENCIES = $(gl_LIBOBJS) EXTRA_libgnu_a_SOURCES = ftoastr.c getloadavg.c getopt.c getopt1.c \ @@ -824,6 +826,8 @@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mktime.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/readlink.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sha1.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sha256.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sha512.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/stat.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strftime.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strtoimax.Po@am__quote@ === modified file 'autogen/aclocal.m4' --- autogen/aclocal.m4 2011-05-24 16:31:25 +0000 +++ autogen/aclocal.m4 2011-06-21 10:18:39 +0000 @@ -1001,6 +1001,8 @@ m4_include([m4/multiarch.m4]) m4_include([m4/readlink.m4]) m4_include([m4/sha1.m4]) +m4_include([m4/sha256.m4]) +m4_include([m4/sha512.m4]) m4_include([m4/socklen.m4]) m4_include([m4/ssize_t.m4]) m4_include([m4/st_dm_mode.m4]) === modified file 'autogen/configure' --- autogen/configure 2011-06-19 18:33:17 +0000 +++ autogen/configure 2011-06-21 10:18:39 +0000 @@ -6541,6 +6541,8 @@ # Code from module careadlinkat: # Code from module crypto/md5: # Code from module crypto/sha1: + # Code from module crypto/sha256: + # Code from module crypto/sha512: # Code from module dosname: # Code from module dtoastr: # Code from module extensions: @@ -6575,6 +6577,7 @@ # Code from module sys_stat: # Code from module time: # Code from module time_r: + # Code from module u64: # Code from module unistd: # Code from module verify: # Code from module warn-on-use: @@ -16695,6 +16698,14 @@ + + + + + + + + # Persuade glibc to declare getloadavg(). @@ -18575,6 +18586,7 @@ + if test $gl_cv_have_include_next = yes; then gl_cv_next_unistd_h='<'unistd.h'>' else ------------------------------------------------------------ revno: 104656 committer: Juanma Barranquero branch nick: trunk timestamp: Tue 2011-06-21 12:04:28 +0200 message: lisp/misc.el (list-dynamic-libraries): Fix computation of header fields. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-21 08:55:22 +0000 +++ lisp/ChangeLog 2011-06-21 10:04:28 +0000 @@ -1,3 +1,8 @@ +2011-06-21 Juanma Barranquero + + * misc.el (list-dynamic-libraries--refresh): Compute header here... + (list-dynamic-libraries): ...not here. + 2011-06-21 Leo Liu * subr.el (sha1): Implement sha1 using secure-hash. === modified file 'lisp/misc.el' --- lisp/misc.el 2011-05-09 23:57:40 +0000 +++ lisp/misc.el 2011-06-21 10:04:28 +0000 @@ -151,6 +151,7 @@ (vector (list "Library" (1+ max-id-len) t) (list "Loaded from" (1+ max-name-len) t) (list "Candidate names" 0 t)))) + (tabulated-list-init-header) (setq tabulated-list-entries nil) (dolist (lib dynamic-library-alist) (let* ((id (car lib)) @@ -178,7 +179,6 @@ (tabulated-list-mode) (setq tabulated-list-sort-key (cons "Library" nil)) (add-hook 'tabulated-list-revert-hook 'list-dynamic-libraries--refresh nil t) - (tabulated-list-init-header) (setq list-dynamic-libraries--loaded-only-p loaded-only-p) (list-dynamic-libraries--refresh) (tabulated-list-print)) ------------------------------------------------------------ revno: 104655 committer: Leo Liu branch nick: trunk timestamp: Tue 2011-06-21 16:55:22 +0800 message: New primitive secure-hash supporting md5, sha-1 and sha-2 diff: === modified file 'etc/ChangeLog' --- etc/ChangeLog 2011-06-14 05:00:35 +0000 +++ etc/ChangeLog 2011-06-21 08:55:22 +0000 @@ -1,3 +1,7 @@ +2011-06-21 Leo Liu + + * NEWS: Mention the new primtive secure-hash. + 2011-06-14 Chong Yidong * themes/dichromacy-theme.el: New theme. === modified file 'etc/NEWS' --- etc/NEWS 2011-06-21 01:49:36 +0000 +++ etc/NEWS 2011-06-21 08:55:22 +0000 @@ -305,7 +305,8 @@ ** The variable `focus-follows-mouse' now always defaults to nil. -** Function `sha1' is now implemented in C for speed. +** New primitive `secure-hash' that supports many secure hash algorithms +including md5, sha-1 and sha-2 (sha-224, sha-256, sha-384 and sha-512). The elisp implementation sha1.el is removed. Feature sha1 is provided by default. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-21 08:29:43 +0000 +++ lisp/ChangeLog 2011-06-21 08:55:22 +0000 @@ -1,3 +1,7 @@ +2011-06-21 Leo Liu + + * subr.el (sha1): Implement sha1 using secure-hash. + 2011-06-21 Martin Rudalics * window.el (display-buffer-alist): In default value do not === modified file 'lisp/subr.el' --- lisp/subr.el 2011-06-15 17:30:41 +0000 +++ lisp/subr.el 2011-06-21 08:55:22 +0000 @@ -2600,6 +2600,14 @@ (get-char-property (1- (field-end pos)) 'field) raw-field))) +(defun sha1 (object &optional start end binary) + "Return the SHA1 (Secure Hash Algorithm) of an OBJECT. +OBJECT is either a string or a buffer. Optional arguments START and +END are character positions specifying which portion of OBJECT for +computing the hash. If BINARY is non-nil, return a string in binary +form." + (secure-hash 'sha1 object start end binary)) + ;;;; Support for yanking and text properties. === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-20 12:54:05 +0000 +++ src/ChangeLog 2011-06-21 08:55:22 +0000 @@ -1,3 +1,14 @@ +2011-06-21 Leo Liu + + * deps.mk (fns.o): + * makefile.w32-in ($(BLD)/fns.$(O)): Include sha256.h and + sha512.h. + + * fns.c (secure_hash): Rename from crypto_hash_function and change + the first arg to accept symbols. + (Fsecure_hash): New primtive. + (syms_of_fns): New symbols. + 2011-06-20 Deniz Dogan * process.c (Fset_process_buffer): Clarify return value in === modified file 'src/deps.mk' --- src/deps.mk 2011-05-24 08:22:58 +0000 +++ src/deps.mk 2011-06-21 08:55:22 +0000 @@ -284,8 +284,8 @@ floatfns.o: floatfns.c syssignal.h lisp.h globals.h $(config_h) fns.o: fns.c commands.h lisp.h $(config_h) frame.h buffer.h character.h \ keyboard.h keymap.h window.h $(INTERVALS_H) coding.h ../lib/md5.h \ - ../lib/sha1.h blockinput.h atimer.h systime.h xterm.h ../lib/unistd.h \ - globals.h + ../lib/sha1.h ../lib/sha256.h ../lib/sha512.h blockinput.h atimer.h \ + systime.h xterm.h ../lib/unistd.h globals.h print.o: print.c process.h frame.h window.h buffer.h keyboard.h character.h \ lisp.h globals.h $(config_h) termchar.h $(INTERVALS_H) msdos.h termhooks.h \ blockinput.h atimer.h systime.h font.h charset.h coding.h ccl.h \ === modified file 'src/fns.c' --- src/fns.c 2011-06-17 15:18:54 +0000 +++ src/fns.c 2011-06-21 08:55:22 +0000 @@ -51,6 +51,8 @@ static Lisp_Object Qwidget_type; static Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper; +static Lisp_Object Qmd5, Qsha1, Qsha224, Qsha256, Qsha384, Qsha512; + static int internal_equal (Lisp_Object , Lisp_Object, int, int); #ifndef HAVE_UNISTD_H @@ -4550,21 +4552,18 @@ /************************************************************************ - MD5 and SHA1 + MD5, SHA-1, and SHA-2 ************************************************************************/ #include "md5.h" #include "sha1.h" - -/* Convert a possibly-signed character to an unsigned character. This is - a bit safer than casting to unsigned char, since it catches some type - errors that the cast doesn't. */ -static inline unsigned char to_uchar (char ch) { return ch; } - -/* TYPE: 0 for md5, 1 for sha1. */ +#include "sha256.h" +#include "sha512.h" + +/* ALGORITHM is a symbol: md5, sha1, sha224 and so on. */ static Lisp_Object -crypto_hash_function (int type, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, Lisp_Object binary) +secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, Lisp_Object binary) { int i; EMACS_INT size; @@ -4574,7 +4573,11 @@ register EMACS_INT b, e; register struct buffer *bp; EMACS_INT temp; - Lisp_Object res=Qnil; + int digest_size; + void *(*hash_func) (const char *, size_t, void *); + Lisp_Object digest; + + CHECK_SYMBOL (algorithm); if (STRINGP (object)) { @@ -4745,47 +4748,61 @@ object = code_convert_string (object, coding_system, Qnil, 1, 0, 0); } - switch (type) - { - case 0: /* MD5 */ - { - char digest[16]; - md5_buffer (SSDATA (object) + start_byte, - SBYTES (object) - (size_byte - end_byte), - digest); - - if (NILP (binary)) - { - char value[33]; - for (i = 0; i < 16; i++) - sprintf (&value[2 * i], "%02x", to_uchar (digest[i])); - res = make_string (value, 32); - } - else - res = make_string (digest, 16); - break; - } - - case 1: /* SHA1 */ - { - char digest[20]; - sha1_buffer (SSDATA (object) + start_byte, - SBYTES (object) - (size_byte - end_byte), - digest); - if (NILP (binary)) - { - char value[41]; - for (i = 0; i < 20; i++) - sprintf (&value[2 * i], "%02x", to_uchar (digest[i])); - res = make_string (value, 40); - } - else - res = make_string (digest, 20); - break; - } - } - - return res; + if (EQ (algorithm, Qmd5)) + { + digest_size = MD5_DIGEST_SIZE; + hash_func = md5_buffer; + } + else if (EQ (algorithm, Qsha1)) + { + digest_size = SHA1_DIGEST_SIZE; + hash_func = sha1_buffer; + } + else if (EQ (algorithm, Qsha224)) + { + digest_size = SHA224_DIGEST_SIZE; + hash_func = sha224_buffer; + } + else if (EQ (algorithm, Qsha256)) + { + digest_size = SHA256_DIGEST_SIZE; + hash_func = sha256_buffer; + } + else if (EQ (algorithm, Qsha384)) + { + digest_size = SHA384_DIGEST_SIZE; + hash_func = sha384_buffer; + } + else if (EQ (algorithm, Qsha512)) + { + digest_size = SHA512_DIGEST_SIZE; + hash_func = sha512_buffer; + } + else + error ("Invalid algorithm arg: %s", SDATA (Fsymbol_name (algorithm))); + + /* allocate 2 x digest_size so that it can be re-used to hold the + hexified value */ + digest = make_uninit_string (digest_size * 2); + + hash_func (SSDATA (object) + start_byte, + SBYTES (object) - (size_byte - end_byte), + SSDATA (digest)); + + if (NILP (binary)) + { + unsigned char *p = SDATA (digest); + for (i = digest_size - 1; i >= 0; i--) + { + static char const hexdigit[16] = "0123456789abcdef"; + int p_i = p[i]; + p[2 * i] = hexdigit[p_i >> 4]; + p[2 * i + 1] = hexdigit[p_i & 0xf]; + } + return digest; + } + else + return make_unibyte_string (SDATA (digest), digest_size); } DEFUN ("md5", Fmd5, Smd5, 1, 5, 0, @@ -4817,25 +4834,31 @@ guesswork fails. Normally, an error is signaled in such case. */) (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror) { - return crypto_hash_function (0, object, start, end, coding_system, noerror, Qnil); + return secure_hash (Qmd5, object, start, end, coding_system, noerror, Qnil); } -DEFUN ("sha1", Fsha1, Ssha1, 1, 4, 0, - doc: /* Return the SHA-1 (Secure Hash Algorithm) of an OBJECT. - -OBJECT is either a string or a buffer. Optional arguments START and -END are character positions specifying which portion of OBJECT for -computing the hash. If BINARY is non-nil, return a string in binary -form. */) - (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object binary) +DEFUN ("secure-hash", Fsecure_hash, Ssecure_hash, 2, 5, 0, + doc: /* Return the secure hash of an OBJECT. +ALGORITHM is a symbol: md5, sha1, sha224, sha256, sha384 or sha512. +OBJECT is either a string or a buffer. +Optional arguments START and END are character positions specifying +which portion of OBJECT for computing the hash. If BINARY is non-nil, +return a string in binary form. */) + (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object binary) { - return crypto_hash_function (1, object, start, end, Qnil, Qnil, binary); + return secure_hash (algorithm, object, start, end, Qnil, Qnil, binary); } - void syms_of_fns (void) { + DEFSYM (Qmd5, "md5"); + DEFSYM (Qsha1, "sha1"); + DEFSYM (Qsha224, "sha224"); + DEFSYM (Qsha256, "sha256"); + DEFSYM (Qsha384, "sha384"); + DEFSYM (Qsha512, "sha512"); + /* Hash table stuff. */ Qhash_table_p = intern_c_string ("hash-table-p"); staticpro (&Qhash_table_p); @@ -5004,7 +5027,7 @@ defsubr (&Sbase64_encode_string); defsubr (&Sbase64_decode_string); defsubr (&Smd5); - defsubr (&Ssha1); + defsubr (&Ssecure_hash); defsubr (&Slocale_info); } === modified file 'src/makefile.w32-in' --- src/makefile.w32-in 2011-06-12 02:48:18 +0000 +++ src/makefile.w32-in 2011-06-21 08:55:22 +0000 @@ -867,6 +867,8 @@ $(EMACS_ROOT)/nt/inc/sys/time.h \ $(EMACS_ROOT)/lib/md5.h \ $(EMACS_ROOT)/lib/sha1.h \ + $(EMACS_ROOT)/lib/sha256.h \ + $(EMACS_ROOT)/lib/sha512.h \ $(LISP_H) \ $(SRC)/atimer.h \ $(SRC)/blockinput.h \ ------------------------------------------------------------ revno: 104654 committer: martin rudalics branch nick: trunk timestamp: Tue 2011-06-21 10:51:30 +0200 message: Fix last fix of display-buffer-normalize-options. diff: === modified file 'lisp/window.el' --- lisp/window.el 2011-06-21 08:29:43 +0000 +++ lisp/window.el 2011-06-21 08:51:30 +0000 @@ -5437,11 +5437,12 @@ ;; `pop-up-frames', `display-buffer-reuse-frames', and ;; `last-nonminibuffer-frame' set means search for a window shoing ;; the same buffer of another frame. - (let ((frames (or (last-nonminibuffer-frame) - (and (or use-pop-up-frames - display-buffer-reuse-frames) + (let ((frames (or (and (or use-pop-up-frames + display-buffer-reuse-frames + (not (last-nonminibuffer-frame))) ;; All visible or iconfied frames. - 0)))) + 0) + (last-nonminibuffer-frame)))) (when frames (setq specifiers (cons (list 'reuse-window 'other 'same frames) ------------------------------------------------------------ revno: 104653 committer: Leo Liu branch nick: trunk timestamp: Tue 2011-06-21 16:45:39 +0800 message: Add crypto/sha256 and crypto/sha512 modules from gnulib diff: === modified file 'ChangeLog' --- ChangeLog 2011-06-19 18:22:16 +0000 +++ ChangeLog 2011-06-21 08:45:39 +0000 @@ -1,3 +1,18 @@ +2011-06-21 Leo Liu + + * m4/sha256.m4: + * m4/sha512.m4: + * m4/gl-comp.m4: + * lib/u64.h: + * lib/sha256.c: + * lib/sha256.h: + * lib/sha512.c: + * lib/sha512.h: + * lib/makefile.w32-in (GNULIBOBJS): + * lib/gnulib.mk: + * Makefile.in (GNULIB_MODULES): Add crypto/sha256 and + crypto/sha512 modules from gnulib. + 2011-06-19 Paul Eggert * lib/unistd.in.h, m4/getloadavg.m4: Merge from gnulib. === modified file 'Makefile.in' --- Makefile.in 2011-05-24 20:09:08 +0000 +++ Makefile.in 2011-06-21 08:45:39 +0000 @@ -332,8 +332,8 @@ # $(gnulib_srcdir) (relative to $(srcdir) and should have build tools # as per $(gnulib_srcdir)/DEPENDENCIES. GNULIB_MODULES = \ - careadlinkat crypto/md5 crypto/sha1 dtoastr filemode getloadavg \ - getopt-gnu ignore-value intprops lstat mktime readlink \ + careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr \ + filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink \ socklen stdarg stdio strftime strtoumax symlink sys_stat GNULIB_TOOL_FLAGS = \ --conditional-dependencies --import --no-changelog --no-vc-files \ === modified file 'lib/gnulib.mk' --- lib/gnulib.mk 2011-06-15 22:27:54 +0000 +++ lib/gnulib.mk 2011-06-21 08:45:39 +0000 @@ -9,7 +9,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files careadlinkat crypto/md5 crypto/sha1 dtoastr filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink socklen stdarg stdio strftime strtoumax symlink sys_stat +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink socklen stdarg stdio strftime strtoumax symlink sys_stat MOSTLYCLEANFILES += core *.stackdump @@ -101,6 +101,22 @@ ## end gnulib module crypto/sha1 +## begin gnulib module crypto/sha256 + +libgnu_a_SOURCES += sha256.c + +EXTRA_DIST += sha256.h + +## end gnulib module crypto/sha256 + +## begin gnulib module crypto/sha512 + +libgnu_a_SOURCES += sha512.c + +EXTRA_DIST += sha512.h + +## end gnulib module crypto/sha512 + ## begin gnulib module dosname if gl_GNULIB_ENABLED_dosname @@ -759,6 +775,13 @@ ## end gnulib module time_r +## begin gnulib module u64 + + +EXTRA_DIST += u64.h + +## end gnulib module u64 + ## begin gnulib module unistd BUILT_SOURCES += unistd.h === modified file 'lib/makefile.w32-in' --- lib/makefile.w32-in 2011-05-29 21:52:18 +0000 +++ lib/makefile.w32-in 2011-06-21 08:45:39 +0000 @@ -30,6 +30,8 @@ $(BLD)/time_r.$(O) \ $(BLD)/md5.$(O) \ $(BLD)/sha1.$(O) \ + $(BLD)/sha256.$(O) \ + $(BLD)/sha512.$(O) \ $(BLD)/filemode.$(O) # @@ -120,6 +122,24 @@ $(EMACS_ROOT)/src/m/intel386.h \ $(EMACS_ROOT)/src/config.h +$(BLD)/sha256.$(O) : \ + $(SRC)/sha256.c \ + $(SRC)/sha256.h \ + $(EMACS_ROOT)/nt/inc/stdint.h \ + $(EMACS_ROOT)/nt/inc/sys/stat.h \ + $(EMACS_ROOT)/src/s/ms-w32.h \ + $(EMACS_ROOT)/src/m/intel386.h \ + $(EMACS_ROOT)/src/config.h + +$(BLD)/sha512.$(O) : \ + $(SRC)/sha512.c \ + $(SRC)/sha512.h \ + $(EMACS_ROOT)/nt/inc/stdint.h \ + $(EMACS_ROOT)/nt/inc/sys/stat.h \ + $(EMACS_ROOT)/src/s/ms-w32.h \ + $(EMACS_ROOT)/src/m/intel386.h \ + $(EMACS_ROOT)/src/config.h + $(BLD)/filemode.$(O) : \ $(SRC)/filemode.c \ $(SRC)/filemode.h \ === added file 'lib/sha256.c' --- lib/sha256.c 1970-01-01 00:00:00 +0000 +++ lib/sha256.c 2011-06-21 08:45:39 +0000 @@ -0,0 +1,569 @@ +/* sha256.c - Functions to compute SHA256 and SHA224 message digest of files or + memory blocks according to the NIST specification FIPS-180-2. + + Copyright (C) 2005-2006, 2008-2011 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program 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 this program. If not, see . */ + +/* Written by David Madore, considerably copypasting from + Scott G. Miller's sha1.c +*/ + +#include + +#include "sha256.h" + +#include +#include +#include + +#if USE_UNLOCKED_IO +# include "unlocked-io.h" +#endif + +#ifdef WORDS_BIGENDIAN +# define SWAP(n) (n) +#else +# define SWAP(n) \ + (((n) << 24) | (((n) & 0xff00) << 8) | (((n) >> 8) & 0xff00) | ((n) >> 24)) +#endif + +#define BLOCKSIZE 32768 +#if BLOCKSIZE % 64 != 0 +# error "invalid BLOCKSIZE" +#endif + +/* This array contains the bytes used to pad the buffer to the next + 64-byte boundary. */ +static const unsigned char fillbuf[64] = { 0x80, 0 /* , 0, 0, ... */ }; + + +/* + Takes a pointer to a 256 bit block of data (eight 32 bit ints) and + intializes it to the start constants of the SHA256 algorithm. This + must be called before using hash in the call to sha256_hash +*/ +void +sha256_init_ctx (struct sha256_ctx *ctx) +{ + ctx->state[0] = 0x6a09e667UL; + ctx->state[1] = 0xbb67ae85UL; + ctx->state[2] = 0x3c6ef372UL; + ctx->state[3] = 0xa54ff53aUL; + ctx->state[4] = 0x510e527fUL; + ctx->state[5] = 0x9b05688cUL; + ctx->state[6] = 0x1f83d9abUL; + ctx->state[7] = 0x5be0cd19UL; + + ctx->total[0] = ctx->total[1] = 0; + ctx->buflen = 0; +} + +void +sha224_init_ctx (struct sha256_ctx *ctx) +{ + ctx->state[0] = 0xc1059ed8UL; + ctx->state[1] = 0x367cd507UL; + ctx->state[2] = 0x3070dd17UL; + ctx->state[3] = 0xf70e5939UL; + ctx->state[4] = 0xffc00b31UL; + ctx->state[5] = 0x68581511UL; + ctx->state[6] = 0x64f98fa7UL; + ctx->state[7] = 0xbefa4fa4UL; + + ctx->total[0] = ctx->total[1] = 0; + ctx->buflen = 0; +} + +/* Copy the value from v into the memory location pointed to by *cp, + If your architecture allows unaligned access this is equivalent to + * (uint32_t *) cp = v */ +static inline void +set_uint32 (char *cp, uint32_t v) +{ + memcpy (cp, &v, sizeof v); +} + +/* Put result from CTX in first 32 bytes following RESBUF. The result + must be in little endian byte order. */ +void * +sha256_read_ctx (const struct sha256_ctx *ctx, void *resbuf) +{ + int i; + char *r = resbuf; + + for (i = 0; i < 8; i++) + set_uint32 (r + i * sizeof ctx->state[0], SWAP (ctx->state[i])); + + return resbuf; +} + +void * +sha224_read_ctx (const struct sha256_ctx *ctx, void *resbuf) +{ + int i; + char *r = resbuf; + + for (i = 0; i < 7; i++) + set_uint32 (r + i * sizeof ctx->state[0], SWAP (ctx->state[i])); + + return resbuf; +} + +/* Process the remaining bytes in the internal buffer and the usual + prolog according to the standard and write the result to RESBUF. */ +static void +sha256_conclude_ctx (struct sha256_ctx *ctx) +{ + /* Take yet unprocessed bytes into account. */ + size_t bytes = ctx->buflen; + size_t size = (bytes < 56) ? 64 / 4 : 64 * 2 / 4; + + /* Now count remaining bytes. */ + ctx->total[0] += bytes; + if (ctx->total[0] < bytes) + ++ctx->total[1]; + + /* Put the 64-bit file length in *bits* at the end of the buffer. + Use set_uint32 rather than a simple assignment, to avoid risk of + unaligned access. */ + set_uint32 ((char *) &ctx->buffer[size - 2], + SWAP ((ctx->total[1] << 3) | (ctx->total[0] >> 29))); + set_uint32 ((char *) &ctx->buffer[size - 1], + SWAP (ctx->total[0] << 3)); + + memcpy (&((char *) ctx->buffer)[bytes], fillbuf, (size - 2) * 4 - bytes); + + /* Process last bytes. */ + sha256_process_block (ctx->buffer, size * 4, ctx); +} + +void * +sha256_finish_ctx (struct sha256_ctx *ctx, void *resbuf) +{ + sha256_conclude_ctx (ctx); + return sha256_read_ctx (ctx, resbuf); +} + +void * +sha224_finish_ctx (struct sha256_ctx *ctx, void *resbuf) +{ + sha256_conclude_ctx (ctx); + return sha224_read_ctx (ctx, resbuf); +} + +/* Compute SHA256 message digest for bytes read from STREAM. The + resulting message digest number will be written into the 32 bytes + beginning at RESBLOCK. */ +int +sha256_stream (FILE *stream, void *resblock) +{ + struct sha256_ctx ctx; + size_t sum; + + char *buffer = malloc (BLOCKSIZE + 72); + if (!buffer) + return 1; + + /* Initialize the computation context. */ + sha256_init_ctx (&ctx); + + /* Iterate over full file contents. */ + while (1) + { + /* We read the file in blocks of BLOCKSIZE bytes. One call of the + computation function processes the whole buffer so that with the + next round of the loop another block can be read. */ + size_t n; + sum = 0; + + /* Read block. Take care for partial reads. */ + while (1) + { + n = fread (buffer + sum, 1, BLOCKSIZE - sum, stream); + + sum += n; + + if (sum == BLOCKSIZE) + break; + + if (n == 0) + { + /* Check for the error flag IFF N == 0, so that we don't + exit the loop after a partial read due to e.g., EAGAIN + or EWOULDBLOCK. */ + if (ferror (stream)) + { + free (buffer); + return 1; + } + goto process_partial_block; + } + + /* We've read at least one byte, so ignore errors. But always + check for EOF, since feof may be true even though N > 0. + Otherwise, we could end up calling fread after EOF. */ + if (feof (stream)) + goto process_partial_block; + } + + /* Process buffer with BLOCKSIZE bytes. Note that + BLOCKSIZE % 64 == 0 + */ + sha256_process_block (buffer, BLOCKSIZE, &ctx); + } + + process_partial_block:; + + /* Process any remaining bytes. */ + if (sum > 0) + sha256_process_bytes (buffer, sum, &ctx); + + /* Construct result in desired memory. */ + sha256_finish_ctx (&ctx, resblock); + free (buffer); + return 0; +} + +/* FIXME: Avoid code duplication */ +int +sha224_stream (FILE *stream, void *resblock) +{ + struct sha256_ctx ctx; + size_t sum; + + char *buffer = malloc (BLOCKSIZE + 72); + if (!buffer) + return 1; + + /* Initialize the computation context. */ + sha224_init_ctx (&ctx); + + /* Iterate over full file contents. */ + while (1) + { + /* We read the file in blocks of BLOCKSIZE bytes. One call of the + computation function processes the whole buffer so that with the + next round of the loop another block can be read. */ + size_t n; + sum = 0; + + /* Read block. Take care for partial reads. */ + while (1) + { + n = fread (buffer + sum, 1, BLOCKSIZE - sum, stream); + + sum += n; + + if (sum == BLOCKSIZE) + break; + + if (n == 0) + { + /* Check for the error flag IFF N == 0, so that we don't + exit the loop after a partial read due to e.g., EAGAIN + or EWOULDBLOCK. */ + if (ferror (stream)) + { + free (buffer); + return 1; + } + goto process_partial_block; + } + + /* We've read at least one byte, so ignore errors. But always + check for EOF, since feof may be true even though N > 0. + Otherwise, we could end up calling fread after EOF. */ + if (feof (stream)) + goto process_partial_block; + } + + /* Process buffer with BLOCKSIZE bytes. Note that + BLOCKSIZE % 64 == 0 + */ + sha256_process_block (buffer, BLOCKSIZE, &ctx); + } + + process_partial_block:; + + /* Process any remaining bytes. */ + if (sum > 0) + sha256_process_bytes (buffer, sum, &ctx); + + /* Construct result in desired memory. */ + sha224_finish_ctx (&ctx, resblock); + free (buffer); + return 0; +} + +/* Compute SHA512 message digest for LEN bytes beginning at BUFFER. The + result is always in little endian byte order, so that a byte-wise + output yields to the wanted ASCII representation of the message + digest. */ +void * +sha256_buffer (const char *buffer, size_t len, void *resblock) +{ + struct sha256_ctx ctx; + + /* Initialize the computation context. */ + sha256_init_ctx (&ctx); + + /* Process whole buffer but last len % 64 bytes. */ + sha256_process_bytes (buffer, len, &ctx); + + /* Put result in desired memory area. */ + return sha256_finish_ctx (&ctx, resblock); +} + +void * +sha224_buffer (const char *buffer, size_t len, void *resblock) +{ + struct sha256_ctx ctx; + + /* Initialize the computation context. */ + sha224_init_ctx (&ctx); + + /* Process whole buffer but last len % 64 bytes. */ + sha256_process_bytes (buffer, len, &ctx); + + /* Put result in desired memory area. */ + return sha224_finish_ctx (&ctx, resblock); +} + +void +sha256_process_bytes (const void *buffer, size_t len, struct sha256_ctx *ctx) +{ + /* When we already have some bits in our internal buffer concatenate + both inputs first. */ + if (ctx->buflen != 0) + { + size_t left_over = ctx->buflen; + size_t add = 128 - left_over > len ? len : 128 - left_over; + + memcpy (&((char *) ctx->buffer)[left_over], buffer, add); + ctx->buflen += add; + + if (ctx->buflen > 64) + { + sha256_process_block (ctx->buffer, ctx->buflen & ~63, ctx); + + ctx->buflen &= 63; + /* The regions in the following copy operation cannot overlap. */ + memcpy (ctx->buffer, + &((char *) ctx->buffer)[(left_over + add) & ~63], + ctx->buflen); + } + + buffer = (const char *) buffer + add; + len -= add; + } + + /* Process available complete blocks. */ + if (len >= 64) + { +#if !_STRING_ARCH_unaligned +# define alignof(type) offsetof (struct { char c; type x; }, x) +# define UNALIGNED_P(p) (((size_t) p) % alignof (uint32_t) != 0) + if (UNALIGNED_P (buffer)) + while (len > 64) + { + sha256_process_block (memcpy (ctx->buffer, buffer, 64), 64, ctx); + buffer = (const char *) buffer + 64; + len -= 64; + } + else +#endif + { + sha256_process_block (buffer, len & ~63, ctx); + buffer = (const char *) buffer + (len & ~63); + len &= 63; + } + } + + /* Move remaining bytes in internal buffer. */ + if (len > 0) + { + size_t left_over = ctx->buflen; + + memcpy (&((char *) ctx->buffer)[left_over], buffer, len); + left_over += len; + if (left_over >= 64) + { + sha256_process_block (ctx->buffer, 64, ctx); + left_over -= 64; + memcpy (ctx->buffer, &ctx->buffer[16], left_over); + } + ctx->buflen = left_over; + } +} + +/* --- Code below is the primary difference between sha1.c and sha256.c --- */ + +/* SHA256 round constants */ +#define K(I) sha256_round_constants[I] +static const uint32_t sha256_round_constants[64] = { + 0x428a2f98UL, 0x71374491UL, 0xb5c0fbcfUL, 0xe9b5dba5UL, + 0x3956c25bUL, 0x59f111f1UL, 0x923f82a4UL, 0xab1c5ed5UL, + 0xd807aa98UL, 0x12835b01UL, 0x243185beUL, 0x550c7dc3UL, + 0x72be5d74UL, 0x80deb1feUL, 0x9bdc06a7UL, 0xc19bf174UL, + 0xe49b69c1UL, 0xefbe4786UL, 0x0fc19dc6UL, 0x240ca1ccUL, + 0x2de92c6fUL, 0x4a7484aaUL, 0x5cb0a9dcUL, 0x76f988daUL, + 0x983e5152UL, 0xa831c66dUL, 0xb00327c8UL, 0xbf597fc7UL, + 0xc6e00bf3UL, 0xd5a79147UL, 0x06ca6351UL, 0x14292967UL, + 0x27b70a85UL, 0x2e1b2138UL, 0x4d2c6dfcUL, 0x53380d13UL, + 0x650a7354UL, 0x766a0abbUL, 0x81c2c92eUL, 0x92722c85UL, + 0xa2bfe8a1UL, 0xa81a664bUL, 0xc24b8b70UL, 0xc76c51a3UL, + 0xd192e819UL, 0xd6990624UL, 0xf40e3585UL, 0x106aa070UL, + 0x19a4c116UL, 0x1e376c08UL, 0x2748774cUL, 0x34b0bcb5UL, + 0x391c0cb3UL, 0x4ed8aa4aUL, 0x5b9cca4fUL, 0x682e6ff3UL, + 0x748f82eeUL, 0x78a5636fUL, 0x84c87814UL, 0x8cc70208UL, + 0x90befffaUL, 0xa4506cebUL, 0xbef9a3f7UL, 0xc67178f2UL, +}; + +/* Round functions. */ +#define F2(A,B,C) ( ( A & B ) | ( C & ( A | B ) ) ) +#define F1(E,F,G) ( G ^ ( E & ( F ^ G ) ) ) + +/* Process LEN bytes of BUFFER, accumulating context into CTX. + It is assumed that LEN % 64 == 0. + Most of this code comes from GnuPG's cipher/sha1.c. */ + +void +sha256_process_block (const void *buffer, size_t len, struct sha256_ctx *ctx) +{ + const uint32_t *words = buffer; + size_t nwords = len / sizeof (uint32_t); + const uint32_t *endp = words + nwords; + uint32_t x[16]; + uint32_t a = ctx->state[0]; + uint32_t b = ctx->state[1]; + uint32_t c = ctx->state[2]; + uint32_t d = ctx->state[3]; + uint32_t e = ctx->state[4]; + uint32_t f = ctx->state[5]; + uint32_t g = ctx->state[6]; + uint32_t h = ctx->state[7]; + + /* First increment the byte count. FIPS PUB 180-2 specifies the possible + length of the file up to 2^64 bits. Here we only compute the + number of bytes. Do a double word increment. */ + ctx->total[0] += len; + if (ctx->total[0] < len) + ++ctx->total[1]; + +#define rol(x, n) (((x) << (n)) | ((x) >> (32 - (n)))) +#define S0(x) (rol(x,25)^rol(x,14)^(x>>3)) +#define S1(x) (rol(x,15)^rol(x,13)^(x>>10)) +#define SS0(x) (rol(x,30)^rol(x,19)^rol(x,10)) +#define SS1(x) (rol(x,26)^rol(x,21)^rol(x,7)) + +#define M(I) ( tm = S1(x[(I-2)&0x0f]) + x[(I-7)&0x0f] \ + + S0(x[(I-15)&0x0f]) + x[I&0x0f] \ + , x[I&0x0f] = tm ) + +#define R(A,B,C,D,E,F,G,H,K,M) do { t0 = SS0(A) + F2(A,B,C); \ + t1 = H + SS1(E) \ + + F1(E,F,G) \ + + K \ + + M; \ + D += t1; H = t0 + t1; \ + } while(0) + + while (words < endp) + { + uint32_t tm; + uint32_t t0, t1; + int t; + /* FIXME: see sha1.c for a better implementation. */ + for (t = 0; t < 16; t++) + { + x[t] = SWAP (*words); + words++; + } + + R( a, b, c, d, e, f, g, h, K( 0), x[ 0] ); + R( h, a, b, c, d, e, f, g, K( 1), x[ 1] ); + R( g, h, a, b, c, d, e, f, K( 2), x[ 2] ); + R( f, g, h, a, b, c, d, e, K( 3), x[ 3] ); + R( e, f, g, h, a, b, c, d, K( 4), x[ 4] ); + R( d, e, f, g, h, a, b, c, K( 5), x[ 5] ); + R( c, d, e, f, g, h, a, b, K( 6), x[ 6] ); + R( b, c, d, e, f, g, h, a, K( 7), x[ 7] ); + R( a, b, c, d, e, f, g, h, K( 8), x[ 8] ); + R( h, a, b, c, d, e, f, g, K( 9), x[ 9] ); + R( g, h, a, b, c, d, e, f, K(10), x[10] ); + R( f, g, h, a, b, c, d, e, K(11), x[11] ); + R( e, f, g, h, a, b, c, d, K(12), x[12] ); + R( d, e, f, g, h, a, b, c, K(13), x[13] ); + R( c, d, e, f, g, h, a, b, K(14), x[14] ); + R( b, c, d, e, f, g, h, a, K(15), x[15] ); + R( a, b, c, d, e, f, g, h, K(16), M(16) ); + R( h, a, b, c, d, e, f, g, K(17), M(17) ); + R( g, h, a, b, c, d, e, f, K(18), M(18) ); + R( f, g, h, a, b, c, d, e, K(19), M(19) ); + R( e, f, g, h, a, b, c, d, K(20), M(20) ); + R( d, e, f, g, h, a, b, c, K(21), M(21) ); + R( c, d, e, f, g, h, a, b, K(22), M(22) ); + R( b, c, d, e, f, g, h, a, K(23), M(23) ); + R( a, b, c, d, e, f, g, h, K(24), M(24) ); + R( h, a, b, c, d, e, f, g, K(25), M(25) ); + R( g, h, a, b, c, d, e, f, K(26), M(26) ); + R( f, g, h, a, b, c, d, e, K(27), M(27) ); + R( e, f, g, h, a, b, c, d, K(28), M(28) ); + R( d, e, f, g, h, a, b, c, K(29), M(29) ); + R( c, d, e, f, g, h, a, b, K(30), M(30) ); + R( b, c, d, e, f, g, h, a, K(31), M(31) ); + R( a, b, c, d, e, f, g, h, K(32), M(32) ); + R( h, a, b, c, d, e, f, g, K(33), M(33) ); + R( g, h, a, b, c, d, e, f, K(34), M(34) ); + R( f, g, h, a, b, c, d, e, K(35), M(35) ); + R( e, f, g, h, a, b, c, d, K(36), M(36) ); + R( d, e, f, g, h, a, b, c, K(37), M(37) ); + R( c, d, e, f, g, h, a, b, K(38), M(38) ); + R( b, c, d, e, f, g, h, a, K(39), M(39) ); + R( a, b, c, d, e, f, g, h, K(40), M(40) ); + R( h, a, b, c, d, e, f, g, K(41), M(41) ); + R( g, h, a, b, c, d, e, f, K(42), M(42) ); + R( f, g, h, a, b, c, d, e, K(43), M(43) ); + R( e, f, g, h, a, b, c, d, K(44), M(44) ); + R( d, e, f, g, h, a, b, c, K(45), M(45) ); + R( c, d, e, f, g, h, a, b, K(46), M(46) ); + R( b, c, d, e, f, g, h, a, K(47), M(47) ); + R( a, b, c, d, e, f, g, h, K(48), M(48) ); + R( h, a, b, c, d, e, f, g, K(49), M(49) ); + R( g, h, a, b, c, d, e, f, K(50), M(50) ); + R( f, g, h, a, b, c, d, e, K(51), M(51) ); + R( e, f, g, h, a, b, c, d, K(52), M(52) ); + R( d, e, f, g, h, a, b, c, K(53), M(53) ); + R( c, d, e, f, g, h, a, b, K(54), M(54) ); + R( b, c, d, e, f, g, h, a, K(55), M(55) ); + R( a, b, c, d, e, f, g, h, K(56), M(56) ); + R( h, a, b, c, d, e, f, g, K(57), M(57) ); + R( g, h, a, b, c, d, e, f, K(58), M(58) ); + R( f, g, h, a, b, c, d, e, K(59), M(59) ); + R( e, f, g, h, a, b, c, d, K(60), M(60) ); + R( d, e, f, g, h, a, b, c, K(61), M(61) ); + R( c, d, e, f, g, h, a, b, K(62), M(62) ); + R( b, c, d, e, f, g, h, a, K(63), M(63) ); + + a = ctx->state[0] += a; + b = ctx->state[1] += b; + c = ctx->state[2] += c; + d = ctx->state[3] += d; + e = ctx->state[4] += e; + f = ctx->state[5] += f; + g = ctx->state[6] += g; + h = ctx->state[7] += h; + } +} === added file 'lib/sha256.h' --- lib/sha256.h 1970-01-01 00:00:00 +0000 +++ lib/sha256.h 2011-06-21 08:45:39 +0000 @@ -0,0 +1,91 @@ +/* Declarations of functions and data types used for SHA256 and SHA224 sum + library functions. + Copyright (C) 2005-2006, 2008-2011 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program 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 this program. If not, see . */ + +#ifndef SHA256_H +# define SHA256_H 1 + +# include +# include + +# ifdef __cplusplus +extern "C" { +# endif + +/* Structure to save state of computation between the single steps. */ +struct sha256_ctx +{ + uint32_t state[8]; + + uint32_t total[2]; + size_t buflen; + uint32_t buffer[32]; +}; + +enum { SHA224_DIGEST_SIZE = 224 / 8 }; +enum { SHA256_DIGEST_SIZE = 256 / 8 }; + +/* Initialize structure containing state of computation. */ +extern void sha256_init_ctx (struct sha256_ctx *ctx); +extern void sha224_init_ctx (struct sha256_ctx *ctx); + +/* Starting with the result of former calls of this function (or the + initialization function update the context for the next LEN bytes + starting at BUFFER. + It is necessary that LEN is a multiple of 64!!! */ +extern void sha256_process_block (const void *buffer, size_t len, + struct sha256_ctx *ctx); + +/* Starting with the result of former calls of this function (or the + initialization function update the context for the next LEN bytes + starting at BUFFER. + It is NOT required that LEN is a multiple of 64. */ +extern void sha256_process_bytes (const void *buffer, size_t len, + struct sha256_ctx *ctx); + +/* Process the remaining bytes in the buffer and put result from CTX + in first 32 (28) bytes following RESBUF. The result is always in little + endian byte order, so that a byte-wise output yields to the wanted + ASCII representation of the message digest. */ +extern void *sha256_finish_ctx (struct sha256_ctx *ctx, void *resbuf); +extern void *sha224_finish_ctx (struct sha256_ctx *ctx, void *resbuf); + + +/* Put result from CTX in first 32 (28) bytes following RESBUF. The result is + always in little endian byte order, so that a byte-wise output yields + to the wanted ASCII representation of the message digest. */ +extern void *sha256_read_ctx (const struct sha256_ctx *ctx, void *resbuf); +extern void *sha224_read_ctx (const struct sha256_ctx *ctx, void *resbuf); + + +/* Compute SHA256 (SHA224) message digest for bytes read from STREAM. The + resulting message digest number will be written into the 32 (28) bytes + beginning at RESBLOCK. */ +extern int sha256_stream (FILE *stream, void *resblock); +extern int sha224_stream (FILE *stream, void *resblock); + +/* Compute SHA256 (SHA224) message digest for LEN bytes beginning at BUFFER. The + result is always in little endian byte order, so that a byte-wise + output yields to the wanted ASCII representation of the message + digest. */ +extern void *sha256_buffer (const char *buffer, size_t len, void *resblock); +extern void *sha224_buffer (const char *buffer, size_t len, void *resblock); + +# ifdef __cplusplus +} +# endif + +#endif === added file 'lib/sha512.c' --- lib/sha512.c 1970-01-01 00:00:00 +0000 +++ lib/sha512.c 2011-06-21 08:45:39 +0000 @@ -0,0 +1,619 @@ +/* sha512.c - Functions to compute SHA512 and SHA384 message digest of files or + memory blocks according to the NIST specification FIPS-180-2. + + Copyright (C) 2005-2006, 2008-2011 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program 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 this program. If not, see . */ + +/* Written by David Madore, considerably copypasting from + Scott G. Miller's sha1.c +*/ + +#include + +#include "sha512.h" + +#include +#include +#include + +#if USE_UNLOCKED_IO +# include "unlocked-io.h" +#endif + +#ifdef WORDS_BIGENDIAN +# define SWAP(n) (n) +#else +# define SWAP(n) \ + u64or (u64or (u64or (u64shl (n, 56), \ + u64shl (u64and (n, u64lo (0x0000ff00)), 40)), \ + u64or (u64shl (u64and (n, u64lo (0x00ff0000)), 24), \ + u64shl (u64and (n, u64lo (0xff000000)), 8))), \ + u64or (u64or (u64and (u64shr (n, 8), u64lo (0xff000000)), \ + u64and (u64shr (n, 24), u64lo (0x00ff0000))), \ + u64or (u64and (u64shr (n, 40), u64lo (0x0000ff00)), \ + u64shr (n, 56)))) +#endif + +#define BLOCKSIZE 32768 +#if BLOCKSIZE % 128 != 0 +# error "invalid BLOCKSIZE" +#endif + +/* This array contains the bytes used to pad the buffer to the next + 128-byte boundary. */ +static const unsigned char fillbuf[128] = { 0x80, 0 /* , 0, 0, ... */ }; + + +/* + Takes a pointer to a 512 bit block of data (eight 64 bit ints) and + intializes it to the start constants of the SHA512 algorithm. This + must be called before using hash in the call to sha512_hash +*/ +void +sha512_init_ctx (struct sha512_ctx *ctx) +{ + ctx->state[0] = u64hilo (0x6a09e667, 0xf3bcc908); + ctx->state[1] = u64hilo (0xbb67ae85, 0x84caa73b); + ctx->state[2] = u64hilo (0x3c6ef372, 0xfe94f82b); + ctx->state[3] = u64hilo (0xa54ff53a, 0x5f1d36f1); + ctx->state[4] = u64hilo (0x510e527f, 0xade682d1); + ctx->state[5] = u64hilo (0x9b05688c, 0x2b3e6c1f); + ctx->state[6] = u64hilo (0x1f83d9ab, 0xfb41bd6b); + ctx->state[7] = u64hilo (0x5be0cd19, 0x137e2179); + + ctx->total[0] = ctx->total[1] = u64lo (0); + ctx->buflen = 0; +} + +void +sha384_init_ctx (struct sha512_ctx *ctx) +{ + ctx->state[0] = u64hilo (0xcbbb9d5d, 0xc1059ed8); + ctx->state[1] = u64hilo (0x629a292a, 0x367cd507); + ctx->state[2] = u64hilo (0x9159015a, 0x3070dd17); + ctx->state[3] = u64hilo (0x152fecd8, 0xf70e5939); + ctx->state[4] = u64hilo (0x67332667, 0xffc00b31); + ctx->state[5] = u64hilo (0x8eb44a87, 0x68581511); + ctx->state[6] = u64hilo (0xdb0c2e0d, 0x64f98fa7); + ctx->state[7] = u64hilo (0x47b5481d, 0xbefa4fa4); + + ctx->total[0] = ctx->total[1] = u64lo (0); + ctx->buflen = 0; +} + +/* Copy the value from V into the memory location pointed to by *CP, + If your architecture allows unaligned access, this is equivalent to + * (__typeof__ (v) *) cp = v */ +static inline void +set_uint64 (char *cp, u64 v) +{ + memcpy (cp, &v, sizeof v); +} + +/* Put result from CTX in first 64 bytes following RESBUF. + The result must be in little endian byte order. */ +void * +sha512_read_ctx (const struct sha512_ctx *ctx, void *resbuf) +{ + int i; + char *r = resbuf; + + for (i = 0; i < 8; i++) + set_uint64 (r + i * sizeof ctx->state[0], SWAP (ctx->state[i])); + + return resbuf; +} + +void * +sha384_read_ctx (const struct sha512_ctx *ctx, void *resbuf) +{ + int i; + char *r = resbuf; + + for (i = 0; i < 6; i++) + set_uint64 (r + i * sizeof ctx->state[0], SWAP (ctx->state[i])); + + return resbuf; +} + +/* Process the remaining bytes in the internal buffer and the usual + prolog according to the standard and write the result to RESBUF. */ +static void +sha512_conclude_ctx (struct sha512_ctx *ctx) +{ + /* Take yet unprocessed bytes into account. */ + size_t bytes = ctx->buflen; + size_t size = (bytes < 112) ? 128 / 8 : 128 * 2 / 8; + + /* Now count remaining bytes. */ + ctx->total[0] = u64plus (ctx->total[0], u64lo (bytes)); + if (u64lt (ctx->total[0], u64lo (bytes))) + ctx->total[1] = u64plus (ctx->total[1], u64lo (1)); + + /* Put the 128-bit file length in *bits* at the end of the buffer. + Use set_uint64 rather than a simple assignment, to avoid risk of + unaligned access. */ + set_uint64 ((char *) &ctx->buffer[size - 2], + SWAP (u64or (u64shl (ctx->total[1], 3), + u64shr (ctx->total[0], 61)))); + set_uint64 ((char *) &ctx->buffer[size - 1], + SWAP (u64shl (ctx->total[0], 3))); + + memcpy (&((char *) ctx->buffer)[bytes], fillbuf, (size - 2) * 8 - bytes); + + /* Process last bytes. */ + sha512_process_block (ctx->buffer, size * 8, ctx); +} + +void * +sha512_finish_ctx (struct sha512_ctx *ctx, void *resbuf) +{ + sha512_conclude_ctx (ctx); + return sha512_read_ctx (ctx, resbuf); +} + +void * +sha384_finish_ctx (struct sha512_ctx *ctx, void *resbuf) +{ + sha512_conclude_ctx (ctx); + return sha384_read_ctx (ctx, resbuf); +} + +/* Compute SHA512 message digest for bytes read from STREAM. The + resulting message digest number will be written into the 64 bytes + beginning at RESBLOCK. */ +int +sha512_stream (FILE *stream, void *resblock) +{ + struct sha512_ctx ctx; + size_t sum; + + char *buffer = malloc (BLOCKSIZE + 72); + if (!buffer) + return 1; + + /* Initialize the computation context. */ + sha512_init_ctx (&ctx); + + /* Iterate over full file contents. */ + while (1) + { + /* We read the file in blocks of BLOCKSIZE bytes. One call of the + computation function processes the whole buffer so that with the + next round of the loop another block can be read. */ + size_t n; + sum = 0; + + /* Read block. Take care for partial reads. */ + while (1) + { + n = fread (buffer + sum, 1, BLOCKSIZE - sum, stream); + + sum += n; + + if (sum == BLOCKSIZE) + break; + + if (n == 0) + { + /* Check for the error flag IFF N == 0, so that we don't + exit the loop after a partial read due to e.g., EAGAIN + or EWOULDBLOCK. */ + if (ferror (stream)) + { + free (buffer); + return 1; + } + goto process_partial_block; + } + + /* We've read at least one byte, so ignore errors. But always + check for EOF, since feof may be true even though N > 0. + Otherwise, we could end up calling fread after EOF. */ + if (feof (stream)) + goto process_partial_block; + } + + /* Process buffer with BLOCKSIZE bytes. Note that + BLOCKSIZE % 128 == 0 + */ + sha512_process_block (buffer, BLOCKSIZE, &ctx); + } + + process_partial_block:; + + /* Process any remaining bytes. */ + if (sum > 0) + sha512_process_bytes (buffer, sum, &ctx); + + /* Construct result in desired memory. */ + sha512_finish_ctx (&ctx, resblock); + free (buffer); + return 0; +} + +/* FIXME: Avoid code duplication */ +int +sha384_stream (FILE *stream, void *resblock) +{ + struct sha512_ctx ctx; + size_t sum; + + char *buffer = malloc (BLOCKSIZE + 72); + if (!buffer) + return 1; + + /* Initialize the computation context. */ + sha384_init_ctx (&ctx); + + /* Iterate over full file contents. */ + while (1) + { + /* We read the file in blocks of BLOCKSIZE bytes. One call of the + computation function processes the whole buffer so that with the + next round of the loop another block can be read. */ + size_t n; + sum = 0; + + /* Read block. Take care for partial reads. */ + while (1) + { + n = fread (buffer + sum, 1, BLOCKSIZE - sum, stream); + + sum += n; + + if (sum == BLOCKSIZE) + break; + + if (n == 0) + { + /* Check for the error flag IFF N == 0, so that we don't + exit the loop after a partial read due to e.g., EAGAIN + or EWOULDBLOCK. */ + if (ferror (stream)) + { + free (buffer); + return 1; + } + goto process_partial_block; + } + + /* We've read at least one byte, so ignore errors. But always + check for EOF, since feof may be true even though N > 0. + Otherwise, we could end up calling fread after EOF. */ + if (feof (stream)) + goto process_partial_block; + } + + /* Process buffer with BLOCKSIZE bytes. Note that + BLOCKSIZE % 128 == 0 + */ + sha512_process_block (buffer, BLOCKSIZE, &ctx); + } + + process_partial_block:; + + /* Process any remaining bytes. */ + if (sum > 0) + sha512_process_bytes (buffer, sum, &ctx); + + /* Construct result in desired memory. */ + sha384_finish_ctx (&ctx, resblock); + free (buffer); + return 0; +} + +/* Compute SHA512 message digest for LEN bytes beginning at BUFFER. The + result is always in little endian byte order, so that a byte-wise + output yields to the wanted ASCII representation of the message + digest. */ +void * +sha512_buffer (const char *buffer, size_t len, void *resblock) +{ + struct sha512_ctx ctx; + + /* Initialize the computation context. */ + sha512_init_ctx (&ctx); + + /* Process whole buffer but last len % 128 bytes. */ + sha512_process_bytes (buffer, len, &ctx); + + /* Put result in desired memory area. */ + return sha512_finish_ctx (&ctx, resblock); +} + +void * +sha384_buffer (const char *buffer, size_t len, void *resblock) +{ + struct sha512_ctx ctx; + + /* Initialize the computation context. */ + sha384_init_ctx (&ctx); + + /* Process whole buffer but last len % 128 bytes. */ + sha512_process_bytes (buffer, len, &ctx); + + /* Put result in desired memory area. */ + return sha384_finish_ctx (&ctx, resblock); +} + +void +sha512_process_bytes (const void *buffer, size_t len, struct sha512_ctx *ctx) +{ + /* When we already have some bits in our internal buffer concatenate + both inputs first. */ + if (ctx->buflen != 0) + { + size_t left_over = ctx->buflen; + size_t add = 256 - left_over > len ? len : 256 - left_over; + + memcpy (&((char *) ctx->buffer)[left_over], buffer, add); + ctx->buflen += add; + + if (ctx->buflen > 128) + { + sha512_process_block (ctx->buffer, ctx->buflen & ~127, ctx); + + ctx->buflen &= 127; + /* The regions in the following copy operation cannot overlap. */ + memcpy (ctx->buffer, + &((char *) ctx->buffer)[(left_over + add) & ~127], + ctx->buflen); + } + + buffer = (const char *) buffer + add; + len -= add; + } + + /* Process available complete blocks. */ + if (len >= 128) + { +#if !_STRING_ARCH_unaligned +# define alignof(type) offsetof (struct { char c; type x; }, x) +# define UNALIGNED_P(p) (((size_t) p) % alignof (u64) != 0) + if (UNALIGNED_P (buffer)) + while (len > 128) + { + sha512_process_block (memcpy (ctx->buffer, buffer, 128), 128, ctx); + buffer = (const char *) buffer + 128; + len -= 128; + } + else +#endif + { + sha512_process_block (buffer, len & ~127, ctx); + buffer = (const char *) buffer + (len & ~127); + len &= 127; + } + } + + /* Move remaining bytes in internal buffer. */ + if (len > 0) + { + size_t left_over = ctx->buflen; + + memcpy (&((char *) ctx->buffer)[left_over], buffer, len); + left_over += len; + if (left_over >= 128) + { + sha512_process_block (ctx->buffer, 128, ctx); + left_over -= 128; + memcpy (ctx->buffer, &ctx->buffer[16], left_over); + } + ctx->buflen = left_over; + } +} + +/* --- Code below is the primary difference between sha1.c and sha512.c --- */ + +/* SHA512 round constants */ +#define K(I) sha512_round_constants[I] +static u64 const sha512_round_constants[80] = { + u64init (0x428a2f98, 0xd728ae22), u64init (0x71374491, 0x23ef65cd), + u64init (0xb5c0fbcf, 0xec4d3b2f), u64init (0xe9b5dba5, 0x8189dbbc), + u64init (0x3956c25b, 0xf348b538), u64init (0x59f111f1, 0xb605d019), + u64init (0x923f82a4, 0xaf194f9b), u64init (0xab1c5ed5, 0xda6d8118), + u64init (0xd807aa98, 0xa3030242), u64init (0x12835b01, 0x45706fbe), + u64init (0x243185be, 0x4ee4b28c), u64init (0x550c7dc3, 0xd5ffb4e2), + u64init (0x72be5d74, 0xf27b896f), u64init (0x80deb1fe, 0x3b1696b1), + u64init (0x9bdc06a7, 0x25c71235), u64init (0xc19bf174, 0xcf692694), + u64init (0xe49b69c1, 0x9ef14ad2), u64init (0xefbe4786, 0x384f25e3), + u64init (0x0fc19dc6, 0x8b8cd5b5), u64init (0x240ca1cc, 0x77ac9c65), + u64init (0x2de92c6f, 0x592b0275), u64init (0x4a7484aa, 0x6ea6e483), + u64init (0x5cb0a9dc, 0xbd41fbd4), u64init (0x76f988da, 0x831153b5), + u64init (0x983e5152, 0xee66dfab), u64init (0xa831c66d, 0x2db43210), + u64init (0xb00327c8, 0x98fb213f), u64init (0xbf597fc7, 0xbeef0ee4), + u64init (0xc6e00bf3, 0x3da88fc2), u64init (0xd5a79147, 0x930aa725), + u64init (0x06ca6351, 0xe003826f), u64init (0x14292967, 0x0a0e6e70), + u64init (0x27b70a85, 0x46d22ffc), u64init (0x2e1b2138, 0x5c26c926), + u64init (0x4d2c6dfc, 0x5ac42aed), u64init (0x53380d13, 0x9d95b3df), + u64init (0x650a7354, 0x8baf63de), u64init (0x766a0abb, 0x3c77b2a8), + u64init (0x81c2c92e, 0x47edaee6), u64init (0x92722c85, 0x1482353b), + u64init (0xa2bfe8a1, 0x4cf10364), u64init (0xa81a664b, 0xbc423001), + u64init (0xc24b8b70, 0xd0f89791), u64init (0xc76c51a3, 0x0654be30), + u64init (0xd192e819, 0xd6ef5218), u64init (0xd6990624, 0x5565a910), + u64init (0xf40e3585, 0x5771202a), u64init (0x106aa070, 0x32bbd1b8), + u64init (0x19a4c116, 0xb8d2d0c8), u64init (0x1e376c08, 0x5141ab53), + u64init (0x2748774c, 0xdf8eeb99), u64init (0x34b0bcb5, 0xe19b48a8), + u64init (0x391c0cb3, 0xc5c95a63), u64init (0x4ed8aa4a, 0xe3418acb), + u64init (0x5b9cca4f, 0x7763e373), u64init (0x682e6ff3, 0xd6b2b8a3), + u64init (0x748f82ee, 0x5defb2fc), u64init (0x78a5636f, 0x43172f60), + u64init (0x84c87814, 0xa1f0ab72), u64init (0x8cc70208, 0x1a6439ec), + u64init (0x90befffa, 0x23631e28), u64init (0xa4506ceb, 0xde82bde9), + u64init (0xbef9a3f7, 0xb2c67915), u64init (0xc67178f2, 0xe372532b), + u64init (0xca273ece, 0xea26619c), u64init (0xd186b8c7, 0x21c0c207), + u64init (0xeada7dd6, 0xcde0eb1e), u64init (0xf57d4f7f, 0xee6ed178), + u64init (0x06f067aa, 0x72176fba), u64init (0x0a637dc5, 0xa2c898a6), + u64init (0x113f9804, 0xbef90dae), u64init (0x1b710b35, 0x131c471b), + u64init (0x28db77f5, 0x23047d84), u64init (0x32caab7b, 0x40c72493), + u64init (0x3c9ebe0a, 0x15c9bebc), u64init (0x431d67c4, 0x9c100d4c), + u64init (0x4cc5d4be, 0xcb3e42b6), u64init (0x597f299c, 0xfc657e2a), + u64init (0x5fcb6fab, 0x3ad6faec), u64init (0x6c44198c, 0x4a475817), +}; + +/* Round functions. */ +#define F2(A, B, C) u64or (u64and (A, B), u64and (C, u64or (A, B))) +#define F1(E, F, G) u64xor (G, u64and (E, u64xor (F, G))) + +/* Process LEN bytes of BUFFER, accumulating context into CTX. + It is assumed that LEN % 128 == 0. + Most of this code comes from GnuPG's cipher/sha1.c. */ + +void +sha512_process_block (const void *buffer, size_t len, struct sha512_ctx *ctx) +{ + u64 const *words = buffer; + u64 const *endp = words + len / sizeof (u64); + u64 x[16]; + u64 a = ctx->state[0]; + u64 b = ctx->state[1]; + u64 c = ctx->state[2]; + u64 d = ctx->state[3]; + u64 e = ctx->state[4]; + u64 f = ctx->state[5]; + u64 g = ctx->state[6]; + u64 h = ctx->state[7]; + + /* First increment the byte count. FIPS PUB 180-2 specifies the possible + length of the file up to 2^128 bits. Here we only compute the + number of bytes. Do a double word increment. */ + ctx->total[0] = u64plus (ctx->total[0], u64lo (len)); + if (u64lt (ctx->total[0], u64lo (len))) + ctx->total[1] = u64plus (ctx->total[1], u64lo (1)); + +#define S0(x) u64xor (u64rol(x, 63), u64xor (u64rol (x, 56), u64shr (x, 7))) +#define S1(x) u64xor (u64rol (x, 45), u64xor (u64rol (x, 3), u64shr (x, 6))) +#define SS0(x) u64xor (u64rol (x, 36), u64xor (u64rol (x, 30), u64rol (x, 25))) +#define SS1(x) u64xor (u64rol(x, 50), u64xor (u64rol (x, 46), u64rol (x, 23))) + +#define M(I) (x[(I) & 15] \ + = u64plus (x[(I) & 15], \ + u64plus (S1 (x[((I) - 2) & 15]), \ + u64plus (x[((I) - 7) & 15], \ + S0 (x[((I) - 15) & 15]))))) + +#define R(A, B, C, D, E, F, G, H, K, M) \ + do \ + { \ + u64 t0 = u64plus (SS0 (A), F2 (A, B, C)); \ + u64 t1 = \ + u64plus (H, u64plus (SS1 (E), \ + u64plus (F1 (E, F, G), u64plus (K, M)))); \ + D = u64plus (D, t1); \ + H = u64plus (t0, t1); \ + } \ + while (0) + + while (words < endp) + { + int t; + /* FIXME: see sha1.c for a better implementation. */ + for (t = 0; t < 16; t++) + { + x[t] = SWAP (*words); + words++; + } + + R( a, b, c, d, e, f, g, h, K( 0), x[ 0] ); + R( h, a, b, c, d, e, f, g, K( 1), x[ 1] ); + R( g, h, a, b, c, d, e, f, K( 2), x[ 2] ); + R( f, g, h, a, b, c, d, e, K( 3), x[ 3] ); + R( e, f, g, h, a, b, c, d, K( 4), x[ 4] ); + R( d, e, f, g, h, a, b, c, K( 5), x[ 5] ); + R( c, d, e, f, g, h, a, b, K( 6), x[ 6] ); + R( b, c, d, e, f, g, h, a, K( 7), x[ 7] ); + R( a, b, c, d, e, f, g, h, K( 8), x[ 8] ); + R( h, a, b, c, d, e, f, g, K( 9), x[ 9] ); + R( g, h, a, b, c, d, e, f, K(10), x[10] ); + R( f, g, h, a, b, c, d, e, K(11), x[11] ); + R( e, f, g, h, a, b, c, d, K(12), x[12] ); + R( d, e, f, g, h, a, b, c, K(13), x[13] ); + R( c, d, e, f, g, h, a, b, K(14), x[14] ); + R( b, c, d, e, f, g, h, a, K(15), x[15] ); + R( a, b, c, d, e, f, g, h, K(16), M(16) ); + R( h, a, b, c, d, e, f, g, K(17), M(17) ); + R( g, h, a, b, c, d, e, f, K(18), M(18) ); + R( f, g, h, a, b, c, d, e, K(19), M(19) ); + R( e, f, g, h, a, b, c, d, K(20), M(20) ); + R( d, e, f, g, h, a, b, c, K(21), M(21) ); + R( c, d, e, f, g, h, a, b, K(22), M(22) ); + R( b, c, d, e, f, g, h, a, K(23), M(23) ); + R( a, b, c, d, e, f, g, h, K(24), M(24) ); + R( h, a, b, c, d, e, f, g, K(25), M(25) ); + R( g, h, a, b, c, d, e, f, K(26), M(26) ); + R( f, g, h, a, b, c, d, e, K(27), M(27) ); + R( e, f, g, h, a, b, c, d, K(28), M(28) ); + R( d, e, f, g, h, a, b, c, K(29), M(29) ); + R( c, d, e, f, g, h, a, b, K(30), M(30) ); + R( b, c, d, e, f, g, h, a, K(31), M(31) ); + R( a, b, c, d, e, f, g, h, K(32), M(32) ); + R( h, a, b, c, d, e, f, g, K(33), M(33) ); + R( g, h, a, b, c, d, e, f, K(34), M(34) ); + R( f, g, h, a, b, c, d, e, K(35), M(35) ); + R( e, f, g, h, a, b, c, d, K(36), M(36) ); + R( d, e, f, g, h, a, b, c, K(37), M(37) ); + R( c, d, e, f, g, h, a, b, K(38), M(38) ); + R( b, c, d, e, f, g, h, a, K(39), M(39) ); + R( a, b, c, d, e, f, g, h, K(40), M(40) ); + R( h, a, b, c, d, e, f, g, K(41), M(41) ); + R( g, h, a, b, c, d, e, f, K(42), M(42) ); + R( f, g, h, a, b, c, d, e, K(43), M(43) ); + R( e, f, g, h, a, b, c, d, K(44), M(44) ); + R( d, e, f, g, h, a, b, c, K(45), M(45) ); + R( c, d, e, f, g, h, a, b, K(46), M(46) ); + R( b, c, d, e, f, g, h, a, K(47), M(47) ); + R( a, b, c, d, e, f, g, h, K(48), M(48) ); + R( h, a, b, c, d, e, f, g, K(49), M(49) ); + R( g, h, a, b, c, d, e, f, K(50), M(50) ); + R( f, g, h, a, b, c, d, e, K(51), M(51) ); + R( e, f, g, h, a, b, c, d, K(52), M(52) ); + R( d, e, f, g, h, a, b, c, K(53), M(53) ); + R( c, d, e, f, g, h, a, b, K(54), M(54) ); + R( b, c, d, e, f, g, h, a, K(55), M(55) ); + R( a, b, c, d, e, f, g, h, K(56), M(56) ); + R( h, a, b, c, d, e, f, g, K(57), M(57) ); + R( g, h, a, b, c, d, e, f, K(58), M(58) ); + R( f, g, h, a, b, c, d, e, K(59), M(59) ); + R( e, f, g, h, a, b, c, d, K(60), M(60) ); + R( d, e, f, g, h, a, b, c, K(61), M(61) ); + R( c, d, e, f, g, h, a, b, K(62), M(62) ); + R( b, c, d, e, f, g, h, a, K(63), M(63) ); + R( a, b, c, d, e, f, g, h, K(64), M(64) ); + R( h, a, b, c, d, e, f, g, K(65), M(65) ); + R( g, h, a, b, c, d, e, f, K(66), M(66) ); + R( f, g, h, a, b, c, d, e, K(67), M(67) ); + R( e, f, g, h, a, b, c, d, K(68), M(68) ); + R( d, e, f, g, h, a, b, c, K(69), M(69) ); + R( c, d, e, f, g, h, a, b, K(70), M(70) ); + R( b, c, d, e, f, g, h, a, K(71), M(71) ); + R( a, b, c, d, e, f, g, h, K(72), M(72) ); + R( h, a, b, c, d, e, f, g, K(73), M(73) ); + R( g, h, a, b, c, d, e, f, K(74), M(74) ); + R( f, g, h, a, b, c, d, e, K(75), M(75) ); + R( e, f, g, h, a, b, c, d, K(76), M(76) ); + R( d, e, f, g, h, a, b, c, K(77), M(77) ); + R( c, d, e, f, g, h, a, b, K(78), M(78) ); + R( b, c, d, e, f, g, h, a, K(79), M(79) ); + + a = ctx->state[0] = u64plus (ctx->state[0], a); + b = ctx->state[1] = u64plus (ctx->state[1], b); + c = ctx->state[2] = u64plus (ctx->state[2], c); + d = ctx->state[3] = u64plus (ctx->state[3], d); + e = ctx->state[4] = u64plus (ctx->state[4], e); + f = ctx->state[5] = u64plus (ctx->state[5], f); + g = ctx->state[6] = u64plus (ctx->state[6], g); + h = ctx->state[7] = u64plus (ctx->state[7], h); + } +} === added file 'lib/sha512.h' --- lib/sha512.h 1970-01-01 00:00:00 +0000 +++ lib/sha512.h 2011-06-21 08:45:39 +0000 @@ -0,0 +1,95 @@ +/* Declarations of functions and data types used for SHA512 and SHA384 sum + library functions. + Copyright (C) 2005-2006, 2008-2011 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program 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 this program. If not, see . */ + +#ifndef SHA512_H +# define SHA512_H 1 + +# include + +# include "u64.h" + +# ifdef __cplusplus +extern "C" { +# endif + +/* Structure to save state of computation between the single steps. */ +struct sha512_ctx +{ + u64 state[8]; + + u64 total[2]; + size_t buflen; + u64 buffer[32]; +}; + +enum { SHA384_DIGEST_SIZE = 384 / 8 }; +enum { SHA512_DIGEST_SIZE = 512 / 8 }; + +/* Initialize structure containing state of computation. */ +extern void sha512_init_ctx (struct sha512_ctx *ctx); +extern void sha384_init_ctx (struct sha512_ctx *ctx); + +/* Starting with the result of former calls of this function (or the + initialization function update the context for the next LEN bytes + starting at BUFFER. + It is necessary that LEN is a multiple of 128!!! */ +extern void sha512_process_block (const void *buffer, size_t len, + struct sha512_ctx *ctx); + +/* Starting with the result of former calls of this function (or the + initialization function update the context for the next LEN bytes + starting at BUFFER. + It is NOT required that LEN is a multiple of 128. */ +extern void sha512_process_bytes (const void *buffer, size_t len, + struct sha512_ctx *ctx); + +/* Process the remaining bytes in the buffer and put result from CTX + in first 64 (48) bytes following RESBUF. The result is always in little + endian byte order, so that a byte-wise output yields to the wanted + ASCII representation of the message digest. */ +extern void *sha512_finish_ctx (struct sha512_ctx *ctx, void *resbuf); +extern void *sha384_finish_ctx (struct sha512_ctx *ctx, void *resbuf); + + +/* Put result from CTX in first 64 (48) bytes following RESBUF. The result is + always in little endian byte order, so that a byte-wise output yields + to the wanted ASCII representation of the message digest. + + IMPORTANT: On some systems it is required that RESBUF is correctly + aligned for a 32 bits value. */ +extern void *sha512_read_ctx (const struct sha512_ctx *ctx, void *resbuf); +extern void *sha384_read_ctx (const struct sha512_ctx *ctx, void *resbuf); + + +/* Compute SHA512 (SHA384) message digest for bytes read from STREAM. The + resulting message digest number will be written into the 64 (48) bytes + beginning at RESBLOCK. */ +extern int sha512_stream (FILE *stream, void *resblock); +extern int sha384_stream (FILE *stream, void *resblock); + +/* Compute SHA512 (SHA384) message digest for LEN bytes beginning at BUFFER. The + result is always in little endian byte order, so that a byte-wise + output yields to the wanted ASCII representation of the message + digest. */ +extern void *sha512_buffer (const char *buffer, size_t len, void *resblock); +extern void *sha384_buffer (const char *buffer, size_t len, void *resblock); + +# ifdef __cplusplus +} +# endif + +#endif === added file 'lib/u64.h' --- lib/u64.h 1970-01-01 00:00:00 +0000 +++ lib/u64.h 2011-06-21 08:45:39 +0000 @@ -0,0 +1,158 @@ +/* uint64_t-like operations that work even on hosts lacking uint64_t + + Copyright (C) 2006, 2009-2011 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program 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 this program. If not, see . */ + +/* Written by Paul Eggert. */ + +#include + +/* Return X rotated left by N bits, where 0 < N < 64. */ +#define u64rol(x, n) u64or (u64shl (x, n), u64shr (x, 64 - n)) + +#ifdef UINT64_MAX + +/* Native implementations are trivial. See below for comments on what + these operations do. */ +typedef uint64_t u64; +# define u64hilo(hi, lo) ((u64) (((u64) (hi) << 32) + (lo))) +# define u64init(hi, lo) u64hilo (hi, lo) +# define u64lo(x) ((u64) (x)) +# define u64lt(x, y) ((x) < (y)) +# define u64and(x, y) ((x) & (y)) +# define u64or(x, y) ((x) | (y)) +# define u64xor(x, y) ((x) ^ (y)) +# define u64plus(x, y) ((x) + (y)) +# define u64shl(x, n) ((x) << (n)) +# define u64shr(x, n) ((x) >> (n)) + +#else + +/* u64 is a 64-bit unsigned integer value. + u64init (HI, LO), is like u64hilo (HI, LO), but for use in + initializer contexts. */ +# ifdef WORDS_BIGENDIAN +typedef struct { uint32_t hi, lo; } u64; +# define u64init(hi, lo) { hi, lo } +# else +typedef struct { uint32_t lo, hi; } u64; +# define u64init(hi, lo) { lo, hi } +# endif + +/* Given the high and low-order 32-bit quantities HI and LO, return a u64 + value representing (HI << 32) + LO. */ +static inline u64 +u64hilo (uint32_t hi, uint32_t lo) +{ + u64 r; + r.hi = hi; + r.lo = lo; + return r; +} + +/* Return a u64 value representing LO. */ +static inline u64 +u64lo (uint32_t lo) +{ + u64 r; + r.hi = 0; + r.lo = lo; + return r; +} + +/* Return X < Y. */ +static inline int +u64lt (u64 x, u64 y) +{ + return x.hi < y.hi || (x.hi == y.hi && x.lo < y.lo); +} + +/* Return X & Y. */ +static inline u64 +u64and (u64 x, u64 y) +{ + u64 r; + r.hi = x.hi & y.hi; + r.lo = x.lo & y.lo; + return r; +} + +/* Return X | Y. */ +static inline u64 +u64or (u64 x, u64 y) +{ + u64 r; + r.hi = x.hi | y.hi; + r.lo = x.lo | y.lo; + return r; +} + +/* Return X ^ Y. */ +static inline u64 +u64xor (u64 x, u64 y) +{ + u64 r; + r.hi = x.hi ^ y.hi; + r.lo = x.lo ^ y.lo; + return r; +} + +/* Return X + Y. */ +static inline u64 +u64plus (u64 x, u64 y) +{ + u64 r; + r.lo = x.lo + y.lo; + r.hi = x.hi + y.hi + (r.lo < x.lo); + return r; +} + +/* Return X << N. */ +static inline u64 +u64shl (u64 x, int n) +{ + u64 r; + if (n < 32) + { + r.hi = (x.hi << n) | (x.lo >> (32 - n)); + r.lo = x.lo << n; + } + else + { + r.hi = x.lo << (n - 32); + r.lo = 0; + } + return r; +} + +/* Return X >> N. */ +static inline u64 +u64shr (u64 x, int n) +{ + u64 r; + if (n < 32) + { + r.hi = x.hi >> n; + r.lo = (x.hi << (32 - n)) | (x.lo >> n); + } + else + { + r.hi = 0; + r.lo = x.hi >> (n - 32); + } + return r; +} + +#endif === modified file 'm4/gl-comp.m4' --- m4/gl-comp.m4 2011-06-15 22:27:54 +0000 +++ m4/gl-comp.m4 2011-06-21 08:45:39 +0000 @@ -32,6 +32,8 @@ # Code from module careadlinkat: # Code from module crypto/md5: # Code from module crypto/sha1: + # Code from module crypto/sha256: + # Code from module crypto/sha512: # Code from module dosname: # Code from module dtoastr: # Code from module extensions: @@ -70,6 +72,7 @@ # Code from module sys_stat: # Code from module time: # Code from module time_r: + # Code from module u64: # Code from module unistd: # Code from module verify: # Code from module warn-on-use: @@ -94,6 +97,8 @@ AC_CHECK_FUNCS_ONCE([readlinkat]) gl_MD5 gl_SHA1 +gl_SHA256 +gl_SHA512 AC_REQUIRE([gl_C99_STRTOLD]) gl_FILEMODE gl_GETLOADAVG @@ -165,6 +170,7 @@ gl_PREREQ_TIME_R fi gl_TIME_MODULE_INDICATOR([time_r]) +AC_REQUIRE([AC_C_INLINE]) gl_UNISTD_H gl_gnulib_enabled_dosname=false gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=false @@ -413,6 +419,10 @@ lib/readlink.c lib/sha1.c lib/sha1.h + lib/sha256.c + lib/sha256.h + lib/sha512.c + lib/sha512.h lib/stat.c lib/stdarg.in.h lib/stdbool.in.h @@ -431,6 +441,7 @@ lib/sys_stat.in.h lib/time.in.h lib/time_r.c + lib/u64.h lib/unistd.in.h lib/verify.h m4/00gnulib.m4 @@ -449,6 +460,8 @@ m4/multiarch.m4 m4/readlink.m4 m4/sha1.m4 + m4/sha256.m4 + m4/sha512.m4 m4/socklen.m4 m4/ssize_t.m4 m4/st_dm_mode.m4 === added file 'm4/sha256.m4' --- m4/sha256.m4 1970-01-01 00:00:00 +0000 +++ m4/sha256.m4 2011-06-21 08:45:39 +0000 @@ -0,0 +1,12 @@ +# sha256.m4 serial 5 +dnl Copyright (C) 2005, 2008-2011 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_SHA256], +[ + dnl Prerequisites of lib/sha256.c. + AC_REQUIRE([gl_BIGENDIAN]) + AC_REQUIRE([AC_C_INLINE]) +]) === added file 'm4/sha512.m4' --- m4/sha512.m4 1970-01-01 00:00:00 +0000 +++ m4/sha512.m4 2011-06-21 08:45:39 +0000 @@ -0,0 +1,12 @@ +# sha512.m4 serial 6 +dnl Copyright (C) 2005-2006, 2008-2011 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_SHA512], +[ + dnl Prerequisites of lib/sha512.c. + AC_REQUIRE([gl_BIGENDIAN]) + AC_REQUIRE([AC_C_INLINE]) +]) ------------------------------------------------------------ revno: 104652 committer: martin rudalics branch nick: trunk timestamp: Tue 2011-06-21 10:29:43 +0200 message: Handle old buffer display options more faithfully. * window.el (display-buffer-alist): In default value do not enforce searching a window on any but the selected frame. Reported by Katsumi Yamaoka . (display-buffer-select-window): Remove function. (display-buffer-in-window): When a window on another frame gets reused, do not select it any more but just raise its frame if necessary (Bug#8851) and (Bug#8856). (display-buffer-normalize-options): Handle pop-up-frames related options more faithfully. (pop-to-buffer): Don't rely on `display-buffer' selecting the window if it is on another frame. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-21 03:16:02 +0000 +++ lisp/ChangeLog 2011-06-21 08:29:43 +0000 @@ -1,3 +1,17 @@ +2011-06-21 Martin Rudalics + + * window.el (display-buffer-alist): In default value do not + enforce searching a window on any but the selected frame. + Reported by Katsumi Yamaoka . + (display-buffer-select-window): Remove function. + (display-buffer-in-window): When a window on another frame gets + reused, do not select it any more but just raise its frame if + necessary (Bug#8851) and (Bug#8856). + (display-buffer-normalize-options): Handle pop-up-frames related + options more faithfully. + (pop-to-buffer): Don't rely on `display-buffer' selecting the + window if it is on another frame. + 2011-06-21 Vincent Belaïche * play/5x5.el (5x5-solve-rotate-left, 5x5-solve-rotate-right): @@ -75,14 +89,6 @@ * net/rcirc.el: Delete trailing whitespaces once and for all. -2011-06-20 Martin Rudalics - - * window.el (get-window-with-predicate): Start scanning with - window following selected window to restore Emacs 23 behavior. - Clarify doc-string. - (get-buffer-window-list): Start scanning with selected window to - restore Emacs 23 behavior. Clarify doc-string. - 2011-06-20 Daniel Colascione * emacs-lisp/syntax.el (syntax-ppss): Further improve docstring. === modified file 'lisp/window.el' --- lisp/window.el 2011-06-20 08:41:57 +0000 +++ lisp/window.el 2011-06-21 08:29:43 +0000 @@ -3862,8 +3862,8 @@ (defcustom display-buffer-alist '((((regexp . ".*")) - ;; Reuse window showing same buffer. - reuse-window (reuse-window nil same visible) + ;; Reuse window showing same buffer on same frame. + reuse-window (reuse-window nil same nil) ;; Pop up window. pop-up-window ;; Split largest or lru window. @@ -4723,22 +4723,6 @@ ((functionp set-width) (ignore-errors (funcall set-width window)))))) -;; We have to work around the deficiency that the command loop does not -;; preserve the selected window when it is on a frame that hasn't been -;; raised or given input focus. So we have to (1) select the window -;; used for displaying a buffer and (2) raise its frame if necessary, -;; thus defeating one primary principle of `display-buffer' namely to -;; _not_ select the window chosen for displaying the buffer :-( -(defun display-buffer-select-window (window &optional norecord) - "Select WINDOW and raise its frame if necessary." - (let ((old-frame (selected-frame)) - (new-frame (window-frame window))) - ;; Select WINDOW _before_ raising the frame to assure that the mouse - ;; cursor moves into the correct window. - (select-window window norecord) - (unless (eq old-frame new-frame) - (select-frame-set-input-focus new-frame)))) - (defun display-buffer-in-window (buffer window specifiers) "Display BUFFER in WINDOW and raise its frame if needed. WINDOW must be a live window and defaults to the selected one. @@ -4759,8 +4743,16 @@ (set-window-dedicated-p window dedicated)) (when no-other-window (set-window-parameter window 'no-other-window t)) - (unless (eq old-frame new-frame) - (display-buffer-select-window window)) + (unless (or (eq old-frame new-frame) + (not (frame-visible-p new-frame)) + ;; Assume the selected frame is already visible enough. + (eq new-frame (selected-frame)) + ;; Assume the frame from which we invoked the minibuffer + ;; is visible. + (and (minibuffer-window-active-p (selected-window)) + (eq new-frame + (window-frame (minibuffer-selected-window))))) + (raise-frame new-frame)) ;; Return window. window)) @@ -5357,11 +5349,14 @@ BUFFER-OR-NAME is the buffer to display. This routine provides a compatibility layer for the now obsolete Emacs 23 buffer display options." - (let* ((buffer (normalize-live-buffer buffer-or-name)) - (buffer-name (buffer-name buffer)) - specifiers) - ;; Disable warnings, there are too many obsolete options here. - (with-no-warnings + (with-no-warnings + (let* ((buffer (normalize-live-buffer buffer-or-name)) + (buffer-name (buffer-name buffer)) + (use-pop-up-frames + (or (and (eq pop-up-frames 'graphic-only) + (display-graphic-p)) + pop-up-frames)) + specifiers) ;; `even-window-heights', unless nil or unset. (unless (memq even-window-heights '(nil unset)) (setq specifiers @@ -5408,10 +5403,8 @@ (cons 'largest fun) (cons 'lru fun)) specifiers)))) - ;; `pop-up-frame' group. Add things if `pop-up-frames' is non-nil - ;; (we ignore the problem that callers usually don't care about - ;; graphic-only). - (when pop-up-frames + ;; `pop-up-frame' group. + (when use-pop-up-frames ;; `pop-up-frame-function'. If `pop-up-frame-function' uses the ;; now obsolete `pop-up-frame-alist' it will continue to do so. (setq specifiers @@ -5419,7 +5412,16 @@ specifiers)) ;; `pop-up-frame' (setq specifiers - (cons (list 'pop-up-frame pop-up-frames) specifiers))) + (cons (list 'pop-up-frame t) specifiers))) + + ;; `pop-up-windows' and `use-pop-up-frames' both nil means means + ;; we are supposed to reuse any window on the same frame (unless + ;; we find one showing the same buffer already). + (unless (or pop-up-windows use-pop-up-frames) + ;; `reuse-window' showing any buffer on same frame. + (setq specifiers + (cons (list 'reuse-window nil nil nil) + specifiers))) ;; `special-display-p' group. (when special-display-function @@ -5432,6 +5434,19 @@ (when (listp pars) pars)) specifiers))))) + ;; `pop-up-frames', `display-buffer-reuse-frames', and + ;; `last-nonminibuffer-frame' set means search for a window shoing + ;; the same buffer of another frame. + (let ((frames (or (last-nonminibuffer-frame) + (and (or use-pop-up-frames + display-buffer-reuse-frames) + ;; All visible or iconfied frames. + 0)))) + (when frames + (setq specifiers + (cons (list 'reuse-window 'other 'same frames) + specifiers)))) + ;; `same-window-p' group. (when (same-window-p buffer-name) ;; Try to reuse the same (selected) window. @@ -5439,25 +5454,9 @@ (cons (list 'reuse-window 'same nil nil) specifiers))) - ;; `pop-up-windows' and `pop-up-frames' both nil means means we - ;; are supposed to reuse any window (unless we find one showing - ;; the same buffer already). - (unless (or pop-up-windows pop-up-frames) - ;; `reuse-window' showing any buffer on same frame. - (setq specifiers - (cons (list 'reuse-window nil nil nil) - specifiers))) - - ;; `display-buffer-reuse-frames' or `pop-up-frames' non-nil means - ;; we are supposed to reuse a window showing the same buffer on - ;; another frame. - (when (or display-buffer-reuse-frames pop-up-frames) - ;; `reuse-window' showing same buffer on visible frame. - (setq specifiers - (cons (list 'reuse-window nil 'same 0) specifiers))) - ;; Prepend "reuse window on same frame if showing the buffer - ;; already" specifier. + ;; already" specifier. It will be overriden by the application + ;; supplied 'other-window specifier. (setq specifiers (cons (list 'reuse-window nil 'same nil) specifiers)) @@ -5761,11 +5760,21 @@ additional information." (interactive "BPop to buffer:\nP") (let ((buffer (normalize-buffer-to-display buffer-or-name)) - window) + (old-window (selected-window)) + (old-frame (selected-frame)) + new-window new-frame) (set-buffer buffer) - (when (setq window (display-buffer buffer specifiers label)) - (select-window window norecord) - buffer))) + (setq new-window (display-buffer buffer specifiers label)) + (unless (eq new-window old-window) + ;; `display-buffer' has chosen another window, select it. + (select-window new-window norecord) + (setq new-frame (window-frame new-window)) + (unless (eq new-frame old-frame) + ;; `display-buffer' has chosen another frame, make sure it gets + ;; input focus and is risen. + (select-frame-set-input-focus new-frame))) + + buffer)) (defsubst pop-to-buffer-same-window (&optional buffer-or-name norecord label) "Pop to buffer specified by BUFFER-OR-NAME in the selected window. ------------------------------------------------------------ revno: 104651 author: Vincent Belaïche committer: Stefan Monnier branch nick: trunk timestamp: Mon 2011-06-20 23:16:02 -0400 message: * lisp/play/5x5.el (5x5-solve-rotate-left, 5x5-solve-rotate-right): New funs. (5x5-mode-map, 5x5-mode-menu): Bind them. (5x5-draw-grid): Tweak the solver's rendering. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-21 02:10:10 +0000 +++ lisp/ChangeLog 2011-06-21 03:16:02 +0000 @@ -1,3 +1,10 @@ +2011-06-21 Vincent Belaïche + + * play/5x5.el (5x5-solve-rotate-left, 5x5-solve-rotate-right): + New functions. + (5x5-mode-map, 5x5-mode-menu): Bind them. + (5x5-draw-grid): Tweak the solver's rendering. + 2011-06-21 Stefan Monnier * progmodes/compile.el (compilation-error-regexp-alist-alist): Rename === modified file 'lisp/play/5x5.el' --- lisp/play/5x5.el 2011-05-24 18:22:09 +0000 +++ lisp/play/5x5.el 2011-06-21 03:16:02 +0000 @@ -144,6 +144,8 @@ (define-key map [(control c) (control x)] #'5x5-crack-xor-mutate) (define-key map "n" #'5x5-new-game) (define-key map "s" #'5x5-solve-suggest) + (define-key map "<" #'5x5-solve-rotate-left) + (define-key map ">" #'5x5-solve-rotate-right) (define-key map "q" #'5x5-quit-game) map) "Local keymap for the 5x5 game.") @@ -174,6 +176,9 @@ ["Quit game" 5x5-quit-game t] "---" ["Use Calc solver" 5x5-solve-suggest t] + ["Rotate left list of Calc solutions" 5x5-solve-rotate-left t] + ["Rotate right list of Calc solutions" 5x5-solve-rotate-right t] + "---" ["Crack randomly" 5x5-crack-randomly t] ["Crack mutating current" 5x5-crack-mutating-current t] ["Crack mutating best" 5x5-crack-mutating-best t] @@ -207,18 +212,21 @@ 5x5 keyboard bindings are: \\<5x5-mode-map> -Flip \\[5x5-flip-current] -Move up \\[5x5-up] -Move down \\[5x5-down] -Move left \\[5x5-left] -Move right \\[5x5-right] -Start new game \\[5x5-new-game] -New game with random grid \\[5x5-randomize] -Random cracker \\[5x5-crack-randomly] -Mutate current cracker \\[5x5-crack-mutating-current] -Mutate best cracker \\[5x5-crack-mutating-best] -Mutate xor cracker \\[5x5-crack-xor-mutate] -Quit current game \\[5x5-quit-game]" +Flip \\[5x5-flip-current] +Move up \\[5x5-up] +Move down \\[5x5-down] +Move left \\[5x5-left] +Move right \\[5x5-right] +Start new game \\[5x5-new-game] +New game with random grid \\[5x5-randomize] +Random cracker \\[5x5-crack-randomly] +Mutate current cracker \\[5x5-crack-mutating-current] +Mutate best cracker \\[5x5-crack-mutating-best] +Mutate xor cracker \\[5x5-crack-xor-mutate] +Solve with Calc \\[5x5-solve-suggest] +Rotate left Calc Solutions \\[5x5-solve-rotate-left] +Rotate right Calc Solutions \\[5x5-solve-rotate-right] +Quit current game \\[5x5-quit-game]" (interactive "P") (setq 5x5-cracking nil) @@ -331,9 +339,14 @@ (forward-char (+ 1 (/ (1+ 5x5-x-scale) 2))) (dotimes (x 5x5-grid-size) (when (5x5-cell solution-grid y x) + (if (= 0 (mod 5x5-x-scale 2)) + (progn + (insert "()") + (delete-region (point) (+ (point) 2)) + (backward-char 2)) (insert-char ?O 1) (delete-char 1) - (backward-char)) + (backward-char))) (forward-char (1+ 5x5-x-scale)))) (forward-line 5x5-y-scale)))) (setq 5x5-solver-output nil))) @@ -790,6 +803,64 @@ (5x5-draw-grid (list 5x5-grid)) (5x5-position-cursor)) +(defun 5x5-solve-rotate-left (&optional n) + "Rotate left by N the list of solutions in 5x5-solver-output. + +If N is not supplied rotate by 1, that is to say put the last +element first in the list. + +The 5x5 game has in general several solutions. For grid size=5, +there are 4 possible solutions. When function +`5x5-solve-suggest' (press `\\[5x5-solve-suggest]') is called the +solution that is presented is the one that needs least number of +strokes --- other solutions can be viewed by rotating through the +list. The list of solution is ordered by number of strokes, so +rotating left just after calling `5x5-solve-suggest' will show +the the solution with second least number of strokes, while +rotating right will show the solution with greatest number of +strokes." + (interactive "P") + (let ((len (length 5x5-solver-output))) + (when (>= len 3) + (setq n (if (integerp n) n 1) + n (mod n (1- len))) + (unless (eq n 0) + (setq n (- len n 1)) + (let* ((p-tail (last 5x5-solver-output (1+ n))) + (tail (cdr p-tail)) + (l-tail (last tail))) + ;; + ;; For n = 2: + ;; + ;; +--+--+ +--+--+ +--+--+ +--+--+ +--+--+ + ;; |M | ---->|S1| ---->|S2| ---->|S3| ---->|S4| ----> nil + ;; +--+--+ +--+--+ +--+--+ +--+--+ +--+--+ + ;; ^ ^ ^ ^ + ;; | | | | + ;; + 5x5-solver-output | | + l-tail + ;; + p-tail | + ;; + tail + ;; + (setcdr l-tail (cdr 5x5-solver-output)) + (setcdr 5x5-solver-output tail) + (unless (eq p-tail 5x5-solver-output) + (setcdr p-tail nil))) + (5x5-draw-grid (list 5x5-grid)) + (5x5-position-cursor))))) + +(defun 5x5-solve-rotate-right (&optional n) + "Rotate right by N the list of solutions in 5x5-solver-output. +If N is not supplied, rotate by 1. Similar to function +`5x5-solve-rotate-left' except that rotation is right instead of +lest." + (interactive "P") + (setq n + (if (integerp n) (- n) + -1)) + (5x5-solve-rotate-left n)) + + + ;; Keyboard response functions. (defun 5x5-flip-current () ------------------------------------------------------------ revno: 104650 fixes bug(s): http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8585 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2011-06-20 22:10:10 -0400 message: * lisp/progmodes/compile.el (compilation-error-regexp-alist-alist): Rename `caml' to `python-tracebacks-and-caml'; allow leading tabs. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-21 01:49:36 +0000 +++ lisp/ChangeLog 2011-06-21 02:10:10 +0000 @@ -1,8 +1,13 @@ +2011-06-21 Stefan Monnier + + * progmodes/compile.el (compilation-error-regexp-alist-alist): Rename + `caml' to `python-tracebacks-and-caml'; allow leading tabs (bug#8585). + 2011-06-21 Drew Adams * menu-bar.el: Use function variable instead of switch-to-buffer. (menu-bar-select-buffer-function): New variable. - (menu-bar-update-buffers): Use it. + (menu-bar-update-buffers): Use it (bug#8876). 2011-06-21 Stefan Monnier @@ -18,15 +23,16 @@ 2011-06-20 Stefan Monnier - * minibuffer.el (completion-metadata): Prepend the alist with `metadata'. + * minibuffer.el (completion-metadata): Add `metadata' to the alist. (completion-try-completion, completion-all-completions): Compute the metadata argument if it's missing; make it optional (bug#8795). - * wid-edit.el: Use lexical scoping and move towards completion-at-point. + * wid-edit.el: Use lex-bind and move towards completion-at-point. (widget-complete): Use new :completion-function property. (widget-completions-at-point): New function. (default): Use :completion-function instead of :complete. - (widget-default-completions): Rename from widget-default-complete, rewrite. + (widget-default-completions): Rename from widget-default-complete; + Rewrite. (widget-string-complete, widget-file-complete, widget-color-complete): Remove functions. (file, symbol, function, variable, coding-system, color): === modified file 'lisp/progmodes/compile.el' --- lisp/progmodes/compile.el 2011-05-09 19:42:45 +0000 +++ lisp/progmodes/compile.el 2011-06-21 02:10:10 +0000 @@ -155,8 +155,8 @@ \\([a-zA-Z]?:?[^:( \t\n]+\\)\ \\([0-9]+\\)\\(?:[) \t]\\|:[^0-9\n]\\)" 2 3 nil (1)) - (caml - "^ *File \\(\"?\\)\\([^,\" \n\t<>]+\\)\\1, lines? \\([0-9]+\\)-?\\([0-9]+\\)?\\(?:$\\|,\ + (python-tracebacks-and-caml + "^[ \t]*File \\(\"?\\)\\([^,\" \n\t<>]+\\)\\1, lines? \\([0-9]+\\)-?\\([0-9]+\\)?\\(?:$\\|,\ \\(?: characters? \\([0-9]+\\)-?\\([0-9]+\\)?:\\)?\\([ \n]Warning:\\)?\\)" 2 (3 . 4) (5 . 6) (7)) ------------------------------------------------------------ revno: 104649 author: Drew Adams committer: Stefan Monnier branch nick: trunk timestamp: Mon 2011-06-20 21:49:36 -0400 message: * lisp/menu-bar.el: Use function variable instead of switch-to-buffer. (menu-bar-select-buffer-function): New variable. (menu-bar-update-buffers): Use it. diff: === modified file 'etc/NEWS' --- etc/NEWS 2011-06-18 21:12:33 +0000 +++ etc/NEWS 2011-06-21 01:49:36 +0000 @@ -309,6 +309,11 @@ The elisp implementation sha1.el is removed. Feature sha1 is provided by default. +** Menu-bar changes + +*** `menu-bar-select-buffer-function' lets you choose another operation +instead of `switch-to-buffer' when selecting an item in the Buffers menu. + * Editing Changes in Emacs 24.1 === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-21 01:43:56 +0000 +++ lisp/ChangeLog 2011-06-21 01:49:36 +0000 @@ -1,3 +1,9 @@ +2011-06-21 Drew Adams + + * menu-bar.el: Use function variable instead of switch-to-buffer. + (menu-bar-select-buffer-function): New variable. + (menu-bar-update-buffers): Use it. + 2011-06-21 Stefan Monnier * emacs-lisp/bytecomp.el (add-to-list): Add handler to check the === modified file 'lisp/menu-bar.el' --- lisp/menu-bar.el 2011-05-29 19:11:23 +0000 +++ lisp/menu-bar.el 2011-06-21 01:49:36 +0000 @@ -1977,6 +1977,10 @@ ;; Used to cache the menu entries for commands in the Buffers menu (defvar menu-bar-buffers-menu-command-entries nil) +(defvar menu-bar-select-buffer-function 'switch-to-buffer + "Function to select the buffer chosen from the `Buffers' menu-bar menu. +It must accept a buffer as its only required argument.") + (defun menu-bar-update-buffers (&optional force) ;; If user discards the Buffers item, play along. (and (lookup-key (current-global-map) [menu-bar buffer]) @@ -2022,7 +2026,7 @@ (cons nil nil)) `(lambda () (interactive) - (switch-to-buffer ,(cdr pair)))))) + (funcall menu-bar-select-buffer-function ,(cdr pair)))))) (list buffers-vec)))) ;; Make a Frames menu if we have more than one frame. ------------------------------------------------------------ revno: 104648 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2011-06-20 21:43:56 -0400 message: * lisp/emacs-lisp/bytecomp.el (add-to-list): Add handler to check the variable's status. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-20 20:49:12 +0000 +++ lisp/ChangeLog 2011-06-21 01:43:56 +0000 @@ -1,3 +1,8 @@ +2011-06-21 Stefan Monnier + + * emacs-lisp/bytecomp.el (add-to-list): Add handler to check the + variable's status. + 2011-06-20 Jan Djärv * x-dnd.el (x-dnd-version-from-flags) === modified file 'lisp/emacs-lisp/bytecomp.el' --- lisp/emacs-lisp/bytecomp.el 2011-06-01 19:32:04 +0000 +++ lisp/emacs-lisp/bytecomp.el 2011-06-21 01:43:56 +0000 @@ -4244,6 +4244,25 @@ (defun byte-compile-form-make-variable-buffer-local (form) (byte-compile-keep-pending form 'byte-compile-normal-call)) +(byte-defop-compiler-1 add-to-list byte-compile-add-to-list) +(defun byte-compile-add-to-list (form) + ;; FIXME: This could be used for `set' as well, except that it's got + ;; its own opcode, so the final `byte-compile-normal-call' needs to + ;; be replaced with something else. + (pcase form + (`(,fun ',var . ,_) + (byte-compile-check-variable var 'assign) + (if (assq var byte-compile--lexical-environment) + (byte-compile-log-warning + (format "%s cannot use lexical var `%s'" fun var) + nil :error) + (unless (or (not (byte-compile-warning-enabled-p 'free-vars)) + (boundp var) + (memq var byte-compile-bound-variables) + (memq var byte-compile-free-references)) + (byte-compile-warn "assignment to free variable `%S'" var) + (push var byte-compile-free-references))))) + (byte-compile-normal-call form)) ;;; tags ------------------------------------------------------------ revno: 104647 fixes bug(s): http://debbugs.gnu.org/8899 committer: Jan D. branch nick: trunk timestamp: Mon 2011-06-20 22:49:12 +0200 message: * x-dnd.el (x-dnd-version-from-flags) (x-dnd-more-than-3-from-flags): New functions that handle long-as-cons and long as number. (x-dnd-handle-xdnd): Call functions above. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-20 20:16:20 +0000 +++ lisp/ChangeLog 2011-06-20 20:49:12 +0000 @@ -1,3 +1,10 @@ +2011-06-20 Jan Djärv + + * x-dnd.el (x-dnd-version-from-flags) + (x-dnd-more-than-3-from-flags): New functions that handle long-as-cons + and long as number (Bug#8899). + (x-dnd-handle-xdnd): Call functions above (Bug#8899). + 2011-06-20 Stefan Monnier * minibuffer.el (completion-metadata): Prepend the alist with `metadata'. === modified file 'lisp/x-dnd.el' --- lisp/x-dnd.el 2011-04-19 13:44:55 +0000 +++ lisp/x-dnd.el 2011-06-20 20:49:12 +0000 @@ -433,6 +433,18 @@ (declare-function x-get-selection-internal "xselect.c" (selection-symbol target-type &optional time-stamp)) +(defun x-dnd-version-from-flags (flags) + "Return the version byte from the 32 bit FLAGS in an XDndEnter message" + (if (consp flags) ;; Long as cons + (ash (car flags) -8) + (ash flags -24))) ;; Ordinary number + +(defun x-dnd-more-than-3-from-flags (flags) + "Return the nmore-than3 bit from the 32 bit FLAGS in an XDndEnter message" + (if (consp flags) + (logand (cdr flags) 1) + (logand flags 1))) + (defun x-dnd-handle-xdnd (event frame window message _format data) "Receive one XDND event (client message) and send the appropriate reply. EVENT is the client message. FRAME is where the mouse is now. @@ -440,9 +452,10 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent." (cond ((equal "XdndEnter" message) (let* ((flags (aref data 1)) - (version (and (consp flags) (ash (car flags) -8))) - (more-than-3 (and (consp flags) (cdr flags))) + (version (x-dnd-version-from-flags flags)) + (more-than-3 (x-dnd-more-than-3-from-flags flags)) (dnd-source (aref data 0))) + (message "%s %s" version more-than-3) (if version ;; If flags is bad, version will be nil. (x-dnd-save-state window nil nil ------------------------------------------------------------ revno: 104646 fixes bug(s): http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8795 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2011-06-20 16:16:20 -0400 message: * lisp/minibuffer.el (completion-metadata): Prepend the alist with `metadata'. (completion-try-completion, completion-all-completions): Compute the metadata argument if it's missing; make it optional. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-20 16:02:31 +0000 +++ lisp/ChangeLog 2011-06-20 20:16:20 +0000 @@ -1,5 +1,9 @@ 2011-06-20 Stefan Monnier + * minibuffer.el (completion-metadata): Prepend the alist with `metadata'. + (completion-try-completion, completion-all-completions): Compute the + metadata argument if it's missing; make it optional (bug#8795). + * wid-edit.el: Use lexical scoping and move towards completion-at-point. (widget-complete): Use new :completion-function property. (widget-completions-at-point): New function. === modified file 'lisp/minibuffer.el' --- lisp/minibuffer.el 2011-06-01 19:32:04 +0000 +++ lisp/minibuffer.el 2011-06-20 20:16:20 +0000 @@ -135,7 +135,8 @@ (let ((metadata (if (functionp table) (funcall table string pred 'metadata)))) (if (eq (car-safe metadata) 'metadata) - (cdr metadata)))) + metadata + '(metadata)))) (defun completion--field-metadata (field-start) (completion-metadata (buffer-substring-no-properties field-start (point)) @@ -513,7 +514,7 @@ (delete-dups (append (cdr over) (copy-sequence completion-styles))) completion-styles))) -(defun completion-try-completion (string table pred point metadata) +(defun completion-try-completion (string table pred point &optional metadata) "Try to complete STRING using completion table TABLE. Only the elements of table that satisfy predicate PRED are considered. POINT is the position of point within STRING. @@ -524,9 +525,12 @@ (completion--some (lambda (style) (funcall (nth 1 (assq style completion-styles-alist)) string table pred point)) - (completion--styles metadata))) + (completion--styles (or metadata + (completion-metadata + (substring string 0 point) + table pred))))) -(defun completion-all-completions (string table pred point metadata) +(defun completion-all-completions (string table pred point &optional metadata) "List the possible completions of STRING in completion table TABLE. Only the elements of table that satisfy predicate PRED are considered. POINT is the position of point within STRING. @@ -537,7 +541,10 @@ (completion--some (lambda (style) (funcall (nth 2 (assq style completion-styles-alist)) string table pred point)) - (completion--styles metadata))) + (completion--styles (or metadata + (completion-metadata + (substring string 0 point) + table pred))))) (defun minibuffer--bitset (modified completions exact) (logior (if modified 4 0) ------------------------------------------------------------ revno: 104645 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2011-06-20 12:14:01 -0400 message: * doc/misc/eshell.texi (Known problems): Fix typo. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2011-06-12 19:23:29 +0000 +++ doc/misc/ChangeLog 2011-06-20 16:14:01 +0000 @@ -1,7 +1,10 @@ +2011-06-20 Stefan Monnier + + * eshell.texi (Known problems): Fix typo. + 2011-06-12 Michael Albinus - * tramp.texi (Customizing Completion): Mention authinfo-style - files. + * tramp.texi (Customizing Completion): Mention authinfo-style files. (Password handling): `auth-source-debug' is good for debug messages. 2011-05-31 Teodor Zlatanov @@ -17,8 +20,8 @@ 2011-05-18 Teodor Zlatanov * gnus.texi (Gnus Registry Setup): Rename from "Setup". - (Store custom flags and keywords): Mention - `gnus-registry-user-format-function-M' and + (Store custom flags and keywords): + Mention `gnus-registry-user-format-function-M' and `gnus-registry-user-format-function-M2'. 2011-05-17 Paul Eggert @@ -55,8 +58,8 @@ 2011-04-14 Teodor Zlatanov * gnus.texi (nnmairix caveats, Setup, Registry Article Refer Method) - (Fancy splitting to parent, Store arbitrary data): Updated - gnus-registry docs. + (Fancy splitting to parent, Store arbitrary data): + Updated gnus-registry docs. 2011-04-13 Juanma Barranquero @@ -252,8 +255,8 @@ 2011-02-19 Glenn Morris - * dired-x.texi (Technical Details): No longer redefines dired-add-entry, - dired-initial-position, dired-clean-up-after-deletion, + * dired-x.texi (Technical Details): No longer redefines + dired-add-entry, dired-initial-position, dired-clean-up-after-deletion, dired-read-shell-command, or dired-find-buffer-nocreate. 2011-02-18 Glenn Morris @@ -339,7 +342,7 @@ * gnus-overrides.texi: Renamed from overrides.texi and all the relevant manuals use it now. - * Makefile.in (nowebhack): Fixed to use -D flag instead of overrides. + * Makefile.in (nowebhack): Fix to use -D flag instead of overrides. 2011-02-05 Katsumi Yamaoka @@ -458,7 +461,7 @@ * Makefile.in (MAKEINFO): Now controlled by `configure'. (MAKEINFO_OPTS): New variable. Use it where appropriate. - (ENVADD): Updated. + (ENVADD): Update. 2011-01-18 Glenn Morris @@ -492,8 +495,8 @@ 2010-12-17 Daiki Ueno - * epa.texi (Encrypting/decrypting *.gpg files): Mention - epa-file-select-keys. + * epa.texi (Encrypting/decrypting *.gpg files): + Mention epa-file-select-keys. 2010-12-16 Lars Magne Ingebrigtsen @@ -501,7 +504,7 @@ 2010-12-16 Teodor Zlatanov - * gnus.texi (Foreign Groups): Added clarification of foreign groups. + * gnus.texi (Foreign Groups): Add clarification of foreign groups. 2010-12-15 Andrew Cohen @@ -792,8 +795,8 @@ 2010-10-29 Lars Magne Ingebrigtsen - * gnus.texi (Client-Side IMAP Splitting): Mention - nnimap-unsplittable-articles. + * gnus.texi (Client-Side IMAP Splitting): + Mention nnimap-unsplittable-articles. 2010-10-29 Julien Danjou @@ -886,8 +889,8 @@ 2010-10-12 Daiki Ueno * epa.texi (Caching Passphrases): - * auth.texi (GnuPG and EasyPG Assistant Configuration): Clarify - some configurations require to set up gpg-agent. + * auth.texi (GnuPG and EasyPG Assistant Configuration): + Clarify some configurations require to set up gpg-agent. 2010-10-11 Glenn Morris @@ -987,14 +990,14 @@ 2010-10-03 Julien Danjou - * emacs-mime.texi (Display Customization): Update - mm-inline-large-images documentation and add documentation for + * emacs-mime.texi (Display Customization): + Update mm-inline-large-images documentation and add documentation for mm-inline-large-images-proportion. 2010-10-03 Michael Albinus - * tramp.texi (Frequently Asked Questions): Mention - remote-file-name-inhibit-cache. + * tramp.texi (Frequently Asked Questions): + Mention remote-file-name-inhibit-cache. 2010-10-02 Lars Magne Ingebrigtsen @@ -1003,15 +1006,14 @@ 2010-10-01 Lars Magne Ingebrigtsen - * gnus.texi (Splitting Mail): Mention the new fancy splitting - function. - (Article Hiding): Add google banner example. Suggested by Benjamin - Xu. + * gnus.texi (Splitting Mail): Mention the new fancy splitting function. + (Article Hiding): Add google banner example. + Suggested by Benjamin Xu. 2010-09-30 Teodor Zlatanov - * gnus.texi (Spam Package Configuration Examples, SpamOracle): Remove - nnimap-split-rule from examples. + * gnus.texi (Spam Package Configuration Examples, SpamOracle): + Remove nnimap-split-rule from examples. 2010-09-30 Lars Magne Ingebrigtsen @@ -1040,8 +1042,8 @@ 2010-09-27 Lars Magne Ingebrigtsen - * gnus.texi (Customizing the IMAP Connection): Document - nnimap-fetch-partial-articles. + * gnus.texi (Customizing the IMAP Connection): + Document nnimap-fetch-partial-articles. 2010-09-26 Lars Magne Ingebrigtsen @@ -1066,7 +1068,7 @@ 2010-09-26 Lars Magne Ingebrigtsen - * gnus.texi (NoCeM): Removed. + * gnus.texi (NoCeM): Remove. (Startup Variables): No jingle. 2010-09-25 Ulrich Mueller @@ -1166,8 +1168,8 @@ 2010-08-29 Lars Magne Ingebrigtsen - * gnus.texi (Asynchronous Fetching): Document - gnus-async-post-fetch-function. + * gnus.texi (Asynchronous Fetching): + Document gnus-async-post-fetch-function. (HTML): Made into its own section. 2010-08-26 Michael Albinus @@ -1175,8 +1177,8 @@ Sync with Tramp 2.1.19. * tramp.texi (Inline methods, Default Method): Mention - `tramp-inline-compress-start-size'. Remove "kludgy" phrase. Remove - remark about doubled "-t" argument. + `tramp-inline-compress-start-size'. Remove "kludgy" phrase. + Remove remark about doubled "-t" argument. (Auto-save and Backup): Remove reference to Emacs 21. (Filename Syntax): Describe port numbers. (Frequently Asked Questions): Adapt supported (X)Emacs versions. Adapt @@ -1426,8 +1428,8 @@ Synchronize with Tramp repository. * tramp.texi (Auto-save and Backup): Remove reference to Emacs 21. - (Frequently Asked Questions): Adapt supported (X)Emacs versions. Adapt - supported MS Windows versions. Remove obsolete URL. Use the $() + (Frequently Asked Questions): Adapt supported (X)Emacs versions. + Adapt supported MS Windows versions. Remove obsolete URL. Use the $() syntax, texi2dvi reports errors with the backquotes. * trampver.texi: Update release number. @@ -1661,8 +1663,8 @@ * dbus.texi (Type Conversion): Fix typo. (Asynchronous Methods): Rename `dbus-registered-functions-table' to `dbus-registered-objects-table'. - (Receiving Method Calls): New defun `dbus-register-property'. Move - `dbus-unregister-object' here. + (Receiving Method Calls): New defun `dbus-register-property'. + Move `dbus-unregister-object' here. 2009-11-13 Carsten Dominik @@ -1676,9 +1678,9 @@ 2009-11-13 John Wiegley - * org.texi (Tracking your habits): Added a new section in the + * org.texi (Tracking your habits): Add a new section in the manual about how to track habits. - (Resolving idle time): Added a section on how idle and + (Resolving idle time): Add a section on how idle and dangling clocks are resolved. 2009-11-13 Carsten Dominik @@ -1705,11 +1707,11 @@ should be set. (Agenda commands): Document that SPC is a filter for any tag. - (Search view): Renamed from "Keyword search". + (Search view): Rename from "Keyword search". (Capure): New chapter. (Markup): New chapter. - (Links in HTML export, Images in HTML export): Extend - the section titles. + (Links in HTML export, Images in HTML export): + Extend the section titles. (Images in HTML export): Document the align option. (Text areas in HTML export): Extend the section title. (Images in LaTeX export): Explain image placement in LaTeX. @@ -1796,8 +1798,8 @@ 2009-09-13 Chong Yidong - * dired-x.texi (Technical Details): Delete - dired-up-directory (Bug#4292). + * dired-x.texi (Technical Details): + Delete dired-up-directory (Bug#4292). 2009-09-03 Michael Albinus @@ -1810,7 +1812,7 @@ Document entry text mode. Improve documentation of the keys to include inactive time stamps into the agenda view. (Feedback): Document the new bug report command. - (Structure editing): Added an index entry for the sorting of subtrees. + (Structure editing): Add an index entry for the sorting of subtrees. 2009-09-02 Teodor Zlatanov @@ -1830,8 +1832,8 @@ 2009-08-29 Katsumi Yamaoka - * gnus.texi (Expiring Mail): Mention - gnus-mark-copied-or-moved-articles-as-expirable. + * gnus.texi (Expiring Mail): + Mention gnus-mark-copied-or-moved-articles-as-expirable. (Various Various): Mention gnus-safe-html-newsgroups. * gnus-news.texi: Mention @@ -1974,7 +1976,7 @@ #+LEATEX_HEADER in-buffer setting. (Bugs): Section removed. (Hooks): New section. - (Add-on packages): Moved here from old location. + (Add-on packages): Move here from old location. (Context-sensitive commands): New section. (Setting tags): Document newline option. (Global TODO list, Matching tags and properties): @@ -2035,8 +2037,8 @@ 2009-06-30 Michael Albinus - * tramp.texi (Inline methods, External methods, Gateway methods): Avoid - the words "kludge" and hack". + * tramp.texi (Inline methods, External methods, Gateway methods): + Avoid the words "kludge" and hack". (External methods): Add `synce' method. * trampver.texi: Update release number. @@ -2491,8 +2493,8 @@ 2009-01-09 Reiner Steib - * gnus.texi (Converting Kill Files): Fix URL. Include - gnus-kill-to-score.el in contrib directory. + * gnus.texi (Converting Kill Files): Fix URL. + Include gnus-kill-to-score.el in contrib directory. 2009-01-09 Reiner Steib @@ -2519,8 +2521,8 @@ 2008-12-20 Carsten Dominik * org.texi (Activation, Exporting, ASCII export, HTML export) - (HTML Export commands, LaTeX/PDF export commands): Improve - documentation about transient-mark-mode. + (HTML Export commands, LaTeX/PDF export commands): + Improve documentation about transient-mark-mode. (References): DOcuemtn the use of special names like $LR1 to reference to fields in the last table row. @@ -2615,7 +2617,7 @@ 2008-11-16 Michael Kifer - * viper.texi (viper-ESC-keyseq-timeout, viper-ESC-key): Removed. + * viper.texi (viper-ESC-keyseq-timeout, viper-ESC-key): Remove. * ediff.texi: Version/date change. @@ -2666,12 +2668,12 @@ 2008-09-25 Teodor Zlatanov - * message.texi (Sending Variables): Fixed variable documentation to + * message.texi (Sending Variables): Fix variable documentation to avoid the "y/n" wording. 2008-09-24 Teodor Zlatanov - * message.texi (Sending Variables): Added `message-confirm-send' doc. + * message.texi (Sending Variables): Add `message-confirm-send' doc. 2008-09-24 Katsumi Yamaoka @@ -2885,7 +2887,7 @@ 2008-06-21 Michael Albinus - * tramp.texi (Password handling): Renamed from "Password caching". + * tramp.texi (Password handling): Rename from "Password caching". Add `auth-source' mechanism. (Connection caching): Tramp reopens the connection automatically, when the operating system on the remote host has been changed. @@ -3097,8 +3099,8 @@ 2008-04-01 Daiki Ueno - * epa.texi (Encrypting/decrypting *.gpg files): Document - epa-file-name-regexp. + * epa.texi (Encrypting/decrypting *.gpg files): + Document epa-file-name-regexp. 2008-03-31 Katsumi Yamaoka @@ -3350,8 +3352,8 @@ 2008-01-09 Katsumi Yamaoka - * gnus.texi (Article Keymap): Add - gnus-article-wide-reply-with-original; fix descriptions of + * gnus.texi (Article Keymap): + Add gnus-article-wide-reply-with-original; fix descriptions of gnus-article-reply-with-original and gnus-article-followup-with-original. @@ -3424,14 +3426,14 @@ (Getting started with rcirc): Change items to reflect prompts. Add more explanation to rcirc-track-minor-mode and added a comment to warn future maintainers that this section is a copy. - (People): Changed /ignore example. + (People): Change /ignore example. (Keywords): Not keywords. 2007-12-20 Alex Schroeder * rcirc.texi (Top): Fighting Information Overload chapter added. (Getting started with rcirc): Add notice of rcirc-track-minor-mode. - (rcirc commands): Moved /ignore command to the new chapter. + (rcirc commands): Move /ignore command to the new chapter. (Fighting Information Overload): New chapter documenting /keyword, /bright, /dim, channel ignore, and low priority channels. (Configuration): Document rcirc-server-alist, remove @@ -3631,8 +3633,8 @@ 2007-10-28 Reiner Steib - * gnus.texi (Sorting the Summary Buffer): Remove - gnus-article-sort-by-date-reverse. + * gnus.texi (Sorting the Summary Buffer): + Remove gnus-article-sort-by-date-reverse. 2007-10-28 Katsumi Yamaoka @@ -3664,8 +3666,8 @@ 2007-10-28 Katsumi Yamaoka - * gnus.texi (Archived Messages): Document - gnus-update-message-archive-method. + * gnus.texi (Archived Messages): + Document gnus-update-message-archive-method. 2007-10-28 Katsumi Yamaoka @@ -3673,13 +3675,13 @@ 2007-10-28 Michaël Cadilhac - * gnus.texi (Group Maneuvering): Document - `gnus-summary-next-group-on-exit'. + * gnus.texi (Group Maneuvering): + Document `gnus-summary-next-group-on-exit'. 2007-10-28 Katsumi Yamaoka - * gnus.texi (Really Various Summary Commands): Mention - gnus-auto-select-on-ephemeral-exit. + * gnus.texi (Really Various Summary Commands): + Mention gnus-auto-select-on-ephemeral-exit. 2007-10-28 Reiner Steib @@ -3828,14 +3830,14 @@ 2007-10-28 Kevin Greiner - * gnus.texi (nntp-open-via-telnet-and-telnet): Fixed grammar. + * gnus.texi (nntp-open-via-telnet-and-telnet): Fix grammar. (Agent Parameters): Updated parameter names to match code. (Group Agent Commands): Corrected 'gnus-agent-fetch-series' as 'gnus-agent-summary-fetch-series'. (Agent and flags): New section providing a generalized discussion of flag handling. - (Agent and IMAP): Removed flag discussion. - (Agent Variables): Added 'gnus-agent-synchronize-flags'. + (Agent and IMAP): Remove flag discussion. + (Agent Variables): Add 'gnus-agent-synchronize-flags'. 2007-10-28 Romain Francoise @@ -3868,7 +3870,7 @@ * gnus.texi (Blacklists and Whitelists, BBDB Whitelists) (Gmane Spam Reporting, Bogofilter, spam-stat spam filtering) (spam-stat spam filtering, SpamOracle) - (Extending the Spam ELisp package): Removed extra quote symbol for + (Extending the Spam ELisp package): Remove extra quote symbol for clarity. 2007-10-28 Reiner Steib @@ -3885,8 +3887,8 @@ 2007-10-28 Reiner Steib - * gnus.texi (Sorting the Summary Buffer): Added - gnus-thread-sort-by-recipient. + * gnus.texi (Sorting the Summary Buffer): + Add gnus-thread-sort-by-recipient. 2007-10-28 Romain Francoise @@ -3921,8 +3923,8 @@ 2007-10-28 Simon Josefsson - * gnus.texi (Article Washing): Add libidn URL. Suggested by - Michael Cook . + * gnus.texi (Article Washing): Add libidn URL. + Suggested by Michael Cook . 2007-10-28 Lars Magne Ingebrigtsen @@ -3971,10 +3973,10 @@ everywhere for consistency. (Filtering Spam Using The Spam ELisp Package): Admonish again. (Spam ELisp Package Sequence of Events): This is Gnus, say so. - Say "regular expression" instead of "regex." Admonish. Pick - other words to sound better (s/so/thus/). - (Spam ELisp Package Filtering of Incoming Mail): Mention - statistical filters. Remove old TODO. + Say "regular expression" instead of "regex." Admonish. + Pick other words to sound better (s/so/thus/). + (Spam ELisp Package Filtering of Incoming Mail): + Mention statistical filters. Remove old TODO. (Spam ELisp Package Sorting and Score Display in Summary Buffer): New section on sorting and displaying the spam score. (BBDB Whitelists): Mention spam-use-BBDB-exclusive is not a @@ -4000,7 +4002,7 @@ 2007-10-28 Reiner Steib - * gnus.texi (Adaptive Scoring): Added gnus-adaptive-pretty-print. + * gnus.texi (Adaptive Scoring): Add gnus-adaptive-pretty-print. 2007-10-28 Simon Josefsson @@ -4014,7 +4016,7 @@ 2007-10-28 Teodor Zlatanov - * gnus.texi (Hashcash): Changed location of library, also mention + * gnus.texi (Hashcash): Change location of library, also mention that payments can be verified and fix the name of the hashcash-path variable. @@ -4034,7 +4036,7 @@ 2007-10-28 Teodor Zlatanov - * gnus.texi (SpamAssassin backend): Added new node about SpamAssassin. + * gnus.texi (SpamAssassin backend): Add new node about SpamAssassin. From Hubert Chan . 2007-10-28 Jesper Harder @@ -4052,8 +4054,8 @@ 2007-10-28 Kevin Greiner - * gnus.texi (Outgoing Messages, Agent Variables): Add - gnus-agent-queue-mail and gnus-agent-prompt-send-queue. + * gnus.texi (Outgoing Messages, Agent Variables): + Add gnus-agent-queue-mail and gnus-agent-prompt-send-queue. Suggested by Gaute Strokkenes 2007-10-28 Jesper Harder @@ -4391,8 +4393,8 @@ 2007-06-19 Jay Belanger - * calc.texi (Basic Arithmetic, Customizing Calc): Mention - the variable `calc-multiplication-has-precedence'. + * calc.texi (Basic Arithmetic, Customizing Calc): + Mention the variable `calc-multiplication-has-precedence'. 2007-06-19 Carsten Dominik @@ -4615,7 +4617,7 @@ 2007-02-25 Carsten Dominik - * org.texi (The spreadsheet): Renamed from "Table calculations". + * org.texi (The spreadsheet): Rename from "Table calculations". Completely reorganized and rewritten. (CamelCase links): Section removed. (Repeating items): New section. @@ -4893,7 +4895,7 @@ 2006-10-20 Masatake YAMATO - * cc-mode.texi (Sample .emacs File): Added missing `)' in + * cc-mode.texi (Sample .emacs File): Add missing `)' in sample code `my-c-initialization-hook'. 2006-10-19 Stuart D. Herring @@ -5057,13 +5059,13 @@ * rcirc.texi: Fix typos. (Getting started with rcirc): New calling convention for M-x irc. Mention #rcirc. Removed channel tracking. - (Configuration): Changed the names of all variables that got changed + (Configuration): Change the names of all variables that got changed recently, eg. rcirc-server to rcirc-default-server. Added documentation for rcirc-authinfo, some background for Bitlbee, and rcirc-track-minor-mode. - (Scrolling conservatively): Fixed the xref from Auto Scrolling to just + (Scrolling conservatively): Fix the xref from Auto Scrolling to just Scrolling. - (Reconnecting after you have lost the connection): Fixed example code + (Reconnecting after you have lost the connection): Fix example code to match code changes. 2006-07-10 Nick Roberts @@ -5885,8 +5887,8 @@ * faq.texi: Set VER to `22.1'. (Basic editing): Explain how to use localized versions of the - Tutorial. Mention that `C-h r' displays the manual. Delete - obsolete WWW link to an Emacs 18 tutorial. + Tutorial. Mention that `C-h r' displays the manual. + Delete obsolete WWW link to an Emacs 18 tutorial. (Getting a printed manual): Point to the new locations of the manuals on the GNU Web site. (Emacs Lisp documentation): Explain that the Emacs Lisp manual is @@ -6069,8 +6071,8 @@ 2005-10-23 Lars Hansen - * dired-x.texi (Miscellaneous Commands): Replace - dired-do-relative-symlink by dired-do-relsymlink and + * dired-x.texi (Miscellaneous Commands): + Replace dired-do-relative-symlink by dired-do-relsymlink and dired-do-relative-symlink-regexp by dired-do-relsymlink-regexp. 2005-10-23 Jay Belanger @@ -6080,8 +6082,8 @@ 2005-10-23 Michael Albinus - * faq.texi (Bugs and problems): Replace - `dired-move-to-filename-regexp' by + * faq.texi (Bugs and problems): + Replace `dired-move-to-filename-regexp' by `directory-listing-before-filename-regexp'. 2005-10-22 Eli Zaretskii @@ -6228,8 +6230,8 @@ * newsticker.texi: Replace @command with @code. Replace @example with @lisp. - (Top): Added explanations to menu items. - (GNU Free Documentation License): Removed. + (Top): Add explanations to menu items. + (GNU Free Documentation License): Remove. 2005-09-16 Romain Francoise @@ -6717,7 +6719,7 @@ 2005-01-01 Jay Belanger - * calc.texi (Programming Tutorial): Changed description of how to + * calc.texi (Programming Tutorial): Change description of how to edit keyboard macros to match current behavior. 2004-12-31 Jay Belanger @@ -6817,10 +6819,10 @@ 2004-12-08 Reiner Steib - * gnus-faq.texi ([5.1]): Added missing bracket. + * gnus-faq.texi ([5.1]): Add missing bracket. - * gnus.texi (Filtering Spam Using The Spam ELisp Package): Index - `spam-initialize'. + * gnus.texi (Filtering Spam Using The Spam ELisp Package): + Index `spam-initialize'. 2004-11-22 Reiner Steib @@ -6831,20 +6833,20 @@ 2004-11-02 Katsumi Yamaoka - * emacs-mime.texi (Encoding Customization): Fix - mm-coding-system-priorities entry. + * emacs-mime.texi (Encoding Customization): + Fix mm-coding-system-priorities entry. 2004-11-03 Jan Djärv * idlwave.texi (Continued Statement Indentation): * reftex.texi (Options (Index Support)): (Displaying and Editing the Index, Table of Contents): - * speedbar.texi (Creating a display, Major Display Modes): Replace - non-nil with non-@code{nil}. + * speedbar.texi (Creating a display, Major Display Modes): + Replace non-nil with non-@code{nil}. 2004-10-21 Jay Belanger - * calc.texi (Algebraic-Style Calculations): Removed a comment. + * calc.texi (Algebraic-Style Calculations): Remove a comment. 2004-10-18 Luc Teirlinck @@ -6852,7 +6854,7 @@ 2004-10-18 Jay Belanger - * calc.texi (Reporting Bugs): Changed the address that bugs + * calc.texi (Reporting Bugs): Change the address that bugs should be sent to. 2004-10-15 Reiner Steib @@ -6871,7 +6873,7 @@ 2004-10-12 Jay Belanger - * calc.texi (Help Commands): Changed the descriptions of + * calc.texi (Help Commands): Change the descriptions of calc-describe-function and calc-describe-variable to match their current behavior. @@ -6937,25 +6939,25 @@ 2004-09-20 Reiner Steib - * gnus.texi (MIME Commands): Added - gnus-mime-display-multipart-as-mixed, + * gnus.texi (MIME Commands): + Add gnus-mime-display-multipart-as-mixed, gnus-mime-display-multipart-alternative-as-mixed, gnus-mime-display-multipart-related-as-mixed. (Mail Source Customization): Clarify `mail-source-directory'. (Splitting Mail): Mention gnus-group-find-new-groups. - (SpamOracle): Fixed typo. + (SpamOracle): Fix typo. * gnus-faq.texi: Untabify. ([6.3]): nnir.el is in contrib directory. * message.texi (News Headers): Clarify how a unique ID is created. - * gnus.texi (Batching Agents): Fixed typo in example. Reported - by Hiroshi Fujishima . + * gnus.texi (Batching Agents): Fix typo in example. + Reported by Hiroshi Fujishima . 2004-09-20 Andre Srinivasan (tiny change) - * gnus.texi (Group Parameters): Added more on hooks. + * gnus.texi (Group Parameters): Add more on hooks. 2004-09-20 Florian Weimer @@ -6963,7 +6965,7 @@ 2004-09-22 Jay Belanger - * calc.texi (Vectors as Lists): Added a warning that the tutorial + * calc.texi (Vectors as Lists): Add a warning that the tutorial might be hidden during part of the session. 2004-09-20 Jay Belanger @@ -7056,8 +7058,8 @@ mm-content-transfer-encoding-defaults entry. (rfc2047): Update. - * gnus.texi (Article Highlighting): Add - gnus-cite-ignore-quoted-from. + * gnus.texi (Article Highlighting): + Add gnus-cite-ignore-quoted-from. (POP before SMTP): New node. (Posting Styles): Addition. (Splitting Mail): Add nnmail-split-lowercase-expanded. @@ -7071,8 +7073,8 @@ 2004-08-22 Reiner Steib - * gnus.texi (Mail Source Specifiers): Describe - `pop3-leave-mail-on-server'. + * gnus.texi (Mail Source Specifiers): + Describe `pop3-leave-mail-on-server'. 2004-08-02 Reiner Steib @@ -7099,8 +7101,8 @@ 2004-06-13 Luc Teirlinck - * autotype.texi (Copyrights, Timestamps): Recommend - `before-save-hook' instead of `write-file-functions'. + * autotype.texi (Copyrights, Timestamps): + Recommend `before-save-hook' instead of `write-file-functions'. 2004-06-13 Lars Hansen @@ -7211,7 +7213,7 @@ 2004-02-29 Simon Josefsson - * smtpmail.texi (Authentication): Changed the list of supported + * smtpmail.texi (Authentication): Change the list of supported authentication mechanisms from CRAM-MD5, PLAIN and LOGIN-MD5 to CRAM-MD5 and LOGIN, tiny patch from Andreas Voegele . @@ -7230,8 +7232,8 @@ * tramp.texi (Customizing Completion): Explain new functions `tramp-parse-shostkeys' and `tramp-parse-sknownhosts'. (all): Savannah URLs unified to "http://savannah.nongnu.org". - (Top): Refer to Savannah mailing list as the major one. Mention - older mailing lists in HTML mode only. + (Top): Refer to Savannah mailing list as the major one. + Mention older mailing lists in HTML mode only. (Auto-save and Backup): Add auto-save. Based on wording of Kai. (Frequently Asked Questions): Remote hosts must not be Unix-like for "smb" method. @@ -7420,7 +7422,7 @@ (Multi-hop Methods): Add method `remsh'. Small patch from Adrian Aichner : Fix minor typos. - (Concept Index): Added to make manual searchable via + (Concept Index): Add to make manual searchable via `Info-index'. (Version Control): Add cindex entry. @@ -7470,7 +7472,7 @@ appropriate. In info case, point to node `Installation' in order to explain how to generate the other way. In html case, make a link to the other html file. - (Obtaining TRAMP): Added a paragraph saying to perform `autoconf' + (Obtaining TRAMP): Add a paragraph saying to perform `autoconf' after CVS checkout/update. (Installation): Completely rewritten. (Installation parameters, Load paths): New sections under @@ -7523,8 +7525,8 @@ 2002-12-26 Kai Großjohann - * tramp.texi (External transfer methods): New method `smb'. From - Michael Albinus. + * tramp.texi (External transfer methods): New method `smb'. + From Michael Albinus. 2002-11-05 Karl Berry @@ -7533,8 +7535,8 @@ 2002-10-06 Kai Großjohann - * tramp.texi: Move @copying to standard place. Use - @insertcopying. + * tramp.texi: Move @copying to standard place. + Use @insertcopying. 2002-10-02 Karl Berry @@ -7992,8 +7994,8 @@ 1989-01-17 Robert J. Chassell (bob@rice-chex.ai.mit.edu) * texinfo.tex: Change spelling of `\sc' font to `\smallcaps' and - then define `\sc' as the command for smallcaps in Texinfo. This - means that the @sc command will produce small caps. bfox has + then define `\sc' as the command for smallcaps in Texinfo. + This means that the @sc command will produce small caps. bfox has made the corresponding change to makeinfo and texinfm.el. 1988-08-16 Robert J. Chassell (bob@frosted-flakes.ai.mit.edu) === modified file 'doc/misc/eshell.texi' --- doc/misc/eshell.texi 2011-02-19 19:40:59 +0000 +++ doc/misc/eshell.texi 2011-06-20 16:14:01 +0000 @@ -814,7 +814,7 @@ With the handling of @emph{word} specified by an @code{eshell-special-alist}. -@item In @code{eshell-veal-using-options}, allow a @code{:complete} tag +@item In @code{eshell-eval-using-options}, allow a @code{:complete} tag It would be used to provide completion rules for that command. Then the macro will automagically define the completion function. ------------------------------------------------------------ revno: 104644 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2011-06-20 12:02:31 -0400 message: Use completion-at-point rather than completion-in-region. * lisp/wid-edit.el: Use lexical scoping and move towards completion-at-point. (widget-complete): Use new :completion-function property. (widget-completions-at-point): New function. (default): Use :completion-function instead of :complete. (widget-default-completions): Rename from widget-default-complete, rewrite. (widget-string-complete, widget-file-complete, widget-color-complete): Remove functions. (file, symbol, function, variable, coding-system, color): * lisp/international/mule-cmds.el (default-input-method, charset) (language-info-custom-alist): * lisp/cus-edit.el (face): Use new property :completions. * lisp/progmodes/pascal.el (pascal-completions-at-point): New function. (pascal-mode): Use it. (pascal-mode-map): Use completion-at-point. (pascal-toggle-completions): Make obsolete. (pascal-complete-word, pascal-show-completions): * lisp/progmodes/octave-mod.el (octave-complete-symbol): Redefine as obsolete alias. * lisp/progmodes/octave-inf.el (inferior-octave-completion-at-point): Signal absence of completion info for old Octave, (inferior-octave-complete): Redefine as obsolete alias. * lisp/progmodes/meta-mode.el: Use lexical-binding and completion-at-point. (meta-completions-at-point): Rename from meta-complete-symbol and adapt it for use on completion-at-point-functions. (meta-common-mode): Use it. (meta-looking-at-backward, meta-match-buffer): Remove. (meta-complete-symbol): Redefine as obsolete alias. (meta-common-mode-map): Use completion-at-point. * lisp/progmodes/make-mode.el: Use lexical-binding and completion-at-point. (makefile-mode-map): Use completion-at-point. (makefile-completions-at-point): Rename from makefile-complete and adapt it for use on completion-at-point-functions. (makefile-mode): Use it. (makefile-complete): Redefine as obsolete alias. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-20 12:55:24 +0000 +++ lisp/ChangeLog 2011-06-20 16:02:31 +0000 @@ -1,3 +1,41 @@ +2011-06-20 Stefan Monnier + + * wid-edit.el: Use lexical scoping and move towards completion-at-point. + (widget-complete): Use new :completion-function property. + (widget-completions-at-point): New function. + (default): Use :completion-function instead of :complete. + (widget-default-completions): Rename from widget-default-complete, rewrite. + (widget-string-complete, widget-file-complete, widget-color-complete): + Remove functions. + (file, symbol, function, variable, coding-system, color): + * international/mule-cmds.el (default-input-method, charset) + (language-info-custom-alist): + * cus-edit.el (face): Use new property :completions. + + * progmodes/pascal.el (pascal-completions-at-point): New function. + (pascal-mode): Use it. + (pascal-mode-map): Use completion-at-point. + (pascal-toggle-completions): Make obsolete. + (pascal-complete-word, pascal-show-completions): + * progmodes/octave-mod.el (octave-complete-symbol): + Redefine as obsolete alias. + * progmodes/octave-inf.el (inferior-octave-completion-at-point): + Signal absence of completion info for old Octave, + (inferior-octave-complete): Redefine as obsolete alias. + * progmodes/meta-mode.el: Use lexical-binding and completion-at-point. + (meta-completions-at-point): Rename from meta-complete-symbol and + adapt it for use on completion-at-point-functions. + (meta-common-mode): Use it. + (meta-looking-at-backward, meta-match-buffer): Remove. + (meta-complete-symbol): Redefine as obsolete alias. + (meta-common-mode-map): Use completion-at-point. + * progmodes/make-mode.el: Use lexical-binding and completion-at-point. + (makefile-mode-map): Use completion-at-point. + (makefile-completions-at-point): Rename from makefile-complete and + adapt it for use on completion-at-point-functions. + (makefile-mode): Use it. + (makefile-complete): Redefine as obsolete alias. + 2011-06-20 Deniz Dogan * net/rcirc.el: Delete trailing whitespaces once and for all. @@ -31,8 +69,8 @@ display-buffer-normalize-options. (display-buffer-normalize-alist-1): New function. (display-buffer-normalize-specifiers-3): Rename to - display-buffer-normalize-alist. Call - display-buffer-normalize-alist-1. + display-buffer-normalize-alist. + Call display-buffer-normalize-alist-1. (display-buffer-normalize-options-inhibit): New variable. (display-buffer-normalize-specifiers): Rewrite calling display-buffer-normalize-alist, @@ -43,8 +81,8 @@ (window-deletable-p): Use frame-auto-delete. (window-list-no-nils, window-state-ignored-parameters) (window-state-get-1, window-state-get, window-state-put-list) - (window-state-put-1, window-state-put-2, window-state-put): New - functions. + (window-state-put-1, window-state-put-2, window-state-put): + New functions. (display-buffer-normalize-options): Move special-display-p group after pop-up-frame group (Bug#8851) and (Bug#8856). @@ -71,12 +109,12 @@ 2011-06-18 Martin Rudalics - * window.el (display-buffer-default-specifiers): Remove - pop-up-frame. Add pop-up-window-min-height, + * window.el (display-buffer-default-specifiers): + Remove pop-up-frame. Add pop-up-window-min-height, pop-up-window-min-width, and another reuse-window specifier (Bug#8882). Reported by Dan Nicolaescu . - (display-buffer-normalize-specifiers-2): Handle - split-height-threshold and split-width-threshold also when + (display-buffer-normalize-specifiers-2): + Handle split-height-threshold and split-width-threshold also when pop-up-windows is unset. Add a reuse-window specifier for the case popping up a new window fails. (special-display-popup-frame): Remove double quoting. @@ -112,8 +150,8 @@ (display-buffer-normalize-specifiers-2): Treat other-window case specially. (display-buffer-normalize-specifiers-3): New function. - (display-buffer-normalize-specifiers): Call - display-buffer-normalize-specifiers-3. + (display-buffer-normalize-specifiers): + Call display-buffer-normalize-specifiers-3. 2011-06-17 Martin Rudalics @@ -133,8 +171,8 @@ 2011-06-16 Martin Rudalics - * window.el (display-buffer-normalize-specifiers-1): Respect - current value of pop-up-frames for most reasonable values of + * window.el (display-buffer-normalize-specifiers-1): + Respect current value of pop-up-frames for most reasonable values of second argument of display-buffer (Bug#8865). (switch-to-buffer-same-frame, switch-to-buffer-other-window) (switch-to-buffer-other-window-same-frame) === modified file 'lisp/cus-edit.el' --- lisp/cus-edit.el 2011-04-19 13:44:55 +0000 +++ lisp/cus-edit.el 2011-06-20 16:02:31 +0000 @@ -3830,9 +3830,8 @@ :sample-face-get 'widget-face-sample-face-get :notify 'widget-face-notify :match (lambda (_widget value) (facep value)) - :complete-function (lambda () - (interactive) - (lisp-complete-symbol 'facep)) + :completions (apply-partially #'completion-table-with-predicate + obarray #'facep 'strict) :prompt-match 'facep :prompt-history 'widget-face-prompt-value-history :validate (lambda (widget) === modified file 'lisp/international/mule-cmds.el' --- lisp/international/mule-cmds.el 2011-02-28 01:07:29 +0000 +++ lisp/international/mule-cmds.el 2011-06-20 16:02:31 +0000 @@ -1308,11 +1308,11 @@ `toggle-input-method' (\\[toggle-input-method])." :link '(custom-manual "(emacs)Input Methods") :group 'mule - :type '(choice (const nil) (string - :completion-ignore-case t - :complete-function widget-string-complete - :completion-alist input-method-alist - :prompt-history input-method-history)) + :type '(choice (const nil) + (string + :completions (apply-partially + #'completion-table-case-fold input-method-alist) + :prompt-history input-method-history)) :set-after '(current-language-environment)) (put 'input-method-function 'permanent-local t) @@ -1875,10 +1875,10 @@ (define-widget 'charset 'symbol "An Emacs charset." :tag "Charset" - :complete-function (lambda () - (interactive) - (lisp-complete-symbol 'charsetp)) - :completion-ignore-case t + :completions (apply-partially #'completion-table-with-predicate + (apply-partially #'completion-table-case-fold + obarray) + #'charsetp 'strict) :value 'ascii :validate (lambda (widget) (unless (charsetp (widget-value widget)) @@ -1912,9 +1912,9 @@ (set-language-environment current-language-environment))) :type `(alist :key-type (string :tag "Language environment" - :completion-ignore-case t - :complete-function widget-string-complete - :completion-alist language-info-alist) + :completions + (apply-partially #'completion-table-case-fold + language-info-alist)) :value-type (alist :key-type symbol :options ((documentation string) @@ -1927,9 +1927,9 @@ (nonascii-translation charset) (input-method (string - :completion-ignore-case t - :complete-function widget-string-complete - :completion-alist input-method-alist + :completions + (apply-partially #'completion-table-case-fold + input-method-alist) :prompt-history input-method-history)) (features (repeat symbol)) (unibyte-display coding-system))))) === modified file 'lisp/mail/mailabbrev.el' --- lisp/mail/mailabbrev.el 2011-01-25 04:08:28 +0000 +++ lisp/mail/mailabbrev.el 2011-06-20 16:02:31 +0000 @@ -565,7 +565,6 @@ (defun mail-abbrev-complete-alias () "Perform completion on alias preceding point." - ;; Based on lisp.el:lisp-complete-symbol (interactive) (mail-abbrev-make-syntax-table) (let ((end (point)) === modified file 'lisp/progmodes/make-mode.el' --- lisp/progmodes/make-mode.el 2011-04-22 18:44:26 +0000 +++ lisp/progmodes/make-mode.el 2011-06-20 16:02:31 +0000 @@ -1,4 +1,4 @@ -;;; make-mode.el --- makefile editing commands for Emacs +;;; make-mode.el --- makefile editing commands for Emacs -*- lexical-binding:t -*- ;; Copyright (C) 1992, 1994, 1999-2011 Free Software Foundation, Inc. @@ -602,7 +602,7 @@ (define-key map "\C-c\C-m\C-p" 'makefile-makepp-mode) (define-key map "\M-p" 'makefile-previous-dependency) (define-key map "\M-n" 'makefile-next-dependency) - (define-key map "\e\t" 'makefile-complete) + (define-key map "\e\t" 'completion-at-point) ;; Make menus. (define-key map [menu-bar makefile-mode] @@ -653,7 +653,7 @@ '(menu-item "Find Targets and Macros" makefile-pickup-everything :help "Notice names of all macros and targets in Makefile")) (define-key map [menu-bar makefile-mode complete] - '(menu-item "Complete Target or Macro" makefile-complete + '(menu-item "Complete Target or Macro" completion-at-point :help "Perform completion on Makefile construct preceding point")) (define-key map [menu-bar makefile-mode backslash] '(menu-item "Backslash Region" makefile-backslash-region @@ -852,6 +852,8 @@ List of special targets. You will be offered to complete on one of those in the minibuffer whenever you enter a `.'. at the beginning of a line in Makefile mode." + (add-hook 'completion-at-point-functions + #'makefile-completions-at-point nil t) (add-hook 'write-file-functions 'makefile-warn-suspicious-lines nil t) (add-hook 'write-file-functions @@ -1147,11 +1149,7 @@ ;;; Completion. -(defun makefile-complete () - "Perform completion on Makefile construct preceding point. -Can complete variable and target names. -The context determines which are considered." - (interactive) +(defun makefile-completions-at-point () (let* ((beg (save-excursion (skip-chars-backward "^$(){}:#= \t\n") (point))) @@ -1168,22 +1166,26 @@ ;; Preceding "$(" or "${" means macros only. ((and (memq pc '(?\{ ?\()) (progn - (setq paren (if (eq paren ?\{) ?\} ?\))) + (setq paren (if (eq pc ?\{) ?\} ?\))) (backward-char) (= (preceding-char) ?$))) t))))) - - (table (apply-partially 'completion-table-with-terminator - (cond - (do-macros (or paren "")) - ((save-excursion (goto-char beg) (bolp)) ":") - (t " ")) - (append (if do-macros - '() - makefile-target-table) - makefile-macro-table)))) - (completion-in-region beg (point) table))) - + (suffix (cond + (do-macros (if paren (string paren))) + ((save-excursion (goto-char beg) (bolp)) ":") + (t " ")))) + (list beg (point) + (append (if do-macros '() makefile-target-table) + makefile-macro-table) + :exit-function + (if suffix + (lambda (_s finished) + (when (memq finished '(sole finished)) + (if (looking-at (regexp-quote suffix)) + (goto-char (match-end 0)) + (insert suffix)))))))) + +(define-obsolete-function-alias 'makefile-complete 'completion-at-point "24.1") ;; Backslashification. Stolen from cc-mode.el. === modified file 'lisp/progmodes/meta-mode.el' --- lisp/progmodes/meta-mode.el 2011-01-25 04:08:28 +0000 +++ lisp/progmodes/meta-mode.el 2011-06-20 16:02:31 +0000 @@ -1,4 +1,4 @@ -;;; meta-mode.el --- major mode for editing Metafont or MetaPost sources +;;; meta-mode.el --- major mode for editing Metafont or MetaPost sources -*- lexical-binding:t -*- ;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc. @@ -471,16 +471,13 @@ (string-lessp (car a) (car b))) -(defun meta-complete-symbol () - "Perform completion on Metafont or MetaPost symbol preceding point." - ;; FIXME: Use completion-at-point-functions. - (interactive "*") +(defun meta-completions-at-point () (let ((list meta-complete-list) entry) (while list (setq entry (car list) list (cdr list)) - (if (meta-looking-at-backward (car entry) 200) + (if (looking-back (car entry) (max (point-min) (- (point) 200))) (setq list nil))) (if (numberp (nth 1 entry)) (let* ((sub (nth 1 entry)) @@ -488,31 +485,19 @@ (begin (match-beginning sub)) (end (match-end sub)) (list (funcall (nth 2 entry)))) - (completion-in-region - begin end - (if (zerop (length close)) list - (apply-partially 'completion-table-with-terminator - close list)))) - (funcall (nth 1 entry))))) - - -(defun meta-looking-at-backward (regexp &optional limit) - ;; utility function used in `meta-complete-symbol' - (let ((pos (point))) - (save-excursion - (and (re-search-backward - regexp (if limit (max (point-min) (- (point) limit))) t) - (eq (match-end 0) pos))))) - -(defun meta-match-buffer (n) - ;; utility function used in `meta-complete-symbol' - (if (match-beginning n) - (let ((str (buffer-substring (match-beginning n) (match-end n)))) - (set-text-properties 0 (length str) nil str) - (copy-sequence str)) - "")) - - + (list + begin end list + :exit-function + (unless (zerop (length close)) + (lambda (_s finished) + (when (memq finished '(sole finished)) + (if (looking-at (regexp-quote close)) + (goto-char (match-end 0)) + (insert close))))))) + (nth 1 entry)))) + +(define-obsolete-function-alias 'meta-complete-symbol + 'completion-at-point "24.1") ;;; Indentation. @@ -906,7 +891,7 @@ (define-key map "\C-c;" 'meta-comment-region) (define-key map "\C-c:" 'meta-uncomment-region) ;; Symbol Completion: - (define-key map "\M-\t" 'meta-complete-symbol) + (define-key map "\M-\t" 'completion-at-point) ;; Shell Commands: ;; (define-key map "\C-c\C-c" 'meta-command-file) ;; (define-key map "\C-c\C-k" 'meta-kill-job) @@ -935,7 +920,7 @@ ["Uncomment Region" meta-uncomment-region :active (meta-mark-active)] "--" - ["Complete Symbol" meta-complete-symbol t] + ["Complete Symbol" completion-at-point t] ; "--" ; ["Command on Buffer" meta-command-file t] ; ["Kill Job" meta-kill-job t] @@ -994,6 +979,7 @@ (set (make-local-variable 'parse-sexp-ignore-comments) t) + (add-hook 'completion-at-point-functions #'meta-completions-at-point nil t) (set (make-local-variable 'comment-indent-function) #'meta-comment-indent) (set (make-local-variable 'indent-line-function) #'meta-indent-line) ;; No need to define a mode-specific 'indent-region-function. === modified file 'lisp/progmodes/octave-inf.el' --- lisp/progmodes/octave-inf.el 2011-04-25 16:29:31 +0000 +++ lisp/progmodes/octave-inf.el 2011-06-20 16:02:31 +0000 @@ -267,8 +267,12 @@ (save-excursion (skip-syntax-backward "w_" (comint-line-beginning-position)) (point)))) - (cond (inferior-octave-complete-impossible nil) - ((eq start end) nil) + (cond ((eq start end) nil) + (inferior-octave-complete-impossible + (message (concat + "Your Octave does not have `completion_matches'. " + "Please upgrade to version 2.X.")) + nil) (t (list start end @@ -279,19 +283,8 @@ (sort (delete-dups inferior-octave-output-list) 'string-lessp)))))))) -(defun inferior-octave-complete () - "Perform completion on the Octave symbol preceding point. -This is implemented using the Octave command `completion_matches' which -is NOT available with versions of Octave prior to 2.0." - (interactive) - (if inferior-octave-complete-impossible - (error (concat - "Your Octave does not have `completion_matches'. " - "Please upgrade to version 2.X.")) - (let ((data (inferior-octave-completion-at-point))) - (if (null data) - (message "Cannot complete an empty string") - (apply #'completion-in-region data))))) +(define-obsolete-function-alias 'inferior-octave-complete + 'completion-at-point "24.1") (defun inferior-octave-dynamic-list-input-ring () "List the buffer's input history in a help buffer." === modified file 'lisp/progmodes/octave-mod.el' --- lisp/progmodes/octave-mod.el 2011-04-25 16:29:31 +0000 +++ lisp/progmodes/octave-mod.el 2011-06-20 16:02:31 +0000 @@ -983,12 +983,8 @@ (setq end (point)))) (list beg end octave-completion-alist))) -(defun octave-complete-symbol () - "Perform completion on Octave symbol preceding point. -Compare that symbol against Octave's reserved words and builtin -variables." - (interactive) - (apply 'completion-in-region (octave-completion-at-point-function))) +(define-obsolete-function-alias 'octave-complete-symbol + 'completion-at-point "24.1") ;;; Electric characters && friends === modified file 'lisp/progmodes/pascal.el' --- lisp/progmodes/pascal.el 2011-04-29 17:34:28 +0000 +++ lisp/progmodes/pascal.el 2011-06-20 16:02:31 +0000 @@ -40,7 +40,6 @@ ;; pascal-tab-always-indent t ;; pascal-auto-endcomments t ;; pascal-auto-lineup '(all) -;; pascal-toggle-completions nil ;; pascal-type-keywords '("array" "file" "packed" "char" ;; "integer" "real" "string" "record") ;; pascal-start-keywords '("begin" "end" "function" "procedure" @@ -79,8 +78,8 @@ ;; These are user preferences, so not to set by default. ;;(define-key map "\r" 'electric-pascal-terminate-line) ;;(define-key map "\t" 'electric-pascal-tab) - (define-key map "\M-\t" 'pascal-complete-word) - (define-key map "\M-?" 'pascal-show-completions) + (define-key map "\M-\t" 'completion-at-point) + (define-key map "\M-?" 'completion-help-at-point) (define-key map "\177" 'backward-delete-char-untabify) (define-key map "\M-\C-h" 'pascal-mark-defun) (define-key map "\C-c\C-b" 'pascal-insert-block) @@ -232,13 +231,13 @@ (const :tag "Case statements" case)) :group 'pascal) -(defcustom pascal-toggle-completions nil - "*Non-nil means \\\\[pascal-complete-word] should try all possible completions one by one. -Repeated use of \\[pascal-complete-word] will show you all of them. +(defvar pascal-toggle-completions nil + "*Non-nil meant \\\\[pascal-complete-word] would try all possible completions one by one. +Repeated use of \\[pascal-complete-word] would show you all of them. Normally, when there is more than one possible completion, -it displays a list of all possible completions." - :type 'boolean - :group 'pascal) +it displays a list of all possible completions.") +(make-obsolete-variable 'pascal-toggle-completions + 'completion-cycle-threshold "24.1") (defcustom pascal-type-keywords '("array" "file" "packed" "char" "integer" "real" "string" "record") @@ -303,9 +302,9 @@ "Major mode for editing Pascal code. \\ TAB indents for Pascal code. Delete converts tabs to spaces as it moves back. -\\[pascal-complete-word] completes the word around current point with respect \ +\\[completion-at-point] completes the word around current point with respect \ to position in code -\\[pascal-show-completions] shows all possible completions at this point. +\\[completion-help-at-point] shows all possible completions at this point. Other useful functions are: @@ -354,6 +353,7 @@ (set (make-local-variable 'comment-start) "{") (set (make-local-variable 'comment-start-skip) "(\\*+ *\\|{ *") (set (make-local-variable 'comment-end) "}") + (add-hook 'completion-at-point-functions 'pascal-completions-at-point nil t) ;; Font lock support (set (make-local-variable 'font-lock-defaults) '(pascal-font-lock-keywords nil t)) @@ -1287,54 +1287,17 @@ (defvar pascal-last-word-shown nil) (defvar pascal-last-completions nil) -(defun pascal-complete-word () - "Complete word at current point. -\(See also `pascal-toggle-completions', `pascal-type-keywords', -`pascal-start-keywords' and `pascal-separator-keywords'.)" - (interactive) +(defun pascal-completions-at-point () (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point))) (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))) - - ;; Toggle-completions inserts whole labels - (if pascal-toggle-completions - (let* ((pascal-str (buffer-substring b e)) - (allcomp (if (and pascal-toggle-completions - (string= pascal-last-word-shown pascal-str)) - pascal-last-completions - (all-completions pascal-str 'pascal-completion)))) - ;; Update entry number in list - (setq pascal-last-completions allcomp - pascal-last-word-numb - (if (>= pascal-last-word-numb (1- (length allcomp))) - 0 - (1+ pascal-last-word-numb))) - (setq pascal-last-word-shown (elt allcomp pascal-last-word-numb)) - ;; Display next match or same string if no match was found - (if allcomp - (progn - (goto-char e) - (insert-before-markers pascal-last-word-shown) - (delete-region b e)) - (message "(No match)"))) - ;; The other form of completion does not necessarily do that. - (completion-in-region b e 'pascal-completion)))) - -(defun pascal-show-completions () - "Show all possible completions at current point." - (interactive) - (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point))) - (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point))) - (pascal-str (buffer-substring b e)) - (allcomp (if (and pascal-toggle-completions - (string= pascal-last-word-shown pascal-str)) - pascal-last-completions - (all-completions pascal-str 'pascal-completion)))) - ;; Show possible completions in a temporary buffer. - (with-output-to-temp-buffer "*Completions*" - (display-completion-list allcomp pascal-str)) - ;; Wait for a keypress. Then delete *Completion* window - (momentary-string-display "" (point)) - (delete-window (get-buffer-window (get-buffer "*Completions*"))))) + (when (> e b) + (list b e #'pascal-completion)))) + +(define-obsolete-function-alias 'pascal-complete-word + 'completion-at-point "24.1") + +(define-obsolete-function-alias 'pascal-show-completions + 'completion-help-at-point "24.1") (defun pascal-get-default-symbol () === modified file 'lisp/wid-edit.el' --- lisp/wid-edit.el 2011-05-21 02:06:11 +0000 +++ lisp/wid-edit.el 2011-06-20 16:02:31 +0000 @@ -1,4 +1,4 @@ -;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t;-*- +;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t; lexical-binding:t -*- ;; ;; Copyright (C) 1996-1997, 1999-2011 Free Software Foundation, Inc. ;; @@ -1161,10 +1161,29 @@ "Complete content of editable field from point. When not inside a field, signal an error." (interactive) + (let ((data (widget-completions-at-point))) + (cond + ((functionp data) (funcall data)) + ((consp data) + (let ((completion-extra-properties (nth 3 data))) + (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data) + (plist-get completion-extra-properties + :predicate)))) + ((widget-field-find (point)) + ;; This defaulting used to be performed in widget-default-complete, but + ;; it seems more appropriate here than in widget-default-completions. + (call-interactively 'widget-complete-field)) + (t + (error "Not in an editable field"))))) +;; We may want to use widget completion in buffers where the major mode +;; hasn't added widget-completions-at-point to completion-at-point-functions, +;; so it's not really obsolete (yet). +;; (make-obsolete 'widget-complete 'completion-at-point "24.1") + +(defun widget-completions-at-point () (let ((field (widget-field-find (point)))) - (if field - (widget-apply field :complete) - (error "Not in an editable field")))) + (when field + (widget-apply field :completions-function)))) ;;; Setting up the buffer. @@ -1435,7 +1454,7 @@ :value-to-external (lambda (_widget value) value) :button-prefix 'widget-button-prefix :button-suffix 'widget-button-suffix - :complete 'widget-default-complete + :completions-function #'widget-default-completions :create 'widget-default-create :indent nil :offset 0 @@ -1461,13 +1480,20 @@ (defvar widget--completing-widget) -(defun widget-default-complete (widget) - "Call the value of the :complete-function property of WIDGET. -If that does not exist, call the value of `widget-complete-field'. -During this call, `widget--completing-widget' is bound to WIDGET." - (let ((widget--completing-widget widget)) - (call-interactively (or (widget-get widget :complete-function) - widget-complete-field)))) +(defun widget-default-completions (widget) + "Return completion data, like `completion-at-point-functions' would." + (let ((completions (widget-get widget :completions))) + (if completions + (list (widget-field-start widget) + (max (point) (widget-field-text-end widget)) + completions) + (if (widget-get widget :complete) + (lambda () (widget-apply widget :complete)) + (if (widget-get widget :complete-function) + (lambda () + (let ((widget--completing-widget widget)) + (call-interactively + (widget-get widget :complete-function))))))))) (defun widget-default-create (widget) "Create WIDGET at point in the current buffer." @@ -3018,20 +3044,6 @@ :complete-function 'ispell-complete-word :prompt-history 'widget-string-prompt-value-history) -(defun widget-string-complete () - "Complete contents of string field. -Completions are taken from the :completion-alist property of the -widget. If that isn't a list, it's evalled and expected to yield a list." - (interactive) - (let* ((widget widget--completing-widget) - (completion-ignore-case (widget-get widget :completion-ignore-case)) - (alist (widget-get widget :completion-alist)) - (_ (unless (listp alist) - (setq alist (eval alist))))) - (completion-in-region (widget-field-start widget) - (max (point) (widget-field-text-end widget)) - alist))) - (define-widget 'regexp 'string "A regular expression." :match 'widget-regexp-match @@ -3059,21 +3071,13 @@ (define-widget 'file 'string "A file widget. It reads a file name from an editable text field." - :complete-function 'widget-file-complete + :completions #'completion-file-name-table :prompt-value 'widget-file-prompt-value :format "%{%t%}: %v" ;; Doesn't work well with terminating newline. ;; :value-face 'widget-single-line-field :tag "File") -(defun widget-file-complete () - "Perform completion on file name preceding point." - (interactive) - (let ((widget widget--completing-widget)) - (completion-in-region (widget-field-start widget) - (max (point) (widget-field-text-end widget)) - 'completion-file-name-table))) - (defun widget-file-prompt-value (widget prompt value unbound) ;; Read file from minibuffer. (abbreviate-file-name @@ -3113,7 +3117,7 @@ :tag "Symbol" :format "%{%t%}: %v" :match (lambda (_widget value) (symbolp value)) - :complete-function 'lisp-complete-symbol + :completions obarray :prompt-internal 'widget-symbol-prompt-internal :prompt-match 'symbolp :prompt-history 'widget-symbol-prompt-value-history @@ -3141,9 +3145,8 @@ (define-widget 'function 'restricted-sexp "A Lisp function." - :complete-function (lambda () - (interactive) - (lisp-complete-symbol 'fboundp)) + :completions (apply-partially #'completion-table-with-predicate + obarray #'fboundp 'strict) :prompt-value 'widget-field-prompt-value :prompt-internal 'widget-symbol-prompt-internal :prompt-match 'fboundp @@ -3165,9 +3168,8 @@ "A Lisp variable." :prompt-match 'boundp :prompt-history 'widget-variable-prompt-value-history - :complete-function (lambda () - (interactive) - (lisp-complete-symbol 'boundp)) + :completions (apply-partially #'completion-table-with-predicate + obarray #'boundp 'strict) :tag "Variable") (define-widget 'coding-system 'symbol @@ -3178,9 +3180,8 @@ :prompt-history 'coding-system-value-history :prompt-value 'widget-coding-system-prompt-value :action 'widget-coding-system-action - :complete-function (lambda () - (interactive) - (lisp-complete-symbol 'coding-system-p)) + :completions (apply-partially #'completion-table-with-predicate + obarray #'coding-system-p 'strict) :validate (lambda (widget) (unless (coding-system-p (widget-value widget)) (widget-put widget :error (format "Invalid coding system: %S" @@ -3317,7 +3318,7 @@ (insert (widget-apply widget :value-get)) (goto-char (point-min)) (let (err) - (condition-case data + (condition-case data ;Note: We get a spurious byte-compile warning here. (progn ;; Avoid a confusing end-of-file error. (skip-syntax-forward "\\s-") @@ -3685,7 +3686,7 @@ :size 10 :tag "Color" :value "black" - :complete 'widget-color-complete + :completions (or facemenu-color-alist (defined-colors)) :sample-face-get 'widget-color-sample-face-get :notify 'widget-color-notify :action 'widget-color-action) @@ -3711,14 +3712,6 @@ (delete-window win))) (pop-to-buffer ,(current-buffer)))))) -(defun widget-color-complete (widget) - "Complete the color in WIDGET." - (require 'facemenu) ; for facemenu-color-alist - (completion-in-region (widget-field-start widget) - (max (point) (widget-field-text-end widget)) - (or facemenu-color-alist - (sort (defined-colors) 'string-lessp)))) - (defun widget-color-sample-face-get (widget) (let* ((value (condition-case nil (widget-value widget) ------------------------------------------------------------ revno: 104643 committer: Deniz Dogan branch nick: emacs-trunk timestamp: Mon 2011-06-20 14:55:24 +0200 message: * lisp/net/rcirc.el: Delete trailing whitespaces once and for all. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-20 08:41:57 +0000 +++ lisp/ChangeLog 2011-06-20 12:55:24 +0000 @@ -1,3 +1,7 @@ +2011-06-20 Deniz Dogan + + * net/rcirc.el: Delete trailing whitespaces once and for all. + 2011-06-20 Martin Rudalics * window.el (get-window-with-predicate): Start scanning with === modified file 'lisp/net/rcirc.el' --- lisp/net/rcirc.el 2011-06-05 19:39:17 +0000 +++ lisp/net/rcirc.el 2011-06-20 12:55:24 +0000 @@ -987,7 +987,7 @@ (setq buffer-invisibility-spec '()) (setq buffer-display-table (make-display-table)) (set-display-table-slot buffer-display-table 4 - (let ((glyph (make-glyph-code + (let ((glyph (make-glyph-code ?. 'font-lock-keyword-face))) (make-vector 3 glyph))) @@ -1151,7 +1151,7 @@ (rcirc-generate-new-buffer-name process target)))) (with-current-buffer new-buffer (rcirc-mode process target) - (rcirc-put-nick-channel process (rcirc-nick process) target + (rcirc-put-nick-channel process (rcirc-nick process) target rcirc-current-line)) new-buffer))))) @@ -1238,7 +1238,7 @@ (interactive) (let ((pos (1+ (- (point) rcirc-prompt-end-marker)))) (goto-char (point-max)) - (let ((text (buffer-substring-no-properties rcirc-prompt-end-marker + (let ((text (buffer-substring-no-properties rcirc-prompt-end-marker (point))) (parent (buffer-name))) (delete-region rcirc-prompt-end-marker (point)) @@ -1477,7 +1477,7 @@ (match-string 1 text))) rcirc-ignore-list)) ;; do not ignore if we sent the message - (not (string= sender (rcirc-nick process)))) + (not (string= sender (rcirc-nick process)))) (let* ((buffer (rcirc-target-buffer process sender response target text)) (inhibit-read-only t)) (with-current-buffer buffer @@ -1655,8 +1655,8 @@ (defun rcirc-view-log-file () "View logfile corresponding to the current buffer." (interactive) - (find-file-other-window - (expand-file-name (funcall rcirc-log-filename-function + (find-file-other-window + (expand-file-name (funcall rcirc-log-filename-function (rcirc-buffer-process) rcirc-target) rcirc-log-directory))) @@ -2446,7 +2446,7 @@ rcirc-fill-column) (t fill-column)) ;; make sure ... doesn't cause line wrapping - 3))) + 3))) (fill-region (point) (point-max) nil t)))) ;;; handlers @@ -2813,7 +2813,7 @@ ;; quakenet authentication doesn't rely on the user's nickname. ;; the variable `nick' here represents the Q account name. (when (eq method 'quakenet) - (rcirc-send-privmsg + (rcirc-send-privmsg process "Q@CServe.quakenet.org" (format "AUTH %s %s" nick (car args)))))))))) ------------------------------------------------------------ revno: 104642 committer: Deniz Dogan branch nick: emacs-trunk timestamp: Mon 2011-06-20 14:54:05 +0200 message: * src/process.c (Fset_process_buffer): Clarify return value in docstring. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-18 19:15:06 +0000 +++ src/ChangeLog 2011-06-20 12:54:05 +0000 @@ -1,3 +1,8 @@ +2011-06-20 Deniz Dogan + + * process.c (Fset_process_buffer): Clarify return value in + docstring. + 2011-06-18 Chong Yidong * dispnew.c (add_window_display_history): Use BVAR. === modified file 'src/process.c' --- src/process.c 2011-06-14 18:57:19 +0000 +++ src/process.c 2011-06-20 12:54:05 +0000 @@ -892,7 +892,8 @@ DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer, 2, 2, 0, - doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */) + doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). +Return BUFFER. */) (register Lisp_Object process, Lisp_Object buffer) { struct Lisp_Process *p; ------------------------------------------------------------ revno: 104641 committer: martin rudalics branch nick: trunk timestamp: Mon 2011-06-20 10:41:57 +0200 message: Restore old behavior of get-window-with-predicate and get-buffer-window-list. * window.el (get-window-with-predicate): Start scanning with window following selected window to restore Emacs 23 behavior. Clarify doc-string. (get-buffer-window-list): Start scanning with selected window to restore Emacs 23 behavior. Clarify doc-string. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-20 03:36:16 +0000 +++ lisp/ChangeLog 2011-06-20 08:41:57 +0000 @@ -1,3 +1,11 @@ +2011-06-20 Martin Rudalics + + * window.el (get-window-with-predicate): Start scanning with + window following selected window to restore Emacs 23 behavior. + Clarify doc-string. + (get-buffer-window-list): Start scanning with selected window to + restore Emacs 23 behavior. Clarify doc-string. + 2011-06-20 Daniel Colascione * emacs-lisp/syntax.el (syntax-ppss): Further improve docstring. === modified file 'lisp/window.el' --- lisp/window.el 2011-06-19 14:32:12 +0000 +++ lisp/window.el 2011-06-20 08:41:57 +0000 @@ -1165,13 +1165,20 @@ (window-frame window)) (or best best-2))) -(defun get-window-with-predicate (predicate &optional minibuf - all-frames default) +(defun get-window-with-predicate (predicate &optional minibuf all-frames default) "Return a live window satisfying PREDICATE. More precisely, cycle through all windows calling the function PREDICATE on each one of them with the window as its sole argument. Return the first window for which PREDICATE returns -non-nil. If no window satisfies PREDICATE, return DEFAULT. +non-nil. Windows are scanned starting with the window following +the selcted window. If no window satisfies PREDICATE, return +DEFAULT. + +MINIBUF t means include the minibuffer window even if the +minibuffer is not active. MINIBUF nil or omitted means include +the minibuffer window only if the minibuffer is active. Any +other value means do not include the minibuffer window even if +the minibuffer is active. ALL-FRAMES nil or omitted means consider all windows on the selected frame, plus the minibuffer window if specified by the MINIBUF @@ -1192,7 +1199,9 @@ Anything else means consider all windows on the selected frame and no others." (catch 'found - (dolist (window (window-list-1 nil minibuf all-frames)) + (dolist (window (window-list-1 + (next-window nil minibuf all-frames) + minibuf all-frames)) (when (funcall predicate window) (throw 'found window))) default)) @@ -1297,10 +1306,8 @@ (defun get-buffer-window-list (&optional buffer-or-name minibuf all-frames) "Return list of all windows displaying BUFFER-OR-NAME, or nil if none. BUFFER-OR-NAME may be a buffer or the name of an existing buffer -and defaults to the current buffer. - -Any windows showing BUFFER-OR-NAME on the selected frame are listed -first. +and defaults to the current buffer. Windows are scanned starting +with the selected window. MINIBUF t means include the minibuffer window even if the minibuffer is not active. MINIBUF nil or omitted means include @@ -1328,7 +1335,7 @@ and no others." (let ((buffer (normalize-live-buffer buffer-or-name)) windows) - (dolist (window (window-list-1 (frame-first-window) minibuf all-frames)) + (dolist (window (window-list-1 (selected-window) minibuf all-frames)) (when (eq (window-buffer window) buffer) (setq windows (cons window windows)))) (nreverse windows))) ------------------------------------------------------------ revno: 104640 committer: Daniel Colascione branch nick: trunk timestamp: Sun 2011-06-19 20:36:16 -0700 message: * emacs-lisp/syntax.el (syntax-ppss): Further improve docstring. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-19 18:53:49 +0000 +++ lisp/ChangeLog 2011-06-20 03:36:16 +0000 @@ -1,3 +1,7 @@ +2011-06-20 Daniel Colascione + + * emacs-lisp/syntax.el (syntax-ppss): Further improve docstring. + 2011-06-19 Chong Yidong * files.el (auto-mode-alist): Entry for m2-mode (Bug#8852). === modified file 'lisp/emacs-lisp/syntax.el' --- lisp/emacs-lisp/syntax.el 2011-06-12 00:27:14 +0000 +++ lisp/emacs-lisp/syntax.el 2011-06-20 03:36:16 +0000 @@ -398,8 +398,9 @@ (defun syntax-ppss (&optional pos) "Parse-Partial-Sexp State at POS, defaulting to point. -The returned value is the same as `parse-partial-sexp' except that -values 2 and 6 values of the returned state cannot be relied upon. +The returned value is the same as that of `parse-partial-sexp' +run from point-min to POS except that values at positions 2 and 6 +in the returned list (counting from 0) cannot be relied upon. Point is at POS when this function returns." ;; Default values. (unless pos (setq pos (point))) ------------------------------------------------------------ revno: 104639 committer: Chong Yidong branch nick: trunk timestamp: Sun 2011-06-19 14:59:58 -0400 message: Fix last change. diff: === modified file 'lisp/files.el' --- lisp/files.el 2011-06-19 18:53:49 +0000 +++ lisp/files.el 2011-06-19 18:59:58 +0000 @@ -2333,7 +2333,7 @@ ("\\.ebrowse\\'" . ebrowse-tree-mode) ("#\\*mail\\*" . mail-mode) ("\\.g\\'" . antlr-mode) - ("\\.m2\\'" . m2-mode) + ("\\.mod\\'" . m2-mode) ("\\.ses\\'" . ses-mode) ("\\.docbook\\'" . sgml-mode) ("\\.com\\'" . dcl-mode) ------------------------------------------------------------ revno: 104638 committer: Chong Yidong branch nick: trunk timestamp: Sun 2011-06-19 14:53:49 -0400 message: * lisp/files.el (auto-mode-alist): Entry for m2-mode (Bug#8852). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-19 18:42:06 +0000 +++ lisp/ChangeLog 2011-06-19 18:53:49 +0000 @@ -1,5 +1,7 @@ 2011-06-19 Chong Yidong + * files.el (auto-mode-alist): Entry for m2-mode (Bug#8852). + * info.el (Info-apropos-toc-nodes): Minor doc fix (Bug#8833). 2011-06-19 Martin Rudalics === modified file 'lisp/files.el' --- lisp/files.el 2011-06-11 09:50:37 +0000 +++ lisp/files.el 2011-06-19 18:53:49 +0000 @@ -2333,6 +2333,7 @@ ("\\.ebrowse\\'" . ebrowse-tree-mode) ("#\\*mail\\*" . mail-mode) ("\\.g\\'" . antlr-mode) + ("\\.m2\\'" . m2-mode) ("\\.ses\\'" . ses-mode) ("\\.docbook\\'" . sgml-mode) ("\\.com\\'" . dcl-mode) ------------------------------------------------------------ revno: 104637 committer: Chong Yidong branch nick: trunk timestamp: Sun 2011-06-19 14:42:06 -0400 message: * info.el (Info-apropos-toc-nodes): Minor doc fix (Bug#8833). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-19 14:32:12 +0000 +++ lisp/ChangeLog 2011-06-19 18:42:06 +0000 @@ -1,3 +1,7 @@ +2011-06-19 Chong Yidong + + * info.el (Info-apropos-toc-nodes): Minor doc fix (Bug#8833). + 2011-06-19 Martin Rudalics * window.el (display-buffer-other-window-means-other-frame): === modified file 'lisp/info.el' --- lisp/info.el 2011-04-05 15:08:28 +0000 +++ lisp/info.el 2011-06-19 18:42:06 +0000 @@ -3230,7 +3230,7 @@ MATCHES is a list of index matches found by `Info-apropos-matches'.") (defun Info-apropos-toc-nodes (filename) - "Apropos-specific implementation of `Info-apropos-toc-nodes'." + "Apropos-specific implementation of `Info-toc-nodes'." (let ((nodes (mapcar 'car (reverse Info-apropos-nodes)))) `(,filename ("Top" nil nil ,nodes) ------------------------------------------------------------ revno: 104636 committer: Glenn Morris branch nick: trunk timestamp: Sun 2011-06-19 14:39:24 -0400 message: Auto-commit of loaddefs files. diff: === modified file 'lisp/dired.el' --- lisp/dired.el 2011-05-21 10:19:46 +0000 +++ lisp/dired.el 2011-06-19 18:39:24 +0000 @@ -4089,7 +4089,7 @@ ;;;*** ;;;### (autoloads (dired-do-relsymlink dired-jump-other-window dired-jump) -;;;;;; "dired-x" "dired-x.el" "94bd5ca0bd260e43402e3cd9f114970c") +;;;;;; "dired-x" "dired-x.el" "cdeb2935dc1d33819b12981ba5272073") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\ ------------------------------------------------------------ revno: 104635 committer: Glenn Morris branch nick: trunk timestamp: Sun 2011-06-19 14:33:17 -0400 message: Auto-commit of generated files. diff: === modified file 'autogen/configure' --- autogen/configure 2011-06-17 17:41:21 +0000 +++ autogen/configure 2011-06-19 18:33:17 +0000 @@ -16707,14 +16707,14 @@ if test "x$ac_cv_func_getloadavg" = x""yes; then : else - gl_have_func=no + gl_func_getloadavg_done=no # Some systems with -lutil have (and need) -lkvm as well, some do not. # On Solaris, -lkvm requires nlist from -lelf, so check that first # to get the right answer into the cache. # For kstat on solaris, we need to test for libelf and libkvm to force the # definition of SVR4 below. - if test $gl_have_func = no; then + if test $gl_func_getloadavg_done = no; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for elf_begin in -lelf" >&5 $as_echo_n "checking for elf_begin in -lelf... " >&6; } if test "${ac_cv_lib_elf_elf_begin+set}" = set; then : @@ -16833,12 +16833,12 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_util_getloadavg" >&5 $as_echo "$ac_cv_lib_util_getloadavg" >&6; } if test "x$ac_cv_lib_util_getloadavg" = x""yes; then : - LIBS="-lutil $LIBS" gl_have_func=yes + LIBS="-lutil $LIBS" gl_func_getloadavg_done=yes fi fi - if test $gl_have_func = no; then + if test $gl_func_getloadavg_done = no; then # There is a commonly available library for RS/6000 AIX. # Since it is not a standard part of AIX, it might be installed locally. gl_getloadavg_LIBS=$LIBS @@ -16880,7 +16880,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_getloadavg_getloadavg" >&5 $as_echo "$ac_cv_lib_getloadavg_getloadavg" >&6; } if test "x$ac_cv_lib_getloadavg_getloadavg" = x""yes; then : - LIBS="-lgetloadavg $LIBS" gl_have_func=yes + LIBS="-lgetloadavg $LIBS" gl_func_getloadavg_done=yes else LIBS=$gl_getloadavg_LIBS fi @@ -16888,67 +16888,11 @@ fi # Set up the replacement function if necessary. - if test $gl_have_func = no; then + if test $gl_func_getloadavg_done = no; then HAVE_GETLOADAVG=0 - fi -fi - - -if test "x$gl_save_LIBS" = x; then - GETLOADAVG_LIBS=$LIBS -else - GETLOADAVG_LIBS=`echo "$LIBS" | sed "s!$gl_save_LIBS!!"` -fi -LIBS=$gl_save_LIBS - - -# Test whether the system declares getloadavg. Solaris has the function -# but declares it in , not . -for ac_header in sys/loadavg.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "sys/loadavg.h" "ac_cv_header_sys_loadavg_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_loadavg_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_SYS_LOADAVG_H 1 -_ACEOF - -fi - -done - -if test $ac_cv_header_sys_loadavg_h = yes; then - HAVE_SYS_LOADAVG_H=1 -else - HAVE_SYS_LOADAVG_H=0 -fi -ac_fn_c_check_decl "$LINENO" "getloadavg" "ac_cv_have_decl_getloadavg" "#if HAVE_SYS_LOADAVG_H - # include - #endif - #include -" -if test "x$ac_cv_have_decl_getloadavg" = x""yes; then : - -else - HAVE_DECL_GETLOADAVG=0 -fi - - -if test $HAVE_GETLOADAVG = 0; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS getloadavg.$ac_objext" - - -# Figure out what our getloadavg.c needs. - -# Solaris has libkstat which does not require root. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for kstat_open in -lkstat" >&5 + + # Solaris has libkstat which does not require root. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for kstat_open in -lkstat" >&5 $as_echo_n "checking for kstat_open in -lkstat... " >&6; } if test "${ac_cv_lib_kstat_kstat_open+set}" = set; then : $as_echo_n "(cached) " >&6 @@ -16993,26 +16937,11 @@ fi -test $ac_cv_lib_kstat_kstat_open = yes && gl_have_func=yes - -# On HPUX9, an unprivileged user can get load averages this way. -if test $gl_have_func = no; then - for ac_func in pstat_getdynamic -do : - ac_fn_c_check_func "$LINENO" "pstat_getdynamic" "ac_cv_func_pstat_getdynamic" -if test "x$ac_cv_func_pstat_getdynamic" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_PSTAT_GETDYNAMIC 1 -_ACEOF - gl_have_func=yes -fi -done - -fi - -# AIX has libperfstat which does not require root -if test $gl_have_func = no; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for perfstat_cpu_total in -lperfstat" >&5 + test $ac_cv_lib_kstat_kstat_open = yes && gl_func_getloadavg_done=yes + + # AIX has libperfstat which does not require root + if test $gl_func_getloadavg_done = no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for perfstat_cpu_total in -lperfstat" >&5 $as_echo_n "checking for perfstat_cpu_total in -lperfstat... " >&6; } if test "${ac_cv_lib_perfstat_perfstat_cpu_total+set}" = set; then : $as_echo_n "(cached) " >&6 @@ -17057,17 +16986,17 @@ fi - test $ac_cv_lib_perfstat_perfstat_cpu_total = yes && gl_have_func=yes -fi + test $ac_cv_lib_perfstat_perfstat_cpu_total = yes && gl_func_getloadavg_done=yes + fi -if test $gl_have_func = no; then - ac_fn_c_check_header_mongrel "$LINENO" "sys/dg_sys_info.h" "ac_cv_header_sys_dg_sys_info_h" "$ac_includes_default" + if test $gl_func_getloadavg_done = no; then + ac_fn_c_check_header_mongrel "$LINENO" "sys/dg_sys_info.h" "ac_cv_header_sys_dg_sys_info_h" "$ac_includes_default" if test "x$ac_cv_header_sys_dg_sys_info_h" = x""yes; then : - gl_have_func=yes + gl_func_getloadavg_done=yes $as_echo "#define DGUX 1" >>confdefs.h - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dg_sys_info in -ldgc" >&5 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dg_sys_info in -ldgc" >&5 $as_echo_n "checking for dg_sys_info in -ldgc... " >&6; } if test "${ac_cv_lib_dgc_dg_sys_info+set}" = set; then : $as_echo_n "(cached) " >&6 @@ -17115,23 +17044,94 @@ fi + fi + fi +fi + + +if test "x$gl_save_LIBS" = x; then + GETLOADAVG_LIBS=$LIBS +else + GETLOADAVG_LIBS=`echo "$LIBS" | sed "s!$gl_save_LIBS!!"` +fi +LIBS=$gl_save_LIBS + + +# Test whether the system declares getloadavg. Solaris has the function +# but declares it in , not . +for ac_header in sys/loadavg.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "sys/loadavg.h" "ac_cv_header_sys_loadavg_h" "$ac_includes_default" +if test "x$ac_cv_header_sys_loadavg_h" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_SYS_LOADAVG_H 1 +_ACEOF + +fi + +done + +if test $ac_cv_header_sys_loadavg_h = yes; then + HAVE_SYS_LOADAVG_H=1 +else + HAVE_SYS_LOADAVG_H=0 +fi +ac_fn_c_check_decl "$LINENO" "getloadavg" "ac_cv_have_decl_getloadavg" "#if HAVE_SYS_LOADAVG_H + # include + #endif + #include +" +if test "x$ac_cv_have_decl_getloadavg" = x""yes; then : + +else + HAVE_DECL_GETLOADAVG=0 +fi + + +if test $HAVE_GETLOADAVG = 0; then + + + + + + + + + gl_LIBOBJS="$gl_LIBOBJS getloadavg.$ac_objext" + + +# Figure out what our getloadavg.c needs. + +# On HPUX9, an unprivileged user can get load averages this way. +if test $gl_func_getloadavg_done = no; then + for ac_func in pstat_getdynamic +do : + ac_fn_c_check_func "$LINENO" "pstat_getdynamic" "ac_cv_func_pstat_getdynamic" +if test "x$ac_cv_func_pstat_getdynamic" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_PSTAT_GETDYNAMIC 1 +_ACEOF + gl_func_getloadavg_done=yes +fi +done + fi # We cannot check for , because Solaris 2 does not use dwarf (it # uses stabs), but it is still SVR4. We cannot check for because # Irix 4.0.5F has the header but not the library. -if test $gl_have_func = no && test "$ac_cv_lib_elf_elf_begin" = yes \ +if test $gl_func_getloadavg_done = no && test "$ac_cv_lib_elf_elf_begin" = yes \ && test "$ac_cv_lib_kvm_kvm_open" = yes; then - gl_have_func=yes + gl_func_getloadavg_done=yes $as_echo "#define SVR4 1" >>confdefs.h fi -if test $gl_have_func = no; then +if test $gl_func_getloadavg_done = no; then ac_fn_c_check_header_mongrel "$LINENO" "inq_stats/cpustats.h" "ac_cv_header_inq_stats_cpustats_h" "$ac_includes_default" if test "x$ac_cv_header_inq_stats_cpustats_h" = x""yes; then : - gl_have_func=yes + gl_func_getloadavg_done=yes $as_echo "#define UMAX 1" >>confdefs.h @@ -17143,17 +17143,17 @@ fi -if test $gl_have_func = no; then +if test $gl_func_getloadavg_done = no; then ac_fn_c_check_header_mongrel "$LINENO" "sys/cpustats.h" "ac_cv_header_sys_cpustats_h" "$ac_includes_default" if test "x$ac_cv_header_sys_cpustats_h" = x""yes; then : - gl_have_func=yes; $as_echo "#define UMAX 1" >>confdefs.h - -fi - - -fi - -if test $gl_have_func = no; then + gl_func_getloadavg_done=yes; $as_echo "#define UMAX 1" >>confdefs.h + +fi + + +fi + +if test $gl_func_getloadavg_done = no; then for ac_header in mach/mach.h do : ac_fn_c_check_header_mongrel "$LINENO" "mach/mach.h" "ac_cv_header_mach_mach_h" "$ac_includes_default" ------------------------------------------------------------ revno: 104634 committer: Paul Eggert branch nick: trunk timestamp: Sun 2011-06-19 11:22:16 -0700 message: * lib/unistd.in.h, m4/getloadavg.m4: Merge from gnulib. diff: === modified file 'ChangeLog' --- ChangeLog 2011-06-17 17:29:50 +0000 +++ ChangeLog 2011-06-19 18:22:16 +0000 @@ -1,3 +1,7 @@ +2011-06-19 Paul Eggert + + * lib/unistd.in.h, m4/getloadavg.m4: Merge from gnulib. + 2011-06-17 Glenn Morris * configure.in: Restore the behavior of checking crt-dir only === modified file 'lib/unistd.in.h' --- lib/unistd.in.h 2011-05-29 21:52:18 +0000 +++ lib/unistd.in.h 2011-06-19 18:22:16 +0000 @@ -1062,6 +1062,7 @@ specification . */ # if @REPLACE_PREAD@ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef pread # define pread rpl_pread # endif _GL_FUNCDECL_RPL (pread, ssize_t, @@ -1096,6 +1097,7 @@ . */ # if @REPLACE_PWRITE@ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef pwrite # define pwrite rpl_pwrite # endif _GL_FUNCDECL_RPL (pwrite, ssize_t, === modified file 'm4/getloadavg.m4' --- m4/getloadavg.m4 2011-06-15 22:27:54 +0000 +++ m4/getloadavg.m4 2011-06-19 18:22:16 +0000 @@ -26,34 +26,51 @@ # NetBSD >= 0.9, OpenBSD >= 2.0, Solaris >= 7. HAVE_GETLOADAVG=1 AC_CHECK_FUNC([getloadavg], [], - [gl_have_func=no + [gl_func_getloadavg_done=no # Some systems with -lutil have (and need) -lkvm as well, some do not. # On Solaris, -lkvm requires nlist from -lelf, so check that first # to get the right answer into the cache. # For kstat on solaris, we need to test for libelf and libkvm to force the # definition of SVR4 below. - if test $gl_have_func = no; then + if test $gl_func_getloadavg_done = no; then AC_CHECK_LIB([elf], [elf_begin], [LIBS="-lelf $LIBS"]) AC_CHECK_LIB([kvm], [kvm_open], [LIBS="-lkvm $LIBS"]) # Check for the 4.4BSD definition of getloadavg. AC_CHECK_LIB([util], [getloadavg], - [LIBS="-lutil $LIBS" gl_have_func=yes]) + [LIBS="-lutil $LIBS" gl_func_getloadavg_done=yes]) fi - if test $gl_have_func = no; then + if test $gl_func_getloadavg_done = no; then # There is a commonly available library for RS/6000 AIX. # Since it is not a standard part of AIX, it might be installed locally. gl_getloadavg_LIBS=$LIBS LIBS="-L/usr/local/lib $LIBS" AC_CHECK_LIB([getloadavg], [getloadavg], - [LIBS="-lgetloadavg $LIBS" gl_have_func=yes], + [LIBS="-lgetloadavg $LIBS" gl_func_getloadavg_done=yes], [LIBS=$gl_getloadavg_LIBS]) fi # Set up the replacement function if necessary. - if test $gl_have_func = no; then + if test $gl_func_getloadavg_done = no; then HAVE_GETLOADAVG=0 + + # Solaris has libkstat which does not require root. + AC_CHECK_LIB([kstat], [kstat_open]) + test $ac_cv_lib_kstat_kstat_open = yes && gl_func_getloadavg_done=yes + + # AIX has libperfstat which does not require root + if test $gl_func_getloadavg_done = no; then + AC_CHECK_LIB([perfstat], [perfstat_cpu_total]) + test $ac_cv_lib_perfstat_perfstat_cpu_total = yes && gl_func_getloadavg_done=yes + fi + + if test $gl_func_getloadavg_done = no; then + AC_CHECK_HEADER([sys/dg_sys_info.h], + [gl_func_getloadavg_done=yes + AC_DEFINE([DGUX], [1], [Define to 1 for DGUX with .]) + AC_CHECK_LIB([dgc], [dg_sys_info])]) + fi fi]) if test "x$gl_save_LIBS" = x; then @@ -88,52 +105,35 @@ [ # Figure out what our getloadavg.c needs. -# Solaris has libkstat which does not require root. -AC_CHECK_LIB([kstat], [kstat_open]) -test $ac_cv_lib_kstat_kstat_open = yes && gl_have_func=yes - # On HPUX9, an unprivileged user can get load averages this way. -if test $gl_have_func = no; then - AC_CHECK_FUNCS([pstat_getdynamic], [gl_have_func=yes]) -fi - -# AIX has libperfstat which does not require root -if test $gl_have_func = no; then - AC_CHECK_LIB([perfstat], [perfstat_cpu_total]) - test $ac_cv_lib_perfstat_perfstat_cpu_total = yes && gl_have_func=yes -fi - -if test $gl_have_func = no; then - AC_CHECK_HEADER([sys/dg_sys_info.h], - [gl_have_func=yes - AC_DEFINE([DGUX], [1], [Define to 1 for DGUX with .]) - AC_CHECK_LIB([dgc], [dg_sys_info])]) +if test $gl_func_getloadavg_done = no; then + AC_CHECK_FUNCS([pstat_getdynamic], [gl_func_getloadavg_done=yes]) fi # We cannot check for , because Solaris 2 does not use dwarf (it # uses stabs), but it is still SVR4. We cannot check for because # Irix 4.0.5F has the header but not the library. -if test $gl_have_func = no && test "$ac_cv_lib_elf_elf_begin" = yes \ +if test $gl_func_getloadavg_done = no && test "$ac_cv_lib_elf_elf_begin" = yes \ && test "$ac_cv_lib_kvm_kvm_open" = yes; then - gl_have_func=yes + gl_func_getloadavg_done=yes AC_DEFINE([SVR4], [1], [Define to 1 on System V Release 4.]) fi -if test $gl_have_func = no; then +if test $gl_func_getloadavg_done = no; then AC_CHECK_HEADER([inq_stats/cpustats.h], - [gl_have_func=yes + [gl_func_getloadavg_done=yes AC_DEFINE([UMAX], [1], [Define to 1 for Encore UMAX.]) AC_DEFINE([UMAX4_3], [1], [Define to 1 for Encore UMAX 4.3 that has instead of .])]) fi -if test $gl_have_func = no; then +if test $gl_func_getloadavg_done = no; then AC_CHECK_HEADER([sys/cpustats.h], - [gl_have_func=yes; AC_DEFINE([UMAX])]) + [gl_func_getloadavg_done=yes; AC_DEFINE([UMAX])]) fi -if test $gl_have_func = no; then +if test $gl_func_getloadavg_done = no; then AC_CHECK_HEADERS([mach/mach.h]) fi ------------------------------------------------------------ revno: 104633 committer: martin rudalics branch nick: trunk timestamp: Sun 2011-06-19 16:32:12 +0200 message: Regroup clauses in display-buffer-normalize-options (Bug#8851) and (Bug#8856). * window.el (display-buffer-normalize-options): Move special-display-p group after pop-up-frame group (Bug#8851) and (Bug#8856). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-19 10:17:56 +0000 +++ lisp/ChangeLog 2011-06-19 14:32:12 +0000 @@ -23,6 +23,8 @@ (window-state-get-1, window-state-get, window-state-put-list) (window-state-put-1, window-state-put-2, window-state-put): New functions. + (display-buffer-normalize-options): Move special-display-p group + after pop-up-frame group (Bug#8851) and (Bug#8856). 2011-06-18 Chong Yidong === modified file 'lisp/window.el' --- lisp/window.el 2011-06-19 10:17:56 +0000 +++ lisp/window.el 2011-06-19 14:32:12 +0000 @@ -5401,6 +5401,19 @@ (cons 'largest fun) (cons 'lru fun)) specifiers)))) + ;; `pop-up-frame' group. Add things if `pop-up-frames' is non-nil + ;; (we ignore the problem that callers usually don't care about + ;; graphic-only). + (when pop-up-frames + ;; `pop-up-frame-function'. If `pop-up-frame-function' uses the + ;; now obsolete `pop-up-frame-alist' it will continue to do so. + (setq specifiers + (cons (cons 'pop-up-frame-function pop-up-frame-function) + specifiers)) + ;; `pop-up-frame' + (setq specifiers + (cons (list 'pop-up-frame pop-up-frames) specifiers))) + ;; `special-display-p' group. (when special-display-function ;; `special-display-p' returns either t or a list of frame @@ -5412,19 +5425,6 @@ (when (listp pars) pars)) specifiers))))) - ;; `pop-up-frame' group. Add things if `pop-up-frames' is non-nil - ;; (we ignore the problem that callers usually don't care about - ;; graphic-only). - (when pop-up-frames - ;; `pop-up-frame-function'. If `pop-up-frame-function' uses the - ;; now obsolete `pop-up-frame-alist' it will continue to do so. - (setq specifiers - (cons (cons 'pop-up-frame-function pop-up-frame-function) - specifiers)) - ;; `pop-up-frame' - (setq specifiers - (cons (list 'pop-up-frame pop-up-frames) specifiers))) - ;; `same-window-p' group. (when (same-window-p buffer-name) ;; Try to reuse the same (selected) window. ------------------------------------------------------------ revno: 104632 committer: martin rudalics branch nick: trunk timestamp: Sun 2011-06-19 12:17:56 +0200 message: Provide functions for saving window configurations as Lisp objects. * window.el (window-list-no-nils, window-state-ignored-parameters) (window-state-get-1, window-state-get, window-state-put-list) (window-state-put-1, window-state-put-2, window-state-put): New functions. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-19 09:59:58 +0000 +++ lisp/ChangeLog 2011-06-19 10:17:56 +0000 @@ -19,6 +19,10 @@ display-buffer-normalize-options-inhibit is non-nil. (frame-auto-delete): New option. (window-deletable-p): Use frame-auto-delete. + (window-list-no-nils, window-state-ignored-parameters) + (window-state-get-1, window-state-get, window-state-put-list) + (window-state-put-1, window-state-put-2, window-state-put): New + functions. 2011-06-18 Chong Yidong === modified file 'lisp/window.el' --- lisp/window.el 2011-06-19 09:59:58 +0000 +++ lisp/window.el 2011-06-19 10:17:56 +0000 @@ -3500,6 +3500,311 @@ ;; (bw-finetune wins) ;; (message "Done in %d rounds" round) )) + +;;; Window states, how to get them and how to put them in a window. +(defsubst window-list-no-nils (&rest args) + "Like LIST but do not add nil elements of ARGS." + (delq nil (apply 'list args))) + +(defvar window-state-ignored-parameters '(quit-restore) + "List of window parameters ignored by `window-state-get'.") + +(defun window-state-get-1 (window &optional markers) + "Helper function for `window-state-get'." + (let* ((type + (cond + ((window-vchild window) 'vc) + ((window-hchild window) 'hc) + (t 'leaf))) + (buffer (window-buffer window)) + (selected (eq window (selected-window))) + (head + (window-list-no-nils + type + (unless (window-next window) (cons 'last t)) + (cons 'clone-number (window-clone-number window)) + (cons 'total-height (window-total-size window)) + (cons 'total-width (window-total-size window t)) + (cons 'normal-height (window-normal-size window)) + (cons 'normal-width (window-normal-size window t)) + (cons 'splits (window-splits window)) + (cons 'nest (window-nest window)) + (let (list) + (dolist (parameter (window-parameters window)) + (unless (memq (car parameter) + window-state-ignored-parameters) + (setq list (cons parameter list)))) + (when list + (cons 'parameters list))) + (when buffer + ;; All buffer related things go in here - make the buffer + ;; current when retrieving `point' and `mark'. + (with-current-buffer (window-buffer window) + (let ((point (if selected (point) (window-point window))) + (start (window-start window)) + (mark (mark))) + (window-list-no-nils + 'buffer (buffer-name buffer) + (cons 'selected selected) + (when window-size-fixed (cons 'size-fixed window-size-fixed)) + (cons 'hscroll (window-hscroll window)) + (cons 'fringes (window-fringes window)) + (cons 'margins (window-margins window)) + (cons 'scroll-bars (window-scroll-bars window)) + (cons 'vscroll (window-vscroll window)) + (cons 'dedicated (window-dedicated-p window)) + (cons 'point (if markers (copy-marker point) point)) + (cons 'start (if markers (copy-marker start) start)) + (when mark + (cons 'mark (if markers (copy-marker mark) mark))))))))) + (tail + (when (memq type '(vc hc)) + (let (list) + (setq window (window-child window)) + (while window + (setq list (cons (window-state-get-1 window markers) list)) + (setq window (window-right window))) + (nreverse list))))) + (append head tail))) + +(defun window-state-get (&optional window markers) + "Return state of WINDOW as a Lisp object. +WINDOW can be any window and defaults to the root window of the +selected frame. + +Optional argument MARKERS non-nil means use markers for sampling +positions like `window-point' or `window-start'. MARKERS should +be non-nil only if the value is used for putting the state back +in the same session (note that markers slow down processing). + +The return value can be used as argument for `window-state-put' +to put the state recorded here into an arbitrary window. The +value can be also stored on disk and read back in a new session." + (setq window + (if window + (if (window-any-p window) + window + (error "%s is not a live or internal window" window)) + (frame-root-window))) + ;; The return value is a cons whose car specifies some constraints on + ;; the size of WINDOW. The cdr lists the states of the subwindows of + ;; WINDOW. + (cons + ;; Frame related things would go into a function, say `frame-state', + ;; calling `window-state-get' to insert the frame's root window. + (window-list-no-nils + (cons 'min-height (window-min-size window)) + (cons 'min-width (window-min-size window t)) + (cons 'min-height-ignore (window-min-size window nil t)) + (cons 'min-width-ignore (window-min-size window t t)) + (cons 'min-height-safe (window-min-size window nil 'safe)) + (cons 'min-width-safe (window-min-size window t 'safe)) + ;; These are probably not needed. + (when (window-size-fixed-p window) (cons 'fixed-height t)) + (when (window-size-fixed-p window t) (cons 'fixed-width t))) + (window-state-get-1 window markers))) + +(defvar window-state-put-list nil + "Helper variable for `window-state-put'.") + +(defun window-state-put-1 (state &optional window ignore totals) + "Helper function for `window-state-put'." + (let ((type (car state))) + (setq state (cdr state)) + (cond + ((eq type 'leaf) + ;; For a leaf window just add unprocessed entries to + ;; `window-state-put-list'. + (setq window-state-put-list + (cons (cons window state) window-state-put-list))) + ((memq type '(vc hc)) + (let* ((horizontal (eq type 'hc)) + (total (window-total-size window horizontal)) + (first t) + size new) + (dolist (item state) + ;; Find the next child window. WINDOW always points to the + ;; real window that we want to fill with what we find here. + (when (memq (car item) '(leaf vc hc)) + (if (assq 'last item) + ;; The last child window. Below `window-state-put-1' + ;; will put into it whatever ITEM has in store. + (setq new nil) + ;; Not the last child window, prepare for splitting + ;; WINDOW. SIZE is the new (and final) size of the old + ;; window. + (setq size + (if totals + ;; Use total size. + (cdr (assq (if horizontal 'total-width 'total-height) item)) + ;; Use normalized size and round. + (round (* total + (cdr (assq + (if horizontal 'normal-width 'normal-height) + item)))))) + + ;; Use safe sizes, we try to resize later. + (setq size (max size (if horizontal + window-safe-min-height + window-safe-min-width))) + + (if (window-sizable-p window (- size) horizontal 'safe) + (let* ((window-nest (assq 'nest item))) + ;; We must inherit the nesting, otherwise we might mess + ;; up handling of atomic and side window. + (setq new (split-window window size horizontal))) + ;; Give up if we can't resize window down to safe sizes. + (error "Cannot resize window %s" window)) + + (when first + (setq first nil) + ;; When creating the first child window add for parent + ;; unprocessed entries to `window-state-put-list'. + (setq window-state-put-list + (cons (cons (window-parent window) state) + window-state-put-list)))) + + ;; Now process the current window (either the one we've just + ;; split or the last child of its parent). + (window-state-put-1 item window ignore totals) + ;; Continue with the last window split off. + (setq window new)))))))) + +(defun window-state-put-2 (ignore) + "Helper function for `window-state-put'." + (dolist (item window-state-put-list) + (let ((window (car item)) + (clone-number (cdr (assq 'clone-number item))) + (splits (cdr (assq 'splits item))) + (nest (cdr (assq 'nest item))) + (parameters (cdr (assq 'parameters item))) + (state (cdr (assq 'buffer item)))) + ;; Put in clone-number. + (when clone-number (set-window-clone-number window clone-number)) + (when splits (set-window-splits window splits)) + (when nest (set-window-nest window nest)) + ;; Process parameters. + (when parameters + (dolist (parameter parameters) + (set-window-parameter window (car parameter) (cdr parameter)))) + ;; Process buffer related state. + (when state + ;; We don't want to raise an error here so we create a buffer if + ;; there's none. + (set-window-buffer window (get-buffer-create (car state))) + (with-current-buffer (window-buffer window) + (set-window-hscroll window (cdr (assq 'hscroll state))) + (apply 'set-window-fringes + (cons window (cdr (assq 'fringes state)))) + (let ((margins (cdr (assq 'margins state)))) + (set-window-margins window (car margins) (cdr margins))) + (let ((scroll-bars (cdr (assq 'scroll-bars state)))) + (set-window-scroll-bars + window (car scroll-bars) (nth 2 scroll-bars) (nth 3 scroll-bars))) + (set-window-vscroll window (cdr (assq 'vscroll state))) + ;; Adjust vertically. + (if (memq window-size-fixed '(t height)) + ;; A fixed height window, try to restore the original size. + (let ((delta (- (cdr (assq 'total-height item)) + (window-total-height window))) + window-size-fixed) + (when (window-resizable-p window delta) + (resize-window window delta))) + ;; Else check whether the window is not high enough. + (let* ((min-size (window-min-size window nil ignore)) + (delta (- min-size (window-total-size window)))) + (when (and (> delta 0) + (window-resizable-p window delta nil ignore)) + (resize-window window delta nil ignore)))) + ;; Adjust horizontally. + (if (memq window-size-fixed '(t width)) + ;; A fixed width window, try to restore the original size. + (let ((delta (- (cdr (assq 'total-width item)) + (window-total-width window))) + window-size-fixed) + (when (window-resizable-p window delta) + (resize-window window delta))) + ;; Else check whether the window is not wide enough. + (let* ((min-size (window-min-size window t ignore)) + (delta (- min-size (window-total-size window t)))) + (when (and (> delta 0) + (window-resizable-p window delta t ignore)) + (resize-window window delta t ignore)))) + ;; Set dedicated status. + (set-window-dedicated-p window (cdr (assq 'dedicated state))) + ;; Install positions (maybe we should do this after all windows + ;; have been created and sized). + (ignore-errors + (set-window-start window (cdr (assq 'start state))) + (set-window-point window (cdr (assq 'point state))) + ;; I'm not sure whether we should set the mark here, but maybe + ;; it can be used. + (let ((mark (cdr (assq 'mark state)))) + (when mark (set-mark mark)))) + ;; Select window if it's the selected one. + (when (cdr (assq 'selected state)) + (select-window window))))))) + +(defun window-state-put (state &optional window ignore) + "Put window state STATE into WINDOW. +STATE should be the state of a window returned by an earlier +invocation of `window-state-get'. Optional argument WINDOW must +specify a live window and defaults to the selected one. + +Optional argument IGNORE non-nil means ignore minimum window +sizes and fixed size restrictions. IGNORE equal `safe' means +subwindows can get as small as `window-safe-min-height' and +`window-safe-min-width'." + (setq window (normalize-live-window window)) + (let* ((frame (window-frame window)) + (head (car state)) + ;; We check here (1) whether the total sizes of root window of + ;; STATE and that of WINDOW are equal so we can avoid + ;; calculating new sizes, and (2) if we do have to resize + ;; whether we can do so without violating size restrictions. + (totals + (and (= (window-total-size window) + (cdr (assq 'total-height state))) + (= (window-total-size window t) + (cdr (assq 'total-width state))))) + (min-height (cdr (assq 'min-height head))) + (min-width (cdr (assq 'min-width head))) + window-splits selected) + (if (and (not totals) + (or (> min-height (window-total-size window)) + (> min-width (window-total-size window t))) + (or (not ignore) + (and (setq min-height + (cdr (assq 'min-height-ignore head))) + (setq min-width + (cdr (assq 'min-width-ignore head))) + (or (> min-height (window-total-size window)) + (> min-width (window-total-size window t))) + (or (not (eq ignore 'safe)) + (and (setq min-height + (cdr (assq 'min-height-safe head))) + (setq min-width + (cdr (assq 'min-width-safe head))) + (or (> min-height + (window-total-size window)) + (> min-width + (window-total-size window t)))))))) + ;; The check above might not catch all errors due to rounding + ;; issues - so IGNORE equal 'safe might not always produce the + ;; minimum possible state. But such configurations hardly make + ;; sense anyway. + (error "Window %s too small to accomodate state" window) + (setq state (cdr state)) + (setq window-state-put-list nil) + ;; Work on the windows of a temporary buffer to make sure that + ;; splitting proceeds regardless of any buffer local values of + ;; `window-size-fixed'. Release that buffer after the buffers of + ;; all live windows have been set by `window-state-put-2'. + (with-temp-buffer + (set-window-buffer window (current-buffer)) + (window-state-put-1 state window nil totals) + (window-state-put-2 ignore)) + (window-check frame)))) ;;; Displaying buffers. (defconst display-buffer-default-specifiers ------------------------------------------------------------ Use --include-merges or -n0 to see merged revisions.